R Shiny中如何用if/then条件语句替代req函数响应Action Button

核心逻辑说明：Shiny的actionButton组件初始值为0，用户每点击一次数值自动+1，我们可以基于这个特性通过if/else分支替换原来的req函数实现需求

具体修改步骤 #

1. 替换renderUI中的req逻辑 #

将原server代码中output$Vectors对应的代码块替换为以下if/else结构：

# 新增状态变量控制显示逻辑，支持hide按钮回到初始状态
show_vector_flag <- reactiveVal(FALSE)
observeEvent(input$showBtn, {show_vector_flag(TRUE)})
observeEvent(input$hideBtn, {show_vector_flag(FALSE)})

output$Vectors <- renderUI({
  if(!show_vector_flag()){
    # 未点击/点击隐藏按钮时，展示提示文本
    p("等待输入")
  } else {
    # 点击显示按钮后，展示矩阵组件
    tagList(matrix2.input("vector_input",input$periods,input$base_input[1,1]))
  }
})

如果你不需要支持hide按钮回到「等待输入」状态，也可以直接判断input$showBtn的数值，写法如下：

output$Vectors <- renderUI({
  if(input$showBtn == 0){
    p("等待输入")
  } else {
    tagList(matrix2.input("vector_input",input$periods,input$base_input[1,1]))
  }
})

2. 修复原代码的按钮绑定错误 #

原代码中事件绑定的按钮id和UI定义的id不匹配，可删除原有的两行observeEvent(input$showPerfVectorBtn...)和observeEvent(input$hidePerfVectorBtn...)代码，我们已经在第一步的状态控制逻辑中处理了按钮点击事件。

3. 可选：避免图表区域报错 #

未点击按钮时vector_input不存在，直接渲染图表会触发报错，可以给output$graph1也加上判断逻辑：

output$graph1 <- renderPlot({
  if(show_vector_flag() && !is.null(input$vector_input)){
    plot(vector.final(periods(),matrix.validate(periods(),vector_input())),type="b")
  }
})

修改后完整可运行代码 #

library(shiny);library(shinyMatrix);library(shinyjs)

matrix1.input <- function(x){
  matrixInput(
    x,
    value = matrix(c(0.2), 4, 1, dimnames = list(c("A","B","C","D"),NULL)),
    rows = list(extend = FALSE,  names = TRUE),
    cols = list(extend = FALSE, names = FALSE, editableNames = FALSE),
    class = "numeric")}

matrix2.input <- function(x,y,z){
  matrixInput(
    x,
    value = matrix(c(y,z),1,2,dimnames=list(NULL,c("Y","Z"))),
    rows = list(extend = TRUE,  names = FALSE),
    cols = list(extend = FALSE, names = TRUE, editableNames = FALSE),
    class = "numeric")}  

matrix.validate <- function(x,y){
  a <- y  
  a[,1][a[,1]>x] <- x 
  b <- diff(a[,1,drop=FALSE])
  b[b<=0] <- NA              
  b <- c(1,b)                
  a <- cbind(a,b)
  a <- na.omit(a)
  a <- a[,-c(3),drop=FALSE]
  return(a)}

vector <- function(X,Y,Z){                                            
  a <- rep(NA, X)
  a[Y] <- Z
  a[seq_len(min(Y)-1)] <- a[min(Y)]
  if(max(Y) < X){a[seq(max(Y)+1, X, 1)] <- 0}
  a <- approx(seq_along(a)[!is.na(a)],a[!is.na(a)],seq_along(a))$y
  b <- seq(1:X)
  c <- data.frame(X = b, Z = a)
  return(c)}

vector.final <- function(x,y){vector(x,matrix.validate(x,y)[,1],matrix.validate(x,y)[,2])}

ui <- 
  pageWithSidebar(
    headerPanel("Model"),
    sidebarPanel(
      conditionalPanel(condition="input.tabselected==2",
                       sliderInput('periods','',min=1,max=120,value=60),
                       matrix1.input("base_input"),
                       useShinyjs(),
                       actionButton('showBtn','Show vector'), 
                       actionButton('hideBtn','Hide vector'),
                       uiOutput("Vectors")),
    ), 
    mainPanel(tabsetPanel(
      tabPanel("Dynamic", value=2,plotOutput("graph1")),
      id = "tabselected")
    ) 
  ) 

server <- function(input,output,session)({
  periods       <- reactive(input$periods)
  base_input    <- reactive(input$base_input)
  vector_input  <- reactive(input$vector_input)
  # 新增状态控制
  show_vector_flag <- reactiveVal(FALSE)
  observeEvent(input$showBtn, {show_vector_flag(TRUE)})
  observeEvent(input$hideBtn, {show_vector_flag(FALSE)})

  observeEvent(input$periods|input$base_input,{
    updateMatrixInput(session,"vector_input", 
                      value=matrix(c(input$periods,input$base_input[1,1]),1,2, 
                                   dimnames=list(NULL, c("Y","Z")))
    ) 
  }) 
  
  # if/else替换req后的renderUI
  output$Vectors <- renderUI({
    if(!show_vector_flag()){
      p("等待输入")
    } else {
      tagList(matrix2.input("vector_input",input$periods,input$base_input[1,1]))
    }
  }) 
  
  # 加判断避免报错的渲染逻辑
  output$graph1 <- renderPlot({
    if(show_vector_flag() && !is.null(input$vector_input)){
      plot(vector.final(periods(),matrix.validate(periods(),vector_input())),type="b")
    }
  })
}) 

shinyApp(ui, server)

内容的提问来源于stack exchange，提问作者Curious Jorge - user9788072