Я работаю над приложением shinny, использующим shinydashboardplus, и пытаюсь установить флажок в раскрывающемся меню, чтобы выбрать карту для отображения (m1, m2 или m3).Что происходит на dropdown_menu = dropdownItemList() и на стороне сервера?
Шейп-файлы для UFEBRASIL здесь https://github.com/lucaseosilva/Desafio3. Вот воспроизводимый фрагмент моего кода:
## Options ##
options("scipen"=20)
## Packages ##
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(shinyWidgets)
library(plotly)
library(ggplot2)
library(openxlsx)
library(sf)
library(tmap)
library(dplyr)
library(leaflet)
library(BETS)
## Maps ##
# States
map<-st_read("./Brasil/UFEBRASIL.shp", stringsAsFactors = FALSE)
IST<-BETSget(
c(15925, 15926, 15927, 15928, 15929,
15930, 15931, 15932, 15933, 15934,
15935, 15936, 15937, 15938, 15939,
15940, 15941, 15942, 15943, 15944,
15945, 15946, 15947, 15948, 15949,
15950, 15951),
data.frame = TRUE)
IST1<-BETSget(
c(15861, 15862, 15863, 15864, 15865,
15866, 15867, 15868, 15869, 15870,
15871, 15872, 15873, 15874, 15875,
15876, 15877, 15878, 15879, 15880,
15881, 15882, 15883, 15884, 15885,
15886, 15887),
data.frame = TRUE)
IST2<-BETSget(
c(15893, 15894, 15895, 15896, 15897,
15898, 15899, 15900, 15901, 15902,
15903, 15904, 15905, 15906, 15907,
15908, 15909, 15910, 15911, 15912,
15913, 15914, 15915, 15916, 15917,
15918, 15919),
data.frame = TRUE)
names(IST)<-States
names(IST1)<-States
names(IST2)<-States
IST<-lapply(IST, tail, 1)
INST1<-lapply(IST1, tail, 1)
IST2<-lapply(IST2, tail, 1)
Estados<-c("ACRE",
"ALAGOAS",
"AMAPÁ",
"AMAZONAS",
"BAHIA",
"CEARÁ",
"DISTRITO FEDERAL",
"ESPIRITO SANTO",
"GOIÁS",
"MARANHÃO",
"MATO GROSSO",
"MATO GROSSO DO SUL",
"MINAS GERAIS",
"PARÁ",
"PARAÍBA",
"PARANÁ",
"PERNAMBUCO",
"PIAUÍ",
"RIO DE JANEIRO",
"RIO GRANDE DO NORTE",
"RIO GRANDE DO SUL",
"RONDÔNIA",
"RORAIMA",
"SANTA CATARINA",
"SÃO PAULO",
"SERGIPE",
"TOCANTINS"
)
IST<-data.frame(States = States,
I = c(IST$`ACRE`$value,
IST$`ALAGOAS`$value,
IST$`AMAPÁ`$value,
IST$`AMAZONAS`$value,
IST$`BAHIA`$value,
IST$`CEARÁ`$value,
IST$`DISTRITO FEDERAL`$value,
IST$`ESPIRITO SANTO`$value,
IST$`GOIÁS`$value,
IST$`MARANHÃO`$value,
IST$`MATO GROSSO`$value,
IST$`MATO GROSSO DO SUL`$value,
IST$`MINAS GERAIS`$value,
IST$`PARÁ`$value,
IST$`PARAÍBA`$value,
IST$`PARANÁ`$value,
IST$`PERNAMBUCO`$value,
IST$`PIAUÍ`$value,
IST$`RIO DE JANEIRO`$value,
IST$`RIO GRANDE DO NORTE`$value,
IST$`RIO GRANDE DO SUL`$value,
IST$`RONDÔNIA`$value,
IST$`RORAIMA`$value,
IST$`SANTA CATARINA`$value,
IST$`SÃO PAULO`$value,
IST$`SERGIPE`$value,
IST$`TOCANTINS`$value)
)
IST1<-data.frame(States = States,
I = c(IST1$`ACRE`$value,
IST1$`ALAGOAS`$value,
IST1$`AMAPÁ`$value,
IST1$`AMAZONAS`$value,
IST1$`BAHIA`$value,
IST1$`CEARÁ`$value,
IST1$`DISTRITO FEDERAL`$value,
IST1$`ESPIRITO SANTO`$value,
IST1$`GOIÁS`$value,
IST1$`MARANHÃO`$value,
IST1$`MATO GROSSO`$value,
IST1$`MATO GROSSO DO SUL`$value,
IST1$`MINAS GERAIS`$value,
IST1$`PARÁ`$value,
IST1$`PARAÍBA`$value,
IST1$`PARANÁ`$value,
IST1$`PERNAMBUCO`$value,
IST1$`PIAUÍ`$value,
IST1$`RIO DE JANEIRO`$value,
IST1$`RIO GRANDE DO NORTE`$value,
IST1$`RIO GRANDE DO SUL`$value,
IST1$`RONDÔNIA`$value,
IST1$`RORAIMA`$value,
IST1$`SANTA CATARINA`$value,
IST1$`SÃO PAULO`$value,
IST1$`SERGIPE`$value,
IST1$`TOCANTINS`$value)
)
IST2<-data.frame(States = States,
I = c(IST2$`ACRE`$value,
IST2$`ALAGOAS`$value,
IST2$`AMAPÁ`$value,
IST2$`AMAZONAS`$value,
IST2$`BAHIA`$value,
IST2$`CEARÁ`$value,
IST2$`DISTRITO FEDERAL`$value,
IST2$`ESPIRITO SANTO`$value,
IST2$`GOIÁS`$value,
IST2$`MARANHÃO`$value,
IST2$`MATO GROSSO`$value,
IST2$`MATO GROSSO DO SUL`$value,
IST2$`MINAS GERAIS`$value,
IST2$`PARÁ`$value,
IST2$`PARAÍBA`$value,
IST2$`PARANÁ`$value,
IST2$`PERNAMBUCO`$value,
IST2$`PIAUÍ`$value,
IST2$`RIO DE JANEIRO`$value,
IST2$`RIO GRANDE DO NORTE`$value,
IST2$`RIO GRANDE DO SUL`$value,
IST2$`RONDÔNIA`$value,
IST2$`RORAIMA`$value,
IST2$`SANTA CATARINA`$value,
IST2$`SÃO PAULO`$value,
IST2$`SERGIPE`$value,
IST2$`TOCANTINS`$value)
)
Boxm1<-
boxPlus(
title = tags$b("States", style = 'font-family: "Georgia"'),
closable = FALSE,
width = 6,
status = "danger",
solidHeader = TRUE,
collapsible = TRUE,
enable_dropdown = TRUE,
dropdown_menu = dropdownItemList(), # What should i do here?
leafletOutput("m1"), # What should i do here?
footer = NULL
)
## User Interface ##
header <- dashboardHeaderPlus(title = "MONITOR",
titleWidth = 200
)
sidebar <- dashboardSidebar(
width = 150,
sidebarMenu(
menuItem("Maps", tabName = "maps", icon = icon("globe-americas", lib = "font-awesome"))
)
)
body <- dashboardBody(
tabItems(
# Maps
tabItem(tabName = "maps",
fluidRow(
Boxm1 # Maps
)
)
)
)
ui <- dashboardPagePlus(header, sidebar, body)
server <- function(input, output) {
output$m1<-renderLeaflet({
tmap_mode("view")
IST<-inner_join(map, IST, by = c("NM_ESTADO" = "States"))
IST<-IST[, c(3,1,2,4,5,6)]
m1<-tm_shape(IST, name = "Maps") +
tm_polygons("I", palette = "Reds", title = "")
tmap_leaflet(m1)
})
output$m2<-renderLeaflet({
tmap_mode("view")
IST1<-inner_join(map, IST1, by = c("NM_ESTADO" = "States"))
IST1<-IST1[, c(3,1,2,4,5,6)]
m2<-tm_shape(IST1, name = "Maps") +
tm_polygons("I", palette = "Reds", title = "")
tmap_leaflet(m2)
})
output$m3<-renderLeaflet({
tmap_mode("view")
IST2<-inner_join(map, IST2, by = c("NM_ESTADO" = "States"))
IST2<-IST2[, c(3,1,2,4,5,6)]
m3<-tm_shape(IST2, name = "Maps") +
tm_polygons("I", palette = "Reds", title = "")
tmap_leaflet(m3)
})
}
## App ##
shinyApp(ui, server)