我仍然在学习Shiny和R，觉得这是一个大海，我仍然需要学习很多东西。如果我的编码方法不理想并且建议代码可以即兴创作，请原谅。
我正在创建这个应用程序，我需要生成交叉表和图表。我需要过滤用户选择的数据基础变量，并根据需要更新表格和图表。
因此，例如，如果用户选择＆＃34; Store_location＆＃34;作为过滤器变量，我想在复选框下面显示此变量的值列表，所以
LOC1 LOC2 中Loc3 LOC4
应显示复选框，用户可以选择这些值的单个/多个。基于此我的数据应该被过滤。因此，如果用户选择loc1和loc2，则应根据条件过滤数据（Store_location ==＆＃34; loc1＆＃34; | Store_location ==＆＃34; loc2＆＃34;）
一旦用户取消选中复选框或为筛选器选择其他变量，相应地应该更新数据以及交叉表和图表。我相信这应该可以在Shiny中完成，我试图使用 checkboxGroupInput 但是不能传递所选的变量，从而得到错误。目前已对此进行了评论，以便代码运行。我创建了一个CSV格式的样本数据，并在应用程序中读取。数据量巨大，因此使用data.table fread来读取数据。因此，任何子设置都需要在data.table中完成。当按钮＆＃34;准备分析数据＆＃34;时，我会对变量进行一些重新格式化/创建。点击。为此，我使用observeEvent（{}），我的所有renderTable / renderplot都在此事件中。我觉得有更好的办法来解决这个问题。如果是，建议。
最后，我的下载器给了我错误，＆＃34;只有＆＃39; grobs＆＃39;允许进入＆＃34; gList＆＃34;＆＃34;有时候错误就像＆＃34;替换有17行，数据有0＆＃34;。我想用交叉表生成一个pdf文件，并在另一个下面绘制一个。建议我哪里出错了。
可以在此处找到示例数据 - sample data
以下是我的应用的代码段 -
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)
总而言之，需要您的帮助来运行此应用程序 -
动态显示所选过滤器变量的值并过滤数据，以便更新交叉表和绘图。注意数据很大并且在data.table中
下载器以pdf格式下载输出。
谢谢！
答案 0 :(得分：0)
这是一种根据所需列的选定值对数据框进行子集化的方法。
我真的不明白你想用行和列选择输入做什么。
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)