Background: I have an app where the user enters their cancer history. For each cancer type they need to enter 1) the name of the cancer, 2) the age of diagnosis, and 3) a conditional input with a secondary cancer name. Initially, the user sees no inputs, just an "add cancer" button. When they click this button, the UI module generates a set of those three inputs for entering the information for one cancer. Each successive click of the button adds a new set of inputs for another cancer. On the server side of my app, I have a three column data frame stored in a reactiveValues() for storing all of the cancer history information, I call this the master data frame. Each row of this data frame will store the cancer information for one cancer/one set of UI module inputs. This data frame should be updated any time any cancer input is updated.
The Problem: The UI module works great but the server module is a problem. The goal of the server module is to create a one row, three column data frame to store the data for one set of UI module inputs/one cancer. This single row data frame updates every time one of the three inputs in the related UI module is changed. In the server side of the app, I need the rows of the master data frame to be individually updated by each server module. When I try to do this I get the following error message just before the app crashes:
Warning: Error in as.vector: cannot coerce type 'environment' to vector of type 'any'
Using the View() function I inserted inside of the server module for testing confirms the server module is indeed doing what it is supposed to. The problem is integrating the server module into the master data frame.
REPREX:
UI module:
# module to enter data for one cancer
canUI <- function(id, canNum){
# reserve a local namespace for cancer hx
ns <- NS(id)
tags$div(id = paste0("canSubContainer", id),
tagList(
fluidRow(
column(width = 2,
selectInput(inputId = ns("Can"),
label = h5(paste0("Cancer ",canNum(),":")),
choices = c("No cancer selected", paste0("Cancer ", 1:10), "Other"),
width = "200px")
),
column(width = 1,
conditionalPanel(sprintf("input['%s'] != 'No cancer selected'", ns("Can")),
div(numericInput(inputId = ns("CanAge"),
label = h5("Diagnosis Age:"),
min = 0, max = 100, step = 1, value = NA,
width = "100px")
),
)
),
# remove this set of cancer inputs
column(width = 1,
actionButton(inputId = ns("removeCan"),
label = NULL,
icon = icon('trash'),
style = "margin-top:40px")
)
),
conditionalPanel(sprintf("input['%s'] == 'Other'", ns("Can")),
fluidRow(
column(1, h5("Other cancer:", style = "margin-left:25px")),
column(2,
div(selectizeInput(inputId = ns("CanOther"),
label = NULL,
choices = c("Unknown/Not Listed", paste0("Other Cancer", 1:10)),
selected = "Unknown/Not Listed",
multiple = FALSE,
options = list(create=TRUE),
width = "225px")
)
)
)
) # end of conditionalPanel for other cancers
) # end of tagList
) # end of div
}
Server module:
# module to transfer one set of cancer inputs (cancer name, age, other cancer name) to the cancer data frame
canServer <- function(id){
moduleServer(
id,
function(input, output, session){
# listen for changes in each of the three inputs
observeEvent(list(input$Can, input$CanAge, input$CanOther), {
# create a template 1 row data frame to store the inputs for this module
this.row <- data.frame(Cancer = "No cancer selected",
Age = NA,
Other = "")
# update the template 1 row data frame
this.row$Cancer[1] <- input$Can
this.row$Age[1] <- input$CanAge
this.row$Other[1] <- input$CanOther
# For testing: data frame appears correct here
# View(this.row)
# return the 1 row data frame
return(reactive({this.row}))
}, ignoreInit = TRUE, ignoreNULL = FALSE)
}
)
}
UI
# Define UI for application that draws a histogram
ui <- fluidPage(
# enter cancers
tags$div(
id = "canContainer",
style = "width:100%"
),
actionButton("addCan", label = "Add Cancer",
icon = icon('plus'))
)
Server:
# Define server logic required to draw a histogram
server <- function(input, output, session) {
# reactive values related to the module:
# 1) data frame to store all inputs from all modules (df)
# 2) a module counter (canNum)
canReactive <- reactiveValues(df = data.frame(Cancer = rep("No cancer selected", 25),
Age = rep(NA, 25),
Other = rep("", 25)),
canNum = 0)
# for testing only
observeEvent(canReactive$df, {
View(canReactive$df)
})
# add a module and advance the module counter when user requests via an add button
observeEvent(input$addCan, {
# advance the number of modules by one
canReactive$canNum <- canReactive$canNum + 1
# create a unique ID for this set of modules
id <- paste0("canModule", canReactive$canNum)
# insert a new module into the UI
insertUI(
selector = "#canContainer",
where = "beforeEnd",
ui = canUI(id = id, canNum = reactive(canReactive$canNum))
)
# store inputs from a module to a row in the master data frame of cancer information
canReactive$df[canReactive$canNum,] <- canServer(id = id)
# observe if any UI model's delete button is clicked
observeEvent(input[[paste0(id, '-removeCan')]], {
# deleted the UI module for the specified set of cancer inputs
removeUI(selector = paste0("#canSubContainer",id))
# clean-up memory
remove_shiny_inputs(id, input)
# reduce cancer module counter by one
if(canReactive$canNum > 0){
canReactive$canNum <- canReactive$canNum - 1
}
})
})
}
# Run the application
shinyApp(ui = ui, server = server)
Other code:
# function to clean up memory when module inputs are deleted
remove_shiny_inputs <- function(id, .input) {
invisible(
lapply(grep(id, names(.input), value = TRUE), function(i) {
.subset2(.input, "impl")$.values$remove(i)
})
)
}
