Merge pull request #208 from hms-dbmi/update-shinyproxy

pre-init shinyproxy

Author: alexvpickering

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: dseqr
 Type: Package
 Title: GUI to Explore Single-Cell and Bulk RNA-Seq from Fastq to Pathways and Perturbations
-Version: 0.36.0
+Version: 0.37.0
 Authors@R: person("Alex", "Pickering", email="[email protected]", role=c("cre", "aut"))
 BugReports: https://github.com/hms-dbmi/dseqr/issues
 URL: https://github.com/hms-dbmi/dseqr

Dockerfile

@@ -88,9 +88,6 @@ RUN R -e "install.packages(repos=NULL, '.')" && \
 #-----------
 from common AS production
 
-# add runner
-COPY inst/run.R .
-
 # ----------
 # TESTING
 #-----------

NAMESPACE

@@ -1,28 +1,38 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(aggregate,Matrix)
+S3method(cbind,safe)
+S3method(pretty,unique)
+S3method(toString,data.frame)
 export(add_cluster_numbers)
 export(bulkPage)
 export(bulkPageUI)
 export(check_has_scseq)
 export(clean_kb_scseq)
+export(dir_exists)
 export(download_kb_index)
 export(drugsPage)
 export(drugsPageUI)
+export(file_exists)
 export(from_crossmeta)
 export(getDeleteRowButtons)
 export(get_expression_colors)
 export(get_palette)
 export(get_presto_markers)
 export(get_species)
 export(init_dseqr)
+export(isTruthy)
 export(load_scseq_qs)
+export(make_unique)
 export(navbar2UI)
 export(navbarUI)
 export(qread.safe)
+export(req)
 export(run_dseqr)
 export(run_kb_scseq)
 export(scPage)
 export(scPageUI)
+export(send_slack_error)
 export(theme_dimgray)
 export(theme_no_xaxis)
 export(theme_no_yaxis)

R/matrix_utils.R

@@ -1,4 +1,5 @@
-# Compute summary statistics of a Matrix
+#' Compute summary statistics of a Matrix
+#' @export
 aggregate.Matrix <- function(x, groupings = NULL, form = NULL, fun = "sum", ...) {
   if (!methods::is(x, "Matrix")) {
     x <- Matrix::Matrix(as.matrix(x), sparse = TRUE)

R/modules-sc-utils.R

@@ -41,6 +41,7 @@ remove.unique <- function(annot) {
   return(annot)
 }
 
+#' @export
 pretty.unique <- function(annot) {
   annot <- make_unique(annot, '_')
 
@@ -574,6 +575,7 @@ evaluate_custom_metric <- function(metric, scseq) {
   return(dat)
 }
 
+#' @export
 cbind.safe <- function(prev, res) {
   res <- cbind(prev, res)
   row.names(res) <- row.names(prev)
@@ -2538,17 +2540,38 @@ get_expression_colors <- function(ft.scaled) {
   return(colors)
 }
 
+#' Safe file.exists
+#'
+#' @param x file path
+#'
+#' @return a logical vector of TRUE or FALSE values
+#' @export
+#'
 file_exists <- function(x) {
   if (!length(x)) return(FALSE)
   file.exists(x)
 }
 
+#' Safe dir.exists
+#'
+#' @param x directory path
+#'
+#' @return a logical vector of TRUE or FALSE values
+#' @export
+#'
 dir_exists <- function(x) {
   if (!length(x)) return(FALSE)
   dir.exists(x)
 }
 
 
+#' Truthy and falsy values
+#'
+#' @param x An expression whose truthiness value we want to determine
+#'
+#' @return a logical vector of TRUE or FALSE values
+#' @export
+#'
 isTruthy <- function(x) {
   if (inherits(x, 'try-error'))
     return(FALSE)
@@ -2571,6 +2594,15 @@ isTruthy <- function(x) {
   return(TRUE)
 }
 
+#' Check for required values
+#'
+#' @param ... Values to check for truthiness.
+#' @param cancelOutput If TRUE and an output is being evaluated, stop processing
+#'  as usual but instead of clearing the output, leave it in whatever state it happens to be in.
+#'
+#' @return The first value that was passed in.
+#' @export
+#'
 req <- function(..., cancelOutput = FALSE) {
   shiny:::dotloop(function(item) {
     if (!isTruthy(item)) {
@@ -2588,8 +2620,16 @@ req <- function(..., cancelOutput = FALSE) {
     invisible()
 }
 
-make_unique <- function(x, sep = ".") {
-  x <- as.character(x)
-  make.unique(x, sep = sep)
+#' Make Character Strings Unique
+#'
+#' @param names a character vector.
+#' @param sep a character string used to separate a duplicate name from its sequence number.
+#'
+#' @return A character vector of same length as names with duplicates changed, in the current locale's encoding.
+#' @export
+#'
+make_unique <- function(names, sep = ".") {
+  names <- as.character(names)
+  make.unique(names, sep = sep)
 }
 

R/recover_error.R

@@ -1,7 +1,14 @@
 
-send_slack_error <- function(project) {
+#' Send shiny errors to slack
+#'
+#' @param project The project that the error originated from
+#' @param user The user that the error originated from
+#'
+#' @return Generates an alert in browser
+#' @export
+#'
+send_slack_error <- function(project, user) {
 
-    user <- Sys.getenv('SHINYPROXY_USERNAME', 'localhost')
     project <- ifelse(project == user, 'private', project)
     error <- recover_error()
     slack <- readRDS(system.file('extdata/slack.rds', package = 'dseqr'))
@@ -136,6 +143,7 @@ getError <- function (cond,
     return(res)
 }
 
+#' @export
 toString.data.frame = function (object, ..., digits=NULL, quote=FALSE, right=TRUE, row.names=TRUE) {
     nRows = length(row.names(object));
     if (length(object)==0) {

R/run_dseqr.R

@@ -2,8 +2,8 @@
 #'
 #' Run dseqr application to explore single-cell and bulk RNA-seq datasets.
 #'
-#' @param user_name Name of user folder in \code{data_dir}. Will be created if doesn't exist.
-#' @param data_dir Directory containing user folders. By default also will contain folders
+#' @param app_name Name of user folder in \code{data_dir}. Will be created if doesn't exist.
+#' @param data_dir Directory containing app folders. By default also will contain folders
 #'  \code{.pert_query_dir}, \code{.pert_signature_dir}, and \code{.indices_dir}.
 #' @param tabs Character vector of tabs to include in order desired. Must be subset of 'Single Cell', 'Bulk Data', and 'Drugs'.
 #' @param pert_query_dir Path to directory where pert query results (using CMAP02/L1000 as query signature) will be downloaded as requested.
@@ -36,11 +36,11 @@
 #' if (interactive()) {
 #'
 #'   data_dir <- tempdir()
-#'   user_name <- 'example'
-#'   run_dseqr(user_name, data_dir)
+#'   app_name <- 'example'
+#'   run_dseqr(app_name, data_dir)
 #' }
 #'
-run_dseqr <- function(user_name,
+run_dseqr <- function(app_name,
                       data_dir,
                       tabs = c('Single Cell', 'Bulk Data', 'Drugs'),
                       pert_query_dir = file.path(data_dir, '.pert_query_dir'),
@@ -61,13 +61,9 @@ run_dseqr <- function(user_name,
     data_dir <- '/srv/dseqr'
   }
 
-
   # gather options
   opts <- list()
 
-  # on remote: send errors to slack
-  if (!is_local) opts$shiny.error <- function() send_slack_error(user_name)
-
   # allow up to 30GB uploads
   opts$shiny.maxRequestSize <- 30*1024*1024^2
 
@@ -91,17 +87,10 @@ run_dseqr <- function(user_name,
 
   if (missing(data_dir)) stop('data_dir not specified.')
 
-  user_dir <- file.path(data_dir, user_name)
-  if (!dir_exists(user_dir)) init_dseqr(user_name, data_dir)
-
-  # ensure various directories exist
-  # duplicated in server.R for tests
-  app_dirs <- c(pert_query_dir, pert_signature_dir, indices_dir, tx2gene_dir, gs_dir)
-  for (dir in app_dirs) dir.create(dir, showWarnings = FALSE)
-
   # pass arguments to app through options then run
   shiny::shinyOptions(
-    user_dir = normalizePath(user_dir),
+    data_dir = normalizePath(data_dir),
+    app_name = app_name,
     pert_query_dir = normalizePath(pert_query_dir),
     pert_signature_dir = normalizePath(pert_signature_dir),
     gs_dir = normalizePath(gs_dir),
@@ -153,3 +142,22 @@ init_dseqr <- function(user_name, data_dir = '/srv/dseqr') {
   dir.create(file.path(default_dir, 'custom_queries'))
 
 }
+
+run_dseqr_shinyproxy <- function(project_name, host_url) {
+
+  is_example <- project_name == 'example'
+
+  logout_url <- sprintf('https://%s/logout', host_url)
+
+  message('project_name: ', project_name)
+  message('is_example: ', is_example)
+  message('logout_url: ', logout_url)
+
+  # where to download/load drug and reference data from dseqr.data
+  Sys.setenv('DSEQR_DATA_PATH' = '/srv/dseqr/.data')
+
+  run_dseqr(project_name,
+            logout_url = logout_url,
+            is_example = is_example)
+
+}