是否可以在 2 个选项卡 [Shiny] 中使用相同的 actionButton？

Posted 2023-02-14

【中文标题】是否可以在 2 个选项卡 [Shiny] 中使用相同的 actionButton？

【英文标题】：Is it possible to have the same actionButton in 2 tabs [Shiny]?

【发布时间】：2022-01-21 23:10:48

【问题描述】：

我正在尝试创建一个具有 3 个选项卡的应用：

Tab 1 > 它有一个checkboxInput，如果您单击它，您将执行 log2 转换。此外，它还有一个actionButton 来提交您的数据（带或不带log2） Tab 2 > 它有一个sliderInput，允许您更改直方图的 bin。它还有另一个actionButton，但这次是为了展示情节。 Tab 3 > 它有一个numericInput，允许您更改绘图的不透明度。此外，它与您在选项卡 2 中找到的 actionButton 相同。

完美运行。但是，当我更改选项卡 3 中的不透明度并想更新绘图时，选项卡 3 中的 actionButton 不起作用。但是，如果您在更改不透明度后单击选项卡 2 中的 actionButton，则绘图会更新。

所以...出于这个原因，我想知道是否有办法在两个标签中使用相同的 actionButton。

代码：

library(shiny)
library(dplyr)
library(ggplot2)

hist_function <- function(DF, bins, alpha)
  hist <- DF %>% 
    ggplot(aes(value)) +
    geom_histogram(aes(y=..density.., fill = id), bins=bins, col="black", alpha=alpha) +
    geom_density() +
    facet_grid(id ~ .) + 
    ggtitle("My histogram....") +
    theme(strip.text.x = element_blank(),strip.text.y = element_blank()) 
  
  return(hist)

  
ui <- fluidPage(
  
  titlePanel("My app"),
  
  sidebarLayout(
    sidebarPanel(
      tabsetPanel(
        
        tabPanel("Tab1",
                 checkboxInput("log2", "Log2 transformation", value = FALSE),
                 actionButton("submit", "Submit")
        ),
        
        tabPanel("Tab2",
                 sliderInput("bins",
                             "Number of bins:",
                             min = 1,
                             max = 50,
                             value = 10),
                 actionButton("show_plot", "See the plot")
        ),
        
        tabPanel("Tab3",
                 numericInput("alpha", "Opacity of the histogram", value=0.2),
                 actionButton("show_plot", "See the plot")
        )
        
      )
    ),
    
    mainPanel(
      plotOutput("histogram"),

    )
  )
)


server <- function(input, output) 
  
  val1 <- c(2.1490626,3.7928443,2.2035281,1.5927854,3.1399245,2.3967338,3.7915825,4.6691277,3.0727319,2.9230937,2.6239759,3.7664386,4.0160378,1.2500835,4.7648343,0.0000000,5.6740227,2.7510256,3.0709322,2.7998003,4.0809085,2.5178086,5.9713330,2.7779843,3.6724801,4.2648527,3.6841084,2.5597235,3.8477471,2.6587736,2.2742209,4.5862788,6.1989269,4.1167091,3.1769325,4.2404515,5.3627032,4.1576810,4.3387921,1.4024381,0.0000000,4.3999099,3.4381837,4.8269218,2.6308474,5.3481382,4.9549753,4.5389650,1.3002293,2.8648220,2.4015338,2.0962332,2.6774765,3.0581759,2.5786137,5.0539080,3.8545796,4.3429043,4.2233248,2.0434363,4.5980727)
  val2 <- c(3.7691229,3.6478055,0.5435826,1.9665861,3.0802654,1.2248374,1.7311236,2.2492826,2.2365337,1.5726119,2.0147144,2.3550348,1.9527204,3.3689502,1.7847986,3.5901329,1.6833872,3.4240479,1.8372175,0.0000000,2.5701453,3.6551315,4.0327091,3.8781182)
  
  data <- reactive(
    df1 <- data.frame(value = val1)   
    df2 <- data.frame(value = val2)   
    
    data_df <- bind_rows(lst(df1, df2), .id = 'id')
  )
 
  
  mydata <- reactive(
    req(input$submit)
    
    if(input$log2 == TRUE)
      data <- data()
      cols <- sapply(data, is.numeric)
      data[cols] <- lapply(data[cols], function(x) log2(x+1))
    
    
    else
      data <- data()
    
    return(data)
  )
  
  
  v <- reactiveValues()
  observeEvent(input$show_plot, 
     v$plot <- hist_function(DF=mydata(), bins=input$bins, alpha=input$alpha)
  )
  
  output$histogram <- renderPlot(
    req(input$submit)
    if (is.null(v$plot)) return()
    v$plot
  )
  


shinyApp(ui = ui, server = server)

请注意，如果我在 tabsetPanel 完成时放置 actionButton，actionButton 在选项卡 3 中有效，但它出现在选项卡 1 中，这是我不想要的。我只想在该选项卡中有提交按钮。

ui <- fluidPage(
  
  titlePanel("My app"),
  
  sidebarLayout(
    sidebarPanel(
      tabsetPanel(
        
        tabPanel("Tab1",
                 checkboxInput("log2", "Log2 transformation", value = FALSE),
                 actionButton("submit", "Submit")
        ),
        
        tabPanel("Tab2",
                 sliderInput("bins",
                             "Number of bins:",
                             min = 1,
                             max = 50,
                             value = 10),
                 #actionButton("show_plot", "See the plot")
        ),
        
        tabPanel("Tab3",
                 numericInput("alpha", "Opacity of the histogram", value=0.2),
                 #actionButton("show_plot", "See the plot")
        )
        
      ),
      actionButton("show_plot", "See the plot") ### THIS IS THE NEW BUTTON
      
    ),
    
    mainPanel(
      plotOutput("histogram"),

    )
  )
)

另一方面，我正在考虑创建两个不同的按钮...因此，我必须将新按钮添加到 observeEvent... 但是，我想在这里问一下，以防有人知道如何在不创建新按钮的情况下做到这一点。

提前非常感谢

问候

【参考方案1】：

您不能有两个或多个具有相同 ID 的输入，但这并不意味着您需要有两个 observEvents。

更改第二个按钮的 ID：

tabPanel("Tab3",
                 numericInput("alpha", "Opacity of the histogram", value=0.2),
                 actionButton("show_plot_2", "See the plot")

并将oberveEvent 更改如下：

observeEvent(input$show_plot | input$show_plot_2, 
    v$plot <- hist_function(DF=mydata(), bins=input$bins, alpha=input$alpha)
  )

但是，请注意，现在用户可以更改 bin 的数量，不要单击“查看绘图”按钮，转到 tab3，更改不透明度，单击“查看绘图”，绘图将根据新的垃圾箱的数量和新的不透明度 - 考虑这是否会让用户感到惊讶。如果你不想要这个，那么你确实需要两个observeEvents。

我看到只有在会话中至少点击一次input$submit 时才会显示该图，这对我来说看起来很奇怪，所以我要留下这个注释:)。

【讨论】：

这正是我想要的。谢谢！关于input$submit是正常的，我决定这样放。