Merge branch 'master' into test-prepare-experiment

pipeline-runner/R/gem2s-5-create_seurat.R

@@ -8,7 +8,6 @@
 #' @export
 #'
 create_seurat <- function(input, pipeline_config, prev_out) {
-
   message("Creating Seurat Objects...")
 
   # NOTE: edrops can be empty list
@@ -46,8 +45,6 @@ create_seurat <- function(input, pipeline_config, prev_out) {
 construct_scdata <- function(counts, doublet_score, edrops_out, sample, annot, config, min.cells = 3, min.features = 10) {
 
   metadata <- construct_metadata(counts, sample, config)
-  lookups <- get_metadata_lookups(metadata)
-  colnames(metadata) <- lookups
 
   scdata <- Seurat::CreateSeuratObject(
     counts,
@@ -56,8 +53,6 @@ construct_scdata <- function(counts, doublet_score, edrops_out, sample, annot, c
     min.cells = min.cells,
     min.features = min.features)
 
-  scdata@misc$metadata_lookups <- lookups
-
   scdata <- scdata %>%
     add_mito(annot) %>%
     add_dblscore(doublet_score) %>%
@@ -66,19 +61,15 @@ construct_scdata <- function(counts, doublet_score, edrops_out, sample, annot, c
   return(scdata)
 }
 
-# to find invalid metadata column names in SeuratObject (e.g. 'TRUE')
-get_metadata_lookups <- function(metadata) {
-  user_values <- names(metadata)
-  lookups <- make.names(colnames(metadata), unique = TRUE)
-  names(lookups) <- user_values
-  return(lookups)
-}
 
 
+# NOTE: any changes here must be reflected in meta_sets
+
 # construct metadata for each SeuratObject
 construct_metadata <- function(counts, sample, config) {
   message("Constructing metadata df...")
   metadata <- data.frame(row.names = colnames(counts), samples = rep(sample, ncol(counts)))
+
   # Add "metadata" if exists in config
   rest <- config$metadata
   if (!is.null(rest)) {
@@ -87,6 +78,9 @@ construct_metadata <- function(counts, sample, config) {
     metadata[names(rest)] <- rest[sample, ]
   }
 
+  # make syntactically valid column names
+  colnames(metadata) <- make.names(colnames(metadata), unique = TRUE)
+
   return(metadata)
 }
 

pipeline-runner/R/gem2s-7-upload_to_aws.R

@@ -124,12 +124,14 @@ meta_sets <- function(input, scdata, color_pool) {
   cell_set_list <- c()
   meta <- lapply(input$metadata, unlist)
 
-  # names of metadata tracks
+  # user-supplied metadata track names
   keys <- names(meta)
 
-  # corresponding names stored in seurat object meta.data
-  seurat_keys <- scdata@misc$metadata_lookups[[keys]]
+  # syntactically valid metadata names as stored in scdata
+  # same names as used in construct_metadata including internal 'samples' column (dropped)
+  seurat_keys <- make.names(c('samples', keys), unique = TRUE)[-1]
 
+  color_index <- 1
   for (i in seq_along(keys)) {
     key <- keys[i]
     seurat_key <- seurat_keys[i]
@@ -144,16 +146,20 @@ meta_sets <- function(input, scdata, color_pool) {
 
     # values of current metadata track
     values <- unique(meta[[i]])
-    for (i in seq_along(values)) {
-      value <- values[i]
+
+    for (j in seq_along(values)) {
+      value <- values[j]
       cell_ids <- scdata$cells_id[scdata[[seurat_key]] == value]
 
-      cell_set$children[[i]] <- list(
+      cell_set$children[[j]] <- list(
         "key" = paste(key, value, sep = "-"),
         "name" = value,
-        "color" = color_pool[i],
+        "color" = color_pool[color_index],
         "cellIds" = unname(cell_ids)
       )
+
+      color_index <- color_index + 1
+
     }
     cell_set_list <- c(cell_set_list, list(cell_set))
   }

pipeline-runner/R/gem2s-helpers.R

@@ -6,6 +6,18 @@ check_prev_out <- function(prev_out, check_names) {
   }
 }
 
+check_input <- function(input) {
+
+  # check that metadata items length is same as number of samples
+  metadata <- input$metadata
+
+  if (length(metadata)) {
+    nsamples <- length(input$sampleNames)
+    nmeta <- sapply(metadata, length)
+    if (!all(nmeta == nsamples)) stop ('Sample number differs from metadata length.')
+  }
+}
+
 
 get_color_pool <- function() {
   c(

pipeline-runner/init.R

@@ -76,7 +76,7 @@ load_config <- function(development_aws_server) {
     }
 
     if(config$cluster_env == 'development') {
-        config$api_url <- "http://host.docker.internal:3000"
+        config$api_url <- sprintf("http://%s:3000", development_aws_server)
         config$aws_config[['endpoint']] <- sprintf("http://%s:4566", development_aws_server) # DOCKER_GATEWAY_HOST
         config$aws_config[['credentials']] <- list(
             creds = list(
@@ -184,11 +184,14 @@ run_gem2s_step <- function(task_name, input, pipeline_config, prev_out) {
     return(res)
 }
 
+
 call_gem2s <- function(task_name, input, pipeline_config) {
     experiment_id <- input$experimentId
 
     if (!exists("prev_out")) assign("prev_out", NULL, pos = ".GlobalEnv")
 
+    check_input(input)
+
     c(data, task_out) %<-% run_gem2s_step(task_name, input, pipeline_config, prev_out)
     assign("prev_out", task_out, pos = ".GlobalEnv")
 

pipeline-runner/tests/testthat/_snaps/gem2s-7-upload_to_aws.md

@@ -0,0 +1,87 @@
+# get_cell_sets without metadata matches snapshot
+
+    Code
+      str(cell_sets)
+    Output
+      List of 1
+       $ cellSets:List of 2
+        ..$ :List of 5
+        .. ..$ key     : chr "scratchpad"
+        .. ..$ name    : chr "Custom cell sets"
+        .. ..$ rootNode: logi TRUE
+        .. ..$ children: list()
+        .. ..$ type    : chr "cellSets"
+        ..$ :List of 5
+        .. ..$ key     : chr "sample"
+        .. ..$ name    : chr "Samples"
+        .. ..$ rootNode: logi TRUE
+        .. ..$ children:List of 2
+        .. .. ..$ :List of 4
+        .. .. .. ..$ key    : chr "123abc"
+        .. .. .. ..$ name   : chr "WT1"
+        .. .. .. ..$ color  : chr "#e377c2"
+        .. .. .. ..$ cellIds: int [1:40] 0 1 2 3 4 5 6 7 8 9 ...
+        .. .. ..$ :List of 4
+        .. .. .. ..$ key    : chr "123def"
+        .. .. .. ..$ name   : chr "WT2"
+        .. .. .. ..$ color  : chr "#8c564b"
+        .. .. .. ..$ cellIds: int [1:40] 40 41 42 43 44 45 46 47 48 49 ...
+        .. ..$ type    : chr "metadataCategorical"
+
+# get_cell_sets with two metadata groups matches snapshot
+
+    Code
+      str(cell_sets)
+    Output
+      List of 1
+       $ cellSets:List of 4
+        ..$ :List of 5
+        .. ..$ key     : chr "scratchpad"
+        .. ..$ name    : chr "Custom cell sets"
+        .. ..$ rootNode: logi TRUE
+        .. ..$ children: list()
+        .. ..$ type    : chr "cellSets"
+        ..$ :List of 5
+        .. ..$ key     : chr "sample"
+        .. ..$ name    : chr "Samples"
+        .. ..$ rootNode: logi TRUE
+        .. ..$ children:List of 2
+        .. .. ..$ :List of 4
+        .. .. .. ..$ key    : chr "123abc"
+        .. .. .. ..$ name   : chr "WT1"
+        .. .. .. ..$ color  : chr "#e377c2"
+        .. .. .. ..$ cellIds: int [1:40] 0 1 2 3 4 5 6 7 8 9 ...
+        .. .. ..$ :List of 4
+        .. .. .. ..$ key    : chr "123def"
+        .. .. .. ..$ name   : chr "WT2"
+        .. .. .. ..$ color  : chr "#8c564b"
+        .. .. .. ..$ cellIds: int [1:40] 40 41 42 43 44 45 46 47 48 49 ...
+        .. ..$ type    : chr "metadataCategorical"
+        ..$ :List of 5
+        .. ..$ key     : chr "Group1"
+        .. ..$ name    : chr "Group1"
+        .. ..$ rootNode: logi TRUE
+        .. ..$ children:List of 2
+        .. .. ..$ :List of 4
+        .. .. .. ..$ key    : chr "Group1-Hello"
+        .. .. .. ..$ name   : chr "Hello"
+        .. .. .. ..$ color  : chr "#d62728"
+        .. .. .. ..$ cellIds: int [1:40] 0 1 2 3 4 5 6 7 8 9 ...
+        .. .. ..$ :List of 4
+        .. .. .. ..$ key    : chr "Group1-WT2"
+        .. .. .. ..$ name   : chr "WT2"
+        .. .. .. ..$ color  : chr "#2ca02c"
+        .. .. .. ..$ cellIds: int [1:40] 40 41 42 43 44 45 46 47 48 49 ...
+        .. ..$ type    : chr "metadataCategorical"
+        ..$ :List of 5
+        .. ..$ key     : chr "Group2"
+        .. ..$ name    : chr "Group2"
+        .. ..$ rootNode: logi TRUE
+        .. ..$ children:List of 1
+        .. .. ..$ :List of 4
+        .. .. .. ..$ key    : chr "Group2-WT"
+        .. .. .. ..$ name   : chr "WT"
+        .. .. .. ..$ color  : chr "#ff7f0e"
+        .. .. .. ..$ cellIds: int [1:80] 0 1 2 3 4 5 6 7 8 9 ...
+        .. ..$ type    : chr "metadataCategorical"
+

pipeline-runner/tests/testthat/test-gem2s-5-create_seurat.R

@@ -62,52 +62,19 @@ test_that("construct_metadata works with syntactically invalid column names", {
         )
 
     metadata <- construct_metadata(counts, sample, config)
+    valid_names <- make.names(colnames(metadata), unique = TRUE)
 
-    # doesn't change column names of metadata
-    expect_equal(colnames(metadata), c('samples', 'TRUE', '1first', 'with space', 'with-dash'))
+    # changes column names of metadata
+    expect_equal(colnames(metadata), valid_names)
 
     # stores correct values in metadata
-    expect_true(all(metadata[['TRUE']] == 'a'))
-    expect_true(all(metadata[['1first']] == 'b'))
-    expect_true(all(metadata[['with space']] == 'c'))
-    expect_true(all(metadata[['with-dash']] == 'd'))
+    expect_true(all(metadata$TRUE. == 'a'))
+    expect_true(all(metadata$X1first == 'b'))
+    expect_true(all(metadata$with.space == 'c'))
+    expect_true(all(metadata$with.dash == 'd'))
 })
 
 
-test_that("result of get_metadata_lookups can be used to access syntactically invalid slots", {
-
-    sample <- 'hello'
-    counts <- mock_counts()
-
-    config <- list(
-        samples = 'hello',
-        metadata = list('TRUE' = list('a'),
-                        '1first' = list('b'),
-                        'with space' = list('c'),
-                        'with-dash' = list('d'))
-    )
-
-    metadata <- construct_metadata(counts, sample, config)
-    lookups <- get_metadata_lookups(metadata)
-
-    # seurat stores as syntactically valid names
-    scdata <- SeuratObject::CreateSeuratObject(counts, meta.data = metadata)
-    expect_true(all(lookups %in% colnames(scdata@meta.data)))
-
-    # use lookups to access
-    keys <- c('TRUE', '1first', 'with space', 'with-dash')
-    values <- c('a', 'b', 'c', 'd')
-
-    for (i in seq_along(keys)) {
-        key <- keys[i]
-        val <- values[i]
-        seurat_key <- lookups[[key]]
-
-        expect_true(seurat_key %in% colnames(scdata@meta.data))
-        expect_true(all(scdata[[seurat_key]] == val))
-    }
-})
-
 
 test_that("create_seurat works without emptyDrops result", {