使用动态菜单时，闪亮的传单无法正常工作
问题描述 投票：0回答：2
我一直在努力解决这个问题，但没有成功。我想用桌子和地图构建一个闪亮的交互式应用程序。它结合了不同的数据集。我们的想法是能够选择所需的数据集并过滤此数据集中的数据并在地图上呈现它们。
我设法建立了一个交互式菜单和反应过滤功能，但是我的传单地图有问题。当我在某些数据集之间切换时，它会崩溃。我只能在localisations-macro或localisations-micro之间切换，但是当我在micro和macro之间切换时它会工作（见下图）。
这个问题与错误有关：Warning: Error in sum: invalid 'type' (list) of argument但我现在知道如何解决这个问题。
我也在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)
2个回答
1
投票
投票
问题是时机：
- 当您从微切换到宏时，输入$ kind仍设置为仅适用于micro的值
- 然后调用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 < - 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"))
),
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()
})
0
投票
投票
非常感谢@ ge.org的努力，但是使用峰值按钮的解决方案并不适合我的应用程序，因为在真正的应用程序中我有更多的类别，并且每次用户登顶更改都会很尴尬。但是由于你对时间的评论，我设法绕过了edditig observeEvent。我将它分为三个单独的条件，每个data.type和负责微观和宏的条件我添加了新条件，以省略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)
最新问题
- 如何在不遇到sqlite3.InterfaceError的情况下将文件路径添加到SQLite3数据库中？
- PyQt6安装成功但无法导入
- 自动完成代码在 Visual Studio 2022 中使用错误的代码样式设置
- 如何使用纯 JavaScript（没有 JS 框架）从表单中选择所有复选框？
- 为多元逻辑回归创建森林图
- 在 CSS 中设置文本的插入阴影样式
- 在 WinUI 3 用户控件中相对于相对面板内的另一个文本块定位 TextBlock
- 类型错误：无法读取未定义的 CryptoJS 的属性“0”
- 全局 CSS 未在 Next JS 中使用 SSG 正确加载 - CORS 错误？
- 如何修复 AttributeError: 'NoneType' 对象没有属性 'bot'？
- 为每个主题而不是每个团队分配泳道
- 如何获得软键盘自动更正建议？
- 尝试从链接下载 PDF 时返回状态 404
- 列表图块和自定义选项卡栏采用相同的宽度
- 使用 bot.run() 运行机器人时处理互联网连接错误
- 如果单元格值更改且不为空，则显示 MsgBox
- 如何创建自动设置编解码器（类型转换器）的 asyncpg 池？
- 如何使用 c8 排除 *.spec.mjs？
- 在node.js中使用tty生成子进程
- 同时设置多个标记的不透明度
© www.soinside.com 2019 - 2024. All rights reserved.