Skip to content

Commit 0ac4fa5

Browse files
Merge pull request #208 from hms-dbmi/update-shinyproxy
pre-init shinyproxy
2 parents 99d9058 + d979e9e commit 0ac4fa5

18 files changed

+286
-76
lines changed

DESCRIPTION

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
Package: dseqr
22
Type: Package
33
Title: GUI to Explore Single-Cell and Bulk RNA-Seq from Fastq to Pathways and Perturbations
4-
Version: 0.36.0
4+
Version: 0.37.0
55
Authors@R: person("Alex", "Pickering", email="[email protected]", role=c("cre", "aut"))
66
BugReports: https://github.com/hms-dbmi/dseqr/issues
77
URL: https://github.com/hms-dbmi/dseqr

Dockerfile

Lines changed: 0 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -88,9 +88,6 @@ RUN R -e "install.packages(repos=NULL, '.')" && \
8888
#-----------
8989
from common AS production
9090

91-
# add runner
92-
COPY inst/run.R .
93-
9491
# ----------
9592
# TESTING
9693
#-----------

NAMESPACE

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,28 +1,38 @@
11
# Generated by roxygen2: do not edit by hand
22

3+
S3method(aggregate,Matrix)
4+
S3method(cbind,safe)
5+
S3method(pretty,unique)
6+
S3method(toString,data.frame)
37
export(add_cluster_numbers)
48
export(bulkPage)
59
export(bulkPageUI)
610
export(check_has_scseq)
711
export(clean_kb_scseq)
12+
export(dir_exists)
813
export(download_kb_index)
914
export(drugsPage)
1015
export(drugsPageUI)
16+
export(file_exists)
1117
export(from_crossmeta)
1218
export(getDeleteRowButtons)
1319
export(get_expression_colors)
1420
export(get_palette)
1521
export(get_presto_markers)
1622
export(get_species)
1723
export(init_dseqr)
24+
export(isTruthy)
1825
export(load_scseq_qs)
26+
export(make_unique)
1927
export(navbar2UI)
2028
export(navbarUI)
2129
export(qread.safe)
30+
export(req)
2231
export(run_dseqr)
2332
export(run_kb_scseq)
2433
export(scPage)
2534
export(scPageUI)
35+
export(send_slack_error)
2636
export(theme_dimgray)
2737
export(theme_no_xaxis)
2838
export(theme_no_yaxis)

R/matrix_utils.R

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
1-
# Compute summary statistics of a Matrix
1+
#' Compute summary statistics of a Matrix
2+
#' @export
23
aggregate.Matrix <- function(x, groupings = NULL, form = NULL, fun = "sum", ...) {
34
if (!methods::is(x, "Matrix")) {
45
x <- Matrix::Matrix(as.matrix(x), sparse = TRUE)

R/modules-sc-utils.R

Lines changed: 43 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -41,6 +41,7 @@ remove.unique <- function(annot) {
4141
return(annot)
4242
}
4343

44+
#' @export
4445
pretty.unique <- function(annot) {
4546
annot <- make_unique(annot, '_')
4647

@@ -574,6 +575,7 @@ evaluate_custom_metric <- function(metric, scseq) {
574575
return(dat)
575576
}
576577

578+
#' @export
577579
cbind.safe <- function(prev, res) {
578580
res <- cbind(prev, res)
579581
row.names(res) <- row.names(prev)
@@ -2538,17 +2540,38 @@ get_expression_colors <- function(ft.scaled) {
25382540
return(colors)
25392541
}
25402542

2543+
#' Safe file.exists
2544+
#'
2545+
#' @param x file path
2546+
#'
2547+
#' @return a logical vector of TRUE or FALSE values
2548+
#' @export
2549+
#'
25412550
file_exists <- function(x) {
25422551
if (!length(x)) return(FALSE)
25432552
file.exists(x)
25442553
}
25452554

2555+
#' Safe dir.exists
2556+
#'
2557+
#' @param x directory path
2558+
#'
2559+
#' @return a logical vector of TRUE or FALSE values
2560+
#' @export
2561+
#'
25462562
dir_exists <- function(x) {
25472563
if (!length(x)) return(FALSE)
25482564
dir.exists(x)
25492565
}
25502566

25512567

2568+
#' Truthy and falsy values
2569+
#'
2570+
#' @param x An expression whose truthiness value we want to determine
2571+
#'
2572+
#' @return a logical vector of TRUE or FALSE values
2573+
#' @export
2574+
#'
25522575
isTruthy <- function(x) {
25532576
if (inherits(x, 'try-error'))
25542577
return(FALSE)
@@ -2571,6 +2594,15 @@ isTruthy <- function(x) {
25712594
return(TRUE)
25722595
}
25732596

2597+
#' Check for required values
2598+
#'
2599+
#' @param ... Values to check for truthiness.
2600+
#' @param cancelOutput If TRUE and an output is being evaluated, stop processing
2601+
#' as usual but instead of clearing the output, leave it in whatever state it happens to be in.
2602+
#'
2603+
#' @return The first value that was passed in.
2604+
#' @export
2605+
#'
25742606
req <- function(..., cancelOutput = FALSE) {
25752607
shiny:::dotloop(function(item) {
25762608
if (!isTruthy(item)) {
@@ -2588,8 +2620,16 @@ req <- function(..., cancelOutput = FALSE) {
25882620
invisible()
25892621
}
25902622

2591-
make_unique <- function(x, sep = ".") {
2592-
x <- as.character(x)
2593-
make.unique(x, sep = sep)
2623+
#' Make Character Strings Unique
2624+
#'
2625+
#' @param names a character vector.
2626+
#' @param sep a character string used to separate a duplicate name from its sequence number.
2627+
#'
2628+
#' @return A character vector of same length as names with duplicates changed, in the current locale's encoding.
2629+
#' @export
2630+
#'
2631+
make_unique <- function(names, sep = ".") {
2632+
names <- as.character(names)
2633+
make.unique(names, sep = sep)
25942634
}
25952635

R/recover_error.R

Lines changed: 10 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,14 @@
11

2-
send_slack_error <- function(project) {
2+
#' Send shiny errors to slack
3+
#'
4+
#' @param project The project that the error originated from
5+
#' @param user The user that the error originated from
6+
#'
7+
#' @return Generates an alert in browser
8+
#' @export
9+
#'
10+
send_slack_error <- function(project, user) {
311

4-
user <- Sys.getenv('SHINYPROXY_USERNAME', 'localhost')
512
project <- ifelse(project == user, 'private', project)
613
error <- recover_error()
714
slack <- readRDS(system.file('extdata/slack.rds', package = 'dseqr'))
@@ -136,6 +143,7 @@ getError <- function (cond,
136143
return(res)
137144
}
138145

146+
#' @export
139147
toString.data.frame = function (object, ..., digits=NULL, quote=FALSE, right=TRUE, row.names=TRUE) {
140148
nRows = length(row.names(object));
141149
if (length(object)==0) {

R/run_dseqr.R

Lines changed: 26 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -2,8 +2,8 @@
22
#'
33
#' Run dseqr application to explore single-cell and bulk RNA-seq datasets.
44
#'
5-
#' @param user_name Name of user folder in \code{data_dir}. Will be created if doesn't exist.
6-
#' @param data_dir Directory containing user folders. By default also will contain folders
5+
#' @param app_name Name of user folder in \code{data_dir}. Will be created if doesn't exist.
6+
#' @param data_dir Directory containing app folders. By default also will contain folders
77
#' \code{.pert_query_dir}, \code{.pert_signature_dir}, and \code{.indices_dir}.
88
#' @param tabs Character vector of tabs to include in order desired. Must be subset of 'Single Cell', 'Bulk Data', and 'Drugs'.
99
#' @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 @@
3636
#' if (interactive()) {
3737
#'
3838
#' data_dir <- tempdir()
39-
#' user_name <- 'example'
40-
#' run_dseqr(user_name, data_dir)
39+
#' app_name <- 'example'
40+
#' run_dseqr(app_name, data_dir)
4141
#' }
4242
#'
43-
run_dseqr <- function(user_name,
43+
run_dseqr <- function(app_name,
4444
data_dir,
4545
tabs = c('Single Cell', 'Bulk Data', 'Drugs'),
4646
pert_query_dir = file.path(data_dir, '.pert_query_dir'),
@@ -61,13 +61,9 @@ run_dseqr <- function(user_name,
6161
data_dir <- '/srv/dseqr'
6262
}
6363

64-
6564
# gather options
6665
opts <- list()
6766

68-
# on remote: send errors to slack
69-
if (!is_local) opts$shiny.error <- function() send_slack_error(user_name)
70-
7167
# allow up to 30GB uploads
7268
opts$shiny.maxRequestSize <- 30*1024*1024^2
7369

@@ -91,17 +87,10 @@ run_dseqr <- function(user_name,
9187

9288
if (missing(data_dir)) stop('data_dir not specified.')
9389

94-
user_dir <- file.path(data_dir, user_name)
95-
if (!dir_exists(user_dir)) init_dseqr(user_name, data_dir)
96-
97-
# ensure various directories exist
98-
# duplicated in server.R for tests
99-
app_dirs <- c(pert_query_dir, pert_signature_dir, indices_dir, tx2gene_dir, gs_dir)
100-
for (dir in app_dirs) dir.create(dir, showWarnings = FALSE)
101-
10290
# pass arguments to app through options then run
10391
shiny::shinyOptions(
104-
user_dir = normalizePath(user_dir),
92+
data_dir = normalizePath(data_dir),
93+
app_name = app_name,
10594
pert_query_dir = normalizePath(pert_query_dir),
10695
pert_signature_dir = normalizePath(pert_signature_dir),
10796
gs_dir = normalizePath(gs_dir),
@@ -153,3 +142,22 @@ init_dseqr <- function(user_name, data_dir = '/srv/dseqr') {
153142
dir.create(file.path(default_dir, 'custom_queries'))
154143

155144
}
145+
146+
run_dseqr_shinyproxy <- function(project_name, host_url) {
147+
148+
is_example <- project_name == 'example'
149+
150+
logout_url <- sprintf('https://%s/logout', host_url)
151+
152+
message('project_name: ', project_name)
153+
message('is_example: ', is_example)
154+
message('logout_url: ', logout_url)
155+
156+
# where to download/load drug and reference data from dseqr.data
157+
Sys.setenv('DSEQR_DATA_PATH' = '/srv/dseqr/.data')
158+
159+
run_dseqr(project_name,
160+
logout_url = logout_url,
161+
is_example = is_example)
162+
163+
}

0 commit comments

Comments
 (0)