根据另一个输入r更改输入值
在服务器功能中，我有observe sinppet，其中有plot和datatable输出因变量，它们根据输入变量过滤数据。
现在输出图和数据表可以正常工作，并且符合预期，但是我希望其他下拉输入在更改任何其他选择器输入中的任何值时做出反应。
如果我在observe中包含renderUI，则一切都将中断，因为在初始化时，所有其他输入均为null，因此过滤器数据将返回No records。
我是否必须为每个输入编写observeEvent函数并更新其他每个输入？还是有另一种方法？
最后，我希望pickerinput像Excel中的切片器一样工作。
server <- function(input, output) {
observe({
#filter data
bData <- dplyr::filter(bData, Crncy %in% input$selCrncy)
bData <- dplyr::filter(bData, bData$`AXE?` %in% input$selAxe)
bData <- dplyr::filter(bData, bData$`Owned?` %in% input$selOwned)
bData <- dplyr::filter(bData, bData$Floater %in% input$selFloater)
bData <- dplyr::filter(bData, bData$`Collateral Type` %in% input$selCollateralType)
bData <- dplyr::filter(bData, bData$`Maturity Type` %in% input$selMaturityType)
bData <- dplyr::filter(bData, bData$`Issuer Name` %in% input$selIssuerName)
bData <- dplyr::filter(bData, bData$Sector %in% input$selSector)
bData <- subset(bData, bData$MatYear >= input$dtrng[1] & bData$MatYear <= input$dtrng[2])
#Scatter Plot
output$OPlot<-renderPlotly({
p <- plot_ly(data = bData, x = ~`Maturity Date`, y = ~YVal, type = 'scatter', mode='markers',
color = ~Crncy, colors = setNames(rainbow(nrow(bData)), bData$Crncy),
marker = list(opacity = 0.7, size=12) ,
text = ~paste(" Security: ", bData$Security, "<br>",
"Currency: ", bData$Crncy, "<br>",
"YTM: ", bData$YTM,"<br>",
"DM: ", bData$DM)) %>%
layout(xaxis = list(title="Maturity"),
yaxis = list(title="FRN: DM | Fixed: YAS ASW USD")) %>%
add_markers(symbol = ~factor(bData$Sym),color = I("black"), marker = list( opacity = 1, size=6))
#add_markers(symbol = ~factor(bData$Sym),symbols = c('circle-open','x-open','diamond-open'),color = I("black"), marker = list( opacity = 1, size=9))
})
#Data table output
output$datatbl = DT::renderDataTable(
bData,
options = list(scrollX = TRUE)
)
})
output$dateUIOP <- renderUI({
sliderInput("dtrng", "Year Range:",
min=min(bData$MatYear), max=max(bData$MatYear),
value = c(min(bData$MatYear),max=max(bData$MatYear))
)
})
output$selCrncyUIOP <- renderUI({
pickerInput("selCrncy","Currency", choices=unique(bData$Crncy),
selected = unique(bData$Crncy),
options = list(`actions-box` = TRUE),multiple = T)
})
output$selAxeUIOP <- renderUI({
pickerInput("selAxe","Axe?", choices=unique(bData$`AXE?`),
selected = unique(bData$`AXE?`),
options = list(`actions-box` = TRUE),multiple = T)
})
2 个答案:
答案 0 :(得分：2)
您应该使用reactive()而不是observe()来过滤数据。在输入选择器准备就绪之前，使用req()静默阻止反应堆发出错误。
filtered_data <- reactive({
req(input$selCrncy, input$selAxe, input$selOwned, input$selFloater, input$selCollateralType, input$selMaturityType, input$selIssuerName, input$selSector, input$dtrng)
bData %>%
filter(Crncy %in% input$selCrncy,
bData$`AXE?` %in% input$selAxe,
bData$`Owned?` %in% input$selOwned,
bData$Floater %in% input$selFloater,
bData$`Collateral Type` %in% input$selCollateralType,
bData$`Maturity Type` %in% input$selMaturityType,
bData$`Issuer Name` %in% input$selIssuerName,
bData$Sector %in% input$selSector,
bData$MatYear >= input$dtrng[1],
bData$MatYear <= input$dtrng[2])
})
output$datatbl = DT::renderDataTable(
filtered_data(),
options = list(scrollX = TRUE)
)
还可以在data = filtered_data()命令中使用data = bData代替renderPlotly。
我不确定您希望选择器如何根据其他选择器进行更改，但是renderUI绝对是这样做的方法。如果您希望一个选择器依赖于另一个选择器，请使用req()使其停止渲染，直到另一个选择器准备就绪。
答案 1 :(得分：2)
OP表示他们想要Excel样式的切片器，也类似于QlikView中的列表框。这些允许用户过滤出现在应用程序其余部分中的数据，还可以对其他过滤器中的选择做出反应。我认为这是一个有趣的挑战，因此我制作了以下原型。
library(tidyverse)
library(shiny)
library(reactable)
my_mpg <- mpg %>%
mutate(across(c(manufacturer, class, cyl), ~factor(., ordered = TRUE)))
ui <- fluidPage(
fluidRow(
column(4, reactableOutput("manufacturer_slicer")),
column(4, reactableOutput("class_slicer")),
column(4, reactableOutput("cyl_slicer"))
),
plotOutput("scatterplot")
)
server <- function(input, output, session){
user_selections <- reactiveValues(manufacturer = levels(my_mpg$manufacturer),
class = levels(my_mpg$class),
cyl = levels(my_mpg$cyl))
output$manufacturer_slicer <- renderReactable({
my_mpg %>%
group_by(manufacturer) %>%
summarize(`# Rows` = n(),
`Total cty` = sum(cty), .groups = "drop") %>%
arrange(manufacturer) %>%
reactable(sortable = TRUE, searchable = TRUE, compact = TRUE, highlight = TRUE,
selection = "multiple", onClick = "select", defaultSelected = 1:length(levels(my_mpg$manufacturer)))
})
output$class_slicer <- renderReactable({
my_mpg %>%
group_by(class) %>%
summarize(`# Rows` = n(),
`Total cty` = sum(cty), .groups = "drop") %>%
reactable(sortable = TRUE, searchable = TRUE, compact = TRUE, highlight = TRUE,
selection = "multiple", onClick = "select", defaultSelected = 1:length(levels(my_mpg$class)))
})
output$cyl_slicer <- renderReactable({
my_mpg %>%
group_by(cyl) %>%
summarize(`# Rows` = n(),
`Total cty` = sum(cty), .groups = "drop") %>%
reactable(sortable = TRUE, searchable = TRUE, compact = TRUE, highlight = TRUE,
selection = "multiple", onClick = "select", defaultSelected = 1:length(levels(my_mpg$cyl)))
})
observeEvent(getReactableState("manufacturer_slicer", "selected"), priority = 20, {
user_selections$manufacturer <- levels(my_mpg$manufacturer)[getReactableState("manufacturer_slicer", "selected")]
})
observeEvent(getReactableState("class_slicer", "selected"), priority = 20, {
user_selections$class <- levels(my_mpg$class)[getReactableState("class_slicer", "selected")]
})
observeEvent(getReactableState("cyl_slicer", "selected"), priority = 20, {
user_selections$cyl <- levels(my_mpg$cyl)[getReactableState("cyl_slicer", "selected")]
})
filtered_data <- reactive({
my_mpg %>%
filter(manufacturer %in% user_selections$manufacturer,
class %in% user_selections$class,
cyl %in% user_selections$cyl)
})
output$scatterplot <- renderPlot({
filtered_data() %>%
ggplot(aes(x=displ, y = hwy)) +
geom_point()
})
observeEvent(filtered_data(), priority = 10, {
req(filtered_data())
new_manufacturer_data <- filtered_data() %>%
group_by(manufacturer) %>%
summarize(`# Rows` = n(),
`Total cty` = sum(cty), .groups = "drop") %>%
complete(manufacturer, fill = list(`# Rows` = 0, `Total cty` = 0)) %>%
arrange(manufacturer)
new_manufacturer_selected <- which(new_manufacturer_data$manufacturer %in% user_selections$manufacturer)
new_manufacturer_page = getReactableState("manufacturer_slicer", "page")
new_class_data <- filtered_data() %>%
group_by(class) %>%
summarize(`# Rows` = n(),
`Total cty` = sum(cty), .groups = "drop") %>%
complete(class, fill = list(`# Rows` = 0, `Total cty` = 0)) %>%
arrange(class)
new_class_selected <- which(new_class_data$class %in% user_selections$class)
new_class_page = getReactableState("class_slicer", "page")
new_cyl_data <- filtered_data() %>%
group_by(cyl) %>%
summarize(`# Rows` = n(),
`Total cty` = sum(cty), .groups = "drop") %>%
complete(cyl, fill = list(`# Rows` = 0, `Total cty` = 0)) %>%
arrange(cyl)
new_cyl_selected <- which(new_cyl_data$cyl %in% user_selections$cyl)
new_cyl_page = getReactableState("cyl_slicer", "page")
updateReactable("manufacturer_slicer", data = new_manufacturer_data, selected = new_manufacturer_selected, page = new_manufacturer_page)
updateReactable("class_slicer", data = new_class_data, selected = new_class_selected, page = new_class_page)
updateReactable("cyl_slicer", data = new_cyl_data, selected = new_cyl_selected, page = new_cyl_page)
})
}
shinyApp(ui = ui, server = server)
这种情况的一个问题是循环逻辑，该循环逻辑可能导致无休止的反应级联。我将用户的选择保存在reactiveValues中以断开链。我使用observeEvent首先更新user_selections对象中保存的选择，然后更新切片器UI元素。 priority设置可确保在进行任何更新之前先保存用户的选择。
切片器可以包含来自数据的统计信息，这些信息告诉用户有关当前过滤上下文中不同列值的相关性。这些应根据业务逻辑进行更改。 # Rows告诉用户该值是否出现在过滤数据中。
我对列使用排序因子，因为我担心reactable是指行索引，而不是值本身。
我对复制粘贴的样板数量不满意，但这应该可以帮助您入门。
相关问题
最新问题
- 我写了这段代码，但我无法理解我的错误
- 我无法从一个代码实例的列表中删除 None 值，但我可以在另一个实例中。为什么它适用于一个细分市场而不适用于另一个细分市场？
- 是否有可能使 loadstring 不可能等于打印？卢阿
- java中的random.expovariate()
- Appscript 通过会议在 Google 日历中发送电子邮件和创建活动
- 为什么我的 Onclick 箭头功能在 React 中不起作用？
- 在此代码中是否有使用“this”的替代方法？
- 在 SQL Server 和 PostgreSQL 上查询，我如何从第一个表获得第二个表的可视化
- 每千个数字得到
- 更新了城市边界 KML 文件的来源？