Shiny Dynamic Filter 变量选择和显示变量值供选择 [英] Shiny Dynamic Filter variable selection and display of variable values for selection
问题描述
我仍在学习 Shiny 和 R，感觉这是一片大海，我仍然需要学习很多东西.如果我的编码方法不理想，请见谅，并建议可以即兴编写代码的地方.
我正在创建这个应用程序，我需要在其中生成交叉表和图表.我需要过滤用户选择的数据基础变量，并根据需要更新表格和图表.
例如，如果用户选择Store_location"作为过滤器变量，我想用复选框在其下方显示此变量的值列表，所以
loc1位置2loc3loc4
应该与复选框一起显示，并且用户可以选择这些值中的一个/多个.在此基础上，我的数据应该得到过滤.因此，如果用户选择 loc1 和 loc2，则应根据条件过滤数据 (Store_location == "loc1" | Store_location == "loc2")
一旦用户取消选中复选框或选择不同的变量进行过滤，相应的数据以及交叉表和图表应该会得到更新.我相信这应该可以在 Shiny 中完成，我试图使用 checkboxGroupInput 但无法传递选定的变量，因此出现错误.目前已对此进行评论，以便代码运行.我创建了一个 CSV 格式的示例数据，并在应用程序中读取.数据很大，因此使用 data.table fread 来读取数据.所以任何子设置都需要在 data.table 中完成.单击为分析准备数据"按钮时，我会重新格式化/创建变量.为此，我使用了observeEvent({}) 并且我所有的renderTable/renderplot 都在这个事件中.我觉得会有更好的方法来处理这个问题.如果是，请提出建议.
最后，我的下载器给了我错误，gList"中只允许使用grobs""，有时还会出现替换有 17 行，数据有 0"之类的错误.我想用交叉表生成一个 pdf 文件，并在另一个下面绘制一个.请建议我哪里出错了.
可以在此处找到示例数据 - 总而言之，需要您的帮助才能运行此应用程序 - 动态显示所选过滤变量的值并过滤数据，以便更新交叉表和图.注意数据很大并且在data.table中 下载器以 pdf 格式下载输出. 谢谢！！ 这是一种根据所需列的选定值对数据框进行子集化的方法. 虽然我真的不明白你想用行和列选择输入做什么. I am still learning Shiny and R and feel it is a sea where I still need to learn quite a lot. Please excuse me if my method of coding is not ideal and do suggest where the code can be improvised. I am creating this app where I need to generate cross tabs and charts. I need to filter my data basis variable selected by the user and based on that the tables and charts need to get updated. So for example if user selects "Store_location" as the filter variable, I want to display the list of values for this variable below it with check box, so loc1
loc2
loc3
loc4 should get displayed with checkbox, and user can select single / multiple of these values. Basis this my data should get filtered. So if user selects loc1 and loc2, data should get filtered based on the condition (Store_location == "loc1" | Store_location == "loc2") Once the user unchecks a checkbox OR selects a different variable for filter, accordingly the data should get updated and the crosstabs and charts. I believe this should be possible to be done in Shiny, I was trying to use checkboxGroupInput but not able pass the variable selected and hence getting errors. Currently have commented this so that the code runs. I have created a sample data which is in CSV format and is been read in the app. Data is huge and hence using data.table fread to read the data. So any sub-setting would need to be done in data.table. I do some reformatting / creating of variables when the button "Prepare data for Analysis" is clicked. For this I am using the observeEvent({}) and all my renderTable / renderplot are inside this event. I feel there would be a better way to handle this. If yes do suggest. Finally, my downloader is giving me error, "only 'grobs' allowed in "gList"" and sometimes error like "replacement has 17 rows, data has 0". I want generate a pdf file with the crosstabs and plot one below the other. Do suggest where I am going wrong. Sample data can be found here - sample data Below is the code snippet for my app - So to summarize, need to your help to run this app for - Dynamic display of values for the filter variable selected and filter the data so that crosstabs and plots get updated. Note data is big and in data.table Downloader to download the outputs in pdf format. Thank you!! Here is a way to subset your data frame in function of selected values for the desired column. I didn't really understand what you wanted to do with the row and column select input though.
这篇关于Shiny Dynamic Filter 变量选择和显示变量值供选择的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！ui <- navbarPage("My Shiny App",tabPanel("洞察力",侧边栏面板(fileInput("file1", "选择输入数据"),selectInput("filtervar", "选择过滤变量", NULL),checkboxGroupInput("filteroptions", "过滤器选项", NULL)),主面板(tabsetPanel(id = "mytabs",tabPanel("数据", tableOutput("table.output"))))))服务器 <- 功能(输入，输出，会话){值 <-reactiveValues()观察({文件 <- 输入 $file1如果(is.null(文件))返回()values$data <- fread(file$datapath)vars <- 名称(值$数据)更新选择输入(会话，过滤器变量"，选择 = 变量)})观察({数据 <- 隔离(值$数据)filter.var <- 输入$filtervarif (is.null(filter.var) || filter.var == "")返回()值 <- 数据[[filter.var]]如果(is.factor(values)){选项 <- 级别(值)} 别的 {选项 <- 唯一(值[订单(值)])}updateCheckboxGroupInput(会话，过滤器选项"，选择 = 选项，selected = as.character(options))})output$table.output <- renderTable({隔离({数据 <- 值$数据var <- 输入$filtervar})值 <- input$filteroptions如果(is.null(数据)){返回()} else if (is.null(var) || var == "") {返回(数据)} else if (is.null(values)) {返回(数据[假])} 别的 {if (is.numeric(data[[var]]))值 <- as.numeric(values)setkeyv(数据，无功)返回(数据[.(值)])}})}闪亮应用(用户界面 = 用户界面，服务器 = 服务器)library("shiny")
library("shinythemes")
library("tools")
library("readxl")
library("data.table")
library("bit64")
library("gmodels")
library("ggplot2")
library("plotly")
library("gridExtra")
### User Interface
ui <- shinyUI(
navbarPage('My Shiny App',
tabPanel("Insights",
sidebarPanel(
fileInput('file1', 'Choose input data',
accept=c('text/csv', 'text/comma-separated-values,text/plain', '.csv')),
tags$hr(),
actionButton(inputId = 'run1', label = "Prepare data for Analysis"),
tags$br(),
tags$br(),
fluidRow(
column(10,
div(style = "font-size: 13px;", selectInput("filtervar", label = "Select Filter Variable", ''))
),
tags$br(),
tags$br(),
wellPanel(
# checkboxGroupInput("filteroptions", "Filter Options", choices = sort(unique(fil)))
),
column(10,
div(style = "font-size: 13px;", selectInput("rowvar", label = "Select Row Variable", ''))
),
tags$br(),
tags$br(),
column(10,
div(style = "font-size: 13px;", selectInput("columnvar", "Select Column Variable", ''))
)),
downloadButton('export',"Download Outputs")
)
,
mainPanel(
tabsetPanel(id='mytabs',
tabPanel("Data", tags$b(tags$br("Below is the top 6 rows of the data prepared" )),tags$br(),tableOutput("table.output")),
tabPanel("Table",tags$b(tags$br("Table Summary" )),tags$br(),tableOutput("crosstab1"),tags$br(),verbatimTextOutput("datatab1")),
tabPanel("Chart",tags$b(tags$br("Graphical Output" )),tags$br(),plotlyOutput("plot1"))
)
)),
tabPanel("Help")
))
server <- shinyServer(function(input, output,session){
#Below code is to increase the file upload size
options(shiny.maxRequestSize=1000*1024^2)
observeEvent(input$run1,{
updateTabsetPanel(session = session
,inputId = 'myTabs')
inFile <- input$file1
if (is.null(inFile))
return(NULL)
data_input <- fread(inFile$datapath)
data_input[,`:=` (YN2014 = ifelse(Year == "Y2014",1,0),YN2015 = ifelse(Year == "Y2015",1,0))]
## vals will contain all plot and table grobs
vals <- reactiveValues(t1=NULL,t2=NULL,t3=NULL,p1=NULL,p2=NULL)
output$table.output <- renderTable({
# top6rows
head(data_input)
})
s <- reactive(
data_input
)
observe({
updateSelectInput(session, "rowvar", choices = (as.character(colnames(data_input))),selected = "Store_location")
})
observe({
updateSelectInput(session, "columnvar", choices = (as.character(colnames(data_input))),selected = "Year")
})
observe({
updateSelectInput(session, "filtervar", choices = (as.character(colnames(data_input))),selected = "Store_location")
})
output$conditionalInput <- renderUI({
if(input$checkbox){
selectInput("typeInput", "Product type",
choices = sort(unique(input$filtervar)))
}
})
output$crosstab1 <- renderTable({
validate(need(input$rowvar,''),
need(input$columnvar,''))
vals$t1 <- addmargins(xtabs(as.formula(paste0("~",input$rowvar,"+",input$columnvar)), s()))
},caption = "<b>Cross-Tab - 1</b>",
caption.placement = getOption("xtable.caption.placement", "top"),
caption.width = getOption("xtable.caption.width", 200))
output$datatab1 <- renderPrint({
validate(need(input$rowvar,''),
need(input$columnvar,''))
vals$t2 <- as.data.frame(with(s(), CrossTable(get(input$rowvar),get(input$columnvar),max.width = 1,prop.c = T,prop.r = F,prop.t = F,prop.chisq = F,chisq = F,format = "SPSS",dnn = c(input$rowvar,input$columnvar))))
})
#plotting theme
.theme<- theme(
axis.line = element_line(colour = 'gray', size = .75),
panel.background = element_blank(),
plot.background = element_blank()
)
output$plot1 <- renderPlotly({
vals$p1 <- ggplot(data_input, aes(get(input$rowvar), ..count..)) +
geom_bar(aes(fill = get(input$columnvar)), position = "dodge") +
theme(axis.text.x=element_text(angle=90, hjust=1),
axis.line = element_line(colour = 'gray', size = .75),
panel.background = element_blank(),
plot.background = element_blank()) +
xlab(input$rowvar) +
ylab("Frequency") +
labs(fill=input$columnvar)
})
## clicking on the export button will generate a pdf file
## containing all grobs
output$export = downloadHandler(
filename = function() {paste0("RES_Insights_Outputs_",Sys.Date(),".pdf")},
content = function(file) {
pdf(file, onefile = TRUE)
grid.arrange(vals$t1,vals$p1)
dev.off()
}
)
})
})
shinyApp(ui = ui, server = server)
ui <- navbarPage("My Shiny App",
tabPanel("Insights",
sidebarPanel(
fileInput("file1", "Choose input data"),
selectInput("filtervar", "Select Filter Variable", NULL),
checkboxGroupInput("filteroptions", "Filter Options", NULL)
),
mainPanel(
tabsetPanel(id = "mytabs",
tabPanel("Data", tableOutput("table.output"))
)
)
)
)
server <- function(input, output,session) {
values <- reactiveValues()
observe({
file <- input$file1
if (is.null(file))
return()
values$data <- fread(file$datapath)
vars <- names(values$data)
updateSelectInput(session, "filtervar", choices = vars)
})
observe({
data <- isolate(values$data)
filter.var <- input$filtervar
if (is.null(filter.var) || filter.var == "")
return()
values <- data[[filter.var]]
if (is.factor(values)) {
options <- levels(values)
} else {
options <- unique(values[order(values)])
}
updateCheckboxGroupInput(session, "filteroptions",
choices = options,
selected = as.character(options))
})
output$table.output <- renderTable({
isolate({
data <- values$data
var <- input$filtervar
})
values <- input$filteroptions
if(is.null(data)) {
return()
} else if (is.null(var) || var == "") {
return(data)
} else if (is.null(values)) {
return(data[FALSE])
} else {
if (is.numeric(data[[var]]))
values <- as.numeric(values)
setkeyv(data, var)
return(data[.(values)])
}
})
}
shinyApp(ui = ui, server = server)
