R/mod_ui_inputs.R

In thierrycnam/masan: masan uses bioconductor to analyze microarray data

#' Data Module UI for masan
#'
#' @param id the id of the UI
#' @param label the label of the UI
#'
#' @return a beautiful UI tagList
#' @export
#' @import shiny
#' @importFrom utils read.csv
#'
#' @examples
#' masanDataInput("toto")
masanDataInput <- function(id, label="masan input") {
  # Create a namespace
  ns <- NS(id)
  tagList(
    fileInput(ns("input_file_1"),
              label = "Choose a file containing paths to CEL files"),
    fileInput(ns("input_file_2"),
              label = "Choose a SDRF file for expression data"),
    checkboxInput(ns("heading"), "Has heading", value = TRUE),
    selectInput(ns("quote"), "Quote", c(
      "None" = "",
      "Double quote" = "\"",
      "Single quote" = "'"
    )),
    actionButton(ns("action_button"), "Load Expression Data"),
    actionButton(ns('action_button_pca'), 'PCA on Expression Data')
  )
}

#' masanData
#'
#' masanData module server function
#' @param input input
#' @param output output
#' @param session session
#' @param stringsAsFactors stringAsFactors
#'
#' @return several objects
#' @export
#' @importFrom utils head
#' @importFrom Biobase AnnotatedDataFrame exprs
#' @importFrom oligo read.celfiles
#' @importFrom oligoClasses list.celfiles
#' @importFrom stats prcomp
#' @importFrom shiny NS
#'
#' @examples
masanData <- function(input, output, session, stringsAsFactors) {
  # Observe Event
  observeEvent(input$action_button, {
    print("exprs button clicked!")
  })

  observeEvent(input$action_button_pca, {
    print("PCA button clicked!")
  })
  # The selected file, if any
  userFile <- reactive({
    # If no file is selected, don't do anything
    validate(need(input$input_file_2, message = FALSE))
    input$input_file_2
  })

  userFolder <- reactive({
    validate(need(input$input_file_1, message = FALSE))
    input$input_file_1
  })

  ## Reactives
  # The user's data, parsed into a data frame
  df_1 <- reactive({
    read.csv(userFile()$datapath,
             header = input$heading,
             quote = input$quote,
             stringsAsFactors = stringsAsFactors)
  })

  # reactive for a csv file containing paths to CEL files
  folder_react <- reactive({
    read.csv(userFolder()$datapath,
             header = FALSE)
  })

  # reactive for cel files
  react_cel_files <- reactive({
    as.vector(folder_react()$V1)
  })

  # reactive for ExpressionSet data loaded
  # from CEL files and SDRF file
  react_affy_raw <- reactive({
    if (input$action_button == 0)
      return()
    input$action_button
    df_p_data <- df_1()
    rownames(df_p_data) <- df_p_data$name
    df_p_data <- AnnotatedDataFrame(df_p_data)
    cel_files <- list.celfiles(react_cel_files(), full.names=TRUE)
    affy_raw <- read.celfiles(cel_files,
                              phenoData = df_p_data)
    affy_raw
  })

  # Reactive for the expression data from
  # affy_raw
  react_expr_raw <- reactive({
    validate(need(input$action_button, message = "Click on Load Data Expression"))
    Biobase::exprs(react_affy_raw())
  })


  # reactive on pca applied to affy_raw expression data
  react_pca_expr_raw <- reactive({
    validate(need(input$action_button_pca, message = "Click on PCA button"))
    pca_raw <- prcomp(t(react_expr_raw()), scale. = FALSE)
    pca_raw
  })

  # reactive for percentage of variance
  react_pca_percent_var <- reactive({
    validate(
      need(react_pca_expr_raw(),
           message = "pca percent var"
      )
    )
    pca_raw <- react_pca_expr_raw()
    percent_var <- round(100*pca_raw$sdev^2/sum(pca_raw$sdev^2),1)
    percent_var
  })

  # reactive for pca sd ratio
  react_pca_sd_ratio <- reactive({
    validate(
      need(react_pca_expr_raw(), message = "pca sd ratio")
    )
    percent_var <- react_pca_percent_var()
    sd_ratio <- sqrt(percent_var[2]/percent_var[1])
    sd_ratio
  })

  # check pca
  output$check_pca_expr_raw <- renderPrint({
    head(react_pca_expr_raw())
  })

  # check percent_var
  output$check_pca_percent_var <- renderPrint({
    react_pca_percent_var()
  })

  # check pca sd ratio
  output$check_pca_sd_ratio <- renderPrint({
    react_pca_sd_ratio()
  })

  # To check the datapath
  output$check_df_1_reactive <- renderPrint({
    validate(
      need(df_1(), "Load a file")
    )
    userFile()$datapath
  })

  # Check the folder selected
  output$check_folder_react <- renderPrint({
    validate(
      need(folder_react(), "Load a folder")
    )
    dim(folder_react())
  })

  # Check paths
  output$check_cel_files <- renderPrint({
    validate(
      need(folder_react(), "Load a file containing paths")
    )
    h3("CEL FILES")
    react_cel_files()
  })

  # Check affy_raw
  output$check_affy_raw <- renderPrint({
    head(react_affy_raw())
  })
  # We can run observers in here if we want to
  observe({
    msg <- sprintf("File %s was uploaded", userFile()$name)
    cat(msg, "\n")
  })

  # ui created dynamically
  # output$selectize_input_1 <- renderUI({
  #   validate(
  #     need(v_quanti_sup(), message = "v_quanti_sup() needed!")
  #   )
  #   selectizeInput(
  #     ns("selectize_1"),
  #     label=h6("Select quantitative supplementary variables"),
  #     choices=as.list(v_quanti_sup())
  #   )
  # })

  # Return the reactive that yields the data frame
  return(
    list(
      df_1=df_1,
      df_path=folder_react,
      folder_name=folder_react,
      affy_raw=react_affy_raw,
      expr_raw=react_expr_raw,
      pca_expr_raw=react_pca_expr_raw
    )
  )
}

#' masanUI
#'
#' masan UI
#' @param id widget id
#'
#' @return
#' @export
#' @import shiny
#'
#' @examples
masanUI <- function(id) {
  ns <- NS(id)
  fluidPage(
    h3("Checking file paths"),
    fluidRow(
      verbatimTextOutput(ns('check_df_1_reactive')),
      verbatimTextOutput(ns('check_folder_react')),
      verbatimTextOutput(ns('check_cel_files')),
      verbatimTextOutput(ns('check_affy_raw')),
      verbatimTextOutput(ns('check_pca_expr_raw')),
      verbatimTextOutput(ns('check_pca_sd_ratio')),
      verbatimTextOutput(ns('check_pca_percent_var')))
  )
}