Я реализовал решение, основанное на вашем коде, которое позволяет вам выбирать и отображать определенные столбцы на основе вашего выбора и загружать данные, отфильтрованные по столбцам, на основе вашего выбора.
В код были внесены следующие изменения:
- Динамический выбор был добавлен к
checkboxGroupInput() в виде
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()
- Все остальное осталось без изменений.
Полное решение на основе вашего кода приведено ниже:
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)
Скриншот ниже:
Надеюсь, это поможет: -)