2

While trying to come up with an overly complicated solution for this question, I stumbled across the following problem. I have 2 different modules, inputtable displays an rhandsontable and returns this table, and resulttable takes this table as the input, performs some calculation and displays the result as an rhandsontable. inputtable returns the rhandsontable object as a reactive value. Because there can be several copies of each module, I store the results from inputtable in a list and feed the list elements as the input to resulttable.

I've noticed that in resulttable, the reactive input input_data$input_table() can't directly be used. When I call a browser or print function or assign it to a variable before I use the reactive value for the actual purpose, then it works. Otherwise I get the error

attempt to apply non-function

As far as I understood passing reactive values to modules, this should work without the need to do something else to the reactive value before using it. If I don't use a list to store the reactive value, but only using one copy of each module and directly storing the result of inputtable in a variable and passing this to resulttable, it works as I would expect. (But storing the different reactive values in a reactiveValues object also leads to the error.)

Does someone know what is going on there?

I apologise for the long example, when I tried to shorten it I lost the error:

library(shiny)
library(rhandsontable)

# define the first module
resulttableUI <- function(id) {
  ns <- NS(id)
  tabPanel(title = ns(id),
           column(12,
                  rHandsontableOutput(ns("results_table"))))
}

resulttable <- function(id, input_data) {
  moduleServer(
    id,
    function(input, output, session) {
      # THE NEXT LINE NEEDS TO BE UNCOMMENTED TO MAKE IT WORK
      # used_data <- input_data$input_table()
      output$results_table <- renderRHandsontable({
        rhandsontable(hot_to_r(input_data$input_table())[2:5]/hot_to_r(input_data$input_table())[1:4])
      })
    }
  )
}

# define the second module
inputtableUI <- function(id) {
  ns <- NS(id)
  tabPanel(title = ns(id),
           column(12,
                  rHandsontableOutput(ns("input_table"))))
}

inputtable <- function(id, i) {
  moduleServer(
    id,
    function(input, output, session) {
      output$input_table <- renderRHandsontable({
        mat <- matrix(c(1:25) * i, ncol = 5, nrow = 5)
        mat <- as.data.frame(mat)
        rhandsontable(mat)
      })
      
      return(list(
        input_table = reactive({input$input_table})
      ))
    }
  )
}

ui <- navbarPage("App",
                 
                 tabPanel("Input",
                          numericInput('num_of_table', "Number of sub tabs: ", value = 1, min = 1, max = 10),
                          tabsetPanel(id = "insert_input")),
                 tabPanel("Results",
                          tabsetPanel(id = "insert_results"))
                 
)

number_modules <- 0
current_id <- 1

server <- function(input, output, session) {
  
  # variable to store the inputs from the modules
  input_data <- list()
  
  observeEvent(input$num_of_table, {
      modules_to_add <- input$num_of_table - number_modules
      for (i in seq_len(modules_to_add)) {
        # add the logic for the input
        input_data[[paste0("inputtable_", current_id)]] <<-
          inputtable(paste0("inputtable_", current_id), current_id)
        # add the logic for the results
        resulttable(paste0("resulttable_", current_id),
                    input_data = input_data[[paste0("inputtable_", current_id)]])
        
        # add the UI
        appendTab(inputId = "insert_input",
                  tab = inputtableUI(paste0("inputtable_", current_id)))
        appendTab(inputId = "insert_results",
                  tab = resulttableUI(paste0("resulttable_", current_id)))
        # update the id
        current_id <<- current_id + 1
        
      }
      
      number_modules <<- input$num_of_table
    
    updateTabsetPanel(session,
                      "insert_input",
                      "inputtable_1-inputtable_1")

  })
}


shinyApp(ui,server)

I'm using R 3.6.1 and shiny 1.5.0.

Unfortunately, there are 2 other issues:

  • You need to click on the result tab to render it
  • The first shown table from the inputtable module uses i = 2 instead of i = 1, I haven't figured out yet why.

So maybe there is something else wrong with my code. I'm glad for any hints for this strange behaviour or how to make a more minimal example.

starja
  • 9,887
  • 1
  • 13
  • 28
  • @Limey thanks for your response and the link. Unfortunately, the link only points to a list of your answers and not a specific answer. Could you update the link? Thanks – starja Jul 14 '20 at 16:01
  • 1
    Aplogies. Here's a revised comment. I'll delete the original. Your problem with `i == 2` rather than `i == 1` is because reactives evaluate lazily. By the time the first tab evaluates, `i` is `2`: hence your problem. My answer to [this post](https://stackoverflow.com/questions/62464271/render-dynamic-tabs-with-dynamic-plots-from-loop-in-shiny/62464557#62464557) is relevant and the link in my answer points to a clean and reliable implementation that can be adapted to your needs – Limey Jul 14 '20 at 16:31
  • @Limey Thanks again for your answer. Some follow-up questions: 1.: Do I understand it correctly that because of the lazy evaluation, it takes some time until the tab is evaluated, and the rest of the code is faster so that `i` is already 2? Or is there some other mechanism at work (e.g. some inputs need to change until the reactive is evaluated)? 2.: In your solution [here](https://stackoverflow.com/a/62342118/12647315) you circumvent the problem by forcing the evaluation through `observe`? 3.: Has my original problem maybe also to do with the effects of lazy evaluation of the reactives? – starja Jul 16 '20 at 18:27
  • Lazy evaluation is subtle. I don't fully understand it myself, so take what I say with a pinch of salt. It's not that some parts of the code are faster than others. Each part is only evaluated when it is needed. It turns out my solution works because `lapply` *forces* evaluation for each loop, but a `for` loop doesn't. See @MrFlick's comment on the answer [here](https://stackoverflow.com/questions/29733257/can-you-more-clearly-explain-lazy-evaluation-in-r-function-operators). More information on lazy evaluation [here](http://adv-r.had.co.nz/Functions.html) - scroll to "Lazy Evaluation". – Limey Jul 17 '20 at 06:58

1 Answers1

2

By changing for loop to lapply, and some other minor modifications in server function, I think it works. Try this

ui <- fluidPage(navbarPage("App",
                 
                 tabPanel("Input",
                          sliderInput('num_of_table', "Number of sub tabs: ", value = 1, min = 1, max = 10),
                          #numericInput('num_of_table', "Number of sub tabs: ", value = 1, min = 1, max = 10),
                          tabsetPanel(id = "insert_input")),
                 tabPanel("Results",
                          tabsetPanel(id = "insert_results"))
                 
))

#number_modules <- 0
current_id <- 0

server <- function(input, output, session) {
  number_modules <- reactiveVal(0)
  # variable to store the inputs from the modules
  input_data <- list()
  
  observeEvent(input$num_of_table, {
    req(input$num_of_table)
    if (input$num_of_table > number_modules() ){
      modules_to_add <- reactive({input$num_of_table - number_modules()})
    }else {
      modules_to_add <- reactive({0})
    }
    lapply(1:modules_to_add(), function(i) {
      # update the id
      current_id <<- current_id + 1
      input_data[[paste0("inputtable_", current_id)]] <<-
        inputtable(paste0("inputtable_", current_id), current_id)
      # add the logic for the results
      resulttable(paste0("resulttable_", current_id),
                  input_data = input_data[[paste0("inputtable_", current_id)]])
      
      ## add the UI
      if (input$num_of_table > number_modules() ){
        appendTab(inputId = "insert_input",
                  tab = inputtableUI(paste0("inputtable_", current_id)))
        appendTab(inputId = "insert_results",
                  tab = resulttableUI(paste0("resulttable_", current_id)))
      }
      
    })
    
    if (input$num_of_table > number_modules() ){
      number_modules(input$num_of_table)
      updateTabsetPanel(session,
                        "insert_input",
                        "inputtable_1-inputtable_1")
    }
    
  })
}

It may still need an update on what to display as input table displays the last table for all sub-tabs if a high number is chosen for num_of_table.

YBS
  • 19,324
  • 2
  • 9
  • 27
  • thank you very much for your response! Interesting that it works with `lapply` but not with `for`. Do you know what is actually going on here/why it is the case? – starja Jul 14 '20 at 16:00
  • I have found that R Shiny with reactive functions do not work well with `for` loops. It is best to use `lapply` or another approach. For more on this please see here https://stackoverflow.com/questions/46118166/for-loop-inside-reactive-function-in-shiny – YBS Jul 14 '20 at 16:12