Merge pull request #30 from natverse/feature/keep.all

cf_meta: add keep.all argument to keep all columns

R/meta.R

@@ -25,6 +25,9 @@ npconn <- function(dataset) {
 #'   extension package.)
 #' @param MoreArgs A named list of arguments to be passed when fetching metadata
 #'   for a given function. See details.
+#' @param keep.all When fetching metadata from different datasets, whether to
+#'   keep all metadata columns rather than just those in common
+#'   (default=\code{FALSE})
 #'
 #' @inheritParams cf_partners
 #'
@@ -39,7 +42,7 @@ npconn <- function(dataset) {
 #' # / introduces a regular expression
 #' mbonmeta=cf_meta(cf_ids(hemibrain='/MBON.+'))
 #' }
-cf_meta <- function(ids, bind.rows=TRUE, integer64=FALSE,
+cf_meta <- function(ids, bind.rows=TRUE, integer64=FALSE, keep.all=FALSE,
                     MoreArgs=list(flywire=list(type=c("cell_type","hemibrain_type")))) {
   if(is.character(ids) || inherits(ids, 'dendrogram') || inherits(ids, 'hclust'))
     ids=keys2df(ids)
@@ -93,7 +96,7 @@ cf_meta <- function(ids, bind.rows=TRUE, integer64=FALSE,
     res[[n]]=tres
   }
   if(length(res)==0) return(NULL)
-  if(bind.rows) bind_rows2(res) else res
+  if(bind.rows) bind_rows2(res, keep.all=keep.all) else res
 }
 
 flywire_meta <- function(ids, type=c("cell_type","hemibrain_type"), ...) {

R/utils.R

@@ -1,15 +1,18 @@
 # private function to bind rows keeping common columns
-bind_rows2 <- function(l) {
+bind_rows2 <- function(l, keep.all=FALSE) {
   ll=lengths(l)
   l=l[ll>0]
   if(length(l)==0) return(NULL)
   if(length(l)==1) return(l[[1]])
 
-  nn=lapply(l, names)
-  commoncols=Reduce(intersect, nn[-1], init=nn[[1]])
-  l=lapply(l, "[", commoncols)
-
-  l <- do.call(function(...) rbind(..., make.row.names=FALSE), l)
+  if(!keep.all) {
+    nn=lapply(l, names)
+    commoncols=Reduce(intersect, nn[-1], init=nn[[1]])
+    l=lapply(l, "[", commoncols)
+    l <- do.call(function(...) rbind(..., make.row.names=FALSE), l)
+  } else {
+    l <- dplyr::bind_rows(l)
+  }
   l
 }
 

tests/testthat/test-meta.R

@@ -9,4 +9,11 @@ test_that("metadata", {
   expect_true(all(grepl("descending",
                         cf_meta(cf_ids(manc='DNa02'))$class)))
 
+  expect_s3_class(
+    dna02meta <- cf_meta(cf_ids(hemibrain = 'DNa02', manc='DNa02')),
+    'data.frame')
+  expect_s3_class(
+    dna02meta2 <- cf_meta(cf_ids(hemibrain = 'DNa02', manc='DNa02'), keep.all = T),
+    'data.frame')
+  expect_contains(colnames(dna02meta2), c("serial", "birthtime"))
 })