使用动态菜单时，闪亮的传单无法正常工作
问题描述 投票：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)
最新问题
- 如何在Android中加载Flutter资源
- 更改传递给 Python 函数的变量的内容。从变量创建引用的语法糖？
- SSRS - 导航到链接的网站或报告时，然后导航回来，丢失滚动位置和参数
- Azure AD Connect“无法验证凭据”
- 有什么方法可以通过CSS从SVG背景图像中删除/禁用feFilter吗？
- GCP Cloud Run 抱怨“无法打开文件 '/app/main.py'：[Errno 2] 没有这样的文件或目录”
- 下一个js应用程序路由器，如果已经登录则重定向到主页
- SSH和github如何确定用户名？
- Authjs 的 OAuth 的 Google 提供商无法在 Nextjs 中工作
- TizenBrew 错误，安装失败 检查证书错误::签名中包含证书的证书链无效。:<-3>
- 在groupByKey或groupBy之后形成列列表
- 检测字符串中的字符是否是表情符号（使用Android）
- 动态生成具有静态内容的函数
- 在 React 中从 AWS S3 预签名 url 下载文件
- 同步递归合并两个多维数组以并排显示值
- 使用本地端的 sudo 权限和我的个人 SSH 密钥，通过 SSH 将远程文件同步到我的本地计算机
- flutter 未安装在我的树莓派上
- Spark 可以在 Macbook M4 Pro 上运行吗
- 如何查看mysql更新查询是否成功？
- JavaScript 错误：指定的参数超出了有效值的范围
© www.soinside.com 2019 - 2024. All rights reserved.