app.R

###################################################

##                       ##
##      SUPERSHINY       ##
##                       ##


###################################################

# problem with how hypotheses are named - unclear why this is a problem now and not before.
# something about '::'

# clean global environment
wipe_global_env <- TRUE
if(wipe_global_env) rm(list=ls(envir = .GlobalEnv), envir = .GlobalEnv)


assign("LOCAL_DB", T, env = .GlobalEnv)

if (Sys.info()["user"] == "cedlich") {
  assign("DEBUG", TRUE, env = .GlobalEnv)
} else {
  assign("DEBUG", FALSE, env = .GlobalEnv)
}


# machine-dependent mount point
if (Sys.info()["user"] == "cedlich" && LOCAL_DB) {
  store_age <- "~/Documents/LocalDB/Projects/"
} else {
  store_age <- file.path(ifelse(.Platform$OS.type=="unix", "/Volumes/group_metabolomics", "Z:"), "group", "#Projects")
}

assign("STORE_AGE", store_age, env = .GlobalEnv)


message(sprintf("DEBUG mode = %s", DEBUG))
message(sprintf("Store path = %s", STORE_AGE))
                


message("Loading libraries")

# libraries
library(multcomp, attach.required = F)
suppressPackageStartupMessages(library(shinyWidgets))
suppressPackageStartupMessages(library(tidyselect))
suppressPackageStartupMessages(library(shinyFiles))
suppressPackageStartupMessages(library(shinyalert))
suppressPackageStartupMessages(library(foreach))
suppressPackageStartupMessages(library(readxl))
suppressPackageStartupMessages(library(RColorBrewer))
suppressPackageStartupMessages(library(scales))
suppressPackageStartupMessages(library(openxlsx))
suppressPackageStartupMessages(library(shinythemes))
suppressPackageStartupMessages(library(magrittr))
suppressPackageStartupMessages(library(tidyverse))
suppressPackageStartupMessages(library(shiny))
suppressPackageStartupMessages(library(shinyBS))
suppressPackageStartupMessages(library(enviPat))
suppressPackageStartupMessages(library(caret))
suppressPackageStartupMessages(library(ggnewscale))
suppressPackageStartupMessages(library(ggdendro))
suppressPackageStartupMessages(library(htmlwidgets))
suppressPackageStartupMessages(library(plotly))
suppressPackageStartupMessages(library(shinyjs))
suppressPackageStartupMessages(library(git2r, exclude = "tag"))
suppressPackageStartupMessages(library(DT))
library(matrixTests)


if (!require("limma", quietly = TRUE)) {
  if (!require("BiocManager", quietly = TRUE)) {
    install.packages("BiocManager")
  }
  BiocManager::install("limma")
}
  


library(limma)



# allow upload up to 500 MB
options(shiny.maxRequestSize = 500*1024^2)

cat(getwd(), "\n")

message("Sourcing scripts")

# code for non-reactive functions
for (pathdir in list.files("Scripts") %>% setdiff("old")) {
  for (f in list.files(file.path("Scripts", pathdir), pattern="*.R")) {
    fp <- file.path("Scripts", pathdir, f)
    # print(sprintf("Sourcing %s", fp))
    source(fp) 
  }
}


# preferences for shiny widgets
assign("MY_SHINY_PREFERENCES",
       if(file.exists("shiny_preferences.RDS")) my_read_shiny_prefs() else list(),
       envir = .GlobalEnv
)

message("Starting app")


ui <- 
  fluidPage(
    # https://community.rstudio.com/t/force-selectinput-to-wrap-text/88185
    htmltools::tags$head(
      htmltools::tags$style(
        type='text/css',
        ".selectize-input { word-wrap : break-word;}
        .selectize-input { word-break: break-word;}
        .selectize-dropdown {word-wrap : break-word;} 
        "
    )),
    navbarPage(
      id = "fluxer_navbarpage",
      title = "SuperShiny Snowdrops",
      theme = shinytheme("yeti"),
      tabPanel("Input", source(file.path("ui_code", "0100_ui_infile.R"),  local = TRUE)$value),
      tabPanel("Stan", uiOutput("stan_panel")),
      tabPanel("PCA", uiOutput("pca_panel")),
      tabPanel("HM", uiOutput("hm_panel")),
      tabPanel("BX", uiOutput("bx_panel")),
      tabPanel("AOV", uiOutput("aov_panel")),
      tabPanel("Output", source(file.path("ui_code", "1000_ui_outfile.R"),  local = TRUE)$value)
      # 
    )
  )

server <- function(input, output, session) {
  
  # initialise reactive variables 
  source(file.path("server_init", "0001_server_init.R"),  local = TRUE)$value
  
  #### ui ####
  
  output$stan_panel = renderUI({
    
    update_now = my_pref_update()
    
    source(file.path("ui_code", "0200_ui_stan.R"),  local = TRUE)$value
    
  })
  
  output$pca_panel = renderUI({

    update_now = my_pref_update()

    source(file.path("ui_code", "0300_ui_pca.R"),  local = TRUE)$value

  })
  
  output$hm_panel = renderUI({
    
    update_now = my_pref_update()
    
    source(file.path("ui_code", "0400_ui_heatmap.R"),  local = TRUE)$value
    
  })
  
  output$bx_panel = renderUI({
    
    update_now = my_pref_update()
    
    source(file.path("ui_code", "0500_ui_boxplot.R"),  local = TRUE)$value
    
  })
  
  output$aov_panel = renderUI({
    
    update_now = my_pref_update()
    
    source(file.path("ui_code", "0600_ui_anova.R"),  local = TRUE)$value
    
  })

  
  #### infile  ####
  source(file.path("server_code", "0100_server_infile_old.R"),  local = TRUE)$value
  source(file.path("server_code", "0101_server_infile_store.R"),  local = TRUE)$value
  source(file.path("server_code", "0102_server_infile_main.R"),  local = TRUE)$value
  source(file.path("server_code", "0103_server_infile_error_check.R"),  local = TRUE)$value

  source(file.path("server_code", "0104_server_infile_assoc_check.R"),  local = TRUE)$value
  
  #### standards ####
  source(file.path("server_code", "0200_server_stan.R"),  local = TRUE)$value

  ### pca ####
  source(file.path("server_code", "0300_server_normalise.R"),  local = TRUE)$value
  source(file.path("server_code", "0301_server_pca.R"),  local = TRUE)$value
  
  #### heatmap ####
  source(file.path("server_code", "0400_server_heatmap.R"),  local = TRUE)$value

  #### boxplot ####
  source(file.path("server_code", "0500_server_boxplot.R"),  local = TRUE)$value

  #### anova ####
  source(file.path("server_code", "0600_server_anova.R"),  local = TRUE)$value

  #### outfile ####

  source(file.path("server_code", "1001_server_outfile.R"),  local = TRUE)$value
  source(file.path("server_code", "1002_server_outfile_old.R"),  local = TRUE)$value

  #### pref ####
  
  output$pref_save = downloadHandler(
    filename = "shiny_preferences.RDS",
    content = function(file) {

      my_shiny_pref(
        isolate(reactiveValuesToList(input)) 
      ) %>% 
        saveRDS(file)
    }
  )
  
  observeEvent(
    input$pref_load,
    {
      assign("MY_SHINY_PREFERENCES",
             my_read_shiny_prefs(input$pref_load$datapath),
             envir = .GlobalEnv
      )
      
      my_pref_update(my_pref_update() + 1)
      
    }
  )  
    
  
  #### exit ####
  
  onStop(function() {
    
    env = parent.env(environment())
    
    ls(envir = env) %>%
      ## .. excluding e.g. session" and "output"
      setdiff(c("session", "output", "my_pref_update")) %>%
      ## object in a list
      mget(envir = env) %>% 
      ## keep only reactive values
      subset(., subset = sapply(., is.reactivevalues)) %>% 
      ## convert reactive values
      sapply(function(z) isolate(reactiveValuesToList(z)), simplify=F) %>% 
      ## assign to global environment
      list2env(envir = .GlobalEnv)
    
    dirname = "server_code/"
    
    for( fname in list.files(dirname , pattern = "*\\.[rR]$")) source_functions_only2(file.path(dirname, fname))
    
    cat("Session stopped\n")
    cat("Type `save(list=ls(), file='tmp.RData')` to save state variables in your current working directory\n")
    cat("Find out what current working directory by typing `getwd()`\n")
  }
  )
  
}



shinyApp(ui, server)