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..ab5d23fe 100644 --- a/R/connectivity.R +++ b/R/connectivity.R @@ -102,6 +102,9 @@ 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. 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 @@ -170,10 +173,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 +190,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 +218,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 +238,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"), @@ -252,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 @@ -555,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 @@ -628,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") diff --git a/man/neuprint_connection_table.Rd b/man/neuprint_connection_table.Rd index a8840c6e..2ef36202 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,10 @@ 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. 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 (\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..436eb922 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), @@ -23,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", {