Shiny Dynamic Filter 变量选择和变量值显示以供选择 [英] Shiny Dynamic Filter variable selection and display of variable values for selection
问题描述
我还在学习 Shiny 和 R，感觉它是一片大海，我仍然需要学习很多东西.如果我的编码方法不理想，请见谅，并建议在哪里可以即兴编写代码.
我正在创建这个需要生成交叉表和图表的应用程序.我需要过滤用户选择的数据基础变量，并根据需要更新表格和图表.
例如，如果用户选择Store_location"作为过滤器变量，我想在其下方显示该变量的值列表并带有复选框，所以
loc1位置2位置 3loc4
应该用复选框显示，用户可以选择单个/多个这些值.基于此，我的数据应该被过滤.因此，如果用户选择 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", "Filter Options", NULL)),主面板(tabsetPanel(id = "mytabs",tabPanel("数据", tableOutput("table.output"))))))服务器 <- 功能(输入，输出，会话){值 <-reactiveValues()观察({文件 <- 输入 $file1if (is.null(file))返回()值$data <- fread(file$datapath)vars <- 名称(值$数据)updateSelectInput(会话，filtervar"，选择 = vars)})观察({数据 <- 隔离(值$数据)filter.var <- 输入$filtervarif (is.null(filter.var) || filter.var == "")返回()值 <- 数据[[filter.var]]if (is.factor(values)) {选项 <- 级别(值)} 别的 {选项 <- 唯一(值 [订单(值)])}updateCheckboxGroupInput(会话，过滤选项"，选择=选项，selected = as.character(options))})output$table.output <- renderTable({隔离({数据 <- 值$数据var <- 输入$filtervar})值 <- 输入$过滤器选项如果(是.空(数据)){返回()} else if (is.null(var) || var == "") {返回(数据)} else if (is.null(values)) {返回(数据[FALSE])} 别的 {if (is.numeric(data[[var]]))值 <- as.numeric(值)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)
