我的閃亮應用程式中有兩個選擇輸入，我正在嘗試使第一個選擇輸入控制傳單地圖和另一個選擇輸入的資料集。當“時間”選擇輸入為“日”時，我希望“食物”選擇輸入的選擇為 dfmorn$food，并且我希望地圖反映這種變化。同樣對于“夜晚”，我希望“食物”輸入顯示 dfnight$food，并反映地圖。目前，地圖和“食物”選擇輸入都沒有對“食物”選擇輸入做出反應。
library(leaflet)
library(shiny)
library(shinydashboard)
library(dplyr)
#Data Sample
longN <- c(-96.72363, -96.72880, -96.72700)
latN <- c(17.06167, 17.06200, 17.06170 )
nameN <- c("jim", "grant", "pablo")
foodN <- c("tacos", "burger", "elote")
dfnight <- data.frame(longN, latN, nameN, foodN)
longM <- c(-96.7261564, -96.7260505, -96.7259757)
latM <- c(17.0543072,17.0548387, 17.0553262)
nameM <- c("bob", "frank", "sue")
foodM <- c("memelas","tortas", "tacos")
dfmorn <- data.frame(longM, latM, nameM, foodM)
#icons
puestocolorsN = c ("tacos" = 'green',
"burger" = 'orange',
"elote" = 'red'
)
colorsN = puestocolorsN[dfnight$food]
iconsN <- awesomeIcons(icon = 'ios-close',
iconColor = 'black',
library = 'ion',
markerColor = unname(colors) )
puestocolorsM = c ("tacos" = 'green',
"memelas" = 'orange',
"tortas" = 'black')
colorsM = puestocolorsM[dfmorn$food]
iconsM <- awesomeIcons(icon = 'ios-close',
iconColor = 'black',
library = 'ion',
markerColor = unname(colorsM) )
#ui
ui <- fluidPage(
titlePanel(title = "Street Food Oaxaca"),
sidebarLayout(
sidebarPanel(
selectInput(
inputId = "time",
label = "Select Time",
choices = c("Day", "Night"),
selected = "Day"
),
# uiOutput("conditionalUI")
selectInput(
inputId = "food",
label = "Type of Food",
choices = unique(dfmorn$food),
selected = dfmorn$food[1:5],
multiple = TRUE)),
mainPanel(h3("Map"), leafletOutput("map", width = "800", height = "600"))))
#server
server <- function(input, output, session){
observeEvent(input$time, {
reactive(
if(input$time == "Day") {
renderUI({
SelectInput(
inputId = "food",
label = "Type of Food",
choices = unique(dfmorn$food),
selected = dfmorn$food[1:5],
multiple = TRUE
)
})
}else {
renderUI({
updateSelectInput(
inputId = "food",
label = "Type of Food",
choices = unique(dfnight$food),
multiple = TRUE
)
})
}
)
})
dfmorn1 <- eventReactive(input$food, {
dfmorn %>% dplyr::filter(food %in% input$food)
})
dfnight1 <- eventReactive(input$food, {
dfnight %>% dplyr::filter(food %in% input$food)
})
observeEvent(input$time, {
reactive(
if(input$time == "Day") {
output$map = renderLeaflet({
leaflet(data = dfmorn1()) %>%
setView(lng = -96.725, lat = 17.0618, zoom =14)%>%
addTiles() %>%
addAwesomeMarkers(
lng = ~long,
lat = ~lat,
icon = icons,
label = ~as.character(dfmorn$name))
})
}else {
output$map = renderLeaflet({
leaflet(data = dfnight1()) %>%
setView(lng = -96.725, lat = 17.0618, zoom =14)%>%
addTiles() %>%
addAwesomeMarkers(
lng = ~long,
lat = ~lat,
icon = icons,
label = ~as.character(dfmorn$name)
)
})
}
)
})
}
#Run the application
shinyApp(ui = ui , server = server)
也仍在嘗試根據 dfmorn$food 和 dfnight$food 對標記顏色進行分組，如下所述：Assigning color to leaflet awesomemarkers based on chr column
提前謝謝了。
uj5u.com熱心網友回復：
您有一些拼寫錯誤和更新 selectInput 的方法不正確。嘗試這個
library(leaflet)
library(shiny)
library(shinydashboard)
library(dplyr)
#Data Sample
longN <- c(-96.72363, -96.72880, -96.72700)
latN <- c(17.06167, 17.06200, 17.06170 )
nameN <- c("jim", "grant", "pablo")
foodN <- c("tacos", "burger", "elote")
dfnight <- data.frame(long=longN, lat=latN, name = nameN, food=foodN)
longM <- c(-96.7261564, -96.7260505, -96.7259757)
latM <- c(17.0543072,17.0548387, 17.0553262)
nameM <- c("bob", "frank", "sue")
foodM <- c("memelas","tortas", "tacos")
dfmorn <- data.frame(long=longM, lat=latM, name = nameM, food=foodM)
puestocolorsN = c ("tacos" = 'green',
"burger" = 'orange',
"elote" = 'red'
)
colorsN = puestocolorsN[dfnight$food]
iconsN <- awesomeIcons(icon = 'ios-close',
iconColor = 'black',
library = 'ion',
markerColor = unname(colorsN) )
puestocolorsM = c ("tacos" = 'green',
"memelas" = 'orange',
"tortas" = 'black')
colorsM = puestocolorsM[dfmorn$food]
iconsM <- awesomeIcons(icon = 'ios-close',
iconColor = 'black',
library = 'ion',
markerColor = unname(colorsM) )
#ui
ui <- fluidPage(
titlePanel(title = "Street Food Oaxaca"),
sidebarLayout(
sidebarPanel(
selectInput(
inputId = "time",
label = "Select Time",
choices = c("Day", "Night"),
selected = "Day"
),
# uiOutput("conditionalUI")
selectInput(
inputId = "food",
label = "Type of Food",
choices = unique(dfmorn$food),
selected = dfmorn$food[1:5],
multiple = TRUE)),
mainPanel(h3("Map"), leafletOutput("map", width = "800", height = "600")))
)
#server
server <- function(input, output, session){
observeEvent(input$time, {
if(input$time == "Day") choices <- unique(dfmorn$food)
else choices <- unique(dfnight$food)
updateSelectInput(
inputId = "food",
label = "Type of Food",
choices = choices,
select=choices[1:3]
)
})
dfmrn <- eventReactive(input$food, {
if(input$time == "Day") df <- dfmorn
else df <- dfnight
df %>% dplyr::filter(food %in% input$food)
})
observe({print(dfmrn())})
output$map = renderLeaflet({
req(dfmrn())
leaflet(data = dfmrn()) %>%
setView(lng = -96.725, lat = 17.0618, zoom =14)%>%
addTiles()
})
observeEvent(input$food, {
if(input$time == "Day") icons <- iconsM
else icons <- iconsN
leafletProxy("map", session) %>%
clearShapes() %>%
clearMarkers() %>%
addAwesomeMarkers(
data = dfmrn(),
lng = ~long,
lat = ~lat,
icon = icons,
label = ~as.character(name)
)
})
}
#Run the application
shinyApp(ui = ui , server = server)
轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/482653.html
上一篇：僅選擇具有多行的參與者