R/analysis_a_setup.R

In fdrennan/test: What the Package Does (One Line, Title Case)

#' analysis_a_setup
#' @export
analysis_a_setup <- function(id = "analysis_a_setup") {
  ns <- NS(id)

  fluidRow(
    wellPanel(
      uiOutput(ns("analysisMenu"))
    ),
    uiOutput(ns("analysis_a_body"))
  )
}

#' analysis_a_setup_server
#' @export
analysis_a_setup_server <- function(input, output, session, session_settings, user, is_admin) {
  ns <- session$ns


  output$analysisMenu <- renderUI({
    try(session_settings())
    uuid <- get_sessions()[1, ]$uuid


    div(
      div(class='text-right', h3(glue('Session ID: {uuid}'))),
      fileInput(ns("file"), h3("Upload Study Data"), accept = ".xlsx"),
      div(actionButton(ns("submitFile"), "Submit"), class = "text-right")
    )
  })

  input_data <- eventReactive(input$submitFile, {
    file <- req(input$file)
    req(file$name)
    data <- clean_excel_data(file)
    data
  })


  output$analysis_a_body <- renderUI({
    req(input_data())
    # ns <- session$ns
    fluidRow(
      # TODO: /home/freddy/Projects/current/test/output/BMN600/TB21-02asdfasdfasdfasdfasdf/bmp_9_pah/files"Give Error Message for Map Subject Types, if one value just show 1, if two values must be unique"
      column(6, uiOutput(ns("typeAssignmentTable"))),
      column(6, uiOutput(ns("groupAssignmentTable"))),
      uiOutput(ns("analysisInputUI")),
      div(actionButton(ns("runAnalysis"), h4("Run Analysis")), class = "text-center"),
      uiOutput(ns("analysisSuccess"))
    )
  })



  output$typeAssignmentTable <- renderUI({
    req(input_data())
    data <- input_data()$data
    type_inputs <- distinct(data, Type, type_snake)
    div(
      h3('Type Selection'),
      make_type_assignment_table(type_inputs, ns)
      # div(actionButton(ns("submitType"), "Update Treatment Groups"), class = "text-right")
    )
  })



  output$groupAssignmentTable <- renderUI({
    # browser()
    data <- input_data()$data

    req(data)
    # req(any(type_names))

    treatment_input <-
      distinct(data, treatment_snake, Treatment) %>%
      filter(complete.cases(.))

    div(
      h3('Treatment Selection'),
      div(
        map2(
          treatment_input$treatment_snake,
          treatment_input$Treatment,
          function(treatmentid, treatment) {
            selectizeInput(ns(treatmentid), treatment, choices = c(
              "Negative Control", "Positive Control", "Vehicle",
              "Treatment", "Other Comparator"
            ))
          }
        )
        # h4("Treatment and Vechicle must exist, otherwise unique")
      )
    )
  })

  output$analysisInputUI <- renderUI({
    # browser()
    data <- input_data()$data
    req(data)
    nd <- names(data)

    date_cols <- str_detect(names(data), "[0-9]")
    date_cols <- names(data)[date_cols]
    date_cols <- date_cols[order(as.numeric(gsub("[A-z]| ", "", date_cols)))]
    date_cols

    wellPanel(
      h4("Select a time point to be used in comparison"),
      selectInput(ns("timeSelectionInput"),
        label = "",
        selected = NULL,
        choices = date_cols
      ),
      # checkboxInput(ns("changeFromBaseline"), h4("Conduct Change from Baseline Analysis"), value = FALSE),
      radioButtons(ns("changeFromBaseline"), "Select Type of Analysis",
        choiceNames = list(
          "Conduct Change from Baseline Analysis",
          "Analysis without Baseline Adjustment"
        ),
        choiceValues = list(
          TRUE, FALSE
        )
      )
    )
  })


  analysis_data <- eventReactive(input$runAnalysis, {
    out <- list(input_data = input_data(), inputs = reactiveValuesToList(input))
    print(out)
    out
  })

  analysis_data
}