loxcodeR: Loxcode Tools

library(shiny)
library(plotly)
library(DT)
library(loxcoder)
library(shinydashboard)
library(rlist)
library(shinyFiles)
library(shinyalert)
library(knitr)
library(rmarkdown)
library(yaml)
library(gridExtra)
library(testit)
library(shinyjs)

### INITIALIZE
load_origin_distmaps('/wehisan/general/user_managed/grpu_naik.s_2/TW/maps/origin/')
load_pair_distmaps('/wehisan/general/user_managed/grpu_naik.s_2/TW/maps/origin/')
#NN156 = readRDS(file = "Loxcode_experiments/NN156.rds")
#NN167 = readRDS(file = "Loxcode_experiments/NN167.rds")
#col = readRDS(file = "Loxcode_experiments/col.rds")
#exp = list(col, NN167, NN156)

#lox <- col
# attr(lox,"alias")=list()
# lox = fill_alias(lox);
exp = list(lox)
d <- summary_table(lox, "all_samples")

### CONSTANTS
chart_choices = c("Statistics Plots", "Heatmap", "Saturation Plot", "Pair Comparison Plot")
codeset_selectionID = c("codeset_stats", "view_codeset", "codeset_stats", "codeset_heat", "codeset_sat", "filter_code_name", "filter_codeset", "codeset_pair")
sample_selectionID = c("view_sample", "matrix_stats", "matrix_heat", "filter_name", "independent_samples", "sampleset_sat", "sampleset_pair")
samplesID = c("size_sample", "complexity_sample", "sample_sat")

### ACTIVITY LOG
startSession = "Session started."
refreshSession = "Session refreshed."

### VARIABLES
react <- reactiveValues(curr=lox, name=lox@name, exp=exp, samp=d, curr_pair=NULL, pairs=list())
global <- reactiveValues()
params <- reactiveValues(functions=list(), types=list(), inputs=list(), annotations=list(), loxcodes=list())
logs <- reactiveValues(activity=list(startSession), timestamps=list(paste(Sys.time())))
sat <- reactiveValues(samples=list(), codesets=list())

### UPDATE FUNCTIONS
updateCodesetSelection <- function(session, selectionID, selected) {
  for (ID in selectionID){
    updateSelectInput(session, ID, choices=names(react$curr@code_sets), selected=selected)
  }
}

updateSampleSelection <- function(session, selectionID, selected) {
  for (ID in selectionID){
    updateSelectInput(session, ID, choices=names(react$curr@count_matrixes), selected=selected)
  }
}

updateSamples <- function(session) {
  choices = names(react$curr@samples)
  updateSelectInput(session, "sample1_pair", "Sample 1:", choices=choices)
  updateSelectInput(session, "sample2_pair", "Sample 2:", choices=choices)
  for (ID in samplesID) {
    updateSelectInput(session, ID, "", choices=choices)
  }
}

updateCurrentExp <- function(session, curr, exp) {
  index = match(curr@name, exp_table(exp)$Experiment_Name)
  exp = list.remove(exp, index)
  exp = list.append(exp, curr)
  return(exp)
}

validateFastq <- function(session, samplesheet, files) {
  files = sort(files[grepl(".fastq$", files)])
  R1 = sort(files[grepl("R1_001.", files)])
  R2 = sort(files[grepl("R2_001.", files)])

  if ("sample" %in% names(samplesheet)){
    sample_names = sort(samplesheet$sample)
  } else {
    showNotification("Sample sheet is invalid. Missing `sample` column.")
    return(FALSE)
  }

  # find the fastq files for each sample
  for (i in sample_names) {
    if (sum(grepl(i,R1))!=1 || sum(grepl(i,R2))!=1) {
      showNotification(paste("Could not find *.fastq file for sample", i, "in fastq directory."))
      return(FALSE)
    }
  }

  # checks if there are two runs each in fastq directory
  if (length(R1) != length(R2)) {
    for (s in R1){
      if ((gsub("_R1_001", "_R2_001", s) %in% R2) == FALSE) {
        showNotification(paste(s, "is missing `R2_001` run in fastq directory."))
      }
    }
    for (s in R2){
      if ((gsub("_R2_001", "_R1_001", s) %in% R1) == FALSE) {
        showNotification(paste(s, "is missing `R1_001` run in fastq directory."))
      }
    }
  }

  return (TRUE)
}

# Function to call in place of dropdownMenu
dropdownMenuCustom <- function (..., type = c("messages", "notifications", "tasks"),
                                badgeStatus, icon = NULL, .list = NULL, customSentence = customSentence)
{
  type <- match.arg(type)
  if (!is.null(badgeStatus)) shinydashboard:::validateStatus(badgeStatus)
  items <- c(list(...), .list)
  lapply(items, shinydashboard:::tagAssert, type = "li")
  dropdownClass <- paste0("dropdown ", type, "-menu")
  if (is.null(badgeStatus)) {badge <- NULL}
  else {badge <- span(class = paste0("label label-", badgeStatus), numItems)}
  tags$li(
    class = dropdownClass,
    a(
      href = "#",
      class = "dropdown-toggle",
      `data-toggle` = "dropdown",
      icon,
      badge
    ),
    tags$ul(
      class = "dropdown-menu",
      tags$li(
        class = "header",
        customSentence(numItems, type)
      ),
      tags$li(
        tags$ul(class = "menu", items)
      )
    )
  )
}

customSentence <- function(numItems, type) {
  paste("Current Loxcode Experiment")
}

shinyalertAnnotate <- function(session, callbackR) {
  shinyalert(
    title = "Annotate",
    text = "Write a short description that describes your plot: ",
    closeOnClickOutside = TRUE,
    showCancelButton = TRUE,
    type = "input",
    inputType = "text",
    callbackR = callbackR
  )}

shinyalertDescribe <- function(session, type, callbackR) {
  shinyalert(
    title = "Describe",
    text = paste("Write a short description that describes how you filtered the", switch(type, "sample"="sample", "code"="code"), "set: "),
    closeOnClickOutside = TRUE,
    showCancelButton = TRUE,
    type = "input",
    inputType = "text",
    callbackR = callbackR
)}

shinyalertName <- function(session, callbackR) {
  shinyalert(
    title = "Name",
    text = "Name the merged experiment: ",
    type = "input",
    inputType = "text", callbackR = callbackR
  )
}

### INCLUDE IN REPORT
include <- function(value, plot, type, input) {
  params$functions = list.append(params$functions, plot)
  params$types = list.append(params$types, type)
  params$inputs = list.append(params$inputs, input)
  params$annotations = list.append(params$annotations, value)
  params$loxcodes = list.append(params$loxcodes, react$curr)
  addToLog(session, logReport(session, react$curr, type, input))
}

### ACTIVITY LOG FUNCTIONS
# Add item to activity log
addToLog <- function(session, item) {
  logs$activity = list.append(logs$activity, item)
  logs$timestamps = list.append(logs$timestamps, paste(Sys.time()))
}

# log import
logUpload <- function(session, lox, method) {
  item = paste("Uploaded loxcode_experiment ", lox@name, "by",
               switch(method, "rds"="'RDS object upload'.", "fastq"="'fastq files and directory upload'."))
  return (item)
}

# log merge experiments
logMerge <- function(session, experiments, lox) {
  names = ""
  for (i in 1:length(experiments)) {
    if (i != (length(experiments))) { names = paste0(names, experiments[[i]]@name, sep = ", ") }
    else { names = paste0(names, experiments[[i]]@name, sep = " ")}
  }
  item = paste0("Merged Loxcode experiments: ", names, ". Created: ", lox@name, ". ")
  return (item)
}

# log created sample sets or code sets
logCreate <- function(session, lox, set_name, type, method, description="") {
  item = paste("Created new ", type, " set in ", lox@name, " (", set_name, ") by ",
               switch(method, "selection"="'Create from Selection'.", "all"="'Create from All'."), description)
  return (item)
}

# log rename or delete sample sets or code sets
logUpdate <- function(session, lox, set_name, type, method, new_name=NULL) {
  item = paste(switch(method, "rename"="Renamed", 'delete'="Deleted"),
               type, " set in ", lox@name, " (", set_name, ") ",
               switch(method, "rename"=paste("to '", new_name, "'"), "delete"=""), ".")
  return (item)
}

# log collapse samples
logCollapse <- function(session, lox, new_set, union, average, params) {
  type <- function() {
    if (union & average) { type = paste("(union and average)") }
    else if (union & !average) { type = paste("(union and sum)") }
    else if (!union & average) { type = paste("(intersection and average)")}
    else { type = paste("(intersection and sum)")}
    return (type)
  }
  item = paste("Collapsed", type(), "of samples in", lox@name, "on parameters:",
               paste(params, collapse=", "), ". Created sample set '", new_set, "'.")
  return (item)
}

# log filter codes
logFilter <- function(session, lox, sample, code, max_reps, tolerance, new_name) {
  item = paste("Filtered codes in", lox@name, "on parameters: Sample_set =", sample, ", Code_set =", code,
               ", Max_reps = ", max_reps, ", Tolerance_level =", tolerance, ". Created code set '", new_name, "'.")
  return (item)
}

# log add to report
logReport <- function(session, lox, plot, parameters) {
  item = paste("Added plot to report.", capitalize(plot), "of", lox@name)
  if (plot!="pair_comparison_plot") {
    item = paste(item, "with parameters: ", paramsAsText(parameters))
  }
  item = paste(item, ".")
  return (item)
}

# log download report
logDownloadReport <- function(session, file, type) {
  item = paste("Downloaded", type, "file.", file, sep=" ")
  return (item)
}

### converts the parameters into text
paramsAsText <- function(params) {
  parametersAsText = list()
  for (i in 1:length(params)) {
    n = names(params)[[i]]
    p = params[[i]]
    if (is(p, "loxcode_experiment") | is(p, "loxcode_sample")) {
      parametersAsText = list.append(parametersAsText, paste(n, "=", p@name))
    }
    else if (is.character(p)) {
      parametersAsText = list.append(parametersAsText, paste(n, "=", p))
    }
    else if (is.numeric(p)) {
      parametersAsText = list.append(parametersAsText, paste(n, "=", paste(p, ",")))
    }
    else if (rapportools::is.boolean(p)) {
      parametersAsText = list.append(parametersAsText, paste(n, "=", p))
    }
  }
  return(paste(parametersAsText, collapse=", "))
}

function(input, output, session) {

  # current loxcode_experiment object
  output$curr_lox = renderMenu({
    dropdownMenuCustom(
      type = "messages",
      icon = icon("bookmark"),
      badgeStatus = NULL,
      customSentence = customSentence,
      messageItem(from=react$curr@name, message="", icon=icon("dna"), href=NULL)
  )})

  ### IMPORT
  # upload loxcode_experiment object
  observeEvent(
    input$submit_rds, {
      if (is.null(input$rds_file)){
        showNotification("Please specify a file path.")
        return
      } else {
        if (grepl(".rds$", input$rds_file[[length(input$rds_file)]])){
          obj = readRDS(file=input$rds_file$datapath)
          if (is(obj, "loxcode_experiment")){
            react$curr <- obj
            react$samp <- sample_table(react$curr, "all_samples")
            react$exp <- rlist::list.append(react$exp, react$curr)
            updateSampleSelection(session, sample_selectionID, NULL)
            updateCodesetSelection(session, codeset_selectionID, NULL)
            updateSamples(session)
            addToLog(session, logUpload(session, react$curr, "rds"))
          } else {
            shinyalert("Oops!", "Object uploaded was not of class <loxcode_experiment>")
          }
        } else {
          shinyalert("Oops!", "File uploaded was not an R object (*.rds).", type="error")
        }
      }
    }
  )

  observeEvent(
    input$submit_fastq, {
      files = list.files(input$dir_input)

      if (is.null(input$samplesheet)){
        showNotification("Please specify a file path.")
      } else {
        if (grepl(".xls$", input$samplesheet$datapath) | grepl(".xlsx$", input$samplesheet$datapath)){ # validate file extension
          samplesheet = read_excel(input$samplesheet$datapath)
          print(input$samplesheet$datapath)

          if (validateFastq(session, samplesheet, files)) { # validate file contents
            newlox <- load_from_xlsx(
              name = input$name_exp,
              s=input$samplesheet$datapath,
              dir=input$dir_input,
              load = TRUE,
              full = FALSE)
            react$curr <- newlox
            react$samp <- sample_table(react$curr, "all_samples")
            react$exp <- rlist::list.append(react$exp, react$curr)
            updateSampleSelection(session, sample_selectionID, NULL)
            updateCodesetSelection(session, codeset_selectionID, NULL)
            updateSamples(session)
            addToLog(session, logUpload(session, react$curr, "fastq"))
          } else {
            shinyalert("Oops!", "Invalid files uploaded.", type="error")
          }

        } else {
          shinyalert("Oops!", "File uploaded was not an excel file (*.xls or *.xlsx).", type="error")
        }
      }
    }
  )

  # table of loxcode_experiment objects
  output$experiments_table = renderDataTable({datatable(
    exp_table(react$exp),
    rownames = FALSE,
    class = "cell-border stripe",
    filter = 'top',
    selection = 'multiple'
  )})

  observeEvent(
    input$select_exp, {
      if (is.null(input$experiments_table_rows_selected) |
          length(input$experiments_table_rows_selected) > 1) {
        shinyalert("Oops!", "Please select one experiment!", type = "error")
        return ()
      }
      else if (length(input$experiments_table_rows_selected) == 1) {
        react$curr = react$exp[[input$experiments_table_rows_selected]]
        showNotification(paste(react$curr@name, " selected."))
      }
    }
  )

  observeEvent(
    input$merge_exp, {
      if (length(input$experiments_table_rows_selected) != 2) {
        shinyalert("Oops!", "Please select two experiments to merge!", type = "error")
        return()
      }
      else {
        shinyalertName(session, mergeExperiments)
      }
  })

  mergeExperiments <- function(value) {
    index = input$experiments_table_rows_selected[1:2]
    experiments = react$exp[index]
    showNotification("Merging experiments...")
    react$curr = merge_experiments(experiments[[1]], experiments[[2]], name = value)
    showNotification("Experiments merged!")
    react$samp <- sample_table(react$curr, "all_samples")
    react$exp <- rlist::list.append(react$exp, react$curr)
    updateSampleSelection(session, sample_selectionID, NULL)
    updateCodesetSelection(session, codeset_selectionID, NULL)
    updateSamples(session)
    addToLog(session, logMerge(session, experiments, react$curr))
  }

  # samplesheet view
  output$samplesheet = renderDataTable({
    d = data.frame()
    if (!is.null(input$samplesheet)) {
      d = read_excel(input$samplesheet$datapath)
      d$Status = ""
    }
    datatable(d)
  })

  output$save_exp = downloadHandler(
    filename = function() {
      paste("data-", Sys.Date(), ".rds", sep="")
    },
    content = function(file) {
      saveRDS(react$curr, file)
    }
  )

  observeEvent(
    input$del_exp, {
      if (!is.null(input$experiments_table_rows_selected)){
        react$exp = list.remove(react$exp, input$experiments_table_rows_selected)
      }
    }
  )

  ### CREATE CODESET
  output$codeset_table = renderDataTable({datatable(
    codeset_table(react$curr, input$view_codeset),
    rownames = FALSE,
    class = "cell-border stripe",
    filter = 'top'
  )} %>% formatStyle(columns=c(seq(2, ncol(react$samp))), 'text-align'='center'))

  output$selected_codes = renderPrint({
    s = input$codeset_table_rows_selected
    d <- codeset_table(react$curr, input$view_codeset)
    if (length(s)) {
      if (length(s)==1) { cat(length(s),'Code Selected:\n\n') }
      else { cat(length(s),'Codes Selected:\n\n') }
      cat(d$Code[s], sep = ', ')
    }
  })

  observeEvent(
    input$delete_codeset, {
      react$curr <- delete_codeset(react$curr, input$view_codeset)
      addToLog(session, logUpdate(session, react$curr, input$view_codeset, "code", "delete"))
      updateCodesetSelection(session, codeset_selectionID, input$name_codeset)
      react$exp = updateCurrentExp(session, react$curr, react$exp)
    }
  )

  observeEvent(
    input$create_codeset, {
      selection = input$codeset_table_rows_selected
      if (length(selection)) {
        react$curr = make_codeset_index(react$curr, c=input$view_codeset, I=selection, n=input$name_codeset)
        addToLog(session, logCreate(session, react$curr, input$name_codeset, "code", "selection"))
        updateCodesetSelection(session, codeset_selectionID, input$name_codeset)
        updateTextInput(session, "name_codeset", label="Name of new codeset:", placeholder="Codeset Name", value="")
        react$exp = updateCurrentExp(session, react$curr, react$exp)
      }
    }
  )

  observeEvent(
    input$create_all_codeset, {
      react$curr = make_codeset_index(react$curr, c=input$view_codeset, I=input$codeset_table_rows_all, n=input$name_codeset)
      global$name = input$name_codeset
      shinyalertDescribe(session, "code", logCodeFilter)
      updateCodesetSelection(session, codeset_selectionID, input$name_codeset)
      updateTextInput(session, "name_codeset", label="Name of new codeset:", placeholder="Codeset Name", value="")
      react$exp = updateCurrentExp(session, react$curr, react$exp)
    }
  )

  logCodeFilter <- function(value) {
    addToLog(session, logCreate(session, react$curr, global$name, "code", "all", value))
  }

  includeRatio <- function(value) {
    include(value=value,
            plot=readstats_plot,
            type="readstats_plot",
            input=list(loxcode_experiment=react$curr, count_matrix=input$matrix_stats, code_set=input$codeset_stats, plot="ratio")
    )}

  observeEvent(
    input$rename_codeset, {
      react$curr = rename_codeset(react$curr, c=input$view_codeset, n=input$name_codeset)
      addToLog(session, logUpdate(session, react$curr, input$view_codeset, "code", "rename", input$name_codeset))
      updateCodesetSelection(session, codeset_selectionID, input$name_codeset)
      updateTextInput(session, "name_codeset", label="Name of new codeset:", placeholder="Codeset Name", value="")
      react$exp = updateCurrentExp(session, react$curr, react$exp)
    }
  )

  ### CREATE SAMPLE SET
  output$sample_table = renderDataTable({
    d <- summary_table(react$curr, input$view_sample)
    react$samp <- d
    datatable(
      d,
      filter = 'top',
      rownames = FALSE,
      class = "cell-border stripe",
      editable = list(target="cell", disable=list(columns=c(0, seq(2, ncol(react$samp))))),
      options = list(
        dom = 't',
        scrollX = TRUE,
        scrollY = TRUE,
        scroller=TRUE,
        fixedColumns = list(leftColumns = 2)
      ),
      extensions = c('FixedColumns','Scroller')
    )} %>% formatStyle(columns=c(seq(3, ncol(react$samp))), 'text-align'='center'))

  observeEvent(
    input$view_sample, {
      d <- summary_table(react$curr, input$view_sample)
      react$samp <- d
  })

  output$selected_samples = renderPrint({
    s = input$sample_table_rows_selected
    d <- summary_table(react$curr, input$view_sample)
    if (length(s)) {
      if (length(s)==1) { cat(length(s),'Sample Selected:\n\n') }
      else { cat(length(s),'Samples Selected:\n\n') }
      cat(d$Sample_Name[s], sep = ', ')
    }
  })

  # renaming samples
  proxy = dataTableProxy("sample_table")
  observeEvent(
    input$sample_table_cell_edit, {
      d = react$samp
      info = input$sample_table_cell_edit
      i = info$row
      j = info$col + 1  # column index offset by 1
      v = info$value
      d[i, j] <<- coerceValue(v, d[i, j])
      sample = d[i,j-1]
      replaceData(proxy, d, resetPaging=FALSE, rownames=FALSE)
      react$curr = new_alias(react$curr, input$view_sample, sample, v)
      updateSelectInput(session, "sample1_pair", "Sample 1:", choices=names(react$curr@samples), selected=input$sample1_pair)
      updateSelectInput(session, "sample2_pair", "Sample 2:", choices=names(react$curr@samples), selected=input$sample1_pair)
      react$exp = updateCurrentExp(session, react$curr, react$exp)
    })

  # create sample set from selection
  observeEvent(
    input$create_sample, {
      selection = input$sample_table_rows_selected
      if (length(selection)) {
        react$curr = make_count_matrix(react$curr, c=input$view_sample, I=selection, n=input$name_sample)
        print(input$view_sample)
        addToLog(session, logCreate(session, react$curr, input$name_sample, "sample set", "selection"))
        updateSampleSelection(session, sample_selectionID, input$name_sample)
        updateTextInput(session, "name_sample", label="Name of new collection of samples:", placeholder="Sample Collection Name", value="")
        react$exp = updateCurrentExp(session, react$curr, react$exp)
      }
    }
  )

  # create sample set from all
  observeEvent(
    input$create_all_sample, {
      react$curr = make_count_matrix(react$curr, c=input$view_sample, I=input$sample_table_rows_all, n=input$name_sample)
      global$name = input$name_sample
      shinyalertDescribe(session, "sample", logSampleFilter)
      updateSampleSelection(session, sample_selectionID, input$name_sample)
      updateTextInput(session, "name_sample", label="Name of new collection of samples:", placeholder="Sample Collection Name", value="")
      react$exp = updateCurrentExp(session, react$curr, react$exp)
    }
  )

  logSampleFilter <- function(value) {
    print(input$name_sample)
    addToLog(session, logCreate(session, react$curr, global$name, "sample set", "all", value))
  }

  # delete a sample set
  observeEvent(
    input$delete_sample, {
      react$curr <- delete_count_matrix(react$curr, input$view_sample)
      addToLog(session, logUpdate(session, react$curr, input$view_sample, "sample", "delete"))
      updateSampleSelection(session, sample_selectionID, "all_samples")
      react$exp = updateCurrentExp(session, react$curr, react$exp)
    }
  )

  # rename sample set
  observeEvent(
    input$rename_sample, {
      if (input$view_sample == "all_samples") { showNotification("Sample set 'all_samples' cannot be renamed.") }
      else {
        react$curr = rename_sampleset(react$curr, input$view_sample, input$name_sample)
        addToLog(session, logUpdate(session, react$curr, input$view_sample, "sample", "rename", input$name_sample))
        updateSampleSelection(session, sample_selectionID, input$name_sample)
        updateTextInput(session, "name_sample", label="Name of new collection of samples:", placeholder="Sample Collection Name", value="")
        react$exp = updateCurrentExp(session, react$curr, react$exp)
      }
    }
  )

  # generate aliases
  observeEvent(
    input$generate_alias,
    if (!length(input$alias_parameters)) { return() }
    else {
      react$curr = generate_alias(react$curr, input$view_sample, input$alias_parameters)
    }
  )

  observe({
    updateCheckboxGroupInput(
      session,
      "alias_parameters",
      "Choose alias parameters:",
      choices=names(get_collapsed_meta(react$curr, input$view_sample)))
  })

  # collapse samples
  observeEvent(
    input$collapse_samples, {
      if (!length(input$collapse_parameters)) { return() }
      else {
        react$curr <- collapse(react$curr, input$view_sample, input$collapse_parameters, input$collapse_name, input$collapse_union, input$collapse_average)
        addToLog(session, logCollapse(session, react$curr, input$collapse_name, input$collapse_union, input$collapse_average, input$collapse_parameters))
        updateSampleSelection(session, sample_selectionID, input$collapse_name)
        updateCheckboxInput(session, "collapse_union", "Union", value=NULL)
        updateCheckboxInput(session, "collapse_average", "Average", value=NULL)
        updateTextInput(session, "collapse_name", label="Name of new sample set:", placeholder="Sample Set Name", value="")
        updateCheckboxGroupInput(session, "collapse_parameters", "Choose parameters to collapse:", choices=names(get_collapsed_meta(react$curr, input$view_sample)), selected=NULL)
        react$exp = updateCurrentExp(session, react$curr, react$exp)
      }
    }
  )

  observeEvent(
    input$collapse_selection, {
      if (length(input$sample_table_rows_selected) < 1) { return () }
      else {
        react$curr = collapse_selection(lox=react$curr, s=input$view_sample, i=input$sample_table_rows_selected, union=input$collapse_union, average=input$collapse_average)
      }
    }
  )

  observe({
    updateCheckboxGroupInput(
      session,
      "collapse_parameters",
      "Choose parameters to collapse:",
      choices=names(get_collapsed_meta(react$curr, input$view_sample)))
  })

  ### FILTER CODES
  output$unfiltered_codes = renderPlot(
    code_frequency_pie(react$curr, input$independent_samples, input$filter_codeset)
  )

  output$filtered_codes = renderPlot(
    filtered_codes_pie(react$curr, input$independent_samples, input$filter_codeset, input$filter_tolerance, input$filter_reps)
  )

  observe({
    if (is.null(react$curr)) { return () }
    else {
      updateSelectInput(session, "filter_codeset", choices = names(react$curr@code_sets)[!names(react$curr@code_sets) == "invalid_codes"])
    }
  })

  observe({
    if (is.null(react$curr@code_sets[[input$filter_codeset]])) { return () }
    else {
      Y = code_freq_table(react$curr, input$independent_samples, input$filter_codeset)
      total = max(as.numeric(names(Y[,!names(Y)%in%c("size", "dist_orig", "radius")])))
      updateSliderInput(session, "filter_reps", label="Maximum allowed code repetitions", min=2, max=total, value=input$filter_reps, step=1)
    }
  })

  # filter codes
  observeEvent(
    input$create_filtered, {
      params = list(react$curr, input$independent_samples, input$filter_codeset, input$filter_tolerance, input$filter_reps, input$filter_code_name)
      react$curr = do.call(make_filtered_codeset, params)
      addToLog(session, do.call(logFilter, list.append(session, params)))
      react$exp = updateCurrentExp(session, react$curr, react$exp)
      updateCodesetSelection(session, codeset_selectionID, input$filter_code_name)
      updateSampleSelection(session, sample_selectionID, input$independent_samples)
    }
  )

  ### STATISTICS PLOT
  # Size plot
  output$size_plot = renderPlotly({
    ggplotly(readstats_plot(react$curr, count_matrix=input$matrix_stats, code_set=input$codeset_stats, plot="size", fill=input$fill_size, labels=input$labels_stats))
  })

  observeEvent(
    input$includeSize, {
      shinyalertAnnotate(session, includeSize)
  })

  includeSize <- function(value) {
    include(value=value,
            plot=readstats_plot,
            type="readstats_plot",
            input=list(loxcode_experiment=react$curr, count_matrix=input$matrix_stats, code_set=input$codeset_stats, plot="size", fill=input$fill_size, labels=input$labels_stats)
  )}

  # Complexity plot
  output$complexity_plot = renderPlotly({
    ggplotly(readstats_plot(react$curr, count_matrix=input$matrix_stats, code_set=input$codeset_stats, plot="complexity", fill=input$fill_complexity, labels=input$labels_stats))
  })

  observeEvent(
    input$includeComplexity, {
      shinyalertAnnotate(session, includeComplexity)
    })

  includeComplexity <- function(value) {
    include(value=value,
            plot=readstats_plot,
            type="readstats_plot",
            input=list(loxcode_experiment=react$curr, count_matrix=input$matrix_stats, code_set=input$codeset_stats, plot="complexity", fill=input$fill_complexity, labels=input$labels_stats)
  )}

  # Ratio plot
  output$ratio_plot = renderPlotly({
    ggplotly(readstats_plot(react$curr, count_matrix=input$matrix_stats, code_set=input$codeset_stats, plot="ratio", labels=input$labels_stats))
  })

  observeEvent(
    input$includeRatio, {
      shinyalertAnnotate(session, includeRatio)
    })

  includeRatio <- function(value) {
    include(value=value,
            plot=readstats_plot,
            type="readstats_plot",
            input=list(loxcode_experiment=react$curr, count_matrix=input$matrix_stats, code_set=input$codeset_stats, plot="ratio", labels=input$labels_stats)
  )}

  # Both plot
  output$both_plot = renderPlotly({
    ggplotly(readstats_plot(react$curr, count_matrix=input$matrix_stats, code_set=input$codeset_stats, plot="both", labels=input$labels_stats))
  })

  observeEvent(
    input$includeBoth, {
      shinyalertAnnotate(session, includeBoth)
    })

  includeBoth <- function(value) {
    include(value=value,
            plot=readstats_plot,
            type="readstats_plot",
            input=list(loxcode_experiment=react$curr, count_matrix=input$matrix_stats, code_set=input$codeset_stats, plot="both", labels=input$labels_stats)
  )}

  # sample size plot
  output$sample_size_plot = renderPlotly({
    size_plot(lox = react$curr,
              sample = input$size_sample,
              count_matrix = input$matrix_stats,
              code_set = input$codeset_stats,
              labels = input$labels_stats)
  })

  observeEvent(
    input$includeSampleSize, {
      shinyalertAnnotate(session, includeSampleSize)
    }
  )

  includeSampleSize <- function(value) {
    include(value=value,
            plot=size_plot,
            type="size_plot",
            input=list(lox = react$curr,
                       sample = input$size_sample,
                       count_matrix = input$matrix_stats,
                       code_set = input$codeset_stats,
                       labels = input$labels_stats))
  }

  # sample complexity plot
  output$sample_complexity_plot = renderPlotly({
    dist_orig_plot(lox = react$curr,
                   sample = input$complexity_sample,
                   count_matrix = input$matrix_stats,
                   code_set = input$codeset_stats,
                   labels = input$labels_stats)
  })

  observeEvent(
    input$includeSampleComplexity, {
      shinyalertAnnotate(session, includeSampleComplexity)
    }
  )

  includeSampleComplexity <- function(value) {
    include(value=value,
            plot=dist_orig_plot,
            type="dist_orig_plot",
            input=list(lox = react$curr,
                       sample = input$complexity_sample,
                       count_matrix = input$matrix_stats,
                       code_set = input$codeset_stats,
                       labels = input$labels_stats))
  }

  # selection by sample name or alias
  observe(
    if (is.null(react$curr)) { return() }
    else{
      aliases = react$curr@alias[[input$matrix_stats]]
      if (is.null(aliases)) { return() }
      else {
        updateSelectInput(session, "size_sample", "Samples", choices=aliases$sample_name)
        updateSelectInput(session, "complexity_sample", "Samples", choices=aliases$sample_name)
        updateSelectInput(session, "size_alias", "Samples", choices=aliases$alias)
        updateSelectInput(session, "complexity_alias", "Samples", choices=aliases$alias)
      }
    }
  )

  # coordinate sample names and aliases
  observe(
    if (is.null(react$curr)) { return() }
    else{
      aliases = react$curr@alias[[input$matrix_stats]]

      if (is.null(aliases) | input$size_sample=="" | input$size_alias==""| input$complexity_sample=="" | input$complexity_alias=="") { return () }

      else if (input$labels_stats=='alias') {
        selected_size_sample = get_samplename(react$curr, input$matrix_stats, input$size_alias)
        updateSelectInput(session, "size_sample", "Samples",
                          choices = aliases$sample_name,
                          selected = selected_size_sample)
        selected_complexity_sample = get_samplename(react$curr, input$matrix_stats, input$complexity_alias)
        updateSelectInput(session, "complexity_sample", "Samples",
                          choices = aliases$sample_name,
                          selected = selected_complexity_sample)
      }

      else if (input$labels_stats=='sample') {
        selected_size_sample = get_alias(react$curr, input$matrix_stats, input$size_sample)
        updateSelectInput(session, "size_alias", "Samples",
                          choices = aliases$alias,
                          selected = selected_size_sample)
        selected_complexity_sample = get_alias(react$curr, input$matrix_stats, input$complexity_sample)
        updateSelectInput(session, "complexity_alias", "Samples",
                          choices = aliases$alias,
                          selected = selected_complexity_sample)
      }
    }
  )

  ### HEATMAP PLOT
  output$heatmap_plotly = renderPlotly({
    ggplotly(heatmap_plot(react$curr, count_matrix=input$matrix_heat, code_set=input$codeset_heat, style=input$style_heat, labels=input$labels_heat, clustering=input$clustering,agglomeration=input$agglomeration,min_reads=input$min_reads,max_repeats=input$max_repeats,min_repeats=input$min_repeats))
  })

  output$heatmap_ggplot = renderPlot({
    heatmap_plot(react$curr, count_matrix=input$matrix_heat, code_set=input$codeset_heat, style=input$style_heat, labels=input$labels_heat, clustering=input$clustering,agglomeration=input$agglomeration,min_reads=input$min_reads,max_repeats=input$max_repeats,min_repeats=input$min_repeats)
  })

  output$bubble_ggplot = renderPlot({
    bubble_plot(react$curr, count_matrix=input$matrix_heat, code_set=input$codeset_heat, style=input$style_heat, labels=input$labels_heat, clustering=input$clustering,agglomeration=input$agglomeration,min_reads=input$min_reads,max_repeats=input$max_repeats,min_repeats=input$min_repeats)
  })

  output$bubble_plotly = renderPlotly({
    ggplotly(bubble_plot(react$curr, count_matrix=input$matrix_heat, code_set=input$codeset_heat, style=input$style_heat, labels=input$labels_heat, clustering=input$clustering,agglomeration=input$agglomeration,min_reads=input$min_reads,max_repeats=input$max_repeats,min_repeats=input$min_repeats))
  })

  observeEvent(
    input$includeHeatmap, {
      shinyalertAnnotate(session, includeHeatmap)
    })

  includeHeatmap <- function(value) {
    include(value=value,
            plot=heatmap_plot,
            type="heatmap_plot",
            input=list(loxcode_experiment=react$curr, count_matrix=input$matrix_heat, code_set=input$codeset_heat, style=input$style_heat, labels=input$labels_heat, clustering=input$clustering,agglomeration=input$agglomeration,min_reads=input$min_reads,max_repeats=input$max_repeats,min_repeats=input$min_repeats)
    )}

  observeEvent(
    input$includeBubble, {
      shinyalertAnnotate(session, includeBubble)
    })

  includeBubble <- function(value) {
    include(value=value,
            plot=bubble_plot,
            type="bubble_plot",
            input=list(loxcode_experiment=react$curr, count_matrix=input$matrix_heat, code_set=input$codeset_heat, style=input$style_heat, labels=input$labels_heat, clustering=input$clustering,agglomeration=input$agglomeration,min_reads=input$min_reads,max_repeats=input$max_repeats,min_repeats=input$min_repeats)
    )}

  output$sample_comparison_pie = renderPlot({
    sample_comparison_pie(react$curr, input$matrix_heat, input$codeset_heat, scale=as.numeric(input$scale_pie), labels=input$labels_heat)
  })

  ### SATURATION PLOT
  output$saturation = renderPlotly({
    ggplotly(saturation_multi(react$curr, list.append(sat$samples, input$sample_sat), list.append(sat$codesets, input$codeset_sat)))
  })

  observeEvent(
    input$includeSaturation, {
      shinyalertAnnotate(session, includeSaturation)
  })

  includeSaturation <- function(value) {
    include(value=value,
            plot=saturation_plot,
            type="saturation_plot",
            input=list(loxcode_experiment=react$curr, loxcode_sample=input$sample_sat, code_set=input$codeset_sat)
  )}

  # add plot
  observeEvent(
    input$add_sat, {
      sat$samples = list.append(sat$samples, input$sample_sat)
      sat$codesets = list.append(sat$codesets, input$codeset_sat)
  })

  # remove last plot
  observeEvent(
    input$remove_sat, {
      n = length(sat$samples)
      if (n==0) { return() }
      else if (n==1) {
        sat$samples <- list()
        sat$codesets <- list()
      }
      else {
        sat$samples[[n]] <- NULL
        sat$codesets[[n]] <- NULL
      }
  })

  # clear plot
  observeEvent(
    input$clear_sat, {
      sat$samples <- list()
      sat$codesets <- list()
  })

  # switch between sample names and aliases
  observe(
    if (is.null(react$curr)) { return() }
    else{
      aliases = react$curr@alias[[input$sampleset_sat]]
      if (is.null(aliases)) { return() }
      else {
        updateSelectInput(session, "sample_sat", "Samples", choices=aliases$sample_name)
        updateSelectInput(session, "alias_sat", "Samples", choices=aliases$alias)
      }
    }
  )

  # coordinate sample names and aliases
  observe(
    if (is.null(react$curr)) { return() }
    else{
      aliases = react$curr@alias[[input$sampleset_sat]]

      if (is.null(aliases) | input$sample_sat=="" | input$alias_sat=="") { return () }

      else if (input$name_sat=='alias') {
        selected_sample = get_samplename(react$curr, input$sampleset_sat, input$alias_sat)
        updateSelectInput(session, "sample_sat", "Samples",
                          choices = aliases$sample_name,
                          selected = selected_sample)
      }

      else if (input$name_sat=='sample') {
        selected_sample = get_alias(react$curr, input$sampleset_sat, input$sample_sat)
        updateSelectInput(session, "alias_sat", "Samples",
                          choices = aliases$alias,
                          selected = selected_sample)
      }
    }
  )

  ### PAIR COMPARISON PLOT
  # ggplot
  output$pair_ggplot = renderPlot({
    range = switch(input$colour_pair, "size"=input$size_slider_pair, "complexity"=input$complexity_slider_pair)
    react$curr_pair <- pair_comparison_plot2(
      lox = react$curr,
      s1 = react$curr@samples[[input$sample1_pair]],
      s2 = react$curr@samples[[input$sample2_pair]],
      sampleset = input$sampleset_pair,
      codeset = input$codeset_pair,
      colorBy = input$colour_pair,
      sizeRange = input$size_slider_pair,
      dist_origRange = input$complexity_slider_pair,
      firstreadRange = input$firstread_slider_pair
    )
    do.call(grid.arrange, list.append(react$pairs, react$curr_pair))
  })

  # plotly
  output$pair_plotly = renderPlotly({
    range = switch(input$colour_pair, "size"=input$size_slider_pair, "complexity"=input$complexity_slider_pair)
    react$curr_pair <- pair_comparison_plot2(
      lox = react$curr,
      s1 = react$curr@samples[[input$sample1_pair]],
      s2 = react$curr@samples[[input$sample2_pair]],
      sampleset = input$sampleset_pair,
      codeset = input$codeset_pair,
      colorBy = input$colour_pair
    )
    plotly_plots = lapply(list.append(react$pairs, react$curr_pair), ggplotly)
    do.call(subplot, plotly_plots)
  })

  # add new plot
  observeEvent(
    input$add_pair, { react$pairs = list.append(react$pairs, react$curr_pair) }
  )

  # remove previous pair plot
  observeEvent(
    input$remove_pair, {
      n = length(react$pairs)
      if (n==0) { return() }
      else if (n==1) { react$pairs <- list() }
      else { react$pairs[[n]] <- NULL }
    }
  )

  # clear all pair plots
  observeEvent(
    input$clear_pair, { react$pairs <- list() }
  )

  # add to report
  observeEvent(
    input$includePair, {
      shinyalertAnnotate(session, includePair)
  })

  includePair <- function(value) {
    include(value=value,
            plot=grid.arrange,
            type="pair_comparison_plot",
            input=list.append(react$pairs, react$curr_pair)
  )}

  # switch between sample names and aliases
  observe(
    if (is.null(react$curr)) { return() }
    else{
      aliases = react$curr@alias[[input$sampleset_pair]]
      if (is.null(aliases)) { return() }
      else {
        updateSelectInput(session, "sample1_pair", "Samples", choices=aliases$sample_name)
        updateSelectInput(session, "sample2_pair", "Samples", choices=aliases$sample_name)
        updateSelectInput(session, "alias1_pair", "Samples", choices=aliases$alias)
        updateSelectInput(session, "alias2_pair", "Samples", choices=aliases$alias)
      }
    }
  )

  # coordinate sample names and aliases
  observe(
    if (is.null(react$curr)) { return() }
    else{
      aliases = react$curr@alias[[input$sampleset_pair]]

      if (is.null(aliases) | input$sample1_pair=="" | input$sample2_pair=="" | input$alias1_pair=="" | input$alias2_pair=="") { return () }

      else if (input$name_pair=='alias') {
        selected_sample1 = get_samplename(react$curr, input$sampleset_pair, input$alias1_pair)
        updateSelectInput(session, "sample1_pair", "Samples",
                          choices = aliases$sample_name,
                          selected = selected_sample1)
        selected_sample2 = get_samplename(react$curr, input$sampleset_pair, input$alias2_pair)
        updateSelectInput(session, "sample2_pair", "Samples",
                          choices = aliases$sample_name,
                          selected = selected_sample2)
      }

      else if (input$name_pair=='sample') {
        selected_sample1 = get_alias(react$curr, input$sampleset_pair, input$sample1_pair)
        updateSelectInput(session, "alias1_pair", "Samples",
                          choices = aliases$alias,
                          selected = selected_sample1)
        selected_sample2 = get_alias(react$curr, input$sampleset_pair, input$sample2_pair)
        updateSelectInput(session, "alias2_pair", "Samples",
                          choices = aliases$alias,
                          selected = selected_sample2)
      }
    }
  )

  observe({
    # updates the slider based on the distance range of the samples selected
    samples = react$curr@samples
    if (is.null(samples) | is.null(samples[[input$sample1_pair]]) | is.null(samples[[input$sample2_pair]])) { return() }
    else {
      updateRange(samples, "complexity_slider_pair", "dist_orig")
      updateRange(samples, "size_slider_pair", "size")
      updateRange(samples, "firstread_slider_pair", "firstread")
    }
  })

  updateRange <- function(samples, slider, type) {
    min_one <- min(na.omit(samples[[input$sample1_pair]]@decode@data[[type]]))
    min_two <- min(na.omit(samples[[input$sample2_pair]]@decode@data[[type]]))
    max_one <- max(na.omit(samples[[input$sample1_pair]]@decode@data[[type]]))
    max_two <- max(na.omit(samples[[input$sample2_pair]]@decode@data[[type]]))
    newmin <- min(min_one, min_two)
    newmax <- max(max_one, max_two)
    updateSliderInput(session, slider, value = c(newmin,newmax), min=newmin, max=newmax)
  }

  ### DOWNLOAD REPORT
  output$components_table = renderDataTable(server=FALSE,{
    datatable(components_table(params),
              class = "cell-border stripe",
              editable = list(target="cell", disable=list(columns=c(0, 1, 2))),
              colnames = c(ID = 1),
              extensions = 'RowReorder',
              options = list(rowReorder=TRUE, order = list(c(0 , 'asc'))),
              callback=JS("// pass on data to R
                          table.on('row-reorder', function(e, details, changes) {
                            Shiny.onInputChange('components_table_row_reorder', JSON.stringify(details));
                          });")
  )})

  components_table <- function(params) {
    d = data.frame()
    if (length(params$functions) == 0) {
      return(data.frame())
    }
    for (i in 1:length(params$functions)) {
      row = data.frame("Plot_type" = params$types[[i]],
                       "Experiment" = params$loxcodes[[i]]@name,
                       "Annotation" = params$annotations[[i]],
                       stringsAsFactors = FALSE)
      d = plyr::rbind.fill(d, row)
    }
    return(d)
  }

  # edit annotations
  comp_proxy = dataTableProxy("components_table")
  observeEvent(
    input$components_table_cell_edit, {
      d = components_table(params)
      info = input$components_table_cell_edit
      i = info$row
      j = info$col
      v = info$value
      d[i, j] <<- coerceValue(v, d[i, j])
      replaceData(proxy, d, resetPaging=FALSE, rownames=FALSE)
      params$annotations[[i]] <- v
  })

  # reorder the rows
  observeEvent(input$components_table_row_reorder, {
    info <- input$components_table_row_reorder
    # error checking
    if(is.null(info) | class(info) != 'character') { return() }

    info <- read_yaml(text=info)
    saveRDS(info,"row.rds")

    if(length(info) == 0) { return() }
    reorder(info)
  })

  reorder <- function(info) {
    temp = list(functions=list(), types=list(), inputs=list(), annotations=list)
    temp$functions <- params$functions
    temp$types <- params$types
    temp$inputs <- params$inputs
    temp$annotations <- params$annotations
    temp$loxcodes <- params$loxcodes
    for (i in 1:length(info)) {
      curr=info[[i]]
      temp$functions[[curr$newPosition + 1]] = params$functions[[curr$oldPosition + 1]]
      temp$types[[curr$newPosition + 1]] = params$types[[curr$oldPosition + 1]]
      temp$inputs[[curr$newPosition + 1]] = params$inputs[[curr$oldPosition + 1]]
      temp$annotations[[curr$newPosition + 1]] = params$annotations[[curr$oldPosition + 1]]
      temp$loxcodes[[curr$newPosition + 1]] = params$loxcodes[[curr$oldPosition + 1]]
    }
    params$functions = temp$functions
    params$types = temp$types
    params$inputs = temp$inputs
    params$annotations = temp$annotations
    params$loxcodes = temp$loxcodes
  }

  # remove a component
  observeEvent(
    input$remove_component, {
      rows = input$components_table_rows_selected
      if (is.null(rows)) { return() }
      params$functions[rows] <- NULL
      params$types[rows] <- NULL
      params$inputs[rows] <- NULL
      params$annotations[rows] <- NULL
      params$loxcodes[rows] <- NULL
    }
  )

  # download report
  output$downloadReport <- downloadHandler(
    filename = function() {
      file = paste('my-report', sep = '.', switch(
        input$format, PDF = 'pdf', HTML = 'html', Word = 'docx'
      ))
      addToLog(session, logDownloadReport(session, file, input$format))
      return(file)
    },

    content = function(file) {
      src <- normalizePath('report.Rmd')

      # temporarily switch to the temp dir, in case you do not have write
      # permission to the current working directory
      owd <- setwd(tempdir())
      on.exit(setwd(owd))
      file.copy(src, 'report.Rmd', overwrite = TRUE)

      # set up parameters
      params <- list(
        format = input$format,
        functions = params$functions,
        types = params$types,
        inputs = params$inputs,
        annotations = params$annotations,
        loxcodes = params$loxcodes
      )

      out <- render(
        'report.Rmd',
        switch(input$format, PDF = pdf_document(), HTML = html_document(), Word = word_document()),
        params=params,
        envir = new.env(parent = globalenv()))
      file.rename(out, file)
    }
  )

  ### ACTIVITY LOG
  output$log_table = renderDataTable({datatable(
    log_table(logs),
    rownames = FALSE,
    class = "cell-border stripe",
    selection = 'none',
    options = list(dom='t')
  )})

  log_table <- function(timestamps, activity) {
    d = data.frame()
    for (i in 1:length(logs$timestamps)) {
      row = data.frame("Time" = logs$timestamps[[i]],
                       "Activity" = logs$activity[[i]],
                       stringsAsFactors=FALSE)
      d = plyr::rbind.fill(d, row)
    }
    return(d)
  }

  # restart the session
  observeEvent(
    input$restart, {
      js$reset()
      addToLog(session, refreshSession)
  })

  # download log
  output$downloadLog = downloadHandler(
    filename="temp.html",
    content=NULL
  )
}