我的问题是从数据库中过滤出一个方便的表。我设法整理好数据库，并且用户可以交互地过滤列（不在示例代码中）。然后，用户可以选择列，然后可以在其中选择要过滤的类别。然后我被卡住了，因为我无法将所选类别应用于表格。之后下载应该不是问题，但是我不明白这一点。我在下面的链接R Shiny: nested observe functions中使用了代码，并进行了后续搜索，但没有得到答案。我试图直接命名变量，但这不是解决方案，也不起作用。我将非常感谢您提出任何建议。
# The application is based on the blog:
# https://stackoverflow.com/questions/40732767/r-shiny-nested-observe-functions
# The code is reduced to the lines where the problem is but contains also some lines as solutions which
# do not work but could help in answering my question
library(shiny)
library(dplyr)
ui <- fluidPage(
titlePanel("Select rows"),
pageWithSidebar(
headerPanel(""),
sidebarPanel(),
mainPanel(
tags$script("$(document).on('click', '.dynamicSI button', function () {
var id = document.getElementById(this.id).getAttribute('data');
var name = document.getElementById(this.id).getAttribute('name');
Shiny.onInputChange('lastSelectId',id);
Shiny.onInputChange('lastSelectName',name);
// to report changes on the same selectInput
Shiny.onInputChange('lastSelect', Math.random());
});"),
actionButton("showtab", "show table"),
uiOutput("FILTERS"),
hr(),
uiOutput("FILTER_GROUP"),
hr(),
verbatimTextOutput("L")
,
tableOutput('tidyrows')
)
)
)
# increased size of upload
server <- function(input, output, session) {
options(shiny.maxRequestSize=30*1024^2)
# here I would provide a table which was already heavily filtered. But to make it clear I use "iris"
dt3 <- reactive({ data <- iris
data})
# here the code from https://stackoverflow.com/questions/40732767/r-shiny-nested-observe-functions starts
output$FILTERS = renderUI({
selectInput("filters","Filters",choices = names(dt3()),multiple = TRUE)
})
observe({
req(input$filters)
filter_names = input$filters
# count how many filters I selected
n = length(filter_names)
# to render n selectInput
lapply(1:n,function(x){
output[[paste0("FILTER_",x)]] = renderUI({
req(input$filters)
div( class = "dynamicSI",
selectInput(paste0("filter_",x),
paste0(filter_names[x]),
choices = unique(dt3()[,filter_names[x]]),
multiple = TRUE,
selected = unique(dt3()[,filter_names[x]])
),
actionButton(paste0("filter_all_",x),"(Un)Select All",
data = paste0("filter_",x), # selectInput id
name = paste0(filter_names[x])) # name of column
)
})
})
output$FILTER_GROUP = renderUI({
div(class="dynamicSI",
lapply(1:n, function(i){
uiOutput(paste0("FILTER_",i))
})
)
})
})
observeEvent(input$lastSelect, {
if (!is.null(input$lastSelectId)) {
cat("lastSelectId:", input$lastSelectId, "\n")
cat("lastSelectName:", input$lastSelectName, "\n")
}
# selectInput id
Filter = input$lastSelectId
# column name of dataset, (label on select input)
NAME = input$lastSelectName
choices = unique(dt3()[,NAME])
if (length(input[[Filter]]) == 0) {
# in corresponding selectInput has no elements selected
updateSelectInput(
session = session, inputId = Filter, selected = as.character(choices)
)
} else {
# has at least one element selected
updateSelectInput(
session = session, inputId = Filter, selected = ""
)
}
})
output$L = renderPrint({
input$lastSelectId
})
# this is my last try with another dataset; I tried to name the variables directly but was not successful
output$tidyrows <- renderTable({ # eventReactive(input$showtab, {
data <- dt3()
data2 <- eventReactive( input$showtab, {
uni <- unique(as.character(data$Sepal.Length))
updateSelectInput(session, "Sepal.Length","Sepal.Length", choices = uni)
uni2 <- unique(as.character(data$Petal.Length))
updateSelectInput(session, "Petal.Length","Petal.Length", choices = uni2)
data <- data[which(data$Sepal.Length == input$Sepal.Length &
data$Petal.Length == input$Petal.Length ), ]
data
})
test <- data2()
data2()
})
}
# Run the application
shinyApp(ui = ui, server = server)*