diff --git a/R/connectivity.R b/R/connectivity.R index 38a941e4..a8f80da3 100644 --- a/R/connectivity.R +++ b/R/connectivity.R @@ -135,20 +135,20 @@ neuprint_common_connectivity <- function(bodyids, statuses = NULL, all_segments)) class(Payload) = "json" com.conn = neuprint_fetch(path = 'api/npexplorer/commonconnectivity', body = Payload, conn = conn, ...) - m = matrix(0,nrow = length(bodyids),ncol = length(com.conn$data[[1]][[1]])) - rownames(m) = paste0(bodyids,"_weight") - connected = c() - for(i in 1:length(com.conn$data[[1]][[1]])){ - s = com.conn$data[[1]][[1]][[i]] - find = match(names(s),rownames(m)) - add = find[!is.na(find)] - m[add,i] = unlist(s)[!is.na(find)] - connected = c(connected,ifelse(is.null(s$input),s$output,s$input)) + partnerType <- ifelse(prepost=="PRE","output","input") + partnerNames <- sapply(com.conn$data[[1]][[1]],function(d) d[[partnerType]]) + partnerCount <- table(partnerNames) + commonPartners <- names(partnerCount[partnerCount == length(bodyids)]) + m <- matrix(0,nrow = length(bodyids),ncol = length(commonPartners)) + rownames(m) <- paste0(bodyids,"_weight") + colnames(m) <- commonPartners + comData <- com.conn$data[[1]][[1]][which(partnerNames %in% commonPartners)] + + for(s in comData){ + rName <- names(s)[names(s) %in% rownames(m)] + m[rName,as.character(s[[partnerType]])] <- s[[rName]] } - m = t(apply(m,1,as.numeric)) - colnames(m) = connected - rownames(m) = bodyids - m = m[,apply(m,2,function(x) sum(x==0)==0)] + rownames(m) <- bodyids m } @@ -208,6 +208,131 @@ 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 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,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 %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, + ifelse(is.null(roi),"",roi) + ) + 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) + })) + })) +} + +#' @title Get a list of the shortest paths between 2 neurons +#' +#' @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 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 +#' 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,roi=NULL,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) + + 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 %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, + ifelse(is.null(roi),"",roi) + ) + 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) + })) + })) + +} + # hidden, caution, does not deal with left/right neuropils extract_connectivity_df <- function(rois, json){ if(is.null(json)){ @@ -218,7 +343,7 @@ extract_connectivity_df <- function(rois, json){ for(roi in rois){ d <- data.frame(0,0) colnames(d) <- paste0(roi,c(".pre",".post")) - b <- a[startsWith(names(a),roi)] + b <- a[startsWith(names(a),paste0(roi,"."))] d[names(b)] <- b values <- cbind(values,d) } diff --git a/R/neurons.R b/R/neurons.R index bd4798b7..2084640d 100644 --- a/R/neurons.R +++ b/R/neurons.R @@ -61,21 +61,7 @@ neuprint_read_neuron <- function(bodyid, nat = TRUE, drvid = FALSE, flow.central n = drvid::read.neuron.dvid(bodyid) d = n$d }else{ - cypher = sprintf("MATCH (:`%s` {bodyId:%s})-[:Contains]->(:Skeleton)-[:Contains]->(root :SkelNode) WHERE NOT (root)<-[:LinksTo]-() RETURN root.rowNumber AS rowId, root.location.x AS x, root.location.y AS y, root.location.z AS z, root.radius AS radius, -1 AS link ORDER BY root.rowNumber UNION match (:`%s` {bodyId:%s})-[:Contains]->(:Skeleton)-[:Contains]->(s :SkelNode)<-[:LinksTo]-(ss :SkelNode) RETURN s.rowNumber AS rowId, s.location.x AS x, s.location.y AS y, s.location.z AS z, s.radius AS radius, ss.rowNumber AS link ORDER BY s.rowNumber", - paste0(dp, all_segments_json), - as.numeric(bodyid), - paste0(dp, all_segments_json), - as.numeric(bodyid)) - nc = neuprint_fetch_custom(cypher=cypher, conn = conn, ...) - if(!length(nc$data)){ - warning("bodyid ", bodyid, " could not be read from ", unlist(getenvoroption("server"))) - return(NULL) - } - d = data.frame(do.call(rbind,nc$data)) - d = as.data.frame(t(apply(d,1,function(r) unlist(r)))) - colnames(d) = c("PointNo","X","Y","Z","W","Parent") - d$Label = 0 - n = nat::as.neuron(d) + n = neuprint_read_neuron_simple(as.numeric(bodyid),dataset=dataset,conn = conn,heal = F,...) } if(heal|flow.centrality){ n = heal_skeleton(x = n)