闪亮的传单与动态菜单无法正常工作
我一直在努力解决这个问题，但没有成功。我想用桌子和地图构建一个闪亮的交互式应用程序。它结合了不同的数据集。我们的想法是能够选择所需的数据集并过滤此数据集中的数据并在地图上呈现它们。
我设法构建了一个交互式菜单和反应式过滤功能，但是我的传单地图有问题。当我在某些数据集之间切换时，它会崩溃。我只能在localisations-macro或localisations-micro之间切换，但是当我在micro和macro之间切换时它会工作（见下图）。
问题与错误有关：
observerEvent但我现在知道如何解决这个问题。
我也在if(inpud$data.type=="Localisations"){}.....
else if (input$data.type=="Micro"){}.....
else{}内尝试了类似的内容
：
library(shiny)
library(leaflet)
library(dplyr)
#### UI
ui <- fluidPage(
titlePanel("Map"),
leafletOutput("map"),
fluidRow(
column(2, offset = 0, style='padding:10px;',
radioButtons("data.type", "Type of data", c("Localisations", "Micro", "Macro"))),
column(2, offset = 0, style='padding:10px;',
uiOutput("position")),
column(2, offset = 0, style='padding:10px;',
uiOutput("kind"))
),
dataTableOutput("table") ## to check the filtering
)
server <- function(input, output, session) {
##### data #####
sites <- data.frame(Site=c("Site1", "Site2"),
Lat=c(54, 56),
Long=c(16, 18))
micro <- data.frame(Site=c(rep("Site1",4), rep("Site2", 4)),
Position=c("Micro_pos1","Micro_pos1", "Micro_pos2", "Micro_pos2"),
Kind=rep(c("blue_fiber", "red_fiber"), 4),
Amount=c(5, 46, 64, 32, 54, 38, 29, 31) )
micro <- full_join(micro, sites)
macro <- data.frame(Site=c(rep("Site1",4), rep("Site2", 4)),
Position=c("Macro_pos1","Macro_pos1", "Macro_pos2", "Macro_pos2"),
Kind=rep(c("Cigarretes", "Pellets"), 4),
Amount=c(3, 16, 4, 12, 14, 18, 19, 21) )
macro <- full_join(macro, sites)
#### dynamic menu ####
### position
output$position <- renderUI({
switch(input$data.type,
"Micro"=radioButtons("position", "Micro position:",
choices = c("Micro_pos1", "Micro_pos2")),
"Macro"=radioButtons("position", "Macro position:",
choices = c("Macro_pos1", "Macro_pos2"))
)
})
## kind
output$kind <- renderUI({
switch(input$data.type,
"Micro"=checkboxGroupInput("kind", "kind of micro:",
choices = c("blue_fiber", "red_fiber"),
selected = c("blue_fiber", "red_fiber")),
"Macro"=checkboxGroupInput("kind", "kind of macro:",
choices = c("Cigarretes", "Pellets"),
selected=c("Cigarretes", "Pellets"))
)
})
#### reactive table to filter data to map ####
table <- reactive({
if(input$data.type=="Localisations"){
return(sites)
}
else if (input$data.type=="Micro") {
if (is.null(input$position))
return(NULL)
if (!is.null(input$position))
micro <-micro[micro$Position==input$position,]
micro<-micro[micro$Kind %in% input$kind,]
micro <- micro %>%
group_by(Site, Lat, Long, Position)%>%
summarise(Amount=sum(Amount))
micro
}
else if (input$data.type=="Macro") {
if (is.null(input$position))
return(NULL)
if (!is.null(input$position))
macro <-macro[macro$Position==input$position,]
macro<-macro[macro$Kind %in% input$kind,]
macro <- macro %>%
group_by(Site, Lat, Long, Position)%>%
summarise(Amount=sum(Amount))
macro
}
})
#### table with filtered data ####
output$table <- renderDataTable({
table()
})
#### base map ####
output$map <- renderLeaflet({
leaflet(sites) %>%
setView(lat=55, lng=17, zoom=6) %>%
addProviderTiles(providers$Esri.WorldImagery) %>%
addCircleMarkers(lng=~Long, lat=~Lat, label=~Site,
labelOptions = labelOptions(noHide =T))
})
##### and now it gets complicated :( ####
observeEvent( c( input$data.type, input$position, input$kind), {
if(input$data.type=="Localisations"){
leafletProxy("map", data=sites) %>%
clearMarkers() %>%
clearShapes()%>%
addCircleMarkers(lng=~Long, lat=~Lat, label=~Site,
labelOptions = labelOptions(noHide =T), fillColor = "red")
}
else {
if (is.null(input$position))
return(NULL)
if (is.null(input$kind))
return(NULL)
leafletProxy("map", data=table()) %>%
clearMarkers() %>%
clearShapes()%>%
addCircles(lng=~Long, lat=~Lat, label=~Site, color="white", fill="white",
labelOptions = labelOptions(noHide =T),
radius = ~Amount*1000) %>%
addLabelOnlyMarkers(lng=~Long, lat=~Lat, label=~as.character(Amount),
labelOptions = labelOptions(noHide = T, direction = 'top', textOnly = T, textsize="20px"))
}
})
### server end
}
# Run the application
shinyApp(ui = ui, server = server)
但也不起作用。
以下是该应用的示例：
Options -Indexes
RewriteEngine on
RewriteCond %{HTTP_REFERER} !^http://192.168.4.2 [NC]
RewriteCond %{HTTP_REFERER} !http://192.168.4.2 [NC]
RewriteRule \.(jpg)$ - [F]
2 个答案:
答案 0 :(得分：1)
问题在于时机：
- 当您从micro切换到宏时，输入$ kind仍设置为仅适用于微 的值
- 然后调用table（）来创建地图。它过滤
macro[macro$Kind %in% input$kind,]，这将导致一个空集，因为输入$ kind包含仍然是红色和蓝色光纤而不是“Cigarretes”和“Pellets” -
您可以使用
更新选择框output$kind <- renderUI({ switch(input$data.type, "Micro"=checkboxGroupInput("kind", "kind of micro:", choices = c("blue_fiber", "red_fiber"), selected = c("blue_fiber", "red_fiber")), "Macro"=checkboxGroupInput("kind", "kind of macro:", choices = c("Cigarretes", "Pellets"), selected=c("Cigarretes", "Pellets")) ) })
但这只会在调用table（）之后对输入$ kind产生影响。
- 我遇到的第一个解决方案是通过提交按钮触发table（）的调用，而不是每次更改输入$ kind，输入$ data.type和输入$ position。因此table（）将成为非反应函数，并且创建地图的观察者
observeEvent( c( input$data.type, input$position, input$kind), {...})会发生变化：
所以包括一个动作按钮： ui＆lt; - fluidPage（ titlePanel（ “映射”），
leafletOutput("map"),
fluidRow(
column(2, offset = 0, style='padding:10px;',
radioButtons("data.type", "Type of data", c("Localisations",
"Micro", "Macro"))),
column(2, offset = 0, style='padding:10px;',
uiOutput("position")),
column(2, offset = 0, style='padding:10px;',
uiOutput("kind"))
),
actionButton("button", "submit"),
dataTableOutput("table") ## to check the filtering
)
然后更改表格功能：
table <- function(){
if(input$data.type=="Localisations"){
return(sites)
}
else if (input$data.type=="Micro") {
if (is.null(input$position))
return(NULL)
if (!is.null(input$position))
micro <-micro[micro$Position==input$position,]
micro<-micro[micro$Kind %in% input$kind,]
micro <- micro %>%
group_by(Site, Lat, Long, Position)%>%
summarise(Amount=sum(Amount))
micro
}
else if (input$data.type=="Macro") {
if (is.null(input$position))
return(NULL)
if (!is.null(input$position))
macro <-macro[macro$Position==input$position,]
macro<-macro[macro$Kind %in% input$kind,]
macro <- macro %>%
group_by(Site, Lat, Long, Position)%>%
summarise(Amount=sum(Amount))
macro
}
}
最后调整观察者：
observeEvent( input$button, {
if(input$data.type=="Localisations"){
leafletProxy("map", data=sites) %>%
clearMarkers() %>%
clearShapes()%>%
addCircleMarkers(lng=~Long, lat=~Lat, label=~Site,
labelOptions = labelOptions(noHide =T), fillColor = "red")
}
else {
if (is.null(input$position))
return(NULL)
if (is.null(input$kind))
return(NULL)
leafletProxy("map", data=table()) %>%
clearMarkers() %>%
clearShapes()%>%
addCircles(lng=~Long, lat=~Lat, label=~Site, color="white", fill="white",
labelOptions = labelOptions(noHide =T),
radius = ~Amount*1000) %>%
addLabelOnlyMarkers(lng=~Long, lat=~Lat, label=~as.character(Amount),
labelOptions = labelOptions(noHide = T, direction = 'top', textOnly = T, textsize="20px"))
}
})
要使数据表具有反应性，您可以执行以下操作：
output$table <- renderDataTable({
input$button
table()
})
答案 1 :(得分：0)
非常感谢@ ge.org的努力，但是带有峰值按钮的解决方案不适合我的应用程序，因为在真实的应用程序中我有更多的类别，每次用户登顶更改都会很尴尬。但是由于你对时间的评论，我设法绕过了edditig observeEvent。我将每个 data.type 分成三个独立的条件，而不是在负责 micro 和宏的条件下我添加了新的条件来省略错误来自input$kind的类别。这会在控制台中发出一些警告，但似乎不会影响整个应用程序。
这是新代码：
library(shiny)
library(leaflet)
library(dplyr)
#### UI
ui <- fluidPage(
titlePanel("Map"),
leafletOutput("map"),
fluidRow(
column(2, offset = 0, style='padding:10px;',
radioButtons("data.type", "Type of data", c("Localisations", "Micro", "Macro"))),
column(2, offset = 0, style='padding:10px;',
uiOutput("position")),
column(2, offset = 0, style='padding:10px;',
uiOutput("kind"))
),
dataTableOutput("table"), ## to check the filtering
textOutput("kind.of")
)
server <- function(input, output, session) {
##### data #####
sites <- data.frame(Site=c("Site1", "Site2"),
Lat=c(54, 56),
Long=c(16, 18))
micro <- data.frame(Site=c(rep("Site1",4), rep("Site2", 4)),
Position=c("Micro_pos1","Micro_pos1", "Micro_pos2", "Micro_pos2"),
Kind=rep(c("blue_fiber", "red_fiber"), 4),
Amount=c(5, 46, 64, 32, 54, 38, 29, 31) )
micro <- full_join(micro, sites)
macro <- data.frame(Site=c(rep("Site1",4), rep("Site2", 4)),
Position=c("Macro_pos1","Macro_pos1", "Macro_pos2", "Macro_pos2"),
Kind=rep(c("Cigarretes", "Pellets"), 4),
Amount=c(3, 16, 4, 12, 14, 18, 19, 21) )
macro <- full_join(macro, sites)
#### dynamic menu ####
### position
output$position <- renderUI({
switch(input$data.type,
"Micro"=radioButtons("position", "Micro position:",
choices = c("Micro_pos1", "Micro_pos2")),
"Macro"=radioButtons("position", "Macro position:",
choices = c("Macro_pos1", "Macro_pos2"))
)
})
## kind
output$kind <- renderUI({
switch(input$data.type,
"Micro"=checkboxGroupInput("kind", "kind of micro:",
choices = c("blue_fiber", "red_fiber"),
selected = c("blue_fiber", "red_fiber")),
"Macro"=checkboxGroupInput("kind", "kind of macro:",
choices = c("Cigarretes", "Pellets"),
selected=c("Cigarretes", "Pellets"))
)
})
#### reactive table to filter data to map ####
table <- reactive({
if(input$data.type=="Localisations"){
return(sites)
}
else if (input$data.type=="Micro") {
if (is.null(input$position))
return(NULL)
if (!is.null(input$position))
micro <-micro[micro$Position==input$position,]
micro<-micro[micro$Kind %in% input$kind,]
micro <- micro %>%
group_by(Site, Lat, Long, Position)%>%
summarise(Amount=sum(Amount))
micro
}
else if (input$data.type=="Macro") {
if (is.null(input$position))
return(NULL)
if (!is.null(input$position))
macro <-macro[macro$Position==input$position,]
macro<-macro[macro$Kind %in% input$kind,]
macro <- macro %>%
group_by(Site, Lat, Long, Position)%>%
summarise(Amount=sum(Amount))
macro
}
})
#### table with filtered data ####
output$table <- renderDataTable({
table()
})
#### base map ####
output$map <- renderLeaflet({
leaflet(sites) %>%
setView(lat=55, lng=17, zoom=6) %>%
addProviderTiles(providers$Esri.WorldImagery) %>%
addCircleMarkers(lng=~Long, lat=~Lat, label=~Site,
labelOptions = labelOptions(noHide =T))
})
#### updating the map #####
observeEvent( c( input$data.type, input$position, input$kind), {
if(input$data.type=="Localisations"){
leafletProxy("map", data=sites) %>%
clearMarkers() %>%
clearShapes()%>%
addCircleMarkers(lng=~Long, lat=~Lat, label=~Site,
labelOptions = labelOptions(noHide =T), fillColor = "red")
}
else if (input$data.type=="Micro") {
if (is.null(input$position))
return(NULL)
if (is.null(input$kind))
return(NULL)
###########################################################
####### and here 4 new line that did all the job #########
if (input$position %in% c("Macro_pos1", "Macro_pos2"))
return(NULL) ## new line
if (input$kind %in% c("Cigarretes", "Pellets"))
return(NULL)
####################################################
leafletProxy("map", data=table()) %>%
clearMarkers() %>%
clearShapes()%>%
addCircles(lng=~Long, lat=~Lat, label=~Site, color="white", fill="white",
labelOptions = labelOptions(noHide =T),
radius = ~Amount*1000) %>%
addLabelOnlyMarkers(lng=~Long, lat=~Lat, label=~as.character(Amount),
labelOptions = labelOptions(noHide = T, direction = 'top', textOnly = T, textsize="20px"))
}
else if(input$data.type=="Macro") {
if (is.null(input$position))
return(NULL)
if (is.null(input$kind))
return(NULL)
###########################################################
####### and here 4 new line that did all the job #########
if (input$position %in% c("Micro_pos1", "Micro_pos2"))
return(NULL)
if (input$kind %in% c("blue_fiber", "red_fiber"))
return(NULL)
##############################################
leafletProxy("map", data=table()) %>%
clearMarkers() %>%
clearShapes()%>%
addCircles(lng=~Long, lat=~Lat, label=~Site, color="white", fill="white",
labelOptions = labelOptions(noHide =T),
radius = ~Amount*1000) %>%
addLabelOnlyMarkers(lng=~Long, lat=~Lat, label=~as.character(Amount),
labelOptions = labelOptions(noHide = T, direction = 'top', textOnly = T, textsize="20px"))
}
})
### server end
}
# Run the application
shinyApp(ui = ui, server = server)
- 我写了这段代码，但我无法理解我的错误
- 我无法从一个代码实例的列表中删除 None 值，但我可以在另一个实例中。为什么它适用于一个细分市场而不适用于另一个细分市场？
- 是否有可能使 loadstring 不可能等于打印？卢阿
- java中的random.expovariate()
- Appscript 通过会议在 Google 日历中发送电子邮件和创建活动
- 为什么我的 Onclick 箭头功能在 React 中不起作用？
- 在此代码中是否有使用“this”的替代方法？
- 在 SQL Server 和 PostgreSQL 上查询，我如何从第一个表获得第二个表的可视化
- 每千个数字得到
- 更新了城市边界 KML 文件的来源？