Why I do not get my data under the Load Panel?

[gabrielburcea]

I am having two tabs in the navigation bar (I am trying to keep it simple, I have more, but won't matter). Now, I get my info tab the way I want it. But when I upload the module for load data, I cannot get it under 'Load Data' tab but rather under the first tab - Info .

Here is a snipped of the code (although full repo is available on the request -https://github.com/gabrielburcea/grwtgolem, it is golem shiny framework and would like to keep it this way.

First, I define app_ui :

app_ui <- function(request) {
  tagList(# Leave this function for adding external resources
    golem_add_external_resources(),
    shinyjs::useShinyjs(),
    
    # Your application UI logic
    shinyUI(
      shiny::navbarPage(title = div(tags$a(img(src = "www/AZ_SYMBOL_RGB.png", height = "50px"), "Growth Rate Explorer"),
                                    id = "navBar",
                                    theme = "www/style.css",
                                    # collapsible = TRUE,
                                    # inverse = TRUE,
                                    style = "position: relative; top: -30px; margin-left: 10px; margin-top: 5px;"),
                        header = tags$head(includeCSS("www/style.css")),# sourcing css style sheet
                        # make navigation bar collapse on smaller screens
                        windowTitle = "Growth Rate Explorer",
                        collapsible = TRUE,
                        
                        shiny::tabPanel("Info", icon = icon("fa-light fa-info"), mod_info_app_ui("info_app_1")),
                        
                        shiny::tabPanel("Load Data", icon = icon("fa-light fa-database"), mod_load_app_ui("load_app_1"))
                        
      )
    )
  )
}

And then, I define the server_app as:

#' app_server
#'
#' @param input,output,session Internal parameters for {shiny}.
#'     DO NOT REMOVE.
#' @import shiny
#' @noRd
app_server <- function(input, output, session){

  mod_info_app_server("info_app_1")
  mod_load_app_server("load_app_1")
 
}

To reiterate, I get my load app under the info tab. Why is this happening?

I have tried for the last two days different configuration but nothing helped.

I tried to re-define the app_server with the shiny::callModule(mod_load_server, mod_load_ui_1) and it did not work whatsoever.

For your info: mod_info_app and mod_load_app:

First is mod_info_app that contains html scripts (which I won't provide, these are way too big) but this module defines the ui and server for info tab, just as golem requires:

#'mod_info_app_ui UI Function
#'
#' @description A shiny Module.
#'
#' @param id,input,output,session Internal parameters for {shiny}.
#'
#' @noRd
#'
#' @importFrom shiny NS tagList
mod_info_app_ui <- function(id){
  ns <- NS(id)
    tagList(shiny::tabPanel(title = "Info",
                            icon = icon("fa-light fa-info"),
                            value = "Info",
                            tags$div(
                              class = "main",
                              shiny::fluidPage(
                                htmltools::htmlTemplate("www/welcome_to_growth_rate_explorer.html"),
                                htmltools::htmlTemplate("www/info_tabs_list.html")
                              )
                            )))


  # )
}

#' mod_info_app_server Server Functions
#'
#' @noRd
mod_info_app_server <- function(id){
  moduleServer( id, function(input, output, session){
    ns <- session$ns

    # Color coding
    colorCoding <- reactive({

      tagList(
        tags$b("Legend"),
        tags$p(drawBullet(color = paste(myColors[1], "; border: 1px solid black")), "Adjusted p Value > 0.05"),
        tags$p(drawBullet(color = myColors[2]), "0.01 < Adjusted p Value", HTML("&le;"), "0.05"),
        tags$p(drawBullet(color = myColors[3]), "0.001 < Adjusted p Value", HTML("&le;"), "0.01"),
        tags$p(drawBullet(color = myColors[4]), "0.0001 < Adjusted p Value", HTML("&le;"), "0.001"),
        tags$p(drawBullet(color = myColors[5]), "Adjusted p Value", HTML("&le;"), "0.0001")

      )

    })

    output$info_colorCoding <- renderUI(colorCoding())


    # Example Data
    output$info_exampleData <- downloadHandler(
      filename = "exampleData.zip",
      content = function(file)  {
        dataDir <- system.file("extdata/exampleData", package = "astraGrowthRateExplorer")

        oldDir <- getwd()
        setwd(dataDir)
        on.exit(setwd(oldDir))

        zip(zipfile = file, files =  list.files(dataDir))
      }
    )


    # Pipeline: Make this graph once
    if (FALSE) {

      library("diagram")

      png(file = file.path(system.file("app/www", package = "astraGrowthRateExplorer"), "diagram.png"),
          width = 1500, height = 200)
      par(mar = c(0, 0.5, 0, 0.5))
      plot.new()

      boxColor <- "blue"

      elpos <- coordinates(5)

      fromto <- matrix(ncol = 2, byrow = TRUE,
                       data = c(1, 2, 2, 3, 3, 4, 4, 5))

      nr <- nrow(fromto)
      arrpos <- matrix(ncol = 2, nrow = nr)
      for (i in 1:nr)
        arrpos[i,] <- straightarrow(to = elpos[fromto[i,2],], from = elpos[fromto[i,1],],
                                    lwd = 2, arr.pos = 0.6, arr.length = 0.5, lcol = boxColor)

      voi <- list(
        "Input Data",
        c("Data Quality Control"),
        c("Calculate Growth Rate", "Summary Metric"),
        c("Statistical Analysis of", "Growth Rate"),
        "Report Generation"
      )
      for (iVar in 1:5)
        textrect(elpos[iVar,], radx = 0.08, rady = 0.15,
                 lab = voi[[iVar]], lcol = boxColor, cex = 1.2, lwd = 1.5)

      dev.off()

    }


  })
}

## To be copied in the UI
# mod_info_app_ui("info_app_1")

## To be copied in the server
# mod_info_app_server("info_app_1")

Here is load_data_app:

#' mod_load_app_ui UI Function
#'
#' @description A shiny Module.
#'
#' @param id,input,output,session Internal parameters for {shiny}.
#'
#' @noRd
#'
#' @importFrom shiny NS tagList
mod_load_app_ui <- function(id, label = "Load Data") {
  ns <- NS(id)
  tagList(
    shiny::tabPanel(
    title = "Load Data",
    icon = icon("fa-light fa-database"),
    label = label,

      tags$br(),

      shiny::sidebarLayout(
        shiny::sidebarPanel(
          hidden(
            actionButton(
              inputId = "load_loadNewButton",
              icon = icon("arrow-alt-circle-up"),
              label = "Upload new data"
            )
          ),
          # Load data
          div(
            id = "load_inputDataSpecifics",
            fileInput(
              inputId = "load_file",
              label = "Data File(s)",
              accept = c(".csv", ".xlsx"),
              multiple = TRUE
            ),
            uiOutput("load_selectColumnNamesUI"),
            uiOutput("load_dayOffsetInput"),
            uiOutput("load_loadDataButtonUI")

          ),
          uiOutput("load_warnings"),

          hidden(
            div(
              id = "load_hiddenOnLoad",

              # Warning if duplicate variable names
              tags$h4("Study Levels"),
              uiOutput("load_studyLevels"),

              # Treatment levels
              tags$h4("Treatment Levels"),
              uiOutput("load_trtLevels"),

              # Sample Quality Control
              shiny::uiOutput("load_sampleQC"),
              shiny::tabsetPanel(
                id = "load_sampleQCTables",
                shiny::tabPanel(
                  title = "settings",
                  renderTable(
                    astraGrowthRateExplorer::QCsettingsOutput(results$load_QCsettings),
                    na = "",
                    width = "100%",
                    caption = "Current settings"
                  )
                ),
                shiny::tabPanel(
                  title = "excluded",
                  renderTable(
                    results$load_excludedByQC,
                    na = "",
                    width = "100%",
                    caption = "Summary of excluded data points"
                  )
                )
              ),

              #            uiOutput("load_nExcludedSamples"),
              #            tableOutput("load_excludedSamples"),

              tags$h4("Exclude Outliers"),
              div(
                id = "load_exclude",
                shiny::radioButtons(
                  inputId = "load_outlierType",
                  label = "Outlier data for",
                  choices = c(
                    "Animal" = 1,
                    "Day" = 2 ,
                    "Animal at specific day" = 3
                  ),
                  inline = TRUE
                ),
                shiny::selectInput(
                  inputId = "load_excludeIdSelect",
                  label = "Select animal_id",
                  choices = c()
                ),
                shiny::selectInput(
                  inputId = "load_excludeDaySelect",
                  label = "Select day",
                  choices = c()
                ),

                shiny::textInput(
                  inputId = "load_excludeReason",
                  label = NULL,
                  placeholder = "please provide a reason here"
                ),
                shiny::uiOutput("load_excludeButtonUI")

              ),
              # Excluded outliers
              shiny::uiOutput("load_outliers")
            )
          )
        ),

        shiny::mainPanel(
          tags$h3("Loaded Data"),

          shiny::uiOutput("load_missingValues"),

          shiny::tabsetPanel(
            id = "load_dataTabs",
            shiny::tabPanel(
              title = "Raw",
              value = "load_dataRawPanel",
              DT::DTOutput("load_dataRaw")
            ),
            shiny::tabPanel(
              title = "Volume",
              value = "load_dataVolumePanel",
              DT::DTOutput("load_dataVolume"),
              shiny::fluidRow(column(
                4,
                shiny::uiOutput("load_plotVolumeStudy")
              ),
              column(
                4,
                shiny::uiOutput("load_plotVolumeTreatments")
              )),
              shiny::actionButton("load_refresh_volume", label = icon("sync-alt")),
              tags$div(style = "margin-bottom:50px",
                       plotlyOutput("load_plotVolume", height = "500px")),
              shiny::fluidRow(column(
                4,
                uiOutput("load_plotlyVolumeLogTreatments")
              ),
              column(
                4,
                uiOutput("load_plotlyVolumeLogIds")
              )),
              shiny::actionButton("load_refresh_volumeLogId", label = icon("sync-alt")),
              tags$div(
                style = "margin-bottom:50px",
                plotlyOutput("load_plotVolumeLogId", height = "500px")
              )
            ),
            shiny::tabPanel(
              title = "GR",
              value = "load_dataPanel",
              # Table
              DT::DTOutput("load_data"),

              # Plot
              shiny::uiOutput("load_selectedRowGR"),
              shiny::uiOutput("load_showPlot"),
              shiny::selectInput(
                inputId = "load_MBPlotFacet",
                label = "group by",
                choices = c("Study" = "study", "Treatment" = "treatment")
              ),
              shiny::actionButton("load_refresh_GR", label = icon("sync-alt")),
              tags$div(style = "margin-bottom:50px",
                       plotlyOutput("load_plotlyGR", height = "600px"))
            )
          )
        )
      )
    ))



    # )



}

#' mod_load_app_server Server Functions
#'
#' @noRd
mod_load_app_server <- function(id) {

  moduleServer(id, function(input, output, session) {
    ns <- session$ns
    observe({
      req(results$load_dataType())

      if (length(input$load_loadDataButton) == 1) {
        toggleElement(id = "load_MBPlotFacet",
                      condition = results$load_dataType() == 2)
      }

      toggleElement(id = "load_excludeIdSelect",
                    condition = input$load_outlierType %in% c(1, 3))
      toggleElement(id = "load_excludeButton",
                    condition = isTruthy(input$load_excludeReason))
      toggleElement(id = "load_excludeDaySelect",
                    condition = input$load_outlierType %in% c(2, 3))

    })

    observe({
      req(results$load_dataVolume())
      updateSelectInput(session,
                        inputId = "load_excludeDaySelect",
                        choices = sort(unique(results$load_dataVolume()$day)))

      sortedIds <- list()
      for (treatment in levels(results$load_dataVolume()$treatment)) {
        ids <-
          unique(results$load_dataVolume()$animal_id[results$load_dataVolume()$treatment == treatment])
        sortedIds[[treatment]] <- ids
      }

      updateSelectInput(session, inputId = "load_excludeIdSelect", choices = sortedIds)
    })

    output$load_selectColumnNamesUI <- renderUI({
      req(results$load_dataInputFile0())

      myColumns <- matchColumns(results$load_dataInputFile0())
      names <- names(myColumns)
      inputIds <- paste0("load_columnName_", names)

      tagList(
        textInput("load_dayOffset",
                  label = "Specify how day is defined",
                  value = "Post-implant"),
        helpText(
          "Please check whether the program has detected the right columns"
        ),
        lapply(1:length(myColumns), function(i)
          selectizeInput(
            inputId = inputIds[i],
            label = names[i],
            choices = myColumns[[i]]$options,
            selected = myColumns[[i]]$guess
          ))
      )
    })


    output$load_dayOffsetInput <- renderUI({
      req(results$load_dataInputFile0())
      req(input$load_columnName_day)
      dayColumn <-
        results$load_dataInputFile0()[, input$load_columnName_day]
      if (isDate(dayColumn)) {
        minDate <- min(as.Date(dayColumn), na.rm = TRUE)
        dateInput("load_dayDateOffset",
                  label = "Specify start date",
                  value = minDate)
      }
      else
        NULL
    })

    output$load_excludeButtonUI <- renderUI({
      validate(need(
        !grepl("QC_", input$load_excludeReason),
        "Please provide a reason without 'QC_'"
      ))
      actionButton(inputId =  "load_excludeButton",
                   label = "Exclude",
                   icon = icon("trash"))
    })


    # make resetting button when data specifications change
    output$load_loadDataButtonUI <- renderUI({
      req(results$load_dataInputFile0())
      input$load_loadNewButton             # rerender on when new data will be specified
      if (length(results$load_validDataErrors()) == 0)
        actionButton(inputId = "load_loadDataButton",
                     label = "Calculate growth rate",
                     icon = icon("random"))
      else
        tagList(
          warningStyle("The app is not able to analyze your data."),
          lapply(results$load_validDataErrors(), function(x) {
            text <- sprintf("ERROR: %s", x)
            warningStyle(text)
          })
        )
    })

    # start the actual transformering and loading of the data. Moreover, hide data input fields.
    observeEvent(input$load_loadDataButton, {
      req(results$load_dataInputFile0())
      updateTabsetPanel(session = session,
                        inputId = "load_dataTabs",
                        selected = "load_dataVolumePanel")
      hide("load_inputDataSpecifics")
      show("load_loadNewButton")
      show("load_hiddenOnLoad")
      click("load_applyQC")
    })

    observeEvent(input$load_loadNewButton, {
      updateTabsetPanel(session = session,
                        inputId = "load_dataTabs",
                        selected = "load_dataRawPanel")
      results$load_exludedOutliers <- NULL
      results$load_QCsettings <- NULL
      show("load_inputDataSpecifics")
      hide("load_hiddenOnLoad")
      hide("load_loadNewButton")
    })

    # Sample quality control
    output$load_sampleQC <- renderUI({
      req(results$load_dataVolumeRaw())
      df <- results$load_dataVolumeRaw()

      t <- table(df$animal_id)
      maxDay <- max(df$day, na.rm = TRUE)
      minDay <- min(df$day, na.rm = TRUE)
      guessedUnit <-
        if (median(df$tumourVolume, na.rm = TRUE) < 2)
          1000
      else
        1

      tagList(
        tags$h4("Sample Quality Control"),
        sliderInput(
          inputId = "load_days",
          label = "Days to include",
          min = minDay,
          max = maxDay,
          value = c(NA, NA),
          step = 1
        ),
        sliderInput(
          "load_minNo",
          label = "Select minimal # of measurements per animal",
          value = 3,
          min = 3,
          max = max(t) - 1
        ),
        textOutput("load_minOutliers"),
        radioButtons(
          inputId = "load_volumeScalingFactor",
          label = "Loaded data volume unit",
          selected = guessedUnit,
          choices = c("mm3" = 1, "cm3" = 1000)
        ),
        actionButton(
          inputId = "load_applyQC",
          label = "Apply QC settings",
          icon = icon("cog")
        )
      )
    })

    # Choose treatment levels
    output$load_trtLevels <- renderUI({
      initLevels <-
        getTreatmentLevels(data = results$load_dataVolumeRaw())
      choices <- unlist(initLevels)
      names(choices) <- NULL

      tagList(
        # Ref
        selectInput(
          inputId = "load_refTrt",
          label = "Reference",
          choices = choices,
          selected = initLevels$ref
        ),

        selectizeInput(
          inputId = "load_otherTrt",
          label = "Treatment(s)",
          choices = initLevels$trt,
          selected = initLevels$trt,
          multiple = TRUE,
          options = list(plugins = list('drag_drop'))
        ),
        helpText(
          "The order of the treatments in all tables/plots can be changed by dragging the levels"
        )
      )
    })

    # Exclude reference for treatment levels
    observe({
      allChoices <-
        unlist(getTreatmentLevels(data = results$load_dataVolumeRaw()))
      trtChoices <-
        allChoices[-which(allChoices == input$load_refTrt)]
      names(trtChoices) <- NULL
      updateSelectInput(session,
                        "load_otherTrt",
                        choices = trtChoices,
                        selected = trtChoices)
    })


    # Selected treatment levels
    results$load_trtLevels <- reactive({
      req(input$load_refTrt)
      req(input$load_otherTrt)
      list(ref = input$load_refTrt,
           trt = {
             if (input$load_refTrt %in% input$load_otherTrt)
               input$load_otherTrt[-which(input$load_otherTrt == input$load_refTrt)]
             else
               input$load_otherTrt
           })
    })

    # Choose study levels
    output$load_studyLevels <- renderUI({
      initLevels <- levels(results$load_dataVolumeRaw()$study)
      choices <- unlist(initLevels)
      names(choices) <- NULL

      tagList(
        selectizeInput(
          inputId = "load_studyLevels",
          label = "Studies",
          choices = choices,
          selected = choices,
          multiple = TRUE,
          options = list(plugins = list('drag_drop'))
        ),
        helpText(
          "The order of the studies in all tables/plots can be changed by dragging the levels"
        )
      )
    })


    ## ----- ##
    ## Input ##
    ## ----- ##

    results$load_dataType <-
      reactive({
        # Single study or multiple? -> important for shown analysis
        req(input$load_studyLevels)
        if (length(input$load_studyLevels) > 1)
          t <- 2
        else
          t <- 1
        t
      })

    # data exactly as read by the file
    results$load_dataInputFile0 <- reactive ({
      validate(need(input$load_file, "Please load data"))
      tryCatch({
        files <- input$load_file$datapath
        names(files) <- input$load_file$name
        output <- loadData(file = files)
      },
      error = function(e)
        validate(
          need(
            FALSE,
            "Data could not be loaded. Please check whether you selected the correct 'Data Type'"
          )
        ))
      output
    })

    # data exactly as read by the file (but only load once start anaylsis is pressed)
    results$load_dataInputFile <- reactive({
      req(results$load_dataInputFile0())
      validate(need(
        input$load_loadDataButton == 1,
        "Please start the analysis first."
      ))
      results$load_dataInputFile0()
    })

    # raw volume data for single batch
    results$load_dataVolumeRaw <- reactive({
      df <- results$load_dataInputFile()

      # remove columns without decent header
      df <- df[, sapply(colnames(df), isTruthy)]

      df <- transformSB(
        df,
        wide = FALSE,
        group = input$load_columnName_group,
        treatment = input$load_columnName_treatment,
        animal_id = input$load_columnName_animal_id,
        tumourVolume = input$load_columnName_tumourVolume,
        day = input$load_columnName_day,
        study = input$load_columnName_study,
        dayOffset = input$load_dayDateOffset
      )
      df <- df[!is.na(df$tumourVolume), ]
    })

    results$load_selectedCols <- reactive({
      req(results$load_dataInputFile0())
      req(input$load_columnName_animal_id)
      req(input$load_columnName_group)
      req(input$load_columnName_treatment)
      req(input$load_columnName_study)
      req(input$load_columnName_tumourVolume)
      req(input$load_columnName_day)
      list(
        "animal_id" = input$load_columnName_animal_id,
        "group" = input$load_columnName_group,
        "treatment" = input$load_columnName_treatment,
        "study" = input$load_columnName_study,
        "tumourVolume" = input$load_columnName_tumourVolume,
        "day" = input$load_columnName_day
      )
    })

    results$load_validDataErrors <- reactive({
      req(results$load_selectedCols())
      selectedCols <- results$load_selectedCols()

      validId <-
        isValidIdColumn(results$load_dataInputFile0()[, selectedCols$animal_id])
      validGroup <-
        isValidGroupColumn(results$load_dataInputFile0()[, selectedCols$group])
      validTreatment <-
        isValidTreatmentColumn(results$load_dataInputFile0()[, selectedCols$treatment])
      validStudy <-
        isValidStudyColumn(results$load_dataInputFile0()[, selectedCols$study])
      validTumourVolume <-
        isValidTumourVolumeColumn(results$load_dataInputFile0()[, selectedCols$tumourVolume])
      validDay <-
        isValidDayColumn(results$load_dataInputFile0()[, selectedCols$day])

      errors <- list(
        if (length(unique(selectedCols)) != length(selectedCols))
          "Must select a different variable for each essential column.",
        if (validId != TRUE)
          validId,
        if (validGroup != TRUE)
          validGroup,
        if (validTreatment != TRUE)
          validTreatment,
        if (validStudy != TRUE)
          validStudy,
        if (validTumourVolume != TRUE)
          validTumourVolume,
        if (validDay != TRUE)
          validDay
      ) %>% unlist
      errors
    })

    # Warnings from loading the data
    results$load_warnings <- reactive({
      req(results$load_dataInputFile0())

      # duplicate variable names
      duplicateNames <-
        attr(results$load_dataInputFile0(), "duplicateNames")

      # excluded count variables
      excludedCount <-
        attr(results$load_dataInputFile0(), "excludedVariables")



      # other warnings
      warning <- attr(results$load_dataInputFile0(), "warning")

      tagList(
        if (!is.null(duplicateNames))
          warningStyle(text = "WARNING: Following duplicated variable names in loaded data are given unique name"),
        tags$ul(lapply(duplicateNames, tags$li)),

        if (!is.null(warning))
          warningStyle(paste("WARNING:", warning))
      )
    })

    output$load_warnings <- renderUI(results$load_warnings())

    # Volume data after QC
    results$load_dataVolume <- reactive({
      req(results$load_dataVolumeRaw())
      req(results$load_trtLevels())
      req(results$load_QCsettings)

      data <- results$load_dataVolumeRaw()

      # exclude outliers
      toExclude <- which(results$load_exludedOutliers != FALSE)
      if (length(toExclude) > 0)
        data <- data[-toExclude, ]

      # apply QC settings
      process <- processData(df = data,
                             settings = results$load_QCsettings)
      data <- process$df
      results$load_excludedByQC <- process$ex

      # keep track of the rows excluded by QC
      exQC <- rep(FALSE, nrow(results$load_dataVolumeRaw()))
      rowNames <- rownames(results$load_dataVolumeRaw())
      indices <- which(rowNames %in% process$name$name)
      for (i in indices) {
        name <- rowNames[i]
        reason <-
          as.character(process$name$reason[process$name$name == name])
        exQC[i] <-  paste0("QC_", reason)
      }
      results$load_exludedQC <- exQC

      # set order of data
      data <- assignStudyLevels(data, input$load_studyLevels)
      data <- assignTreatmentLevels(data, results$load_trtLevels())
      data <- data[order(data$study, data$treatment), ]

      data
    })

    results$load_exludedRows <- reactive({
      ex1 <- results$load_exludedOutliers
      ex2 <- results$load_exludedQC

      if (length(ex1) == 0)
        ex1 <- FALSE
      if (length(ex2) == 0)
        ex2 <- FALSE
      ex <- cbind(ex1, ex2)
      apply(ex, 1, function(x) {
        # first check if outlier is reason of exclusion, if not find QC reason
        if (x[1] != FALSE)
          x[1]
        else
          x[2]
      })
    })

    results$load_outliers <- reactive({
      req(results$load_dataVolumeRaw())
      req(results$load_exludedRows)
      summarizeExclusions(results$load_dataVolumeRaw(),
                          results$load_exludedRows())
    })

    # Growth rate data
    results$load_data <- reactive({
      req(results$load_dataVolume())
      validate(need((nrow(
        results$load_dataVolume()
      ) > 0),
      "Need more data to calculate growthrates."))
      regressionOutput(results$load_dataVolume())
    })


    # Quality control settings
    results$load_QCsettings <- NULL
    observeEvent(input$load_applyQC,
                 ignoreInit = FALSE,
                 ignoreNULL = FALSE,
                 {
                   if (is.null(results$load_QCsettings)) {
                     settings <- data.frame(
                       study = levels(results$load_dataVolumeRaw()$study),
                       startDay = input$load_days[1],
                       endDay = input$load_days[2],
                       minNo = input$load_minNo,
                       volumeScalingFactor = as.numeric(input$load_volumeScalingFactor)
                     )
                   }
                   else{
                     settings <- results$load_QCsettings
                     settings[settings$study %in% input$load_studyLevels, ] <-
                       data.frame(
                         study = input$load_studyLevels,
                         startDay = input$load_days[1],
                         endDay = input$load_days[2],
                         minNo = input$load_minNo,
                         volumeScalingFactor = as.numeric(input$load_volumeScalingFactor)
                       )
                   }
                   results$load_QCsettings <- settings
                 })


    #' get rows that would be excluded from a data.frame
    #' @param data.frame data.frame
    #' @param values named list (possibly of lists)
    #' @importFrom plyr match_df
    excludedOutliers <- function(df, values) {
      values <- expand.grid(values)     # unlist list of values
      myData <- df[, colnames(values)]
      which(rownames(df) %in% rownames(plyr::match_df(myData, values)))
    }


    # Button for excluding outlier
    output$load_outlierButton <- renderUI({
      validate(need(input$load_outlierReason, "Please provide a reason"))
      validate(need(
        !grepl("QC_", input$load_outlierReason),
        "Please provide a reason without 'QC_'"
      ))

      actionButton(inputId = "load_excludeOutlier",
                   label = "Exclude Outlier",
                   icon = icon("trash"))
    })

    observe({
      results$load_exludedOutliers <-
        rep(FALSE, nrow(results$load_dataVolumeRaw()))
    })

    # Add selected plot outlier to the list
    observeEvent(input$load_excludeOutlier, {
      # update exclusion list
      values <- list(
        "animal_id" = results$load_selectedRowGR()$animal_id,
        "study" =  results$load_selectedRowGR()$study
      )
      exIndices <-
        excludedOutliers(results$load_dataVolumeRaw(), values)
      newEx <- results$load_exludedOutliers
      newEx[exIndices] <- input$load_outlierReason
      results$load_exludedOutliers <- newEx
    })

    # Add outlier to the list
    observeEvent(input$load_excludeButton, {
      req(input$load_excludeButton)

      values <- list("study" = input$load_studyLevels)
      if (input$load_outlierType %in% c(2, 3))
        values$day <- as.integer(input$load_excludeDaySelect)

      if (input$load_outlierType %in% c(1, 3)) {
        values$animal_id <- input$load_excludeIdSelect
        values$treatment <- results$load_dataVolumeRaw()$treatment[{
          results$load_dataVolumeRaw()$animal_id == values$animal_id &
            results$load_dataVolumeRaw()$study == values$study
        }][1]
      }

      # update exclusion list
      exIndices <-
        excludedOutliers(results$load_dataVolumeRaw(), values)
      newEx <- results$load_exludedOutliers
      newEx[exIndices] <-  input$load_excludeReason
      results$load_exludedOutliers <- newEx
    })


    # Selected point in the graph
    observe({
      req(results$load_plotlyGR())                                 # prevent warning on startup
      results$GRplotRegistered <- TRUE
    })

    observe({
      req(results$GRplotRegistered)
      results$load_selectedRownGR <-
        event_data("plotly_click", source = "GRplot")$key
    })

    observe({
      results$load_data()
      results$load_selectedRownGR <-  NULL
    })

    results$load_selectedRowGR <- reactive({
      if (isTruthy(results$load_selectedRownGR)) {
        GR_data <- isolate(results$load_data())
        GR_data[results$load_selectedRownGR , ]
      }
      else
        NULL
    })

    ### ------ ##
    ### Output ##
    ### ------ ##



    # Warning for missing values in data
    output$load_missingValues <- renderUI({
      req(results$load_dataInputFile0())

      if (any(is.na(results$load_dataInputFile0())))
        warningStyle("WARNING: Some values are missing for the loaded data. They are highlighted in red.")

    })

    # Table with raw data
    output$load_dataRaw <- DT::renderDT({
      req(results$load_dataInputFile0())
      myData <- results$load_dataInputFile0()

      myTable <-
        DT::datatable(
          results$load_dataInputFile0(),
          rownames = FALSE,
          selection = "none",
          filter = list(position = 'top', clear = FALSE),
          options = list(dom = 'tip')
        )

      # Highlight missing value
      if (any(is.na(myData)))
        myTable <-
        myTable %>% DT::formatStyle(
          columns = 1:ncol(myData),
          target = "cell",
          backgroundColor = DT::styleEqual(NA, "#e52323")
        )

      myTable
    })

    # Table with loaded data
    output$load_data <- DT::renderDT({
      req(results$load_data())
      myData <- results$load_data()
      myTable <- DT::datatable(
        myData,
        #          rownames = FALSE,
        selection = "none",
        filter = list(position = 'top', clear = FALSE),
        options = list(
          dom = 'tip',
          displayStart = {
            if (!is.null(results$load_selectedRowGR()))
              (which(
                rownames(myData) == rownames(results$load_selectedRowGR())
              ) - 1) %/% 10 * 10
            else
              0
          },
          columnDefs = list(list(
            targets = 0, visible = FALSE
          )) # hide row names
        )
      )

      # Highlight missing value
      if (any(is.na(myData)))
        myTable <-
        myTable %>% DT::formatStyle(
          columns = 1:ncol(myData),
          target = "cell",
          backgroundColor = DT::styleEqual(NA, "#e52323")
        )

      if (!is.null(results$load_selectedRowGR()))
        myTable <- myTable %>%
        DT::formatStyle(
          0,
          target = "row",
          backgroundColor = DT::styleEqual(results$load_selectedRownGR, "#32a6d3")
        )
      myTable <-
        myTable %>% DT::formatRound(columns = 4:ncol(myData), digits = 4)

    })


    # Table with loaded dataVolume
    output$load_dataVolume <- DT::renderDT({
      req(results$load_dataVolume())

      myData <-
        results$load_dataVolume()[, names(getCriticalColumns())]
      myData[, "group"] <- NULL # do not display group

      myTable <-
        DT::datatable(
          myData,
          rownames = FALSE,
          selection = "none",
          filter = list(position = 'top', clear = FALSE),
          options = list(dom = 'tip')
        )

      # Highlight missing value
      if (any(is.na(myData)))
        myTable <-
        myTable %>% DT::formatStyle(
          columns = 1:ncol(myData),
          target = "cell",
          backgroundColor = DT::styleEqual(NA, "#e52323")
        )

      #      if (!is.null(results$load_selectedKey()))
      #        myTable <- myTable %>%
      #            DT::formatStyle(columns = "animal_id", target = "row",
      #                backgroundColor = DT::styleEqual(results$load_selectedKey(), "#32a6d3")
      #            )
      myTable <- myTable %>%
        DT::formatRound(columns = "tumourVolume", digits = 4) %>%
        DT::formatRound(columns = "day", digits = 0)
    })

    # Selected animal_id in plot
    output$load_selectedRowGR <- renderUI({
      req(results$load_outliers)
      # Update when point is excluded
      nrow(results$load_outliers())

      tagList(
        helpText(
          "By clicking on a point in the plot, the corresponding row will be highlighted in blue in the table"
        ),
        if (!is.null(results$load_selectedRowGR()))
          wellPanel(
            warningStyle("Do you want to exclude the highlighted sample from the data?"),
            p(
              tags$b("Selected Sample:"),
              results$load_selectedRowGR()$animal_id
            ),
            p(tags$b("Study:"), results$load_selectedRowGR()$study),
            tags$b("Reason"),
            fluidRow(column(
              10,
              textInput(
                inputId = "load_outlierReason",
                label = NULL,
                width = "100%"
              )
            ),
            column(2, uiOutput(
              "load_outlierButton"
            )))
          )
      )
    })




    # List excluded outliers
    output$load_outliers <- renderUI({
      req(results$load_exludedRows)
      validate(need(
        results$load_exludedRows(),
        "No outliers have been excluded."
      ))
      nOutliers <- sum(results$load_exludedRows() != FALSE)
      tagList(
        warningStyle(
          paste(
            "WARNING: There",
            if (nOutliers == 1)
              paste("was", nOutliers, "data point")
            else
              paste("were", nOutliers, "data points"),
            "excluded"
          )
        ),
        renderTable(
          results$load_outliers(),
          na = "",
          width = "100%",
          caption = "Summary of excluded data points"
        ),
        actionButton("load_outlierSummaryHelp", "?")
      )
    })

    observeEvent(input$load_outlierSummaryHelp, {
      showModal({
        modalDialog(
          title = "Outlier summary explanation",
          p("Blank cells should be read as 'all'."),
          renderTable(
            na = "",
            width = "100%",
            data.frame(
              animal_id = "",
              treatment = "",
              study = "myStudy",
              day = "9",
              reason = "QC_day",
              N = "5"
            )
          ),
          p(
            "\"All animals and all treatments for study 'myStudy' have been excluded at day 9 because of 'day quality control'.\""
          ),
          p("A total of 5 data points have been exluded because of this."),
          footer = modalButton("dismiss")
        )
      })
    })

    # PLOTS

    # plot display control

    output$load_plotVolumeStudy <- renderUI({
      selectInput(
        inputId = "load_plotVolumeStudy",
        label = "choose study",
        choices = input$load_studyLevels
      )
    })

    output$load_plotVolumeTreatments <- renderUI({
      treatments <- unique(
        subset(
          results$load_dataVolume(),
          subset = study == input$load_plotVolumeStudy
        )$treatment
      )
      startN <- min(5, length(treatments))

      selectInput(
        inputId = "load_plotVolumeTreatments",
        label = "choose treatments",
        choices = treatments,
        selected = treatments[1:startN],
        multiple = TRUE
      )
    })

    output$load_plotlyVolumeLogTreatments <- renderUI({
      req(results$load_trtLevels())
      choices <- results$load_trtLevels()

      # give appropriate names for display
      names(choices)[1] <- choices$ref
      if (length(choices$trt) == 1)
        names(choices)[2] <- choices$trt
      else
        names(choices)[2] <- "treatments"

      selectInput(inputId = "load_plotlyVolumeLogTreatment",
                  label = "choose treatment",
                  choices = choices)
    })

    output$load_plotlyVolumeLogIds <- renderUI({
      ids <- unique(
        subset(
          results$load_dataVolume(),
          subset =
            treatment == input$load_plotlyVolumeLogTreatment &
            study == input$load_plotVolumeStudy
        )$animal_id
      )
      startN <- min(10, length(ids))

      selectInput(
        inputId = "load_plotlyVolumeLogIds",
        label = "choose animal_id",
        choices = ids,
        selected = ids[1:startN],
        multiple = TRUE
      )
    })


    # plots

    output$load_plotVolume <- renderPlotly({
      req(results$load_dataVolume())
      req(input$load_plotVolumeTreatments)
      input$load_refresh_volume

      validate(need(
        !any(duplicated(unlist(
          results$load_trtLevels()
        ))),
        "Please choose Treatment(s) different from the reference"
      ))
      myData  <- subset(
        results$load_dataVolume(),
        study == input$load_plotVolumeStudy &
          treatment %in% input$load_plotVolumeTreatments
      )
      if (nrow(myData) > 0) {
        p <- plotlyVolume(myData)
      }
      else
        p <- NULL
      p
    })

    output$load_plotVolumeLogId <- renderPlotly({
      req(results$load_dataVolume())
      req(input$load_plotlyVolumeLogTreatment)
      input$load_refresh_volumeLogId

      validate(need(
        !any(duplicated(unlist(
          results$load_trtLevels()
        ))),
        "Please choose Treatment(s) different from the reference"
      ))

      myData <- subset(
        results$load_dataVolume(),
        treatment == input$load_plotlyVolumeLogTreatment &
          animal_id %in% input$load_plotlyVolumeLogIds &
          study == input$load_plotVolumeStudy
      )

      if (nrow(myData) > 0)
        plot <- plotlyVolumeLogId(df = myData)
      else
        plot <- NULL
      plot
    })

    results$load_plotGR <- reactive({
      req(results$load_data())
      req(input$load_MBPlotFacet)

      if (input$load_MBPlotFacet == "treatment") {
        xVar <- "study"
      } else{
        xVar <- "treatment"
      }

      suppressWarnings(
        plotGrowthRate(
          df = results$load_data(),
          xVar = xVar,
          facetVar = input$load_MBPlotFacet,
          withJitter = TRUE
        )
      )
    })

    results$load_plotlyGR <- reactive({
      req(results$load_data())
      req(input$load_MBPlotFacet)

      if (input$load_MBPlotFacet == "treatment") {
        xVar <- "study"
      } else{
        xVar <- "treatment"
      }

      suppressWarnings(
        plotlyGrowthRate(
          df = results$load_data(),
          xVar = xVar,
          facetVar = input$load_MBPlotFacet,
          withJitter = TRUE,
          selected = rownames(results$load_selectedRowGR()),
          source = "GRplot"
        )
      )
    })

    output$load_plotlyGR <- renderPlotly({
      input$load_refresh_GR
      results$load_plotlyGR()
    })


  })
}

## To be copied in the UI
# mod_load_app_ui("load_app_1")

## To be copied in the server
# mod_load_app_server("load_app_1")

If you want to see the user interface, as to how Info tab with Load Data tab get mixed up, check the stackoverflow link where I've posted a pic:

https://stackoverflow.com/questions/75453946/why-i-do-not-get-my-data-under-the-load-data-panel

[gabrielburcea]

Hello peps. Would you please help? I have opened up a bounty on stackoverlow! Wish someone can help. I can also make available the github repo for the person who's willing to help!

[gabrielburcea]

@ColinFay I beg for help! Please do help . Also the bounty on stackoverflow expires. I simply beg for help.

[ArthurData]

Hello @gabrielburcea,

Sorry for the long wait for a reply.
Is this problem still true? If so, I'd be delighted to help.

[ColinFay]

Closed on SO, so closing here :)