Merge branch 'master' into dev-credentials-database

.github/workflows/build-test-push/Dockerfile

@@ -10,7 +10,7 @@
 # Start from lastest base image
 #------------------------------------------------------------
 
-FROM bigomics/omicsplayground-base:ub2204_v2
+FROM bigomics/omicsplayground:latest
 
 #------------------------------------------------------------
 # Set env variables 
@@ -23,14 +23,6 @@ ENV DEBIAN_FRONTEND noninteractive
 ENV LANG=en_US.UTF-8 LANGUAGE=en_US:en LC_ALL=en_US.UTF-8 
 RUN sed -i '/en_US.UTF-8/s/^# //g' /etc/locale.gen && locale-gen
 
-#------------------------------------------------------------
-# Install de-novo bigomics stuff (as R packages)
-#------------------------------------------------------------
-
-RUN R -e "remotes::install_github('bigomics/PCSF',dependencies=FALSE)"
-RUN R -e "remotes::install_github('bigomics/bigdash',dependencies=FALSE)"
-RUN R -e "remotes::install_github('bigomics/bigLoaders',dependencies=FALSE)"
-RUN R -e "remotes::install_github('bigomics/fgsea')"
 
 # check if playbase@{$GITHUB_HEAD_REF} exists, if it does, install.. other wise install main
 

.github/workflows/build-test-push/entrypoint.sh

@@ -1,7 +1,9 @@
 #!/bin/bash
 
 # Run tests
-R -e "x <- shiny::runTests(assert = FALSE); writeLines(as.character(all(x[[2]])), 'test_result.txt')"
+# run target sass in makefile
+
+R -e "options(authentication='none'); x <- shiny::runTests(assert = FALSE); writeLines(as.character(all(x[[2]])), 'test_result.txt')"
 
 # Read test results from file
 res=$(cat test_result.txt)

.gitignore

@@ -53,6 +53,8 @@ data_shared/*
 trace/*
 logs/*.rds
 /logs/
+USER_INPUT/
+user_input/
 
 # Sensitive files #
 ####################
@@ -68,3 +70,8 @@ Renviron.site
 .Rdata
 inst/doc
 *.csv
+*.RData
+params*
+processx-error.log
+processx-output.log
+raw_*

Makefile

@@ -32,7 +32,7 @@ docker.run:
 docker.run2:
 	@echo running docker $(TAG) at port 4000
 	docker run --rm -it -p 4000:3838 \
-		-v ~/Playground/omicsplayground/data:/omicsplayground/data \
+		-v ~/Playground/pgx:/omicsplayground/data \
 		-v ~/Playground/libx:/omicsplayground/libx \
 		-v /aws/pgx-share:/omicsplayground/data_shared \
 		-v /aws/pgx-public:/omicsplayground/data_public \
@@ -86,7 +86,7 @@ FORCE: ;
 
 ##VERSION=`head -n1 VERSION`
 DATE = `date +%y%m%d|sed 's/\ //g'`
-VERSION = "v3.3.0-beta10.9001"
+VERSION = "v3.3.0-beta16"
 BUILD := $(VERSION)"-"$(BRANCH)""$(DATE)
 
 version: 
@@ -112,6 +112,8 @@ push.version:
 	docker tag bigomics/omicsplayground:$(BRANCH) bigomics/omicsplayground:$(VERSION)
 	docker push bigomics/omicsplayground:$(VERSION)
 
+auth=none
+
 board.launch:
 	R -e "options(board = '$(board)', authentication = '$(auth)'); shiny::runApp('dev/board.launch')"
 
@@ -121,11 +123,11 @@ board.example:
 pgx.check.error: sass
 	Rscript dev/board_check_across_pgx.R $(if $(d),-d $(d),)
 
-app.test:
-	R -e "shiny::runTests()"
+app.test: sass
+	R -e  "options(authentication='$(auth)'); shiny::runTests()"
 
 app.test.review:
-	R -e "testthat::use snapshot_review('snapshot/')""
+	R -e "testthat::snapshot_review('snapshot/')"
 
 update:
 	Rscript dev/update.R

README.rst

@@ -82,12 +82,6 @@ Next, install all necessary R packages and dependencies by running from the omic
     cd omicsplayground
     Rscript dev/requirements.R
     
-As option, you can run the following command in the ``build/`` folder to build the datasets::
-
-    Rscript build-datasets.R
-
-   Note: Building the datasets can vary from minutes to a couple of hours depending on their sizes.
-
 Finally, you can run the omicsplayground platform. You can do this with the Makefile located in the root omicsplayground folder::
 
     make run

VERSION

@@ -1 +1 @@
-v3.3.0-beta10.9001-master231215
+v3.3.0-beta16-master240213

bin/pgxcreate_op.R

@@ -6,21 +6,21 @@
 ## (c) 2023 BigOmics Analytics
 ##
 
-message("[compute PGX process] : starting process\n")
-args = commandArgs(trailingOnly=TRUE)
+message("[create PGX process] : starting process")
+args <- commandArgs(trailingOnly=TRUE)
 
 temp_dir <- args[1]
 
 if(!exists("temp_dir")) {
   temp_dir <- getwd()
 }
 
-params_from_op <- file.path(temp_dir,"params.RData")
+params_from_op <- file.path(temp_dir, "params.RData")
 
 if (file.exists(params_from_op)) {
   params <- readRDS(params_from_op)
 } else {
-  yaml::yaml.load_file(file.path(temp_dir,"PARAMS.yml"))
+  yaml::yaml.load_file(file.path(temp_dir, "PARAMS.yml"))
 }
 
 # Call create_pgx function
@@ -42,21 +42,25 @@ pgx <- playbase::pgx.createPGX(
   only.proteincoding = params$only.proteincoding,
   only.hugo = params$only.hugo,
   convert.hugo = params$convert.hugo,
-  do.cluster = params$do.cluster,
-  cluster.contrasts = params$cluster.contrasts
+  custom.geneset = params$custom.geneset,
+  max.genesets = params$max.genesets,
+  annot_table = params$annot_table
 )
 
+message("[create PGX process] : PGX created succefully")
+message("[compute PGX process] : starting process")
+
 pgx <- playbase::pgx.computePGX(
   pgx = pgx,
   max.genes = params$max.genes,
-  max.genesets = params$max.genesets,
   gx.methods = params$gx.methods,
   gset.methods = params$gset.methods,
-  custom.geneset = params$custom.geneset,
   extra.methods = params$extra.methods,
   use.design = params$use.design,        ## no.design+prune are combined
   prune.samples = params$prune.samples,  ##
-  do.cluster = params$do.cluster,
+  do.clustergenes = params$do.cluster,
+  do.clustergenesets = params$do.cluster,
+  cluster.contrasts = params$cluster.contrasts,
   pgx.dir = params$pgx.save.folder,
   libx.dir = params$libx.dir,
   user_input_dir = temp_dir
@@ -77,4 +81,13 @@ if (dir.exists(params$pgx.save.folder)) {
 }
 save(pgx, file = pgx_name)
 
+ds_name <- paste0("<b>", params$name, "</b>")
+gmail_creds <- file.path(params$ETC, "gmail_creds")
+
+params$sendSuccessMessageToUser(
+  user_email = params$email,
+  pgx_name = ds_name,
+  path_to_creds = gmail_creds
+)
+
 message("[compute PGX process] : process finished, pgx is saved as", pgx_name,"\n")

components/00SourceAll.R

@@ -176,6 +176,7 @@ if (!file.exists("00SourceAll.R")) {
   source("board.upload/R/upload_module_batchcorrect.R", encoding = "UTF-8")
   source("board.upload/R/upload_module_computepgx.R", encoding = "UTF-8")
   source("board.upload/R/upload_module_makecontrast.R", encoding = "UTF-8")
+  source("board.upload/R/upload_module_outliers.R", encoding = "UTF-8")
   source("board.upload/R/upload_module_preview.R", encoding = "UTF-8")
   source("board.upload/R/upload_plot_contraststats.R", encoding = "UTF-8")
   source("board.upload/R/upload_plot_countstats.R", encoding = "UTF-8")
@@ -218,6 +219,7 @@ if (!file.exists("00SourceAll.R")) {
   source("modules/CookiesModule.R", encoding = "UTF-8")
   source("modules/InfoModals.R", encoding = "UTF-8")
   source("modules/NormalizeCountsModule.R", encoding = "UTF-8")
+  source("modules/PlotDownloadLogger.R", encoding = "UTF-8")
   source("modules/QuestionModule.R", encoding = "UTF-8")
   source("modules/SendReferralModule.R", encoding = "UTF-8")
   source("modules/SocialMediaModule.R", encoding = "UTF-8")

components/app/R/global.R

@@ -214,3 +214,6 @@ main.init_time
 message("[GLOBAL] global init time = ", main.init_time, " ", attr(main.init_time, "units"))
 
 shiny::addResourcePath("static", file.path(OPG, "components/app/R/www"))
+
+## Initialize plot download logger
+PLOT_DOWNLOAD_LOGGER <<- reactiveValues(log = list(), str = "")

components/app/R/server.R

@@ -568,17 +568,17 @@ app_server <- function(input, output, session) {
       ## Dynamically show upon availability in pgx object
       info("[SERVER] disabling extra features")
       tabRequire(PGX, session, "wgcna-tab", "wgcna", TRUE)
-      ##      tabRequire(PGX, session, "cmap-tab", "connectivity", has.libx)
       tabRequire(PGX, session, "drug-tab", "drugs", TRUE)
       tabRequire(PGX, session, "wordcloud-tab", "wordcloud", TRUE)
       tabRequire(PGX, session, "cell-tab", "deconv", TRUE)
+      gset_tabs <- c("enrich-tab", "pathway-tab", "isect-tab", "sig-tab")
+      for (tab_i in gset_tabs) {
+        tabRequire(PGX, session, tab_i, "gsetX", TRUE)
+        tabRequire(PGX, session, tab_i, "gset.meta", TRUE)
+      }
 
       ## DEVELOPER only tabs (still too alpha)
       info("[SERVER] disabling alpha features")
-      #      toggleTab("cell-tabs", "iTALK", DEV) ## DEV only
-      #      toggleTab("cell-tabs", "CNV", DEV) ## DEV only
-      #      toggleTab("cell-tabs", "Monocle", DEV) ## DEV only
-
       info("[SERVER] trigger on change dataset done!")
     }
   )
@@ -785,11 +785,17 @@ app_server <- function(input, output, session) {
     nav_count.str <- paste(paste0(names(nav.count), "=", nav.count), collapse = ";")
     nav_count.str <- gsub("-tab", "", nav_count.str)
 
+    ## record num datasets
+    pgxdir <- shiny::isolate(auth$user_dir)
+    num_pgxfiles <- length(dir(pgxdir, pattern = ".pgx$"))
+
     pgx.record_access(
       user = isolate(auth$email),
       action = action,
       session = session,
-      comment = nav_count.str
+      comment = nav_count.str,
+      comment2 = isolate(PLOT_DOWNLOAD_LOGGER$str),
+      num_datasets = num_pgxfiles
     )
 
     ## reset (logout) user. This should already have been done with

components/app/R/ui.R

@@ -72,8 +72,7 @@ app_ui <- function(x) {
       version <- scan(file.path(OPG, "VERSION"), character())[1]
       id <- "maintabs"
       header <- shiny::tagList(
-        # shiny::tags$head(htmltools::includeHTML("www/hubspot-embed.js")),
-        shiny::tags$head(shiny::tags$script("hubspot-embed.js")),
+        shiny::tags$head(htmltools::includeHTML("www/hubspot-embed.html")),
         ##    gtag2, ## Google Tag Manager???
         shiny::tags$head(shiny::tags$script(src = "custom/temp.js")),
         shiny::tags$head(shiny::tags$script(src = "custom/dropdown-helper.js")),

components/app/R/utils/utils.R

@@ -46,6 +46,18 @@ envcat <- function(var) {
   message(var, " = ", Sys.getenv(var))
 }
 
+mem.vmrss <- function(digits = 0) {
+  mem <- "[? MB]"
+  if (Sys.info()["sysname"] %in% c("Linux")) {
+    proc <- paste("/proc", Sys.getpid(), "status", sep = "/")
+    rss <- system(paste("grep -i vmrss", proc), intern = TRUE)
+    rss <- gsub("VmRSS:[\t ]+| kB", "", rss)
+    rss <- as.numeric(rss) / (1024) ## MB
+    mem <- paste0(round(rss, digits), "MB")
+  }
+  mem
+}
+
 mem.proc <- function(digits = 0) {
   mem <- "[? MB]"
   if (Sys.info()["sysname"] %in% c("Linux")) {
@@ -64,7 +76,7 @@ info <- function(..., type = "INFO") {
   msg <- "some message"
   msg <- sapply(list(...), paste, collapse = " ")
   dd <- paste0("[", dd, "]")
-  mm <- paste0("[", mem.proc(), "]")
+  mm <- paste0("[", mem.proc(), "/", mem.vmrss(), "]")
   type <- paste0("[", type, "]")
   message(paste0(type, dd, mm, " --- ", sub("\n$", "", paste(msg, collapse = " "))))
 }

components/board.clustering/R/clustering_plot_genemodule.R

@@ -65,7 +65,6 @@ clustering_plot_genemodule_server <- function(id,
       res <- getTopMatrix()
       shiny::req(res)
 
-      dbg("[clustering_plot_genemodule.R::plot_data] names(res) = ", names(res))
       mat <- res$mat
       idx <- res$idx
       modx <- sapply(1:ncol(mat), function(i) tapply(mat[, i], idx, mean))
@@ -81,11 +80,7 @@ clustering_plot_genemodule_server <- function(id,
       pd <- plot_data()
       shiny::req(pd)
 
-      dbg("[clustering_plot_genemodule.R::render_plotly] names(pd) = ", names(pd))
       mat <- pd$mat
-      dbg("[clustering_plot_genemodule.R::render_plotly] dim(mat) = ", dim(mat))
-
-
       plotly.colors <- c(
         "#1f77b4", "#ff7f0e", "#2ca02c", "#d62728", "#9467bd",
         "#8c564b", "#e377c2", "#7f7f7f", "#bcbd22", "#17becf"

components/board.clustering/R/clustering_plot_phenoplot.R

@@ -39,7 +39,6 @@ clustering_plot_phenoplot_server <- function(id,
                                              selected_phenotypes,
                                              clustmethod,
                                              selected_samples,
-                                             hm_getClusterPositions,
                                              watermark = FALSE) {
   moduleServer(id, function(input, output, session) {
     ns <- session$ns

components/board.clustering/R/clustering_plot_splitmap.R

@@ -113,6 +113,7 @@ clustering_plot_splitmap_server <- function(id,
 
       filt <- getTopMatrix()
       shiny::req(filt)
+
       zx <- filt$mat
       annot <- filt$annot
       zx.idx <- filt$idx
@@ -212,6 +213,7 @@ clustering_plot_splitmap_server <- function(id,
       ## iHeatmap based splitted heatmap #########
 
       shiny::req(pgx$genes)
+
       ## -------------- variable to split samples
       scale <- "none"
       if (input$hm_scale == "relative") scale <- "row.center"
@@ -221,6 +223,7 @@ clustering_plot_splitmap_server <- function(id,
 
       ## extract from plot data
       pd <- plot_data()
+
       filt <- pd[["filt"]]
       X <- pd[["zx"]]
       annot <- pd[["annot"]]
@@ -232,12 +235,14 @@ clustering_plot_splitmap_server <- function(id,
 
       ## iheatmapr needs factors for sharing between groups
       annotF <- data.frame(as.list(annot), stringsAsFactors = TRUE)
-
       rownames(annotF) <- rownames(annot)
-      if (length(selected_phenotypes()) == 0) {
+
+      sel <- selected_phenotypes()
+      sel <- intersect(sel, colnames(annotF))
+      if (length(sel) == 0) {
         annotF <- NULL
       } else {
-        annotF <- annotF[, selected_phenotypes(), drop = FALSE]
+        annotF <- annotF[, sel, drop = FALSE]
       }
 
       colcex <- as.numeric(input$hm_cexCol)
@@ -290,7 +295,8 @@ clustering_plot_splitmap_server <- function(id,
         func = x$func,
         csvFunc = plot_data,
         res = c(80, 95), # resolution of plots
-        pdf.width = 10, pdf.height = 8,
+        pdf.width = 10,
+        pdf.height = 8,
         add.watermark = watermark,
         card = x$card
       )