From 8840489534d7515ec19daf4fc9a9bcac145161a9 Mon Sep 17 00:00:00 2001 From: Romain Franconville Date: Wed, 15 Jan 2020 17:10:17 -0500 Subject: [PATCH 1/4] Prototype functions for paths and shortest paths running appropriate queries --- R/connectivity.R | 95 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 95 insertions(+) diff --git a/R/connectivity.R b/R/connectivity.R index 38a941e4..d30ef6e5 100644 --- a/R/connectivity.R +++ b/R/connectivity.R @@ -208,6 +208,101 @@ neuprint_simple_connectivity <- function(bodyids, d } +#' @title Get a list of paths of length n between 2 neurons +#' +#' @description Get all of the paths in the database that connect the +#' query neurons with at least weightT synapses at each step +#' @param body_pre the bodyid of the neuron at the start of the path +#' @param body_post the bodyid of the neuron at the end of the path +#' @param n the length of the path. If n is a vector, paths of length n[1] to n[2] are considered +#' @param weightT weight threshold +#' @param dataset optional, a dataset you want to query. If NULL, the default +#' specified by your R environ file is used. See \code{neuprint_login} for +#' details. +#' @param all_segments if TRUE, all bodies are considered, if FALSE, only 'Neurons', i.e. bodies with a status roughly traced status. +#' @param conn optional, a neuprintr connection object, which also specifies the +#' neuPrint server see \code{\link{neuprint_login}}. If NULL, your defaults +#' set in your R.profile or R.environ are used. +#' @param ... methods passed to \code{neuprint_login} +#' @return +#' @seealso \code{\link{neuprint_common_connectivity}}, +#' \code{\link{neuprint_get_adjacency_matrix}} +#' @export +#' @rdname neuprint_get_paths +neuprint_get_paths <- function(body_pre,body_post,n,weightT=5,dataset = NULL, conn = NULL,all_segments=FALSE, ...){ + + if (length(n)==1){ + n <- c(n,n) + } + dataset <- check_dataset(dataset) + conn <- neuprint_login(conn) + all_segments.json <- ifelse(all_segments,"Segment","Neuron") + dp <- neuprint_dataset_prefix(dataset, conn=conn) + prefixed <- paste0(dp, all_segments.json) + + cypher <- sprintf(paste("call apoc.cypher.runTimeboxed('MATCH p = (src : `%s`{ bodyId: %s })-[ConnectsTo*%s..%s]->(dest:`%s`{ bodyId: %s })", + "WHERE ALL (x in relationships(p) WHERE x.weight >= %s)", + "RETURN length(p) AS `length(path)`,[n in nodes(p) | [n.bodyId, n.type]] AS path,[x in relationships(p) | x.weight] AS weights', {},5000)", + "YIELD value return value.`length(path)` as `length(path)`, value.path as path, value.weights AS weights" + ), + prefixed, + as.numeric(body_pre), + n[1]-1, + n[2], + prefixed, + as.numeric(body_post), + weightT + ) + nc <- neuprint_fetch_custom(cypher=cypher, conn = conn) + + +} + +#' @title Get a list of paths of length n between 2 neurons +#' +#' @description Get all of the paths in the database that connect the +#' query neurons with at least weightT synapses at each step +#' @param body_pre the bodyid of the neuron at the start of the path +#' @param body_post the bodyid of the neuron at the end of the path +#' @param n the length of the path. If n is a vector, paths of length n[1] to n[2] are considered +#' @param weightT weight threshold +#' @param dataset optional, a dataset you want to query. If NULL, the default +#' specified by your R environ file is used. See \code{neuprint_login} for +#' details. +#' @param all_segments if TRUE, all bodies are considered, if FALSE, only 'Neurons', i.e. bodies with a status roughly traced status. +#' @param conn optional, a neuprintr connection object, which also specifies the +#' neuPrint server see \code{\link{neuprint_login}}. If NULL, your defaults +#' set in your R.profile or R.environ are used. +#' @param ... methods passed to \code{neuprint_login} +#' @return +#' @seealso \code{\link{neuprint_common_connectivity}}, +#' \code{\link{neuprint_get_adjacency_matrix}} +#' @export +#' @rdname neuprint_get_shortest_paths +neuprint_get_shortest_paths <- function(body_pre,body_post,weightT=5,dataset = NULL, conn = NULL,all_segments=FALSE, ...){ + + dataset <- check_dataset(dataset) + conn <- neuprint_login(conn) + all_segments.json <- ifelse(all_segments,"Segment","Neuron") + dp <- neuprint_dataset_prefix(dataset, conn=conn) + prefixed <- paste0(dp, all_segments.json) + + cypher <- sprintf(paste("call apoc.cypher.runTimeboxed('MATCH p = allShortestPaths((src : `%s`{ bodyId: %s })-[ConnectsTo*]->(dest:`%s`{ bodyId: %s }))", + "WHERE ALL (x in relationships(p) WHERE x.weight >= %s)", + "RETURN length(p) AS `length(path)`,[n in nodes(p) | [n.bodyId, n.type]] AS path,[x in relationships(p) | x.weight] AS weights', {},5000)", + "YIELD value return value.`length(path)` as `length(path)`, value.path as path, value.weights AS weights" + ), + prefixed, + as.numeric(body_pre), + prefixed, + as.numeric(body_post), + weightT + ) + nc <- neuprint_fetch_custom(cypher=cypher, conn = conn) + + +} + # hidden, caution, does not deal with left/right neuropils extract_connectivity_df <- function(rois, json){ if(is.null(json)){ From db4d18529b49d4eb863d3763f3d9e558767fb7a4 Mon Sep 17 00:00:00 2001 From: Romain Franconville Date: Wed, 15 Jan 2020 17:10:17 -0500 Subject: [PATCH 2/4] Prototype functions for paths and shortest paths running appropriate queries --- R/connectivity.R | 95 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 95 insertions(+) diff --git a/R/connectivity.R b/R/connectivity.R index 0d6491f8..d027935e 100644 --- a/R/connectivity.R +++ b/R/connectivity.R @@ -208,6 +208,101 @@ neuprint_simple_connectivity <- function(bodyids, d } +#' @title Get a list of paths of length n between 2 neurons +#' +#' @description Get all of the paths in the database that connect the +#' query neurons with at least weightT synapses at each step +#' @param body_pre the bodyid of the neuron at the start of the path +#' @param body_post the bodyid of the neuron at the end of the path +#' @param n the length of the path. If n is a vector, paths of length n[1] to n[2] are considered +#' @param weightT weight threshold +#' @param dataset optional, a dataset you want to query. If NULL, the default +#' specified by your R environ file is used. See \code{neuprint_login} for +#' details. +#' @param all_segments if TRUE, all bodies are considered, if FALSE, only 'Neurons', i.e. bodies with a status roughly traced status. +#' @param conn optional, a neuprintr connection object, which also specifies the +#' neuPrint server see \code{\link{neuprint_login}}. If NULL, your defaults +#' set in your R.profile or R.environ are used. +#' @param ... methods passed to \code{neuprint_login} +#' @return +#' @seealso \code{\link{neuprint_common_connectivity}}, +#' \code{\link{neuprint_get_adjacency_matrix}} +#' @export +#' @rdname neuprint_get_paths +neuprint_get_paths <- function(body_pre,body_post,n,weightT=5,dataset = NULL, conn = NULL,all_segments=FALSE, ...){ + + if (length(n)==1){ + n <- c(n,n) + } + dataset <- check_dataset(dataset) + conn <- neuprint_login(conn) + all_segments.json <- ifelse(all_segments,"Segment","Neuron") + dp <- neuprint_dataset_prefix(dataset, conn=conn) + prefixed <- paste0(dp, all_segments.json) + + cypher <- sprintf(paste("call apoc.cypher.runTimeboxed('MATCH p = (src : `%s`{ bodyId: %s })-[ConnectsTo*%s..%s]->(dest:`%s`{ bodyId: %s })", + "WHERE ALL (x in relationships(p) WHERE x.weight >= %s)", + "RETURN length(p) AS `length(path)`,[n in nodes(p) | [n.bodyId, n.type]] AS path,[x in relationships(p) | x.weight] AS weights', {},5000)", + "YIELD value return value.`length(path)` as `length(path)`, value.path as path, value.weights AS weights" + ), + prefixed, + as.numeric(body_pre), + n[1]-1, + n[2], + prefixed, + as.numeric(body_post), + weightT + ) + nc <- neuprint_fetch_custom(cypher=cypher, conn = conn) + + +} + +#' @title Get a list of paths of length n between 2 neurons +#' +#' @description Get all of the paths in the database that connect the +#' query neurons with at least weightT synapses at each step +#' @param body_pre the bodyid of the neuron at the start of the path +#' @param body_post the bodyid of the neuron at the end of the path +#' @param n the length of the path. If n is a vector, paths of length n[1] to n[2] are considered +#' @param weightT weight threshold +#' @param dataset optional, a dataset you want to query. If NULL, the default +#' specified by your R environ file is used. See \code{neuprint_login} for +#' details. +#' @param all_segments if TRUE, all bodies are considered, if FALSE, only 'Neurons', i.e. bodies with a status roughly traced status. +#' @param conn optional, a neuprintr connection object, which also specifies the +#' neuPrint server see \code{\link{neuprint_login}}. If NULL, your defaults +#' set in your R.profile or R.environ are used. +#' @param ... methods passed to \code{neuprint_login} +#' @return +#' @seealso \code{\link{neuprint_common_connectivity}}, +#' \code{\link{neuprint_get_adjacency_matrix}} +#' @export +#' @rdname neuprint_get_shortest_paths +neuprint_get_shortest_paths <- function(body_pre,body_post,weightT=5,dataset = NULL, conn = NULL,all_segments=FALSE, ...){ + + dataset <- check_dataset(dataset) + conn <- neuprint_login(conn) + all_segments.json <- ifelse(all_segments,"Segment","Neuron") + dp <- neuprint_dataset_prefix(dataset, conn=conn) + prefixed <- paste0(dp, all_segments.json) + + cypher <- sprintf(paste("call apoc.cypher.runTimeboxed('MATCH p = allShortestPaths((src : `%s`{ bodyId: %s })-[ConnectsTo*]->(dest:`%s`{ bodyId: %s }))", + "WHERE ALL (x in relationships(p) WHERE x.weight >= %s)", + "RETURN length(p) AS `length(path)`,[n in nodes(p) | [n.bodyId, n.type]] AS path,[x in relationships(p) | x.weight] AS weights', {},5000)", + "YIELD value return value.`length(path)` as `length(path)`, value.path as path, value.weights AS weights" + ), + prefixed, + as.numeric(body_pre), + prefixed, + as.numeric(body_post), + weightT + ) + nc <- neuprint_fetch_custom(cypher=cypher, conn = conn) + + +} + # hidden, caution, does not deal with left/right neuropils extract_connectivity_df <- function(rois, json){ if(is.null(json)){ From 14c0ee734011352b76172eeff4ceca0b06b153a0 Mon Sep 17 00:00:00 2001 From: Romain Franconville Date: Thu, 16 Jan 2020 11:17:21 -0500 Subject: [PATCH 3/4] Output a data frame with columns to,from,weight,name.to,name.from. --- R/connectivity.R | 20 ++++++++++++++++++-- 1 file changed, 18 insertions(+), 2 deletions(-) diff --git a/R/connectivity.R b/R/connectivity.R index d027935e..f07bb349 100644 --- a/R/connectivity.R +++ b/R/connectivity.R @@ -254,7 +254,15 @@ neuprint_get_paths <- function(body_pre,body_post,n,weightT=5,dataset = NULL, co weightT ) nc <- neuprint_fetch_custom(cypher=cypher, conn = conn) - + connTable <- dplyr::bind_rows(lapply(nc$data, function(d){ + l <- d[[1]] + dplyr::bind_rows(lapply(1:l, function(i){ + data.frame(from=as.character(d[[2]][[i]][[1]]), + to=as.character(d[[2]][[i+1]][[1]]), + weight=d[[3]][[i]], + name.from=d[[2]][[i]][[2]],name.to=d[[2]][[i+1]][[2]],stringsAsFactors = FALSE) + })) + })) } @@ -299,7 +307,15 @@ neuprint_get_shortest_paths <- function(body_pre,body_post,weightT=5,dataset = N weightT ) nc <- neuprint_fetch_custom(cypher=cypher, conn = conn) - + connTable <- dplyr::bind_rows(lapply(nc$data, function(d){ + l <- d[[1]] + dplyr::bind_rows(lapply(1:l, function(i){ + data.frame(from=as.character(d[[2]][[i]][[1]]), + to=as.character(d[[2]][[i+1]][[1]]), + weight=d[[3]][[i]], + name.from=d[[2]][[i]][[2]],name.to=d[[2]][[i+1]][[2]],stringsAsFactors = FALSE) + })) + })) } From f4529ad4c7527c490635367cdcda2f013208f2d0 Mon Sep 17 00:00:00 2001 From: Romain Franconville Date: Thu, 16 Jan 2020 14:08:14 -0500 Subject: [PATCH 4/4] Addind a `roi` argument to parse paths only in a ROI of set of ROIs --- R/connectivity.R | 45 +++++++++++++++++++++++++++++---------------- 1 file changed, 29 insertions(+), 16 deletions(-) diff --git a/R/connectivity.R b/R/connectivity.R index 20aabbbc..a8f80da3 100644 --- a/R/connectivity.R +++ b/R/connectivity.R @@ -223,25 +223,32 @@ neuprint_simple_connectivity <- function(bodyids, #' @param conn optional, a neuprintr connection object, which also specifies the #' neuPrint server see \code{\link{neuprint_login}}. If NULL, your defaults #' set in your R.profile or R.environ are used. +#' @param roi Limit the search to connections happening within a certain ROI or set of ROIs (NULL by default) #' @param ... methods passed to \code{neuprint_login} #' @return #' @seealso \code{\link{neuprint_common_connectivity}}, #' \code{\link{neuprint_get_adjacency_matrix}} #' @export #' @rdname neuprint_get_paths -neuprint_get_paths <- function(body_pre,body_post,n,weightT=5,dataset = NULL, conn = NULL,all_segments=FALSE, ...){ +neuprint_get_paths <- function(body_pre,body_post,n,weightT=5,roi=NULL,dataset = NULL, conn = NULL,all_segments=FALSE, ...){ if (length(n)==1){ n <- c(n,n) } dataset <- check_dataset(dataset) conn <- neuprint_login(conn) + + if(!is.null(roi)){ + roicheck = neuprint_check_roi(rois=roi, dataset = dataset, conn = conn, ...) + roi <- paste("AND (" ,paste0("exists(apoc.convert.fromJsonMap(x.roiInfo).`",roi,"`)",collapse=" OR "),")") + } + all_segments.json <- ifelse(all_segments,"Segment","Neuron") dp <- neuprint_dataset_prefix(dataset, conn=conn) prefixed <- paste0(dp, all_segments.json) cypher <- sprintf(paste("call apoc.cypher.runTimeboxed('MATCH p = (src : `%s`{ bodyId: %s })-[ConnectsTo*%s..%s]->(dest:`%s`{ bodyId: %s })", - "WHERE ALL (x in relationships(p) WHERE x.weight >= %s)", + "WHERE ALL (x in relationships(p) WHERE x.weight >= %s %s)", "RETURN length(p) AS `length(path)`,[n in nodes(p) | [n.bodyId, n.type]] AS path,[x in relationships(p) | x.weight] AS weights', {},5000)", "YIELD value return value.`length(path)` as `length(path)`, value.path as path, value.weights AS weights" ), @@ -251,7 +258,8 @@ neuprint_get_paths <- function(body_pre,body_post,n,weightT=5,dataset = NULL, co n[2], prefixed, as.numeric(body_post), - weightT + weightT, + ifelse(is.null(roi),"",roi) ) nc <- neuprint_fetch_custom(cypher=cypher, conn = conn) @@ -266,17 +274,17 @@ neuprint_get_paths <- function(body_pre,body_post,n,weightT=5,dataset = NULL, co })) } -#' @title Get a list of paths of length n between 2 neurons +#' @title Get a list of the shortest paths between 2 neurons #' -#' @description Get all of the paths in the database that connect the +#' @description Get all of the shortest paths in the database that connect the #' query neurons with at least weightT synapses at each step #' @param body_pre the bodyid of the neuron at the start of the path #' @param body_post the bodyid of the neuron at the end of the path -#' @param n the length of the path. If n is a vector, paths of length n[1] to n[2] are considered #' @param weightT weight threshold #' @param dataset optional, a dataset you want to query. If NULL, the default #' specified by your R environ file is used. See \code{neuprint_login} for #' details. +#' @param roi Limit the search to connections happening within a certain ROI or set of ROIs (NULL by default) #' @param all_segments if TRUE, all bodies are considered, if FALSE, only 'Neurons', i.e. bodies with a status roughly traced status. #' @param conn optional, a neuprintr connection object, which also specifies the #' neuPrint server see \code{\link{neuprint_login}}. If NULL, your defaults @@ -287,7 +295,7 @@ neuprint_get_paths <- function(body_pre,body_post,n,weightT=5,dataset = NULL, co #' \code{\link{neuprint_get_adjacency_matrix}} #' @export #' @rdname neuprint_get_shortest_paths -neuprint_get_shortest_paths <- function(body_pre,body_post,weightT=5,dataset = NULL, conn = NULL,all_segments=FALSE, ...){ +neuprint_get_shortest_paths <- function(body_pre,body_post,weightT=5,roi=NULL,dataset = NULL, conn = NULL,all_segments=FALSE, ...){ dataset <- check_dataset(dataset) conn <- neuprint_login(conn) @@ -295,17 +303,22 @@ neuprint_get_shortest_paths <- function(body_pre,body_post,weightT=5,dataset = N dp <- neuprint_dataset_prefix(dataset, conn=conn) prefixed <- paste0(dp, all_segments.json) + if(!is.null(roi)){ + roicheck = neuprint_check_roi(rois=roi, dataset = dataset, conn = conn, ...) + roi <- paste("AND (" ,paste0("exists(apoc.convert.fromJsonMap(x.roiInfo).`",roi,"`)",collapse=" OR "),")") + } + cypher <- sprintf(paste("call apoc.cypher.runTimeboxed('MATCH p = allShortestPaths((src : `%s`{ bodyId: %s })-[ConnectsTo*]->(dest:`%s`{ bodyId: %s }))", - "WHERE ALL (x in relationships(p) WHERE x.weight >= %s)", + "WHERE ALL (x in relationships(p) WHERE x.weight >= %s %s)", "RETURN length(p) AS `length(path)`,[n in nodes(p) | [n.bodyId, n.type]] AS path,[x in relationships(p) | x.weight] AS weights', {},5000)", - "YIELD value return value.`length(path)` as `length(path)`, value.path as path, value.weights AS weights" - ), - prefixed, - as.numeric(body_pre), - prefixed, - as.numeric(body_post), - weightT - ) + "YIELD value return value.`length(path)` as `length(path)`, value.path as path, value.weights AS weights"), + prefixed, + as.numeric(body_pre), + prefixed, + as.numeric(body_post), + weightT, + ifelse(is.null(roi),"",roi) + ) nc <- neuprint_fetch_custom(cypher=cypher, conn = conn) connTable <- dplyr::bind_rows(lapply(nc$data, function(d){