R Shiny -仅在选择特定输入过滤器时显示下载按钮

m4pnthwp  于 2023-05-11  发布在  其他
关注(0)|答案(2)|浏览(78)

我有一个下载处理程序，它显示一个下载按钮，可以下载csv文件中的输出数据集。但我面临的问题是，我希望下载按钮只有在我选择特定输入时才能看到。输入滤波器都是React性的，并且观察事件与所有输入滤波器相关联。
我希望下载按钮仅在选择output category=“Sub-Gran”时可见，因为下载按钮功能仅适用于dataset 2（df_testdata2）输出。
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)
r

2条答案

按热度按时间
dkqlctbz

dkqlctbz1#

实现所需结果的一个选项是将downloadButton Package 在conditionalPanel中，使用条件'input.Output_category.includes("Sub-Gran")'将仅在选择"Sub-Gran"时显示downloadButton。
请注意，我将您的代码简化为一个更小的可复制示例：

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)

赞(0）分享  回复(0）举报  2023-05-11
e1xvtsh3

e1xvtsh32#

如果你只想在选择子组时出现下载按钮，我添加了一个observeEvent()来查看它是什么类别。然后我添加了动态UI来支持用户更改类别。当类别被选中时，下载按钮将出现，当它没有被选中（或没有）时，将没有下载按钮。我在代码中添加了注解。

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)
赞(0）分享  回复(0）举报  2023-05-11
我来回答

相关问题

    查看更多

    热门标签

    更多
    JavaquerypythonNode开发语言requestUtil数据库Table后端算法LoggerMessageElementParser

    最新问答

    更多
    • 蜀ICP备2022004421号-2 NULL123 https://www.null123.com © All rights reserved
    • 本站内容来源互联网,如果侵犯您的权益请联系我们删除, 联系方式：448109455@qq.com