英文:
R Shiny - Display download button only upon selecting a specific input filter
问题
以下是您要翻译的内容：
"I have a download handler which displays a download button that downloads output dataset in a csv file. But the problem I am facing is, I want the download button to be visible only if I select a specific input. The input filters are all reactive and an observe event is associated with all the input filters.
I want the download button visible only if I select the output category="Sub-Gran" as the download button feature is only for dataset2 (df_testdata2) output."
英文:
I have a download handler which displays a download button that downloads output dataset in a csv file. But the problem I am facing is, I want the download button to be visible only if I select a specific input. The input filters are all reactive and an observe event is associated with all the input filters.
I want the download button visible only if I select the output category="Sub-Gran" as the download button feature is only for dataset2 (df_testdata2) output.
> Blockquote
library(shiny)
library(dplyr)
library(DBI)
library(readxl)
library(openxlsx)
library(dbplyr)
library(shinythemes)
library(DT)
#library(shinyBS)
category<-c('AA','AA','AA','AA','AA','BB','BB','BB','BB','BB')
sub.category<- c('A01','A01','A02','A02','A03','B01','B02','B02','B03','B03')
gran.category <- c('A01-11','A01-12','A02-11','A02-12','A03-11','B01-11','B02-11','B02-12','B03-11','B03-12')
val1<-c(1,1,2,5,2,4,3,1,1,1)
val2<-c(2,2,2,2,2,2,2,2,2,2)
val3<-c(4,5,5,6,6,3,6,8,1,1)
val4<-c(0,0,0,0,0,0,0,0,0,0)
testdata <- as.data.frame(cbind(category,sub.category,gran.category,val1,val2,val3,val4))
n <- 5
testdata <- do.call("rbind", replicate(n, testdata, simplify = FALSE))
testdata1 <- testdata
colnames(testdata1) <- c('boomchicka', 'boom1chicka*','boom2bookmboom','boom3','boom4','boom5','boom6')
testdata <- cbind(testdata,testdata1)
#testdata <- cbind(testdata,testdata)
## Filters
cat_name <- unique(testdata$category)
cat_sub_name <- testdata %>% select(category, sub.category, gran.category) %>%
distinct() %>% arrange(sub.category, gran.category)
cat_sub_gran_name <- testdata %>% select(category, sub.category, gran.category) %>%
distinct() %>% arrange(sub.category, gran.category)
# Server function to determine the input and output parameters
server <- function(input, output, session) {
###
df_testdata1 <- reactive({
if (input$Output_category == "Cat-Sub") {
if (is.null(input$test_category) & is.null(input$test_subcategory) )
{
testdata
}
else if (is.null(input$test_category) & !is.null(input$test_subcategory) )
{
testdata %>% filter(sub.category %in% input$test_subcategory)
}
else if (!is.null(input$test_category) & is.null(input$test_subcategory))
{
testdata %>% filter(category %in% input$test_category)
}
else if (!is.null(input$test_category) & !is.null(input$test_subcategory))
{
testdata %>% filter (category %in% input$test_category & sub.category %in% input$test_subcategory)
}
}
})
output$tab1 <- DT::renderDataTable({
DT::datatable(df_testdata1(),
style = "bootstrap",
rownames=TRUE,
selection='none',
escape=FALSE,
filter = list(position = 'bottom', clear = FALSE),
options = list(autoWidth = TRUE, searching = TRUE))
})
df_testdata2 <- reactive({
if (input$Output_category == "Sub-Gran"){
if (is.null(input$test_subcategory) & is.null(input$test_grancategory) )
{
testdata
}
else if (is.null(input$test_subcategory) & !is.null(input$test_grancategory) )
{
testdata %>% filter(gran.category %in% input$test_grancategory)
}
else if (!is.null(input$test_subcategory) & is.null(input$test_grancategory))
{
testdata %>% filter(sub.category %in% input$test_subcategory)
}
else if (!is.null(input$test_subcategory) & !is.null(input$test_grancategory))
{
testdata %>% filter (sub.category %in% input$test_subcategory & gran.category %in% input$test_grancategory)
}
}
})
output$tab2 <- DT::renderDataTable({
DT::datatable(df_testdata2(),
style = "bootstrap",
rownames=TRUE,
selection='none',
escape=FALSE,
filter = list(position = 'bottom', clear = FALSE),
options = list(autoWidth = TRUE, searching = TRUE))
})
## Enablind a download handler for CDASH Fields
output$downLoadFilterGranCat <- downloadHandler(
filename = function() {
paste('GranCat-', Sys.Date(), '.csv', sep = '')
},
content = function(file) {
write.csv(df_testdata2()[input[["tab2_rows_all"]], ],file)
}
)
## Dependent reactive filter for the sub category
observeEvent(input$test_category, {
if (is.null(input$test_category)) {
subcatToShow = unique(cat_sub_gran_name$sub.category)
#selected <- character(0)
}else {
subcatToShow = cat_sub_gran_name %>%
filter(category %in% input$test_category) %>%
pull(unique(sub.category))
#selected <- subcatToShow[1]
}
#Update the actual input
updateSelectInput(session, "test_subcategory", choices = subcatToShow
)
},ignoreNULL = FALSE)
## Dependent reactive filter for the sub category
observeEvent(input$test_subcategory, {
if (is.null(input$test_category) & is.null(input$test_subcategory)) {
grancatToShow = cat_sub_gran_name$gran.category
}
else if (is.null(input$test_category) & !is.null(input$test_subcategory)){
grancatToShow = cat_sub_gran_name %>%
filter(sub.category %in% input$test_subcategory) %>%
pull(gran.category)
}
else if (!is.null(input$test_category) & is.null(input$test_subcategory)){
grancatToShow = cat_sub_gran_name %>%
filter(category %in% input$test_category) %>%
pull(gran.category)
}
else if (!is.null(input$test_category) & !is.null(input$test_subcategory)){
grancatToShow = cat_sub_gran_name %>%
filter(category %in% input$test_category & sub.category %in% input$test_subcategory ) %>%
pull(gran.category)
}
#Update the actual input
updateSelectInput(session, "test_grancategory", choices = grancatToShow
)
},ignoreNULL = FALSE)
}
# UI section of the program to design the front-end of the web application
ui <- fluidPage(
theme = shinytheme('darkly'),
titlePanel("Analysis Dataset", windowTitle="Category Dataset"
),
sidebarLayout(
mainPanel(
width = 10,
DT::dataTableOutput('tab1'),
DT::dataTableOutput('tab2'),
## Download filter functionality
div(downloadButton('downLoadFilterGranCat',div(strong("Download Gran Category"),
style = "text-align:center; color:green; font-size:100%")),align='center'),
),
sidebarPanel(
width = 2,
selectInput("Output_category",
choices = c("Cat-Sub","Sub-Gran"),
label = "Select the Output Category",
multiple = TRUE),
selectInput("test_category",
choices = cat_name,
label = "Select the category name",
multiple = TRUE),
selectInput("test_subcategory",
choices = c(),
label = "Select the sub category name",
multiple = TRUE),
selectInput("test_grancategory",
choices = c(),
label = "Select the gran category name",
multiple = TRUE)
)
)
)
shinyApp(ui = ui, server = server)
答案1
得分: 0
将您的`downloadButton`包装在`conditionalPanel`中，使用条件`'input.Output_category.includes("Sub-Gran")'`，仅当选择了`"Sub-Gran"`时显示`downloadButton`。
请注意，我将您的代码精简为一个更小的可复现示例：
英文:
One option to achieve your desired result would be to wrap your downloadButton inside a conditionalPanel which using the condition 'input.Output_category.includes("Sub-Gran")' will show the downloadButton only if "Sub-Gran" was chosen.
Note that I stripped down your code to a much more minimal reproducible example:
library(shiny)
library(dplyr)
library(DT)
category <- c("AA", "AA", "AA", "AA", "AA")
sub.category <- c("A01", "A01", "A02", "A02", "A03")
gran.category <- c("A01-11", "A01-12", "A02-11", "A02-12", "A03-11")
testdata <- data.frame(category, sub.category, gran.category)
server <- function(input, output, session) {
df_testdata1 <- reactive({
req(input$Output_category)
if ("Cat-Sub" %in% input$Output_category) {
testdata
}
})
output$tab1 <- DT::renderDataTable({
DT::datatable(df_testdata1(),
style = "bootstrap",
rownames = TRUE,
selection = "none",
escape = FALSE,
filter = list(position = "bottom", clear = FALSE),
options = list(autoWidth = TRUE, searching = TRUE)
)
})
df_testdata2 <- reactive({
req(input$Output_category)
if ("Sub-Gran" %in% input$Output_category) {
testdata
}
})
output$tab2 <- DT::renderDataTable({
DT::datatable(df_testdata2(),
style = "bootstrap",
rownames = TRUE,
selection = "none",
escape = FALSE,
filter = list(position = "bottom", clear = FALSE),
options = list(autoWidth = TRUE, searching = TRUE)
)
})
output$downLoadFilterGranCat <- downloadHandler(
filename = function() {
paste("GranCat-", Sys.Date(), ".csv", sep = "")
},
content = function(file) {
write.csv(df_testdata2()[input[["tab2_rows_all"]], ], file)
}
)
}
ui <- fluidPage(
titlePanel("Analysis Dataset", windowTitle = "Category Dataset"),
sidebarLayout(
sidebarPanel(
width = 2,
selectInput("Output_category",
choices = c("Cat-Sub", "Sub-Gran"),
label = "Select the Output Category",
multiple = TRUE
)
),
mainPanel(
width = 10,
DT::dataTableOutput("tab1"),
DT::dataTableOutput("tab2"),
conditionalPanel(
'input.Output_category.includes("Sub-Gran")',
div(downloadButton("downLoadFilterGranCat", div(strong("Download Gran Category"),
style = "text-align:center; color:green; font-size:100%"
)), align = "center")
)
)
)
)
shinyApp(ui = ui, server = server)
答案2
得分: 0
以下是您要翻译的代码部分：
# Added observeEvent
observeEvent(input$Output_category, {
print("printing:::::::")
print(input$Output_category)
if (input$Output_category != "Sub-Gran")
{
output$download_button <- renderUI({})
}
})
请注意，这是R语言中的一部分代码，用于观察input$Output_category的值，并在特定条件下更改output$download_button的呈现。如果input$Output_category不等于"Sub-Gran"，则将其呈现为空。
英文:
If you only want the download button to appear when Sub-Gran is selected I added an observeEvent() to see what category it is. Then I added dynamic UI to support when the user changes the category. When the category is selected then the download button will appear, and when it's not selected (or nothing) then there will be no download button. I added comments to where I have added to your code.
library(shiny)
library(dplyr)
library(DBI)
library(readxl)
library(openxlsx)
library(dbplyr)
library(shinythemes)
library(DT)
library(shinyBS)
category<-c('AA','AA','AA','AA','AA','BB','BB','BB','BB','BB')
sub.category<- c('A01','A01','A02','A02','A03','B01','B02','B02','B03','B03')
gran.category <- c('A01-11','A01-12','A02-11','A02-12','A03-11','B01-11','B02-11','B02-12','B03-11','B03-12')
val1<-c(1,1,2,5,2,4,3,1,1,1)
val2<-c(2,2,2,2,2,2,2,2,2,2)
val3<-c(4,5,5,6,6,3,6,8,1,1)
val4<-c(0,0,0,0,0,0,0,0,0,0)
testdata <- as.data.frame(cbind(category,sub.category,gran.category,val1,val2,val3,val4))
n <- 5
testdata <- do.call("rbind", replicate(n, testdata, simplify = FALSE))
testdata1 <- testdata
colnames(testdata1) <- c('boomchicka', 'boom1chicka*','boom2bookmboom','boom3','boom4','boom5','boom6')
testdata <- cbind(testdata,testdata1)
#testdata <- cbind(testdata,testdata)
## Filters
cat_name <- unique(testdata$category)
cat_sub_name <- testdata %>% select(category, sub.category, gran.category) %>%
distinct() %>% arrange(sub.category, gran.category)
cat_sub_gran_name <- testdata %>% select(category, sub.category, gran.category) %>%
distinct() %>% arrange(sub.category, gran.category)
# Server function to determine the input and output parameters
server <- function(input, output, session) {
###
df_testdata1 <- reactive({
if (input$Output_category == "Cat-Sub") {
if (is.null(input$test_category) & is.null(input$test_subcategory) )
{
testdata
}
else if (is.null(input$test_category) & !is.null(input$test_subcategory) )
{
testdata %>% filter(sub.category %in% input$test_subcategory)
}
else if (!is.null(input$test_category) & is.null(input$test_subcategory))
{
testdata %>% filter(category %in% input$test_category)
}
else if (!is.null(input$test_category) & !is.null(input$test_subcategory))
{
testdata %>% filter (category %in% input$test_category & sub.category %in% input$test_subcategory)
}
}
})
output$tab1 <- DT::renderDataTable({
DT::datatable(df_testdata1(),
style = "bootstrap",
rownames=TRUE,
selection='none',
escape=FALSE,
filter = list(position = 'bottom', clear = FALSE),
options = list(autoWidth = TRUE, searching = TRUE))
})
# Added observeEvent
observeEvent(input$Output_category, {
print("printing:::::::")
print(input$Output_category)
if (input$Output_category != "Sub-Gran")
{
output$download_button <- renderUI({})
}
})
df_testdata2 <- reactive({
if (input$Output_category == "Sub-Gran"){
# If true then display output button.
output$download_button <- renderUI({
div(downloadButton('downLoadFilterGranCat',div(strong("Download Gran Category"),
style = "text-align:center; color:green; font-size:100%")),align='center')
})
if (is.null(input$test_subcategory) & is.null(input$test_grancategory) )
{
testdata
}
else if (is.null(input$test_subcategory) & !is.null(input$test_grancategory) )
{
testdata %>% filter(gran.category %in% input$test_grancategory)
}
else if (!is.null(input$test_subcategory) & is.null(input$test_grancategory))
{
testdata %>% filter(sub.category %in% input$test_subcategory)
}
else if (!is.null(input$test_subcategory) & !is.null(input$test_grancategory))
{
testdata %>% filter (sub.category %in% input$test_subcategory & gran.category %in% input$test_grancategory)
}
}
})
output$tab2 <- DT::renderDataTable({
DT::datatable(df_testdata2(),
style = "bootstrap",
rownames=TRUE,
selection='none',
escape=FALSE,
filter = list(position = 'bottom', clear = FALSE),
options = list(autoWidth = TRUE, searching = TRUE))
})
## Enablind a download handler for CDASH Fields
output$downLoadFilterGranCat <- downloadHandler(
filename = function() {
paste('GranCat-', Sys.Date(), '.csv', sep = '')
},
content = function(file) {
write.csv(df_testdata2()[input[["tab2_rows_all"]], ],file)
}
)
## Dependent reactive filter for the sub category
observeEvent(input$test_category, {
if (is.null(input$test_category)) {
subcatToShow = unique(cat_sub_gran_name$sub.category)
#selected <- character(0)
}else {
subcatToShow = cat_sub_gran_name %>%
filter(category %in% input$test_category) %>%
pull(unique(sub.category))
#selected <- subcatToShow[1]
}
#Update the actual input
updateSelectInput(session, "test_subcategory", choices = subcatToShow
)
},ignoreNULL = FALSE)
## Dependent reactive filter for the sub category
observeEvent(input$test_subcategory, {
if (is.null(input$test_category) & is.null(input$test_subcategory)) {
grancatToShow = cat_sub_gran_name$gran.category
}
else if (is.null(input$test_category) & !is.null(input$test_subcategory)){
grancatToShow = cat_sub_gran_name %>%
filter(sub.category %in% input$test_subcategory) %>%
pull(gran.category)
}
else if (!is.null(input$test_category) & is.null(input$test_subcategory)){
grancatToShow = cat_sub_gran_name %>%
filter(category %in% input$test_category) %>%
pull(gran.category)
}
else if (!is.null(input$test_category) & !is.null(input$test_subcategory)){
grancatToShow = cat_sub_gran_name %>%
filter(category %in% input$test_category & sub.category %in% input$test_subcategory ) %>%
pull(gran.category)
}
#Update the actual input
updateSelectInput(session, "test_grancategory", choices = grancatToShow
)
},ignoreNULL = FALSE)
}
# UI section of the program to design the front-end of the web application
ui <- fluidPage(
theme = shinytheme('darkly'),
titlePanel("Analysis Dataset", windowTitle="Category Dataset"
),
sidebarLayout(
mainPanel(
width = 10,
DT::dataTableOutput('tab1'),
DT::dataTableOutput('tab2'),
## Download filter functionality
# Added Dynamic Output
uiOutput(outputId = "download_button")
),
sidebarPanel(
width = 2,
selectInput("Output_category",
choices = c("Cat-Sub","Sub-Gran"),
label = "Select the Output Category",
multiple = TRUE),
selectInput("test_category",
choices = cat_name,
label = "Select the category name",
multiple = TRUE),
selectInput("test_subcategory",
choices = c(),
label = "Select the sub category name",
multiple = TRUE),
selectInput("test_grancategory",
choices = c(),
label = "Select the gran category name",
multiple = TRUE)
)
)
)
shinyApp(ui = ui, server = server)
通过集体智慧和协作来改善编程学习和解决问题的方式。致力于成为全球开发者共同参与的知识库，让每个人都能够通过互相帮助和分享经验来进步。
评论