inst/shinyApp/app/server.R

In qbarbier/CytoTron: Cytometry Perceptron annotation

library("CytoTron")
options(shiny.maxRequestSize = 1000000*1024^2)
shinyServer(function(input, output, session){
  set.seed(42)

  ####### Reactive ######
  values <- reactiveValues(
    data = NULL,
    data.names = NULL,
    data.params= NULL,
    data.trans.params = NULL,
    data.concat = NULL,
    data.clusters = NULL,
    data.reduc.dim = NULL,
    train = NULL,
    train.names = NULL,
    train.clusters = NULL,
    train.params = NULL,
    train.trans.params = NULL,
    train.ready = NULL,
    model = NULL,
    log = NULL,
    prediction.marker = NULL,
    prediction = NULL
  )
  ######################

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

  uploadData <- function(dataPaths){
    progress <- Progress$new()
    paths <- dataPaths$datapath
    progress$set(message = "Read Upload Data", value = 0)
    flow.frames <- lapply(c(1:length(paths)), function(i) {
      progress$set(detail = paste0(i,"/",length(paths)), value=i/length(paths))
      if(length(grep(".fcs$",basename(paths[i])))>0){
        fcs <- read.FCS(paths[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)
      }
    })
    progress$close()
    if(is.null(flow.frames[[1]])){
      return(NULL)
    } else {
      return(list(flow.frames,as.vector(basename(dataPaths$name))))
    }
  }

  preprocessData <- function(flow.frames,comp,spill,methode,arg,markers,
                             concat=TRUE,norm=FALSE,clean=FALSE){
    progress <- Progress$new()
    if(is.na(arg) || arg == ""){arg <- NULL}
    if(clean){
      flow.frames <- lapply(c(1:length(flow.frames)),function(i){
        progress$set(message="Clean",value=i/length(flow.frames),detail=paste0(i,"/",length(flow.frames)))
        fcs <- flow.frames[[i]]
        fcs <- clean.tails.FCS(fcs,markers)
      })
    }
    if(comp!=FALSE && !is.null(spill) && spill != "NULL" && length(spill)>1){
      progress$set(message="Compensation", value=0)
      flow.frames <- lapply(c(1:length(flow.frames)),function(i){
        progress$set(message="Compensation", value=i/length(flow.frames),detail=paste0(i,"/",length(flow.frames)))
        fcs <- flow.frames[[i]]
        return(compensate.FCS(fcs,spill))
      })
    }
    if(methode != "none"){
      progress$set(message="Transformation", value=0)
      flow.frames <- lapply(c(1:length(flow.frames)),function(i){
        progress$set(message="Transformation", value=i/length(flow.frames),detail=paste0(i,"/",length(flow.frames)))
        fcs <- flow.frames[[i]]
        if(methode=="arcsinh"){
          return(arcsinh.FCS(fcs, markers,arg))
        }
        if(methode=="logicle"){
          return(logicle.FCS(fcs, markers=markers))
        }
      })
    }
    if(concat){
      progress$set(message="Concatenation", value=0.5)
      fcs <- concatenate.FCS(flow.frames,params = "CytoTron")
      if(norm){
        progress$set(message="Normalize", value=0.9)
        fcs <- norm.percentile.FCS(fcs,markers = markers)
      }
      progress$close()
    } else {
      if(norm){
        progress$set(message="Normalize", value=0.9)
        fcs <- lapply(flow.frames, function(fcs){
          norm.percentile.FCS(fcs,markers = markers)
        })
      } else {
        fcs <- flow.frames
      }
      progress$close()
    }
    return(fcs)
  }

  unPreprocessData <- function(data, comp, spill, methode, arg, markers,
                               concat=TRUE,norm=FALSE, raw.data=NULL){
    #progress <- Progress$new()
    if(is.na(arg) || arg == ""){arg <- NULL}
    if(norm){
      progress$set(message="Un Normalize", values=0)
      data <- unNorm.percentile.FCS(data,markers = markers)
    }
    #progress$set(message="Deconcatenante",value=0)
    flow.frames <- lapply(sort(unique(data@exprs[, "CytoTron"])),function(i){
      fcs <- data[which(data@exprs[, "CytoTron"] == i),]})
    if(methode != "none"){
      #progress$set(message="Invers Transformation", value=0)
      flow.frames <- lapply(c(1:length(flow.frames)),function(i){
        #progress$set(message="Invers Transformation", value=i/length(flow.frames),detail=paste0(i,"/",length(flow.frames)))
        fcs <- flow.frames[[i]]
        if(methode=="arcsinh"){
          return(invers.arcsinh.FCS(fcs, markers,arg))
        }
        if(methode=="logicle"){
          return(invers.logicle.FCS(fcs, markers=markers))
        }
      })
    }
    if(comp!=FALSE){
      #progress$set(message="Compensation", value=0)
      flow.frames <- lapply(c(1:length(flow.frames)),function(i){
        #progress$set(message="Compensation", value=i/length(flow.frames),detail=paste0(i,"/",length(flow.frames)))
        fcs <- flow.frames[[i]]
        return(decompensate.FCS(fcs,raw.data[[i]]@description[[spill]]))
      })
    }
    return(flow.frames)

  }

  #reticulate::source_python("../../src/model.py")

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

  observeEvent(input$upload_all,{
    cleanReactiveValues()
    load(input$upload_all$datapath)
    progress <- Progress$new()
    progress$set(message="Chargement des données",value=0)
    for(i in names(values)){
      progress$set(detail=i,value=grep(i,names(values))/length(names(values)))
      values[[i]] <- list[[i]]
    }
    if(!is.null(values$model)){
      values$model$model <- unserialize_model(values$model$model)
      updateSelectInput(session,"model_markers",choices=values$train.params,selected=values$train.params[values$model$markers])
    }
    progress$close()
    rm("list")
  })

  output$save_all <- downloadHandler(
    filename = function(){return(paste0(Sys.Date(),"_CytoTron.Rdata"))},
    content = function(filename){
      list <- reactiveValuesToList(values)
      if(!is.null(values$model)){
        list$model$model <- serialize_model(list$model$model)
      }
      save(list="list",file=filename)
    }
  )

  observeEvent(input$data_upload,{
    res <- uploadData(input$data_upload)
    if(is.null(res)){
      return(NULL)
      showNotification(ui="Impossible d'ouvrir les FCS data", type = "error")
    }
    showNotification(ui="Chargement des FCS data terminé",type="message")
    values$data <- res[[1]]
    values$data.names <- res[[2]]
    values$data.params <- getParamsCytoTron(values$data[[1]])
    values$log <- rbind(values$log,"Data Uploaded")
  })

  observe({
    if(is.null(values$data)||is.null(values$data.names)||is.null(values$data.params))return(NULL)
    selected <- NULL
    trans_meth <- "none"
    comp <- TRUE
    clean <- TRUE
    if(found.spill.FCS(values$data[[1]])[1]!="NULL"){
      selected <- values$data.params[which(values$data.params%in%colnames(values$data[[1]]@description[[found.spill.FCS(values$data[[1]])[1]]]))]
      trans_meth <- "logicle"
    } else {
      selected <- values$data.params
      trans_meth <- "arcsinh"
      comp <- FALSE
      clean <- FALSE
    }
    if(!is.null(values$data.trans.params)){
      selected <- values$data.trans.params
    }

    output$summary_data <- renderPrint({
      return(summary(values$data[[1]]@exprs[,selected]))
    })

    updateCheckboxInput(session,"compensation", value=comp)
    updateSelectInput(session,"trans_methd",selected=trans_meth)
    updateSelectInput(session,"markers",choices=values$data.params,selected=selected)
    updateSelectInput(session,"comp_keywords",choices=names(values$data[[1]]@description),selected=found.spill.FCS(values$data[[1]])[1])
    updateSelectInput(session,"data_markers",choices=values$data.params,selected=selected)
    #updateCheckboxInput(session,"clean",value=clean)
  })

  observeEvent(input$train_upload,{
    res <- uploadData(input$train_upload)
    if(is.null(res)){
      return(NULL)
      showNotification(ui="Impossible d'ouvrir les FCS train", type = "error")
    }
    showNotification(ui="Chargement des FCS train terminé",type="message")
    values$train <- res[[1]]
    values$train.names <- res[[2]]

    values$train.params <- getParamsCytoTron(values$train[[1]])
    values$log <- rbind(values$log,"Train Uploaded")
  })

  observe({
    if(is.null(values$train)||is.null(values$train.names)||is.null(values$train.params))return(NULL)
    selected <- NULL
    trans_meth <- "none"
    comp <- TRUE
    clean <- TRUE
    if(found.spill.FCS(values$train[[1]])[[1]]!="NULL"){
      selected <- values$train.params[which(values$train.params%in%colnames(values$train[[1]]@description[[found.spill.FCS(values$train[[1]])[1]]]))]
      trans_meth <- "logicle"
    } else {
      selected <- values$train.params
      trans_meth <- "arcsinh"
      comp <- FALSE
      clean <- FALSE
    }
    if(!is.null(values$train.trans.params)){
      selected <- values$train.trans.params
    }

    output$summary_train <- renderPrint({
      return(summary(values$train[[1]]@exprs[,selected]))
    })

    updateCheckboxInput(session,"compensation2", value=comp)
    #updateCheckboxInput(session,"clean2",value=clean)
    updateSelectInput(session,"trans_methd2",selected=trans_meth)
    updateSelectInput(session,"markers2",choices=values$train.params,selected=selected)
    updateSelectInput(session,"comp_keywords2",choices=names(values$train[[1]]@description),selected=found.spill.FCS(values$train[[1]])[1])
    if(is.null(values$model)){updateSelectInput(session,"model_markers",choices=values$train.params,selected=selected)}
  })

  observeEvent(input$preprocess,{
    if(is.null(values$data)) return(NULL)
    flow.frames <- values$data
    values$data.concat <- preprocessData(flow.frames,input$compensation,
      input$comp_keywords,input$trans_methd,input$trans_args,input$markers,
      concat=TRUE,norm=FALSE,clean=FALSE)
    if(is.null(values$data.concat)){
      showNotification(ui="Erreur lors du Preprocessing",type="error")
    } else {
      showNotification(ui="Preprocessing terminé",type="message")
    }
    values$data.trans.params <- input$markers
    values$log <- rbind(values$log,"Data Preprocess")
  })

  observeEvent(input$preprocess2,{
    if(is.null(values$train)) return(NULL)
    flow.frames <- values$train
    values$train.ready <- preprocessData(flow.frames,input$compensation2,
      input$comp_keywords2,input$trans_methd2,input$trans_args2,input$markers2,
      concat=FALSE,norm=FALSE,clean=FALSE)
    if(is.null(values$train.ready)){
      showNotification(ui="Erreur lors du Preprocessing",type="error")
    } else {
      showNotification(ui="Preprocessing terminé",type="message")
    }
    values$data.train.params <- input$markers2
    values$log <- rbind(values$log,"Train Preprocess")
  })

  observe({
    if(is.null(values$data.concat)){
      shinyjs::enable("preprocess")
      shinyjs::enable("compensation")
      shinyjs::enable("normalise")
      shinyjs::enable("trans_methd")
      shinyjs::enable("trans_args")
      shinyjs::enable("markers")
      shinyjs::enable("comp_keywords")
      shinyjs::enable("clean")
    }
    if(!is.null(values$data.concat)){
      shinyjs::disable("preprocess")
      shinyjs::disable("compensation")
      shinyjs::disable("normalise")
      shinyjs::disable("trans_methd")
      shinyjs::disable("trans_args")
      shinyjs::disable("markers")
      shinyjs::disable("comp_keywords")
      shinyjs::disable("clean")
    }
    if(is.null(values$train.ready)){
      shinyjs::enable("preprocess2")
      shinyjs::enable("compensation2")
      shinyjs::enable("normalise2")
      shinyjs::enable("trans_methd2")
      shinyjs::enable("trans_args2")
      shinyjs::enable("markers2")
      shinyjs::enable("comp_keywords2")
      shinyjs::enable("clean2")
    }
    if(!is.null(values$train.ready)){
      shinyjs::disable("preprocess2")
      shinyjs::disable("compensation2")
      shinyjs::disable("normalise2")
      shinyjs::disable("trans_methd2")
      shinyjs::disable("trans_args2")
      shinyjs::disable("markers2")
      shinyjs::disable("comp_keywords2")
      shinyjs::disable("clean2")
    }
  })

  output$data_ready <- reactive({
    if(!is.null(values$data.concat)){return(TRUE)}
    return(FALSE)
  })
  outputOptions(output, "data_ready", suspendWhenHidden = FALSE)

  output$train_ready <- reactive({
    if(!is.null(values$train.ready)){return(TRUE)}
    return(FALSE)
  })
  outputOptions(output, "train_ready", suspendWhenHidden = FALSE)

  output$model_ready <- reactive({
    if(!is.null(values$model)){return(TRUE)}
    return(FALSE)
  })
  outputOptions(output,"model_ready",suspendWhenHidden = FALSE)

  observeEvent(input$clustering_data,{
    if(input$clustering_data != "FlowSOM" && input$clustering_data != "Rphenograph"){
      output$clusters <- renderUI({
        numericInput("clusters","Clusters",value=200)
      })
    } else {
      output$clusters <- renderUI({
        return(NULL)
      })
    }
  })

  observeEvent(input$clustering_train,{
    if(input$clustering_train != "FlowSOM" && input$clustering_train != "none"){
      output$clusters2 <- renderUI({
        numericInput("clusters2","Clusters",value=20)
      })
    } else {
      output$clusters2 <- renderUI({
        return(NULL)
      })
    }
  })

  observeEvent(input$reduc_dim,{
    if(is.null(values$data.concat)) return(NULL)
    progress <- Progress$new()
    progress$set(message="Reduction de dimension", value=0.5)
    fcs <- values$data.concat
    markers <- input$data_markers
    methode <- input$reduc_dim_methode
    args <- NULL
    if(methode == "EmbedSOM"){
      args <- list()
      args[[1]] <- input$xgrid
      args[[2]] <- input$ygrid
      args[[3]] <- input$rlen
    }
    if(methode == "tSNE"){
      args <- list()
      args[[1]] <- input$perp
      args[[2]] <- input$theta
      args[[3]] <- input$iter
    }
    if(methode == "UMAP"){

    }
    res <- reduDimData(fcs, markers, methode, args)
    if(is.null(values$data.reduc.dim)){
      values$data.reduc.dim <- res
    } else {
      if(colnames(res)[1]%in%colnames(values$data.reduc.dim)){
        values$data.reduc.dim[,colnames(res)[1]] <- res[,1]
        values$data.reduc.dim[,colnames(res)[2]] <- res[,2]
      } else {
        values$data.reduc.dim <-cbind(values$data.reduc.dim,res)
      }
    }
    progress$set(message="Reduction de dimension", value=0.99)
    values$log <- rbind(values$log,"Reduction Dim")
    progress$close()
  })

  observeEvent(input$model_hidden,{
    if(is.na(input$model_hidden))return(NULL)
    output$model_hiddens <- renderUI({
      res <- lapply(c(1:as.numeric(input$model_hidden)),function(i){
        numericInput(paste0("couche_",i),paste0("couche_",i),value=64,min=1,step = 1)
      })
      res <- do.call(tagList, res)
      return(res)
    })
    output$model_hiddens_fonction <- renderUI({
      res <- lapply(c(1:as.numeric(input$model_hidden)),function(i){
        selectInput(paste0("func_",i),paste0("activ_func",i),selected="relu",
                    choices=c("relu","softmax","sigmoid","linear"))
      })
      res <- do.call(tagList, res)
      return(res)
    })
  })

  observe({
    if(is.null(values$data.concat)) return(NULL)
    output$select_x_plot_data <- renderUI({
      choices <- values$data.params
      if(length(values$data.reduc.dim)>0){
        choices <- c(choices, colnames(values$data.reduc.dim))
      }
      selectInput("select_x_plot_data","X Param",choices=choices,multiple=FALSE)
    })
    output$select_y_plot_data <- renderUI({
      choices <- values$data.params
      if(length(values$data.reduc.dim)>0){
        choices <- c(choices, colnames(values$data.reduc.dim))
      }
      selectInput("select_y_plot_data","Y Param",choices=choices,multiple=FALSE)
    })
    output$select_z_plot_data <- renderUI({
      choices <- c("Density",values$data.params)
      if(length(values$data.clusters)>0){choices<-c(choices,names(values$data.clusters))}
      selectInput("select_z_plot_data","Z Param",choices=choices,multiple=FALSE)
    })
    output$select_file_plot_data <- renderUI({
      choices <- c(1: length(values$data.names))
      names(choices) <- values$data.names
      checkboxGroupInput("select_file_plot_data","Files",choices = choices,selected=choices,inline = FALSE)
    })
  })

  observeEvent(input$select_x_plot_data,{
    if(!input$select_x_plot_data%in%colnames(values$data.concat)){return(NULL)}
    x <- values$data.concat@exprs[,input$select_x_plot_data]
    output$xlim <- renderUI({
      sliderInput("xlim","xlim",min=round(min(x))-1, max=round(max(x))+1,
                  value=c((round(min(x))-1),(round(max(x))+1)), step=0.1)
    })
  })

  observeEvent(input$select_y_plot_data,{
    if(!input$select_y_plot_data%in%colnames(values$data.concat)){return(NULL)}
    y <- values$data.concat@exprs[,input$select_y_plot_data]
    output$ylim <- renderUI({
      sliderInput("ylim","ylim",min=round(min(y))-1, max=round(max(y))+1,
                  value=c(round(min(y)-1),round(max(y)+1)), step=0.1)
    })
  })

  observeEvent(input$plot_data,{
    if(is.null(values$data.concat))return(NULL)
    fcs <- values$data.concat
    id <- c()
    for(i in as.numeric(input$select_file_plot_data)){
      id <- c(id, which(fcs@exprs[,"CytoTron"]==i))
    }
    print(length(id))
    if(length(id)==0){
      showNotification(ui="No file selected",type="error")
      return(NULL)
    }
    if(length(id)>1){fcs <- fcs[id,]}
    id2 <- sample(c(1:dim(fcs)[1]),round((input$percentile_plot/100)*dim(fcs)[1]))
    fcs <- fcs[id2,]

    if(!input$select_x_plot_data%in%colnames(values$data.concat)){
      x <- values$data.reduc.dim[id[id2],input$select_x_plot_data]
      xlim <- c(min(x), max(x))
    } else {
      x <- fcs@exprs[,input$select_x_plot_data]
      xlim <- input$xlim
    }

    if(!input$select_y_plot_data%in%colnames(values$data.concat)){
      y <- values$data.reduc.dim[id[id2],input$select_y_plot_data]
      ylim <- c(min(y), max(y))
    } else {
      y <- fcs@exprs[,input$select_y_plot_data]
      ylim <- input$ylim
    }

    if(input$select_z_plot_data == "Density"){
      colPalette <- colorRampPalette(c("blue", "turquoise","green", "yellow", "orange", "red"))
      colors <- densCols(x,y, colramp = colPalette)
    }else if(input$select_z_plot_data != "Density" && !input$select_z_plot_data%in%colnames(fcs)){
      rain <- rainbow(length(unique(values$data.clusters[[input$select_z_plot_data]])))
      colors <- rain[unique(values$data.clusters[[input$select_z_plot_data]])]
    }else{
      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(cut(fcs@exprs[,c(input$select_z_plot_data)],breaks=20))]
    }

    output$plot_data <- renderPlot({
      plot(x=x,y=y,col=colors,xlim=xlim, ylim=ylim, pch=".", cex=1.5, main="",xlab="X",ylab="Y")
    },height = 600, width = 600)
  })

  observeEvent(input$add_model_marker_pattern,{
    if(is.null(input$model_marker_pattern)) return(NULL)
    id <- grep(input$model_marker_pattern, names(values$train.params))
    if(length(id)>1){
      selected <- values$train.params[id]
      updateSelectInput(session,"model_markers",selected=selected)
    }
  })

  observeEvent(input$add_model_marker_all,{
    if(is.null(values$train.params))return(NULL)
    updateSelectInput(session,"model_markers")
  })

  observeEvent(input$add_data_marker_all,{})

  observeEvent(input$add_data_marker_pattern,{
    if(is.null(input$data_marker_pattern)) return(NULL)
    id <- grep(input$data_marker_pattern, names(values$data.params))
    if(length(id)>1){
      selected <- values$data.params[id]
      updateSelectInput(session,"data_markers",selected=selected)
    }
  })

  observeEvent(input$model_create,{
    if(is.null(values$train))return(NULL)
    progress <- Progress$new()
    hidden <- unlist(lapply(c(1:input$model_hidden),function(i){
      return(as.numeric(input[[paste0("couche_",i)]]))
    }))
    func <- unlist(lapply(c(1:input$model_hidden),function(i){
      return(input[[paste0("func_",i)]])
    }))
    epochs <- input$model_epochs
    nameDim <- "popName"
    compile_function <- input$compile_function
    batch <- input$batch_size

    if(input$clustering_train != "none"){
      progress$set(message="Creation du model", value=0.25, detail="Clustering")
      if(input$clustering_train == "ceil"){
        flow.frames <- values$train.ready
        names(flow.frames) <- values$train.names
        markers <- input$model_markers
        train <- CytoTron::ceilTrainData(flow.frames,markers,input$replace,input$size)
        progress$set(message="Creation du model", value=0.50, detail="Modelisation")
        model <- CytoTron::createModel(train,nameDim,hidden,func,epochs,compile_function,batch)

      } else {
        if(input$clustering_train == "FlowSOM"){
          args <- c(input$xgrid2, input$ygrid, input$rlen2)
        }
        if(input$clustering_train == "kmeans"){
          args <- c(input$clusters2, input$iterations2)
        }
        if(input$clustering_train == "CLARA"){
          args <- c(input$clusters2, input$samples2, input$sampsiaz2)
        }
        flow.frames <- values$train.ready
        names(flow.frames) <- values$train.names
        markers <- input$model_markers
        methode <- input$clustering_train
        train <- CytoTron::overClusteringTrainData(flow.frames,markers,methode,args)
        progress$set(message="Creation du model", value=0.50, detail="Modelisation")
        model <- CytoTron::createModel(train,nameDim,hidden,func,epochs,compile_function,batch)
      }
    } else {
      progress$set(message="Creation du model", value=0.25, detail="Preparation")
      train <- concatenate.FCS(values$train.ready, params="popName")
      train <- train@exprs[,c(input$model_markers,"popName")]
      train[,"popName"] <- values$train.names[train[,"popName"]]
      progress$set(message="Creation du model", value=0.50, detail="Modelisation")
      model <- CytoTron::createModel(train,nameDim,hidden,func,epochs,compile_function,batch)

      # data <- train[,-dim(train)[2]]
      # pop <-  model.matrix(~as.factor(train[,"popName"])-1)
      # temp <- neuralnet(data,pop,hidden)
      # model <- list(model=temp)

    }

    id <- which(values$train.params%in%input$model_markers)
    model$markers <- names(values$train.params)[id]
    model$names <- values$train.names
    values$model <- model
    if(length(grep("Model Create",values$log))==0){values$log<-rbind(values$log,"Model Create")}
    progress$close()

  })

  output$model_view <- renderPlot({
    if(is.null(values$model)) return(NULL)
    #plot(1)
    keras:::plot.keras_training_history(values$model$history)
  })

  observeEvent(input$test_model,{
    if(is.null(values$model)) return(NULL)
    if(is.null(values$train.ready)) return(NULL)
    if(length(values$model$markers) != length(input$model_markers)){
      showNotification(ui="Not same number of dimension between model and train data",type="error")
      return(NULL)
    }
    progress <- Progress$new()
    progress$set(message="Test du model", value=0.99)
    data <- concatenate.FCS(values$train.ready, params="popName")
    data <- data@exprs[,c(input$model_markers)]
    data <- data.matrix(data)

    pred <- predict_classes(values$model$model,data)
    pred <- pred+1

    # res <- values$model$model(data)
    # mat <- res$numpy()
    # pred <- apply(mat, 1, which.max)

    progress$close()

    output$model_prediction <- renderTable({
      df <- as.vector(unlist(lapply(c(1:length(values$train.ready)),function(i){
        v <- length(which(pred==i))
        return(v)
      })))
      res <- as.vector(unlist(lapply(values$train.ready,function(i){return(dim(i)[1])})))
      ann <- as.vector(unlist(lapply(c(1:length(values$train.ready)),function(i){
        return(rep(i,dim(values$train.ready[[i]])[1]))
      })))
      size <- round(res/sum(res)*100,2)
      good.annot <- c()
      bad.annot <- c()
      recall <- c()
      for(i in c(1:length(values$train.ready))){
        print(i)
        id <- which(ann==i)
        pred.id <- pred[id]
        good.annot <- c(good.annot,length(which(pred.id==i)))
        bad.annot <- c(bad.annot, length(which(pred.id!=i)))
        recall <- c(recall,length(which(pred.id==i))/length(id))
      }
      df <- cbind(df,res,size,good.annot,bad.annot,recall)
      row.names(df) <- values$train.names
      colnames(df) <- c("Prediction","Reel","Size","Good","Bad","Recall")
      return(df)
    },rownames = TRUE, colnames = TRUE)
    progress$close()
  })

  observeEvent(input$refresh_model,{
    values$model <- NULL
  })

  observe({
    if(is.null(values$model) && !is.null(values$log)){
      if(length(grep("Model Create",values$log[,1]))>0){
        values$log <- matrix(values$log[-grep("Model Create",values$log),])
      }
    }
  })

  observeEvent(input$upload_model,{
    load(input$upload_model$datapath)
    values$model$model <- unserialize_model(save[[1]])
    values$model$markers <- save[[2]]
    values$model$history <- save[[3]]
    values$model$names <- save[[4]]
    updateSelectInput(session,"model_markers",selected=values$train.params[values$model$markers])
  })

  output$model <- reactive({!is.null(values$model)})
  outputOptions(output, "model", suspendWhenHidden = FALSE)

  output$ddl_model <- downloadHandler(
    filename = function(){
      return(paste0(Sys.Date(),"_perceptron.Rdata"))
    },
    content = function(filename){
      model <- serialize_model(values$model$model)
      markers <- values$model$markers
      history <- values$model$history
      names <- values$model$names
      save <- list(model,markers,history,names)
      save(list="save",file=filename)
    }
  )

  editTable <- reactive({
    myTable <- data.table(Input=values$model$markers)
    inputVec <- vector(mode="character",length=0)
    for(i in seq(nrow(myTable))){
      selected <- NULL
      if(!is.null(values$prediction.marker)){selected <- values$prediction.marker[i]}
      inputVec[i] <- as.character(selectInput(inputId=paste0("assign_",i),selected = selected,
                                              label=NULL,choices=values$data.params,multiple=FALSE,width = 100))
    }
    myTable <- myTable[,select := inputVec]
    output$myTableOutput <- DT::renderDataTable({#iris
      myTable
    },escape=FALSE,options = list(searching =FALSE, paging=FALSE,dom='t',ordering=F,
                                  drawCallback = htmlwidgets::JS('function(settings) {Shiny.bindAll(this.api().table().node());}')
    ),rownames=FALSE)
  })

  observe({
    if(is.null(values$model)) return(NULL)
    editTable()
  })

  observe({
    if(is.null(values$data.concat)) return(NULL)
    output$select_x_plot_data2 <- renderUI({
      choices <- values$data.params
      if(!is.null(values$data.reduc.dim)){
        choices <- c(choices, colnames(values$data.reduc.dim))
      }
      selectInput("select_x_plot_data2","X Param",choices=choices,multiple=FALSE)
    })
    output$select_y_plot_data2 <- renderUI({
      choices <- values$data.params
      if(!is.null(values$data.reduc.dim)){
        choices <- c(choices, colnames(values$data.reduc.dim))
      }
      selectInput("select_y_plot_data2","Y Param",choices=choices,multiple=FALSE)
    })
    output$select_file_plot_data2 <- renderUI({
      choices <- c(1: length(values$data.names))
      names(choices) <- values$data.names
      checkboxGroupInput("select_file_plot_data2","Files",choices = choices,selected=choices,inline = FALSE)
    })
  })

  observeEvent(input$add_same_name,{
    if(is.null(values$data.params)) return(NULL)
    if(is.null(values$model)) return(NULL)
    editTable()
    for(i in c(1:length(values$model$markers))){
      a <- values$model$markers[[i]]
      id <- which(names(values$data.params)==a)
      if(length(id)>0){
        updateSelectInput(session, paste0("assign_",i),selected=values$data.params[[id]])
      }
    }
  })

  observeEvent(input$annote,{
    if(is.null(values$model)) return(NULL)
    if(is.null(values$data.concat)) return(NULL)
    progress <- Progress$new()
    progress$set(message="Prediction in progress", value=0.9)
    markers <- c()
    for(i in c(1:length(values$model$markers))){
      markers <- c(markers, input[[paste0("assign_",i)]])
    }
    data <- values$data.concat@exprs[,markers]
    data <- data.matrix(data)
    pred <- predict_classes(values$model$model,data)
    values$prediction <- pred+1
    values$prediction.marker <- markers
    values$log <- rbind(values$log,"Annotate")
    progress$close()
  })

  observeEvent(input$select_x_plot_data2,{
    if(input$select_x_plot_data2%in%colnames(values$data.concat)){
      x <- values$data.concat@exprs[,input$select_x_plot_data2]
    }
    if(input$select_x_plot_data2%in%colnames(values$data.reduc.dim)){
      x <- values$data.reduc.dim[,input$select_x_plot_data2]
    }
    min <- round(min(x))-1
    max <- round(max(x))+1
    output$xlim2 <- renderUI({
      sliderInput("xlim2","xlim",min=min, max=max,value=c(min,max), step=0.1)
    })
  })

  observeEvent(input$select_y_plot_data2,{
    if(input$select_y_plot_data2%in%colnames(values$data.concat)){
      y <- values$data.concat@exprs[,input$select_y_plot_data2]
    }
    if(input$select_y_plot_data2%in%colnames(values$data.reduc.dim)){
      y <- values$data.reduc.dim[,input$select_y_plot_data2]
    }
    min <- round(min(y))-1
    max <- round(max(y))+1
    output$ylim2 <- renderUI({
      sliderInput("ylim2","ylim",min=min, max=max,value=c(min,max), step=0.1)
    })
  })

  observeEvent(input$plot_data2,{
    if(is.null(values$prediction)) return(NULL)
    if(is.null(values$data.concat))return(NULL)
    fcs <- values$data.concat
    id <- c()
    for(i in as.numeric(input$select_file_plot_data2)){
      id <- c(id, which(fcs@exprs[,"CytoTron"]==i))
    }
    if(length(id)==0){
      showNotification(ui="No file selected",type="error")
      return(NULL)
    }
    if(length(id)>1){fcs <- fcs[id,]}
    id2 <- sample(c(1:dim(fcs)[1]),round((input$percentile_plot/100)*dim(fcs)[1]))
    fcs <- fcs[id2,]

    if(!input$select_x_plot_data2%in%colnames(values$data.concat)){
      x <- values$data.reduc.dim[id[id2],input$select_x_plot_data2]
      xlim <- c(min(x), max(x))
    } else {
      x <- fcs@exprs[,input$select_x_plot_data2]
      xlim <- input$xlim2
    }

    if(!input$select_y_plot_data2%in%colnames(values$data.concat)){
      y <- values$data.reduc.dim[id[id2],input$select_y_plot_data2]
      ylim <- c(min(y), max(y))
    } else {
      y <- fcs@exprs[,input$select_y_plot_data2]
      ylim <- input$ylim2
    }

    rain <- rainbow(length(values$model$names))
    colors <- rain[values$prediction[id[id2]]]

    output$plot_data2 <- renderPlot({
      par(mar=c(5, 5, 1, input$mar), xpd=TRUE)
      plot(x=x,y=y,col=colors,xlim=xlim, ylim=ylim, pch=".", cex=1.5, main="",
           xlab=input$select_x_plot_data2,ylab=input$select_y_plot_data2)
      legend("topright",inset=c(-input$inset,0),legend=c(values$model$names), pch=20, col=rain)
    },height = input$height, width = input$width)

  })

  # observeEvent(input$download_res,{
  #   dim <- colnames(values$data.reduc.dim)
  #   output$dimName <- renderUI({
  #     objectDimName <- lapply(c(1:length(dim)),function(i){
  #       checkboxInput(paste0("dim_",dim[i]),dim[i],value=TRUE)
  #     })
  #     return(do.call(tagList,objectDimName))
  #   })
  #   showModal(modalDialog(
  #     title="Download Visualisation Value",
  #     column(12,uiOutput("dimName")),
  #     downloadButton("ddl_enrich_fcs","Enrich"),
  #     easyClose = TRUE,
  #     footer = NULL
  # ))
  #})

  output$enrich_fcs_ddl <- downloadHandler(
    filename=function(){return("output.zip")},
    content=function(filename){
      print("1")
      if(is.null(values$data)) return(NULL)
      if(is.null(values$prediction) || length(values$prediction) != dim(values$data.concat)[1]){
        showNotification(ui="Aucune prediction correspondante trouver et enrichie dans le fichier",type="warning")
        return(NULL)
      }
      print("2")
      data <- concatenate.FCS(values$data,params="temp")
      data <- enrich.FCS(data,values$prediction,"CytoTron")
      dim <- colnames(values$data.reduc.dim)
      #browser()
      for(i in c(1:length(dim))){
        #if(input[[paste0("dim_",dim[i])]]){
          data <- enrich.FCS(data,values$data.reduc.dim[,dim[i]])
        #}
      }
      print("3")
      flow.frames <- deconcatenate.FCS(data,params="temp")
      root <- getwd()
      tmpdir <- tempdir()
      setwd(tempdir())
      fs <- c()
      for(i in c(1:length(flow.frames))){
        print(i)
        name <- values$data.names[i]
        fcs <- flow.frames[[i]]
        path <- gsub(".fcs$",".fcs",name)
        fs <- c(fs, path)
        write.FCS(fcs, path)
      }
      zip(zipfile=filename, files=fs)
      setwd(root)
    }
  )

  output$ddl_final_table <- downloadHandler(
    filename=function(){return("final_table.csv")},
    content =function(filename){
      write.csv(values$final.table, file=filename)
    }
  )

  observe({
    if(is.null(values$prediction)) return(NULL)
    data <- enrich.FCS(values$data.concat,values$prediction,"Prediction")
    params <- "CytoTron"
    flow.frames <- lapply(sort(unlist(unique(data@exprs[,params]))), function(i){
      fcs <- data[which(data@exprs[,params]==i),]
      return(fcs)
    })
    rm("data")
    res <- lapply(c(1:length(flow.frames)),function(i){
      ligne <- lapply(c(1:length(values$model$names)),function(j){
        return(length(which(flow.frames[[i]]@exprs[,"Prediction"]==j)))
      })
      return(unlist(ligne))
    })
    res <- do.call(rbind,res)
    colnames(res) <- values$model$names
    row.names(res) <- values$data.names
    TOTAL <- unlist(lapply(values$data,function(i){return(dim(i)[1])}))
    p <- lapply(c(1:dim(res)[1]),function(i){return(res[i,]/TOTAL[i]*100)})
    p <- do.call(rbind,p)
    colnames(p) <- paste0("% ",values$model$names)
    res <- cbind(TOTAL,res,p)
    row.names(res) <- values$data.names
    values$final.table <- res
    output$percent_table <- renderTable({
      return(values$final.table)
    },rownames=TRUE)

  })
})