inst/app/contributions/DE_DataExploration/outputs.R

require(parallel) # done
source(paste0(packagePath, .Platform$file.sep,"contributions",
              .Platform$file.sep,"DE_DataExploration", .Platform$file.sep, "panelPlotFactFunc.R"))


# source(paste0(packagePath, "/reactives.R"), local = TRUE)

# since DE_scaterPNG is not used frequently it is not included in the heavyCalculations
# list
# myHeavyCalculations = list(c("DE_scaterPNG", "DE_scaterPNG"))

# Expression ------------------------------------------------------------------
callModule(
  clusterServer,
  "DE_expclusters",
  deProjTable,
  reactive(input$DE_gene_id)
)

# DE_updateInputExpPanel ----
#' DE_updateInputExpPanel
#' update x/y coordinates that can be chosen based on available
#' projections

observe(label ="obs_DE_logNormalization_sf", x = {
  .schnappsEnv$defaultValues[["DE_logNormalization_sf"]] = input$DE_logNormalization_sf
})
observe(label ="obs_DE_seuratRefBased_splitby", x = {
  .schnappsEnv$defaultValues[["DE_seuratRefBased_splitby"]] = input$DE_seuratRefBased_splitby
})
observe(label ="obs_DE_seuratSCtransform_split.by", x = {
  .schnappsEnv$defaultValues[["DE_seuratSCtransform_split.by"]] = input$DE_seuratSCtransform_split.by
})
observe(label ="obs_DE_seuratSCtransform_vars2regress", x = {
  .schnappsEnv$defaultValues[["DE_seuratSCtransform_vars2regress"]] = input$DE_seuratSCtransform_vars2regress
})
observe(label ="obs_DE_seuratStandard_splitby", x = {
  .schnappsEnv$defaultValues[["DE_seuratStandard_splitby"]] = input$DE_seuratStandard_splitby
})
observe(label ="obs_DE_seuratLogNorm_var2reg", x = {
  .schnappsEnv$defaultValues[["DE_seuratLogNorm_var2reg"]] = input$DE_seuratLogNorm_var2reg
})
observe(label ="obs_DE_logNormalization_sf", x = {
  .schnappsEnv$defaultValues[["DE_logNormalization_sf"]] = input$DE_logNormalization_sf
})
observe(label ="obs_DE_panelplotids", x = {
  .schnappsEnv$defaultValues[["DE_panelplotids"]] = input$DE_panelplotids
})
observe(label ="obs_DE_seuratSCTnorm_var2reg", x = {
  .schnappsEnv$defaultValues[["DE_seuratSCTnorm_var2reg"]] = input$DE_seuratSCTnorm_var2reg
})
observe(label ="obs_DE_nCol", x = {
  .schnappsEnv$defaultValues[["DE_nCol"]] = input$DE_nCol
})
observe(label ="obs_DE_panelplotSameScale", x = {
  .schnappsEnv$defaultValues[["DE_panelplotSameScale"]] = input$DE_panelplotSameScale
})
observe(label ="obs_DE_expclusters_col", x = {
  .schnappsEnv$defaultValues[["DE_expclusters_col"]] = input$DE_expclusters_col
})
observe(label ="obs_DE_gene_id", x = {
  .schnappsEnv$defaultValues[["DE_gene_id"]] = input$DE_gene_id
})

observe(label ="obs_DE_pFact_dim_x", x = {
  .schnappsEnv$obs_DE_pFact_dim_x = input$DE_pFact_dim_x
  .schnappsEnv$defaultValues[["DE_pFact_dim_x"]] = input$DE_pFact_dim_x
})
observe(label ="obs_DE_pFact_dim_y", x = {
  .schnappsEnv$DE_pFact_dim_y = input$DE_pFact_dim_y
  .schnappsEnv$defaultValues[["DE_pFact_dim_y"]] = input$DE_pFact_dim_y
})
observe(label ="DE_pFact_dim_col", x = {
  .schnappsEnv$DE_pFact_dim_col = input$DE_pFact_dim_col
  .schnappsEnv$defaultValues[["DE_pFact_dim_col"]] = input$DE_pFact_dim_col
})
observe(label ="obs_DE_panelplotFactSameScale", x = {
  .schnappsEnv$DE_panelplotFactSameScale = input$DE_panelplotFactSameScale
  .schnappsEnv$defaultValues[["DE_panelplotFactSameScale"]] = input$DE_panelplotFactSameScale
})
observe(label ="obs_DE_panelplotFactPvalue", x = {
  .schnappsEnv$DE_panelplotFactPvalue = input$DE_panelplotFactPvalue
  .schnappsEnv$defaultValues[["DE_panelplotFactPvalue"]] = input$DE_panelplotFactPvalue
})
observe(label ="obs_DE_pFactnCol", x = {
  .schnappsEnv$DE_pFactnCol = input$DE_pFactnCol
  .schnappsEnv$defaultValues[["DE_pFactnCol"]] = input$DE_pFactnCol
})
observe(label ="obs_DE_pFactIds", x = {
  .schnappsEnv$DE_pFactIds = input$DE_pFactIds
  .schnappsEnv$defaultValues[["DE_pFactIds"]] = input$DE_pFactIds
})
observe(label = "ob19", {
  if (DEBUG) cat(file = stderr(), "observe: DE_clusterSelectionPanelPlot\n")
  .schnappsEnv$DE_cl1 <- input$DE_clusterSelectionPanelPlot
})


observe(label = "DE_seuratLogNorm_var2regOBSinp", {
  if (DEBUG) cat(file = stderr(), paste0("observe: DE_seuratLogNorm_var2regOBSinp\n"))
  .schnappsEnv$DE_seuratLogNorm_var2reg <- input$DE_seuratLogNorm_var2reg
})
observe(label = "DE_seuratSCtransform_vars2regressOBSinp", {
  if (DEBUG) cat(file = stderr(), paste0("observe: DE_seuratSCtransform_vars2regress\n"))
  .schnappsEnv$DE_seuratSCtransform_vars2regress <- input$DE_seuratSCtransform_vars2regress
})
observe(label = "DE_seuratSCtransform_split.byOBSinp", {
  if (DEBUG) cat(file = stderr(), paste0("observe: DE_seuratSCtransform_split.by\n"))
  .schnappsEnv$DE_seuratSCtransform_split.by <- input$DE_seuratSCtransform_split.by
})
observe(label = "DE_seuratStandard_splitbyOBSinp", {
  if (DEBUG) cat(file = stderr(), paste0("observe: DE_seuratStandard_splitby\n"))
  .schnappsEnv$DE_seuratStandard_splitby <- input$DE_seuratStandard_splitby
})




observe(label = "ob17x", {
  if (DEBUG) cat(file = stderr(), "observe: DE_expclusters_x\n")
  .schnappsEnv$DE_expclusters_x <- input$DE_expclusters_x
  .schnappsEnv$defaultValues$DE_expclusters_x <- input$DE_expclusters_x
})
observe(label = "ob17y", {
  if (DEBUG) cat(file = stderr(), "observe: DE_expclusters_y\n")
  .schnappsEnv$DE_expclusters_y <- input$DE_expclusters_y
  .schnappsEnv$defaultValues$DE_expclusters_y <- input$DE_expclusters_y
})
observe(label = "ob17z", {
  if (DEBUG) cat(file = stderr(), "observe: DE_expclusters_z\n")
  .schnappsEnv$DE_expclusters_z <- input$DE_expclusters_z
  .schnappsEnv$defaultValues$DE_expclusters_z <- input$DE_expclusters_z
})
# observe(label = "ob17c", {
#   if (DEBUG) cat(file = stderr(), "observe: DE_expclusters_col\n")
#   .schnappsEnv$DE_expclusters_col <- input$DE_expclusters_col
# })
observe(label = "ob17d", {
  if (DEBUG) cat(file = stderr(), "observe: DE_gene_vio_x\n")
  .schnappsEnv$DE_gene_vio_x <- input$DE_gene_vio_x
  .schnappsEnv$defaultValues$DE_gene_vio_x <- input$DE_gene_vio_x
})
.schnappsEnv$DE_dim_x <- "tsne1"
.schnappsEnv$DE_dim_y <- "tsne1"
observe(label = "ob17", {
  if (DEBUG) cat(file = stderr(), "observe: DE_dim_x\n")
  .schnappsEnv$DE_dim_x <- input$DE_dim_x
  .schnappsEnv$defaultValues$DE_dim_x <- input$DE_dim_x
})
observe(label = "ob18", {
  if (DEBUG) cat(file = stderr(), "observe: DE_dim_y\n")
  .schnappsEnv$DE_dim_y <- input$DE_dim_y
  .schnappsEnv$defaultValues$DE_dim_y <- input$DE_dim_y
})

observe({
  if (DEBUG) cat(file = stderr(), "DE_updateInputExpPanel started.\n")
  start.time <- base::Sys.time()
  on.exit({
    printTimeEnd(start.time, "DE_updateInputExpPanel")
    if (!is.null(getDefaultReactiveDomain())) {
      removeNotification(id = "DE_updateInputExpPanel")
    }
  })
  if (!is.null(getDefaultReactiveDomain())) {
    showNotification("DE_updateInputExpPanel", id = "DE_updateInputExpPanel", duration = NULL)
  }
  
  projections <- projections()
  projFactors <- projFactors()
  
  # Can use character(0) to remove all choices
  if (is.null(projections)) {
    return(NULL)
  }
  
  # Can also set the label and select items
  updateSelectInput(session, "DE_expclusters_x",
                    choices = colnames(projections),
                    selected = .schnappsEnv$DE_expclusters_x
  )
  updateSelectInput(session, "DE_expclusters_y",
                    choices = colnames(projections),
                    selected = .schnappsEnv$DE_expclusters_y
  )
  updateSelectInput(session, "DE_expclusters_z",
                    choices = colnames(projections),
                    selected = .schnappsEnv$DE_expclusters_z
  )
  # updateSelectInput(session, "DE_expclusters_col",
  #                   choices = colnames(projections),
  #                   selected = .schnappsEnv$DE_expclusters_col
  # )
  updateSelectInput(session, "DE_gene_vio_x",
                    choices = projFactors,
                    selected = .schnappsEnv$DE_gene_vio_x
  )
  
  updateSelectInput(session, "DE_dim_x",
                    choices = colnames(projections),
                    selected = .schnappsEnv$DE_dim_x
  )
  
  # Can also set the label and select items
  updateSelectInput(session, "DE_dim_y",
                    choices = colnames(projections),
                    selected = .schnappsEnv$DE_dim_y
  )
  updateSelectInput(session,"DE_pFact_dim_x",
                    choices = colnames(projections),
                    selected = .schnappsEnv$DE_pFact_dim_x)
  updateSelectInput(session,"DE_pFact_dim_y",
                    choices = colnames(projections),
                    selected = .schnappsEnv$DE_pFact_dim_y)
  updateSelectInput(session,"DE_pFact_dim_col",
                    choices = colnames(projections),
                    selected = .schnappsEnv$DE_pFact_dim_col)
  updateSelectInput(session, "DE_pFactIds",
                    choices = projFactors,
                    selected = .schnappsEnv$DE_pFactIds)
  # return(TRUE)
})

observe({
  scEx <- scEx()
  setRedGreenButtonCurrent(
    vars = list(
      c("scaterRan", 0)
    )
  )
  
  updateButtonColor(buttonName = "runScater", parameters = c(
    "scaterRan"
  ))
})


## observe DE_seuratLogNorm_var2regOBS ----
observe(label = "DE_seuratLogNorm_var2regOBS", {
  scEx <- scEx()
  tmp <- input$normalizationRadioButton
  if (DEBUG) cat(file = stderr(), "observe: DE_seuratLogNorm_var2regOBS\n")
  # Can use character(0) to remove all choices
  if (is.null(scEx)) {
    return(NULL)
  }
  choicesVal = names(Filter(is.factor, colData(scEx)))
  cdat =  colData(scEx)
  choicesVal = choicesVal[unlist(lapply(choicesVal, FUN = function(x) {length(levels(cdat[,x]))>1}))]
  choicesVal = c("", choicesVal)
  # save(file = "~/SCHNAPPsDebug/DE_seuratLogNorm_var2regOBS.RData", list = c(ls(), ".schnappsEnv"))
  # cp = load(file="~/SCHNAPPsDebug/DE_seuratLogNorm_var2regOBS.RData")
  # deepDebug()
  updateSelectInput(
    session,
    "DE_seuratLogNorm_var2reg",
    choices = choicesVal
    ,
    selected = .schnappsEnv$DE_seuratLogNorm_var2reg
  )
  updateSelectInput(
    session,
    "DE_seuratSCtransform_vars2regress",
    choices = colData(scEx) %>% names()
    ,
    selected = .schnappsEnv$DE_seuratSCtransform_vars2regress
  )
  updateSelectInput(
    session,
    "DE_seuratSCtransform_split.by",
    choices = choicesVal
    ,
    selected = .schnappsEnv$DE_seuratSCtransform_split.by
  )
  updateSelectInput(
    session,
    "DE_seuratSCTnorm_var2reg",
    choices = choicesVal
    ,
    selected = .schnappsEnv$DE_seuratSCtransform_split.by
  )
  updateSelectInput(
    session,
    "DE_seuratStandard_splitby",
    choices = choicesVal
    ,
    selected = .schnappsEnv$DE_seuratSCtransform_split.by
  )
  updateSelectInput(
    session,
    "DE_seuratRefBased_splitby",
    choices = choicesVal
    ,
    selected = .schnappsEnv$DE_seuratSCtransform_split.by
  )
  # save(file = "~/SCHNAPPsDebug/DE_seuratLogNorm_var2regOBS2.RData", list = c(ls(), ".schnappsEnv"))
  # cp = load(file="~/SCHNAPPsDebug/DE_seuratLogNorm_var2regOBS2.RData")
  
})



# EXPLORE TAB VIOLIN PLOT ----
# TODO module for violin plot  ??
output$DE_gene_vio_plot <- renderPlot({
  start.time <- base::Sys.time()
  on.exit(
    if (!is.null(getDefaultReactiveDomain())) {
      removeNotification(id = "DE_gene_vio_plot")
    }
  )
  # show in the app that this is running
  if (!is.null(getDefaultReactiveDomain())) {
    showNotification("DE_gene_vio_plot", id = "DE_gene_vio_plot", duration = NULL)
  }
  if (DEBUG) cat(file = stderr(), "output$DE_gene_vio_plot\n")
  
  scEx_log <- scEx_log()
  projections <- projections()
  g_id <- input$DE_gene_id
  pc <- projectionColors %>% reactiveValuesToList()
  x = input$DE_gene_vio_x
  
  selectedCells <- DE_Exp_dataInput()
  if(is.null(selectedCells)) return(NULL)
  cellNs <- selectedCells$cellNames()
  sampdesc <- selectedCells$selectionDescription()
  prj <- isolate(selectedCells$ProjectionUsed())
  prjVals <- isolate(selectedCells$ProjectionValsUsed())
  
  if (is.null(scEx_log) | is.null(projections) | is.null(cellNs)) {
    if (DEBUG) cat(file = stderr(), "output$DE_gene_vio_plot:NULL\n")
    return(NULL)
  }
  debugControl("DE_gene_vio_plot", list = c(ls()))
  # cp = load(file="~/SCHNAPPsDebug/DE_gene_vio_plot.RData")
  
  
  p1 <- DE_geneViolinFunc(scEx_log = scEx_log[, cellNs], g_id = g_id, projections = projections[cellNs, ], ccols = pc[[x]], x)
  
  printTimeEnd(start.time, "DE_gene_vio_plot")
  exportTestValues(DE_gene_vio_plot = {
    p1
  })
  return(p1)
})


### Panel Plot ----
#' DE_clusterSelectionPanelPlot
#' update selection options for clusters
#' since we allow also "all" we have to have a different strategy for the input
#' it is debateable whether this is usefull to have a different strategy, but for now
#' we leave it as it.
.schnappsEnv$DE_cl1 <- "All"
output$DE_clusterSelectionPanelPlot <- renderUI({
  if (DEBUG) cat(file = stderr(), "output$DE_clusterSelectionPanelPlot\n")
  projections <- projections()
  upI <- DE_updateInputExpPanel()
  if (is.null(projections)) {
    HTML("Please load data")
  } else {
    noOfClusters <- levels(as.factor(projections$dbCluster))
    sc_selectInput(
      "DE_clusterSelectionPanelPlot",
      label = "Cluster",
      choices = c(c("All"), noOfClusters),
      selected = .schnappsEnv$DE_cl1
    )
  }
})



dePanelCellSelection <- callModule(
  cellSelectionModule,
  "DE_PanelPlotCellSelection"
)

dePanelFactCellSelection <- callModule(
  cellSelectionModule,
  "DE_PanelPlotFactCellSelection"
)

DE_Exp_dataInput <- callModule(
  cellSelectionModule,
  "DE_Exp_dataInput"
)

# Panel plot button observer ----
#observe: cellNameTable_rows_selected ----
observe(label = "ob_panelPlotParams", {
  if (DEBUG) cat(file = stderr(), "observe ob_panelPlotParams\n")
  
  input$updatePanelPlot
  setRedGreenButtonCurrent(
    vars = list(
      c("DE_panelplotids", (input$DE_panelplotids)),
      c("DE_dim_x", (input$DE_dim_x)),
      c("DE_dim_y", (input$DE_dim_y)),
      c("DE_panelplotSameScale", (input$DE_panelplotSameScale)),
      c("DE_nCol", (input$DE_nCol)),
      c("DE_PanelPlotCellSelection-Mod_clusterPP", (input$`DE_PanelPlotCellSelection-Mod_clusterPP`)),
      c("DE_PanelPlotCellSelection-Mod_PPGrp", (input$`DE_PanelPlotCellSelection-Mod_PPGrp`)),
      c("DE_panelplotPvalue", (input$DE_panelplotPvalue))
    )
  )
  
  updateButtonColor(buttonName = "updatePanelPlot", parameters = c(
    "DE_panelplotids", "DE_dim_x", "DE_dim_y", "DE_panelplotSameScale", 
    "DE_nCol", "DE_PanelPlotCellSelection-Mod_clusterPP", "DE_PanelPlotCellSelection-Mod_PPGrp", "DE_panelplotPvalue"
  ))
})




# DE_panelPlot ----
#' DE_panelPlot
#' plot multiple panels for a given list of genes
#' If the x-axis is a categorical value and the y-axis is UMI.counts the y-axis related to
#' the count for that gene. Otherwise, all genes are used.
#' normalized counts are used for plotting
output$DE_panelPlot <- renderPlot({
  start.time <- base::Sys.time()
  on.exit(
    if (!is.null(getDefaultReactiveDomain())) {
      removeNotification(id = "DE_panelPlot")
    }
  )
  # show in the app that this is running
  if (!is.null(getDefaultReactiveDomain())) {
    showNotification("DE_panelPlot", id = "DE_panelPlot", duration = NULL)
  }
  if (DEBUG) cat(file = stderr(), "output$DE_panelPlot\n")
  
  clicked <- input$updatePanelPlot
  applyPvalue <- isolate(input$DE_panelplotPvalue)
  scEx_log <- scEx_log()
  projections <- projections()
  # DE_updateInputPPt()
  genesin <- isolate(input$DE_panelplotids)
  # cl4 <- input$DE_clusterSelectionPanelPlot
  # ppgrp <- isolate(input$DE_PPGrp)
  # ppCluster <- isolate(input$DE_clusterPP)
  
  selectedCells <- isolate(dePanelCellSelection())
  cellNs <- isolate(selectedCells$cellNames())
  sampdesc <- isolate(selectedCells$selectionDescription())
  
  dimx4 <- isolate(input$DE_dim_x)
  dimy4 <- isolate(input$DE_dim_y)
  sameScale <- isolate(input$DE_panelplotSameScale)
  nCol <- isolate(as.numeric(input$DE_nCol))
  
  if (is.null(scEx_log) | is.null(projections) | is.null(cellNs)) {
    return(NULL)
  }
  # debugControl("DE_panelPlot", list = c("scEx_log", "projections", "genesin",
  # "dimx4", "dimy4", "sameScale", "nCol", "sampdesc" , "cellNs"))
  # cp = load(file="~/SCHNAPPsDebug/DE_panelPlot.RData")
  
  genesin <- toupper(genesin)
  genesin <- gsub(" ", "", genesin, fixed = TRUE)
  genesin <- strsplit(genesin, ",")
  genesin <- genesin[[1]]
  
  # if (DEBUG) cat(file = stderr(), paste("output:sampdesc",sampdesc,"\n"))
  retVal <- panelPlotFunc_m(scEx_log, projections, genesin, dimx4, dimy4, sameScale, nCol, sampdesc, cellNs, applyPvalue = applyPvalue) 
  
  setRedGreenButton(
    vars = list(
      c("DE_panelplotids", isolate(input$DE_panelplotids)),
      c("DE_dim_x", isolate(input$DE_dim_x)),
      c("DE_dim_y", isolate(input$DE_dim_y)),
      c("DE_panelplotSameScale", isolate(input$DE_panelplotSameScale)),
      c("DE_nCol", isolate(input$DE_nCol)),
      c("DE_PanelPlotCellSelection-Mod_clusterPP", isolate(input$`DE_PanelPlotCellSelection-Mod_clusterPP`)),
      c("DE_PanelPlotCellSelection-Mod_PPGrp", isolate(input$`DE_PanelPlotCellSelection-Mod_PPGrp`)),
      c("DE_panelplotPvalue", isolate(input$DE_panelplotPvalue))
    ),
    button = "updatePanelPlot"
  )
  
  
  printTimeEnd(start.time, "DE_panelPlot")
  exportTestValues(DE_panelPlot = {
    ls()
  })
  af = panelPlotFunc
  # remove env because it is too big
  environment(af) = new.env(parent = emptyenv())
  
  .schnappsEnv[["DE_panelPlot"]] <- list(plotFunc = af,
                                         scEx_log = scEx_log, 
                                         projections=projections, 
                                         genesin=genesin, dimx4=dimx4, 
                                         dimy4=dimy4, sameScale=sameScale, 
                                         nCol=nCol, sampdesc=sampdesc,
                                         cellNs=cellNs,
                                         applyPvalue = applyPvalue
  )
  retVal
})




# DE_panelPlotFact ----
#' DE_panelPlotFact
#' plot multiple panels for a given list of genes
#' If the x-axis is a categorical value and the y-axis is UMI.counts the y-axis related to
#' the count for that gene. Otherwise, all genes are used.
#' normalized counts are used for plotting
output$DE_panelPlotFact <- renderPlot({
  start.time <- base::Sys.time()
  on.exit(
    if (!is.null(getDefaultReactiveDomain())) {
      removeNotification(id = "DE_panelPlotFact")
    }
  )
  # show in the app that this is running
  if (!is.null(getDefaultReactiveDomain())) {
    showNotification("DE_panelPlotFact", id = "DE_panelPlotFact", duration = NULL)
  }
  if (DEBUG) cat(file = stderr(), "output$DE_panelPlotFact\n")
  # source("~/Rstudio/schnapps/inst/app/contributions/DE_DataExploration/panelPlotFactFunc.R")
  clicked <- input$updatePanelPlotFact
  applyPvalue <- isolate(input$DE_panelplotFactPvalue)
  scEx_log <- scEx_log()
  projections <- projections()
  DE_updateInputPPt()
  factsin <- isolate(input$DE_pFactIds)
  # cl4 <- input$DE_clusterSelectionPanelPlot
  # ppgrp <- isolate(input$DE_PPGrp)
  # ppCluster <- isolate(input$DE_clusterPP)
  
  selectedCells <- isolate(dePanelFactCellSelection())
  cellNs <- isolate(selectedCells$cellNames())
  sampdesc <- isolate(selectedCells$selectionDescription())
  
  dimx4 <- isolate(input$DE_pFact_dim_x)
  dimy4 <- isolate(input$DE_pFact_dim_y)
  dimCol4 <- isolate(input$DE_pFact_dim_col)
  sameScale <- isolate(input$DE_panelplotFactSameScale)
  nCol <- isolate(as.numeric(input$DE_pFactnCol))
  
  if (is.null(scEx_log) | is.null(projections) | is.null(cellNs)) {
    return(NULL)
  }
  # debugControl("DE_panelPlotFact", list = c("scEx_log", "projections", "genesin",
  # "dimx4", "dimy4", "sameScale", "nCol", "sampdesc" , "cellNs"))
  # cp = load(file="~/SCHNAPPsDebug/DE_panelPlotFact.RData")
  
  # genesin <- toupper(genesin)
  # genesin <- gsub(" ", "", genesin, fixed = TRUE)
  # genesin <- strsplit(genesin, ",")
  # genesin <- genesin[[1]]
  
  # if (DEBUG) cat(file = stderr(), paste("output:sampdesc",sampdesc,"\n"))
  retVal <- panelPlotFactFunc(scEx_log, projections, factsin, dimx4, dimy4, dimCol4, 
                              sameScale, nCol, sampdesc, cellNs,
                              applyPvalue = applyPvalue, projectionColors=projectionColors, .schnappsEnv = .schnappsEnv) 
  
  setRedGreenButton(
    vars = list(
      c("DE_pFactIds", isolate(input$DE_pFactIds)),
      c("DE_pFact_dim_x", isolate(input$DE_pFact_dim_x)),
      c("DE_pFact_dim_y", isolate(input$DE_pFact_dim_y)),
      c("DE_pFact_dim_col", isolate(input$DE_pFact_dim_col)),
      c("DE_panelplotFactSameScale", isolate(input$DE_panelplotFactSameScale)),
      c("DE_pFactnCol", isolate(input$DE_pFactnCol)),
      c("DE_PanelPlotFactCellSelection-Mod_clusterPP", isolate(input$`DE_PanelPlotFactCellSelection-Mod_clusterPP`)),
      c("DE_PanelPlotFactCellSelection-Mod_PPGrp", isolate(input$`DE_PanelPlotFactCellSelection-Mod_PPGrp`)),
      c("DE_panelplotFactPvalue", isolate(input$DE_panelplotFactPvalue))
    ),
    button = "updatePanelPlotFact"
  )
  
  
  printTimeEnd(start.time, "DE_panelPlotFact")
  exportTestValues(DE_panelPlotFact = {
    ls()
  })
  af = panelPlotFunc
  # remove env because it is too big
  environment(af) = new.env(parent = emptyenv())
  
  .schnappsEnv[["DE_panelPlotFact"]] <- list(plotFunc = af,
                                         scEx_log = scEx_log, 
                                         projections=projections, 
                                         dimx4=dimx4, 
                                         dimy4=dimy4, sameScale=sameScale, 
                                         nCol=nCol, sampdesc=sampdesc,
                                         cellNs=cellNs,
                                         applyPvalue = applyPvalue
  )
  retVal
})

#
# 
# 
# Scater QC ----
#
# 
# 

emptyImage = list(
  src =  normalizePath("www/images/schnappsLogo.png",mustWork = F),
  contentType = "image/png",
  width = 500,
  height = 500,
  alt = "Scater plot will be here when 'apply changes' is checked"
)

createScaterPNG <- function(scaterReads, n, scols, width=NULL, height=NULL, DEBUG, outfile) {
  if (DEBUG) cat(file = stderr(), "function: createScaterPNG\n")
  # save(file = "~/SCHNAPPsDebug/createScaterPNG.RData", list = c(ls()))
  # cp=load(file='~/SCHNAPPsDebug/createScaterPNG.RData')
  if (DEBUG) cat(file = stderr(), "function: createScaterPNG2\n")
  p1 = pltHighExp( scaterReads, n, scols) 
  if (DEBUG) cat(file = stderr(), "function: createScaterPNG3\n")
  # calculations
  if (is.null(width)) {
    width <- 96 * 7
  }
  if (is.null(height)) {
    height <- 96 * 7
  }
  myPNGwidth <- width / 96
  myPNGheight <- height / 96
  
  if (DEBUG) cat(file = stderr(), "function: createScaterPNG4\n")
  tryCatch(
    ggsave(file = normalizePath(outfile, mustWork = FALSE), plot = p1, width = myPNGwidth, height = myPNGheight, units = "in"),
    error = function(e) {
      if (!is.null(getDefaultReactiveDomain())) {
        showNotification("Problem saving ggplot", type = "warning", duration = NULL)
      }
      return(emptyImage)
    }
  )
  retVal <- list(
    src = normalizePath(outfile, mustWork = FALSE),
    contentType = "image/png",
    width = width,
    height = height,
    alt = "Scater plot should be here"
  )
  if (DEBUG) cat(file = stderr(), "function: createScaterPNG5\n")
  
  return(retVal)
}

# click on start button
observeEvent(input$runScater,{
  if (.schnappsEnv$DEBUG) cat(file = stderr(), "observeEvent: detachedProc$runScater\n")
  if (!is.null(detachedProc$process)){
    return()
  }
  start.time <- base::Sys.time()
  if (!is.null(getDefaultReactiveDomain())) {
    showNotification("DE_scaterPNG", id = "DE_scaterPNG", duration = NULL)
    removeNotification(id="DE_scaterPNG_Error")
  }
  require(future.callr)
  scaterReads <- isolate(scaterReads())
  scols <- isolate(projectionColors$sampleNames)
  maxMemory = isolate(input$maxMemory)
  
  if (is.null(scaterReads)){
    removeNotification(id="DE_scaterPNG")
    detachedProc$result <- emptyImage
    return()
  }
  # width <- session$clientData$output_plot_width
  # height <- session$clientData$output_plot_height
  width <- NULL
  height <- NULL
  # outfile has to be set outside of the future since it will be removed after the session closes.
  outfile <- paste0(tempdir(), .Platform$file.sep, "scaterPlot.png")
  
  n <- min(nrow(scaterReads), 50)
  # browser()
  if (.schnappsEnv$DEBUGSAVE) {
    save(file = normalizePath("~/SCHNAPPsDebug/scater.RData"), list = c(ls()))
  }
  # cp=load(file='~/SCHNAPPsDebug/scater.RData')
  detachedProc$result <- emptyImage
  pl=plan()
  # span process
  # detachedProc$process <- mcparallel({
  #   createScaterPNG(scaterReads, n, scols, width=width, height=height)
  # })
  #span the process/function call
  # This should be set globally as it is also not reset here
  options(future.globals.maxSize= maxMemory * 1024^3)
  plan(callr, workers = 2)
  
  detachedProc$process <- tryCatch({
    future({
      # detachedProc$process$pid = Sys.getpid()
      createScaterPNG(scaterReads=scaterReads, n=n, scols=scols, width=NULL, height=NULL, DEBUG = DEBUG, outfile=outfile)
    },seed=NULL,
    packages = "scater",
    globals = list(createScaterPNG=createScaterPNG, emptyImage=emptyImage, DEBUG=.schnappsEnv$DEBUG, pltHighExp=pltHighExp,
                   scaterReads=scaterReads, n=n, scols=scols, width=NULL, height=NULL, outfile=outfile), # we specify all variables with the function call
    lazy = FALSE, #start immediatly
    stdout = structure(TRUE, drop = TRUE)
    )},
    error = function(e) {
      cat(file = stderr(), paste("\n\n!!!Error during detach process:", e, "\n\nDo you need to increase the memory?\n\n"))
      if (!is.null(getDefaultReactiveDomain())) {
        showNotification("DE_scaterPNG ERROR", id = "DE_scaterPNG_Error", duration = NULL, type = "error")
      }
      return(NULL)
    }
  )
  if (.schnappsEnv$DEBUGSAVE) {
    save(file = normalizePath("~/SCHNAPPsDebug/scater2.RData"), list = c(ls()))
  }
  # cp=load(file='~/SCHNAPPsDebug/scater2.RData')
  # browser()
  if(is.null(detachedProc$process)) {
    plan(pl)
    return(NULL)
  }
  activateObserver(1)
  if(!is.null(detachedProc$process$process))
    cat(file = stderr(), paste("input$start",detachedProc$process$process$get_pid(),"me:",Sys.getpid(),"\n"))
  if("callr" %in% class(pl)){
    detachedProc$PID = detachedProc$process$process$get_pid()
  }else{
    # if("multisession" %in% class(pl)){
    #   currentWorkerPIDs = getWorkerPIDs()
    # }
    #
    # please use callr otherwise we cannot kill process (for now)
    # 
    detachedProc$PID = NULL
  }
  
  detachedProc$startTime = start.time
  detachedProc$msg <- sprintf("%1$s started", detachedProc$process$pid)
  plan(pl)
})
#
# Stop the process
#
observeEvent(input$stopScater, {
  if(.schnappsEnv$DEBUG) cat(file = stderr(), "input$stopScater\n")

  if (.schnappsEnv$DEBUGSAVE) {
    save(file = normalizePath("~/SCHNAPPsDebug/stopScater.RData"), list = c(ls()))
  }
  # cp=load(file='~/SCHNAPPsDebug/stopScater.RData')
  if (!is.null(detachedProc$PID)) {
    if("running" == detachedProc$process$state){
      #For windows
      # system(sprintf("taskkill /F /PID %s", v[[i]]))
      
      #For Linux
      system(sprintf("kill -9 %s", detachedProc$PID))
      activateObserver(0)
      detachedProc$PID = NULL
      detachedProc$process = NULL
      if (!is.null(getDefaultReactiveDomain())) {
        removeNotification(id = "DE_scaterQC")
        removeNotification(id = "DE_scaterPNG")
      }
      
    }
  }
})

#
# Handle process event
#
observe({
  if (.schnappsEnv$DEBUG) cat(file = stderr(), "observeEvent: detachedProc$process\n")
  # this will re-execute the collection process of mcparallel
  # if(!is.null(detachedProc$process))
  if(activateObserver()>0)
    invalidateLater(500, session)
  # browser()
  if (.schnappsEnv$DEBUG) cat(file = stderr(), "observeEvent: detachedProc$process2\n")
  if (.schnappsEnv$DEBUGSAVE) {
    save(file = normalizePath("~/SCHNAPPsDebug/processScater.RData"), list = c(ls()))
  }
  # cp=load(file='~/SCHNAPPsDebug/processScater.RData')
  
    isolate({
    if(resolved(detachedProc$process))
      if(!is.null(detachedProc$process)){
        # browser()
        detachedProc$result <- value(detachedProc$process)
        result = detachedProc$result
        # save(file = "~/SCHNAPPsDebug/createScaterPNGprocess.RData", list = c("result"))
        # cp=load(file='~/SCHNAPPsDebug/createScaterPNGprocess.RData')
        detachedProc$process <- NULL
        detachedProc$PID = NULL
        activateObserver(0)
        if (.schnappsEnv$DEBUG) cat(file = stderr(), "observeEvent: detachedProc$process3\n")
        printTimeEnd(detachedProc$startTime, "DE_scaterPNG")
        if (.schnappsEnv$DEBUG) cat(file = stderr(), "observeEvent: detachedProc$process4\n")
        if (!is.null(getDefaultReactiveDomain())) {
          removeNotification( id = "DE_scaterPNG")
        }
        
      }
    if (.schnappsEnv$DEBUG) cat(file = stderr(), "observeEvent: detachedProc$process5\n")
    
  })
})

output$DE_scaterQC <- renderImage(deleteFile = F, {
  start.time <- base::Sys.time()
  on.exit(
    if (!is.null(getDefaultReactiveDomain())) {
      removeNotification(id = "DE_scaterQC")
    }
  )
  if (!is.null(getDefaultReactiveDomain())) {
    showNotification("DE_scaterQC", id = "DE_scaterQC", duration = NULL)
  }
  if (DEBUG) cat(file = stderr(), "renderImage. output$DE_scaterQC\n")
  # browser()
  result = detachedProc$result
  if (.schnappsEnv$DEBUGSAVE) {
    save(file = normalizePath("~/SCHNAPPsDebug/result1Scater.RData"), list = c(ls()))
  }
  # cp=load(file='~/SCHNAPPsDebug/result1Scater.RData')
  
  scaterReads <- isolate(scaterReads())
  if (is.null(scaterReads) | is.null(result)) {
    return(emptyImage)
  }
  if (.schnappsEnv$DEBUGSAVE) {
    save(file = normalizePath("~/SCHNAPPsDebug/result2Scater.RData"), list = c(ls()))
  }
  # cp=load(file='~/SCHNAPPsDebug/result2Scater.RData')
  af = pltHighExp
  # remove env because it is too big
  environment(af) = new.env(parent = emptyenv())
  n <- min(nrow(scaterReads), 50)
  scols <- isolate(projectionColors$sampleNames)
  .schnappsEnv[["DE_scaterPNG"]] <- list(plotFunc = af,
                                         # plotHighestExprs = plotHighestExprs,
                                         scaterReads = scaterReads, 
                                         n = n,
                                         scols = scols
  )
  setRedGreenButton(
    vars = list(
      c("scaterRan", 1)
    ),
    button = "runScater"
  )
  
  exportTestValues(DE_scaterPNG = {
    result
  })
  result
})
#  Cannot call `bindCache()` on this object because it is marked as not cacheable.
# %>% bindCache(scaterReads())

# DE_tsne_plt ----
# tSNE plot within Data exploration - Expressoin
output$DE_tsne_plt <- plotly::renderPlotly({
  start.time <- base::Sys.time()
  on.exit(
    if (!is.null(getDefaultReactiveDomain())) {
      removeNotification(id = "DE_tsne_plt")
    }
  )
  if (!is.null(getDefaultReactiveDomain())) {
    showNotification("DE_tsne_plt", id = "DE_tsne_plt", duration = NULL)
  }
  if (DEBUG) cat(file = stderr(), "output$DE_tsne_plt\n")
  
  scEx_log <- scEx_log()
  g_id <- input$DE_gene_id
  projections <- projections()
  selectedCells <- DE_Exp_dataInput()
  if(is.null(selectedCells)) return(NULL)
  cellNs <- selectedCells$cellNames()
  sampdesc <- selectedCells$selectionDescription()
  prj <- isolate(selectedCells$ProjectionUsed())
  prjVals <- isolate(selectedCells$ProjectionValsUsed())
  x = input$DE_expclusters_x
  y = input$DE_expclusters_y
  z = input$DE_expclusters_z
  # dimCol <- input$DE_expclusters_col
  # scols <- projectionColors$sampleNames
  # ccols <- projectionColors$dbCluster
  pc = projectionColors %>% reactiveValuesToList()
  if (is.null(scEx_log) | is.null(projections) | is.null(cellNs) ) {
    return(NULL)
  }
  # debugControl("DE_tsne_plt", list = c(ls()))
  # cp = load(file="~/SCHNAPPsDebug/DE_tsne_plt.RData")
  
  # projections$ExpressionColor = 
  dimCol = "ExpressionColor"
  featureData <- rowData(scEx_log)
  geneid <- geneName2Index(g_id, featureData)
  if (length(geneid) == 0) {
    return(NULL)
  }
  
  if (length(geneid) == 1) {
    projections$ExpressionColor <- assays(scEx_log)[[1]][geneid, ]
  } else {
    projections$ExpressionColor <- Matrix::colSums(assays(scEx_log)[[1]][geneid, ])
  }
  
  retVal <- tsnePlot(projections, x,y,z, dimCol, projColors=pc) 
  
  # retVal <- DE_dataExpltSNEPlot(scEx_log[,cellNs], g_id, projections[cellNs, ], x,y,z)
  
  printTimeEnd(start.time, "DE_dataExpltSNEPlot")
  exportTestValues(DE_dataExpltSNEPlot = {
    str(retVal)
  })
  retVal
})

# download RDS ----
output$DE_downloadPanel <- downloadHandler(
  filename = paste0("panelPlot.", Sys.Date(), ".Zip"),
  content = function(file) {
    if (DEBUG) cat(file = stderr(), paste("DE_downloadPanel: \n"))
    
    scEx <- scEx()
    projections <- projections()
    scEx_log <- scEx_log()
    pca <- pcaReact()
    # TODO should be taken from projections.
    tsne <- tsne()
    
    if (is.null(scEx) | is.null(scEx_log)) {
      return(NULL)
    }
    # debugControl("DE_downloadPanel", list = c(ls()))
    # load(file='~/SCHNAPPsDebug/DE_downloadPanel.RData')
    
    reducedDims(scEx) <- SimpleList(PCA = pca$x, TSNE = tsne)
    assays(scEx)[["logcounts"]] <- assays(scEx_log)[[1]]
    colData(scEx)[["before.Filter"]] <- projections$before.filter
    colData(scEx)[["dbCluster"]] <- projections$dbCluster
    colData(scEx)[["UmiCountPerGenes"]] <- projections$UmiCountPerGenes
    colData(scEx)[["UmiCountPerGenes2"]] <- projections$UmiCountPerGenes2
    
    save(file = file, list = c("scEx"))
    if (DEBUG) cat(file = stderr(), paste("DE_downloadPanel:done \n"))
    
    # write.csv(as.matrix(exprs(scEx)), file)
  }
)

# observers for input parameters and

observe(label = "observe DE_seuratRefBased", {
  if (DEBUG) cat(file = stderr(), "observe DE_seuratRefBased\n")
  if (is.null(input$updateNormalization)) {
    return(NULL)
  }
  if (!input$normalizationRadioButton == "DE_seuratRefBased") {
    return(NULL)
  }
  if (!input$whichscLog == "calcLog") {
    return(NULL)
  }
  out <- DE_seuratRefBased()
  if (is.null(out)) {
    # set one parameter to something not possible to deactivate button/or choose different
    .schnappsEnv$DE_seuratRefBased_nfeatures <- "NA"
  }
  
  # currentValues
  setRedGreenButtonCurrent(
    vars = list(
      c("DE_seuratRefBased_nfeatures", input$DE_seuratRefBased_nfeatures),
      c("DE_seuratRefBased_k.filter", input$DE_seuratRefBased_k.filter),
      c("DE_seuratRefBased_scaleFactor", input$DE_seuratRefBased_scaleFactor)
    )
  )
  
  updateButtonColor(buttonName = "updateNormalization", parameters = c(
    "DE_seuratRefBased_nfeatures", "DE_seuratRefBased_k.filter",
    "DE_seuratRefBased_scaleFactor"
  ))
  
  
  # Here, we create the actual button
  # output$updateNormalizationButton <- updateButtonUI(input = input, name = "updateNormalization",
  #                                                    variables = c("nfeatures", "k.filter", "scalingFactor"  ) )
})


# obs.updateNormalization DE_seuratRefBased ----
observe(label = "obs.updateNormalization", {
  buttonPressed <- input$updateNormalization
  radioButtonVal <- isolate(input$normalizationRadioButton)
  if (!exists("DE_seuratRefBasedButtonOldVal", envir = .schnappsEnv)) {
    .schnappsEnv$DE_seuratRefBasedButtonOldVal <- 0
  }
  if (is.null(radioButtonVal)) {
    radioButtonVal <- ""
  }
  if (is.null(buttonPressed)) {
    buttonPressed <- 0
  }
  
  # changing the reactive DE_logGeneNormalizationButton will trigger the recalculation
  if (radioButtonVal == "DE_seuratRefBased" &
      !.schnappsEnv$DE_seuratRefBasedButtonOldVal == buttonPressed) {
    cat(file = stderr(), green(paste("\n=====changing value\n")))
    DE_seuratRefBasedButton(buttonPressed)
    .schnappsEnv$DE_seuratRefBasedButtonOldVal <- buttonPressed
  }
})


# obs.updateNormalization DE_seuratSCTnormButton ----
observe(label = "ob DE_seuratSCTnormButtonOldVal", {
  buttonPressed <- input$updateNormalization
  radioButtonVal <- isolate(input$normalizationRadioButton)
  if (!exists("DE_seuratSCTnormButtonOldVal", envir = .schnappsEnv)) {
    .schnappsEnv$DE_seuratSCTnormButtonOldVal <- 0
  }
  if (is.null(radioButtonVal)) {
    radioButtonVal <- ""
  }
  if (is.null(buttonPressed)) {
    buttonPressed <- 0
  }
  
  # changing the reactive DE_logGeneNormalizationButton will trigger the recalculation
  if (radioButtonVal == "DE_seuratSCTnorm" &
      !.schnappsEnv$DE_seuratSCTnormButtonOldVal == buttonPressed) {
    cat(file = stderr(), green(paste("\n=====changing value\n")))
    DE_seuratSCTnormButton(buttonPressed)
    .schnappsEnv$DE_seuratSCTnormButtonOldVal <- buttonPressed
  }
})



# obs.updateNormalization DE_seuratSCtransformButton ----
observe(label = "ob DE_seuratSCtransformButtonOldVal", {
  buttonPressed <- input$updateNormalization
  radioButtonVal <- isolate(input$normalizationRadioButton)
  if (!exists("DE_seuratSCtransformButtonOldVal", envir = .schnappsEnv)) {
    .schnappsEnv$DE_seuratSCtransformButtonOldVal <- 0
  }
  if (is.null(radioButtonVal)) {
    radioButtonVal <- ""
  }
  if (is.null(buttonPressed)) {
    buttonPressed <- 0
  }
  
  # changing the reactive DE_logGeneNormalizationButton will trigger the recalculation
  if (radioButtonVal == "DE_seuratSCtransform" &
      !.schnappsEnv$DE_seuratSCtransformButtonOldVal == buttonPressed) {
    cat(file = stderr(), green(paste("\n=====changing value\n")))
    DE_seuratSCtransformButton(buttonPressed)
    .schnappsEnv$DE_seuratSCtransformButtonOldVal <- buttonPressed
  }
})

observe(label = "observe DE_seuratSCtransform", {
  if (DEBUG) cat(file = stderr(), "observe DE_seuratSCtransform\n")
  if (is.null(input$updateNormalization)) {
    return(NULL)
  }
  if (!input$normalizationRadioButton == "DE_seuratSCtransform") {
    return(NULL)
  }
  if (!input$whichscLog == "calcLog") {
    return(NULL)
  }
  out <- DE_seuratSCtransform()
  if (is.null(out)) {
    # set one parameter to something not possible to deactivate button/or choose different
    .schnappsEnv$DE_seuratRefBased_nfeatures <- "NA"
  }
  
  setRedGreenButtonCurrent(
    vars = list(
      c("DE_seuratSCtransform_nfeatures", input$DE_seuratSCtransform_nfeatures),
      c("DE_seuratSCtransform_k.filter", input$DE_seuratSCtransform_k.filter),
      c("DE_seuratSCtransform_scaleFactor", input$DE_seuratSCtransform_scaleFactor)
    )
  )
  
  updateButtonColor(buttonName = "updateNormalization", parameters = c(
    "DE_seuratSCtransform_nfeatures",
    "DE_seuratSCtransform_k.filter",
    "DE_seuratSCtransform_scaleFactor"
  ))
})


# obs.updateNormalization DE_seuratSCtransformButton ----
observe(label = "ob DE_seuratStandardButton", {
  buttonPressed <- input$updateNormalization
  radioButtonVal <- isolate(input$normalizationRadioButton)
  if (!exists("DE_seuratStandardButtonOldVal", envir = .schnappsEnv)) {
    .schnappsEnv$DE_seuratStandardButtonOldVal <- 0
  }
  if (is.null(radioButtonVal)) {
    radioButtonVal <- ""
  }
  if (is.null(buttonPressed)) {
    buttonPressed <- 0
  }
  
  # changing the reactive DE_logGeneNormalizationButton will trigger the recalculation
  if (radioButtonVal == "DE_seuratStandard" &
      !.schnappsEnv$DE_seuratStandardButtonOldVal == buttonPressed) {
    cat(file = stderr(), green(paste("\n=====changing value\n")))
    DE_seuratStandardButton(buttonPressed)
    .schnappsEnv$DE_seuratStandardButtonOldVal <- buttonPressed
  }
})

# obs.updateNormalization DE_seuratLogNormButton ----
observe(label = "ob DE_seuratLogNormButton", {
  buttonPressed <- input$updateNormalization
  radioButtonVal <- isolate(input$normalizationRadioButton)
  if (!exists("DE_seuratLogNormButtonOldVal", envir = .schnappsEnv)) {
    .schnappsEnv$DE_seuratLogNormButtonOldVal <- 0
  }
  if (is.null(radioButtonVal)) {
    radioButtonVal <- ""
  }
  if (is.null(buttonPressed)) {
    buttonPressed <- 0
  }
  
  # changing the reactive DE_logGeneNormalizationButton will trigger the recalculation
  if (radioButtonVal == "DE_seuratLogNorm" &
      !.schnappsEnv$DE_seuratLogNormButtonOldVal == buttonPressed) {
    cat(file = stderr(), green(paste("\n=====changing value\n")))
    DE_seuratLogNormButton(buttonPressed)
    .schnappsEnv$DE_seuratLogNormButtonOldVal <- buttonPressed
  }
})

observe(label = "observe DE_seuratStandard", {
  if (DEBUG) cat(file = stderr(), "observe DE_seuratStandard\n")
  if (is.null(input$updateNormalization)) {
    return(NULL)
  }
  if (!input$normalizationRadioButton == "DE_seuratStandard") {
    return(NULL)
  }
  if (!input$whichscLog == "calcLog") {
    return(NULL)
  }
  out <- DE_seuratStandard()
  if (is.null(out)) {
    # set one parameter to something not possible to deactivate button/or choose different
    .schnappsEnv$DE_seuratRefBased_nfeatures <- "NA"
  }
  
  setRedGreenButtonCurrent(
    vars = list(
      c("DE_seuratStandard_dims", input$DE_seuratStandard_dims),
      c("DE_seuratStandard_anchorF", input$DE_seuratStandard_anchorF),
      c("DE_seuratStandard_kF", input$DE_seuratStandard_kF),
      c("DE_seuratStandard_k.weight", input$DE_seuratStandard_k.weight)
    )
  )
  
  updateButtonColor(buttonName = "updateNormalization", parameters = c(
    "DE_seuratStandard_dims",
    "DE_seuratStandard_anchorF",
    "DE_seuratStandard_kF",
    "DE_seuratStandard_k.weight"
  ))
})

# obs.updateNormalization DE_logNormalization ----
observe(label = "obs.updateNormalization", {
  buttonPressed <- input$updateNormalization
  radioButtonVal <- isolate(input$normalizationRadioButton)
  if (!exists("DE_logNormalizationButtonOldVal", envir = .schnappsEnv)) {
    .schnappsEnv$DE_logNormalizationButtonOldVal <- 0
  }
  if (is.null(radioButtonVal)) {
    radioButtonVal <- ""
  }
  if (is.null(buttonPressed)) {
    buttonPressed <- 0
  }
  
  # changing the reactive DE_logGeneNormalizationButton will trigger the recalculation
  if (radioButtonVal == "DE_logNormalization" &
      !.schnappsEnv$DE_logNormalizationButtonOldVal == buttonPressed) {
    cat(file = stderr(), green(paste("\n=====changing value\n")))
    DE_logNormalizationButton(buttonPressed)
    .schnappsEnv$DE_logNormalizationButtonOldVal <- buttonPressed
  }
})

# if no parameters the second observer is not needed


# obs.updateNormalization DE_logGeneNormalization ----
observe(label = "obs.updateNormalization", {
  buttonPressed <- input$updateNormalization
  radioButtonVal <- isolate(input$normalizationRadioButton)
  if (!exists("DE_logGeneNormalizationButtonOldVal", envir = .schnappsEnv)) {
    .schnappsEnv$DE_logGeneNormalizationButtonOldVal <- 0
  }
  if (is.null(radioButtonVal)) {
    radioButtonVal <- ""
  }
  if (is.null(buttonPressed)) {
    buttonPressed <- 0
  }
  
  # changing the reactive DE_logGeneNormalizationButton will trigger the recalculation
  if (radioButtonVal == "DE_logGeneNormalization" &
      !.schnappsEnv$DE_logGeneNormalizationButtonOldVal == buttonPressed) {
    cat(file = stderr(), green(paste("\n=====changing value\n")))
    DE_logGeneNormalizationButton(buttonPressed)
    .schnappsEnv$DE_logGeneNormalizationButtonOldVal <- buttonPressed
  }
})

# observe parameters for logGene ----
observe(label = "oblogGene", {
  temp <- input$DE_geneIds_norm
  if (DEBUG) green(cat(file = stderr(), "observe DE_logGeneNormalization\n"))
  if (is.null(input$updateNormalization)) {
    if (DEBUG) cat(file = stderr(), "observe DE_logGeneNormalization, input$updateNormalization NULL\n")
    return(NULL)
  }
  if (!input$normalizationRadioButton == "DE_logGeneNormalization") {
    if (DEBUG) {
      cat(file = stderr(), paste(
        "observe DE_logGeneNormalization, input$normalizationRadioButton good",
        input$updateNormalization, "\n"
      ))
    }
    return(NULL)
  }
  if (!input$whichscLog == "calcLog") {
    return(NULL)
  }
  out <- isolate(DE_logGeneNormalization())
  
  if (is.null(out)) {
    # set one parameter to something not possible to deactivate button/or choose different
    .schnappsEnv$calculated_DE_geneIds_norm <- "NOT AVAILABLE"
  }
  
  setRedGreenButtonCurrent(
    vars = list(
      c("DE_geneIds_norm", input$DE_geneIds_norm)
    )
  )
  # Here, we create the actual button
  updateButtonColor(buttonName = "updateNormalization", parameters = c("DE_geneIds_norm"))
  # output$updateNormalizationButton <- updateButtonUI(input = input, name = "updateNormalization",
  #                                                    variables = c("DE_geneIds_norm"))
})

# observer for normalization button ----
# checks the radio button for changes.
observe(label = "ob12", {
  if (DEBUG) cat(file = stderr(), "observe normalizationRadioButton\n")
  out <- scEx_log()
  radioButtonValue <- input$normalizationRadioButton
  
  if (is.null(out)) {
    # set one parameter to something not possible to deactivate button/or choose different
    .schnappsEnv$calculated_normalizationRadioButton <- "NA"
  }
  if (DEBUG) {
    cat(file = stderr(), paste(
      "observe normalizationRadioButton: ",
      radioButtonValue, "\n"
    ))
  }
  assign("normalizationRadioButton", radioButtonValue, envir = .schnappsEnv)
  # Here, we create the actual button
  updateButtonColor(buttonName = "updateNormalization", parameters = c("normalizationRadioButton"))
  
  # output$updateNormalizationButton <- updateButtonUI(input = input, name = "updateNormalization",
  #                                                    variables = c("normalizationRadioButton"))
})
C3BI-pasteur-fr/UTechSCB-SCHNAPPs documentation built on Sept. 8, 2024, 12:44 a.m.