inst/shiny-examples/protGear_interactive/load_data_dashboard/server.R

#library(shinySignals)   # devtools::install_github("hadley/shinySignals")
#library(bubbles)        # devtools::install_github("jcheng5/bubbles")


## document -->http://www.cryer.co.uk/file-types/a/atf/genepix_file_formats.htm
## http://www.cryer.co.uk/file-types/a/atf/genepix_file_formats.htm#example

## this loads packages from CRAN
pac_loads <- c('shiny','shinyFiles','DT','tidyverse','shinydashboard','shinyjs',
               'factoextra','FactoMineR','shinySignals','bubbles','ggplotify','shinythemes')


sapply(pac_loads, require, character.only = TRUE)
## this loads or installs packages from github
#pacman::p_load_gh("hadley/shinySignals","jcheng5/bubbles","GuangchuangYu/ggplotify")



#' Title
#'
#' @param input
#' @param output
#' @param session
#'
#' @return
#' @export
#'
#' @examples
shinyServer(function(input, output, session) {
  js$hidehead('none')
  wd_this <- getwd()
  volumes <- getVolumes()()
  dir.create("processed_data")

  shinyFiles::shinyDirChoose(input, "folderChoose",  roots = volumes, #c(home = wd_this),
                 session = session)
## this works where
sel_path <- reactive({
    return(print(parseDirPath(volumes, input$folderChoose)))
})

#'@_______________structure_of_array_data____________________________________
observe({ # called only once at app init
    updateTabItems(session, "structure_view", "structure")
})


#'@______________________load_intro_________________________
#show intro modal
observeEvent("", {
  showModal(modalDialog(
       includeHTML(system.file("shiny-examples/protGear_interactive/", "intro_text.html", package="protGear" ,
                             mustWork = TRUE)),
   
    easyClose = TRUE,
    footer = tagList(
      actionButton(inputId = "intro", label = "DISMISS (INTRODUCTION TOUR)", icon = icon("info-circle"))
    )
  ))
})


observeEvent(input$intro,{
  removeModal()
})

#'@_____________________________check_this___________________
# show intro tour
## to be activated
# observeEvent(input$intro,
#              ## check on radar example
#             # introjs(session, options = list("nextLabel" = "Continue",
#                                             # "prevLabel" = "Previous",
#                                             # "doneLabel" = "Alright. Let's go"))
#             showModal(
#               modalDialog(title = "Just clicked on intro tour!",
#                           p("Spanner in the works.Coming soon!!"))
#             )
#          #  shinyalert::shinyalert("Just clicked on intro tour!", "Spanner in the works.Coming soon!!", type = "warning")
# )


# use action buttons as tab selectors
update_all <- function(x) {
  updateSelectInput(session, "tab",
                    choices = c("Structure overview", "Overview image"),
                    label = "",
                    selected = x
  )
}

observeEvent(input$structure, {
  update_all("Structure overview")
})
observeEvent(input$structure_img, {
  update_all("Overview image")
})


# update confirm button

observeEvent(input$confirm, {
  updateButton(
    session,
    inputId = "confirm",
    label = "CONFIRM SELECTION",
    icon = icon("bar-chart-o"),
    style = "primary")
})

# hide the underlying selectInput in sidebar for better design
observeEvent("", {
  hide("tab")
})

# initiate reactive value storage
rv <- reactiveValues()

observeEvent(input$all_tabs, {
  # store last tab
  rv$last_tab <- rv$current_tab
  rv$current_tab <- input$all_tabs

  if (input$all_tabs == "Overview") {
  showModal(
    modalDialog(title = "Overview",
                headerText = strong("What to do"),
                icon = icon("question"),
                badgeStatus = NULL,
                notificationItem(
                  text = (steps$text[1]),
                  icon = icon("spinner")
                ),
                br(),
                notificationItem(
                  text = steps$text[2],
                  icon = icon("address-card")
                ),
                br(),
                notificationItem(
                  text = steps$text[3],
                  icon = icon("calendar")
                ),
                br(),
                notificationItem(
                  text = steps$text[4],
                  icon = icon("user-md")
                ),
                br(),
                notificationItem(
                  text = steps$text[5],
                  icon = icon("ambulance")
                ),
                br(),
                notificationItem(
                  text = steps$text[6],
                  icon = icon("flask")
                ),
                br(),
                notificationItem(
                  text = strong(steps$text[7]),
                  icon = icon("exclamation")
                ))
  )
    # immediately navigate back to previous tab
    updateTabsetPanel(session, "all_tabs",
                      selected = rv$last_tab)
  }## end if
})


#'@-------------------------------
## a button to load the file
output$gpr_file_load <- renderUI({
    fileInput("gpr_file", "Choose one of the GPR files",
              buttonLabel = "Browse...",
              accept = c(
                "text/csv",
                "text/comma-separated-values,text/plain",
                ".csv")

    )
    # shinyFileChoose(input, 'gpr_file', defaultRoot = 'wd',
    #                   filetypes = c('gpr', "txt"))
})


## read file for the gpr
gpr_file_reactive <- reactive({
  # input$file will be NULL initially. After the user selects
  # and uploads a file, it will be a data frame with 'name',
  # 'size', 'type', and 'datapath' columns.
  inFile <- input$gpr_file

  if (is.null(inFile)){
    return(NULL)
  }else{
    x <- grep('Block.*Column|Column.*Block', readLines(inFile$datapath))
    # d_f <- read.table(inFile$datapath,skip=x-1, header = T)
    d_f <- data.table::fread(inFile$datapath,skip=x-1, header=TRUE)
    d_f <- d_f %>%
      group_by(Block) %>%
      mutate(meanX=mean(X),meanY=mean(Y),maxY=max(Y),maxX=max(X),minY=min(Y),minX=min(X))
    return(d_f)
  }

})


## reading the gpr file
gpr_header_reactive <- reactive({
  #inFile <- input$gpr_file
  inFile <- input$gpr_file
  if (is.null(inFile))    return(NULL)
  header_gpr <- readGPRHeader(file=inFile$datapath)


  return(header_gpr)

})


## empty structure
empty_strucuture <- reactive({
  text <- paste("\nLoad one of the file that has MFI data\n",
               "       to visualize/define the structure ")
  plot_empty2 <- ggplot() +
    annotate("text", x = 4, y = 25, size=8, label = text) +
    theme_bw() +
    theme(panel.grid.major=element_blank(),
          panel.grid.minor=element_blank())
  return(plot_empty2)
})


## a plot for the structure of the arrays
output$structure_plot <- renderPlot({
  gpr_file_reactive <- gpr_file_reactive()

  if(!is.null(gpr_file_reactive)){
    gpr_header <- gpr_header_reactive()

    gpr_header_wl <- unlist(strsplit(gpr_header$Wavelengths,"\\r|\\n|\\t"))
    gpr_header_wl <- gsub('\"',"",gpr_header_wl, fixed=TRUE)
    gpr_header_wl <- gpr_header_wl[gpr_header_wl!=""]
      p <- ggplot(gpr_file_reactive, aes(x=X, y=-Y, colour=as.factor(Block))) +
        #geom_rect(aes(xmin = minX, xmax = maxX, ymin = -minY, ymax = -maxY),color = "black",alpha=0.0001,fill="blue") +
        geom_point(size=.1) +
        theme_void()+
        theme(legend.position = "none") +
        # scale_color_brewer(palette="Set3") +
        geom_text(aes(x=meanX, y=-meanY, label=paste("Block",Block)), color="black",size=4) +
        ggtitle(paste("Scanned at", gpr_header_wl ,"Wavelength(s)"))


    }else if(is.null(input$gpr_file)){
      p <- empty_strucuture()

    }else{
      p <- empty_strucuture()

    }
  return(p)
})



## select the variable to plot
## selectig the spatial variable to plot
output$select_spatial_var <- renderUI({
  gpr_header <- gpr_header_reactive()
  gpr_file_reactive <- gpr_file_reactive()

  if(!is.null(gpr_file_reactive)){
    var_names <- names(gpr_file_reactive)
    var_names <- var_names[grepl("[Mm]edian|[Mm]ean",var_names)]
    tagList(
      useShinyFeedback(), # include shinyFeedback  # inclusion here is ideal; b/c inside module
      selectInput(inputId = "select_spatial",
                  "Select the variable to visualize",
                  choices = var_names,
                  selected = var_names[grep(paste0("^[B]635.*Median$"),var_names)]
      )
    )
  }
})



output$select_spatial_type <- renderUI({
  graphs <- c("Point graph"='point',
              "Array 2D graph"='2d_array')
  # graphs_id <- c("bar_chart","ridge_plot")
  prettyRadioButtons(inputId="spatial_type",
                     label = 'Plot an array 2D plot or a point graph:',
                     choices =  graphs,
                     inline= TRUE, animation = "jelly",
                     status = "default",
                     shape = "curve",bigger = TRUE)

})


## a plot for the spatial structure of the arrays
output$spatial_structure_plot <- renderPlotly({
  gpr_file_reactive <- gpr_file_reactive()
  inFile <- input$gpr_file
  MFI_var <- input$select_spatial
  if(!is.null(gpr_file_reactive)){
    m <- list(
      l = 20,
      r = 50,
      b = 50,
      t = 50,
      pad = 20
    )

      p <- visualize_slide(infile=inFile,
                           MFI_var =MFI_var, interactive=TRUE ,d_f=gpr_file_reactive)
      p <- p  %>%
        layout(title = paste("Spatial visualization of", MFI_var ," MFI"),
               margin = m)
      #ggtitle(paste("Spatial visualization of", MFI_var ," MFI"))


  }else if(is.null(input$gpr_file)){
    p <- empty_strucuture()
    p <- ggplotly(p)
  }else{
    p <- empty_strucuture()
    p <- ggplotly(p)
  }
  return(p)
})




output$spatial_structure_plot_2d <- renderPlot({
  gpr_file_reactive <- gpr_file_reactive()
  inFile <- input$gpr_file
  MFI_var <- input$select_spatial
  if(!is.null(gpr_file_reactive)){


      p <- visualize_slide_2d(infile=inFile,
                              MFI_var =MFI_var,d_f=gpr_file_reactive)
      p <- p  + ggtitle(paste("Spatial visualization of", MFI_var ," MFI")) #%>% layout(title = paste("Spatial visualization of", MFI_var ," MFI"))


  }else if(is.null(input$gpr_file)){
    p <- empty_strucuture()

  }else{
    p <- empty_strucuture()

  }
  return(p)
})


## indicating the scanning wavelength
output$wavelength_struct <- renderInfoBox({
  gpr_header <- gpr_header_reactive()

  if(is.null(gpr_header)){
   infoBox("Select the a gpr/text",
            subtitle = paste0("LOAD A FILE") ,
            # icon = shiny::icon("user-md"),
            icon = icon("exclamation-triangle"),
            color = "red",width = 4,fill = TRUE)
  }else{
    gpr_header_wl <- unlist(strsplit(gpr_header$Wavelengths,"\\r|\\n|\\t"))
    gpr_header_wl <- gsub('\"',"",gpr_header_wl, fixed=TRUE)
    gpr_header_wl <- gpr_header_wl[gpr_header_wl!=""]
    infoBox("The file(s) were scanned at:", paste(gpr_header_wl,collapse = ';'),
            subtitle = paste0("Wavelength(s)") ,
            icon = shiny::icon("check-circle"),
            color = "orange",width = 4,fill = TRUE)
  }

})

## miniarray
output$total_miniarray_struct <- renderUI({
  gpr_header <- gpr_header_reactive()
  if(!is.null(gpr_header)){
    tagList(
      useShinyFeedback(), # include shinyFeedback  # inclusion here is ideal; b/c inside module
      numericInput(inputId = "total_miniarray",
                   "Input the total number of mini-arrays as per the graph below . Each miniarray appears as a rectangle",
                   value = ''
      )
    )
  }
})

#### warning for the selecting the number of mini arrays
observeEvent(input$total_miniarray, {
  req(input$total_miniarray)
  gpr_file_reactive <- gpr_file_reactive()

  if(!is.null(gpr_file_reactive)){
    blocks <- max(gpr_file_reactive$Block, na.rm = TRUE)
  }else{
    blocks <- 0
  }

  if (input$total_miniarray >blocks |input$total_miniarray <0  ) {
      showFeedbackWarning(inputId = "total_miniarray",
                          text = "The value is more or less than available blocks",color = "#FF0000")
    } else {
      hideFeedback("total_miniarray")
    }
})


## observer event for foreground  name
observeEvent(input$select_F, {
  req(input$select_F)
  if (!grepl('^F',input$select_F)  ) {
    showFeedbackWarning(inputId = "select_F",
                        text = "The variable selected does not start with F",color = "#FF0000")
  } else {
    hideFeedback("select_F")
  }
})


## observer event for background name
observeEvent(input$select_B, {
  req(input$select_B)
  if (!grepl('^B',input$select_B)  ) {
    showFeedbackWarning(inputId = "select_B",
                        text = "The variable selected does not start with B",color = "#FF0000")
  } else {
    hideFeedback("select_B")
  }
})


## observer event for input of samples per block
observeEvent(input$blockspersample_param, {
  req(input$blockspersample_param)
  req(input$total_miniarray)
  gpr_file_reactive <- gpr_file_reactive()
  if(!is.null(gpr_file_reactive)){
    mini_arrays <- input$total_miniarray
    blocks <- max(gpr_file_reactive$Block, na.rm = TRUE)
    value_check <- blocks/mini_arrays

  }else{
    value_check <- 0
  }
  #alue_check=2
  if (input$blockspersample_param>value_check |input$blockspersample_param<value_check    ) {
    showFeedbackWarning(inputId = "blockspersample_param",
                        text = "This does not match well with the mini array",color = "#FF0000")
  } else {
    hideFeedback("blockspersample_param")
  }
})



## select the input for the foreground var
output$select_F_var <- renderUI({
  gpr_header <- gpr_header_reactive()
  gpr_file_reactive <- gpr_file_reactive()

  if(!is.null(gpr_file_reactive)){
    var_names <- names(gpr_file_reactive)
    var_names <- var_names[grepl("[Mm]edian",var_names)]
    tagList(
      useShinyFeedback(), # include shinyFeedback  # inclusion here is ideal; b/c inside module
      selectInput(inputId = "select_F",
                   "Select the FOREGROUND variable, mostly the variable starts with F followed by wavelength",
                  choices =var_names,
                  selected = var_names[grep(paste0("^[F]635.*Median$"),var_names)]
      )
    )
  }
})

## selectig the background variable
output$select_B_var <- renderUI({
  gpr_header <- gpr_header_reactive()
  gpr_file_reactive <- gpr_file_reactive()

  if(!is.null(gpr_file_reactive)){
    var_names <- names(gpr_file_reactive)
    var_names <- var_names[grepl("[Mm]edian",var_names)]
    tagList(
      useShinyFeedback(), # include shinyFeedback  # inclusion here is ideal; b/c inside module
      selectInput(inputId = "select_B",
                  "Select the BACKGROUND variable, the variable starts with B followed by wavelength",
                  choices = var_names,
                  selected = var_names[grep(paste0("^[B]635.*Median$"),var_names)]
      )
    )
  }
})


## input the numbe of blocks
output$blockspersample_output <- renderUI({
  gpr_file_reactive <- gpr_file_reactive()
 if(!is.null(input$total_miniarray)){
   mini_arrays <- input$total_miniarray
   blocks <- max(gpr_file_reactive$Block, na.rm = TRUE)
   value_check <- blocks/mini_arrays

 }else{
   value_check <- 1
 }
  if(!is.null(gpr_file_reactive)){

    tagList(
      useShinyFeedback(), # include shinyFeedback  # inclusion here is ideal; b/c inside module
      numericInput("blockspersample_param",
        "Input the number blocks per sample (rectangle) as per the graph below",
        value = value_check
      )
    )
  }


})


#'@_______________end_structure_of_array_data____________________________________


#'@_______________parameters_of_array_data____________________________________
#'
## input for the parameters
## select  the folders



output$dir_files <- renderUI({
  inFile <- input$gpr_file
  if(!is.null(inFile)){
    if(!is.na(input$total_miniarray) | !is.null(input$total_miniarray)){
      shinyFiles::shinyDirButton("folderChoose",
                                 "Chose directory with the data",
                                 "Upload")
    }else{
      stop("Define the mini-array number to load files")
    }
  }else{
    stop("Define the array structure to load files")
  }
  #shinyalert("Oops!", "Something went wrong.", type = "error")
})

## check why disable button not working????
# observe({
#   useShinyjs()
#   #if(!is.null(input$gpr_file)){
#    # shinyjs::enable("folderChoose")
#   #} else {
#     shinyjs::disable("folderChoose")
#   #}
# })

## define the tab to load on intialisation
observe({ # called only once at app init
  updateTabItems(session, "data_load_tabs", "dashboard")
})


## observer event for input of the channel
observeEvent(input$channel_param, {
  req(input$channel_param)
  req(gpr_header_reactive())
  gpr_header <- gpr_header_reactive()
  gpr_header_wl <- unlist(strsplit(gpr_header$Wavelengths,"\\r|\\n|\\t"))
  gpr_header_wl <- gsub('\"',"",gpr_header_wl, fixed=TRUE)
  gpr_header_wl <- gpr_header_wl[gpr_header_wl!=""]
if (input$channel_param %ni% gpr_header_wl &!is.null(gpr_header)  ) {
  showFeedbackDanger(inputId = "channel_param",
                        text = "This does not match with what was entered on the structure",color = "#FF0000")
  } else {
    hideFeedback("channel_param")
  }
})


## observer event for input of the samples per slide
observeEvent(input$totsamples_param, {
  req(input$totsamples_param)
  req(input$total_miniarray)

  if (input$totsamples_param!=input$total_miniarray  ) {
    showFeedbackDanger(inputId = "totsamples_param",
                       text = "This does not match with what was entered on the structure. Expects each sample per mini-array",color = "#FF0000")
  } else {
    hideFeedback("totsamples_param")
  }
})

## if the intial file is not laoded the user has the freedom of selecting the wavelength
output$channel_output <- renderUI({
  inFile <- input$gpr_file
  if(!is.null(inFile)){
    gpr_header <- gpr_header_reactive()
    gpr_header_wl <- unlist(strsplit(gpr_header$Wavelengths,"\\r|\\n|\\t"))
    gpr_header_wl <- gsub('\"',"",gpr_header_wl, fixed=TRUE)
    gpr_header_wl <- gpr_header_wl[gpr_header_wl!=""]
    if(!is.null(gpr_header)){
      tagList(
        useShinyFeedback(),
        selectInput("channel_param",
                    h4("Input the channel used for scanning the data"),
                    c("635" = "635",
                      "532" = "532",
                      "488" = "488",
                      "594 " = "594 "),
                    selectize = FALSE,
                    selected =   gpr_header_wl[[1]]))
    }
  }else {
    tagList(
      useShinyFeedback(),
      selectInput("channel_param",
                  h4("Input the channel used for scanning the data"),
                  choices =  c("635" = "635",
                               "532" = "532",
                               "488" = "488",
                               "594 " = "594 "),
                  selectize = FALSE)
    )
    }
})

## the total samples per slide
output$total_samples_output <- renderUI({
  inFile <- input$gpr_file
  if(!is.null(inFile)){
    if(is.null(input$total_miniarray)){
      numericInput(
        "totsamples_param",
        h4("Input the  total number of samples per slide "),
        value = ''
      )
    }else{
      numericInput(
        "totsamples_param",
        h4("Input the  total number of samples per slide "),
        value = input$total_miniarray
      )
    }

  }else{
    numericInput(
      "totsamples_param",
      h4("Input the  total number of samples per slide "),
      value = ''
    )
  }


  })


output$mig_prefix_output <- renderUI({
  textInput(
    "mig_suffix_param",
    h4("Input the prefix used to identify the MIG files"),
    placeholder = "_first"
  )
})

output$machine_output <- renderUI({
  textInput(
    "machine_param",
    h4("Hybridization machine used before expression"),
    placeholder = "m1"
  )
})


output$date_process_output <- renderUI({
  textInput(
    "date_process_param",
    h4("Input the month day and month of processing"),
    placeholder = "0505"
  )
})




#'@_______________End_definition_of_parameters____________________________________
##################################################################################


#'@_______________Path_of_data_definition_and_working_directory____________________________________
# sel_path <- reactive({
#     return(print(parseDirPath( c(home = wd_this) , input$folderChoose)))
#   })
#
setWorkingDir<- eventReactive(input$folderChoose,{
    setwd(sel_path())
})


## output all the directory
output$batch_select <- renderUI({
  ## the path
  folder_choose <- parseDirPath(c(home = wd_this) ,input$folderChoose)
  paths <- list.dirs(path =sel_path() , full.names = TRUE)
  #paths <- paths[grepl("machine" , paths)]
  path_toutput <- gsub(paste0(getwd(),"/"),"", paths)

  selectInput(inputId='chip_path_param',
              label='Select the batch of data to be processed:',
              choices=path_toutput)

})


output$sampleID_select <- renderUI({
  ## the path
  folder_choose <- parseDirPath(c(home = wd_this) ,input$folderChoose)
  paths <- list.dirs(path =sel_path() , full.names = TRUE)
  #paths <- paths[grepl("sample[Ii][Dd]" , paths)]
  path_toutput <- gsub(paste0(getwd(),"/"),"", paths)

  selectInput('sampleID_path_param',
              'Select the folder with sampleID\'s :',
              path_toutput)

})



#'@_______________End_Path_of_data_definition____________________________________
  ##################################################################################

#'@_______________function_to_collect_all_the_parametes____________________________________
  ## specify the the parameters to process the data
genepix_vars <- reactive({
  genepix_vars_ls <- array_vars(channel=input$channel_param ,
                            FG= input$select_F,
                            BG=input$select_B,
                             chip_path = input$chip_path_param , #sel_path , #"data/array_data",
                             totsamples = input$totsamples_param,
                             blockspersample = input$blockspersample_param,  # 2,
                             sampleID_path = input$sampleID_path_param ,#"data/array_sampleID/",
                             mig_prefix = input$mig_suffix_param,
                             machine = input$machine_param ,#1,
                             date_process = input$date_process_param )
    return(genepix_vars_ls)
})

#'@_______________end_all_parameter_collection____________________________________
##################################################################################


#'@_______________count_all_files_in_the_path_selected____________________________________
#'
#'
## first check all files have sample ID

check_sampleIDs <- reactive({
  inFile <- input$gpr_file
  if(!is.null(inFile)){
    if(input$sampleID_path_param=="" | is.null(input$sampleID_path_param ) ){
      check_result <- NULL
    }else(
      check_result <- check_sampleID_files(genepix_vars())

    )

  }else{
    check_result <- NULL
  }


})

output$check_sampleID_out <- renderInfoBox({

  missing_id <- length(check_sampleIDs())
  if(missing_id==0){
    infoBox("Select the directory",
            subtitle = paste0("with sampleID's") ,
           # icon = shiny::icon("user-md"),
           icon = icon("exclamation-triangle"),
            color = "red",width = 4,fill = TRUE)
  }else{
    infoBox("Files with missing sampleID .csv:", missing_id,
            subtitle = paste0("The files are saved in the log file") ,
            icon = shiny::icon("user-md"),
            color = "fuchsia",width = 4,fill = TRUE)
  }

})


## lists all the files in the selected directory
all_files <- reactive({
  inFile <- input$gpr_file

  if(!is.null(inFile)){
  if(is.null(input$chip_path_param) | input$chip_path_param==""){
   filesInDir <- NULL
 }else if(!is.null(input$chip_path_param)){
   pth_full <- file.path(input$chip_path_param)
   pth <-input$chip_path_param
   #path_toutput <- gsub(paste0(getwd(),"/"),"", input$chip_path_param)
   ### list the files in the directory
   filesInDir <- list.files(pth_full)

 }
  }else{
    filesInDir <- NULL
  }
   return(filesInDir)
})


##total number of files
output$files_in_batch <- shinydashboard::renderInfoBox({
  total_files <- length(all_files())
  if(total_files==0){
    infoBox("Select the folder with array data",
            paste0("NA"),
            icon = icon("exclamation-triangle"),
            color = "red")
  }else if(total_files>0){
    infoBox("Total files in batch",
      paste0(total_files),
      subtitle = paste0("Files ending with .txt or .gpr"),
      icon = icon("list-ul"),
      color = "olive"
    )
  }


})

#'@_______________end_all_count_of_files____________________________________
##################################################################################


#'@_______________Display_some_key_info____________________________________
#'
#'
#### read in all the datasets
### list all the file names under data folder
filenames_reactive <- reactive({
  genepix_vars <- genepix_vars()
  filenames_return <- list.files(file.path(genepix_vars$chip_path),
                        pattern="*.txt$|*.gpr$", full.names=FALSE)


  return(filenames_return)
})


data_files_reactive  <-  reactive({
  if(is.null(input$chip_path_param) | input$chip_path_param==""){
    data_files <- NULL
  }else {
    genepix_vars <- genepix_vars()
    filenames <- filenames_reactive()

    data_files <- purrr::map(.x = filenames,
                             .f = read_array_files,
                             data_path=genepix_vars$chip_path ,
                             genepix_vars=genepix_vars)
    data_files <- set_names(data_files, purrr::map(filenames, name_of_files))
  }

  return(data_files)
})

dfs <- reactive({
  dfs_names <- names(data_files_reactive())
  return(dfs_names)
})




params_display <- reactive({
  inFile <- input$gpr_file
  if(!is.null(inFile)){
  if(is.null(input$chip_path_param) | input$chip_path_param==""){
    params_df <- NULL
  }else{
    data_files <- data_files_reactive()
    genepix_vars <- genepix_vars()
    df_1 <- data_files[[1]]

    blocks <- max(df_1$Block)
    spotsperblock <- table(df_1$Block)[[1]]
    antigens <- length(unique(df_1$Name))
    antigen_list <- c(unique(as.character(df_1$Name)))
    antigen_list <- gsub(" ","",antigen_list)
    params_df <- list(blocks=blocks,
                      spotsperblock=spotsperblock,
                      antigens=antigens,
                      antigen_list=antigen_list)
  }
    }else{
      params_df <- NULL
  }

 return(params_df)
})


output$blocks_count <- renderInfoBox({
  #req(input$chip_path_param)
  params_df <- params_display()
  if(is.null(params_df) ){
    infoBox("Select the directory",
            subtitle = paste0("with array data") ,
            icon = icon("exclamation-triangle"),
            color = "red",width = 4,fill = TRUE)
  }else{
    infoBox("Each array file has : ", paste(params_df$blocks, "blocks"),
            subtitle = paste("with",params_df$spotsperblock, "spots per block") ,
            icon = icon("th",lib = "font-awesome"),
            color = "red",width = 4,fill = FALSE)
  }

})


output$antigens_count  <- renderInfoBox({
  params_df <- params_display()
  if(is.null(params_df)){
    infoBox("Select the directory",
            subtitle = paste0("with array data") ,
            icon = icon("exclamation-triangle"),
            color = "red",width = 4,fill = TRUE)
  }else{
    infoBox("Each array file has: ", params_df$antigens,
            subtitle = paste0("antigens") ,
            icon = icon("allergies",lib = "font-awesome"),
            color = "red",width = 4,fill = FALSE)
  }

})




## empty plot for adding to before data load
empty_plot <- reactive({
  inFile <- input$gpr_file
  if(!is.null(inFile)){

    if(is.na(input$total_miniarray)){
      x <- 0
    }else {x <- 1}

    if(x==0){
      text <- paste("\nPlot will appear after\n",
                   " a) defining the number of mini-arrays in design structure\n",
                   " b) selecting folder with data")
    }else  {
      text <- paste("\nPlot will appear after\n",
                   " a) selecting folder with data\n"
      )
    }

  }else{
    text <- paste("\nPlot will appear after\n",
                 " a) defining the array design structure then \n",
                 " b) selecting folder with data")
  }

   plot_empty <- ggplot() +
     annotate("text", x = 4, y = 25, size=8, label = text) +
     theme_bw() +
     theme(panel.grid.major=element_blank(),
           panel.grid.minor=element_blank())
   return(plot_empty)
})


empty_plot_error <- reactive({
  text <- paste("\nCheck data stucture well.\n",
               "       replicates definition or ")
  plot_empty <- ggplot() +
    annotate("text", x = 4, y = 25, size=8, label = text) +
    theme_bw() +
    theme(panel.grid.major=element_blank(),
          panel.grid.minor=element_blank())
  return(plot_empty)
})


empty_plot_NS <- reactive({
  text <- paste("\nNot selected.\n",
               " ")
  plot_empty <- ggplot() +
    annotate("text", x = 4, y = 25, size=8, label = text) +
    theme_bw() +
    theme(panel.grid.major=element_blank(),
          panel.grid.minor=element_blank())
  return(plot_empty)
})


empty_plot_no_rep <- reactive({
  text <- paste("\nThe experiment did not have\n",
               "       lab replicates or \n",
               "Select the no of lab replicates")
  plot_empty <- ggplot() +
    annotate("text", x = 4, y = 25, size=8, label = text) +
    theme_bw() +
    theme(panel.grid.major=element_blank(),
          panel.grid.minor=element_blank())
  return(plot_empty)
})

### plot of the buffer spots
## filenams
merged_dfs_reactive <- reactive({
  if(is.null(input$chip_path_param) | input$chip_path_param==""){
    sample_ID_merged_dfs <- NULL
  }else {
    genepix_vars <- genepix_vars()
    filenames <- filenames_reactive()
    data_files <-  data_files_reactive()
    dfs <- dfs()
    sample_ID_merged_dfs <- purrr::map(.x=dfs, .f=merge_sampleID ,data_files=data_files ,
                                         genepix_vars, method="subtract_local")
    sample_ID_merged_dfs <- set_names(sample_ID_merged_dfs, purrr::map(filenames, name_of_files))



  }

  return(sample_ID_merged_dfs)
})



# table of a sample dataset of the file
output$tbl_all_data <-  DT::renderDT({
  folder_choose <- parseDirPath(c(home = wd_this) ,input$folderChoose)
  if(!rlang::is_empty(sel_path) ){#input$folderChoose!=''
    all_datas <- list.files(sel_path() , recursive = TRUE)
    sample_ID_merged_dfs <-  merged_dfs_reactive()
    d_f <- plyr::ldply(sample_ID_merged_dfs)
    write_csv(d_f, paste("processed_data/raw_data-", Sys.Date(), ".csv", sep=""))
    df <- DT::datatable(d_f)

  }
  #options = list(lengthChange = FALSE,
  #  initComplete = JS('function(setting, json) { alert("done"); }'))
  return( df)
})

## download all data
output$download_Raw_Data <- downloadHandler(
  filename = function() {
    paste("raw_data-", Sys.Date(), ".csv", sep="")
  },
  content = function(file) {
    sample_ID_merged_dfs <-  merged_dfs_reactive()
    d_f <- plyr::ldply(sample_ID_merged_dfs)
    write_csv(d_f, file)
  }
)



dfs_reactive_bg_correct <- reactive({
  if(is.null(input$chip_path_param) | input$chip_path_param==""){
    sample_ID_merged_dfs <- NULL
  }else {
    genepix_vars <- genepix_vars()
    filenames <- filenames_reactive()
    data_files <-  data_files_reactive()
    dfs <- dfs()
    sample_ID_merged_dfs <- purrr::map(.x=dfs, .f=merge_sampleID ,data_files=data_files ,
                                       genepix_vars, method=input$bg_correct_1)
    sample_ID_merged_dfs <- set_names(sample_ID_merged_dfs, purrr::map(filenames, name_of_files))
}

  return(sample_ID_merged_dfs)
})


## function with bg correct input under CV tab
merged_dfs_reactive_bg_correct <- reactive({
  if(is.null(input$chip_path_param) | input$chip_path_param==""){
    sample_ID_merged_dfs <- NULL
  }else {
    genepix_vars <- genepix_vars()
    filenames <- filenames_reactive()
    data_files <-  data_files_reactive()
    dfs <- dfs()
   sample_ID_merged_dfs <- purrr::map(.x=dfs, .f=merge_sampleID ,data_files=data_files ,
                                         genepix_vars, method=input$bg_correct)
  sample_ID_merged_dfs <- set_names(sample_ID_merged_dfs, purrr::map(filenames, name_of_files))



  }

  return(sample_ID_merged_dfs)
})


all_data_reactive <- reactive({
  if(is.null(input$chip_path_param) | input$chip_path_param==""){
    allData <- NULL
  }else {
    dfs <- dfs()
    filenames <- filenames_reactive()
    data_files <-  data_files_reactive()
    genepix_vars <- genepix_vars()

    allData <- purrr::map(.x=dfs, .f=extract_bg,data_files=data_files,genepix_vars)
    allData <- set_names(allData, purrr::map(filenames, name_of_files))
    allData <- plyr::ldply(allData)
  }
 return(allData)
})


buffers_dfs_reactive <- reactive({
  if(is.null(input$chip_path_param) | input$chip_path_param==""){
    buffers <- NULL
  }else {
    sample_ID_merged_dfs <-  merged_dfs_reactive()
    filenames <- filenames_reactive()
    buffer_transp <- purrr::map(.x=sample_ID_merged_dfs, .f=buffer_spots)

    buffer_transp <- set_names(buffer_transp, purrr::map(filenames, name_of_files))

    buffers <- plyr::ldply(buffer_transp)
  }

  return(buffers)
})

 ## plot the buffer spots
output$data_process <- renderPlot({#DT::renderDT
  inFile <- input$gpr_file
  if(!is.null(inFile)){
  if(input$chip_path_param!="") {

    buffers <-  buffers_dfs_reactive()
    merged_dfs <- merged_dfs_reactive()
    dfs <- dfs()

    p <-  plot_buffer(buffers,buffer_names="antigen",buffer_mfi="FMedianBG_correct",slide_id=".id")

     }else{
     p <- empty_plot()

   }
  }else{
    p <- empty_plot()

  }
  return(p)
 })


output$data_box <- renderPlotly({
  inFile <- input$gpr_file
  if(!is.null(inFile)){
  if(input$chip_path_param!="") {
    sample_ID_merged_dfs <-  merged_dfs_reactive()

    merged_dfs <- plyr::ldply(sample_ID_merged_dfs)
    merged_dfs <- merged_dfs %>%
      filter(!grepl("[Bb][Uu][Ff][Ff][Ee][Rr]",antigen))

    antigens_list <- unique(merged_dfs[["antigen"]])
    antigens_list_plot <- antigens_list[input$slider_antigen[[1]]:input$slider_antigen[[2]]]

    merged_dfs <- merged_dfs %>%
      filter(antigen %in% antigens_list_plot)

    p <- plot_ly(merged_dfs, y = ~FMedianBG_correct, color = I("blue"),
                 alpha = 0.1, boxpoints = "suspectedoutliers",width=0.1 )
    p <- p %>%
      add_boxplot(x = ~antigen)  %>%
      layout(xaxis = list(title = "", tickangle = -45))
    p
  }else{
    p <- empty_plot()
    p <- ggplotly(p)
  p
  }
  }else{
    p <- empty_plot()
    p <- ggplotly(p)
    p
  }
})
#'@_______________End_display_some_key_info____________________________________

#'@_______________Background_correction____________________________________

## define which tab to load on opening the tab items
observe({ # called only once at app init
  updateTabItems(session, "bg_tabs", "bg_graphs")
})


output$slide_names_bg <- renderUI({
  if(input$chip_path_param!="") {
 dfs_names <- list('Slides'=dfs())
 dfs <- dfs()
 pickerInput(inputId="slide",
             label="Choose a slide:",
             choices= dfs,
             options = list(
               `actions-box` = TRUE,
               size = 10,
               `selected-text-format` = "count > 3"
             ),
             selected = paste(dfs),
             multiple = TRUE)
  }
})


output$select_log_MFI <- renderUI({
  graphs <- c("Log the MFI"=TRUE,
              "Raw MFI"=FALSE)
  # graphs_id <- c("bar_chart","ridge_plot")
  prettyRadioButtons(inputId="log_mfi",
                     label = 'Plot with log or raw MFI:',
                     choices =  graphs,
                     inline=TRUE, animation = "jelly",
                     status = "default",
                     shape = "curve",bigger = TRUE)

})

output$select_block_antigen <- renderUI({
  graphs <- c("Block"="Block",
              "Antigen"="antigen")
  awesomeRadio("block_antigen",
               label = 'Select block or antigen:',
               choices =  graphs,
               # choiceValues=all_var_prefix,
               #selected = character(0),
               inline=TRUE)

})

output$value_block <- renderUI({
  paste(input$block_antigen)
})


observe({
  x <- input$block_antigen
  y <- 'Background plot by'

  updateTextInput(session, "value_block", value = paste(y, x))


})

output$bg_plots <- renderPlotly({
  if(input$chip_path_param!="") {
    ## load the default parameted
    allData_bg <-  all_data_reactive()
    allData_bg <- allData_bg %>%
      filter(.id %in% input$slide)

    p<- plot_bg(df=allData_bg, x_axis=input$block_antigen,bg_MFI="BG_Median",
            log_mfi=input$log_mfi)
    p <- ggplotly(p) %>%  layout(height = 800)
    p
  }else{
    p <- empty_plot()
    p <- ggplotly(p)
    p
  }

})


output$fg_bg_plots <- renderPlotly({
  if(input$chip_path_param!="") {
    ## load the default parameted
    allData_bg <-  all_data_reactive()

    allData_bg <- allData_bg %>%
      filter(.id %in% input$slide)
    p <- plot_FB(allData_bg,antigen_name="antigen",bg_MFI="BG_Median",FG_MFI="FBG_Median")
    p <- ggplotly(p, tooltip = "text")%>%  layout(height = 800)
    p
  }else{
    p <- empty_plot()
    p <- ggplotly(p)
    p
  }

})




output$bg_correction_select_1 <- renderUI({
  bg_correct_approaches <- c("None"="none",
                             "Local bakground subtraction"="subtract_local",
                             "Global background subtraction"="subtract_global",
                             "Moving mininimum"="movingmin_bg",
                             "Half Moving mininimum"="minimum_half",
                             "Log-linear background correction"="edwards",
                             "Normal Exponential (normexp)"="normexp"
                             )
  selectInput(inputId = 'bg_correct_1',
              label = 'Background correction',
              selected = 'subtract_local',
              choices = bg_correct_approaches)
})


output$bg_correct_graphs <- renderPlot({
  if(input$chip_path_param!="") {
    bg_correct_df <- dfs_reactive_bg_correct()
    bg_correct_df <- plyr::ldply(bg_correct_df)
    all_df <- bg_correct_df %>%
      select(antigen,FMedian,FMedianBG_correct) %>%
      gather(var,mfi,-antigen)



    # New facet label names for var variable
   supp_labs <- c("FMedian before background correction", "FMedian after background correction")
    names(supp_labs) <- c("FMedian", "FMedianBG_correct")

    p <- ggplot(all_df,aes(x=antigen, y=mfi))+
      geom_boxplot()+
      facet_wrap(~var, nrow = 2,labeller = labeller(var = supp_labs))+
      geom_hline(yintercept = 0, color='red')+
      theme_light()+
    #  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1)) +
      ylab("MFI") +
      theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1),
            strip.background = element_rect(fill="black",size = 3),
            strip.text.x = element_text(size=12, color="white",
                                        face="bold.italic")) +
      ggtitle(paste0(input$bg_correct_1," background correction"))


  }else{
    p <- empty_plot()

  }
  return(p)
},height=800)

#'@_______________End_Background_correction____________________________________
#'
#'
#'
#'@_______________CV_calculation____________________________________

observe({ # called only once at app init
  updateTabItems(session, "cv_tabs", "bg_correct_cv")
})


output$bg_correction_drop_down <- renderUI({
  bg_correct_approaches <- c("None"="none",
                             "Local bakground subtraction"="subtract_local",
                             "Global background subtraction"="subtract_global",
                             "Moving mininimum"="movingmin_bg",
                             "Half Moving mininimum"="minimum_half",
                             "Log-linear background correction"="edwards",
                             "Normal Exponential (normexp)"="normexp")


  dropdownButton(
    tags$h3("List of Inputs"),
    selectInput(inputId = 'bg_correct', label = 'Background correction', choices = bg_correct_approaches),
    selectInput(inputId = 'ycol', label = 'Y Variable', choices = names(iris), selected = names(iris)[[2]]),
    sliderInput(inputId = 'clusters', label = 'Cluster count', value = 3, min = 1, max = 9),
  circle = TRUE, status = "danger", icon = icon("gear"), width = "300px",
    tooltip = tooltipOptions(title = "Click to see inputs !")
  )
})



output$bg_correction_select <-  renderUI({
  if(!is.null(input$bg_correct_1)){
    selected_bg <- input$bg_correct_1
  }else{
    selected_bg <- 'subtract_local'
  }
  bg_correct_approaches <- c("None"="none",
                             "Local bakground subtraction"="subtract_local",
                             "Global background subtraction"="subtract_global",
                             "Moving mininimum"="movingmin_bg",
                             "Half Moving mininimum"="minimum_half",
                             "Log-linear background correction"="edwards",
                             "Normal Exponential (normexp)"="normexp")
  selectInput(inputId = 'bg_correct',
              label = 'Background correction',
              selected = selected_bg,
              choices = bg_correct_approaches)
})

output$cv_value_select <- renderUI({
  sliderInput(inputId = 'cv_value', label = 'Select CV cut off', value = 20, min = 1, max = 100)
})

output$cv_ui <- renderText({ input$cv_value })


output$minimum_mfi_select <- renderUI({
  sliderInput(inputId = 'cv_value_mfi', label = 'Select MFI for CV cut off', value = 1000, min = 100, max = 10000)
})



output$replicates_select <- renderUI({
  sliderInput(inputId = 'lab_replicates',
              label = 'Select the number of lab replicates',
              value = 1, min = 1, max = 5)
})


data_CV_reactive <- reactive({
  if(input$chip_path_param!="") {
  sample_ID_merged_dfs <-  merged_dfs_reactive_bg_correct()
  filenames <- filenames_reactive()
  dataCV <- purrr::map(.x=sample_ID_merged_dfs, .f=cv_estimation ,lab_replicates=input$lab_replicates,
                       cv_cut_off=input$cv_value)

  dataCV <- set_names(dataCV, purrr::map(filenames, name_of_files))
  }else {
    dataCV <- NULL
  }
  return(dataCV)
})


data_CV_best2_reactive <- reactive({
  if(input$chip_path_param!="") {
    dataCV <- data_CV_reactive()
    filenames <- filenames_reactive()
    dataCV_best2 <- purrr::map(.x=dataCV, .f=best_CV_estimation , slide_id="iden" ,
                               lab_replicates=input$lab_replicates,cv_cut_off=input$cv_value)


# # give the names to the returned list
    dataCV_best2 <- set_names(dataCV_best2, purrr::map(filenames, name_of_files))
  }else {
    dataCV_best2 <- NULL
  }
  return(dataCV_best2)
})

output$cv_corr_plot <- renderPlot({
  dataCV <- data_CV_reactive()
  dataCV <- plyr::ldply(dataCV)
  if(input$chip_path_param!="") {
  if(max(dataCV$replicates) <=input$lab_replicates & input$lab_replicates!=1){

    ggpairs(dataCV,aes(color=cvCat_all) ,
            columns = paste(1:input$lab_replicates), title = "",  axisLabels = "show") +
      theme_light()
  }else if(input$lab_replicates==1){
    p <- empty_plot_no_rep()
    p
  }else{
    p <- empty_plot_error()
    p
  }
  }else{
    p <- empty_plot()
    p
  }

})

dataCV_all_sample_reactive <- reactive({
  if(input$lab_replicates>1) {
  dataCV <- data_CV_reactive()
  filenames <- filenames_reactive()

  dataCV_sample <- purrr::map(.x=dataCV, .f=cv_by_sample_estimation , cv_variable="cvCat_all" ,
                              lab_replicates=input$lab_replicates)
  dataCV_sample <- set_names(dataCV_sample, purrr::map(filenames, name_of_files))
  all_cv_sample <- plyr::ldply(dataCV_sample)
  }else {
  all_cv_sample <- NULL
  }
  return(all_cv_sample)
})



dataCV_sample_best2_reactive <- reactive({
  if(input$lab_replicates>1) {
    dataCV_best2 <- data_CV_best2_reactive()
    filenames <- filenames_reactive()

    dataCV_sample_best2 <- purrr::map(.x=dataCV_best2, .f=cv_by_sample_estimation , cv_variable="best_CV_cat" ,
                                      lab_replicates=input$lab_replicates)
    dataCV_sample_best2 <- set_names(dataCV_sample_best2, purrr::map(filenames, name_of_files))
    all_cv_sample_best2 <- plyr::ldply(dataCV_sample_best2)
  }else {
    all_cv_sample_best2 <- NULL
  }
  return(all_cv_sample_best2)
})


output$cv_violin_plot <- renderPlot({
  all_cv_sample <- dataCV_all_sample_reactive()
  cv_cut_off <- input$cv_value

  if(input$chip_path_param!="") {
    if(!is.null(all_cv_sample) & !plyr::empty(all_cv_sample)){
      ## plot only the CV perccentages
      less_20 <- rlang::sym(paste0("CV <= ",cv_cut_off, "_perc"))
      gt_20 <- rlang::sym(paste0("CV > ",cv_cut_off, "_perc"))

      less_20_per <-  rlang::sym(paste0("% CV <=",cv_cut_off))
      gt_20_per <-  rlang::sym(paste0("% CV >",cv_cut_off))

      p <- ggplot(all_cv_sample)+
        geom_violin(aes_string(".id",less_20,color=shQuote(less_20_per))) +
        geom_violin(aes_string('.id',gt_20, color=shQuote(gt_20_per))) +
        geom_violin(aes(.id,Others_perc,color="Others")) +
        ylab("% of CV") +
        theme_light() +
        ggtitle(paste0("% of CV >", input$cv_value ,"or <=",input$cv_value," for each sample all repeats considered"))


    }else if(plyr::empty(all_cv_sample)){
      p <- empty_plot_no_rep()

    }else{
      p <- empty_plot_error()

    }
  }else{
    p <- empty_plot()

  }
  return(p)
})


output$cv_violin_plot_best2 <- renderPlot({
  all_cv_sample_best2 <- dataCV_sample_best2_reactive()

  cv_cut_off <- input$cv_value

  if(input$chip_path_param!="") {
    if(!is.null(all_cv_sample_best2) & !plyr::empty(all_cv_sample_best2)){
      ## plot only the CV perccentages
      if('Others_perc' %ni% names(all_cv_sample_best2)){
        all_cv_sample_best2['Others_perc'] <- 0
        all_cv_sample_best2['Others_n'] <- 0
      }
      less_20 <- rlang::sym(paste0("CV <= ",cv_cut_off, "_perc"))
      gt_20 <- rlang::sym(paste0("CV > ",cv_cut_off, "_perc"))

      less_20_per <-  rlang::sym(paste0("% CV <=",cv_cut_off))
      gt_20_per <-  rlang::sym(paste0("% CV >",cv_cut_off))
      p <- ggplot(all_cv_sample_best2)+
        geom_violin(aes_string(".id",less_20,color=shQuote(less_20_per))) +
        geom_violin(aes_string('.id',gt_20, color=shQuote(gt_20_per))) +
        geom_violin(aes(.id,Others_perc,color="Others")) +
        ylab("% of CV") +
        theme_minimal() +
        ggtitle(paste0("% of CV >", input$cv_value ,"or <=",input$cv_value," for each sample all repeats considered"))
      p

    }else if(plyr::empty(all_cv_sample_best2)){
      p <- empty_plot_no_rep()
      p
    }else{
      p <- empty_plot_error()
      p
    }
  }else{
    p <- empty_plot()
    p
  }

})



# table of a sample dataset of the file
output$sample_best2_reactive_tbl <-  DT::renderDT({
  dataCV_sample_best2 <- dataCV_sample_best2_reactive()
 if(!rlang::is_empty(sel_path) ){#input$folderChoose!=""

   all_vars <- names(dataCV_sample_best2)
   percs <- all_vars[grepl("perc",all_vars)]

   divide_100 <- function(x, na.rm = FALSE) (x/100)
   dataCV_sample_best2 <- dataCV_sample_best2 %>% mutate_at(percs,divide_100 )

   sample_best2_df <-  datatable(dataCV_sample_best2)  %>%
     formatPercentage( columns = percs, 2) %>%
     formatStyle(
       columns = percs,
       background = styleColorBar(0:1, 'red'),
       backgroundSize = '100% 90%',
       backgroundRepeat = 'no-repeat',
       backgroundPosition = 'center'
     )
    sample_best2_df
 }else {
   sample_best2_df <- data.frame()
  }

})
#'@_______________End_CV_calculation____________________________________



#' @________________________________subtract_the_tag_values_______________________________________

output$tag_subtract_select <- renderUI({
  #materialSwitch(inputId = "tag_subtract_btn", label = "Tag", status = "danger")
  # switchInput(
  #   inputId = "tag_subtract_btn",
  #   value = FALSE,
  #   size = "mini",
  #   #label = "Purification TAGS",
  #   onLabel = "TAG",
  #   offLabel = "No TAG",
  #   onStatus = "success",
  #   offStatus = "danger",
  #   #labelWidth = "100px",
  #   width='auto'
  # )

  materialSwitch(inputId = "tag_subtract_btn",
                 label = "Select if purification TAG(s) was used",
                 right = TRUE,
                 value = FALSE,
                 status = "success"
                 )


})



output$tag_file_load <- renderUI({
  if(input$tag_subtract_btn==TRUE){
    fileInput("tag_file", "Choose CSV File with tag antigens",
              buttonLabel = "Browse...",
              accept = c(
                "text/csv",
                "text/comma-separated-values,text/plain",
                ".csv"))
  }else {
    warning("No purification TAGs used")
  }

 # shinyFileChoose(input, 'tag_file', defaultRoot = 'wd',
 #                   filetypes = c('csv', "txt"))
})


tag_file_reactive <- reactive({
  # input$file1 will be NULL initially. After the user selects
  # and uploads a file, it will be a data frame with 'name',
  # 'size', 'type', and 'datapath' columns. The 'datapath'
  # column will contain the local filenames where the data can
  # be found.
  inFile <- input$tag_file

  if (is.null(inFile))
    return(NULL)
  df_tag <- read_csv(inFile$datapath)
  return(df_tag)
})





output$tag_antigens_select <- renderUI({
  tag_file <- tag_file_reactive()
 if(!is.null(tag_file)) {
   params_df <- params_display()
   antigens <-   params_df$antigen_list

   if('TAG_name' %in% names(tag_file)){
     list_tag <- antigens[antigens %in% unique(tag_file$TAG_name)]
   }else{
     list_tag <- ""
   }
   antigen_list  <- list('Antigens'=antigens)
    selectInput(inputId="tag_antigens",
                  label="Select the TAG antigens:",
                  choices= antigen_list,
                  selected = list_tag ,
                  multiple = TRUE)
    }
})

output$sample_ID_select <- renderUI({
  if(input$chip_path_param!="") {

    tag_data <- tag_data_reactive()
     sample_list <- unique(tag_data$sampleID)
    sample_list  <- list('Antigens'=sample_list)
    selectInput(inputId="sample_tag",
                label="Choose a sample to compare TAG values:",
                choices= sample_list,
                # selected = "" ,
                multiple = FALSE)
  }
})


output$tag_antigen_radio_select <- renderUI({
  tag_antigens <- input$tag_antigens
  awesomeRadio("tag_antigen_radio",
               label = 'Select the antigen to visualize:',
               choices =  tag_antigens,
             selected = tag_antigens[[1]],
               inline=TRUE)

})




## tag subtracted data
dataCV_tag_reactive <- reactive({
  inFile <- input$tag_file
  if(input$chip_path_param!="" & !is.null(inFile) & input$tag_subtract_btn==TRUE ) {
    dataCV_best2 <- data_CV_best2_reactive()
    filenames <- filenames_reactive()
    tag_antigens <- input$tag_antigens
    tag_file <- tag_file_reactive()
    genepix_vars <- genepix_vars()
    batch_vars <- list(machine= genepix_vars$machine,
                       day =genepix_vars$date_process)


  dataCV_tag <- purrr::map(.x=dataCV_best2, .f=tag_subtract ,
                         tag_antigens=tag_antigens,
                         mean_best_CV_var="mean_best_CV",
                         tag_file=tag_file,
                         batch_vars=batch_vars)

  dataCV_tag <- set_names(dataCV_tag, purrr::map(filenames, name_of_files))
  dataCV_tag <- plyr::ldply(dataCV_tag)



  }else if(input$chip_path_param!="" & is.null(inFile) & input$tag_subtract_btn==FALSE) {
    dataCV_best2 <- data_CV_best2_reactive()
    filenames <- filenames_reactive()

    genepix_vars <- genepix_vars()
    batch_vars <- list(machine= genepix_vars$machine,
                       day =genepix_vars$date_process)
    dataCV_best2 <- set_names(dataCV_best2, purrr::map(filenames, name_of_files))
    dataCV_tag <- plyr::ldply(dataCV_best2)

    dataCV_tag <- dataCV_tag %>% ungroup() %>%
      dplyr::select(sampleID ,sample_array_ID, antigen , everything()) %>%
      mutate(mean_best_CV_tag=mean_best_CV,TAG_mfi=0,TAG=NA,TAG_name='') %>%
      mutate(machine=batch_vars[["machine"]] , day=batch_vars[["day"]])
  }else{
    dataCV_tag <- NULL
  }
  return(dataCV_tag)
})



dataCV_tag_specific_reactive <- reactive({
  dataCV_tag <- dataCV_tag_reactive()
  if(!is.null(dataCV_tag)){

    df <- dataCV_tag %>%
      filter(TAG_name==input$tag_antigen_radio)
  }else{
    df <- NULL
  }
 return(df)
})



output$antigen_tag_specific_select <- renderUI({
  df_tag_specific <- dataCV_tag_specific_reactive()
  antigens <- unique(df_tag_specific$antigen)
  antigen_list  <- list('Antigens'=antigens)
  pickerInput(inputId="tag_specific_antigens",
              label="Choose the TAG antigens to visualize:",
              choices= antigen_list,
              options = list(
                `actions-box` = TRUE,
                size = 10,
                `selected-text-format` = "count > 3"
              ),
              selected = paste(antigens),
              multiple = TRUE)
})



tag_data_reactive <- reactive({
  dataCV_tag <- dataCV_tag_reactive()
  if(!is.null(dataCV_tag)){
   tag_antigens <- input$tag_antigens
    tag_data_wide <- dataCV_tag %>%
      filter(antigen==tag_antigens[[2]])
    tag_data_wide <- tag_data_wide %>%
      select(.id, sampleID,tag_antigens) %>%
      gather(tag_antigen, MFI, -c(.id, sampleID))
  }else{
    tag_data_wide <- NULL
  }
  return(tag_data_wide)
})


### create a table and download the dataCV corrected data
## display the data
# table of a sample dataset of the file
output$tbl_data_cv<-  DT::renderDT({
  folder_choose <- parseDirPath(c(home = wd_this) ,input$folderChoose)
  if(!rlang::is_empty(sel_path)){#input$folderChoose!=""){
    dataCV_tag <- dataCV_tag_reactive()
    dataCV_tag <- dataCV_tag %>% mutate_if(is.numeric, ~round(., 3))

    write_csv(dataCV_tag, paste("processed_data/data_CV-", Sys.Date(), ".csv", sep=""))

    df <- DT::datatable(dataCV_tag)


  }
  #options = list(lengthChange = FALSE,
  #  initComplete = JS('function(setting, json) { alert("done"); }'))
  return(df)
}, filter = 'top')

## download all data
output$download_dataCV <- downloadHandler(
  filename = function() {
    paste("raw_data-", Sys.Date(), ".csv", sep="")
  },
  content = function(file) {
    dataCV_tag <- dataCV_tag_reactive()

    write_csv(dataCV_tag, file)
  }
)



output$tag_box <- renderPlot({
  tag_data <- tag_data_reactive()
  if(input$chip_path_param!="") {
    if(!is.null(tag_data)){
    p <- ggplot(tag_data, aes(tag_antigen,MFI)) +
        geom_violin(alpha=0.3) +
        geom_boxplot(width = 0.2) +
        geom_jitter(aes(color=.id),
                    position = position_jitter(width = .15, height=-0.7),
                    size=2)+
        theme_light()
    p

    }else{
      p <- empty_plot_error()
      p
    }
  }else{
    p <- empty_plot()
    p
  }
})

output$tag_box_sample <- renderPlot({
  tag_data <- tag_data_reactive()
  if(input$chip_path_param!="") {

    if(!is.null(tag_data)){
      tag_data <- tag_data %>%
        filter(sampleID %in% input$sample_tag)
      p <- ggplot(tag_data, aes(tag_antigen,MFI)) +
        geom_violin(alpha=0.3) +
        geom_boxplot(width = 0.2) +
        geom_jitter(aes(color=.id),
                    position = position_jitter(width = .15, height=-0.7),
                    size=2)+
        theme_light()
      p

    }else{
      p <- empty_plot_error()
      p
    }
  }else{
    p <- empty_plot()
    p
  }
})



output$tag_antigens_box  <- renderPlot({
  dataCV_tag_specific <- dataCV_tag_specific_reactive()
  if(!is.null(input$tag_specific_antigens)){
    df_plot <- dataCV_tag_specific %>%
      dplyr::select(.id,sampleID,antigen,before_tag=mean_best_CV,after_tag=mean_best_CV_tag) %>%
      filter(antigen %in% input$tag_specific_antigens)
  }else{
    df_plot <- dataCV_tag_specific %>%
      dplyr::select(.id,sampleID,antigen,before_tag=mean_best_CV,after_tag=mean_best_CV_tag)
  }
  df_plot <- df_plot %>%
    gather(measure,mfi,-c(.id:antigen))
  ggplot(df_plot,aes(as.factor(antigen),mfi,color=measure))  +
    geom_boxplot(aes(fill=measure),alpha=0.5)+
    theme_light() +
     xlab("antigen name")+
    ggtitle("Before and after TAG subtraction") +
    theme(axis.text.x = element_text(angle = 45, hjust = 1))
})

## info boxes to show the selected paramaeter
output$bg_correct_infobox <- output$bg_correct_infobox2 <- renderInfoBox({
  if(is.null(input$bg_correct)){
    infoBox("Select the background correct approach",
            subtitle = paste0("") ,
            # icon = shiny::icon("user-md"),
            icon = icon("exclamation-triangle"),
            color = "red",width = 4,fill = FALSE)
  }else{
    bg_correct_approaches <- c("None"="none",
                               "Local bakground subtraction"="subtract_local",
                               "Global background subtraction"="subtract_global",
                               "Moving mininimum"="movingmin_bg",
                               "Half Moving mininimum"="minimum_half",
                               "Log-linear background correction"="edwards",
                               "Normal Exponential (normexp)"="normexp")
    bg_app <- names(which(bg_correct_approaches == input$bg_correct))
    infoBox("Background correction",bg_app ,
            subtitle = paste0("") ,
            icon = shiny::icon("layer-group"),
            color = "aqua",width = 4,fill = FALSE)
  }

})


output$tag_infobox <- output$tag_infobox2 <- renderInfoBox({
  if(is.null(input$tag_antigens)){
    infoBox("Select the TAG antigens",
            subtitle = paste0("") ,
            # icon = shiny::icon("user-md"),
            icon = icon("exclamation-triangle"),
            color = "red",width = 4,fill = FALSE)
  }else{
    antigens <- paste(input$tag_antigens,collapse=" ,")
    infoBox("TAG antigens",antigens ,
            subtitle = '' ,
            icon = shiny::icon("tag"),
            color = "aqua",width = 4,fill = FALSE)
  }

})


output$cv_infobox <- output$cv_infobox2 <- renderInfoBox({
  if(is.null(input$cv_value)){
    infoBox("Select the CV cutoff",
            subtitle = paste0("") ,
            # icon = shiny::icon("user-md"),
            icon = icon("exclamation-triangle"),
            color = "red",width = 4,fill = FALSE)
  }else{
    infoBox("Selected CV cutoff",paste(input$cv_value,"% with") ,
            subtitle = paste0(input$lab_replicates," lab replicates") ,
            icon = shiny::icon("cut"),
            color = "aqua",width = 4,fill = FALSE)
  }

})

### hide the menu item for TAG visuals
### hide the menu item for TAG visuals
output$tag_plots <- renderMenu({
  req(input$tag_subtract_btn)
  if(input$tag_subtract_btn == TRUE)

    menuItem("Tag subtract", tabName = "tag_plots", icon = icon("bell")#,
             #menuSubItem("No option",tabName="RO_00"),
             #menuSubItem("Option 1",tabName="RO_01")
    )
})







#'
#'
#'@________________________________end_subtract_the_tag_values_______________________________________
#'
#'
#'@________________________________Normalisation_______________________________________
observe({ # called only once at app initialisation
  updateTabItems(session, "norm_tabs", "normalisation")
})


output$normalisation_select <- renderUI({
  normalisation_approaches <- c("Log2 Normalisation"="log2",
                                "VSN"="vsn",
                                "Cyclic Loess"="cyclic_loess",
                                "Cyclic Loess (log)"="cyclic_loess_log",
                                "RLM Normalisation"="rlm")
  selectInput(inputId = 'normalisation_method',
              label = 'Select normalisation method',
              selected = 'log2',
              choices = normalisation_approaches)
})

## select the control antigens to use with RLM
output$rlm_antigens_select <- renderUI({
  params_df <- params_display()
  antigens <-   params_df$antigen_list
  antigen_list  <- list('Antigens'=antigens)
  if(input$normalisation_method=="rlm") {
    selectInput(inputId="rlm_antigens",
                label="Choose the RLM antigens:",
                choices= antigen_list,
                multiple = TRUE)
  }
})


output$normalisation_infobox <- renderInfoBox({
  if(is.null(input$normalisation_method)){
    infoBox("Select the normalisation method",
            subtitle = paste0("") ,
            # icon = shiny::icon("user-md"),
            icon = icon("exclamation-triangle"),
            color = "red",width = 4,fill = FALSE)
  }else{
    normalisation_approaches <- c("Log2 Normalisation"="log2",
                                  "VSN"="vsn",
                                  "Cyclic Loess"="cyclic_loess",
                                  "Cyclic Loess (log)"="cyclic_loess_log",
                                  "RLM Normalisation"="rlm")
    normal_app <- names(which(normalisation_approaches == input$normalisation_method))
    infoBox("Normalisation approach",paste(normal_app) ,
            subtitle = "" ,
            icon = shiny::icon("cut"),
            color = "aqua",width = 4,fill = FALSE)
  }

})


## normalisation function
to_normalise_reactive <- reactive({
  dataCV_tag <- dataCV_tag_reactive()
  if(!is.null(dataCV_tag)){
    batch_vars_name <- c("machine","day")
    df_to_normalise <-  dataCV_tag  %>%
      ungroup() %>%
      select(slide=.id,sampleID,sample_array_ID,antigen,batch_vars_name,mean_best_CV) %>%
      group_by(sampleID,machine, slide)

    df_to_normalise$sample_index <- group_indices(.data =df_to_normalise )

    ###
    to_normalise <- df_to_normalise %>%
      ungroup() %>% select(-slide,-sampleID,-sample_array_ID) %>%
      select(antigen, machine,day,sample_index, everything()) %>%
      gather(variable, value, -(antigen:sample_index)) %>%
      unite(temp, antigen ) %>%
      select(-variable) %>%
      spread(temp, value)

    row.names(to_normalise) <- to_normalise$sample_index
  }else {
    to_normalise <- NULL
  }
  return(to_normalise)
})

array_matrix_reactive <- reactive({
  dataCV_tag <- dataCV_tag_reactive()
  if(!is.null(dataCV_tag) & !is.null(input$rlm_antigens)){
    batch_vars_name <- c("machine","day")
    df_to_normalise <-  dataCV_tag  %>%
      ungroup() %>%
      dplyr::select(slide=.id,sampleID,sample_array_ID,antigen,batch_vars_name,mean_best_CV) %>%
      group_by(sampleID,machine, slide)

    df_to_normalise$sample_index <- group_indices(.data =df_to_normalise )

    array_matrix <- df_to_normalise %>%
      filter(antigen==input$rlm_antigens[[1]]) %>%
      ungroup() %>%
      select(sample_array_ID,sample_index,slide)
  }else{
    array_matrix <- NULL
  }
  return(array_matrix)
})

## returning non normalised data
non_normalised_list_reactive <- reactive({
  to_normalise <- to_normalise_reactive()
  params_df <- params_display()
  antigens <-   params_df$antigen_list
  antigens <- antigens[antigens %in% names(to_normalise)]
  if(!is.null(to_normalise)){
    matrix_antigen <-  to_normalise %>%
      select(antigens) %>%
      as.matrix(.)
    normalise_list <- matrix_normalise(matrix_antigen=matrix_antigen,
                                       method = "none",
                                       array_matrix=array_matrix,
                                       return_plot = TRUE,
                                       control_antigens=control_antigens)
  }else {
    normalise_list <- NULL
  }


  return(normalise_list)

})

antigens_norm_react <- reactive({
  dataCV_tag <- dataCV_tag_reactive()
  if(!is.null(dataCV_tag)){
    batch_vars_name <- c("machine","day")
    df_to_normalise <-  dataCV_tag  %>%
      ungroup() %>%
      select(slide=.id,sampleID,sample_array_ID,antigen,batch_vars_name,mean_best_CV) %>%
      group_by(sampleID,machine, slide)
    to_normalise_antigens <- c(df_to_normalise$antigen)
  }
  return(to_normalise_antigens)
})

## returning a list of the normalised data
normalised_list_reactive <- reactive({
  to_normalise <- to_normalise_reactive()

  params_df <- params_display()
  antigens <-   params_df$antigen_list
  control_antigens <- input$rlm_antigens
  ## check consistency of names
  #antigens <- antigens[antigens %like% names(to_normalise)]
  antigens <- antigens_norm_react()


  if(!is.null(to_normalise) & input$normalisation_method!="rlm"){
    matrix_antigen <-  to_normalise %>%
    ## check consistency of names
    select(antigens) %>%
      as.matrix(.)

    normalise_list <- matrix_normalise(matrix_antigen=matrix_antigen,
                                       method = input$normalisation_method,
                                       array_matrix=array_matrix,
                                       return_plot = TRUE,
                                       control_antigens=control_antigens)
  }else if(!is.null(to_normalise) & input$normalisation_method=="rlm"){
    array_matrix <- array_matrix_reactive()
    print(row.names(to_normalise))
    matrix_antigen <-  to_normalise %>%
    #  rownames_to_column(.data, var = "rowname") %>%
      ## check consistency of names
    select(antigens) %>%
      as.matrix(.)
  ## check why it looses row names above
  row.names(matrix_antigen) <- row.names(to_normalise)
    normalise_list <- matrix_normalise(matrix_antigen=matrix_antigen,
                                       method = input$normalisation_method,
                                       array_matrix=array_matrix,
                                       return_plot = TRUE,
                                       control_antigens=control_antigens)
  }else {
    normalise_list <- NULL
  }


  return(normalise_list)

})

output$normalised_sd_plot <- renderPlot({
  normalised_list <- normalised_list_reactive()
  if(input$chip_path_param!="") {
    if(!is.null(normalised_list)){
      p <- normalised_list$plot_normalisation
      p

    }else{
      p <- empty_plot_error()
      p
    }
  }else{
    p <- empty_plot()
    p
  }
})


output$normalisation_drop_down <- renderUI({
  dropdownButton(
    tags$h3("List of Normalisation"),
    checkboxInput("log2", "Log2 Normalisation", TRUE),
    checkboxInput("vsn", "VSN", TRUE),
    checkboxInput("cyclic_loess_log", "Cyclic Loess (log)", TRUE),
    checkboxInput("rlm", "RLM Normalisation",FALSE),
    checkboxInput("cyclic_loess", "Cyclic Loess", FALSE)
  )
})


normalised_list_all_reactive <- reactive({
  to_normalise <- to_normalise_reactive()
  params_df <- params_display()
  antigens <-   params_df$antigen_list
  control_antigens <- input$rlm_antigens
  array_matrix <- array_matrix_reactive()
  ## due to different structures
 # antigens <- antigens[antigens %in% names(to_normalise)]
  antigens <- antigens_norm_react()
  matrix_antigen <-  to_normalise %>%
    select(antigens) %>%
    as.matrix(.)

  ## no normalisation
  normalise_list_none <- matrix_normalise(matrix_antigen=matrix_antigen,
                                         method = "none",
                                         array_matrix=array_matrix,
                                         return_plot = TRUE,
                                         control_antigens=control_antigens)
  names(normalise_list_none) <- c("matrix_antigen_none" ,"plot_none")

  ## log normalisation
  if(input$log2==TRUE){
    normalise_list_log <- matrix_normalise(matrix_antigen=matrix_antigen,
                                           method = "log2",
                                           array_matrix=array_matrix,
                                           return_plot = TRUE,
                                           control_antigens=control_antigens)
    names(normalise_list_log) <- c("matrix_antigen_log" ,"plot_log")
  }else if(input$log2==FALSE){
    p <- empty_plot_NS() + ggtitle("Log normalisation")
    normalise_list_log <- list(plot_log=p, matrix_antigen_log=NULL)
  }


  if(input$vsn==TRUE){
    normalise_list_vsn <- matrix_normalise(matrix_antigen=matrix_antigen,
                                           method = "vsn",
                                           array_matrix=array_matrix,
                                           return_plot = TRUE,
                                           control_antigens=control_antigens)
    names(normalise_list_vsn) <- c("matrix_antigen_vsn" ,"plot_vsn")
  }else if(input$vsn==FALSE){
    p <- empty_plot_NS() + ggtitle("VSN normalisation")
    normalise_list_vsn <- list(plot_vsn=p, matrix_antigen_vsn=NULL)
  }


  if(input$cyclic_loess_log==TRUE){
    normalise_list_cyclic_loess_log <- matrix_normalise(matrix_antigen=matrix_antigen,
                                                        method = "cyclic_loess_log",
                                                        array_matrix=array_matrix,
                                                        return_plot = TRUE,
                                                        control_antigens=control_antigens)
    names(normalise_list_cyclic_loess_log) <- c("matrix_antigen_cyclic_loess_log" ,"plot_cyclic_loess_log")

  }else if(input$cyclic_loess_log==FALSE){
    p <- empty_plot_NS() + ggtitle("Cyclic Loess Log")
    normalise_list_cyclic_loess_log <- list(plot_cyclic_loess_log=p, matrix_antigen_cyclic_loess_log=NULL)
  }
  if(input$cyclic_loess==TRUE){
    normalise_list_cyclic_loess <- matrix_normalise(matrix_antigen=matrix_antigen,
                                                    method = "cyclic_loess",
                                                    array_matrix=array_matrix,
                                                    return_plot = TRUE,
                                                    control_antigens=control_antigens)
    names(normalise_list_cyclic_loess) <- c("matrix_antigen_cyclic_loess" ,"plot_cyclic_loess")

  }else if(input$cyclic_loess==FALSE){
    p <- empty_plot_NS() + ggtitle("Cyclic Loess")
    normalise_list_cyclic_loess <- list(plot_cyclic_loess=p, matrix_antigen_cyclic_loess=NULL)
  }


  if(input$rlm==TRUE){
    normalise_list_rlm <- matrix_normalise(matrix_antigen=matrix_antigen,
                                                  method = "rlm",
                                                  array_matrix=array_matrix,
                                                  return_plot = TRUE,
                                                  control_antigens=control_antigens)
    names(normalise_list_rlm) <- c("matrix_antigen_rlm" ,"plot_rlm")

  }else if(input$rlm==FALSE){
    p <- empty_plot_NS() + ggtitle("RLM")
    normalise_list_rlm <- list(plot_rlm=p, matrix_antigen_rlm=NULL)
  }

  normalise_list <- c(normalise_list_none , normalise_list_log,normalise_list_vsn,normalise_list_cyclic_loess_log,
                      normalise_list_cyclic_loess,normalise_list_rlm)
  return(normalise_list)

})


## plot showing all the normalisation techniques
output$mutiple_plot <- renderPlot({
  normalised_list <- normalised_list_all_reactive()
  normalised_list_plot <- normalised_list[grepl("plot",names(normalised_list))]

  p <- do.call("grid.arrange", c(normalised_list_plot, ncol=2))
  p
})



## output for heatmap
output$select_heatmap<- renderUI({
  heat_map_c <- c("Plot both before and after normalisation"=TRUE,
              "Plot only normalised data"=FALSE)
  prettyRadioButtons(inputId="heat_both",
                     label = 'Plot with log or raw MFI:',
                     choices =  heat_map_c,
                     inline=TRUE,
                     selected = FALSE,
                     animation = "jelly",
                     status = "default",
                     shape = "curve",bigger = TRUE)

})

## heatmap plot
output$heatmap_normalised_see <- renderPlot({

  p3 <- pheatmap::pheatmap(cars)
  p3 <-ggplotify::as.ggplot(p3)
  p3 <- p3 +  theme_void()
  return(p3)
})


output$heatmap_normalised <- renderPlot({
  normalised_list <- normalised_list_reactive()
  non_normalised_list_reactive <- non_normalised_list_reactive()
  control_antigens <- input$rlm_antigens
  norm_df <- normalised_list$matrix_antigen_normalised
  norm_df <- data.frame(apply(norm_df, 2, function(x){rescale(x, to =c(0,1))}))


  if(!is.null(normalised_list) & input$normalisation_method=="rlm"){
    norm_df <- normalised_list$matrix_antigen_normalised
    norm_df <- norm_df %>% select(-control_antigens)
    norm_df <- data.frame(apply(norm_df, 2, function(x){rescale(x, to =c(0,1))}))
    non_norm_df <- non_normalised_list_reactive$matrix_antigen_normalised
    non_norm_df <- non_norm_df %>%  select(-control_antigens)
    non_norm_df <- data.frame(apply(non_norm_df, 2, function(x){rescale(x, to =c(0,1))}))

  }else{
    norm_df <- normalised_list$matrix_antigen_normalised
    norm_df <- data.frame(apply(norm_df, 2, function(x){rescale(x, to =c(0,1))}))
    non_norm_df <- non_normalised_list_reactive$matrix_antigen_normalised
    non_norm_df <- data.frame(apply(non_norm_df, 2, function(x){rescale(x, to =c(0,1))}))
  }
  #test sections
  #print(paste(str(norm_df)))
  #print(paste(names(norm_df)))
  #print(paste(colSums(is.na(norm_df))))

  if(input$heat_both==TRUE){
    p_non_norm <- pheatmap::pheatmap(non_norm_df ,
                                     scale = "none",
                                     cluster_rows = FALSE ,
                                     main="Non normalised data",
                                     silent = TRUE)
    p_non_norm <- ggplotify::as.ggplot(p_non_norm)+ theme_void()
    p2 <- pheatmap::pheatmap(norm_df ,scale = "none", cluster_rows = FALSE ,
                             main=paste(input$normalisation_method,"Normalised Data"),
                             silent = TRUE)
    p2 <- ggplotify::as.ggplot(p2) + theme_void()
    #p <- gridExtra::grid.arrange(grobs = list(p2[[4]],p_non_norm[[4]]))
    p <- ggpubr::ggarrange(p_non_norm,p2, nrow = 2)

  }else{
    p3 <- pheatmap::pheatmap(norm_df ,scale = "none", cluster_rows = FALSE,
                            main=paste(input$normalisation_method,"Normalised Data"),
                            silent = TRUE)
    p3 <- ggplotify::as.ggplot(p3)
    p <- p3 +  theme_void()

  }

  return(p)

})


## output for heatmap
output$slider_pca<- renderUI({

  sliderInput(inputId = 'vars_pca', label = 'Select variables to plot on the PCA',
              value = 20,
              min = 10, max = 50)

})


## plot a PCA

output$PCA_normalised <- renderPlot({
  normalised_list <- normalised_list_reactive()
  non_normalised_list_reactive <- non_normalised_list_reactive()
  control_antigens <- input$rlm_antigens
  norm_df <- normalised_list$matrix_antigen_normalised
  norm_df <- data.frame(apply(norm_df, 2, function(x){rescale(x, to =c(0,1))}))

  if(!is.null(input$vars_pca)){
    vars_visualise <- input$vars_pca
  }else{
    vars_visualise <- 20
  }

  if(!is.null(normalised_list) & input$normalisation_method=="rlm"){
    norm_df <- normalised_list$matrix_antigen_normalised
    norm_df <- norm_df %>% select(-control_antigens)
    norm_df <- data.frame(apply(norm_df, 2, function(x){rescale(x, to =c(0,1))}))
    non_norm_df <- non_normalised_list_reactive$matrix_antigen_normalised
    non_norm_df <- non_norm_df %>%  select(-control_antigens)
    non_norm_df <- data.frame(apply(non_norm_df, 2, function(x){rescale(x, to =c(0,1))}))

  }else{
    norm_df <- normalised_list$matrix_antigen_normalised
    norm_df <- data.frame(apply(norm_df, 2, function(x){rescale(x, to =c(0,1))}))
    non_norm_df <- non_normalised_list_reactive$matrix_antigen_normalised
    non_norm_df <- data.frame(apply(non_norm_df, 2, function(x){rescale(x, to =c(0,1))}))
  }

  ## compute PCA
  res_pca <- prcomp( norm_df, scale = TRUE)
  var <- get_pca_var(res_pca)

  #Visualize the PCA
  p1 <- fviz_pca_ind(res_pca,
                    col.var = "contrib", # Color by contributions to the PC
                    gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
                    repel = TRUE     # Avoid text overlapping
  )+    theme_minimal()

  #p2 <- fviz_cos2(res_pca, choice='var',axes=1:2)
  # Select the top vars_visualise contributing variables
  p2 <-fviz_pca_biplot(res_pca, label="var",
                    select.var = list(contrib = vars_visualise)) +
    theme_minimal()

  # Total cos2 of variables on Dim.1 and Dim.2
  p3 <-     fviz_cos2(res_pca, choice = "var", axes = 1:2 , top = vars_visualise)


  # Color by cos2 values: quality on the factor map
 p4 <-  fviz_pca_var(res_pca, col.var = "cos2",
               gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
               select.var = list(contrib = vars_visualise),
               repel = TRUE # Avoid text overlapping
  )

  p <- gridExtra::grid.arrange(p1,p2,p3,p4, ncol=2 )
  p
})


# function to hide or show or hide tabs with loading
observe({

  tag_file_reactive <- tag_file_reactive()

  req(input$tag_subtract_btn)
  if(is.null(tag_file_reactive) & input$tag_subtract_btn==TRUE){
  hideTab(inputId = "all_tabs", target = "normalise_panel")
  }else  if(input$tag_subtract_btn==FALSE & is.null(tag_file_reactive)){
    showTab(inputId = "all_tabs", target = "normalise_panel")
  }else{
    showTab(inputId = "all_tabs", target = "normalise_panel")
  }
})


#if(input$chip_path_param==""){hideTab(inputId = 'all_tabs',target ='normalise_panel') }

# ### hide tabs
# observe({
#  # hide(selector = "#navbar li a[data-value=normalise_panel]")
#   if(input$chip_path_param==""){hideTab(inputId = 'all_tabs',target ='normalise_panel') }
# })
#
# observeEvent(input$variableXX=='am', {
#   toggle(selector = "#navbar li a[data-value=normalise_panel]")
# })

# output$trial <- renderPlotly({
#   if(input$chip_path_param!="") {
#     ## load the default parameted
#     p <- ggplot(cars,aes(speed,dist)) +geom_jitter()
#     p <- ggplotly(p)
#     p
#
#   }else{
#     p <- empty_plot()
#     p <- ggplotly(p)
#     p
#   }
#
# })
#
#
output$trial2 <- renderPrint({
  print(paste(str(input$tag_antigens), "seeeee", dataCV_tag_reactive()))
})

})
Keniajin/protGear documentation built on Feb. 6, 2023, 6:28 p.m.