[英]How to build a dynamic filter in R Shiny?
我正在构建一个具有上载功能和类别变量过滤功能的应用程序。 这样,用户可以通过指定列和值来进行一些数据操作。 但是,过滤器功能不起作用。 该代码简化如下:
#ui.R
library(shiny)
fluidPage(
titlePanel("Test Dynamic Column Selection"),
sidebarLayout(
sidebarPanel(
fileInput('file1', 'Choose CSV File',
accept=c('text/csv',
'text/comma-separated-values,text/plain',
'.csv')),
hr(),
checkboxInput('header', 'Header', TRUE),
radioButtons('sep', 'Separator',
c(Comma=',',
Semicolon=';',
Tab='\t'),
','),
hr(),
uiOutput("choose_columns"),
hr(),
uiOutput("choose_column"),
textInput('column_value', label = 'Value'),
actionButton('filter', label = 'Filter')
),
mainPanel(
tableOutput('contents')
)
)
)
#server.R
library(shiny)
function(input, output) {
uploaded_data <- reactive({
inFile <- input$file1
read.table(inFile$datapath, header=input$header, sep=input$sep, quote=input$quote)
})
react_vals <- reactiveValues(data = NULL)
output$choose_columns <- renderUI({
if(is.null(input$file1))
return()
colnames <- names(react_vals$data)
checkboxGroupInput("choose_columns", "Choose columns",
choices = colnames,
selected = colnames)
})
output$choose_column <- renderUI({
if(is.null(input$file1))
return()
is_factor <- sapply(react_vals$data, is.factor)
colnames <- names(react_vals$data[, is_factor])
selectInput("choose_column", "Choose column", choices = colnames)
})
observeEvent(input$file1, react_vals$data <- uploaded_data())
observeEvent(input$choose_columns, react_vals$data <- react_vals$data[, input$choose_columns])
# This line of code does not work :(
observeEvent(input$filter, react_vals$data <- subset(react_vals$data, input$choose_column != input$column_value))
output$contents <- renderTable(react_vals$data)
}
我认为您的应用存在多个问题,我尝试逐步解释一下:
input$choose_columns
依赖于react_vals$data
反应值,因此当取消选中复选框时,Shiny会为少用的一栏为react_vals$data
分配一个新值,然后重新渲染input$choose_columns
UI,从而减少一个复选框可用。 (与input$choose_column
selectInput
) 您的代码:
colnames <- names(react_vals$data)
替换代码:
colnames <- names(uploaded_data())
req()
。这是最佳实践。 您的代码:
if(is.null(input$file1)) return()
替换代码:
req(input$file1)
input$choose_column
和input$column_value
两个字符串进行比较来进行子集化。 即:“列名A”!=“值:某物”
通常每行返回TRUE
,并且最终根本不进行过滤。
我想出了两种解决方案,它们有些丑陋,因此,如果有人想出更好的解决方案,请随时发表评论/编辑。
#server.R
library(shiny)
function(input, output) {
uploaded_data <- reactive({
inFile <- input$file1
read.table(inFile$datapath, header=input$header, sep=input$sep, quote=input$quote)
})
react_vals <- reactiveValues(data = NULL)
output$choose_columns <- renderUI({
req(input$file1)
colnames <- names(uploaded_data())
checkboxGroupInput("choose_columns", "Choose columns",
choices = colnames,
selected = colnames)
})
output$choose_column <- renderUI({
req(input$file1)
is_factor <- sapply(uploaded_data(), is.factor)
colnames <- colnames(uploaded_data()[is_factor])
selectInput("choose_column", "Choose column", choices = colnames)
})
observeEvent(input$file1, react_vals$data <- uploaded_data())
observeEvent(input$choose_columns, react_vals$data <- uploaded_data()[, input$choose_columns])
observeEvent(input$filter, {
react_vals$data <-
#Option A
eval(parse(text = sprintf("subset(uploaded_data(), %s != '%s')", input$choose_column, input$column_value)))
#Option B
#subset(uploaded_data(), uploaded_data()[, which(names(uploaded_data()) == input$choose_column)] != input$column_value)
})
output$contents <- renderTable(react_vals$data)
}
shinyApp(ui, server)
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.