Shiny crashing when I increase the number of rows of a table


#1

Hi, I am trying to solve a crash in my Shiny App for some time but could not figure out how, any thoughts?

Basically I have a hotable which does some calculations based on another table. Every time I try to increase the number of flow zones the app crashes saying that "subscript out of bounds [No stack trace available]"

My code is below, If anyone can help me to understand what is going on and how to fix It would be very helpful, thanks!

PS: The problem is on the observe reactive function chunck of the code

ui <- fluidPage(
  tabsetPanel(
    tabPanel("Introduction", #tab used for introduction where the app is explained
      titlePanel("Introduction"),
        mainPanel(
          h2("Summary"),
          br(), br(), #line space between content
          h2("Installation"),
          br(), br(),
          h2("Input"),
          br(), br(),
          h2("Output"),
          br(), br(),
          h2("Model parameters"),
          br(), br(),
          h2("Simulation output")
        ) #close mainPanel
    ), #close introduction tabPanel
    tabPanel("Well data", #tab used for entering the well data
      titlePanel("Enter well basic data information"),
        mainPanel(
          fluidRow(
            column(6,
              textInput(inputId = "Wellname", 
                          label = "Wellname:",
                          width = "200px"),
              numericInput(inputId = "ElevationReference",
                             label = "Elevation reference",
                             value = "555.53",
                             width = "200px"),
              numericInput(inputId = "WellDiam",
                             label = "Well diameter",
                             value = 6,
                             width = "200px")
                 ), #close column
            column(6,
              numericInput(inputId = "Drawdown",
                             label = "Drawdown",
                             value = "3.5",
                             width = "200px"),
              numericInput(inputId = "DepthAmbientWaterLevel",
                             label = "Depth to ambient water level",
                             value = "4.62",
                             width = "200px"),
              numericInput(inputId = "DepthBottonCasing",
                             label = "Depthat botton of casing",
                             value = 10,
                             width = "200px"),
              numericInput(inputId = "DepthBottonWell",
                             label ="Depth at botton of well",
                             value = 140,
                             width = "200px")
          ) #close column
        )  #close fluiRow
      ) #close mainPanel
    ), #close well data tabPanel
    tabPanel("Flowmeter data", #tab used for uploading the raw or processed data
      titlePanel("Uploading Files"),
      sidebarLayout(
        sidebarPanel(
          fileInput('file1', 
                    'Choose ambient flow txt File',
                    accept=c('text/csv',
                             'text/comma-separated-values,text/plain',
                             '.csv')
                    ), #close fileInput
          fileInput('file2', 
                    'Choose pumped flow txt File',
                    accept=c('text/csv',
                             'text/comma-separated-values,text/plain',
                             '.csv')
                    ), #close fileInput
          tags$br(),
          radioButtons('sep',
                       'Separator',
                       c(Comma=',',
                       Semicolon=';',
                       Tab='\t'),
                       ',')
          ), #close radioButtons
        mainPanel(
          h5("Ambient flow raw data"), #title
          tableOutput('contents1'), #table location with ambient flow data uploaded
          h5("Pump flow raw data"), #title
          tableOutput('contents2') #table location with stressed flow data uploaded
        ) #close mainPanel
      ) #close sidebarLayout
    ), #close tabPanel flow data uploaded
    tabPanel("Flow log analysis", #tab used for the flow log analysis
      pageWithSidebar(
        headerPanel('Output my data'),
        sidebarPanel(
          numericInput(inputId = "NumberFlowZones",
                       label = "Number of flow zones",
                       min=1,
                       max=10,
                       value=NULL,
                       width = "200px"),
          actionButton("gobutton","Update"),
          br(),
          numericInput(inputId = "ROI",
                       label = "Well Radius of Influence (ROI)",
                       value = 95,
                       width = "150px"),
          numericInput(inputId = "Ttotal",
                       label = "Well Transmissivity",
                       value = 26,
                       width = "150px"),
          br(),
          h2("Solver"),
          checkboxInput("Regularization", "Solve with regularization",F),
          numericInput(inputId = "ABSmax",
                       label = "ABSmax",
                       value = 1,
                       width = "150px"),
          numericInput(inputId = "RegularizationWeight",
                       label = "Regularization Weight",
                       value = 1,
                       width = "150px"),
          numericInput(inputId = "TfactorMin",
                       label = "T factor minimum",
                       value = 1,
                       width = "150px")
               ), #close sidebarPanel
        mainPanel(
          fluidRow(
            column(12,
              hotable("InterpFlowZones"),br(),
              hotable("SimulFlowZones")
            ) #close column
          ), #close fluidRow
          fluidRow(
            column(6,
              plotOutput('MyPlot1')
            ), #close column
            column(6,
              plotOutput('MyPlot2') 
            ) #close column
          ) #close fluidRow
        ) #close mainPanel
      ) #close pageWithSidebar
    ) #close tabPanel flow log analysis
  ) #close tabsetPanel
) #close ui fluidPage

server <- function(input,output){
  data <- eventReactive(input$gobutton,{ #atributes the data table to a variable which will be used as a function later
    if(is.null(input$NumberFlowZones)){ #if no flow zones are entered return nothing
      return()
    } #close if
    InterpFlowZones <- setNames(data.frame(matrix(data=0, #else create the table to enter the data
                                                  nrow = input$NumberFlowZones,
                                                  ncol = 6)
                                           ), #close the data.frame func.
                                c("Zone","Depth","Ambient flow","Stressed flow","Tfactor","aH")
                                ) #close setNames
    InterpFlowZones #não sei se tiro ou deixo, por hora ficou
  }) #close event reactive
  output$InterpFlowZones <- renderHotable({ #hotable receive the function data above but allow editing with the readOnly=F
    data()
    }, readOnly = FALSE)
  observe({  #start an interative event based on changes in the InterpFlowZones
    MirrorTable <- hot.to.df(input$InterpFlowZones) #get the data from the InterpFlowZones and put into a new data table
    if(!is.null(MirrorTable)) {    #ensure data frame from table exists
      B = data.matrix(MirrorTable) #ensure its numeric
      R = as.data.frame(B) #covert the matrix into data frame
      R[,1] = B[,1] #copy the zone from InterpFlowZones
      R[,2] = B[,2] #copy the depth from InterpFlowZones
      R[,3] = ((input$ElevationReference-input$DepthAmbientWaterLevel)+B[,6]) #calculate the zone farfield head
      for(i in input$NumberFlowZones:1){
        if(i==input$NumberFlowZones){
          R[input$NumberFlowZones,4] = (((2*pi*B[input$NumberFlowZones,5]*input$Ttotal*(R[input$NumberFlowZones,3]-(input$ElevationReference-input$DepthAmbientWaterLevel)))/(log(input$ROI/(input$WellDiam/2/12))))/192.5) #calculate the simulated ambient flow for the last zone
          R[input$NumberFlowZones,5] = (((2*pi*B[input$NumberFlowZones,5]*input$Ttotal*(R[input$NumberFlowZones,3]-(input$ElevationReference-(input$Drawdown+input$DepthAmbientWaterLevel))))/(log(input$ROI/(input$WellDiam/2/12))))/192.5) #calculate the simulated stressed flow for the last zone
        }else{
          R[i,4] = (((2*pi*B[i,5]*input$Ttotal*(R[i,3]-(input$ElevationReference-input$DepthAmbientWaterLevel)))/(log(input$ROI/(input$WellDiam/2/12))))/192.5)+R[(i+1),4] #calculate the simulated ambient flow for the last zone
          R[i,5] = (((2*pi*B[i,5]*input$Ttotal*(R[i,3]-(input$ElevationReference-(input$Drawdown+input$DepthAmbientWaterLevel))))/(log(input$ROI/(input$WellDiam/2/12))))/192.5)+R[(i+1),5] #calculate the simulated stressed flow for the last zone
        } #close the else
      } #close the for
      R[,6] = B[,3]-R[,4] #calculate the ambient error
      R[,7] = B[,4]-R[,5] #calculate the stressed error
      R[,8] = B[,5]*input$Ttotal #calculate the zone transmissivity
      R[,9] = R[,8]/sum(R[,8]) #calculate the percentage compared with the total transmissivity
      output$SimulFlowZones <- renderHotable({(setNames(data.frame(R), c("Zone", "Depth", "Farfield head", "Ambient Flow","Stressed flow", "Ambient error", "Stressed error", "Zone T", "Ttotal %")))}, readOnly = TRUE) #show the simulated table at the server display
    } #close the if statement
  }) # end of observe
} #close server function
shinyApp(ui=ui, server=server) #run the shiny app

#2

What package is hotable from?

My guess is the error happens when input$NumberFlowZones goes above the number of rows in MirrorTable.

Try recreating the process with different situations in a regular R script without shiny. See if you can recreate the error.


Also, some unrelated tips:

  • Use column names instead of indices. The code would be easier to read and won't break if you add or remove other columns. It also shows the concepts as code, so you won't need as many comments. For example,

    R[, 6] = B[, 3] - R[, 4] #calculate the ambient error
    

    could be rewritten as

    R[, "Ambient error"] <- B[, "Ambient flow"] - R[, "Stressed flow"]
    

    By the way, if I got those columns wrong, consider it evidence that numeric indexing carries risk of confusion.

  • Use seq_len(input$NumberFlowZones) instead of 1:input$NumberFlowZones. This has better behavior when x is 0 or negative. This specific case won't have non-positive values because of the input definition, but it's a good habit to learn.

  • Try to improve readability. It's totally possible to take your time and read each piece of code to figure it out. But your time is valuable, and having to follow multiple nested function calls or look up column names is a waste of your time.

    For example, replace

    InterpFlowZones <- setNames(data.frame(matrix(data=0, #else create the table to enter the data
                                                      nrow = input$NumberFlowZones,
                                                      ncol = 6)
                                               ), #close the data.frame func.
                                    c("Zone","Depth","Ambient flow","Stressed flow","Tfactor","aH")
                                    ) #close setNames
    

    with

    default <- rep(0, input$NumberFlowZones)
    InterpFlowZones <- data.frame(
        "Zone"          = default,
        "Depth"         = default,
        "Ambient flow"  = default,
        "Stressed flow" = default,
        "Tfactor"       = default,
        "aH"            = default
    )
    

#3

Hi nwerth,

hotable is from the package shinysky

thank you very much for the advices, as a new user of R still a lot to learn by myself and when more experienced users like you give some feedback on how to improve the code is always very helpful.