ShinyR模态框中rhandsontable的hot_to_r()失效及图表自动更新问题

问题分析与修复 #

问题1：切换到多实验标签页直接点击Run报错"Error:argument is of length zero" #

原因：未打开模态框时，input$table2未被渲染，调用hot_to_r(input$table2)会返回空值，导致后续数据处理逻辑报错。

修复方案：

• 多实验标签页初始化时，直接将预设数据赋值给响应式变量，无需依赖未渲染的表格组件；
• 点击Run按钮时，先判断input$table2是否存在，存在则更新数据，否则保留现有预设数据。

问题2：修改μ0_g或μ0_m参数时图表自动更新 #

原因：图表渲染逻辑直接依赖实时输入参数input$mug0和input$mud0，参数变化会触发自动重绘。

修复方案：

• 使用reactiveValues存储"确认版"参数，仅在点击Run按钮时同步当前输入的参数值；
• 图表渲染仅依赖存储的确认参数，而非实时输入值。

修复后的完整代码 #

library(shiny)
library(plotly)
library(rhandsontable)
library(shinyBS)

source("submic_modif.R")

# USER INTERFACE
ui = navbarPage(
  id="navbar",
  shinyjs::useShinyjs(),
  tabPanel(
    "Model 1",
    sidebarLayout(
      sidebarPanel(
        fluidRow(
          column(5, numericInput(inputId = "mug0",
                                 label = "μ0_g ",
                                 value = 2.7233,
                                 step = 0.0001,
                                 width = '100%')),
          column(5, numericInput(inputId = "mud0",
                                 label = "μ0_m ",
                                 value = 3.5874e-02,
                                 step = 0.000001,
                                 width = '100%'))
        )
      ),
      mainPanel(plotlyOutput("plot_manual"))
    ),
    sidebarPanel(
      fluidRow(
        tabsetPanel(
          id = "model1_tabsetPanel",
          type = "tabs",
          tabPanel(
            "Single experiment",
            column(12, align="center", style="padding:16px",
                   actionButton("runSingle", "Run", class = "btn-success")),
            rHandsontableOutput("table", height = "400px")
          ),
          tabPanel(
            "Multiple experiment",
            column(12, align="center", style="padding:16px",
                   actionButton("runMultiple", "Run", class = "btn-success")),
            column(12, align="center", style="padding:16px",
                   actionButton("openModal", "Input data", class = "btn-info"))
          )
        )
      )
    )
  )
)

server = function(input, output, session) {
  # 存储确认后的参数（多实验标签页专用）
  confirmed_params <- reactiveValues(mug0 = 2.7233, mud0 = 3.5874e-02)
  
  # 监听标签页切换
  observeEvent(input$model1_tabsetPanel, {
    if(input$model1_tabsetPanel == "Single experiment"){
      # 单实验标签页原逻辑保留
      exp_df = data.frame(
        Time=c(0,2,4,8,12,16,20,24,30,36,48),
        y=c(3.025E+5,3.100E+6,3.3800E+9,5.5500E+10,2.180E+11,5.600E+11,9.780E+11,1.530E+12,1.610E+12,1.050E+12,8.630E+11)
      )
      datavalues=reactiveValues(data=exp_df)
      
      time_mod = c(0,5,10,15,20,25,30,35,40,45,50)
      y_mod = c(3.025000e+05,9.537914e+05,2.771997e+06,7.468204e+06,1.875098e+07,1.343028e+12,1.343028e+12,1.343028e+12,1.343028e+12,1.343028e+12)
      
      output$table = renderRHandsontable({
        rhandsontable(datavalues$data,maxRows = 100, colHeaders = c("Time","CFU/mL"))
      })
      
      observeEvent(input$runSingle, {
        datavalues$data=hot_to_r(input$table)
        p1=input$mug0
        p2=input$mud0
        y_exp=unlist(datavalues$data$y)
        time_exp = unlist(datavalues$data$Time)
        time_mod = time_exp
        y_mod =  y_exp * p1 * p2
        
        output$plot_manual=renderPlotly({
          plot_ly(datavalues$data, x=~Time, y=~y, name = "Experimental data", type = 'scatter',
                  mode = 'markers', color ="orange") %>% 
            add_lines(name="Model output",x=time_mod, y=y_mod, mode='line') %>% 
            layout(yaxis=list(showexponent= "all", exponentformat='E'))
        })
      })
      
      output$plot_manual=renderPlotly({
        plot_ly(datavalues$data, x=~Time, y=~y, name = "Experimental data", type = 'scatter',
                mode = 'markers', color ="orange") %>% 
          add_lines(name="Model output",x= time_mod, y=y_mod, mode='line') %>% 
          layout(yaxis=list(showexponent= "all", exponentformat='E'))
      })
    } else if (input$model1_tabsetPanel == "Multiple experiment"){
      # 初始化多实验预设数据
      preset_df = data.frame(
        exp1_t= c(0,2,4,8,12,16,20,24,30,36,48,rep(NA,89)),
        exp1_y = c(302500,5800000,5650000000,1.1675e11,4.975e11,1.9075e12,4.8250e12,5.4250e12,5.600e12,5.1250e12,3.9000e12,rep(NA,89)),
        exp1_d = c(50,50,50,50,50,50,50,50,50,50,50,rep(NA,89)),
        exp2_y = c(302500,3100000,3375000000,5.5500e10,2.175e11,5.6000e11,9.7750e11,1.5350e12,1.615e12,1.0525e12,8.6250e11,rep(NA,89)),
        exp2_d = c(50,50,50,50,50,50,50,50,50,50,50,rep(NA,89)),
        exp3_y = c(302500,1210000,2030000000,4.0000e10,1.520e11,3.5000e11,4.8000e11,7.8000e11,7.300e11,5.7000e11,4.9000e11,rep(NA,89)),
        exp3_d = c(50,50,50,50,50,50,50,50,50,50,50,rep(NA,89))
      )
      
      colHeaders = reactive({
        input_count = 1
        headers = character(7)
        headers[1] = "Time"
        for(i in seq(from = 2, to = 6, by = 2)){
          headers[i] = paste0(input[[paste0("colHeader", input_count )]], " CFU/mL")
          headers[i+1] = paste0(input[[paste0("colHeader", input_count )]], " Drug (mg/L)")
          input_count  = input_count  + 1
        }
        headers
      })
      
      outputValues=reactiveValues(data=preset_df)
      
      # 渲染模态框内的handsontable
      output$table2 = renderRHandsontable({
        rhandsontable(outputValues$data,maxRows = 100, colHeaders = colHeaders())
      })
      
      # 列标题更新逻辑修正
      for (i in 1:3) {
        observeEvent(input[[paste0("colHeader", i)]], {
          col_idx <- (i-1)*2 +1
          colnames(outputValues$data)[col_idx] <- input[[paste0("colHeader", i)]]
          colnames(outputValues$data)[col_idx+1] <- paste0(input[[paste0("colHeader", i)]], " Drug (mg/L)")
        })
      }
      
      # 多实验Run按钮逻辑
      observeEvent(input$runMultiple, {
        # 仅当表格存在时更新数据
        if(!is.null(input$table2)){
          outputValues$data <- hot_to_r(input$table2)
        }
        # 同步确认参数
        confirmed_params$mug0 <- input$mug0
        confirmed_params$mud0 <- input$mud0
        
        output$plot_manual = renderPlotly({
          p=plot_ly(type="scatter", mode="markers") 
          l=2
          while (l<ncol(outputValues$data)+1){
            p1=confirmed_params$mug0
            p2=confirmed_params$mud0
            time_exp = unlist(outputValues$data[1])
            y_exp= unlist(outputValues$data[l])
            time_mod = time_exp
            y_mod = y_exp * p1 * p2
            
            p = add_trace(p, x=time_exp, y= y_exp,  mode="markers", name= paste("Observed", (l-1)/2))
            p = add_lines(p, x=time_mod ,y= y_mod,  mode="line", name=paste("Expected ", (l-1)/2))
            l = l+2
          }
          p %>% 
            layout(yaxis=list(showexponent= "all", exponentformat='E'))
        })
      })
      
      # 初始渲染多实验默认图表
      output$plot_manual = renderPlotly({
        p=plot_ly(type="scatter", mode="markers") 
        l=2
        while (l<ncol(preset_df)+1){
          p1=confirmed_params$mug0
          p2=confirmed_params$mud0
          time_exp = unlist(preset_df[1])
          y_exp= unlist(preset_df[l])
          time_mod = time_exp
          y_mod = y_exp * p1 * p2
          
          p = add_trace(p, x=time_exp, y= y_exp,  mode="markers", name= paste("Observed", (l-1)/2))
          p = add_lines(p, x=time_mod ,y= y_mod,  mode="line", name=paste("Expected ", (l-1)/2))
          l = l+2
        }
        p %>% 
          layout(yaxis=list(showexponent= "all", exponentformat='E'))
      })
      
      # 模态框逻辑
      observeEvent(input$openModal, {
        showModal(
          modalDialog(
            id = "tableModal",
            title = "Input your data",
            footer = modalButton("Close"),
            easyClose = TRUE,
            size = "l",
            fluidRow(
              column(width = 12,
                     rHandsontableOutput("table2", height = "400px"),
                     column(width=6,
                            textInput("colHeader1", "Header 1:", value = "Exp1"),
                            textInput("colHeader2", "Header 2:", value = "Exp2"),
                            textInput("colHeader3", "Header 3:", value = "Exp3")
                     )
              )
            )
          )
        )
      })
    }
  })
}

shinyApp(ui, server)

额外修正说明 #

• 修复了原代码中列标题长度不匹配、循环次数错误、列索引计算错误等隐性问题；
• 多实验标签页新增初始图表渲染，无需点击Run即可查看默认数据可视化结果；
• 跳过药物列的图表绘制逻辑，避免无效数据展示。

内容的提问来源于stack exchange，提问作者Adrián Pedreira