Я изо всех сил пытаюсь обновить свои мини-диаграммы в 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,{}
, но это тоже не сработало.