From 8a6f39b170c76f717de7a906cb66d98075dc823e Mon Sep 17 00:00:00 2001 From: Gregory Jefferis Date: Thu, 30 Jul 2020 08:16:42 +0100 Subject: [PATCH 1/3] Basic implementation and test for connection threshold * note that checkmate was already an indirect dependency --- DESCRIPTION | 5 +++-- NAMESPACE | 1 + R/connectivity.R | 9 +++++++++ man/neuprint_connection_table.Rd | 4 ++++ tests/testthat/test-connectivity.R | 5 +++++ 5 files changed, 22 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 03fbd2c0..8ff0698d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -39,12 +39,13 @@ Imports: bit64, stringr, tibble, - Matrix + Matrix, + checkmate Remotes: natverse/drvid, natverse/nat Encoding: UTF-8 Language: en-GB -RoxygenNote: 7.1.0 +RoxygenNote: 7.1.1 URL: https://github.com/natverse/neuprintr BugReports: https://github.com/natverse/neuprintr/issues diff --git a/NAMESPACE b/NAMESPACE index 9b384739..8c6c4bb6 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -37,6 +37,7 @@ export(neuprint_skeleton_connectivity_matrix) export(neuprint_version) export(progress_natprogress) importFrom(Matrix,sparseMatrix) +importFrom(checkmate,assert_integer) importFrom(drvid,read.neuron.dvid) importFrom(httr,parse_url) importFrom(memoise,memoise) diff --git a/R/connectivity.R b/R/connectivity.R index 903b2607..e8a7960d 100644 --- a/R/connectivity.R +++ b/R/connectivity.R @@ -102,6 +102,8 @@ neuprint_get_adjacency_matrix <- function(bodyids=NULL, inputids=NULL, #' \code{bodyids} #' @param by.roi logical, whether or not to break neurons' connectivity down by #' region of interest (ROI) +#' @param threshold Only return partners >= to an integer value. Default of 1 +#' returns all partners. #' @param superLevel When \code{by.roi=TRUE}, should we look at low-level ROIs #' (\code{superLevel=FALSE}) or only super-level ROIs #' (\code{superLevel=TRUE}). A super-level ROIs can contain multiple @@ -170,10 +172,12 @@ neuprint_get_adjacency_matrix <- function(bodyids=NULL, inputids=NULL, #' by.roi = TRUE, roi = "LH(R)") #' #' } +#' @importFrom checkmate assert_integer neuprint_connection_table <- function(bodyids, prepost = c("PRE","POST"), roi = NULL, by.roi = FALSE, + threshold=1L, superLevel = FALSE, progress = FALSE, dataset = NULL, @@ -185,6 +189,8 @@ neuprint_connection_table <- function(bodyids, conn<-neuprint_login(conn) bodyids <- neuprint_ids(bodyids, dataset = dataset, conn = conn) + threshold=assert_integer(as.integer(round(threshold)), lower = 1, len = 1) + nP <- length(bodyids) if(is.numeric(chunk)) { chunksize=chunk @@ -211,6 +217,7 @@ neuprint_connection_table <- function(bodyids, prepost = prepost, roi = roi, by.roi = by.roi, + threshold = threshold, progress = FALSE, dataset = dataset, conn = conn, ...), error = function(e) {warning(e); NULL}))) @@ -230,12 +237,14 @@ neuprint_connection_table <- function(bodyids, "MATCH (a:`%s`)-[c:ConnectsTo]->(b:`%s`)", "WHERE %s.bodyId=bodyId", "%s", + "%s", "RETURN a.bodyId AS %s, b.bodyId AS %s, c.weight AS weight", "%s"), id2json(bodyids), all_segments.json, all_segments.json, ifelse(prepost=="POST","a","b"), + ifelse(threshold>1, paste("AND c.weight >= ", threshold), ""), ifelse(!is.null(roi)|by.roi,"UNWIND keys(apoc.convert.fromJsonMap(c.roiInfo)) AS k",""), ifelse(prepost=="POST","bodyid","partner"), ifelse(prepost=="POST","partner","bodyid"), diff --git a/man/neuprint_connection_table.Rd b/man/neuprint_connection_table.Rd index a8840c6e..2a1e9e8b 100644 --- a/man/neuprint_connection_table.Rd +++ b/man/neuprint_connection_table.Rd @@ -9,6 +9,7 @@ neuprint_connection_table( prepost = c("PRE", "POST"), roi = NULL, by.roi = FALSE, + threshold = 1L, superLevel = FALSE, progress = FALSE, dataset = NULL, @@ -31,6 +32,9 @@ inputs) or \code{POST}: postsynaptic (downstream outputs) to the given \item{by.roi}{logical, whether or not to break neurons' connectivity down by region of interest (ROI)} +\item{threshold}{Only return partners >= to an integer value. Default of 1 +returns all partners.} + \item{superLevel}{When \code{by.roi=TRUE}, should we look at low-level ROIs (\code{superLevel=FALSE}) or only super-level ROIs (\code{superLevel=TRUE}). A super-level ROIs can contain multiple diff --git a/tests/testthat/test-connectivity.R b/tests/testthat/test-connectivity.R index 8d62eaf9..48851025 100644 --- a/tests/testthat/test-connectivity.R +++ b/tests/testthat/test-connectivity.R @@ -8,6 +8,11 @@ test_that("neuprint_connection_table works", { progress = TRUE), t1) + # test that threshold works ok + expect_equal( + neuprint_connection_table(c(818983130, 1796818119),threshold = 2), + subset(t1, weight >= 2)) + expect_is(t2 <- neuprint_connection_table(c(818983130, 1796818119), prepost = "POST", by.roi = TRUE), From 2b4592ebe4a46ea55c0ffa10d007d0d3695bb897 Mon Sep 17 00:00:00 2001 From: Gregory Jefferis Date: Fri, 31 Jul 2020 09:15:13 +0100 Subject: [PATCH 2/3] Apply threshold to ROIweight * the cypher got a bit hairy so I actually only apply the ROI weight threshold to downloaded data. * I'm sure there must be a way to apply it on the server in a multi-level query. --- R/connectivity.R | 12 +++++++++--- man/neuprint_connection_table.Rd | 3 ++- tests/testthat/test-connectivity.R | 9 +++++++++ 3 files changed, 20 insertions(+), 4 deletions(-) diff --git a/R/connectivity.R b/R/connectivity.R index e8a7960d..dd71a97b 100644 --- a/R/connectivity.R +++ b/R/connectivity.R @@ -103,7 +103,8 @@ neuprint_get_adjacency_matrix <- function(bodyids=NULL, inputids=NULL, #' @param by.roi logical, whether or not to break neurons' connectivity down by #' region of interest (ROI) #' @param threshold Only return partners >= to an integer value. Default of 1 -#' returns all partners. +#' returns all partners. This threshold will be applied to the ROI weight when +#' the \code{roi} argument is specified, otherwise to the whole neuron. #' @param superLevel When \code{by.roi=TRUE}, should we look at low-level ROIs #' (\code{superLevel=FALSE}) or only super-level ROIs #' (\code{superLevel=TRUE}). A super-level ROIs can contain multiple @@ -261,13 +262,18 @@ neuprint_connection_table <- function(bodyids, if(!is.null(roi)){ d <- d[d$roi%in%roi,] } - if(by.roi&is.null(roi)){ + if(by.roi && is.null(roi)){ rois <- neuprint_ROIs(superLevel = superLevel) d <- d[d$roi%in%rois,] } d <- d[order(d$weight,decreasing=TRUE),] rownames(d) <- NULL - d[,sort(colnames(d))] + d=d[,sort(colnames(d))] + + if(!is.null(roi) && threshold>1) + d=d[d$ROIweight>=threshold,] + + d } #' @title Get the common synaptic partners for a set of neurons diff --git a/man/neuprint_connection_table.Rd b/man/neuprint_connection_table.Rd index 2a1e9e8b..2ef36202 100644 --- a/man/neuprint_connection_table.Rd +++ b/man/neuprint_connection_table.Rd @@ -33,7 +33,8 @@ inputs) or \code{POST}: postsynaptic (downstream outputs) to the given region of interest (ROI)} \item{threshold}{Only return partners >= to an integer value. Default of 1 -returns all partners.} +returns all partners. This threshold will be applied to the ROI weight when +the \code{roi} argument is specified, otherwise to the whole neuron.} \item{superLevel}{When \code{by.roi=TRUE}, should we look at low-level ROIs (\code{superLevel=FALSE}) or only super-level ROIs diff --git a/tests/testthat/test-connectivity.R b/tests/testthat/test-connectivity.R index 48851025..436eb922 100644 --- a/tests/testthat/test-connectivity.R +++ b/tests/testthat/test-connectivity.R @@ -28,6 +28,15 @@ test_that("neuprint_connection_table works", { 'data.frame') # equivalent so we don't worry about rownames expect_equivalent(subset(t2, roi=='LH(R)'), t3) + expect_equivalent( + neuprint_connection_table( + c(818983130, 1796818119), + prepost = "POST", + roi = "LH(R)", + threshold = 3 + ), + subset(t3, ROIweight >= 3) + ) }) test_that("other connectivity functions work", { From 62945c9ef8701b1cc67c7d9344ddc2263c7e906b Mon Sep 17 00:00:00 2001 From: Gregory Jefferis Date: Fri, 31 Jul 2020 19:58:46 +0100 Subject: [PATCH 3/3] ensure that neuprint_get_paths returns data.frames * this is just to ensure consistency after various changes in dplyr/tibble that more aggressively return tibbles (which are nice but ...) --- R/connectivity.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/connectivity.R b/R/connectivity.R index dd71a97b..ab5d23fe 100644 --- a/R/connectivity.R +++ b/R/connectivity.R @@ -570,7 +570,7 @@ neuprint_get_paths <- function(body_pre, body_post, n, weightT=5, roi=NULL, by.r connTable <- dplyr::bind_cols(connTable,roiTable) } - connTable + as.data.frame(connTable) } #' @title Get a list of the shortest paths between two neurons @@ -643,7 +643,7 @@ neuprint_get_shortest_paths <- function(body_pre,body_post,weightT=5,roi=NULL,by all_segments=all_segments, ...), error = function(e) {warning(e); NULL}))) - return(d) + return(as.data.frame(d)) } all_segments.json <- ifelse(all_segments,"Segment","Neuron")