Jarvis:

options(expressions = 5e5,shiny.maxRequestSize = 2000*1024^3)

shinyServer(function(input, output, session){
  session$onSessionEnded(stopApp)
  ###### GLOBAL #######
  getParams <- reactive({
    if(is.null(values$flow.frames)) return(NULL)
    data <- as.matrix(pData(values$flow.frames[[1]]@parameters),stringsAsFactors = F)
    labels <- data[,2]
    params <- data[,1]
    labels[which(is.na(labels))] <- colnames(values$flow.frames[[1]])[c(which(is.na(labels)))]
    labels[which(labels=="<NA>")] <- colnames(values$flow.frames[[1]])[c(which(labels=="<NA>"))]
    names(params) <- labels
    values$params <- params
  })

  cleanReactiveValues <- reactive({
    for(i in names(values)){
      values[[i]] <- NULL
    }
    values$log <- "Historique"
  })

  values <- reactiveValues(
    flow.frames = NULL,
    names.flow.frames = NULL,
    params = NULL,
    info = NULL,
    flow.frames.validate = NULL,
    reduc.dim = NULL,
    cluster = NULL,
    log = "Historique"
  )

  ###### UPLOAD DATA ######
  output$save <- downloadHandler(
    filename = function(){"save.jarvis"},
    content = function(filename){
      list <- reactiveValuesToList(values)
      save(list="list",file=filename)
    }
  )

  observeEvent(input$jarvis_load,{
    cleanReactiveValues()
    load(input$jarvis_load$datapath)
    for(i in c(1:length(list))){
      values[[names(list[i])]] <- list[[i]]
    }
  })

  output$ex_out <- renderPrint({
    print(values$log)
  })

  observeEvent(input$fcs,{
    cleanReactiveValues()
    progress <- Progress$new()
    progress$set(message = "Read Upload file", value = 0)
    flow.frames <- lapply(c(1:length(input$fcs$datapath)), function(i) {
      progress$set(detail = paste0(i,"/",length(input$fcs$datapath)), value=i/length(input$fcs$datapath))
      if(length(grep(".fcs$",basename(input$fcs$datapath[i])))>0){
        fcs <- read.FCS.CIPHE(input$fcs$datapath[i])
        if(is.null(fcs)){
          showNotification(ui="FCS Corrupted can't be open !!", type = "error")
        } else {
          fcs@exprs[which(is.na(fcs@exprs))] <- 0
        }
        return(fcs)
      } else {
        return(NULL)
      }
    })
    if(is.null(flow.frames[[1]])){
      values$flow.frames <- NULL
      showNotification(ui="FCS Corrupted or bad format and can't be open !!", type = "error")
    } else {
      values$flow.frames <- flow.frames
      names(values$flow.frames) <- as.vector(input$fcs$name)
      values$names.flow.frames <- as.vector(input$fcs$name)
      #values$sample.plot <- values$flow.frames[[1]][1:5000,]
      values$log <- rbind(values$log,"Upload")
      getParams()
    }
    shinyjs::disable("fcs")
    shinyjs::disable("jarvis_load")
    progress$close()
    Events <- unlist(lapply(values$flow.frames,function(i){return(dim(i)[1])}))
    Parameters <- unlist(lapply(values$flow.frames,function(i){return(dim(i)[2])}))
    Compensation <- lapply(values$flow.frames,function(i){return(foundSpillCIPHE(i))})

    info <- lapply(c(1:length(Compensation)), function(i){return(unlist(c(Compensation[[i]],Parameters[[i]])))})

    values$flow.frames.validate <- TRUE
    mat <- do.call(cbind,info)
    if(length(unique(mat[1,]))>1){
      values$flow.frames.validate <- FALSE
      showNotification(ui="Erreur dans la présence de matrice de compensation",type="error",duration=10)
    }
    if(length(unique(mat[2,]))>1){
      values$flow.frames.validate <- FALSE
      showNotification(ui="Erreur des dimension de la matrice de compensation",type="error",duration=10)
    }
    if(length(unique(mat[3,]))>1){
      values$flow.frames.validate <- FALSE
      showNotification(ui="Erreur dans le nombre de marqueurs entre vos fichier",type="error",duration=10)
    }
    values$info <- info
    names(values$info) <- names(values$flow.frames)
  })

  observe({
    if(is.null(values$flow.frames)) return(NULL)
    Events <- unlist(lapply(values$flow.frames,function(i){return(dim(i)[1])}))
    Parameters <- unlist(lapply(values$flow.frames,function(i){return(dim(i)[2])}))
    Compensation <- lapply(values$flow.frames,function(i){return(foundSpillCIPHE(i))})
    info <- lapply(c(1:length(Compensation)), function(i){return(unlist(c(Compensation[[i]],Parameters[[i]])))})
    table <- data.frame(
      Names = values$names.flow.frames,
      Events = Events,
      Parameters = Parameters
    )
    output$summaryTable <- DT::renderDataTable({
      table <- cbind(table, do.call(rbind, Compensation))
      colnames(table)[c(4,5)] <- c("Spill Keyword","Spill Dimension")
      DT::datatable(table,options = list(orderClasses = TRUE,
                                         lengthMenu = FALSE,pageLength = 100,searching = FALSE
      ),selection='none',escape=F,rownames = FALSE)
    })
  })

  observeEvent(input$refresh_input,{
    shinyjs::enable("fcs")
    shinyjs::enable("jarvis_load")
    cleanReactiveValues()
    showNotification(ui="Jarvis rafraichie",type = "message")
  })

  output$files_validate <- reactive({
    if(is.null(values$flow.frames.validate))return(FALSE)
    return(values$flow.frames.validate)
  })
  outputOptions(output,"files_validate",suspendWhenHidden = FALSE)

  ###### AUTO PREPROCESS ######
  observe({ ## Autocomplete preprocssing layout
    if(is.null(values$info))return(NULL)
    selected <- NULL
    if(values$info[[1]][1]!="NULL"){
      selected <- values$params[which(values$params%in%colnames(values$flow.frames[[1]]@description[["SPILL"]]))]
      updateSelectInput(session,"trans_method",selected="logicle")
      updateSelectInput(session,"comp_key",selected=values$info[[1]][1],choices=c("none",names(values$flow.frames[[1]]@description)))
      selected2 <- pData(values$flow.frames[[1]]@parameters)[which(!is.na(pData(values$flow.frames[[1]]@parameters)[,2])),1]
    } else {
      updateSelectInput(session,"trans_method",selected="arcsinh")
      updateNumericInput(session,"trans_arg",value=5)
      selected <- values$params
      selected2 <- values$params
    }
    updateSelectInput(session,"trans_marker",choices=values$params,selected=selected)
    updateSelectInput(session,"norm_markers",choices=values$params,selected=selected2)
  })

  observeEvent(input$compenser,{
    if(is.null(values$flow.frames)) return(NULL)
    progress <- Progress$new()
    flow.frames <- values$flow.frames
    if(input$comp_key!="none"){
      flow.frames <- lapply(c(1:length(flow.frames)), function(i){
        progress$set(message="Compensation",detail=paste0(i,"/",length(flow.frames)),value=i/length(flow.frames))
        return(compensate(flow.frames[[i]],flow.frames[[i]]@description[[input$comp_key]]))
      })
    }
    values$flow.frames <- flow.frames
    values$log <- rbind(values$log,"Compenser")
    progress$close()
  })

  observeEvent(input$transformer,{
    if(is.null(values$flow.frames)) return(NULL)
    progress <- Progress$new()
    flow.frames <- values$flow.frames
    if(input$trans_method!="none"){
      flow.frames <- lapply(c(1:length(flow.frames)), function(i){
        progress$set(message="Transformation",detail=paste0(i,"/",length(flow.frames)),value=i/length(flow.frames))
        if(input$trans_method=="arcsinh"){
          return(arcsinhTransCIPHE(flow.frames[[i]],marker = input$trans_marker,arg = input$trans_arg))
        }
        if(input$trans_method=="logicle"){
          return(logiclTransformCIPHE(flow.frames[[i]],marker=input$trans_marker,value=input$trans_arg))
        }
      })
    }
    values$flow.frames <- flow.frames
    values$log <- rbind(values$log,"Transformer")
    progress$close()
  })

  observeEvent(input$nettoyer,{
    if(is.null(values$flow.frames)) return(NULL)
    progress <- Progress$new()
    flow.frames <- values$flow.frames
    if(input$clean_method!="none"){
      flow.frames <- lapply(c(1:length(flow.frames)),function(i){
        progress$set(message="Cleanning",detail=paste0(i,"/",length(flow.frames)),value=i/length(flow.frames))
        return(flow_auto_qc(flow.frames[[i]],output = 3, html_report = FALSE,mini_report = FALSE, folder_results = FALSE))
      })
    }
    values$flow.frames <- flow.frames
    values$log <- rbind(values$log,"Nettoyer")
    progress$close()
  })

  observeEvent(input$normaliser,{
    if(is.null(values$flow.frames)) return(NULL)
    progress <- Progress$new()
    flow.frames <- values$flow.frames
    if(input$norm_methode!="none"){
      fs <- flowSet(flow.frames)
      progress$set(message="Normalize", value=0.5)
      fs <- gaussNorm(fs, input$norm_markers,max.lms=1)$flowset
      flow.frames <- lapply(c(1:length(fs)),function(i){return(fs[[i]])})
      progress$set(message="Normalize", value=1)
      output$norm_plot <- renderPlot({
        model <- as.formula(paste0("~",paste0("`",input$norm_markers,"`",collapse = "+")))
        p <- densityplot(model,fs,xlim=c(0,5))
        return(p)
      })
    }
    values$flow.frames <- flow.frames
    values$log <- rbind(values$log,"Normaliser")
    progress$close()
  })

  observeEvent(input$concatener,{
    if(is.null(values$flow.frames)) return(NULL)
    progress <- Progress$new()
    flow.frames <- values$flow.frames
    flow.frames <- concatenateCIPHE(flow.frames, params=input$concat_params)
    values$flow.frames <- list(flow.frames)
    values$log <- rbind(values$log,"Concatener")
    progress$close()
  })

  ###### MACHINE LEARNING ######
  output$cluster_markers <- renderUI({
    selectInput("cluster_markers","Markers",choices=values$params,multiple=TRUE,selected=values$params)
  })

  output$reduc_markers <- renderUI({
    selectInput("reduc_markers","Markers",choices=values$params,multiple=TRUE,selected=values$params)
  })

  observeEvent(input$cluster,{
    if(is.null(values$flow.frames))return(NULL)
    if(input$cluster_method == "K-means"){
      args <- list(input$kmeans_center)
    }
    if(input$cluster_method == "FlowSOM"){
      args <- list(input$xdim, input$ydim)
    }
    if(input$cluster_method == "CLARA"){
      args <- list(input$clara_centers, input$clara_samples)
    }
    progress <- Progress$new()
    values$cluster <- clusterFCSbyCIPHE(values$flow.frames, args=args,
          markers = input$cluster_markers, methodes=input$cluster_method)
    names(values$cluster) <- input$cluster_method
  })

  observeEvent(input$reduc_dim,{
    progress <- Progress$new()
    values$reduc.dim <- lapply(c(1:length(values$flow.frames)), function(i){
      progress$set(message="Reduction de dimension",detail=paste0(i,"/",length(values$flow.frames)),value=i/length(values$flow.frames))
      reduc.dim <- reducDimFCSbyCIPHE(values$flow.frames[[i]],args=NULL,methode="PCA",markers=input$reduc_markers)
      colnames(reduc.dim) <- paste0(input$reduc_method,c(1,2))
    })
    names(values$reduc.dim) <- values$names.flow.frames
    progress$close()
  })


  observe({
    if(is.null(values$flow.frames)) return(NULL)
    list <- c(1:length(values$flow.frames))
    names(list) <- values$names.flow.frames
    updateSelectInput(session,"select_file",choices=list)
    if(!is.null(values$reduc.dim)){
      choices <- c(values$params,colnames(values$reduc.dim))
    } else {
      choices <- values$params
    }
    if(!is.null(values$cluster)){
      choices_z <- c("Density",values$params,names(values$cluster))
    } else {
      choices_z <- c("Density",values$params)
    }
    updateSelectInput(session,"x_param",choices = choices)
    updateSelectInput(session,"y_param",choices = choices)
    updateSelectInput(session,"z_param",choices = choices_z,selected="Density")
  })

  observeEvent(input$filter,{
    output$filter_select <- renderUI({

    })
  })

  observeEvent(input$plot,{
    if(is.null(input$select_file)) return(NULL)
    if(input$x_param%in%colnames(values$flow.frames[[input$select_file]])){
      x <- values$flow.frames[[input$select_file]]@exprs[,input$x_param]
    } else {
      x <- values$reduc.dim[,input$x_param]
    }
    if(input$y_param%in%colnames(values$flow.frames[[input$select_file]])){
      y <- values$flow.frames[[input$select_file]]@exprs[,input$y_param]
    } else {
      y <- values$reduc.dim[,input$y_param]
    }
    if(input$z_param%in%colnames(values$flow.frames[[input$select_file]])){
      z <- values$flow.frames[[input$select_file]]@exprs[u,input$z_param]
    } else {
      z <- hist()
    }
    xmin <- round(min(x))-1;xmax <- round(max(x))+1;ymin <- round(min(y))-1;ymax <- round(max(y))+1
    updateSliderInput(session,"xlim",min=xmin,max=xmax,value=c(xmin,xmax))
    updateSliderInput(session,"ylim",min=ymin,max=ymax,value=c(ymin,ymax))

    output$plot_visualisation <- renderPlot({
      palette <- colorRampPalette(c(rgb(0,0,1,0.3),rgb(1,1,0,0.3),rgb(1,0,0,0.3)),alpha=TRUE)
      colors <- palette(20)[as.numeric(z,breaks=20)]
      plot(x,y,pch=".",cex=1.5,xlim=input$xlim,ylim=input$ylim,col=colors,main=values$names.flow.frames[input$select_file])
    },width=500,height = 500)
  })


  ###### ANNOTATION AUTO ######

})