inst/extdata/shinyApp/server.R

options(shiny.maxRequestSize=7*1024^3, stringsAsFactors=FALSE) 

# source('~/tissue_specific_gene/function/fun.R')
# Right before submit the package the following functions will be deleted, and they will be imported as above. They are listed here now for the convenience of functionality development.

# Import internal functions.
sort_gen_con <- get('sort_gen_con', envir=asNamespace('spatialHeatmap'), inherits=FALSE)
test_ffm <- get('test_ffm', envir=asNamespace('spatialHeatmap'), inherits=FALSE)
matrix_hm <- get('matrix_hm', envir=asNamespace('spatialHeatmap'), inherits=FALSE)

# Function to extract nearest genes.
sub_na <- get('sub_na', envir=asNamespace('spatialHeatmap'), inherits=FALSE)

adj_mod <- get('adj_mod', envir=asNamespace('spatialHeatmap'), inherits=FALSE)

filter_data <- get('filter_data', envir=asNamespace('spatialHeatmap'), inherits=FALSE)

col_bar <- get('col_bar', envir=asNamespace('spatialHeatmap'), inherits=FALSE)

lay_shm <- get('lay_shm', envir=asNamespace('spatialHeatmap'), inherits=FALSE)

nod_lin <- get('nod_lin', envir=asNamespace('spatialHeatmap'), inherits=FALSE)

# Break combined path to a group (g=TRUE) or siblings (g=FALSE).
path_br <- get('path_br', envir=asNamespace('spatialHeatmap'), inherits=FALSE)

# The outline or tissue nodes are checked for combines paths. If combined paths are detected, those outside a group are broken to a group while those inside a group are broken as siblings.  
path_br_all <- get('path_br_all', envir=asNamespace('spatialHeatmap'), inherits=FALSE)

# 'a' nodes are not removed.
svg_attr <- get('svg_attr', envir=asNamespace('spatialHeatmap'), inherits=FALSE)

svg_df <- get('svg_df', envir=asNamespace('spatialHeatmap'), inherits=FALSE)

grob_list <- get('grob_list', envir=asNamespace('spatialHeatmap'), inherits=FALSE)

# Separate SHMs of grobs and ggplot. Different SHMs of same 'gene_condition' are indexed with suffixed of '_1', '_2', ...
grob_gg <- get('grob_gg', envir=asNamespace('spatialHeatmap'), inherits=FALSE)

# Subset data matrix by correlation or distance measure.
submatrix <- get('submatrix', envir=asNamespace('spatialHeatmap'), inherits=FALSE)

# Adjust legend key size and rows in ggplot.
gg_lgd <- get('gg_lgd', envir=asNamespace('spatialHeatmap'), inherits=FALSE)

# Add value keys SHMs.
gg_2lgd <- get('gg_2lgd', envir=asNamespace('spatialHeatmap'), inherits=FALSE)

# Prepare interactive SHMs in html.
html_ly <- get('html_ly', envir=asNamespace('spatialHeatmap'), inherits=FALSE)

# Make videos.
video <- get('video', envir=asNamespace('spatialHeatmap'), inherits=FALSE)

# Import input matrix.
fread.df <- function(input, isRowGene, header, sep='auto', fill, rep.aggr='mean', check.names=FALSE) {
  
  df0 <- fread(input=input, header=header, sep=sep, fill=fill)
  cna <- make.names(colnames(df0))
  if (cna[1]=='V1') cna <- cna[-1] else cna <- cna[-ncol(df0)] 
  df1 <- as.data.frame(df0); rownames(df1) <- df1[, 1]
  # Subsetting identical column names in a matrix will not trigger appending numbers.
  df1 <- as.matrix(df1[, -1]); colnames(df1) <- cna
  if(isRowGene==FALSE) df1 <- t(df1)
  cna <- colnames(df1); rna <- rownames(df1)
  
  # Isolate data and annotation.
  na <- vapply(seq_len(ncol(df1)), function(i) { tryCatch({ as.numeric(df1[, i]) }, warning=function(w) { return(rep(NA, nrow(df1))) }, error=function(e) { stop("Please make sure input data are numeric!") }) }, FUN.VALUE=numeric(nrow(df1)) )
  na <- as.data.frame(na); rownames(na) <- rna
  idx <- colSums(apply(na, 2, is.na))!=0
  gene2 <- na[!idx]; colnames(gene2) <- cna <- cna[!idx]
  gene3 <- as.data.frame(df1)[idx]
  form <- grepl("__", cna); if (sum(form)==0) { colnames(gene2) <- paste0(cna, '__', 'con'); con.na <- FALSE } else con.na <- TRUE
  if (ncol(gene3)>0) { colnames(gene3)[1] <- 'ann'; gene3 <- gene3[1] }
  if(sum(is.na(as.numeric(as.matrix(gene2))))>=1) return('Make sure all values in data matrix are numeric.')
  
  gen.rep <- gene2; rna <- rownames(gen.rep); gen.rep <-apply(gen.rep, 2, as.numeric); rownames(gen.rep) <- rna
  # Aggregate replicates.
  if (any(duplicated(cna)) & !is.null(rep.aggr)) {

    # To keep colnames, "X" should be a character, not a factor.
    if (rep.aggr=='mean') gene2 <- sapply(X=unique(cna), function(x) rowMeans(gene2[, cna==x, drop=FALSE]))
    if (rep.aggr=='median') {

      gene2 <- sapply(X=unique(cna), function(x) Biobase::rowMedians(gene2[, cna==x, drop=FALSE]))
      rownames(gene2) <- rna

    }

  }; gene2 <-apply(gene2, 2, as.numeric); rownames(gene2) <- rna 
  return(list(gene2=as.data.frame(gene2), gene3=as.data.frame(gene3), gen.rep=as.data.frame(gen.rep), con.na=con.na))

}

# Separate colour ingredients.
col_sep <- function(color) {

  color <- gsub(' |\\.|-|;|,|/', '_', color)
  color <- strsplit(color, '_')[[1]]
  color <- color[color!='']; return(color)

}

# enableWGCNAThreads()
shinyServer(function(input, output, session) {

  cfg <- reactiveValues(lis.dat=NULL, lis.dld=NULL, lis.par=NULL, na.def=NULL, dat.def=NULL, svg.def=NULL, dat.ipt=NULL, na.cus=NULL)

  observe({

    withProgress(message="Loading dependencies: ", value=0, {
    incProgress(0.3, detail="in progress...")
    library(SummarizedExperiment); library(shiny); library(shinydashboard); library(grImport); library(rsvg); library(ggplot2); 
    incProgress(0.6, detail="in progress...")
    library(DT); library(gridExtra); library(ggdendro); library(WGCNA); library(grid); library(xml2); library(plotly); library(data.table); library(genefilter); library(flashClust); library(visNetwork); 
    incProgress(0.9, detail="in progress...")
    library(reshape2); library(igraph); library(animation); library(av); library(shinyWidgets); library(yaml)
  })

    lis.cfg <- yaml.load_file('config/config.yaml')
    lis.dat <- lis.cfg[grepl('^dataset\\d+', names(lis.cfg))]
    lis.dld <- lis.cfg[grepl('download_single|download_multiple', names(lis.cfg))]
    if (is.null(input$config)) lis.par <- lis.cfg[!grepl('^dataset\\d+|download_single|download_multiple', names(lis.cfg))] else lis.par <- yaml.load_file(input$config$datapath[1])
    if (!any(lis.par$hide.legend %in% c('Yes', 'No'))) lis.par$hide.legend <- ifelse(lis.par$hide.legend==TRUE, 'Yes', 'No')
    for (i in seq_along(lis.par)) {

      lis0 <- lis.par[[i]]; if (length(lis0)>1) { 
 
        name <- default <- NULL; for (j in seq_along(lis0)) {

          pair <- strsplit(lis0[j], ':')[[1]]
          name <- c(name, pair[1]); default <- c(default, pair[2])

        }; df0 <- data.frame(name=name, default=default)
        rownames(df0) <- df0$name; lis.par[[i]] <- df0

      } 

    }
    # Separate data, svg.
    na.ipt <- dat.ipt <- svg.ipt <- NULL; for (i in lis.dat) { 
 
      na.ipt <- c(na.ipt, i$name); dat.ipt <- c(dat.ipt, i$data)
      # svg.ipt <- c(svg.ipt, i$svg); names(dat.ipt) <- names(svg.ipt) <- na.ipt
      svg.ipt <- c(svg.ipt, list(i$svg))

    }; names(dat.ipt) <- names(svg.ipt) <- na.ipt

    # Separate data, svg of default and customization. 
    na.def <- na.ipt[!grepl('^none$|^customData$|^customComputedData$', na.ipt)]
    dat.def <- dat.ipt[na.def]; svg.def <- svg.ipt[na.def]
na.cus <- c('customData', 'customComputedData')
    cfg$lis.dat <- lis.dat; cfg$lis.dld <- lis.dld; cfg$lis.par <- lis.par; cfg$na.def <- na.def; cfg$svg.def <- svg.def; cfg$dat.ipt <- dat.ipt; cfg$na.cus <- na.cus

    output$spatialHeatmap <- renderText({ lis.par$title['title', 'default'] })
    output$title.w <- renderText({ lis.par$title['width', 'default'] })
    updateSelectInput(session, 'fileIn', 'Step 1: data sets', na.ipt, lis.par$default.dataset)
    updateRadioButtons(session, inputId='dimName', label='Step 4: is column or row gene?', choices=c("None", "Row", "Column"), selected=lis.par$col.row.gene, inline=TRUE)
    # updateSelectInput(session, 'sep', 'Step 5: separator', c("None", "Tab", "Space", "Comma", "Semicolon"), lis.par$separator)
    updateNumericInput(session, inputId="A", label="Value (A) to exceed:", value=as.numeric(lis.par$data.matrix['A', 'default']))
    updateNumericInput(session, inputId="P", label="Proportion (P) of samples with values >= A:", value=as.numeric(lis.par$data.matrix['P', 'default']))
    updateNumericInput(session, inputId="CV1", label="Min coefficient of variation (CV1):", value=as.numeric(lis.par$data.matrix['CV1', 'default']))
    updateNumericInput(session, inputId="CV2", label="Max coefficient of variation (CV2):", value=as.numeric(lis.par$data.matrix['CV2', 'default']))
    updateRadioButtons(session, inputId='log', label='Log/exp:', choices=c("No", "log2", "exp2"), selected=lis.par$log.exp, inline=TRUE)
    updateRadioButtons(session, inputId='scale', label='Scale by:', choices=c('No', 'Row', 'Column'), selected=lis.par$data.matrix.scale, inline=TRUE)
    updateRadioButtons(session, inputId='hide.lgd', label="Hide legend:", choices=c('Yes', 'No'), selected=lis.par$hide.legend, inline=TRUE)
    updateRadioButtons(session, inputId='measure', label="Measure:", choices=c('correlation', 'distance'), selected=lis.par$mhm['measure', 'default'], inline=TRUE)
    updateRadioButtons(session, inputId="cor.abs", label="Cor.absolute:", choices=c('No', 'Yes'), selected=lis.par$mhm['cor.absolute', 'default'], inline=TRUE)
    updateRadioButtons(session, inputId="thr", label="Select by:", choices=c('proportion'='p', 'number'='n', 'value'='v'), selected=lis.par$mhm['select.by', 'default'], inline=TRUE)
    updateNumericInput(session, inputId='mhm.v', label='Cutoff: ', value=as.numeric(lis.par$mhm['cutoff', 'default']), min=-Inf, max=Inf, step=NA)
    updateRadioButtons(session, inputId="mat.scale", label="Scale by:", choices=c("No", "Column", "Row"), selected=lis.par$mhm['scale', 'default'], inline=TRUE)
    #updateRadioButtons(session, inputId="mhm.but", label="Show plot:", choices=c("Yes", "No"), selected=lis.par$mhm['show', 'default'], inline=TRUE)
    updateSelectInput(session, inputId="net.type", label="Network type:", choices=c('signed', 'unsigned', 'signed hybrid', 'distance'), selected=lis.par$network['net.type', 'default'])
    updateNumericInput(session, "min.size", "Minmum module size:", value=as.numeric(lis.par$network['min.size', 'default']), min=15, max=5000)
    updateSelectInput(session, "ds","Module splitting sensitivity level:", 3:2, selected=lis.par$network['ds', 'default'])
    updateTextInput(session, "color.net", "Color scheme:", lis.par$network['color', 'default'], placeholder=paste0('Eg: ', lis.par$network['color', 'default']))
    updateNumericInput(session, "max.edg", "Maximun edges (too many edges may crash the app):", value=cfg$lis.par$network['max.edges', 'default'], min=1, max=500)
  #output$edge <- renderUI({ 
   # span(style="color:black;font-weight:NULL;", HTML("Remaining edges to display (If > 300, the app might get stuck.):<br/>0"))
  #})

  })

  observe({ 

    dld.exp <- reactiveValues(sgl=NULL, mul=NULL)
    dld.exp$sgl <- cfg$lis.dld$download_single
    dld.exp$mul <- cfg$lis.dld$download_multiple

    output$dld.cfg <- downloadHandler(
      filename=function(){ "config_par.yaml" },
      content=function(file=paste0(normalizePath(tempdir(check=TRUE), winslash="/", mustWork=FALSE), '/config_par.yaml')){ 
 
        lis.cfg <- yaml.load_file('config/config.yaml')
        lis.par <- lis.cfg[c("default.dataset", "col.row.gene", "separator", "hide.legend", "data.matrix", "shm.img", "shm.anm", "shm.video", "legend", "mhm", "network")]
        write_yaml(lis.par, file)

      }
    )
    output$dld.sgl <- downloadHandler(
      filename=function(){ "single_aSVG_data.zip" },
      content=function(file=paste0(normalizePath(tempdir(check=TRUE), winslash="/", mustWork=FALSE), '/single_aSVG_data.zip')){ zip(file, c(dld.exp$sgl$data, dld.exp$sgl$svg)) }
    )
    output$dld.mul <- downloadHandler(   
      filename=function(){ "multiple_aSVG_data.zip" },
      content=function(file=paste0(normalizePath(tempdir(check=TRUE), winslash="/", mustWork=FALSE), '/multiple_aSVG_data.zip')){ zip(file, c(dld.exp$mul$data, dld.exp$mul$svg)) }
  )
  })

  # Instruction.
  output$dld <-renderUI({ includeHTML("instruction/download.html") })
  output$sum <-renderUI({ includeHTML("instruction/summary.html") })
  output$input <-renderUI({ includeHTML("instruction/input.html") })
  output$matrix <-renderUI({ includeHTML("instruction/data_matrix.html") })
  output$shm.ins <-renderUI({ includeHTML("instruction/spatial_heatmap.html") })
  output$mhm.ins <-renderUI({ includeHTML("instruction/matrix_heatmap.html") })
  output$net.ins <-renderUI({ includeHTML("instruction/network.html") })
  # Acknowledgement.
  output$ack <-renderUI({ includeHTML("instruction/acknowledgement.html") })

  # Filter parameters.
  fil <- reactiveValues(P=0, A=0, CV1=-Inf, CV2=Inf)

  observe({

    input$fileIn; input$geneInpath
    updateRadioButtons(session, inputId="dimName", label="Step 4: is column or row gene?", 
    inline=TRUE, choices=c("None", "Row", "Column"), selected="None")
    # updateSelectInput(session, 'sep', 'Step 5: separator', c("None", "Tab", "Space", "Comma", "Semicolon"), "None")
    updateRadioButtons(session, inputId='log', label='Log/exp transform:', choices=c("No", "log2", "exp2"), selected=cfg$lis.par$data.matrix['log.exp', 'default'], inline=TRUE)
    updateRadioButtons(session, 'scale', label='Scale by:', choices=c('No', 'Row', 'Column'), selected=cfg$lis.par$data.matrix['scale', 'default'], inline=TRUE)
    updateRadioButtons(session, inputId='cs.v', label='Color scale based on:', choices=c("Selected rows", "All rows"), selected=cfg$lis.par$shm.img['color.scale', 'default'], inline=TRUE)
    updateNumericInput(session, inputId="height", label="Overall height:", value=as.numeric(cfg$lis.par$shm.img['height', 'default']), min=0.1, max=Inf, step=NA)
    updateNumericInput(session, inputId="width", label="Overall width:", value=as.numeric(cfg$lis.par$shm.img['width', 'default']), min=0.1, max=Inf, step=NA)
    updateNumericInput(session, inputId="col.n", label="Columns:", value=as.numeric(cfg$lis.par$shm.img['columns', 'default']), min=1, max=Inf, step=1)

  })

  observe({

    input$fileIn; input$geneInpath; input$log
    updateNumericInput(session, inputId="A", label="Value (A) to exceed:", value=as.numeric(cfg$lis.par$data.matrix['A', 'default'])) 
    updateNumericInput(session, inputId="P", label="Proportion (P) of samples with values >= A:", value=as.numeric(cfg$lis.par$data.matrix['P', 'default']), min=0, max=1)
    updateNumericInput(session, inputId="CV1", label="Min coefficient of variation (CV1):", value=as.numeric(cfg$lis.par$data.matrix['CV1', 'default']))
    updateNumericInput(session, inputId="CV2", label="Max coefficient of variation (CV2):", value=as.numeric(cfg$lis.par$data.matrix['CV2', 'default'])) 
    fil$P <- 0; fil$A <- 0; fil$CV1 <- -Inf; fil$CV2 <- Inf

  })

  observeEvent(input$fil.but, {

    if (input$fileIn=="none") return(NULL)  
    fil$P <- input$P; fil$A <- input$A; fil$CV1 <- input$CV1; fil$CV2 <- input$CV2
  
  })

  output$fil.par <- renderText({
    
    if (input$fileIn=="none") return(NULL)  
    P <- input$P
    validate(need(try(P<=1 & P>=0), 'P should be between 0 to 1 !'))

  })

  geneIn0 <- reactive({

    if (input$fileIn=="none") return(NULL)
    withProgress(message="Loading data: ", value = 0, {
    if (any(input$fileIn %in% cfg$na.def)) {

      incProgress(0.5, detail="Loading matrix. Please wait.")
      df.te <- fread.df(input=cfg$dat.ipt[input$fileIn], isRowGene=TRUE, header=TRUE, fill=TRUE); return(df.te)

    }

    if (any(input$fileIn %in% cfg$na.cus) & 
    !is.null(input$geneInpath) & input$dimName!="None") {

      incProgress(0.25, detail="Importing matrix. Please wait.")
      geneInpath <- input$geneInpath
      #if (input$sep=="Tab") sep <- "\t" else if (input$sep=="Space") sep <- " " else if (input$sep=="Comma") sep <- "," else if (input$sep=="Semicolon") sep <- ";"
      df.upl <- fread.df(input=geneInpath$datapath, isRowGene=(input$dimName=='Row'), header=TRUE, fill=TRUE, rep.aggr='mean'); return(df.upl)
   
    }

    })

  })

  # Transform data.
  geneIn1 <- reactive({

    if (is.null(geneIn0())|is.null(input$scale)) return(NULL)
    gene1 <- gene2 <- geneIn0()[['gene2']] 
    if (input$log=='log2') {
   
      g.min <- min(gene2)
      if (g.min<0) gene2 <- gene2-g.min+1; if (g.min==0) gene2 <- gene2+1; gene2 <- log2(gene2)

    }; if (input$log=='exp2') gene2 <- 2^gene2
    # Scale by row/column
    if (input$scale=='Row') { gene2 <- t(scale(t(gene2))) } else if (input$scale=='Column') { gene2 <- scale(gene2) }

    gene3 <- geneIn0()[['gene3']]; gen.rep <- geneIn0()[['gen.rep']]
    return(list(gene1=gene1, gene2=gene2, gene3=gene3, gen.rep=gen.rep))

  })

  output$col.order <- renderUI({

    if (is.null(geneIn1())) return()
    col.nas <- colnames(geneIn1()[['gene2']])
    dropdownButton(inputId='dropdown', label='Re-order columns', circle=FALSE, icon=NULL, status='primary',
    actionButton("col.cfm", "Confirm", icon=icon("refresh")), 
    selectizeInput(inputId="col.na", label='', choices=col.nas, selected=col.nas, multiple=TRUE, options= list(plugins=list('remove_button', 'drag_drop')))
    )
  
  })
  sear <- reactiveValues(id=NULL)
  observeEvent(input$fileIn, { sear$id <- NULL })
  observeEvent(input$search.but, {
    
    if (is.null(geneIn1())) return()
    if (input$search=='') sel <- as.numeric(cfg$lis.par$data.matrix['row.selected', 'default']) else {

      gens <- strsplit(gsub(' |,', '_', input$search), '_')[[1]]
      pat <- paste0('^', gens, '$', collapse='|')
      sel <- which(grepl(pat, x=rownames(geneIn1()[['gene2']]), ignore.case=TRUE, perl=TRUE))
      if (length(sel)==0) sel <- as.numeric(cfg$lis.par$data.matrix['row.selected', 'default'])

     }; sear$id <- sel

  })
  geneIn <- reactive({
    
    if (is.null(geneIn1())) return(NULL)    
    gene1 <- geneIn1()[['gene1']]; gene2 <- geneIn1()[['gene2']]; gene3 <- geneIn1()[['gene3']]; input$fil.but
    if (!identical(sort(input$col.na), sort(colnames(gene2)))) return()
    # Input variables in "isolate" will not triger re-excution, but if the whole reactive object is trigered by "input$fil.but" then code inside "isolate" will re-excute.
    isolate({
  
      se <- SummarizedExperiment(assays=list(expr=as.matrix(gene2)), rowData=gene3)
      if (ncol(gene3)>0) ann.col <- colnames(gene3)[1] else ann.col <- NULL
      # If scaled by row, sd is 1, mean is 0, cv is Inf.
      se <- filter_data(data=se, ann=ann.col, sam.factor=NULL, con.factor=NULL, pOA=c(fil$P, fil$A), CV=c(ifelse(input$scale=='Row', -Inf, fil$CV1), ifelse(input$scale=='Row', Inf, fil$CV2)), dir=NULL)
      if (nrow(se)==0) { validate(need(try(nrow(se)>0), 'All rows are filtered out!')); return() }
      # In case of all rows are filtered, the app continues to work without refreshing after the filter parameters are reduced.
      se <- filter_data(data=se, ann=ann.col, sam.factor=NULL, con.factor=NULL, pOA=c(fil$P, fil$A), CV=c(ifelse(input$scale=='Row', -Inf, fil$CV1), ifelse(input$scale=='Row', Inf, fil$CV2)), dir=NULL)

      gene2 <- as.data.frame(assay(se), stringsAsfactors=FALSE); colnames(gene2) <- make.names(colnames(gene2))
      gene1 <- gene1[rownames(gene2), ]
      gene3 <- as.data.frame(rowData(se))[, , drop=FALSE]
      
    })
    cat('Preparing data matrix... \n')
    if (is.null(sear$id)) rows <- seq_len(nrow(gene2)) else rows <- sear$id
    if (length(rows)==1 & rows[1]==as.numeric(cfg$lis.par$data.matrix['row.selected', 'default'])) rows <- seq_len(nrow(gene2))
    return(list(gene1=gene1[rows, input$col.na], gene2=gene2[rows, input$col.na], gene3=gene3[rows, , drop=FALSE]))

  })
  output$dt <- renderDataTable({

    if (is.null(geneIn())) return()
    if ((any(input$fileIn %in% cfg$na.cus) & is.null(geneIn()))|input$fileIn=="none") return(NULL)

    withProgress(message="Data table: ", value = 0, {

      incProgress(0.5, detail="Displaying. Please wait.")
      if (input$fileIn!="none") {

      gene <- geneIn(); gene.dt <- cbind.data.frame(gene[["gene2"]][, , drop=FALSE], gene[["gene3"]][, , drop=FALSE], stringsAsFactors=FALSE) 

   }; cat('Presenting data matrix... \n')
   if (is.null(sear$id)) sel <- as.numeric(cfg$lis.par$data.matrix['row.selected', 'default']) else sel <- sear$id
   if (length(sel)==1 & sel[1]==as.numeric(cfg$lis.par$data.matrix['row.selected', 'default']) & nrow(gene.dt)>1) sel <- sel else if (nrow(gene.dt)==1)  sel <- 1 else if (length(sel)>1) sel <- seq_along(sel)

   datatable(gene.dt, selection=list(mode="multiple", target="row", selected=sel),
   filter="top", extensions=c('Scroller'), options=list(pageLength=5, lengthMenu=c(5, 15, 20), autoWidth=TRUE, scrollCollapse=TRUE, deferRender=TRUE, scrollX=TRUE, scrollY=200, scroller=TRUE, searchHighlight=FALSE, search=list(regex=TRUE, smart=FALSE, caseInsensitive=TRUE), searching=FALSE), class='cell-border strip hover') %>% formatStyle(0, backgroundColor="orange", cursor='pointer') %>% 
    formatRound(colnames(geneIn()[["gene2"]]), 2)

    })

  })

  gID <- reactiveValues(geneID="none", new=NULL, all=NULL)
  observe({ input$geneInpath; input$fileIn; gID$geneID <- "none" })
  observe({ if (is.null(geneIn())) gID$geneID <- "none" })
  # To make the "gID$new" and "gID$all" updated with the new "input$fileIn", since the selected row is fixed (3rd row), the "gID$new" is not updated when "input$fileIn" is changed, and the downstream is not updated either. The shoot/root examples use the same data matrix, so the "gID$all" is the same (pre-selected 3rd row) when change from the default "shoot" to others like "organ". As a result, the "gene$new" is null and downstream is not updated. Also the "gene$new" is the same when change from shoot to organ, and downstream is not updated, thus "gene$new" and "gene$all" are both set NULL above upon new "input$fileIn".  
  observeEvent(input$fileIn, {

    if (is.null(input$dt_rows_selected)) return()
    gID$all <- gID$new <- NULL
    r.na <- rownames(geneIn()[["gene2"]]); gID$geneID <- r.na[input$dt_rows_selected]
    # Avoid multiple selected rows from last input$fileIn. Must be behind gID$geneID. 
    if (length(input$dt_rows_selected)>1) return()
    gID$new <- setdiff(gID$geneID, gID$all); gID$all <- c(gID$all, gID$new)
    if (is.null(r.na)) gID$geneID <- "none"
    })
  observeEvent(list(input$dt_rows_selected, geneIn()), {
 
    if (is.null(input$dt_rows_selected)) return()
    r.na <- rownames(geneIn()[["gene2"]]); gID$geneID <- r.na[input$dt_rows_selected]
    if (any(is.na(gID$geneID))) gID$geneID <- "none"
    gID$new <- setdiff(gID$geneID, gID$all); gID$all <- c(gID$all, gID$new)
    
  })
  observeEvent(list(input$search.but), {
  
    if (is.null(input$search.but)|is.null(sear$id)|is.null(geneIn())) return()
    gID$geneID <- rownames(geneIn()[["gene2"]])[sear$id]
    if (any(is.na(gID$geneID))) gID$geneID <- "none"
 
  })

  geneV <- reactive({

    if (any(is.na(gID$geneID))) return()
    if (is.null(geneIn())|sum(gID$geneID[1]!='none')==0) return(NULL)
    if (input$cs.v=="Selected rows" & is.null(input$dt_rows_selected)) return(NULL)
    if (input$fileIn!="none") { if (input$cs.v=="Selected rows") gene <- geneIn()[["gene2"]][gID$geneID, ]
    if (input$cs.v=="w.mat") gene <- geneIn()[["gene2"]] }
    seq(min(gene), max(gene), len=1000) # len must be same with that from the function "spatial_hm()". Otherwise the mapping of a gene value to the colour bar is not accurate. 

  })

  col.sch <- reactive({ 

    if(input$color=="") return(NULL)
    col <- gsub(' |\\.|-|;|,|/', '_', input$color)
    col <- strsplit(col, '_')[[1]]
    col <- col[col!='']; col1 <- col[!col %in% colors()]
    if (length(col1>0)) validate(need(try(col1 %in% colors()), paste0('Colors not valid: ', col1, ' !'))); col

  })
  
  color <- reactiveValues(col="none")
  observe({
    
    if (is.null(input$col.but)) return()
    if(input$col.but==0) color$col <- colorRampPalette(col_sep(cfg$lis.par$shm.img['color', 'default']))(length(geneV()))

  })
  # As long as a button is used, observeEvent should be used. All variables inside 'observeEvent' trigger code evaluation, not only 'eventExpr'.  
  observeEvent(input$col.but, {

    if (is.null(col.sch())) return (NULL)
    if (input$fileIn!="none") { color$col <- colorRampPalette(col.sch())(length(geneV())) }

  })

  shm.bar <- reactive({

    if (is.null(gID$all)) return(NULL)
    if ((any(input$fileIn %in% cfg$na.def) & !is.null(geneIn()))|(any(input$fileIn %in% cfg$na.cus) & (!is.null(input$svgInpath)|!is.null(input$svgInpath1)) & !is.null(geneIn()))) {

      if (length(color$col=="none")==0|input$color==""|is.null(geneV())) return(NULL)

      withProgress(message="Color scale: ", value = 0, {

        incProgress(0.75, detail="Plotting. Please wait.")
        cat('Colour key... \n')
        cs.g <- col_bar(geneV=geneV(), cols=color$col, width=1); return(cs.g)

      })

    }

  })
  # One output can only be used once in ui.R.
  output$bar1 <- renderPlot({ if (!is.null(shm.bar)) shm.bar() })
  output$bar2 <- renderPlot({ if (!is.null(shm.bar)) shm.bar() })

  observe({

    if (is.null(geneIn())) return(NULL)
    r.na <- rownames(geneIn()[["gene2"]]); gens.sel <- r.na[input$dt_rows_selected]
    if (length(gens.sel)==0) return()
    updateSelectInput(session, inputId="gen.sel", label="Select a target gene:", choices=c("None", gens.sel), selected=gens.sel[1])

  })

  svg.path <- reactive({

    if (input$fileIn=='none') return()
    if (any(input$fileIn %in% cfg$na.cus)) {

      if (is.null(input$svgInpath1)) svgIn.df <- input$svgInpath else svgIn.df <- input$svgInpath1
      svg.path <- svgIn.df$datapath; svg.na <- svgIn.df$name

    } else { 

      svg.path <- cfg$svg.def[[input$fileIn]]
      svg.na <- NULL; for (i in svg.path) {
      
        str <- strsplit(i, '/')[[1]]; svg.na <- c(svg.na, str[length(str)])

      }

    }
    if (length(svg.na)>1) {

      validate(need(try(all(grepl('_shm\\d+\\.svg$', svg.na, perl=TRUE))), "Suffixes of aSVGs should be indexed as '_shm1.svg', '_shm2.svg', '_shm3i.svg', ..."))
      ord <- order(gsub('.*_(shm.*)$', '\\1', svg.na))
      svg.path <- svg.path[ord]; svg.na <- svg.na[ord]
    
    }; cat('Access aSVG path... \n')
    return(list(svg.path=svg.path, svg.na=svg.na))

  })

  sam <- reactive({ 

    cname <- colnames(geneIn()[["gene2"]]); idx <- grep("__", cname); c.na <- cname[idx]
    if (length(grep("__", c.na))>=1) gsub("(.*)(__)(.*$)", "\\1", c.na) else return(NULL) 

  })
  
  svg.df <- reactive({ 

    if ((any(input$fileIn %in% cfg$na.cus) & 
    (!is.null(input$svgInpath)|!is.null(input$svgInpath1)))|(any(input$fileIn %in% cfg$na.def) & is.null(input$svgInpath))) {

      withProgress(message="Tissue heatmap: ", value=0, {
    
        incProgress(0.5, detail="Extracting coordinates. Please wait.") 
          svg.path <- svg.path()[['svg.path']]
          svg.na <- svg.path()[['svg.na']]; svg.df.lis <- NULL
          # Whether a single or multiple SVGs, all are returned in a list.
          for (i in seq_along(svg.na)) {
         
            cat('Coordinate:', svg.na[i], '\n')
            df_tis <- svg_df(svg.path=svg.path[i], feature=sam())
            validate(need(!is.character(df_tis), paste0(svg.na[i], ': ', df_tis)))
            svg.df.lis <- c(svg.df.lis, list(df_tis))
   
          }; names(svg.df.lis) <- svg.na; 
         return(svg.df.lis)

      })

    }

  })


  observe({

    input$fileIn; geneIn(); input$adj.modInpath; svg.df(); input$hide.lgd 
    tis.tran <- NULL; for (i in seq_along(svg.df())) { tis.tran <- c(tis.tran, svg.df()[[i]][['tis.path']]) }
    updateCheckboxGroupInput(session, inputId="tis", label='Select tissues to be transparent:', choices=intersect(unique(sam()), unique(tis.tran)), selected='', inline=TRUE)

  })

  con <- reactive({ 

    cname <- colnames(geneIn()[["gene2"]]); idx <- grep("__", cname); c.na <- cname[idx]
    if (length(grep("__", c.na))>=1) gsub("(.*)(__)(.*$)", "\\3", c.na) else return(NULL) 

  })

  # General selected gene/condition pattern.
  pat.con <- reactive({ con.uni <- unique(con()); if (is.null(con.uni)) return(NULL); paste0(con.uni, collapse='|') })
  pat.gen <- reactive({ if (is.null(gID$geneID)) return(); if (gID$geneID[1]=='none') return(NULL);  paste0(gID$geneID, collapse='|') })
  pat.all <- reactive({ if (is.null(pat.con())|is.null(pat.gen())) return(NULL); paste0('(', pat.gen(), ')_(', pat.con(), ')') })

  grob <- reactiveValues(all=NULL, all1=NULL, gg.all=NULL, gg.all1=NULL, lgd.all=NULL)
  observeEvent(input$fileIn, { grob$all <- grob$gg.all1 <- grob$gg.all1 <- grob$gg.all <- grob$lgd.all <- NULL })
  # Avoid repetitive computation under input$cs.v=='w.mat'.
  gs.new <- reactive({ 

    if.con <- is.null(svg.df())|is.null(geneIn())|is.null(gID$new)|length(gID$new)==0|is.null(gID$all)|is.null(input$dt_rows_selected)|color$col[1]=='none'
    if (length(if.con==FALSE)==0) if (length(if.con)==0) return(); if (is.na(if.con)|if.con==TRUE) return(NULL)

    if (input$cs.v=="Selected rows") ID <- gID$geneID
    if (input$cs.v=="w.mat") ID <- gID$new
    if (is.null(ID)|length(gID$new)>1|length(ID)>1|ID[1]=='none') return()
    # Avoid repetitive computation.  
    pat.new <- paste0('^', gID$new, '_(', pat.con(), ')_\\d+$')
    if (any(grepl(pat.new, names(grob$all)))) return()
    withProgress(message="Tissue heatmap: ", value=0, {
 
      incProgress(0.25, detail="preparing data.")
      gene <- geneIn()[["gene2"]]
      svg.df.lis <- svg.df(); grob.lis.all <- w.h.all <- NULL
      # Get max width/height of multiple SVGs, and dimensions of other SVGs can be set relative to this max width/height.
      for (i in seq_along(svg.df.lis)) { w.h.all <- c(w.h.all, svg.df.lis[[i]][['w.h']]); w.h.max <- max(w.h.all) }
      # A set of SHMs are made for each SVG, and all sets of SHMs are placed in a list.
      svg.na <- names(svg.df.lis)
      for (i in seq_along(svg.df.lis)) {

        svg.df <- svg.df.lis[[i]]; g.df <- svg.df[["df"]]; w.h <- svg.df[['w.h']]
        tis.path <- svg.df[["tis.path"]]; fil.cols <- svg.df[['fil.cols']]
        if (input$pre.scale=='Yes') mar <- (1-w.h/w.h.max*0.99)/2 else mar <- NULL
        cat('New grob/ggplot:', ID, ' \n')
        grob.lis <- grob_list(gene=gene, con.na=geneIn0()[['con.na']], geneV=geneV(), coord=g.df, ID=ID, legend.col=fil.cols, cols=color$col, tis.path=tis.path, tis.trans=input$tis, sub.title.size=18, mar.lb=mar, legend.nrow=2, legend.key.size=0.04, line.size=input$line.size, line.color=input$line.color) # Only gID$new is used.
        validate(need(!is.null(grob.lis), paste0(svg.na[i], ': no spatial features that have matching sample identifiers in data are detected!')))
        grob.lis.all <- c(grob.lis.all, list(grob.lis))

      }; names(grob.lis.all) <- svg.na; return(grob.lis.all)

    })

  })

  # Extension of 'observeEvent': any of 'input$log; input$tis; input$col.but; input$cs.v' causes evaluation of all code. 
  # input$tis as an argument in "grob_list" will not cause evaluation of all code, thus it is listed here.
  # Use "observeEvent" to replace "observe" and list events (input$log, input$tis, ...), since if the events are in "observe", every time a new gene is clicked, "input$dt_rows_selected" causes the evaluation of all code in "observe", and the evaluation is duplicated with "gs.new".
  col.reorder <- reactiveValues(col.re='Y')
  observeEvent(input$col.na, { if (input$col.cfm>0) col.reorder$col.re <- 'N' })
  observeEvent(list(input$log, input$tis, input$col.but, input$cs.v, input$pre.scale, input$col.cfm, input$scale, input$line.size, input$line.color), {
    
    grob$all <- grob$gg.all <- grob$lgd.all <- NULL; gs.all <- reactive({ 

      if.con <- is.null(svg.df())|is.null(geneIn())|is.null(input$dt_rows_selected)|color$col[1]=='none'|is.null(input$pre.scale)|gID$geneID[1]=='none'

      if (length(if.con==FALSE)==0) if (length(if.con)==0) return(); if (is.na(if.con)|if.con==TRUE) return(NULL)
      withProgress(message="Spatial heatmap: ", value=0, {
      incProgress(0.25, detail="preparing data.")
      #if (input$cs.v=="Selected rows") gene <- geneIn()[["gene2"]][input$dt_rows_selected, ]
      #if (input$cs.v=="w.mat") gene <- geneIn()[["gene2"]]
      gene <- geneIn()[["gene2"]][gID$geneID, ]
      svg.df.lis <- svg.df(); grob.lis.all <- w.h.all <- NULL
      # Get max width/height of multiple SVGs, and dimensions of other SVGs can be set relative to this max width/height.
      for (i in seq_along(svg.df.lis)) { w.h.all <- c(w.h.all, svg.df.lis[[i]][['w.h']]); w.h.max <- max(w.h.all) }
      # A set of SHMs are made for each SVG, and all sets of SHMs are placed in a list.
      for (i in seq_along(svg.df.lis)) {

        svg.df <- svg.df.lis[[i]]; g.df <- svg.df[["df"]]
        tis.path <- svg.df[["tis.path"]]; fil.cols <- svg.df[['fil.cols']]; w.h <- svg.df[['w.h']]
        if (input$pre.scale=='Yes') mar <- (1-w.h/w.h.max*0.99)/2 else mar <- NULL
        cat('All grob/ggplot:', gID$geneID, ' \n')
        svg.na <- names(svg.df.lis)
        incProgress(0.75, detail=paste0('preparing ', paste0(gID$geneID, collapse=';')))
        grob.lis <- grob_list(gene=gene, con.na=geneIn0()[['con.na']], geneV=geneV(), coord=g.df, ID=gID$geneID, legend.col=fil.cols, cols=color$col, tis.path=tis.path, tis.trans=input$tis, sub.title.size=18, mar.lb=mar, legend.nrow=2, legend.key.size=0.04, line.size=input$line.size, line.color=input$line.color) # All gene IDs are used.
        validate(need(!is.null(grob.lis), paste0(svg.na[i], ': no spatial features that have matching sample identifiers in data are detected!')))
        grob.lis.all <- c(grob.lis.all, list(grob.lis))

      }; names(grob.lis.all) <- svg.na; return(grob.lis.all)

      })

    }); grob.gg.lis <- grob_gg(gs=gs.all())
    grob$all <- grob.gg.lis[['grob']]; grob$gg.all <- grob.gg.lis[['gg']]; grob$lgd.all <- grob.gg.lis[['lgd.all']]

  })
  # Avoid repetitive computation under input$cs.v=='gen.sel'.
  observeEvent(list(gID$geneID), {
    
    if.con <-  is.null(input$cs.v)|gID$geneID[1]=='none'|input$cs.v=='w.mat'

    if (length(if.con==FALSE)==0) if (length(if.con)==0) return(); if (is.na(if.con)|if.con==TRUE) return(NULL)
    ID <- gID$geneID
    grob$all <- grob$gg.all <- grob$lgd.all <- NULL; gs.all <- reactive({ 

      if.con <- is.null(svg.df())|is.null(geneIn())|is.null(input$dt_rows_selected)|color$col[1]=='none'|is.null(input$pre.scale)
      if (length(if.con==FALSE)==0) if (length(if.con)==0) return(); if (is.na(if.con)|if.con==TRUE) return(NULL)
      withProgress(message="Spatial heatmap: ", value=0, {
      incProgress(0.25, detail="preparing data.")
      gene <- geneIn()[["gene2"]][gID$geneID, ]
      svg.df.lis <- svg.df(); grob.lis.all <- w.h.all <- NULL
      # Get max width/height of multiple SVGs, and dimensions of other SVGs can be set relative to this max width/height.
      for (i in seq_along(svg.df.lis)) { w.h.all <- c(w.h.all, svg.df.lis[[i]][['w.h']]); w.h.max <- max(w.h.all) }
      # A set of SHMs are made for each SVG, and all sets of SHMs are placed in a list.
      for (i in seq_along(svg.df.lis)) {

        svg.df <- svg.df.lis[[i]]; g.df <- svg.df[["df"]]
        tis.path <- svg.df[["tis.path"]]; fil.cols <- svg.df[['fil.cols']]; w.h <- svg.df[['w.h']]
        if (input$pre.scale=='Yes') mar <- (1-w.h/w.h.max*0.99)/2 else mar <- NULL
        cat('All grob/ggplot of row selection:', ID, ' \n')
        svg.na <- names(svg.df.lis)
        incProgress(0.75, detail=paste0('preparing ', paste0(ID, collapse=';')))
        grob.lis <- grob_list(gene=gene, con.na=geneIn0()[['con.na']], geneV=geneV(), coord=g.df, ID=ID, legend.col=fil.cols, cols=color$col, tis.path=tis.path, tis.trans=input$tis, sub.title.size=18, mar.lb=mar, legend.nrow=2, legend.key.size=0.04, line.size=input$line.size, line.color=input$line.color) # All gene IDs are used.
        validate(need(!is.null(grob.lis), paste0(svg.na[i], ': no spatial features that have matching sample identifiers in data are detected!')))
        grob.lis.all <- c(grob.lis.all, list(grob.lis))

      }; names(grob.lis.all) <- svg.na; return(grob.lis.all)

      })

    }); grob.gg.lis <- grob_gg(gs=gs.all())
    grob$all <- grob.gg.lis[['grob']]; grob$gg.all <- grob.gg.lis[['gg']]; grob$lgd.all <- grob.gg.lis[['lgd.all']]

  })
  # when 'color <- reactiveValues(col="none")', upon the app is launched, 'gs.new' is evaluated for 3 time. In the 1st time, 'gID$new'/'gID$all' are NULL, so 'gs.new' is NULL. In the 2nd time, 'color$col[1]=='none'' is TRUE, so NULL is returned to 'gs.new', but 'gID$new'/'gID$all' are 'HRE2'. In the third time, 'color$col[1]=='none'' is FALSE, so 'gs.new' is not NULL, but 'gID$new' is still 'HRE2', so it does not triger evaluation of 'observeEvent' and hence SHMs and legend plot are not returned upon being launched. The solution is to assign colors to 'color$col' in 'observe' upon being launched so that in the 2nd time 'gs.new' is not NULL, and no 3rd time.
  observeEvent(gs.new(), { 

    if (is.null(svg.df())|is.null(gID$new)|length(gID$new)==0|is.null(gID$all)|is.null(gs.new())) return(NULL)
    cat('Updating grobs/ggplots/lgds... \n')
    grob.gg.lis <- grob_gg(gs=gs.new())
    grobs <- grob.gg.lis[['grob']]
    grob.rm <- !names(grob$all) %in% names(grobs)
    grob$all <- c(grob$all[grob.rm], grobs)
    ggs <- grob.gg.lis[['gg']]
    gg.rm <- !names(grob$gg.all) %in% names(ggs)
    grob$gg.all <- c(grob$gg.all[gg.rm], ggs) 
    lgd0 <- grob.gg.lis[['lgd.all']]
    grob$lgd.all <- c(grob$lgd.all, lgd0[!names(lgd0) %in% names(grob$lgd.all)])
  
  })
 
  output$h.w.c <- renderText({
    
    if (is.null(geneIn())|is.null(input$dt_rows_selected)|is.null(svg.df())|is.null(grob$all)) return(NULL)

    height <- input$height; width <- input$width
    col.n <- input$col.n;
    validate(need(height>=0.1 & !is.na(height), 'Height should be a positive numeric !'))
    validate(need(width>=0.1 & !is.na(width), 'Width should be a positive numeric !'))
    validate(need(col.n>=1 & as.integer(col.n)==col.n & !is.na(col.n), 'No. of columns should be a positive integer !'))

  })
  observeEvent(list(input$lgd.key.size, input$lgd.row, input$tis, input$lgd.label, input$lgd.lab.size), {

    lgd.key.size <- input$lgd.key.size; lgd.row <- input$lgd.row
    lgd.label <- input$lgd.label; label.size <- input$lgd.lab.size
    if (is.null(grob$lgd.all)|is.null(lgd.key.size)|is.null(lgd.row)|is.null(lgd.label)) return()
    cat('Adjust legend size/rows... \n')
    grob$lgd.all <- gg_lgd(gg.all=grob$lgd.all, size.key=lgd.key.size, size.text.key=NULL, row=lgd.row, sam.dat=sam(), tis.trans=input$tis, position.text.key='right', label=(lgd.label=='Yes'), label.size=label.size)
  
  })
  observeEvent(list(grob.all=grob$all, gen.con=input$gen.con), {
  
    if (is.null(gID$all)|is.null(grob$all)|is.null(grob$gg.all)) return()
    cat('Reordering grobs/ggplots... \n')
    na.all <- names(grob$all); pat.all <- paste0('^', pat.all(), '(_\\d+$)')
    # Indexed cons with '_1', '_2', ... at the end.
    con <- unique(gsub(pat.all, '\\2\\3', na.all)); if (length(con)==0) return()
    na.all <- sort_gen_con(ID.sel=gID$all, na.all=na.all, con.all=con, by=input$gen.con)
    grob$all1 <- grob$all[na.all]; grob$gg.all1 <- grob$gg.all[na.all]

  })
  # Add value legend to SHMs.
  # 'observeEvent' is able to avoid infinite cycles while 'observe' may cause such cycles. E.g. in the latter, 'is.null(grob$gg.all)' and 'grob$gg.all1 <- gg.all <- gg_2lgd()' would induce each other and form infinit circles.
  observe({


  })
  observeEvent(list(val.lgd=input$val.lgd, row=input$val.lgd.row, key=input$val.lgd.key, text=input$val.lgd.text, feat=input$val.lgd.feat), {
    
    validate(need(try(as.integer(input$val.lgd.row)==input$val.lgd.row & input$val.lgd.row>0), 'Legend key rows should be a positive integer!'))
    validate(need(try(input$val.lgd.key>0), 'Legend key size should be a positive numeric!'))
    validate(need(try(input$val.lgd.text>0), 'Legend text size should be a positive numeric!'))
    
    cat('Adding value legend... \n')
    if.con <- is.null(grob$gg.all)|is.null(sam())|is.null(input$val.lgd)|is.null(input$val.lgd.feat)|input$val.lgd==0
    if (length(if.con==FALSE)==0) if (length(if.con)==0) return(); if (is.na(if.con)|if.con==TRUE) return(NULL)
    gg.all <- grob$gg.all1
    if ((input$val.lgd %% 2)==1) {

      gg.all <- gg_2lgd(gg.all=gg.all, sam.dat=sam(), tis.trans=input$tis, position.2nd='bottom', legend.nrow.2nd=input$val.lgd.row, legend.key.size.2nd=input$val.lgd.key, legend.text.size.2nd=input$val.lgd.text, add.feature.2nd=(input$val.lgd.feat=='Yes'))
      grob$all1 <- gg.all <- lapply(gg.all, function(x) { x+theme(legend.position="bottom") } )
      tmp <- normalizePath(tempfile(), winslash='/', mustWork=FALSE)
      png(tmp); grob$all1 <- lapply(gg.all, ggplotGrob)
      dev.off(); if (file.exists(tmp)) do.call(file.remove, list(tmp))
    
    } else if ((input$val.lgd %% 2)==0) { 

      cat('Remove value legend... \n')
      grob$gg.all1 <- gg.all <- lapply(gg.all, function(x) { x+theme(legend.position="none") })
      tmp <- normalizePath(tempfile(), winslash='/', mustWork=FALSE); png(tmp); grob$all1 <- lapply(gg.all, ggplotGrob) 
      dev.off(); if (file.exists(tmp)) do.call(file.remove, list(tmp))

    }

  })

  observeEvent(input$col.cfm, { col.reorder$col.re <- 'Y' })
  # In "observe" and "observeEvent", if one code return (NULL), then all the following code stops. If one code changes, all the code renews.
  observe({
 
    if.con <- is.null(geneIn())|is.null(input$dt_rows_selected)|is.null(svg.df())|gID$geneID[1]=="none"|is.null(grob$all1)
    if (length(if.con==FALSE)==0) if (length(if.con)==0) return(); if (is.na(if.con)|if.con==TRUE) return(NULL)
    
    output$shm <- renderPlot(width=as.numeric(input$width)/2*as.numeric(input$col.n), height=as.numeric(input$height)*length(input$dt_rows_selected), {
    
    if (col.reorder$col.re=='N') return()
    if.con <-  is.null(input$dt_rows_selected)|is.null(svg.df())|gID$geneID[1]=="none"|is.null(grob$all1)
    if (length(if.con==FALSE)==0) if (length(if.con)==0) return(); if (is.na(if.con)|if.con==TRUE) return(NULL)
    if (is.na(color$col[1])|length(color$col=="none")==0|input$color=="") return(NULL)
    r.na <- rownames(geneIn()[["gene2"]])
    grob.na <- names(grob$all1)
    # Select target grobs.
    # Use definite patterns and avoid using '.*' as much as possible. Try to as specific as possible.
    pat.all <- paste0('^', pat.all(), '(_\\d+$)')
    grob.lis.p <- grob$all1[grepl(pat.all, grob.na)] # grob.lis.p <- grob.lis.p[unique(names(grob.lis.p))]
    # Indexed cons with '_1', '_2', ... at the end.
    con <- unique(gsub(pat.all, '\\2\\3', names(grob.lis.p))); if (length(con)==0) return()
    cat('Plotting spatial heatmaps... \n')
    lay <- input$gen.con; ID <- gID$geneID; ncol <- input$col.n
    shm.lay <- lay_shm(lay.shm=lay, con=con, ncol=ncol, ID.sel=ID, grob.list=grob.lis.p, width=input$width, height=input$height, shiny=TRUE); shm <- shm.lay$shm
    # Adjust the dimension in chicken example. 
    #svg.df <- svg.df(); w.all <- h.all <- 0
    # for (i in svg.df) { w.all <- w.all+i$w.h['width']; h.all <- h.all+i$w.h['height'] }
    #shm.row <- nrow(shm.lay$lay)
    #if (length(svg.df)==1) updateNumericInput(session, inputId="height", label="Overall height:", value=as.numeric(h.all/w.all*shm.row*input$width), min=0.1, max=Inf, step=NA)
    if (input$ext!='NA') {
      
      validate(need(try(input$res>0), 'Resolution should be a positive numeric!'))
      validate(need(try(input$lgd.w>=0 & input$lgd.w <1), 'Legend width should be between 0 to 1!'))
      validate(need(try(input$lgd.ratio>0), 'Legend aspect ratio should be a positive numeric!'))
      cs.grob <- ggplotGrob(shm.bar())
      cs.arr <- arrangeGrob(grobs=list(grobTree(cs.grob)), layout_matrix=cbind(1), widths=unit(1, "npc"))
      # Legend size in downloaded SHM is reduced.
      lgd.lis <- grob$lgd.all; lgd.lis <- gg_lgd(gg.all=lgd.lis, sam.dat=sam(), tis.trans=input$tis, label=FALSE)
      lgd.lis <- gg_lgd(gg.all=lgd.lis, size.key=input$lgd.key.size*0.5, size.text.key=NULL, label.size=input$lgd.lab.size, row=input$lgd.row, sam.dat=sam(), tis.trans=input$tis, position.text.key='right', label=(input$lgd.label=='Yes'))
      if (input$lgd.w>0) {
  
        grob.lgd.lis <- lapply(lgd.lis, ggplotGrob)
        lgd.tr <- lapply(grob.lgd.lis, grobTree)
    # In 'arrangeGrob', if numbers in 'layout_matrix' are more than items in 'grobs', there is no difference. The width/height of each subplot is decided by 'widths' and 'heights'.
    lgd.arr <- arrangeGrob(grobs=lgd.tr, layout_matrix=matrix(seq_along(lgd.lis), ncol=1), widths=unit(1, "npc"), heights=unit(rep(1/length(lgd.lis)/input$lgd.ratio, length(lgd.lis)), "npc"))
    w.lgd <- (1-0.08)/(ncol+1)*input$lgd.w # Legend is reduced.
    png(paste0(normalizePath(tempdir(check=TRUE), winslash="/", mustWork=FALSE), '/tmp.png')); shm1 <- grid.arrange(cs.arr, shm, lgd.arr, ncol=3, widths=unit(c(0.08-0.005, 1-0.08-w.lgd, w.lgd), 'npc')); dev.off() } else { png(paste0(normalizePath(tempdir(check=TRUE), winslash="/", mustWork=FALSE), '/tmp.png')); shm1 <- grid.arrange(cs.arr, shm, ncol=2, widths=unit(c(0.08-0.005, 1-0.08), 'npc')); dev.off() }
    ggsave(paste0(normalizePath(tempdir(check=TRUE), winslash="/", mustWork=FALSE), '/shm.', input$ext), plot=shm1, device=input$ext, width=input$width/72, height=input$height/72, dpi=input$res, unit='in') }
    
    })

  })

  output$dld.shm <- downloadHandler(
    filename=function() { paste0('shm.', input$ext) },
    content=function(file) { file0 <- paste0(normalizePath(tempdir(check=TRUE), winslash="/", mustWork=FALSE), '/shm.', input$ext); 
    cat("Downloading 'shm' from", normalizePath(tempdir(check=TRUE), winslash="/", mustWork=FALSE), '...\n')
    file.copy(file0, file, overwrite=TRUE) }
  )

  observe({
  
    input$fileIn; geneIn(); input$adj.modInpath; input$A; input$p; input$cv1; input$cv2; input$dt_rows_selected; input$tis; input$gen.con  
    updateRadioButtons(session, inputId='ext', label='File type:', choices=c('NA', "png", "jpg", "pdf"), selected=cfg$lis.par$shm.img['file.type', 'default'], inline=TRUE)
    updateRadioButtons(session, inputId="ggly.but", label="Show animation:", choices=c("Yes", "No"), selected=cfg$lis.par$shm.anm['show', 'default'], inline=TRUE)
    updateRadioButtons(session, inputId="vdo.but", label="Show video:", choices=c("Yes", "No"), selected=cfg$lis.par$shm.video['show', 'default'], inline=TRUE)

  })

  observe({
   input$lgd.key.size; input$lgd.row; input$tis; input$lgd.label; input$lgd.lab.size
   updateRadioButtons(session, inputId="vdo.but", label="Show video:", choices=c("Yes", "No"), selected=cfg$lis.par$shm.video['show', 'default'], inline=TRUE)
  })


 output$shm.ui <- renderUI({

      box(title="Spatial Heatmap", status="primary", solidHeader=TRUE, collapsible=TRUE, width=ifelse(input$hide.lgd=='No', 9, 12), height=NULL, 
      tabBox(title="", width=12, id='shm_all', selected='shm1', side='right', 
      tabPanel(title='Video', value='shm3', 
      fluidRow(splitLayout(cellWidths=c('1%', '15%', '1%', '15%', '1%', '8%', '1%', '8%', '1%', '13%', '1%', '16%'), '', 
      radioButtons(inputId="vdo.but", label="Show video:", choices=c("Yes", "No"), selected=cfg$lis.par$shm.video['show', 'default'], inline=TRUE), '',
      numericInput(inputId='vdo.itvl', label='Transition time (s):', value=as.numeric(cfg$lis.par$shm.video['transition', 'default']), min=0.1, max=Inf, step=1, width=270), '',
      numericInput(inputId='vdo.height', label='Height:', value=as.numeric(cfg$lis.par$shm.video['height', 'default']), min=0.1, max=0.99, step=0.1, width=270), '',
      numericInput(inputId='vdo.width', label='Width:', value=as.numeric(cfg$lis.par$shm.video['width', 'default']), min=0.1, max=0.92, step=0.1, width=270), '',
      numericInput(inputId='vdo.res', label='Resolution (dpi):', value=as.numeric(cfg$lis.par$shm.video['dpi', 'default']), min=1, max=1000, step=5, width=270), '',
      radioButtons(inputId="vdo.val.lgd", label="Add values to legend:", choices=c("Yes", "No"), selected=cfg$lis.par$shm.video['value.legend', 'default'], inline=TRUE)

      )), uiOutput('video.dim'), textOutput('tran.vdo'), htmlOutput('ffm'), 
      fluidRow(splitLayout(cellWidths=c("1%", "7%", "91%", "1%"), "", plotOutput("bar3"), uiOutput('video'), ""))),
      
      tabPanel(title='Animation', value='shm2', 
      fluidRow(splitLayout(cellWidths=c('1%', '15%', '1%', '15%', '1%', '10%', '1%', '10%', '1%', '13%'), '', 
      radioButtons(inputId="ggly.but", label="Show animation:", choices=c("Yes", "No"), selected=as.numeric(cfg$lis.par$shm.img['show', 'default']), inline=TRUE), '',
      numericInput(inputId='t', label='Transition time (s):', value=as.numeric(cfg$lis.par$shm.anm['transition', 'default']), min=0.1, max=Inf, step=NA, width=270), '',
      uiOutput('anm.h'), '', uiOutput('anm.w'), '', uiOutput('dld.anm.but')
      )), textOutput('tran'), uiOutput('sld.fm'),
      fluidRow(splitLayout(cellWidths=c("1%", "7%", "91%", "1%"), "", plotOutput("bar2"), htmlOutput("ggly"), ""))
      ),

      tabPanel(title="Image", value='shm1',  
      fluidRow(column(10, splitLayout(cellWidths=c('14%', '1%', '14%', '1%', '9%', '1%', '32%', '1%', '15%'),
      numericInput(inputId='height', label='Overall height:', value=as.numeric(cfg$lis.par$shm.img['height', 'default']), min=1, max=Inf, step=NA, width=170), '',
      numericInput(inputId='width', label='Overall width:', value=as.numeric(cfg$lis.par$shm.img['width', 'default']), min=1, max=Inf, step=NA, width=170), '',
      numericInput(inputId='col.n', label='Columns:', value=as.numeric(cfg$lis.par$shm.img['columns', 'default']), min=1, max=Inf, step=1, width=150), '',
      radioButtons(inputId="gen.con", label="Display by:", choices=c("Gene"="gene", "Condition"="con", "None"="none"), selected=cfg$lis.par$shm.img['display.by', 'default'], inline=TRUE), '', 
     radioButtons(inputId="pre.scale", label="Preserve.scale:", choices=c("Yes", "No"), selected=cfg$lis.par$shm.img['preserve.scale', 'default'], inline=TRUE)
      )),
      column(1,
      dropdownButton(inputId='dropdown', label='Color key', circle=FALSE, icon=NULL, status='primary', inline=FALSE, width=250, 
      fluidRow(splitLayout(cellWidths=c('1%', '70%', '25%'), '', textInput("color", "Color scheme:", cfg$lis.par$shm.img['color', 'default'], placeholder=paste0('Eg: ', cfg$lis.par$shm.img['color', 'default']), width=200),
      actionButton("col.but", "Go", icon=icon("refresh")))), 
      radioButtons(inputId='cs.v', label='Color scale based on:', choices=c("Selected rows", "All rows"), selected=cfg$lis.par$shm.img['color.scale', 'default'], inline=TRUE)
      ))
      ), textOutput('h.w.c'), textOutput('msg.col'),

      fluidRow(splitLayout(cellWidths=c('100%'),  checkboxGroupInput(inputId="tis", label="Select tissues to be transparent:", choices='', selected='', inline=TRUE))),

      fluidRow(column(1, offset=0, style='padding-left:0px; padding-right:50px; padding-top:0px; padding-bottom:5px',
      dropdownButton(inputId='dropdown', label='Download', circle=FALSE, icon=NULL, status='primary', inline=FALSE, width=800,
      fluidRow(splitLayout(cellWidths=c('27%', '1%', '14%', '1%', '11%', '1%', '17%', '1%', '14%'), 
      radioButtons(inputId='ext', label='File type:', choices=c('NA', "png", "jpg", "pdf"), selected=cfg$lis.par$shm.img['file.type', 'default'], inline=TRUE), '',
      numericInput(inputId='res', label='Resolustion (dpi):', value=as.numeric(cfg$lis.par$shm.img['dpi', 'default']), min=10, max=Inf, step=10, width=150), '',
      numericInput(inputId='lgd.w', label='Legend width:', value=as.numeric(cfg$lis.par$shm.img['legend.width', 'default']), min=0, max=1, step=0.1, width=150), '',
      numericInput(inputId='lgd.ratio', label='Legend aspect ratio:', value=as.numeric(cfg$lis.par$shm.img['legend.aspect.ratio', 'default']), min=0.0001, max=Inf, step=0.1, width=140), '', downloadButton("dld.shm", "Download")
      )))
      ),  
      column(1, offset=0, style='padding-left:50px; padding-right:80px; padding-top:0px; padding-bottom:5px',
      dropdownButton(inputId='value.lgd', label='Value legend', circle=FALSE, icon=NULL, status='primary', inline=FALSE, width=500,
      fluidRow(splitLayout(cellWidths=c('1%', '25%', '1%', '13%', '1%', '17%', '1%', '14%', '1%', '28%'), '', 
      actionButton("val.lgd", "Add/Remove", icon=icon("refresh")), '',  
      numericInput(inputId='val.lgd.row', label='Rows:', value=as.numeric(cfg$lis.par$shm.img['value.legend.rows', 'default']), min=1, max=Inf, step=1, width=150), '',
      numericInput(inputId='val.lgd.key', label='Key size:', value=as.numeric(cfg$lis.par$shm.img['value.legend.key', 'default']), min=0.0001, max=1, step=0.01, width=150), '',
      numericInput(inputId='val.lgd.text', label='Text size:', value=as.numeric(cfg$lis.par$shm.img['value.legend.text', 'default']), min=0.0001, max=Inf, step=1, width=140), '',
      radioButtons(inputId='val.lgd.feat', label='Include feature:', choices=c('No', 'Yes'), selected=cfg$lis.par$shm.img['include.feature', 'default'], inline=TRUE)
      ))
      )),
      column(1, offset=0, style='padding-left:40px; padding-right:50px; padding-top:0px; padding-bottom:5px',
      dropdownButton(inputId='line', label='Shape outline', circle=FALSE, icon=NULL, status='primary', inline=FALSE, width=250,
      selectInput('line.color', label='Line color:', choices=c('grey70', 'black', 'red', 'green', 'blue'), selected=cfg$lis.par$shm.img['line.color', 'default']),
      numericInput(inputId='line.size', label='Line size:', value=as.numeric(cfg$lis.par$shm.img['line.size', 'default']), min=0.05, max=Inf, step=0.05, width=150)
      ))
      ),
      fluidRow(splitLayout(cellWidths=c("1%", "7%", "91%", "1%"), "", plotOutput("bar1"), plotOutput("shm", height='auto'), "")))

      ))
  
  })

  output$shms.o <- renderUI({
 
    if (is.null(svg.path())) return(NULL)
    if (length(svg.path()$svg.na)==1) return(NULL)
    selectInput('shms.in', label='aSVG for legend:', choices=svg.path()[['svg.na']], selected=svg.path()[['svg.na']][1])

  })

  output$lgd <- renderPlot(width='auto', height = "auto", {

    validate(need(try(as.integer(input$lgd.row)==input$lgd.row & input$lgd.row>0), 'Legend key rows should be a positive integer!'))
    validate(need(try(input$lgd.key.size>0&input$lgd.key.size<1), 'Legend key size should be between 0 and 1!'))
    svg.path <- svg.path()
    if (is.null(svg.path())|is.null(grob$lgd.all)|(length(svg.path$svg.na)>1 & is.null(input$shms.in))) return(ggplot())

      # Width and height in original SVG.
      if (length(svg.path$svg.na)>1) svg.na <- input$shms.in else svg.na <- 1

      w.h <- svg.df()[[svg.na]][['w.h']]
      w.h <- as.numeric(gsub("^(\\d+\\.\\d+|\\d+).*", "\\1", w.h)); r <- w.h[1]/w.h[2]
      if (is.na(r)) return()
      cat('Plotting legend plot... \n')
      g.lgd <- grob$lgd.all[[svg.na]]; g.lgd <- g.lgd+coord_fixed(ratio=r); return(g.lgd)

  })

  output$lgd.ui <- renderUI({ 
    
    if (is.null(input$hide.lgd)) return(NULL) 
    if (input$hide.lgd=='Yes') return(NULL)
    box(title="Legend Plot", status="primary", solidHeader=TRUE, collapsible=TRUE, uiOutput('shms.o'),
    splitLayout(cellWidths=c("43%", "1%", '43%'),
    numericInput(inputId='lgd.row', label='Legend key rows:', value=as.numeric(cfg$lis.par$legend['key.row', 'default']), min=1, max=Inf, step=1, width=150), '',
    numericInput(inputId='lgd.key.size', label='Legend key size:', value=as.numeric(cfg$lis.par$legend['key.size', 'default']), min=0, max=1, step=0.02, width=150)
    ),
    splitLayout(cellWidths=c("43%", "1%", '43%'),
    radioButtons(inputId="lgd.label", label="Label feature:", choices=c("Yes", "No"), selected=cfg$lis.par$legend['label', 'default'], inline=TRUE), '',
    numericInput(inputId='lgd.lab.size', label='Label size:', value=as.numeric(cfg$lis.par$legend['label.size', 'default']), min=0, max=Inf, step=0.5, width=150)
    ),
    splitLayout(cellWidths=c("99%", "1%"), plotOutput("lgd"), ""), width=3) 

  })


  output$tran <- renderText({
    
    if (is.null(geneIn())|is.null(input$dt_rows_selected)|is.null(svg.df())|gID$geneID[1]=="none"|is.null(grob$all)) return(NULL)
    validate(need(try(input$t>=0.1), 'Transition time should be at least 0.1 second!'))

  })

  ggly_rm <- function() {
    if (dir.exists('www/ggly/')) {
      cat("Removing animation files in 'www/ggly/' ... \n")
      unlink('www/ggly/lib', recursive=TRUE)
      file.remove(list.files('www/ggly/', '*.html$', full.names=TRUE))
    } else dir.create('www/ggly')
  }
  vdo_rm <- function() {
    if (dir.exists('www/video/')) {
      cat("Removing video file in 'www/video/' ... \n")
      file.remove(list.files('www/video/', '*.mp4$', full.names=TRUE))
    } else dir.create('www/video/')
  }
  observeEvent(list(fineIn=input$fileIn, log=input$log, tis=input$tis, col.but=input$col.but, cs.v=input$cs.v, pre.scale=input$pre.scale), { ggly_rm(); vdo_rm() })

  observeEvent(list(width.ly=input$width.ly, height.ly=input$height.ly), {
    if (dir.exists('html_shm/')) { unlink('html_shm/lib', recursive=TRUE)
      file.remove(list.files('html_shm/', '*.html$', full.names=TRUE))
    } else dir.create('html_shm/')
  })
  observeEvent(list(log=input$log, tis=input$tis, col.but=input$col.but, cs.v=input$cs.v, pre.scale=input$pre.scale, ggly.but=input$ggly.but, gID.new=gID$new), {

    if (is.null(input$ggly.but)) return() 
    if (input$ggly.but=='No') return()
    if (is.null(geneIn())|is.null(gID$new)|is.null(input$dt_rows_selected)|is.null(svg.df())|gID$geneID[1]=="none"|is.null(grob$gg.all1)|input$ggly.but=='No') return(NULL)
    if (length(color$col=="none")==0|input$color=="") return(NULL)

    withProgress(message="Animation: ", value=0, {
    incProgress(0.25, detail="preparing frames...") 
    gg.all <- grob$gg.all1; na <- names(gg.all)
    # Only take the selected genes.
    na <- na[grepl(paste0('^', pat.all(), '_\\d+$'), na)]; gg.all <- gg.all[na]
    for (i in seq_along(gg.all)) {

      na0 <- paste0(na[i], ".html")
      if (length(list.files('www/ggly/', na0))>0) next
      gly <- ggplotly(gg.all[[i]], tooltip='text') %>% layout(showlegend=FALSE)
      gly$sizingPolicy$padding <- 0
      cat('Animation: saving', na0, '\n')
      saveWidget(gly, na0, selfcontained=FALSE, libdir="lib")
      file.rename(na0, paste0('www/ggly/', na0))

    }
    if (!dir.exists('www/ggly/lib')) file.rename('lib', 'www/ggly/lib') else if (dir.exists('lib/')) unlink('lib', recursive=TRUE)
    })

  })

  output$sld.fm <- renderUI({
 
    if (is.null(grob$gg.all)|is.null(pat.all())|is.null(gID$geneID)) return(NULL) 
    gen.con.pat <- paste0('^', pat.all(), '_\\d+$') 
    sliderInput(inputId='fm', 'Frames', min=1, max=sum(grepl(gen.con.pat, names(grob$gg.all1))), step=1, value=1, animate=animationOptions(interval=input$t*10^3, loop=FALSE, playButton=icon('play'), pauseButton=icon('pause')))
  
  })

  # As long as the variable of 'reactive' is used in the 'ui.R', changes of elements in 'reactive' would cause chain change all the way to 'ui.R'. E.g. the change in "input$ggly.but=='No'" leads to changes in 'output$ggly' and 'ui.R', not necessarily changes in 'output$ggly' call changes in 'gly.url'.
  gly.url <- reactive({ 
    
    if (is.null(input$ggly.but)) return() 
    if (is.null(grob$gg.all1)|input$ggly.but=='No'|gID$geneID[1]=='none'|is.null(pat.all())) return(NULL)
    gg.all <- grob$gg.all1; na <- names(gg.all)
    # Only take the selected genes.
    na <- na[grepl(paste0('^', pat.all(), '_\\d+$'), na)]; na1 <- na[as.integer(input$fm)]
    na2 <- list.files('www/ggly', pattern=na1)
    if (length(na2)==0|is.na(na2)) return(NULL)
    cat('Animation: access', na2, 'path \n')
    paste0('ggly/', na2)
  
  })

  # Variables in 'observe' are accessible anywhere in the same 'observe'.
  observe({

    if (is.null(input$ggly.but)|is.null(input$fm)) return() 
    if (input$ggly.but=='No'|is.null(gly.url())) return()
    if (is.null(svg.df())|is.null(geneIn())|is.null(input$dt_rows_selected)|color$col[1]=='none') return(NULL)
    
    gg.all <- grob$gg.all1; na <- names(gg.all)
    # Only take the selected genes.
    na <- na[grepl(paste0('^', pat.all(), '_\\d+$'), na)]; na1 <- na[as.integer(input$fm)]
    na2 <- list.files('www/ggly', pattern=paste0(na1, '\\.html$')); if (length(na2)==0) return(NULL)
    gg <- gg.all[[na1]]
    dat <- layer_data(gg); x.max <- max(dat$x); y.max <- max(dat$y)
    w <- cfg$lis.par$shm.anm['width', 'default']
    if (w!='NA') w <- as.numeric(w) else w <- NA
    h <- cfg$lis.par$shm.anm['height', 'default']
    if (h!='NA') h <- as.numeric(h) else h <- NA
    if (!is.na(w)) {
      h <- y.max/x.max*w; if (h>550) { h <- 550; w <- x.max/y.max*h }
    } else if (is.na(w) & !is.na(h)) { w <- x.max/y.max*h }
    output$anm.w <- renderUI({

      numericInput(inputId='width.ly', label='Width:', value=w, min=1, max=Inf, step=NA, width=170)

    })
    output$anm.h <- renderUI({

      numericInput(inputId='height.ly', label='Height:', value=h, min=1, max=Inf, step=NA, width=170)

    })
  output$dld.anm.but <- renderUI({ downloadButton("dld.anm", "Download") })

  })

  
  observeEvent(list(log=input$log, tis=input$tis, col.but=input$col.but, cs.v=input$cs.v, pre.scale=input$pre.scale, ggly.but=input$ggly.but, fm=input$fm), {
  
  output$ggly <- renderUI({ 

    if (input$ggly.but=='No'|is.null(gly.url())) return()
    if (is.null(svg.df())|is.null(geneIn())|is.null(input$dt_rows_selected)|color$col[1]=='none') return(NULL)
    withProgress(message="Animation: ", value=0, {
    incProgress(0.75, detail="plotting...")
    gly.url <- gly.url(); cat('Animation: plotting', gly.url, '\n')
    tags$iframe(src=gly.url, height=input$height.ly, width=input$width.ly, scrolling='auto')
  
    })

  })

  })

  anm.dld <- reactive({
    
    if (input$ggly.but=='No'|is.null(gly.url())) return()
    if (is.null(svg.df())|is.null(geneIn())|is.null(input$dt_rows_selected)|color$col[1]=='none') return(NULL) 
    withProgress(message="Downloading animation: ", value=0, {
    incProgress(0.1, detail="in progress...")
    gg.all <- grob$gg.all1; na <- names(gg.all)
    gg.na <- na[grepl(paste0('^', pat.all(), '_\\d+$'), na)]
    gg <- gg.all[gg.na]
    pro <- 0.1; for (i in seq_along(gg.na)) {
    incProgress(pro+0.2, detail=paste0('preparing ', gg.na[i], '.html...'))
    html_ly(gg=gg[i], cs.g=shm.bar(), tis.trans=input$tis, sam.uni=sam(), anm.width=input$width.ly, anm.height=input$height.ly, out.dir='.') }

   })

  })
  
  # This step leaves 'fil.na' in 'output$dld.anm' being a global variable.
  output$dld.anm <- downloadHandler( 
    # The rest code will run only after 'anm.dld()' is done.
    filename=function(){ anm.dld(); "html_shm.zip" },
    fil.na <- paste0(normalizePath(tempdir(check=TRUE), winslash="/", mustWork=FALSE), '/html_shm.zip'),
    content=function(fil.na){ cat('Downloading animation... \n'); zip(fil.na, 'html_shm/') }
  )

  output$video.dim <- renderUI({

    selectInput("vdo.dim", label="Fixed dimension:", choices=c('1920x1080', '1280x800', '320x568', '1280x1024', '1280x720', '320x480', '480x360', '600x600', '800x600', '640x480'), selected=cfg$lis.par$shm.video['dimension', 'default'], width=110)

  })

  output$ffm <- renderText({
    ffm <- tryCatch({ test_ffm() }, error=function(e){ return('error') }, warning=function(w) { return('warning') } )
    if (grepl('error|warning', ffm)) paste("<span style=\"color:red\">Error: \"ffmpeg\" is not detected!\"</span>")
  })

  observeEvent(list(log=input$log, tis=input$tis, col.but=input$col.but, cs.v=input$cs.v, pre.scale=input$pre.scale, vdo.but=input$vdo.but, vdo.dim=input$vdo.dim, vdo.itvl=input$vdo.itvl, vdo.height=input$vdo.height, vdo.width=input$vdo.width, vdo.res=input$vdo.res, vdo.val.lgd=input$'vdo.val.lgd'), {

    if (is.null(input$vdo.but)) return(NULL) 
    if (input$vdo.but=='No'|is.null(pat.all())) return(NULL)
    if (is.null(svg.df())|is.null(geneIn())|is.null(input$dt_rows_selected)|color$col[1]=='none') return(NULL)
    validate(need(try(!is.na(input$vdo.itvl)&input$vdo.itvl>0), 'Transition time should be a positive numeric!'))
    validate(need(try(!is.na(input$vdo.height)&input$vdo.height>0&input$vdo.height<=0.99), 'Height should be between 0.1 and 0.99!'))
    validate(need(try(!is.na(input$vdo.width)&input$vdo.width>0&input$vdo.width<=0.92), 'Width should be between 0.1 and 0.92!'))
    validate(need(try(!is.na(input$vdo.res)&input$vdo.res>=1&input$vdo.res<=700), 'Resolution should be between 1 and 700!'))
    
    withProgress(message="Video: ", value=0, {
    incProgress(0.75, detail="in progress...")
    gg.all <- grob$gg.all1; na <- names(gg.all)
    pat <- paste0('^', pat.all(), '_\\d+$'); na <- na[grepl(pat, na)]
    gg.all1 <- gg.all[na]
    cat('Making video... \n')
    res <- input$vdo.res; dim <- input$vdo.dim
    if (dim %in% c('1280x800', '1280x1024', '1280x720')&res>450) res <- 450
    if (dim=='1920x1080'&res>300) res <- 300
    # selectInput("vdo.dim", label="Fixed dimension:", choices=c('1920x1080', '1280x800', '320x568', '1280x1024', '1280x720', '320x480', '480x360', '600x600', '800x600', '640x480'), selected='640x480', width=110)
    vdo <- video(gg=gg.all1, cs.g=shm.bar(), sam.uni=sam(), tis.trans=input$tis, lgd.key.size=input$lgd.key.size, lgd.text.size=NULL, position.text.key='right', legend.value.vdo=(input$'vdo.val.lgd'=='Yes'), label=(input$lgd.label=='Yes'), label.size=input$lgd.lab.size, sub.title.size=8, bar.value.size=6, lgd.row=input$lgd.row, width=input$vdo.width, height=input$vdo.height, video.dim=dim, interval=input$vdo.itvl, res=res, out.dir='./www/video'); if (is.null(vdo)) return()
    cat('Presenting video... \n')
    incProgress(0.95, detail="Presenting video...")
    w.h <- as.numeric(strsplit(input$vdo.dim, 'x')[[1]])
    output$video <-renderUI({ tags$video(id="video", type="video/mp4", src="video/shm.mp4", width=w.h[1], height=w.h[2], controls="controls") })

    })

  })

  observe({

    geneIn(); input$adj.modInpath; input$A; input$p; input$cv1
    input$cv2; input$min.size; input$net.type
    input$measure; input$cor.abs; input$thr; input$mhm.v
    updateRadioButtons(session, "mat.scale", "Scale by: ", c("No", "Column", "Row"), "No", inline=TRUE)

  })


  observe({
  
    input$fileIn; geneIn(); input$adj.modInpath; input$A; input$p; input$cv1; input$cv2; input$dt_rows_selected
    updateActionButton(session, inputId='mhm.but', label='Update', icon=icon("refresh"))
    #updateRadioButtons(session, inputId="mhm.but", label="Show plot:", choices=c("Yes", "No"), selected=cfg$lis.par$mhm['show', 'default'], inline=TRUE)

  })

  # Calculate whole correlation or distance matrix.
  cor.dis <- reactive({

    if (is.null(geneIn())|input$mhm.but=='No') return()
    if ((any(input$fileIn %in% cfg$na.cus) & is.null(geneIn()))|input$fileIn=="none") return(NULL)
    
    withProgress(message="Compute similarity/distance matrix: ", value = 0, {

      incProgress(0.5, detail="Please wait...")
      gene <- geneIn()[['gene1']]
      cat('Correlation/distance matrix...\n')
      if (input$measure=='correlation') {
      
        m <- cor(x=t(gene))
        if (input$cor.abs==TRUE) { m <- abs(m) }; return(m)

      } else if (input$measure=='distance') { return(-as.matrix(dist(x=gene))) }

    })

  })

  # Subset nearest neighbours for target genes based on correlation or distance matrix.
  submat <- reactive({
  
    if (input$fileIn=="None") return()
    if (is.null(cor.dis())|input$mhm.but=='No') return()
    gene <- geneIn()[["gene1"]]; rna <- rownames(gene)
    gen.tar<- gID$geneID; mat <- cor.dis()
    # Validate filtering parameters in matrix heatmap. 
    measure <- input$measure; cor.abs <- input$cor.abs; mhm.v <- input$mhm.v; thr <- input$thr
    if (input$thr=='p') {

      validate(need(try(mhm.v>0 & mhm.v<=1), 'Proportion should be between 0 to 1 !'))

    } else if (input$thr=='n') {

      validate(need(try(mhm.v>=1 & as.integer(mhm.v)==mhm.v & !is.na(mhm.v)), 'Number should be a positive integer !'))

    } else if (input$thr=='v' & measure=='correlation') {

      validate(need(try(mhm.v>-1 & mhm.v <1), 'Correlation value should be between -1 to 1 !'))

    } else if (input$thr=='v' & measure=='distance') {

      validate(need(try(mhm.v>=0), 'Distance value should be non-negative !'))

    }

    withProgress(message="Selecting nearest neighbours: ", value = 0, {

      incProgress(0.5, detail="Please wait...")
      arg <- list(p=NULL, n=NULL, v=NULL)
      arg[names(arg) %in% input$thr] <- input$mhm.v
      if (input$measure=='distance' & input$thr=='v') arg['v'] <- -arg[['v']]
      if (!all(gen.tar %in% rownames(mat))) return()    
      cat('Subsetting nearest neighbors...\n')
      validate(need(try(ncol(gene)>4), 'The "sample__condition" variables in the Data Matrix are less than 5, so no coexpression analysis is applied!'))
      gen.na <- do.call(sub_na, c(mat=list(mat), ID=list(gen.tar), arg))
      if (any(is.na(gen.na))) return() 
      validate(need(try(length(gen.na)>=2), paste0('Only ', gen.na, ' selected!'))); return(gene[gen.na, ])

    })

  })
  mhm <- reactiveValues(hm=NULL)
  # Plot matrix heatmap.
  observe({

    if (input$mhm.but!=0) return() 
    if (is.null(submat())) return()
    gene <- geneIn()[["gene1"]]; rna <- rownames(gene)
    gen.tar <- gID$geneID; if (length(gen.tar)>1) return()
    withProgress(message="Matrix heatmap:", value=0, {
      incProgress(0.7, detail="Plotting...")
      if (input$mat.scale=="Column") scale.hm <- 'column' else if (input$mat.scale=="Row") scale.hm <- 'row' else scale.hm <- 'no'
      cat('Initial matrix heatmap...\n')
      mhm$hm <- matrix_hm(ID=gen.tar, data=submat(), scale=scale.hm, main='Target Genes and Their Nearest Neighbours', title.size=10, static=FALSE)

    })

  })
  hmly <- eventReactive(input$mhm.but, {
    
    #if (is.null(submat())|input$mhm.but=='No') return()
    if (is.null(submat())) return()
    gene <- geneIn()[["gene1"]]; rna <- rownames(gene)
    gen.tar<- gID$geneID
    withProgress(message="Matrix heatmap:", value=0, {
      incProgress(0.7, detail="Plotting...")
      if (input$mat.scale=="Column") scale.hm <- 'column' else if (input$mat.scale=="Row") scale.hm <- 'row' else scale.hm <- 'no'
      cat('Matrix heatmap...\n')
      matrix_hm(ID=gen.tar, data=submat(), scale=scale.hm, main='Target Genes and Their Nearest Neighbours', title.size=10, static=FALSE)

    })

  })

  output$HMly <- renderPlotly({ 
   
    if (is.null(input$dt_rows_selected)) return()
    if (is.null(gID$geneID)|is.null(submat())) return()
    if (gID$geneID[1]=='none'|is.na(gID$geneID[1])) return()
    if (input$mhm.but!=0) hmly() else if (input$mhm.but==0) mhm$hm else return() 
  
  })

  adj.mod <- reactive({ 

    if (input$fileIn=="customComputedData" & !is.null(input$adj.modInpath)) {

      name <- input$adj.modInpath$name; path <- input$adj.modInpath$datapath
      path1 <- path[name=="adj.txt"]; path2 <- path[name=="mod.txt"]

      withProgress(message="Loading: ", value = 0, {
        incProgress(0.5, detail="adjacency matrix and module definition.")
        adj <- fread(path1, sep="\t", header=TRUE, fill=TRUE); c.na <- colnames(adj)[-ncol(adj)]
        r.na <- as.data.frame(adj[, 1])[, 1];  adj <- as.data.frame(adj)[, -1] 
        rownames(adj) <- r.na; colnames(adj) <- c.na

        mcol <- fread(path2, sep="\t", header=TRUE, fill=TRUE); c.na <- colnames(mcol)[-ncol(mcol)]
        r.na <- as.data.frame(mcol[, 1])[, 1]; mcol <- as.data.frame(mcol)[, -1] 
        rownames(mcol) <- r.na; colnames(mcol) <- c.na

      }); return(list(adj=adj, mcol=mcol))

    }

  })

    #gene <- geneIn()[["gene2"]]; if (!(input$gen.sel %in% rownames(gene))) return() # Avoid unnecessary computing of 'adj', since 'input$gen.sel' is a cerain true gene id of an irrelevant expression matrix, not 'None', when switching from one defaul example's matrix heatmap to another example.
    adj.mods <- reactiveValues(lis=NULL)
    observe({
    
      if (input$fileIn=="None") return()
      if (is.null(submat())|input$cpt.nw!=0|length(gID$geneID)>1) return()

    if (input$fileIn=="customData"|any(input$fileIn %in% cfg$na.def)) {

      gene <- geneIn()[["gene1"]]; if (is.null(gene)) return()
      type <- input$net.type; sft <- if (type=='distance') 1 else 6
      withProgress(message="Computing: ", value = 0, {
        incProgress(0.3, detail="adjacency matrix.")
        incProgress(0.5, detail="topological overlap matrix.")
        incProgress(0.1, detail="dynamic tree cutting.")
        cat('Initial adjacency matrix and modules...\n')
        adj.mods$lis <- adj_mod(data=submat(), type=type, minSize=input$min.size, dir=NULL)

      })

    }
    
    })

  # er <- eventReactive(exp, {}). If its reactive value "er()" is called before eventReactive is triggered, the code execution stops where "er()" is called.
  observeEvent(input$cpt.nw, { 
    #gene <- geneIn()[["gene2"]]; if (!(input$gen.sel %in% rownames(gene))) return() # Avoid unnecessary computing of 'adj', since 'input$gen.sel' is a cerain true gene id of an irrelevant expression matrix, not 'None', when switching from one defaul example's matrix heatmap to another example.
    if (is.null(submat())|input$cpt.nw==0) return()
    if (input$fileIn=="customData"|any(input$fileIn %in% cfg$na.def)) {

      gene <- geneIn()[["gene1"]]; if (is.null(gene)) return()
      type <- input$net.type; sft <- if (type=='distance') 1 else 6
      withProgress(message="Computing: ", value = 0, {
        incProgress(0.3, detail="adjacency matrix.")
        incProgress(0.5, detail="topological overlap matrix.")
        incProgress(0.1, detail="dynamic tree cutting.")
        cat('Adjacency and modules... \n')
        adj.mods$lis <- adj_mod(data=submat(), type=type, minSize=input$min.size)

      })

    }

  })

  observe({
 
    input$gen.sel; input$measure; input$cor.abs; input$thr; input$mhm.v
    updateSelectInput(session, 'ds', "Module splitting sensitivity level:", 3:2, selected=cfg$lis.par$network['ds', 'default'])

  })

  #mcol <- reactive({

   # if ((input$cpt.nw!=0|!is.null(adj.mods$lis)) & (input$fileIn=="customData"|any(input$fileIn %in% cfg$na.def))) { 

    #withProgress(message="Computing dendrogram:", value=0, {
     # incProgress(0.7, detail="hierarchical clustering.")
      #if (input$cpt.nw!=0) mod4 <- adj.mods$lis[['mod']] else mod4 <- adj.mods$lis[['mod']]
 
    #}); return(mod4) 
    
 # }

 #})


  #observe({
  
   # geneIn(); gID$geneID; input$adj.in; input$gen.sel; input$ds; input$adj.modInpath; input$A; input$p; input$cv1; input$cv2; input$min.size; input$net.type
    #updateRadioButtons(session, inputId="cpt.nw", label="Show plot:", choices=c("Yes", "No"), selected=ifelse(nrow(visNet()[["link"]])<120, "Yes", "No"), inline=TRUE)
  
  #})

  col.sch.net <- reactive({ 

    if(input$color.net=="") return(NULL) 
    col <- gsub(' |\\.|-|;|,|/', '_', input$color.net)
    col <- strsplit(col, '_')[[1]]
    col <- col[col!='']; col1 <- col[!col %in% colors()]
    if (length(col1>0)) validate(need(try(col1 %in% colors()), paste0('Colors not valid: ', paste0(col1, collapse=', '), '!'))); col

  }); color.net <- reactiveValues(col.net="none")

  len.cs.net <- 350
  observeEvent(input$col.but.net, {

    if (is.null(col.sch.net())) return (NULL)
    color.net$col.net <- colorRampPalette(col.sch.net())(len.cs.net)

  })

  visNet <- reactive({
 
    input$cpt.nw; if (input$fileIn=="None") return()
    if (input$fileIn=='customComputedData' & is.null(geneIn())) return()
    # if (input$adj.in=="None") return(NULL)
    if (input$fileIn=="customComputedData") { adj <- adj.mod()[['adj']]; mods <- adj.mod()[['mcol']] } else if (input$fileIn=="customData"|input$fileIn %in% cfg$na.def) { 
      adj <- adj.mods$lis[['adj']]; mods <- adj.mods$lis[['mod']]
    }
    if (input$fileIn=='customComputedData') gene <- geneIn()$gene2 else gene <- submat()
    if (!(input$gen.sel %in% rownames(gene))) return() # Avoid unnecessary computing of 'adj', since 'input$gen.sel' is a cerain true gene id of an irrelevant expression matrix, not 'None', when switching from one defaul example's network to another example.
    lab <- mods[, input$ds][rownames(gene)==input$gen.sel]
    validate(need(try(length(lab)==1 & !is.na(lab) & nrow(mods)==nrow(gene)), 'Click "Update" to display new network!'))
    if (length(lab)>1|is.na(lab)) return() # When input$fileIn is changed, gene is changed also, but mods is not since it is controled by observeEvent.
    validate(need(try(lab!='0'), 'Warning: the selected gene is not assigned to any module. Please select a different one or adjust the "Minmum module size"!'))
    idx.m <- mods[, input$ds]==lab; adj.m <- adj[idx.m, idx.m]; gen.na <- colnames(adj.m) 
    idx.sel <- grep(paste0("^", input$gen.sel, "$"), gen.na); gen.na[idx.sel] <- paste0(input$gen.sel, "_target")
    colnames(adj.m) <- rownames(adj.m) <- gen.na
    withProgress(message="Computing network:", value=0, { 
      incProgress(0.8, detail="making network data frame")
      cat('Extracting nodes and edges... \n')
      # Identify adjcency threshold with edges < max number (e.g. 300) 
      ID <- input$gen.sel; adjs <- 1; lin <- 0; adj.lin.vec <- NULL
      validate(need(try(as.integer(input$max.edg)==input$max.edg), 'The number of edges should be an integer!'))
      # Compute the min adj.
      while (lin<input$max.edg) {
          
          adjs <- adjs-0.002; if (adjs<=10^-15) adjs <- 0
          nod.lin <- nod_lin(ds=input$ds, lab=lab, mods=mods, adj=adj, geneID=ID, adj.min=adjs)
          lin <- nrow(nod.lin[['link']])
          vec0 <- adjs; names(vec0) <- lin
          adj.lin.vec <- c(adj.lin.vec, vec0)
          if (adjs==0) break

      }; cat('Adjacency-edge pairs done! \n')
      # The first version of links computed from the min adj or the input adj, which is subjected to the following check.
      nod.lin <- nod_lin(ds=input$ds, lab=lab, mods=mods, adj=adj, geneID=ID, adj.min=ifelse(input$adj.in==1, adjs, input$adj.in))
      link1 <- nod.lin[['link']]; colnames(link1)[3] <- 'value'
      # If the links are 0 due to the input adj, change the "adjs" to the value bringing 1 or 2 links.
      lins <- NULL; if (nrow(link1)==0) {

        adjs <- adj.lin.vec[names(adj.lin.vec)>=1][1]
        nod.lin <- nod_lin(ds=input$ds, lab=lab, mods=mods, adj=adj, geneID=ID, adj.min=adjs)
        link1 <- nod.lin[['link']]; colnames(link1)[3] <- 'value'; lins <- nrow(link1)

      } else if (nrow(link1)>input$max.edg) {
       
        # If the links are larger than max links due to the input adj, change the "adjs" to the value producing max links.
        adjs <- adjs+0.002
        nod.lin <- nod_lin(ds=input$ds, lab=lab, mods=mods, adj=adj, geneID=ID, adj.min=adjs)
        link1 <- nod.lin[['link']]; colnames(link1)[3] <- 'value'; lins <- nrow(link1)

      } else if (nrow(link1)<=input$max.edg & input$adj.in!=1) {
        
        # If 0<link total<max links, use the input adj.
        adjs <- input$adj.in
        nod.lin <- nod_lin(ds=input$ds, lab=lab, mods=mods, adj=adj, geneID=ID, adj.min=adjs)
        link1 <- nod.lin[['link']]; colnames(link1)[3] <- 'value'; lins <- nrow(link1)

      }
      node <- nod.lin[['node']]; colnames(node) <- c('id', 'value') 
      if (nrow(link1)!=0) { 
        
        link1$title <- link1$value # 'length' is not well indicative of adjacency value, so replaced by 'value'.
        link1$color <- 'lightblue'
        
      }; ann <- geneIn()[['gene3']]
      if (!is.null(ann)) node <- cbind(node, title=ann[node$id, ], borderWidth=2, color.border="black", color.highlight.background="orange", color.highlight.border="darkred", color=NA, stringsAsFactors=FALSE)
      if (is.null(ann)) node <- cbind(node, borderWidth=2, color.border="black", color.highlight.background="orange", color.highlight.border="darkred", color=NA, stringsAsFactors=FALSE)
      net.lis <- list(node=node, link=link1, adjs=adjs, lins=lins)

    }); net.lis

  })
  # The order of reactive expression matters so "updateSelectInput" of "adj.in" should be after visNet().
  observe({
 
    if (input$fileIn=="None") return()
    geneIn(); gID$geneID; input$gen.sel; input$ds; input$adj.modInpath; input$A; input$p; input$cv1; input$cv2; input$min.size; input$net.type
    input$gen.sel; input$measure; input$cor.abs; input$thr; input$mhm.v; input$cpt.nw
     #if ((input$adj.in==1 & is.null(visNet()[["adjs1"]]))|(input$cpt.nw!=cfg$lis.par$network['max.edges', 'default'] & is.null(visNet()[["adjs1"]]))) { updateSelectInput(session, "adj.in", "Adjacency threshold:", sort(seq(0, 1, 0.002), decreasing=TRUE), visNet()[["adjs"]]) } else if (!is.null(visNet()[["adjs1"]])) updateSelectInput(session, "adj.in", "Adjacency threshold:", sort(seq(0, 1, 0.002), decreasing=TRUE), visNet()[["adjs1"]])
     lins <- visNet()[["lins"]]
     if (input$adj.in==1|is.null(lins)|is.numeric(lins)) updateSelectInput(session, "adj.in", "Adjacency threshold (the  smaller, the more edges):", sort(seq(0, 1, 0.002), decreasing=TRUE), as.numeric(visNet()[["adjs"]])) 
  
  })
  output$bar.net <- renderPlot({  

    #if (input$adj.in=="None"|input$cpt.nw=="No") return(NULL)
    if (input$adj.in=="None") return(NULL)
    if (length(color.net$col.net=="none")==0) return(NULL)
    gene <- geneIn()[["gene1"]]; if (!(input$gen.sel %in% rownames(gene))) return() # Avoid unnecessary computing of 'adj', since 'input$gen.sel' is a cerain true gene id of an irrelevant expression matrix, not 'None', when switching from one defaul example's network to another example.
    if(input$col.but.net==0) color.net$col.net <- colorRampPalette(col_sep(cfg$lis.par$network['color', 'default']))(len.cs.net) # color.net$col.net is changed alse outside renderPlot, since it is a reactive value.

      withProgress(message="Color scale: ", value = 0, {
      incProgress(0.25, detail="Preparing data. Please wait.")
      incProgress(0.75, detail="Plotting. Please wait.")
      node <- visNet()[["node"]]; if (is.null(node)) return()
      node.v <- node$value; v.net <- seq(min(node.v), max(node.v), len=len.cs.net)
      cat('Network bar... \n')
      cs.net <- col_bar(geneV=v.net, cols=color.net$col.net, width=1); return(cs.net) # '((max(v.net)-min(v.net))/len.cs.net)*0.7' avoids bar overlap.

      })

  })

  observeEvent(visNet(), {

    output$edge <- renderUI({ 

      if (input$adj.in=="None"|is.null(visNet())) return(NULL)
      if (input$fileIn=="none"|(input$fileIn=="Your own" & is.null(geneIn()))|
      input$gen.sel=="None") return(NULL)
      cat('Remaining edges... \n')
      span(style = "color:black;font-weight:NULL;", HTML(paste0("Remaining edges: ", dim((visNet()[["link"]]))[1])))

    })

  })
  vis.net <- reactive({ 
    
    #if (input$adj.in=="None"|input$cpt.nw=="No") return(NULL)
    if (input$adj.in=="None") return(NULL)
    gene <- geneIn()[["gene1"]]; if (!(input$gen.sel %in% rownames(gene))) return() # Avoid unnecessary computing of 'adj', since 'input$gen.sel' is a cerain true gene id of an irrelevant expression matrix, not 'None', when switching from one defaul example's network to another example.
    withProgress(message="Network:", value=0.5, {
    incProgress(0.3, detail="prepare for plotting.")
    # Match colours with gene connectivity by approximation.
    node <- visNet()[["node"]]; if (is.null(node)) return() 
    node.v <- node$value; v.net <- seq(min(node.v), max(node.v), len=len.cs.net)
    col.nod <- NULL; for (i in node$value) {

      ab <- abs(i-v.net); col.nod <- c(col.nod, color.net$col.net[which(ab==min(ab))[1]])

    }; node$color <- col.nod
    cat('Network... \n')
    visNetwork(node, visNet()[["link"]], height="300px", width="100%", background="", main=paste0("Network Module Containing ", input$gen.sel), submain="", footer= "") %>% visIgraphLayout(physics=FALSE, smooth=TRUE) %>% visOptions(highlightNearest=list(enabled=TRUE, hover=TRUE), nodesIdSelection=TRUE)

    })
    
  })

  output$vis <- renderVisNetwork({

    if (is.null(input$dt_rows_selected)) return()
    if (input$fileIn=="none"|is.null(vis.net())) return(NULL)
    # if (input$cpt.nw=="No") return(NULL)

    withProgress(message="Network:", value=0.5, {

      incProgress(0.3, detail="plotting.")
      cat('Rendering network...\n'); vis.net()

    })

  })

  onStop(function() { ggly_rm(); vdo_rm(); cat("Session stopped! \n") })

})

Try the spatialHeatmap package in your browser

Any scripts or data that you put into this service are public.

spatialHeatmap documentation built on Nov. 8, 2020, 5:46 p.m.