Shiny app not working after being split into modules

Question

I have the following shiny app that works correctly in app.R/ui.R-server.R. The main idea is that an user submit a dataset and then the app can highlight some errors in the dataset (i.e., incorrect data formats, ranges, etc.), so the user can modify them directly in the app or download the data. However, when I split the app in different modules and functions, the app is not working anymore. I think the issue is related to how I try to access to df$data in the different modules but I am not entirely sure.

Code to built a df(.xlsx) to be submitted in the app:

df_submitted <- data.frame(x=c(1:20),y=c(0:1),z=c("R"))
df_submitted[[2,2]] <- 3
df_submitted[[5,2]] <- "yes"
df_submitted[[6,2]] <- "no"
df_submitted[[3,3]] <- "python"

Single file app (working)

library(shiny)
library(readxl)
library(openxlsx)
library(tidyverse)
library(validate)
library(DT)
library(shinyjs)
library(jsonlite)


ui <- (fluidPage(
  useShinyjs(),
  titlePanel("Test"),
  sidebarLayout(sidebarPanel(
    fileInput("df_submitted","Upload your file",accept = c(".xlsx")),
    downloadButton("download","Download"),
    actionButton("lab_num","Replace Labels")
  ),
  mainPanel(
    DTOutput("dt_data"))
  )
))

server <- function(input, output, session) {
  df <- reactiveValues(data=NULL)
  
  #Upload file
  df_uploaded <- reactive({
    file_submitted <- input$df_submitted
    file_ext <- tools::file_ext(file_submitted$name)
    file_path <- file_submitted$datapath

    if (is.null(file_submitted)){
      return(NULL)
    } else if (file_ext=="xlsx"){
      read_xlsx(file_path,sheet=1)
    }
  })

  observe({
    df$data <- df_uploaded()
  })
  
  ###Validate form
  data_validated <- reactive({
    req(df$data)
    df_validate <- df$data
    ##rules
    rules <- validator(
      x>5,
      y<3,
      z=="R"
    )
    #Confront rules against df
    out <- confront(df_validate,rules)
    cells_dt <- data.frame(values(out))
    cells_dt <- cells_dt %>%
      mutate_all(function(x) ifelse(x==TRUE,0,1))
    #Join cells that fail the rules for future highlight in TD
    df_validate <- cbind(df_validate,cells_dt)
    df_validate
  })
  
  #Render DT  
  output$dt_data=renderDT({
    df_dt <- data_validated()
    visible_cols <- 1:((ncol(df_dt)/2))
    hidden_cols <- ((ncol(df_dt)/2)+1):ncol(df_dt)
    
    df_dt %>%
      datatable(
        editable="cell",
        selection="none",
        options=list(
          autoWidth=T,
          columnDefs=list(list(targets=hidden_cols,visible=F)))) %>%
      formatStyle(visible_cols,hidden_cols,
                  backgroundColor=styleEqual(c(0,1),c("white","#FFC7CE")),
                  color=styleEqual(c(0,1),c("black","#9C0006")))
  },server=T) #End render DT
  
  dt_proxy <- dataTableProxy("dt_data")


  observeEvent(input$dt_data_cell_edit, {
    info <- input$dt_data_cell_edit
    df$data <<- editData(df$data,info,dt_proxy)
  })
  
#Button to automatically replace some patterns
  df_match <- data.frame(lab=c("Yes","No"),val=c(1,0))
  
  observeEvent(input$lab_num,{
    df$data <- df$data %>%
      mutate(y = case_when(
       y %in% df_match$lab ~ as.character(df_match$val[match(y,df_match$lab)]),
        TRUE~y))
  })
  
  output$download <- downloadHandler(
    filename= function(){
      paste0("revised_",input$df_submitted)
    },
    content=function(file){
      df_tbl <- df$data
      write.xlsx(df_tbl,file,rowNames=F)
    })  
}

shinyApp(ui = ui, server = server)

Code split in modules. I am just putting the examples of some modules, ideally, I would like to have most of the code in modules/functions, but as is not working correctly, I am just putting some examples.

Module to download the data (it should be reactive, but the code is not working)

#Download ui button
downExcelUI <- function(id,label) {
  ns <- NS(id)
  downloadButton(ns("download"),label)
}

#Download Excel unformat server
downExcelUnformatServer <- function(id,filename,df) {
  moduleServer(id, function(input,output,session) {
     output$id <- downloadHandler(
      filename=filename,
      content=function(file){
        write.xlsx(df(),file,rowNames=F) #Based on my search, I should have the df as reactive(), but this is not working, if I removed () the df that is downloaded is not being reactive
      })
  })
}

#Module render DT, not being reactive

#Download ui button
renderDTUI <- function(id) {
  ns <- NS(id)
  DTOutput(ns("dt_table"))
}

#Download Excel unformat server
renderDTServer <- function(id,df) {
  moduleServer(id, function(input,output,session) {
    
    output$dt_table=renderDT({
      df_dt <- df()
      visible_cols <- 1:((ncol(df_dt)/2))
      hidden_cols <- ((ncol(df_dt)/2)+1):ncol(df_dt)
      
      df_dt %>%
        datatable(
          editable="cell",
          selection="none",
          options=list(
            autoWidth=T,
            columnDefs=list(list(targets=hidden_cols,visible=F)))) %>%
        formatStyle(visible_cols,hidden_cols,
                    backgroundColor=styleEqual(c(0,1),c("white","#FFC7CE")),
                    color=styleEqual(c(0,1),c("black","#9C0006")))
    },server=T)
    

  })
}

Function to validate the data. In the current example I have this function #commented# and I access directly in the server because if I use this function in the example nothing is displayed.

validation <- function(df){
  reactive({
    req(df())
    df_validate <- df()
    ##rules
    rules <- validator(
      x>5,
      y<3,
      z=="R"
    )
    #Confront rules against df
    out <- confront(df_validate,rules)
    cells_dt <- data.frame(values(out))
    cells_dt <- cells_dt %>%
      mutate_all(function(x) ifelse(x==TRUE,0,1))
    #Join cells that fail the rules for future highlight in DT
    df_validate <- cbind(df_validate,cells_dt)
    df_validate
  })
}

App.R

library(shiny)
library(readxl)
library(openxlsx)
library(tidyverse)
library(validate)
library(DT)
library(shinyjs)
library(jsonlite)


ui <- (fluidPage(
  useShinyjs(),
  titlePanel("Test"),
  sidebarLayout(sidebarPanel(
    fileInput("df_submitted","Upload your file",accept = c(".xlsx")),
    downExcelUI("download_dt","Download"),
    actionButton("lab_num","Replace Labels")
  ),
  mainPanel(
    renderDTUI("dt_data"))
  
  )
))

server <- function(input, output, session) {
  df <- reactiveValues(data=NULL)
  
  #Upload file
  df_uploaded <- reactive({
    file_submitted <- input$df_submitted
    file_ext <- tools::file_ext(file_submitted$name)
    file_path <- file_submitted$datapath

    if (is.null(file_submitted)){
      return(NULL)
    } else if (file_ext=="xlsx"){
      read_xlsx(file_path,sheet=1)
    }
  })

  observe({
    df$data <- df_uploaded()
  })
  
  #Function validate form, not working
  # data_validated <- validation(df$data)
  
  data_validated <- reactive({
    req(df$data)
    df_validate <- df$data
    ##rules
    rules <- validator(
      x>5,
      y<3,
      z=="R"
    )
    #Confront rules against df
    out <- confront(df_validate,rules)
    cells_dt <- data.frame(values(out))
    cells_dt <- cells_dt %>%
      mutate_all(function(x) ifelse(x==TRUE,0,1))
    #Join cells that fail the rules for future highlight in TD
    df_validate <- cbind(df_validate,cells_dt)
    df_validate
  })
  
  #Module Render DT
  df_renddt <- renderDTServer("dt_data",data_validated)
  
  dt_proxy <- dataTableProxy("df_renddt")

  observeEvent(input$df_renddt_cell_edit, {
    info <- input$df_renddt_cell_edit
    df$data <<- editData(df$data,info,dt_proxy)
  })
  
  #Replace data matching a specific value
  #Would like to have this in a function outside app.R as well
  df_match <- data.frame(lab=c("Yes","No"),val=c(1,0))
  observeEvent(input$lab_num,{
    df$data <- df$data %>%
      mutate(y = case_when(
       y %in% df_match$lab ~ as.character(df_match$val[match(y,df_match$lab)]),
        TRUE~y))
  })
  
  #Module download data
  downExcelUnformatServer("download_dt","form.xlsx",df$data)
} 

shinyApp(ui = ui, server = server)

Answer 1

The renderDT module works for me, however there are a few other issues with your code:

• for df_submitted, it has to be uppercase Yes/No to match your rules
• when assigning values to a reactiveValues object, you don't need to use <<-, <- is enough
• I would also encapsulate the dataTableProxy into your module. I then store the changes in a reactiveValues object in the module and return this from the module, so that you can use it in the main

renderDTServer <- function(id,df) {
  moduleServer(id, function(input,output,session) {
    
    df_module <- reactiveValues(data = NULL)
    observeEvent(df(), {
      df_module$data <- df()
    })
    
    output$dt_table=renderDT({
      df_dt <- df()
      visible_cols <- 1:((ncol(df_dt)/2))
      hidden_cols <- ((ncol(df_dt)/2)+1):ncol(df_dt)
      
      df_dt %>%
        datatable(
          editable="cell",
          selection="none",
          options=list(
            autoWidth=T,
            columnDefs=list(list(targets=hidden_cols,visible=F)))) %>%
        formatStyle(visible_cols,hidden_cols,
                    backgroundColor=styleEqual(c(0,1),c("white","#FFC7CE")),
                    color=styleEqual(c(0,1),c("black","#9C0006")))
    },server=T)
    
    dt_proxy <- dataTableProxy("dt_table")
    
    observeEvent(input$dt_table_cell_edit, {
      # browser()
      info <- input$dt_table_cell_edit
      df_module$data <- editData(df_module$data,info,dt_proxy)
    })
    
    return(df_module)
    
  })
}

• you can encapsulate the validation part in a function if you pass it the unevaluated reactive:

validation <- function(df){
  reactive({
    req(df$data)
    df_validate <- df$data
    ##rules
    rules <- validator(
      x>5,
      y<3,
      z=="R"
    )
    #Confront rules against df
    out <- confront(df_validate,rules)
    cells_dt <- data.frame(values(out))
    cells_dt <- cells_dt %>%
      mutate_all(function(x) ifelse(x==TRUE,0,1))
    #Join cells that fail the rules for future highlight in DT
    df_validate <- cbind(df_validate,cells_dt)
    df_validate
  })
}

and call it in the main app with

data_validated <- validation(df)

• you can encapsulate the observer as follows (only tested within one file though, not sure if it works with global.R):

check_for_replacement <- function(input, df, df_user_input) {
  observeEvent(input$lab_num,{
    browser()
    df$data <- df_user_input$data %>%
      mutate(y = case_when(
        y %in% df_match$lab ~ as.character(df_match$val[match(y,df_match$lab)]),
        TRUE~y))
  })
}

• for the downExcelUnformat module, you need to also use output$download in the server part (needs the same id as you've used in the UI part)

downExcelUnformatServer <- function(id,filename,df) {
  moduleServer(id, function(input,output,session) {
    output$download <- downloadHandler(
      filename= filename,
      content=function(file){
        df_tbl <- df$data
        write.xlsx(df_tbl,file,rowNames=F)
      }) 
  })
}

Currently, the main server function looks like this. Please note that right now there is a circular dependency on the validate part and when you adjust the labels, the data is validated again, which adds another set of columns which are not dealt with. You need to think about what you want to do with these:

server <- function(input, output, session) {
  df <- reactiveValues(data=NULL)
  
  #Upload file
  df_uploaded <- reactive({
    file_submitted <- input$df_submitted
    file_ext <- tools::file_ext(file_submitted$name)
    file_path <- file_submitted$datapath
    
    if (is.null(file_submitted)){
      return(NULL)
    } else if (file_ext=="xlsx"){
      read_xlsx(file_path,sheet=1)
    }
  })
  
  observeEvent(df_uploaded(), {
    df$data <- df_uploaded()
  })
  
  #Function validate form, not working
  data_validated <- validation(df)
  
  #Module Render DT
  df_user_input <- renderDTServer("dt_data", data_validated)
  
  #Replace data matching a specific value
  #Would like to have this in a function outside app.R as well
  df_match <- data.frame(lab=c("Yes","No"),val=c(1,0))
  check_for_replacement(input, df, df_user_input)
  
  #Module download data
  downExcelUnformatServer("download_dt","form.xlsx",df_user_input)
} 

Please only pass unevaluated reactives to modules and be aware that there is a difference between reactive/reactiveVal/reactiveValues. For a more detailed explanation, you can check out my shiny modules tutorial.

Answer 2

So, I kind of get into an answer. I just realized I was trying to pass the data into the modules using df$data when in reality what I needed was to pass just df. Now everything seems to work fine, at least for now....

So here is the module that is working for DT. As you may realize now I am passing three objects to the function the id, the df reactive object wihtout $data and df_val which is obtained from the validation function.

renderDTUI <- function(id) {
  ns <- NS(id)
  DTOutput(ns("dt_table"))
}


renderDTServer <- function(id,df,df_val) {
  moduleServer(id, function(input,output,session) {
    output$dt_table=renderDT({
      df_dt <- df_val()
      visible_cols <- 1:((ncol(df_dt)/2))
      hidden_cols <- ((ncol(df_dt)/2)+1):ncol(df_dt)
      
      df_dt %>%
        datatable(
          editable="cell",
          selection="none",
          options=list(
            autoWidth=T,
            columnDefs=list(list(targets=hidden_cols,visible=F)))) %>%
        formatStyle(visible_cols,hidden_cols,
                    backgroundColor=styleEqual(c(0,1),c("white","#FFC7CE")),
                    color=styleEqual(c(0,1),c("black","#9C0006")))
    },server=T)
    
    dt_proxy <- dataTableProxy("dt_table")
    
    observeEvent(input$dt_table_cell_edit, {
      info <- input$dt_table_cell_edit
      df$data <- editData(df$data,info,dt_proxy, resetPaging = FALSE)
    })
  
  })
}

For the download module is kind of the same:

downExcelUI <- function(id,label) {
  ns <- NS(id)
  downloadButton(ns("download"),label)
}

downExcelUnformatServer <- function(id,filename,df) {
  moduleServer(id, function(input,output,session) {
     output$download <- downloadHandler(
      filename=filename,
      content=function(file){
        df_tbl <- df$data
        write.xlsx(df_tbl,file,rowNames=F)
      })
  })
}

And here is the server part of the app:

server <- function(input, output, session) {
  df <- reactiveValues(data=NULL)
  
  #Upload file
  df_uploaded <- reactive({
    file_submitted <- input$df_submitted
    file_ext <- tools::file_ext(file_submitted$name)
    file_path <- file_submitted$datapath

    if (is.null(file_submitted)){
      return(NULL)
    } else if (file_ext=="xlsx"){
      read_xlsx(file_path,sheet=1)
    }
  })

  observe({
    df$data <- df_uploaded()
  })
  
  # Function validate form
  data_validated <- validation(df)
  
   #Module Render DT
  renderDTServer("dt_data",df,data_validated)
  
  #Replace data matching a specific value
  df_match <- data.frame(lab=c("Yes","No"),val=c(1,0))
  replaceLabelServer("lab_num",df,df_match)

  
  #Module download data
  downExcelUnformatServer("download_dt","form.xlsx",df)
} #End server