Merge branch 'issue15' into dev

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: JoesFlow
 Title: Joes Flow simplified analysis for single cell modality data
-Version: 0.1.4-2
+Version: 0.1.4-3
 Authors@R: c(person('Cooper', 'Devlin', email = 'jcooperdevlin@gmail.com', 
                     role = c('cre', 'aut')),
              person('Randy', 'Johnson', email = 'johnsonra@mail.nih.gov',

R/app_server.R

@@ -688,13 +688,16 @@ app_server <- function(input, output, session) {
   output$pca_coord_download = downloadHandler(
     filename = 'PCA_coords.txt',
     content = function(file) {
+      # (getting a warning with the use of `.data$` inside of dplyr::rename)
+      X1 <- X2 <- NULL
 
       extract_values(clustered_data = pca_coords(),
                      ids            = data_mat()[,1],
                      meta           = meta_mat(),
-                     grp            = input$meta_val) %>%
+                     grp            = input$meta_val,
+                     cluster        = kmeaner()) %>%
 
-        rename(PC1 = .data$X1, PC2 = .data$X2) %>%
+        rename(PC1 = X1, PC2 = X2) %>%
 
         utils::write.table(file, sep='\t', quote=FALSE, row.names=FALSE)
     })
@@ -734,12 +737,16 @@ app_server <- function(input, output, session) {
   output$umap_coord_download = downloadHandler(
     filename = 'UMAP_coords.txt',
     content = function(file) {
+      # (getting a warning with the use of `.data$` inside of dplyr::rename)
+      X1 <- X2 <- NULL
+
       extract_values(clustered_data = umap_coords(),
                      ids            = data_mat()[,1],
                      meta           = meta_mat(),
-                     grp            = input$meta_val) %>%
+                     grp            = input$meta_val,
+                     cluster        = kmeaner()) %>%
 
-        rename(UMAP_1 = .data$X1, UMAP_2 = .data$X2) %>%
+        rename(UMAP_1 = X1, UMAP_2 = X2) %>%
 
         utils::write.table(file, sep='\t', quote=FALSE, row.names=FALSE)
     })
@@ -771,12 +778,16 @@ app_server <- function(input, output, session) {
   output$tsne_coord_download = downloadHandler(
     filename = 'TSNE_coords.txt',
     content = function(file) {
+      # (getting a warning with the use of `.data$` inside of dplyr::rename)
+      X1 <- X2 <- NULL
+
       extract_values(clustered_data = tsne_coords(),
                      ids            = data_mat()[,1],
                      meta           = meta_mat(),
-                     grp            = input$meta_val) %>%
+                     grp            = input$meta_val,
+                     cluster        = kmeaner()) %>%
 
-        rename(tSNE_1 = .data$X1, tSNE_2 = .data$X2) %>%
+        rename(tSNE_1 = X1, tSNE_2 = X2) %>%
 
         utils::write.table(file, sep='\t', quote=FALSE, row.names=FALSE)
     })

R/extract_values.R

@@ -8,6 +8,7 @@
 #' @param ids Character vector of ids for each row in `clustered_data`, corresponding to labels in `grps`
 #' @param meta Data frame containing translation from id to group
 #' @param grp Character value identifying the column of `meta` to use for group identifier
+#' @param cluster Data frame containing sample ID and the assigned kmeans cluster, as returned by `kmeaner()`
 #' @param ... Other objects passed to methods of `extract_values`
 #'
 #' @return A tibble with values for SampleID, Group, Cluster, PC/vector 1, and PC/vector 2
@@ -23,16 +24,16 @@ extract_values <- function(clustered_data, ...)
 #' @rdname extract_values
 #' @method extract_values prcomp
 #' @export
-extract_values.prcomp <- function(clustered_data, ids, meta, grp, ...)
+extract_values.prcomp <- function(clustered_data, ids, meta, grp, cluster = NULL, ...)
 {
-  extract_values(clustered_data$x, ids, meta, grp, ...)
+  extract_values(clustered_data$x, ids, meta, grp, cluster, ...)
 }
 
 # method for matrix object
 #' @rdname extract_values
 #' @method extract_values matrix
 #' @export
-extract_values.matrix <- function(clustered_data, ids, meta, grp, ...)
+extract_values.matrix <- function(clustered_data, ids, meta, grp, cluster = NULL, ...)
 {
   # fix "no visible global function definition" warnings in devtools::check()
   # (can't use `.data$` inside of dplyr::select)
@@ -43,6 +44,9 @@ extract_values.matrix <- function(clustered_data, ids, meta, grp, ...)
                    X1       = clustered_data[,1],
                    X2       = clustered_data[,2])
 
+  if(!is.null(cluster))
+    retval$cluster <- cluster$grp
+
   # grouping labels
   meta_grps <- tibble(id = meta[,1] %>% unlist(),
                       grp = meta[,grp] %>% unlist())
@@ -64,7 +68,12 @@ extract_values.matrix <- function(clustered_data, ids, meta, grp, ...)
   }
 
   # put IDs at the front and return
-  dplyr::select(retval, SampleID, Group, X1, X2)
+  if(!is.null(cluster))
+  {
+    return(dplyr::select(retval, SampleID, Group, cluster, X1, X2))
+  }else{
+    return(dplyr::select(retval, SampleID, Group, X1, X2))
+  }
 }
 
 
@@ -75,19 +84,20 @@ extract_values.matrix <- function(clustered_data, ids, meta, grp, ...)
 #' @param ids Character vector of ids for each row in `clustered_data$x`, corresponding to labels in `grps`
 #' @param meta Data frame containing translation from id to group
 #' @param grp Character value identifying the column of `meta` to use for group identifier
+#' @param cluster Data frame containing sample ID and the assigned kmeans cluster, as returned by `kmeaner()`
 #' @return a data frame with values for SampleID, Group, PC1, and PC2
 #' @export
 #' @import dplyr
-extract_sb_values <- function(clustered_data, ids, meta, grp)
+extract_sb_values <- function(clustered_data, ids, meta, grp, cluster = NULL)
 {
   # fix "no visible global function definition" warnings in devtools::check()
   # (can't use `.data$` inside of dplyr::select)
   SampleID <- Group <- PC1 <- PC2 <- NULL
 
   # pull principal components from sb_pca()
-  tibble(SampleID = ids,
-         PC1      = clustered_data$x[,'PC1'],
-         PC2      = clustered_data$x[,'PC2']) %>%
+  retval <- tibble(SampleID = ids,
+                   PC1      = clustered_data$x[,'PC1'],
+                   PC2      = clustered_data$x[,'PC2']) %>%
 
     # add grouping information
     group_by(.data$SampleID) %>%
@@ -96,6 +106,13 @@ extract_sb_values <- function(clustered_data, ids, meta, grp)
     ungroup() %>%
 
     dplyr::select(SampleID, Group, PC1, PC2)
+
+  if(!is.null(cluster))
+  {
+    retval$cluster <- cluster$grp
+  }
+
+  retval
 }
 
 

inst/WORDLIST

@@ -2,29 +2,26 @@ IDSS
 Joes
 Kmeans
 NIAID
-RData
 RStudio
 Rtsne
 SampleID
 UMAP
 clusterJF
 cytometry
-devtools
-flowdata
 ggplot
 github
 grps
 https
 interpretable
 io
+kmeaner
 kmeans
 loadings
 niaid
 prcomp
 sb
 scRNA
 tSNE
-testData
 tibble
 tsne
 uamp

tests/testthat/test-output.R

@@ -0,0 +1,88 @@
+# test functionality of tabular outputs
+
+#########
+# Setup #
+#########
+
+library(JoesFlow)
+library(shiny)
+
+# check which data sets we can test
+extdata_dir  <- system.file( 'extdata', package = 'JoesFlow')
+testData_dir <- system.file('testData', package = 'JoesFlow')
+
+test_data <- tibble(lab = 'test',
+                    flow = paste0(extdata_dir, '/flow.csv'),
+                    meta = paste0(extdata_dir, '/metadata.csv'))
+
+if(testData_dir != '')
+{
+  test_data <- tibble(lab = list.files(testData_dir),
+                      flow = paste0(testData_dir, '/', lab, '/flow.csv'),
+                      meta = paste0(testData_dir, '/', lab, '/metadata.csv')) %>%
+    bind_rows(test_data)
+}
+
+
+#########
+# Tests #
+#########
+
+test_that('Tabular output tests', {
+
+  testServer(shinyApp(ui = app_ui(),
+                      server = app_server),
+             {
+               # set up inputs
+               session$setInputs(nav_bar                    = "Visualize",
+                                 main_output                = 'UMAP',
+                                 file1                      = NULL,
+                                 file2                      = NULL,
+                                 subsample                  = 0.2,
+                                 seed                       = 247893,
+                                 meta_val                   = "ID",
+                                 clust_type                 = "Kmeans",
+                                 kmean                      = 5,
+                                 feat_dim                   = "PCA",
+                                 colpal                     = "Default",
+                                 show_hide_dimreduct_legend = "Show",
+                                 show_hide_cluster_legend   = "Show",
+                                 plot1_brush                = NULL,
+                                 download_width             = 15,
+                                 download_height            = 10)
+
+               for(i in 1:nrow(test_data))
+               {
+                 # set input files (test_data_paths is a `reactiveValues` object in the app)
+                 test_data_paths$flow <- test_data$flow[i]
+                 test_data_paths$meta <- test_data$meta[i]
+
+
+                 ### unit tests to run on all data sets ###
+
+                 # check PCA output
+                 tmp <- output$pca_coord_download %>%
+                   read.table(sep = '\t', header = TRUE)
+
+                 expect_s3_class(tmp, "data.frame")
+                 expect_equal(names(tmp), c('SampleID', 'Group', 'cluster', 'PC1', 'PC2'))
+
+                 # check UMAP output
+                 tmp <- output$umap_coord_download %>%
+                   read.table(sep = '\t', header = TRUE)
+
+                 expect_s3_class(tmp, "data.frame")
+                 expect_equal(names(tmp), c('SampleID', 'Group', 'cluster', 'UMAP_1', 'UMAP_2'))
+
+                 # check tSNE output
+                 tmp <- output$tsne_coord_download %>%
+                   read.table(sep = '\t', header = TRUE)
+
+                 expect_s3_class(tmp, "data.frame")
+                 expect_equal(names(tmp), c('SampleID', 'Group', 'cluster', 'tSNE_1', 'tSNE_2'))
+
+                 # check sample-based pca output
+                 expect_s3_class(sb_vals(), 'tbl')
+               }
+             })
+})