无法删除/选择Shinyapp中的多个列
我正在使用mtcars数据来构建ShinyApp。我放置了 checkboxgroupinput 来选择 cyl，vs，disp 之类的列。 但目前无法正常工作。 出于相同的目的，我还放置了 DT库的列可见性，但是当我删除列并下载数据时，它会在excel中显示完整的输出。 我也在粘贴代码。请看一看。非常感谢：）
data_table <-mtcars [，c（2,8,3,1,4,5,9,6,7，10,11）]
ncol(data_table)
names(data_table)[4:11]<- rep(x =
c('OTS_lhr_Wave_1','OTS_isb_Wave_2','OTS_lhr_Wave_2','OTS_isb_Wave_1',
'NTS_lhr_Wave_1','NTS_isb_Wave_2','NTS_lhr_Wave_2','NTS_isb_Wave_1'),
times=1, each=1)
library(readr)
library(shiny)
library(DT)
library(dplyr)
library(shinythemes)
library(htmlwidgets)
library(shinyWidgets)
ui = fluidPage(
sidebarLayout(
sidebarPanel (
downloadButton(outputId = "downLoadFilter",
label = "Download data"),
selectInput(inputId = "disp",
label = "disp:",
choices = c("All",
unique(as.character(data_table$disp))),
selected = "All",
multiple = TRUE),
radioButtons(inputId = "variables", label = "Choose Variable(s):",
choices =c("All","OTS", "NTS"), inline = FALSE,
selected = c("All")),
selectInput(inputId = "regions1", label = "choose region",
choices =c("lhr"),
multiple = TRUE, selected = c("lhr")),
selectInput(inputId = "regions2", label = "choose region",
choices =c("isb"),
multiple = TRUE, selected = c("isb")),
selectInput(inputId = "waves", label = "choose wave",
choices =c("Wave_1", "Wave_2"), multiple = TRUE,
selected = c("Wave_1", "Wave_2")),
checkboxGroupInput(inputId = "columns", label = "Select Columns to display:",
choices =names(data_table)[1:3],
selected = names(data_table)[1:3], inline = TRUE)
),
mainPanel(
tags$h5('Download only current page using following buttons:'),
DT::dataTableOutput('mytable') )))
server = function(input, output, session) {
#tab 1
thedata <- reactive({
if(input$disp != 'All'){
data_table<-data_table[data_table$disp %in% input$disp,]
}
#starting OTS NTS
if (input$variables== 'All'){
data_table<- data_table[,c("cyl", "vs", "disp" ,
names(data_table[grep(pattern = "TS", x = names(data_table), fixed = TRUE)])),drop=FALSE] }
if (input$variables== 'OTS'){
data_table<- data_table[,c("cyl", "vs", "disp" ,
names(data_table[grep(pattern = "OTS", x = names(data_table), fixed = TRUE)])),drop=FALSE] }
if (input$variables== 'NTS'){
data_table<- data_table[,c("cyl", "vs", "disp" ,
names(data_table[grep(pattern = "NTS", x = names(data_table), fixed = TRUE)])),drop=FALSE] }
#Region1
all_cols <- names(data_table)
region_cols <- c()
if ('lhr' %in% input$regions1){
region_cols <- c(region_cols, all_cols[grep('lhr', all_cols, fixed = TRUE)])
}
#Region2
if ('isb' %in% input$regions2){
region_cols <- c(region_cols, all_cols[grep('isb', all_cols, fixed = TRUE)])
}
#Waves
waves_cols <- c()
if ('Wave_1' %in% input$waves){
waves_cols <- c(waves_cols, all_cols[grep('Wave_1', all_cols, fixed = TRUE)])
}
if ('Wave_2' %in% input$waves){
waves_cols <- c(waves_cols, all_cols[grep('Wave_2', all_cols, fixed = TRUE)])
}
data_table <- data_table[,c( input$columns, intersect(region_cols, waves_cols)), drop=FALSE]
})
output$mytable = DT::renderDataTable({
DT::datatable( filter = "top", rownames = FALSE, escape = FALSE,
class = 'cell-border stripe',
extensions = c('FixedHeader', 'Buttons'),
options = list(pageLength = 50, autowidth=FALSE, fixedHeader = TRUE,
dom = 'Brtip',
buttons = list('copy', 'print',
list(extend = 'collection',
buttons = c('csv', 'excel', 'pdf'),
text = 'Download'),
list(extend = 'colvis', columns = c(0,1,2)))
),
{
thedata()
})
})
output$downLoadFilter <- downloadHandler(
filename = function() {
paste('Filtered Data ', Sys.time(), '.csv', sep = '')
},
content = function(path){
write_csv(thedata(), path) # Call reactive thedata()
}
)
}
shinyApp(ui = ui, server = server)
2 个答案:
答案 0 :(得分：0)
我已经基于您的代码实现了一个解决方案，该解决方案使您可以根据自己的选择来选择和呈现特定的列，并根据自己的选择下载经过列过滤的数据。
对代码进行了以下更改：
-
动态选择以以下形式添加到
-
checkboxGroupInput(inputId = "columns", label = "Select Columns to display:", choices = data_table %>% colnames(), selected = NULL) - 根据以上（1）的选择，编写了一种反应式过滤方法以返回所有选定的列，如下所示：
-
columnFilter <- shiny::reactive({ shiny::req(input$columns) data_table %>% select(input$columns) })
-
- 编写了一种反应式下载数据准备方法，该方法可以按如下方式传递到
downloadHandler()中：-
getDownloadData <- shiny::reactive({ if(is.null(input$columns)) return(thedata()) else return(columnFilter()) })
-
-
基于上面的（3），
downloadHandler()现在变为：output$downLoadFilter <- downloadHandler( filename = function() { paste('Filtered Data ', Sys.time(), '.csv', sep = '') }, content = function(path){ write_csv(getDownloadData(), path) } ) } -
在数据呈现功能中，添加了逻辑触发器，如下所示：
-
if(is.null(input$columns)) thedata() else columnFilter()
-
- 其他所有内容保持不变。
checkboxGroupInput()中：
基于您的代码的完整解决方案如下：
data_table<-mtcars[,c(2,8,3,1,4,5,9,6,7, 10,11)]
ncol(data_table)
names(data_table)[4:11]<- rep(x =
c('OTS_lhr_Wave_1','OTS_isb_Wave_2','OTS_lhr_Wave_2','OTS_isb_Wave_1',
'NTS_lhr_Wave_1','NTS_isb_Wave_2','NTS_lhr_Wave_2','NTS_isb_Wave_1'),
times=1, each=1)
library(readr)
library(shiny)
library(DT)
library(dplyr)
library(shinythemes)
library(htmlwidgets)
library(shinyWidgets)
ui <- fluidPage(
sidebarLayout(
sidebarPanel (
downloadButton(outputId =
"downLoadFilter",
label = "Download data"),
selectInput(inputId = "cyl",
label = "cyl:",
choices = c("All",
unique(as.character(data_table$cyl))),
selected = "All",
multiple = TRUE),
selectInput(inputId = "vs",
label = "vs:",
choices = c("All",
unique(as.character(data_table$vs))),
selected = "All",
multiple = TRUE),
selectInput(inputId = "disp",
label = "disp:",
choices = c("All",
unique(as.character(data_table$disp))),
selected = "All",
multiple = TRUE),
checkboxGroupInput(inputId = "columns",
label = "Select Columns to display:",
choices = data_table %>% colnames(),
selected = NULL),
radioButtons(inputId = "variables",
label = "Choose Variable(s):",
choices =c("All","OTS",
"NTS"), inline = FALSE,
selected = c("OTS")),
selectInput(inputId = "regions", label = "choose region",
choices =c("lhr",
"isb"),
multiple = TRUE,
selected = c("lhr")),
selectInput(inputId = "waves", label = "choose wave",
choices =c("Wave_1",
"Wave_2"), multiple = TRUE,
selected = c("Wave_1"))
),
mainPanel(
tags$h5('Download only current page using following
buttons:'),
DT::dataTableOutput('mytable') )))
server <- function(input, output, session) {
columnFilter <- shiny::reactive({
shiny::req(input$columns)
data_table %>% select(input$columns)
})
getDownloadData <- shiny::reactive({
if(is.null(input$columns)) return(thedata())
else return(columnFilter())
})
#tab 1
thedata <- reactive({
if(input$cyl != 'All'){
data_table<-data_table[data_table$cyl %in% input$cyl,]
}
if(input$vs != 'All'){
data_table<-data_table[data_table$vs %in% input$vs,]
}
if(input$disp != 'All'){
data_table<-data_table[data_table$disp %in% input$disp,]
}
#starting OTS NTS
if (input$variables== 'All'){
data_table<- data_table[,c("cyl", "vs", "disp" ,
names(data_table[grep(pattern = "TS", x =
names(data_table),
fixed = TRUE)])),drop=FALSE] }
if (input$variables== 'OTS'){
data_table<- data_table[,c("cyl", "vs", "disp" ,
names(data_table[grep(pattern = "OTS", x =
names(data_table),
fixed = TRUE)])),drop=FALSE] }
if (input$variables== 'NTS'){
data_table<- data_table[,c("cyl", "vs", "disp" ,
names(data_table[grep(pattern = "NTS", x =
names(data_table),
fixed = TRUE)])),drop=FALSE] }
#Region
all_cols <- names(data_table)
region_cols <- c("cyl", "vs", "disp" )
if ('lhr' %in% input$regions){
region_cols <- c(region_cols, all_cols[grep('lhr', all_cols, fixed =
TRUE)])
}
if ('isb' %in% input$regions){
region_cols <- c(region_cols, all_cols[grep('isb', all_cols, fixed =
TRUE)])
}
#Waves
waves_cols <- c("cyl", "vs", "disp" )
if ('Wave_1' %in% input$waves){
waves_cols <- c(waves_cols, all_cols[grep('Wave_1', all_cols, fixed =
TRUE)])
}
if ('Wave_2' %in% input$waves){
waves_cols <- c(waves_cols, all_cols[grep('Wave_2', all_cols, fixed =
TRUE)])
}
data_table <- data_table[,intersect(region_cols, waves_cols),
drop=FALSE]
})
output$mytable = DT::renderDataTable({
DT::datatable( filter = "top", rownames = FALSE, escape = FALSE,
class = 'cell-border stripe',
extensions = c('FixedHeader', 'Buttons'),
options = list(pageLength = 50, autowidth=FALSE,
fixedHeader = TRUE,
dom = 'Brtip',
buttons = list('copy', 'print',
list(extend = 'collection',
buttons = c('csv',
'excel',
'pdf'),
text = 'Download'),
list(extend = 'colvis',
columns = c(0,1,2)))
),
{
if(is.null(input$columns)) thedata()
else columnFilter()
})
})
output$downLoadFilter <- downloadHandler(
filename = function() {
paste('Filtered Data ', Sys.time(), '.csv', sep = '')
},
content = function(path){
write_csv(getDownloadData(), path)
}
)
}
shinyApp(ui = ui, server = server)
以下屏幕截图：
我希望这会有所帮助：-）
答案 1 :(得分：0)
data_table<-mtcars[,c(2,8,3,1,4,5,9,6,7, 10,11)]
ncol(data_table)
names(data_table)[4:11]<- rep(x =
c('OTS_lhr_Wave_1','OTS_isb_Wave_2','OTS_lhr_Wave_2','OTS_isb_Wave_1',
'NTS_lhr_Wave_1','NTS_isb_Wave_2','NTS_lhr_Wave_2','NTS_isb_Wave_1'),
times=1, each=1)
library(readr)
library(shiny)
library(DT)
library(dplyr)
library(shinythemes)
library(htmlwidgets)
library(shinyWidgets)
ui = fluidPage(
sidebarLayout(
sidebarPanel (
downloadButton(outputId = "downLoadFilter",
label = "Download data"),
selectInput(inputId = "disp",
label = "disp:",
choices = c("All",
unique(as.character(data_table$disp))),
selected = "All",
multiple = TRUE),
radioButtons(inputId = "variables", label = "Choose Variable(s):",
choices =c("All","OTS", "NTS"), inline = FALSE,
selected = c("All")),
selectInput(inputId = "regions1", label = "choose region",
choices =c("lhr"),
multiple = TRUE, selected = c("lhr")),
selectInput(inputId = "regions2", label = "choose region",
choices =c("isb"),
multiple = TRUE, selected = c("isb")),
selectInput(inputId = "waves", label = "choose wave",
choices =c("Wave_1", "Wave_2"), multiple = TRUE,
selected = c("Wave_1", "Wave_2")),
checkboxGroupInput(inputId = "columns", label = "Select Columns to
display:",
choices =names(data_table)[1:3],
selected = names(data_table)[1:3], inline = TRUE)
),
mainPanel(
tags$h5('Download only current page using following buttons:'),
DT::dataTableOutput('mytable') )))
server = function(input, output, session) {
#tab 1
thedata <- reactive({
if(input$disp != 'All'){
data_table<-data_table[data_table$disp %in% input$disp,]
}
#starting OTS NTS
if (input$variables== 'All'){
data_table<- data_table[,c("cyl", "vs", "disp" ,
names(data_table[grep(pattern = "TS", x
= names(data_table), fixed = TRUE)])),drop=FALSE] }
if (input$variables== 'OTS'){
data_table<- data_table[,c("cyl", "vs", "disp" ,
names(data_table[grep(pattern = "OTS", x
= names(data_table), fixed = TRUE)])),drop=FALSE] }
if (input$variables== 'NTS'){
data_table<- data_table[,c("cyl", "vs", "disp" ,
names(data_table[grep(pattern = "NTS", x
= names(data_table), fixed = TRUE)])),drop=FALSE] }
#Region1
all_cols <- names(data_table)
region_cols <- c()
if ('lhr' %in% input$regions1){
region_cols <- c(region_cols, all_cols[grep('lhr', all_cols, fixed =
TRUE)])
}
#Region2
if ('isb' %in% input$regions2){
region_cols <- c(region_cols, all_cols[grep('isb', all_cols, fixed =
TRUE)])
}
#Waves
waves_cols <- c()
if ('Wave_1' %in% input$waves){
waves_cols <- c(waves_cols, all_cols[grep('Wave_1', all_cols, fixed
= TRUE)])
}
if ('Wave_2' %in% input$waves){
waves_cols <- c(waves_cols, all_cols[grep('Wave_2', all_cols, fixed
= TRUE)])
}
data_table <- data_table[,c( input$columns, intersect(region_cols,
waves_cols)), drop=FALSE]
})
output$mytable = DT::renderDataTable({
DT::datatable( filter = "top", rownames = FALSE, escape = FALSE,
class = 'cell-border stripe',
extensions = c('FixedHeader', 'Buttons'),
options = list(pageLength = 50, autowidth=FALSE,
fixedHeader = TRUE,
dom = 'Brtip',
buttons = list('copy', 'print',
list(extend =
'collection',
buttons = c('csv',
'excel', 'pdf'),
text = 'Download'),
list(extend = 'colvis',
columns = c(0,1,2)))
),
{
thedata()
})
})
output$downLoadFilter <- downloadHandler(
filename = function() {
paste('Filtered Data ', Sys.time(), '.csv', sep = '')
},
content = function(path){
write_csv(thedata(), path) # Call reactive thedata()
}
)
}
shinyApp(ui = ui, server = server)
相关问题
最新问题
- 我写了这段代码，但我无法理解我的错误
- 我无法从一个代码实例的列表中删除 None 值，但我可以在另一个实例中。为什么它适用于一个细分市场而不适用于另一个细分市场？
- 是否有可能使 loadstring 不可能等于打印？卢阿
- java中的random.expovariate()
- Appscript 通过会议在 Google 日历中发送电子邮件和创建活动
- 为什么我的 Onclick 箭头功能在 React 中不起作用？
- 在此代码中是否有使用“this”的替代方法？
- 在 SQL Server 和 PostgreSQL 上查询，我如何从第一个表获得第二个表的可视化
- 每千个数字得到
- 更新了城市边界 KML 文件的来源？