R Shiny – 仅在选择特定输入筛选器时显示下载按钮

huangapple
go评论97阅读模式
英文:

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

  1. library(shiny)
  2. library(dplyr)
  3. library(DBI)
  4. library(readxl)
  5. library(openxlsx)
  6. library(dbplyr)
  7. library(shinythemes)
  8. library(DT)
  9. #library(shinyBS)
  10. category<-c('AA','AA','AA','AA','AA','BB','BB','BB','BB','BB')
  11. sub.category<- c('A01','A01','A02','A02','A03','B01','B02','B02','B03','B03')
  12. gran.category <- c('A01-11','A01-12','A02-11','A02-12','A03-11','B01-11','B02-11','B02-12','B03-11','B03-12')
  13. val1<-c(1,1,2,5,2,4,3,1,1,1)
  14. val2<-c(2,2,2,2,2,2,2,2,2,2)
  15. val3<-c(4,5,5,6,6,3,6,8,1,1)
  16. val4<-c(0,0,0,0,0,0,0,0,0,0)
  17. testdata <- as.data.frame(cbind(category,sub.category,gran.category,val1,val2,val3,val4))
  18. n <- 5
  19. testdata <- do.call("rbind", replicate(n, testdata, simplify = FALSE))
  20. testdata1 <- testdata
  21. colnames(testdata1) <- c('boomchicka', 'boom1chicka*','boom2bookmboom','boom3','boom4','boom5','boom6')
  22. testdata <- cbind(testdata,testdata1)
  23. #testdata <- cbind(testdata,testdata)
  24. ## Filters
  25. cat_name <- unique(testdata$category)
  26. cat_sub_name <- testdata %>% select(category, sub.category, gran.category) %>% 
  27. distinct() %>% arrange(sub.category, gran.category)
  28. cat_sub_gran_name <- testdata %>% select(category, sub.category, gran.category) %>% 
  29. distinct() %>% arrange(sub.category, gran.category)
  30. # Server function to determine the input and output parameters
  31. server <- function(input, output, session) {
  32. ###   
  33. df_testdata1 <- reactive({
  34. if (input$Output_category == "Cat-Sub") {
  35. if (is.null(input$test_category) & is.null(input$test_subcategory) )
  36. {
  37. testdata
  38. }
  39. else if (is.null(input$test_category) & !is.null(input$test_subcategory) )
  40. {
  41. testdata %>% filter(sub.category %in% input$test_subcategory)
  42. }
  43. else if (!is.null(input$test_category) & is.null(input$test_subcategory)) 
  44. {
  45. testdata %>% filter(category %in% input$test_category)
  46. }
  47. else if (!is.null(input$test_category) & !is.null(input$test_subcategory))
  48. {
  49. testdata %>% filter (category %in% input$test_category & sub.category %in% input$test_subcategory)
  50. }
  51. }
  52. })
  53. output$tab1 <- DT::renderDataTable({
  54. DT::datatable(df_testdata1(),
  55. style = "bootstrap", 
  56. rownames=TRUE,
  57. selection='none',
  58. escape=FALSE,
  59. filter = list(position = 'bottom', clear = FALSE), 
  60. options = list(autoWidth = TRUE, searching = TRUE))
  61. })
  62. df_testdata2 <- reactive({
  63. if (input$Output_category == "Sub-Gran"){
  64. if (is.null(input$test_subcategory) & is.null(input$test_grancategory) )
  65. {
  66. testdata
  67. }
  68. else if (is.null(input$test_subcategory) & !is.null(input$test_grancategory) )
  69. {
  70. testdata %>% filter(gran.category %in% input$test_grancategory)
  71. }
  72. else if (!is.null(input$test_subcategory) & is.null(input$test_grancategory)) 
  73. {
  74. testdata %>% filter(sub.category %in% input$test_subcategory)
  75. }
  76. else if (!is.null(input$test_subcategory) & !is.null(input$test_grancategory))
  77. {
  78. testdata %>% filter (sub.category %in% input$test_subcategory & gran.category %in% input$test_grancategory)
  79. }
  80. }
  81. })
  82. output$tab2 <- DT::renderDataTable({
  83. DT::datatable(df_testdata2(),
  84. style = "bootstrap", 
  85. rownames=TRUE,
  86. selection='none',
  87. escape=FALSE,
  88. filter = list(position = 'bottom', clear = FALSE), 
  89. options = list(autoWidth = TRUE, searching = TRUE))
  90. })
  91. ## Enablind a download handler for CDASH Fields
  92. output$downLoadFilterGranCat <- downloadHandler(
  93. filename = function() {
  94. paste('GranCat-', Sys.Date(), '.csv', sep = '')
  95. },
  96. content = function(file) {
  97. write.csv(df_testdata2()[input[["tab2_rows_all"]], ],file)
  98. }
  99. )
  100. ## Dependent reactive filter for the sub category
  101. observeEvent(input$test_category, {
  102. if (is.null(input$test_category)) {
  103. subcatToShow = unique(cat_sub_gran_name$sub.category)
  104. #selected <- character(0)
  105. }else {
  106. subcatToShow = cat_sub_gran_name %>% 
  107. filter(category %in% input$test_category) %>% 
  108. pull(unique(sub.category))
  109. #selected <- subcatToShow[1]
  110. }
  111. #Update the actual input
  112. updateSelectInput(session, "test_subcategory", choices = subcatToShow 
  113. )
  114. },ignoreNULL = FALSE)
  115. ## Dependent reactive filter for the sub category
  116. observeEvent(input$test_subcategory, {
  117. if (is.null(input$test_category) & is.null(input$test_subcategory)) {
  118. grancatToShow = cat_sub_gran_name$gran.category
  119. }
  120. else if (is.null(input$test_category) & !is.null(input$test_subcategory)){
  121. grancatToShow = cat_sub_gran_name %>% 
  122. filter(sub.category %in% input$test_subcategory) %>% 
  123. pull(gran.category)
  124. }
  125. else if (!is.null(input$test_category) & is.null(input$test_subcategory)){
  126. grancatToShow = cat_sub_gran_name %>% 
  127. filter(category %in% input$test_category) %>% 
  128. pull(gran.category)
  129. }
  130. else if (!is.null(input$test_category) & !is.null(input$test_subcategory)){
  131. grancatToShow = cat_sub_gran_name %>% 
  132. filter(category %in% input$test_category & sub.category %in% input$test_subcategory ) %>% 
  133. pull(gran.category)
  134. }
  135. #Update the actual input
  136. updateSelectInput(session, "test_grancategory", choices = grancatToShow
  137. )
  138. },ignoreNULL = FALSE)
  139. }
  140. # UI section of the program to design the front-end of the web application 
  141. ui <- fluidPage(
  142. theme = shinytheme('darkly'),
  143. titlePanel("Analysis Dataset", windowTitle="Category Dataset"
  144. ),
  145. sidebarLayout(
  146. mainPanel(
  147. width = 10,
  148. DT::dataTableOutput('tab1'),
  149. DT::dataTableOutput('tab2'),
  150. ## Download filter functionality
  151. div(downloadButton('downLoadFilterGranCat',div(strong("Download Gran Category"),
  152. style = "text-align:center; color:green; font-size:100%")),align='center'),
  153. ),
  154. sidebarPanel( 
  155. width = 2,
  156. selectInput("Output_category",
  157. choices = c("Cat-Sub","Sub-Gran"), 
  158. label = "Select the Output Category",
  159. multiple = TRUE),
  160. selectInput("test_category",
  161. choices = cat_name, 
  162. label = "Select the category name",
  163. multiple = TRUE),
  164. selectInput("test_subcategory",
  165. choices = c(), 
  166. label = "Select the sub category name",
  167. multiple = TRUE),
  168. selectInput("test_grancategory",
  169. choices = c(), 
  170. label = "Select the gran category name",
  171. multiple = TRUE)
  172. )
  173. )
  174. )
  175. shinyApp(ui = ui, server = server)

答案1

得分: 0

  1. 将您的`downloadButton`包装在`conditionalPanel`中，使用条件`'input.Output_category.includes("Sub-Gran")'`，仅当选择了`"Sub-Gran"`时显示`downloadButton`。
  2. 请注意，我将您的代码精简为一个更小的可复现示例：
英文:

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:

  1. library(shiny)
  2. library(dplyr)
  3. library(DT)
  4. category <- c("AA", "AA", "AA", "AA", "AA")
  5. sub.category <- c("A01", "A01", "A02", "A02", "A03")
  6. gran.category <- c("A01-11", "A01-12", "A02-11", "A02-12", "A03-11")
  7. testdata <- data.frame(category, sub.category, gran.category)
  8. server <- function(input, output, session) {
  9. df_testdata1 <- reactive({
  10. req(input$Output_category)
  11. if ("Cat-Sub" %in% input$Output_category) {
  12. testdata
  13. }
  14. })
  15. output$tab1 <- DT::renderDataTable({
  16. DT::datatable(df_testdata1(),
  17. style = "bootstrap",
  18. rownames = TRUE,
  19. selection = "none",
  20. escape = FALSE,
  21. filter = list(position = "bottom", clear = FALSE),
  22. options = list(autoWidth = TRUE, searching = TRUE)
  23. )
  24. })
  25. df_testdata2 <- reactive({
  26. req(input$Output_category)
  27. if ("Sub-Gran" %in% input$Output_category) {
  28. testdata
  29. }
  30. })
  31. output$tab2 <- DT::renderDataTable({
  32. DT::datatable(df_testdata2(),
  33. style = "bootstrap",
  34. rownames = TRUE,
  35. selection = "none",
  36. escape = FALSE,
  37. filter = list(position = "bottom", clear = FALSE),
  38. options = list(autoWidth = TRUE, searching = TRUE)
  39. )
  40. })
  41. output$downLoadFilterGranCat <- downloadHandler(
  42. filename = function() {
  43. paste("GranCat-", Sys.Date(), ".csv", sep = "")
  44. },
  45. content = function(file) {
  46. write.csv(df_testdata2()[input[["tab2_rows_all"]], ], file)
  47. }
  48. )
  49. }
  50. ui <- fluidPage(
  51. titlePanel("Analysis Dataset", windowTitle = "Category Dataset"),
  52. sidebarLayout(
  53. sidebarPanel(
  54. width = 2,
  55. selectInput("Output_category",
  56. choices = c("Cat-Sub", "Sub-Gran"),
  57. label = "Select the Output Category",
  58. multiple = TRUE
  59. )
  60. ),
  61. mainPanel(
  62. width = 10,
  63. DT::dataTableOutput("tab1"),
  64. DT::dataTableOutput("tab2"),
  65. conditionalPanel(
  66. 'input.Output_category.includes("Sub-Gran")',
  67. div(downloadButton("downLoadFilterGranCat", div(strong("Download Gran Category"),
  68. style = "text-align:center; color:green; font-size:100%"
  69. )), align = "center")
  70. )
  71. )
  72. )
  73. )
  74. shinyApp(ui = ui, server = server)

R Shiny – 仅在选择特定输入筛选器时显示下载按钮

答案2

得分: 0

以下是您要翻译的代码部分：

  1. # Added observeEvent
  2. observeEvent(input$Output_category, {
  3.   print("printing:::::::")
  4.   print(input$Output_category)
  5.   if (input$Output_category != "Sub-Gran")
  6.   {
  7.     output$download_button <- renderUI({})
  8.   }
  9. })

请注意，这是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.

  2. library(shiny)
  3. library(dplyr)
  4. library(DBI)
  5. library(readxl)
  6. library(openxlsx)
  7. library(dbplyr)
  8. library(shinythemes)
  9. library(DT)
  10. library(shinyBS)
  14. category&lt;-c(&#39;AA&#39;,&#39;AA&#39;,&#39;AA&#39;,&#39;AA&#39;,&#39;AA&#39;,&#39;BB&#39;,&#39;BB&#39;,&#39;BB&#39;,&#39;BB&#39;,&#39;BB&#39;)
  15. sub.category&lt;- c(&#39;A01&#39;,&#39;A01&#39;,&#39;A02&#39;,&#39;A02&#39;,&#39;A03&#39;,&#39;B01&#39;,&#39;B02&#39;,&#39;B02&#39;,&#39;B03&#39;,&#39;B03&#39;)
  16. gran.category &lt;- c(&#39;A01-11&#39;,&#39;A01-12&#39;,&#39;A02-11&#39;,&#39;A02-12&#39;,&#39;A03-11&#39;,&#39;B01-11&#39;,&#39;B02-11&#39;,&#39;B02-12&#39;,&#39;B03-11&#39;,&#39;B03-12&#39;)
  17. val1&lt;-c(1,1,2,5,2,4,3,1,1,1)
  18. val2&lt;-c(2,2,2,2,2,2,2,2,2,2)
  19. val3&lt;-c(4,5,5,6,6,3,6,8,1,1)
  20. val4&lt;-c(0,0,0,0,0,0,0,0,0,0)
  22. testdata &lt;- as.data.frame(cbind(category,sub.category,gran.category,val1,val2,val3,val4))
  24. n &lt;- 5
  25. testdata &lt;- do.call(&quot;rbind&quot;, replicate(n, testdata, simplify = FALSE))
  26. testdata1 &lt;- testdata
  27. colnames(testdata1) &lt;- c(&#39;boomchicka&#39;, &#39;boom1chicka*&#39;,&#39;boom2bookmboom&#39;,&#39;boom3&#39;,&#39;boom4&#39;,&#39;boom5&#39;,&#39;boom6&#39;)
  28. testdata &lt;- cbind(testdata,testdata1)
  30. #testdata &lt;- cbind(testdata,testdata)
  33. ## Filters
  34. cat_name &lt;- unique(testdata$category)
  35. cat_sub_name &lt;- testdata %&gt;% select(category, sub.category, gran.category) %&gt;% 
  36.   distinct() %&gt;% arrange(sub.category, gran.category)
  37. cat_sub_gran_name &lt;- testdata %&gt;% select(category, sub.category, gran.category) %&gt;% 
  38.   distinct() %&gt;% arrange(sub.category, gran.category)
  41. # Server function to determine the input and output parameters
  42. server &lt;- function(input, output, session) {
  43.   
  44.   ###   
  45.   df_testdata1 &lt;- reactive({
  46.     if (input$Output_category == &quot;Cat-Sub&quot;) {
  47.       
  48.       if (is.null(input$test_category) &amp; is.null(input$test_subcategory) )
  49.       {
  50.         testdata
  51.       }
  52.       
  53.       else if (is.null(input$test_category) &amp; !is.null(input$test_subcategory) )
  54.       {
  55.         
  56.         testdata %&gt;% filter(sub.category %in% input$test_subcategory)
  57.         
  58.       }
  59.       else if (!is.null(input$test_category) &amp; is.null(input$test_subcategory)) 
  60.       {
  61.         
  62.         testdata %&gt;% filter(category %in% input$test_category)
  63.         
  64.       }
  65.       else if (!is.null(input$test_category) &amp; !is.null(input$test_subcategory))
  66.       {
  67.         testdata %&gt;% filter (category %in% input$test_category &amp; sub.category %in% input$test_subcategory)
  68.         
  69.       }
  70.       
  71.     }
  72.     
  73.     
  74.     
  75.     
  76.     
  77.     
  78.     
  79.   })
  80.   
  81.   output$tab1 &lt;- DT::renderDataTable({
  82.     
  83.     DT::datatable(df_testdata1(),
  84.                   style = &quot;bootstrap&quot;, 
  85.                   rownames=TRUE,
  86.                   selection=&#39;none&#39;,
  87.                   escape=FALSE,
  88.                   filter = list(position = &#39;bottom&#39;, clear = FALSE), 
  89.                   options = list(autoWidth = TRUE, searching = TRUE))
  90.     
  91.     
  92.     
  93.   })
  94.   
  95.   # Added observeEvent
  96.   observeEvent(input$Output_category, {
  97.     print(&quot;printing:::::::&quot;)
  98.     print(input$Output_category)
  99.     if (input$Output_category != &quot;Sub-Gran&quot;)
  100.     {
  101.       output$download_button &lt;- renderUI({})
  102.     }
  103.   })
  105.   
  106.   df_testdata2 &lt;- reactive({
  107.     
  108.     if (input$Output_category == &quot;Sub-Gran&quot;){
  109.       
  110.       
  111.       # If true then display output button.
  112.       output$download_button &lt;- renderUI({
  113.         div(downloadButton(&#39;downLoadFilterGranCat&#39;,div(strong(&quot;Download Gran Category&quot;),
  114.                                                        style = &quot;text-align:center; color:green; font-size:100%&quot;)),align=&#39;center&#39;)
  115.       })
  116.       if (is.null(input$test_subcategory) &amp; is.null(input$test_grancategory) )
  117.       {
  118.         testdata
  119.       }
  120.       
  121.       else if (is.null(input$test_subcategory) &amp; !is.null(input$test_grancategory) )
  122.       {
  123.         
  124.         testdata %&gt;% filter(gran.category %in% input$test_grancategory)
  125.         
  126.       }
  127.       else if (!is.null(input$test_subcategory) &amp; is.null(input$test_grancategory)) 
  128.       {
  129.         
  130.         testdata %&gt;% filter(sub.category %in% input$test_subcategory)
  131.         
  132.       }
  133.       else if (!is.null(input$test_subcategory) &amp; !is.null(input$test_grancategory))
  134.       {
  135.         testdata %&gt;% filter (sub.category %in% input$test_subcategory &amp; gran.category %in% input$test_grancategory)
  136.         
  137.       }
  138.       
  139.     }
  140.     
  141.     
  142.     
  143.     
  144.     
  145.     
  146.   })
  147.   
  148.   output$tab2 &lt;- DT::renderDataTable({
  149.     
  150.     DT::datatable(df_testdata2(),
  151.                   style = &quot;bootstrap&quot;, 
  152.                   rownames=TRUE,
  153.                   selection=&#39;none&#39;,
  154.                   escape=FALSE,
  155.                   filter = list(position = &#39;bottom&#39;, clear = FALSE), 
  156.                   options = list(autoWidth = TRUE, searching = TRUE))
  157.     
  158.     
  159.     
  160.   })
  161.   
  162.   ## Enablind a download handler for CDASH Fields
  163.   output$downLoadFilterGranCat &lt;- downloadHandler(
  164.     filename = function() {
  165.       paste(&#39;GranCat-&#39;, Sys.Date(), &#39;.csv&#39;, sep = &#39;&#39;)
  166.     },
  167.     content = function(file) {
  168.       write.csv(df_testdata2()[input[[&quot;tab2_rows_all&quot;]], ],file)
  169.     }
  170.   )
  171.   
  172.   
  173.   ## Dependent reactive filter for the sub category
  174.   observeEvent(input$test_category, {
  175.     
  176.     if (is.null(input$test_category)) {
  177.       subcatToShow = unique(cat_sub_gran_name$sub.category)
  178.       #selected &lt;- character(0)
  179.     }else {
  180.       subcatToShow = cat_sub_gran_name %&gt;% 
  181.         filter(category %in% input$test_category) %&gt;% 
  182.         pull(unique(sub.category))
  183.       #selected &lt;- subcatToShow[1]
  184.     }
  185.     
  186.     #Update the actual input
  187.     updateSelectInput(session, &quot;test_subcategory&quot;, choices = subcatToShow 
  188.     )
  189.     
  190.   },ignoreNULL = FALSE)
  191.   
  192.   ## Dependent reactive filter for the sub category
  193.   observeEvent(input$test_subcategory, {
  194.     
  195.     if (is.null(input$test_category) &amp; is.null(input$test_subcategory)) {
  196.       grancatToShow = cat_sub_gran_name$gran.category
  197.       
  198.     }
  199.     else if (is.null(input$test_category) &amp; !is.null(input$test_subcategory)){
  200.       grancatToShow = cat_sub_gran_name %&gt;% 
  201.         filter(sub.category %in% input$test_subcategory) %&gt;% 
  202.         pull(gran.category)
  203.     }
  204.     else if (!is.null(input$test_category) &amp; is.null(input$test_subcategory)){
  205.       grancatToShow = cat_sub_gran_name %&gt;% 
  206.         filter(category %in% input$test_category) %&gt;% 
  207.         pull(gran.category)
  208.     }
  209.     else if (!is.null(input$test_category) &amp; !is.null(input$test_subcategory)){
  210.       grancatToShow = cat_sub_gran_name %&gt;% 
  211.         filter(category %in% input$test_category &amp; sub.category %in% input$test_subcategory ) %&gt;% 
  212.         pull(gran.category)
  213.     }
  214.     
  215.     #Update the actual input
  216.     updateSelectInput(session, &quot;test_grancategory&quot;, choices = grancatToShow
  217.     )
  218.     
  219.   },ignoreNULL = FALSE)
  220.   
  221.   
  222. }
  226. # UI section of the program to design the front-end of the web application 
  228. ui &lt;- fluidPage(
  229.   theme = shinytheme(&#39;darkly&#39;),
  230.   
  231.   titlePanel(&quot;Analysis Dataset&quot;, windowTitle=&quot;Category Dataset&quot;
  232.   ),
  233.   
  234.   sidebarLayout(
  235.     
  236.     
  237.     
  238.     mainPanel(
  239.       width = 10,
  240.       DT::dataTableOutput(&#39;tab1&#39;),
  241.       DT::dataTableOutput(&#39;tab2&#39;),
  242.       ## Download filter functionality
  243.       # Added Dynamic Output
  244.       uiOutput(outputId = &quot;download_button&quot;)
  245.     ),
  246.     
  247.     sidebarPanel( 
  248.       width = 2,
  249.       
  250.       selectInput(&quot;Output_category&quot;,
  251.                   choices = c(&quot;Cat-Sub&quot;,&quot;Sub-Gran&quot;), 
  252.                   label = &quot;Select the Output Category&quot;,
  253.                   multiple = TRUE),
  254.       
  255.       selectInput(&quot;test_category&quot;,
  256.                   choices = cat_name, 
  257.                   label = &quot;Select the category name&quot;,
  258.                   multiple = TRUE),
  259.       
  260.       selectInput(&quot;test_subcategory&quot;,
  261.                   choices = c(), 
  262.                   label = &quot;Select the sub category name&quot;,
  263.                   multiple = TRUE),
  264.       
  265.       selectInput(&quot;test_grancategory&quot;,
  266.                   choices = c(), 
  267.                   label = &quot;Select the gran category name&quot;,
  268.                   multiple = TRUE)
  269.       
  270.       
  271.     )
  272.     
  273.     
  274.     
  275.   )
  276.   
  277.   
  278. )
  280. shinyApp(ui = ui, server = server)

huangapple
  • 本文由 发表于 2023年5月10日 21:40:56
  • 转载请务必保留本文链接：https://go.coder-hub.com/76219155.html
  • button
  • download
  • r
  • shiny
匿名

发表评论

匿名网友

:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen:

确定