How to add a nested list to a reactiveValue from a Shiny Module

Question

I need to add data from a nested list from a Shiny module to a global reactiveValues() variable.

The objective is to save different versions of the selected data into the reactiveValues for later use.

library(shiny)
library(tidyverse)
library(shinyWidgets)
library(DT)

addDataUI <- function(id) {
  ns <- NS(id)
  
  tagList(
    fluidRow(
      column(4,
             pickerInput(inputId = ns("measurement_type"),
                         label = "Estimate Type",
                         choices = c("height", "weight"),
                         selected = c("height", "weight"),
                         multiple = TRUE)
             )
    ),
    tableOutput(ns("summary")),
    br(),
    actionButton(ns("add_dataset"), 'Add dataset')
    )
  }



addDataServer <- function(id, dataset) {
  moduleServer(id, function(input, output, session) {
    results <- reactive({
      dataset() %>% 
        filter(measurement_type %in% input$measurement_type) 
    })
    output$summary <- renderTable(results())
    
    addObject <- reactiveVal()
    
    observeEvent(input$add_dataset, {
      objectChoice <- "measurementTable"
      chars <- c(0:9, letters, LETTERS)
      randomId <- stringr::str_c(sample(chars, 4, replace = TRUE) , collapse = "" )
      dataReport <- list()
      addObject(
        dataReport[[randomId]][[objectChoice]] <- dataset()
        )
    })
    addObject
    })
  }


ui <- fluidPage(
  titlePanel("Measurement App"),
  fluidRow(column(6, actionButton("resetDataset", "Reset Dataset"))),
  fluidRow(column(6, addDataUI("measurements"))),
  fluidRow(column(6, DTOutput("dataReportMenu")))
)

server <- function(input, output) {
  
  dataset <- tribble(
    ~database, ~measurement_type, ~estimate,
    "A", "weight", 10,
    "B", "height", 20,
    )
  
  dataReport <- reactiveValues()
  
  observeEvent(input$resetDataset, {
    dataReport <- reactiveValues()
  })
  
  newData <- addDataServer(id = "measurements", dataset = reactive(dataset))
  
  observe({
    for (key in names(newData())) {
      dataReport <- newData()
    }
  }) %>%
    bindEvent(newData())
  
  objectsListPreview <- reactive({
    dataReportList <- reactiveValuesToList(dataReport)
    if (length(dataReportList) == 0) {
      return("None")
    } else {
      objectList <- list()
      for (i in seq(1:length(dataReportList))) {
        objectList <- rbind(objectList, names(dataReportList[[i]]))
      }
      result <- unlist(objectList)
      return(result)
    }
  })
  
  output$dataReportMenu <- renderDT({
    dataReportFrame <- data.frame(
      Name = objectsListPreview()
    )
    DT::datatable(dataReportFrame, options = list(dom = 't'))
  })
  
}

shinyApp(ui = ui, server = server)

I am using this previous example in which they can update a dataframe saved into the reactive value.

But when I want to add a nested list to the reactiveValue, nothing happens in my case.

The dataReportMenu should show only the objectChoice that I am adding as a level in the nested list after the randomId.

Answer 1

For assignment to reactiveValues, you can use

 for (key in names(newData())) {
      dataReport[[key]] <- newData()
 }

Full code:

library(shiny)
library(tidyverse)
library(shinyWidgets)
library(DT)

addDataUI <- function(id) {
  ns <- NS(id)
  
  tagList(
    fluidRow(
      column(4,
             pickerInput(inputId = ns("measurement_type"),
                         label = "Estimate Type",
                         choices = c("height", "weight"),
                         selected = c("height", "weight"),
                         multiple = TRUE)
      )
    ),
    tableOutput(ns("summary")),
    br(),
    actionButton(ns("add_dataset"), 'Add dataset')
  )
}

addDataServer <- function(id, dataset) {
  moduleServer(id, function(input, output, session) {
    results <- reactive({
      dataset() %>% 
        dplyr::filter(measurement_type %in% input$measurement_type) 
    })
    output$summary <- renderTable(results())
    
    addObject <- reactiveVal()
    
    observeEvent(input$add_dataset, {
      objectChoice <- "measurementTable"
      chars <- c(0:9, letters, LETTERS)
      randomId <- stringr::str_c(sample(chars, 4, replace = TRUE) , collapse = "" )
      dataReport <- list()
      dataReport[[randomId]][[objectChoice]] <- dataset()
      addObject(
        dataReport
      )
      
    })
    return(addObject)
  })
}


ui <- fluidPage(
  titlePanel("Measurement App"),
  fluidRow(column(6, actionButton("resetDataset", "Reset Dataset"))),
  fluidRow(column(6, addDataUI("measurements"))),
  fluidRow(column(6, DTOutput("dataReportMenu")))
)

server <- function(input, output) {
  
  dataset <- tribble(
    ~database, ~measurement_type, ~estimate,
    "A", "weight", 10,
    "B", "height", 20,
  )
  
  dataReport <- reactiveValues()
  
  observeEvent(input$resetDataset, {
    dataReport <- reactiveValues()
  })
  
  newData <- addDataServer(id = "measurements", dataset = reactive(dataset))
  
  observe({
    for (key in names(newData())) {
      dataReport[[key]] <- newData()
    }
  }) %>%
    bindEvent(newData())
  
  # observe({print(newData())})
  
  objectList <- list()
  objectsListPreview <- reactive({
    dataReportList <- reactiveValuesToList(dataReport)
    
    if (length(dataReportList) == 0) {
      return("None")
    } else {
      # objectList <- list()
      for (i in seq(1:length(dataReportList))) {
        objectList <- rbind(objectList, names(dataReportList[[i]]))
      }
      result <- unlist(objectList)
      return(result)
    }
  })
  
  output$dataReportMenu <- renderDT({
    dataReportFrame <- data.frame(
      Name = objectsListPreview()
    )
    DT::datatable(dataReportFrame, options = list(dom = 't'))
  })
  
}

shinyApp(ui = ui, server = server)