2016-06-01 2 views
2

Использование Rstudio Я пытаюсь сделать блестящее приложение, которое производит выходные листы. Обратите внимание, что блестящий - это пакет, который я раньше не использовал, поэтому может быть, что в скрипте есть другие ошибки, чем тот, с которым я сталкиваюсь сейчас.Как подмножить dataframe и график с лифтом в зависимости от inputselect в блестящей

Я использую один dataframe с дорожками разных лиц, из которых я хочу подмножество и построить дорожку одного животного в ответ на inputselection.

Sample: 

WhaleID  lat  long 
gm08_150c 68,4276 16,5192 
gm08_150c 68,4337 16,5263 
gm08_150c 68,4327 16,5198 
gm08_154d 68,4295 16,5243 
gm08_154d 68,4313 16,5314 
gm08_154d 68,4281 16,5191 

Выбор в выборе входной точные имена, используемые в файле .csv, в столбце WhaleID, поэтому я хотел бы подмножество всех строк с этой WhaleID от главного dataframe.

После этого подмножества я хочу подмножество только столбцов «long» и «lat» из ранее подмножества данных. Затем этот информационный кадр читается листом.

Последний шаг заключается в построении этих «длинных» и «латинских» позиций на карте.

К сожалению, я получаю сообщение об ошибке:

Warning: Error in $: object of type 'closure' is not subsettable 
Stack trace (innermost first): 
    82: inherits 
    81: resolveFormula 
    80: derivePolygons 
    79: addPolylines 
    78: function_list[[i]] 
    77: freduce 
    76: _fseq 
    75: eval 
    74: eval 
    73: withVisible 
    72: %>% 
    71: func [#15] 
    70: output$map 
    4: <Anonymous> 
    3: do.call 
    2: print.shiny.appobj 
    1: <Promise> 

Сценарий я использую:

require(shiny) 
    require(leaflet) 

    ##Main dataframe I want to subset depending on inputselection  
    dataframe <-read.csv2("PW_with_speedbearingturn.csv") 


    ui <- bootstrapPage( 
     tags$style(type = "text/css", "html, body {width:100%;height:100%}"), 
     absolutePanel(top = 10, right = 10, 
     selectInput(inputId = "whaleID", 
        label = "Select a whale", 
        choices = c("gm08_150c","gm08_154d"))), 
     leafletOutput(outputId = "map", width = "100%", height = "700") 
    ) 

    server <- function(input, output, session){ 

     #?observeEvent 
     #observeEvent(input$whaleID,) 
     Start <- makeIcon(
     iconUrl = "https://upload.wikimedia.org/wikipedia/commons/thumb/f/fe/Dark_Green_Arrow_Down.svg/480px-Dark_Green_Arrow_Down.svg.png", 
     iconWidth = 22, iconHeight = 20, 
     iconAnchorX = 11, iconAnchorY = 20) 

     eventReactive(input$whaleID,{ 
        df<-subset(dataframe, WhaleID == "input$whaleID") ## "input$whaleID" should become the WhaleID that is selected from the inputselect. 

        df<-subset(df, select = c("long", "lat")) 
     })     
     output$map <- renderLeaflet({ 
     leaflet() %>% 
     addTiles() %>% 
     addPolylines(df, lng = df$long, lat = df$lat, col = "grey", opacity = 1)%>% 
     addMarkers(df, lng = first(df$long), lat = first(df$lat), icon = Start, popup = "Start") 
     }) 
    } 

    shinyApp(ui = ui, server = server) 

Я считаю, что он должен делать с eventreactive секцией и Подменю части внутри. Он должен обновляться каждый раз в ответ на то, какой выбор выбран из выбора ввода. К сожалению, я не мог найти никаких существующих решений по этому вопросу.

Любые советы по решению этой проблемы?

Спасибо заранее,

Onno

+0

Помогло ли оно иметь один слой для каждого кита? Если да, сколько у вас индивидуальных идентификаторов? – TimSalabim

ответ

2

Я думаю, что вы можете избежать eventReactive полностью с renderLeaflet будет реактивными об изменениях в input. Здесь приведен пример, так как у меня нет данных. Дайте мне знать, если это не имеет смысла.

require(shiny) 
require(leaflet) 

##Main dataframe I want to subset depending on inputselection  
dataframe <- data.frame(
    abb = state.abb, 
    x = state.center$x, 
    y = state.center$y, 
    stringsAsFactors = FALSE 
) 


ui <- bootstrapPage( 
    tags$style(type = "text/css", "html, body {width:100%;height:100%}"), 
    absolutePanel(top = 10, right = 10, 
       selectInput(inputId = "whaleID", 
          label = "Select a state", 
          choices = dataframe[["abb"]])), 
    leafletOutput(outputId = "map", width = "100%", height = "700") 
) 

server <- function(input, output, session){ 

    Start <- makeIcon(
    iconUrl = "https://upload.wikimedia.org/wikipedia/commons/thumb/f/fe/Dark_Green_Arrow_Down.svg/480px-Dark_Green_Arrow_Down.svg.png", 
    iconWidth = 22, iconHeight = 20, 
    iconAnchorX = 11, iconAnchorY = 20) 


    output$map <- renderLeaflet({ 
    df <- subset(dataframe, abb == input$whaleID) 
    leaflet() %>% 
     addTiles() %>% 
     #addPolylines(df, lng = df$long, lat = df$lat, col = "grey", opacity = 1)%>% 
     addMarkers(data = df, lng = ~x, lat = ~y, icon = Start, popup = "Start") 
    }) 
} 

shinyApp(ui = ui, server = server) 
+0

Большое спасибо за вашу реакцию, это помогло мне решить проблему, и скрипт теперь работает правильно. –