From 455e787241fdf11d26f365b7756445036857abb3 Mon Sep 17 00:00:00 2001
From: Gregory Jefferis <jefferis@gmail.com>
Date: Sat, 2 Nov 2024 12:04:35 +0000
Subject: [PATCH] cf_meta: add keep.all argument to keep all columns

---
 R/meta.R                   |  7 +++++--
 R/utils.R                  | 15 +++++++++------
 man/cf_meta.Rd             |  5 +++++
 tests/testthat/test-meta.R |  7 +++++++
 4 files changed, 26 insertions(+), 8 deletions(-)

diff --git a/R/meta.R b/R/meta.R
index ad5ac5c..51fd9e3 100644
--- a/R/meta.R
+++ b/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"), ...) {
diff --git a/R/utils.R b/R/utils.R
index 4163c9d..3a183df 100644
--- a/R/utils.R
+++ b/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
 }
 
diff --git a/man/cf_meta.Rd b/man/cf_meta.Rd
index efe2ca4..cee1bea 100644
--- a/man/cf_meta.Rd
+++ b/man/cf_meta.Rd
@@ -8,6 +8,7 @@ cf_meta(
   ids,
   bind.rows = TRUE,
   integer64 = FALSE,
+  keep.all = FALSE,
   MoreArgs = list(flywire = list(type = c("cell_type", "hemibrain_type")))
 )
 }
@@ -24,6 +25,10 @@ note that some columns will be dropped).}
 ints (more compact but a little fragile as they rely on the \code{bit64}
 extension package.)}
 
+\item{keep.all}{When fetching metadata from different datasets, whether to
+keep all metadata columns rather than just those in common
+(default=\code{FALSE})}
+
 \item{MoreArgs}{A named list of arguments to be passed when fetching metadata
 for a given function. See details.}
 }
diff --git a/tests/testthat/test-meta.R b/tests/testthat/test-meta.R
index 4fe9d4d..a0fbf73 100644
--- a/tests/testthat/test-meta.R
+++ b/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"))
 })