ShinyR“hot_to_r()”函数在放置在模态中的rhandsontable中不起作用除非我进行更改

问题描述 投票:0回答:1

我正在开发一个 ShinyR 应用程序。

根据您选择的选项卡(单个或多个实验),应用程序会显示用于单个实验(三列)的选项卡或一个按钮,用于打开带有列的模式以输入三个实验的数据。

“单个实验”选项工作正常:绘制初始默认值,并且仅在单击“运行”按钮时应用更改,而不是在修改输入“参数 1”或“参数 2”时应用更改。所以我复制了“多次实验”选项的结构。但是,我面临两个问题。当我选择该选项卡并单击“运行”时,我收到以下消息(错误:参数长度为零)。

另一方面,如果我单击“输入数据”,修改表的某些值并单击“运行”,则图表将正确更新。如果我之前不进行编辑,函数“hot_to_r”似乎无法使用表数据创建数据表。还有另一个问题,当我修改输入“Param 1”或“Param 2”时,图表会自动更新,而我希望仅在单击“运行”时才更新图表。老实说,我觉得第二个问题没有任何逻辑。

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) {
  
  #Observe selected tabset (Single/ Muliple experiment)
  
  observeEvent(input$model1_tabsetPanel,
    {
    ###-----------------------##
    ###    SINGLE EXPERIMENT  ##
    ###-----------------------##   
    if(input$model1_tabsetPanel == "Single experiment"){
      #Create a data frame and set predefined experimental values for initial plot
      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)
      )
      
      #Make dataframe reactive to changes
      datavalues=reactiveValues(data=exp_df)
      
      #Set predefine vectors to initial plot 
      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,1.343028e+12)

      #Create a handsontable with the dataframe content
      output$table = renderRHandsontable({
        rhandsontable(datavalues$data,maxRows = 100, colHeaders = c("Time","CFU/mL"))
      })
      
      #Refresh dataframe values and plot results just when clicking "Run" button
      observeEvent(
        input$runSingle,
        {datavalues$data=hot_to_r(input$table)
        
          # Packing equation parameters in a vector
          p1=input$mug0
          p2=input$mud0

          p=c(p1,p2)
          
          #Extracts experimental y and time from dataframe
          y_exp=unlist(datavalues$data$y)
          time_exp = unlist(datavalues$data$Time)
          
          #Generate model output
          time_mod = time_exp
          y_mod =  y_exp * p1 * p2
          
          #Plot results
          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'))
      })
    }
    
    ###-----------------------##
    ### CODE FOR UPLOAD FILE  ##
    ###-----------------------##  
    else if (input$model1_tabsetPanel == "Multiple experiment"){
      #Create a data frame and set predefined values for initial plot
      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(12)
        headers[1] = "Time"
        for(i in seq(from = 2, to = 10, 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
      })
      
      #Make dataframe reactive to changes
      outputValues=reactiveValues(data=preset_df)
      
      #Create a handsontable with the dataframe content, using inputs values to set colheaders
      output$table2 = renderRHandsontable({
        rhandsontable(outputValues$data,maxRows = 100, colHeaders = colHeaders())
      })
      
      #A loop that observe changes in inputs values and set col names in df and handsontable
      for (i in 1:5) {
        observeEvent(input[[paste0("colHeader", i)]], {
          colnames(preset_df)[i] = input[[paste0("colHeader", i)]]
          output$hot = renderRHandsontable({
            handsontable(outputValues$data,maxRows = 100, colHeaders = colHeaders())
          })
        })
      }
      
      #Apply changes in handsontable to dataframe when clicking in "Run"
      observeEvent(input$runMultiple,
                   {
                     outputValues$data = hot_to_r(input$table2)
                     output$plot_manual = renderPlotly({
                       p=plot_ly(type="scatter", mode="markers") 
                       
                       #Iterate over dataframe and dynamically add traces to plot
                       l=2
                       while (l<ncol(outputValues$data)+1){
                         #Packing parameters in a vector
                         p1=input$mug0
                         p2=input$mud0
                         params=c(p1,p2)
                         
                         #Extracts experimental y and time from dataframe
                         time_exp = unlist(outputValues$data[1])
                         y_exp= unlist(outputValues$data[l])
                         
                         #Generate model output
                         time_mod = time_exp
                         y_mod = y_exp * p1 * p2
                         
                         #Plot expected and observed results
                         p = add_trace(p, x=time_exp, y= y_exp,  mode="markers", name= paste("Observed", l-1))
                         p = add_lines(p, x=time_mod ,y= y_mod,  mode="line", name=paste("Expected ",l-1))
                         l = l+1
                       }
                       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)


shiny modal-dialog rhandsontable
1个回答
0
投票

我认为原因如下。当您在尚未打开模式的情况下选择“多个实验”选项卡并按“运行”按钮时,rhandsontable

table2
尚未渲染,因此
input$table2
NULL

要解决这个问题,您可以使用无功导体,而不是使用无功值

outputValues$data

Data <- reactive({
  if(is.null(input$table2)) {
    preset_df
  } else {
    hot_to_r(input$table2)
  }
})

顺便说一句,您正在嵌套反应性元素(观察者内部的观察者等),这是一个不好的做法。

© www.soinside.com 2019 - 2024. All rights reserved.