From 06010e935883e7b70774173cdb948238f5a45328 Mon Sep 17 00:00:00 2001 From: Dominik Krzeminski Date: Thu, 9 Jun 2022 12:21:35 +0100 Subject: [PATCH 1/4] added withMeta parameter to nlapply --- R/neuronlist.R | 10 +++++++++- man/nlapply.Rd | 4 ++++ tests/testthat/test-neuronlist.R | 18 ++++++++++++++++++ 3 files changed, 31 insertions(+), 1 deletion(-) diff --git a/R/neuronlist.R b/R/neuronlist.R index ea872c79..e8bf46e5 100644 --- a/R/neuronlist.R +++ b/R/neuronlist.R @@ -388,6 +388,8 @@ as.data.frame.neuronlist<-function(x, row.names = names(x), optional = FALSE, .. #' error. The default value (\code{NA}) will result in nlapply stopping with #' an error message the moment there is an error. For other values, see #' details. +#' @param withMeta whether or not to include the metadata from the neuronlist +#' data.frame #' @param .progress Character vector specifying the type of progress bar (see #' Progress bar section for details) The default value of \code{"auto"} shows #' a progress bar in interactive use after 2s. The default value can be @@ -479,7 +481,7 @@ as.data.frame.neuronlist<-function(x, row.names = names(x), optional = FALSE, .. #' options(nat.progress=NULL) #' sl=nlapply(Cell07PNs, FUN = seglengths) #' } -nlapply<-function (X, FUN, ..., subset=NULL, OmitFailures=NA, +nlapply<-function (X, FUN, ..., subset=NULL, OmitFailures=NA, withMeta=FALSE, .progress=getOption('nat.progress', default='auto')){ if(isTRUE(.progress=='auto')) { .progress = ifelse(interactive(), "natprogress", "none") @@ -495,6 +497,12 @@ nlapply<-function (X, FUN, ..., subset=NULL, OmitFailures=NA, class(X) else c("neuronlist", 'list') + if (withMeta && ncol(X[,]) > 0) { + meta_list <- split(X[,], seq(nrow(X[,]))) + Xlist = mapply(append, X, meta_list, SIMPLIFY = FALSE) + X = as.neuronlist(lapply(Xlist, as.neuron)) + } + if(!is.null(subset)){ if(!is.character(subset)) subset=names(X)[subset] Y=X diff --git a/man/nlapply.Rd b/man/nlapply.Rd index 1a98c899..6a5d14ba 100644 --- a/man/nlapply.Rd +++ b/man/nlapply.Rd @@ -12,6 +12,7 @@ nlapply( ..., subset = NULL, OmitFailures = NA, + withMeta = FALSE, .progress = getOption("nat.progress", default = "auto") ) @@ -45,6 +46,9 @@ error. The default value (\code{NA}) will result in nlapply stopping with an error message the moment there is an error. For other values, see details.} +\item{withMeta}{whether or not to include the metadata from the neuronlist +data.frame} + \item{.progress}{Character vector specifying the type of progress bar (see Progress bar section for details) The default value of \code{"auto"} shows a progress bar in interactive use after 2s. The default value can be diff --git a/tests/testthat/test-neuronlist.R b/tests/testthat/test-neuronlist.R index b0721825..0f89d819 100644 --- a/tests/testthat/test-neuronlist.R +++ b/tests/testthat/test-neuronlist.R @@ -327,6 +327,24 @@ test_that("[<-.neuronlist does the right thing",{ expect_null(colnames(kcs13[,]<-NULL)) }) +test_that("neuronlist includes metadata",{ + kcs13=kcs20[1:3] + + # expect that withMeta output will contain more attributes + out1 = nlapply(kcs13, function(x) x) + out2 = nlapply(kcs13, function(x) x, withMeta = T) + expect_true( + length(attributes(out1[[2]])$names) < length(attributes(out1[[1]])$names) + ) + + # or parts of columns + data.frame(kcs13) <- NULL + out3 = nlapply(kcs13, function(x) x, withMeta = T) + expect_true( + all(names(out1[[1]]) == names(out3[[1]])) + ) +}) + test_that("prune twigs of a neuronlist", { n = Cell07PNs[1:3] From 673a9458eae3032180e08ab8d002fc0ef0507968 Mon Sep 17 00:00:00 2001 From: Dominik Krzeminski Date: Thu, 9 Jun 2022 13:23:46 +0100 Subject: [PATCH 2/4] changed url path for the tests to pass --- R/neuronlistfh.R | 2 +- man/remotesync.Rd | 2 +- tests/testthat/test-.neuronlistfh-remote-nocran.R | 4 ++-- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/neuronlistfh.R b/R/neuronlistfh.R index 1ebc509d..695285ac 100644 --- a/R/neuronlistfh.R +++ b/R/neuronlistfh.R @@ -655,7 +655,7 @@ remotesync.default<-function(x, remote=attr(x,'remote'), download.missing=TRUE, #' @rdname remotesync #' @examples #' \dontrun{ -#' kcs20=read.neuronlistfh('http://flybrain.mrc-lmb.cam.ac.uk/si/nblast/flycircuit/kcs20.rds') +#' kcs20=read.neuronlistfh(' https://virtualflybrain.org/data/VFB/nblast/flycircuit/kcs20.rds') #' # update object from the web #' kcs20=remotesync(kcs20) #' # download all neurons with significant innervation of the vertical lobe diff --git a/man/remotesync.Rd b/man/remotesync.Rd index 479fd927..0ad8345f 100644 --- a/man/remotesync.Rd +++ b/man/remotesync.Rd @@ -49,7 +49,7 @@ Synchronise a remote object } \examples{ \dontrun{ -kcs20=read.neuronlistfh('http://flybrain.mrc-lmb.cam.ac.uk/si/nblast/flycircuit/kcs20.rds') +kcs20=read.neuronlistfh(' https://virtualflybrain.org/data/nblast/flycircuit/kcs20.rds') # update object from the web kcs20=remotesync(kcs20) # download all neurons with significant innervation of the vertical lobe diff --git a/tests/testthat/test-.neuronlistfh-remote-nocran.R b/tests/testthat/test-.neuronlistfh-remote-nocran.R index 42b854d6..9d07b9a7 100644 --- a/tests/testthat/test-.neuronlistfh-remote-nocran.R +++ b/tests/testthat/test-.neuronlistfh-remote-nocran.R @@ -6,7 +6,7 @@ test_that("we can download a neuronlistfh object with MD5'd objects", { localdir <- tempfile() dir.create(localdir) on.exit(unlink(localdir, recursive=TRUE)) - kcs20.url="http://flybrain.mrc-lmb.cam.ac.uk/si/nblast/flycircuit/kcs20.rds" + kcs20.url=" https://virtualflybrain.org/data/VFB/nblast/flycircuit/kcs20.rds" kcs20md5 <- read.neuronlistfh(kcs20.url, localdir=localdir, quiet=TRUE) # test trying to read in neuronlistfh object which is now available locally # before we have downloaded any data objects @@ -26,7 +26,7 @@ test_that("we can synchronise a neuronlistfh object with its remote", { localdir <- tempfile() dir.create(localdir) on.exit(unlink(localdir, recursive=TRUE)) - kcs20fh.remote <- read.neuronlistfh("http://flybrain.mrc-lmb.cam.ac.uk/si/nblast/flycircuit/kcs20.rds", + kcs20fh.remote <- read.neuronlistfh(" https://virtualflybrain.org/data/VFB/nblast/flycircuit/kcs20.rds", localdir=localdir) expect_equal(dim(kcs20fh.remote[[1]]$points), c(284, 3)) # make a neuronlistfh object from the local data bundled with this package From ce0045108376562a6b527dde1ccc6621d767d8ec Mon Sep 17 00:00:00 2001 From: Dominik Krzeminski Date: Thu, 9 Jun 2022 13:27:18 +0100 Subject: [PATCH 3/4] changed url path to http for the tests to pass --- R/neuronlistfh.R | 2 +- man/remotesync.Rd | 2 +- tests/testthat/test-.neuronlistfh-remote-nocran.R | 4 ++-- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/neuronlistfh.R b/R/neuronlistfh.R index 695285ac..d64f1a95 100644 --- a/R/neuronlistfh.R +++ b/R/neuronlistfh.R @@ -655,7 +655,7 @@ remotesync.default<-function(x, remote=attr(x,'remote'), download.missing=TRUE, #' @rdname remotesync #' @examples #' \dontrun{ -#' kcs20=read.neuronlistfh(' https://virtualflybrain.org/data/VFB/nblast/flycircuit/kcs20.rds') +#' kcs20=read.neuronlistfh('http://virtualflybrain.org/data/VFB/nblast/flycircuit/kcs20.rds') #' # update object from the web #' kcs20=remotesync(kcs20) #' # download all neurons with significant innervation of the vertical lobe diff --git a/man/remotesync.Rd b/man/remotesync.Rd index 0ad8345f..8f05e797 100644 --- a/man/remotesync.Rd +++ b/man/remotesync.Rd @@ -49,7 +49,7 @@ Synchronise a remote object } \examples{ \dontrun{ -kcs20=read.neuronlistfh(' https://virtualflybrain.org/data/nblast/flycircuit/kcs20.rds') +kcs20=read.neuronlistfh('http://virtualflybrain.org/data/nblast/flycircuit/kcs20.rds') # update object from the web kcs20=remotesync(kcs20) # download all neurons with significant innervation of the vertical lobe diff --git a/tests/testthat/test-.neuronlistfh-remote-nocran.R b/tests/testthat/test-.neuronlistfh-remote-nocran.R index 9d07b9a7..5e6564e6 100644 --- a/tests/testthat/test-.neuronlistfh-remote-nocran.R +++ b/tests/testthat/test-.neuronlistfh-remote-nocran.R @@ -6,7 +6,7 @@ test_that("we can download a neuronlistfh object with MD5'd objects", { localdir <- tempfile() dir.create(localdir) on.exit(unlink(localdir, recursive=TRUE)) - kcs20.url=" https://virtualflybrain.org/data/VFB/nblast/flycircuit/kcs20.rds" + kcs20.url="http://virtualflybrain.org/data/VFB/nblast/flycircuit/kcs20.rds" kcs20md5 <- read.neuronlistfh(kcs20.url, localdir=localdir, quiet=TRUE) # test trying to read in neuronlistfh object which is now available locally # before we have downloaded any data objects @@ -26,7 +26,7 @@ test_that("we can synchronise a neuronlistfh object with its remote", { localdir <- tempfile() dir.create(localdir) on.exit(unlink(localdir, recursive=TRUE)) - kcs20fh.remote <- read.neuronlistfh(" https://virtualflybrain.org/data/VFB/nblast/flycircuit/kcs20.rds", + kcs20fh.remote <- read.neuronlistfh("http://virtualflybrain.org/data/VFB/nblast/flycircuit/kcs20.rds", localdir=localdir) expect_equal(dim(kcs20fh.remote[[1]]$points), c(284, 3)) # make a neuronlistfh object from the local data bundled with this package From 55c92be4c2ba34724b7fd53d93e8e1ba6d7db2a8 Mon Sep 17 00:00:00 2001 From: Dominik Krzeminski Date: Thu, 9 Jun 2022 13:28:37 +0100 Subject: [PATCH 4/4] neuronlist test fixed --- tests/testthat/test-neuronlist.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-neuronlist.R b/tests/testthat/test-neuronlist.R index 0f89d819..3d91458c 100644 --- a/tests/testthat/test-neuronlist.R +++ b/tests/testthat/test-neuronlist.R @@ -334,7 +334,7 @@ test_that("neuronlist includes metadata",{ out1 = nlapply(kcs13, function(x) x) out2 = nlapply(kcs13, function(x) x, withMeta = T) expect_true( - length(attributes(out1[[2]])$names) < length(attributes(out1[[1]])$names) + length(attributes(out1[[2]])$names) < length(attributes(out2[[2]])$names) ) # or parts of columns