Изменить данные на основе флажка Shiny Ввод с помощью мини-диаграмм в Leaflet - PullRequest
0 голосов
/ 05 августа 2020

Я изо всех сил пытаюсь обновить свои мини-диаграммы в Leaflet на основе выбора флажков на моей блестящей панели инструментов. Это странно, потому что я успешно модифицировал свои мини-диаграммы на основе selectInput, но аналогичный подход не работает для checkboxInput.

Вот пример набора данных и других глобальных объектов:

responses <- c('Support name change','Against','Retain','Focus','General')
year <- c('value1','value2','')
state <- c('Virginia','Maryland','West Virginia')
indiv <- rep(1:50)
Overall.Category <- sample(responses,50,replace = TRUE)
Year <- sample(year,50,replace = TRUE)
State <- sample(state,50,replace = TRUE)

demo <- as.data.frame(cbind(indiv,Overall.Category,State,Year))

demo$lat <- ifelse(demo$State=="Virginia",37.52,
                   ifelse(demo$State=="Maryland",39.61,38.64))

demo$lng <- ifelse(demo$State=="Virginia",-78.85,
                   ifelse(demo$State=="Maryland",-77.30,-80.62))

map_data <- demo %>%
  filter(!is.na(lat)) %>%
  group_by(State,lat,lng) %>%
  mutate(total.responses = n(),
         `Against Name Change` = ifelse(grepl("Against",Overall.Category),TRUE,NA),
         `Support Name Change` = ifelse(grepl("Support name change",Overall.Category),TRUE,NA),
         `Retain but Contextualize` = ifelse(grepl("Retain",Overall.Category),TRUE,NA),
         `Focus on Diversity` = ifelse(grepl("Focus",Overall.Category),TRUE,NA),
         `General` = ifelse(grepl("General",Overall.Category) | Overall.Category=="Unknown",TRUE,NA)) %>%
  group_by(State,lat,lng,total.responses) %>%
  summarise(`Against Name Change` = sum(`Against Name Change`, na.rm = TRUE),
            `Support Name Change` = sum(`Support Name Change`, na.rm = TRUE),
            `Retain but Contextualize` = sum(`Retain but Contextualize`, na.rm = TRUE),
            `Focus on Diversity` = sum(`Focus on Diversity`, na.rm = TRUE),
            `General` = sum(`General`, na.rm = TRUE))

tilesURL <- "http://server.arcgisonline.com/ArcGIS/rest/services/Canvas/World_Light_Gray_Base/MapServer/tile/{z}/{y}/{x}"

basemap <- leaflet(width = "100%", height = "1800px") %>%
  addTiles(tilesURL) %>%
  setView(lat = 37.52, lng = -78.85, zoom = 5)

Мой пользовательский интерфейс и функции сервера:


ui <- dashboardPage(header <- dashboardHeader(title = NULL),
                  sidebar <- dashboardSidebar(sidebarMenu(
                    menuItem("Responses by State", tabName = "geo", icon = icon("map-marked-alt"))
                  )
                  ), 
                  body <- dashboardBody(shinyjs::useShinyjs(), uiOutput("body")),
                  skin = "blue"
  )


server <- function(input, output, session) {
  
  output$map <- renderLeaflet({
    
    basemap %>%
      addMinicharts(
        map_data$lng, map_data$lat,
        chartdata = map_data[,c("Against Name Change","Support Name Change")],
        type = "pie",
        layerId = map_data$State,
        showLabels = TRUE,
        width = 100*sqrt(map_data$total.responses)/sqrt(max(map_data$total.responses)),
        transitionTime=0,
        colorPalette = c("#F16C20", "#1395BA")
      )
  })
  
  observe({
    
    # if (length(input$ex_nonalum)==0 | input$ex_nonalum==FALSE) {
    #   
    #   data1 <- map_data
    #   
    # } else {
    #   data1 <- demo %>%
    #     filter(!is.na(lat)) %>%
    #     filter(Year!="") %>%
    #     group_by(State,lat,lng) %>%
    #     mutate(total.responses = n(),
    #            `Against Name Change` = ifelse(grepl("Against",Overall.Category),TRUE,NA),
    #            `Support Name Change` = ifelse(grepl("Support name change",Overall.Category),TRUE,NA),
    #            `Retain but Contextualize` = ifelse(grepl("Retain",Overall.Category),TRUE,NA),
    #            `Focus on Diversity` = ifelse(grepl("Focus",Overall.Category),TRUE,NA),
    #            `General` = ifelse(grepl("General",Overall.Category) | Overall.Category=="Unknown",TRUE,NA)) %>%
    #     group_by(State,lat,lng,total.responses) %>%
    #     summarise(`Against Name Change` = sum(`Against Name Change`, na.rm = TRUE),
    #               `Support Name Change` = sum(`Support Name Change`, na.rm = TRUE),
    #               `Retain but Contextualize` = sum(`Retain but Contextualize`, na.rm = TRUE),
    #               `Focus on Diversity` = sum(`Focus on Diversity`, na.rm = TRUE),
    #               `General` = sum(`General`, na.rm = TRUE))
    # }
    
    if (length(input$response_type) == 0) {
      data <- map_data[,c("Support Name Change","Against Name Change")] #map_data would be replaced by data1 if commented code worked
    } else {
      data <- map_data[, input$response_type]
    }
    
    zoom <- input$map_zoom
    
    scale <- ifelse(is.null(zoom),60,
                    ifelse(zoom==5,60,
                           ifelse(zoom==6,100,
                                  ifelse(zoom==7,200,
                                         ifelse(zoom==8,300,
                                                ifelse(zoom==9,400,
                                                       ifelse(zoom>9,450,
                                                              ifelse(zoom<5,40,NULL))))))))
    
    maxValue <- max(as.matrix(map_data))
    
    leafletProxy("map", session) %>%
      updateMinicharts(
        map_data$State,
        chartdata = data,
        maxValues = maxValue,
        type = "pie",
        showLabels = input$labels,
        width = scale*sqrt(map_data$total.responses)/sqrt(max(map_data$total.responses)),
        transitionTime = 0,
        colorPalette = c("#F16C20", "#1395BA","#0D3C55","#EBC844","#A2B86C")
      )
    
  })
  
  

  output$body <- renderUI({
        tabItem(tabName = "geo",
                fluidRow(
                  column(6,
                         selectInput("response_type", "Response Category", choices = c("Against Name Change",
                                                                                       "Support Name Change",
                                                                                       "Focus on Diversity",
                                                                                       "Retain but Contextualize",
                                                                                       "General"),
                                     multiple = TRUE,
                                     selected = c("Against Name Change","Support Name Change"))
                  ),
                  column(4,
                         checkboxInput("labels", "Show values", value = TRUE),
                         checkboxInput("ex_nonalum", "Exclude Non-Alumni", value = FALSE)
                  )
                  
                ),
                leafletOutput("map", height = "850px")
        )
    })
}

shinyApp(ui,server)

Закомментированная часть - моя лучшая попытка манипулировать моими данными в наблюдателе, чтобы обновить мои мини-диаграммы. Это приводит к сбою моего приложения и выдает ошибку Error in if: argument is of length zero. Я также пробовал обновить мини-диаграммы в observeEvent(input$ex_nonalum,{}, но это тоже не сработало.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...