Add prune_by_tag and catmaid_get_tag

DESCRIPTION

@@ -28,7 +28,8 @@ Imports:
     nabor,
     xml2,
     grDevices,
-    checkmate
+    checkmate,
+    igraph
 Suggests:
     spelling,
     testthat

NAMESPACE

@@ -34,6 +34,7 @@ export(catmaid_get_labels)
 export(catmaid_get_neuronnames)
 export(catmaid_get_node_count)
 export(catmaid_get_review_status)
+export(catmaid_get_tag)
 export(catmaid_get_treenode_table)
 export(catmaid_get_treenodes_detail)
 export(catmaid_get_user_list)
@@ -56,6 +57,7 @@ export(catmaid_version)
 export(connectors)
 export(copy_tags_connectors)
 export(nsoma)
+export(prune_by_tag)
 export(read.neuron.catmaid)
 export(read.neurons.catmaid)
 export(read_catmaid_selection)

R/catmaid_tags.R

@@ -0,0 +1,92 @@
+#' Prune neuron by splitting it at CATMAID tags
+#'
+#' @details Split a neuron based on tags assigned in CATMAID. Remove points either downstream (from the root, must be soma to work properly) of the tagged points(s) or upstream.
+#'
+#' @param x a \code{neuron} or \code{neuronlist} object
+#' @param tag a tag that has been assigned in CATMAID
+#' @param remove.upstream Logical when \code{TRUE} points downstream of the tag(s) are removed, if true, points upstream are removed
+#' @param ... Additional arguments, passed to \code{\link{nlapply}} or eventually to \code{\link{prune_vertices}}
+#' @rdname prune_by_tag
+#' @export
+prune_by_tag <-function(x, tag, remove.upstream = TRUE, ...) UseMethod("prune_by_tag")
+prune_by_tag.neuron <- function(x, tag, remove.upstream = TRUE, ...){
+  classes = class(x)
+  p = unlist(x$tags[names(x$tags)%in%tag])
+  if(is.null(p)){
+    stop(paste0("Neuron does not have a tag in: ",tag))
+  }
+  split.point = as.numeric(rownames(x$d[x$d$PointNo==p,]))
+  n = nat::as.ngraph(x)
+  leaves = nat::endpoints(x)
+  downstream = suppressWarnings(unique(unlist(igraph::shortest_paths(n, split.point, to = leaves, mode = "out")$vpath)))
+  x = nat::prune_vertices(x,verticestoprune = downstream, invert = remove.upstream, ...)
+  class(x) = classes
+  x
+}
+prune_by_tag.catmaidneuron<- function(x, tag, remove.upstream = TRUE, ...){
+  p = unlist(x$tags[names(x$tags)%in%tag])
+  if(is.null(p)){
+    stop(paste0("Neuron does not have a tag in: ",tag))
+  }
+  split.point = as.numeric(rownames(x$d[x$d$PointNo==p,]))
+  n = nat::as.ngraph(x)
+  leaves = nat::endpoints(x)
+  downstream = suppressWarnings(unique(unlist(igraph::shortest_paths(n, split.point, to = leaves, mode = "out")$vpath)))
+  pruned = nat::prune_vertices(x,verticestoprune = downstream, invert = remove.upstream, ...)
+  pruned$connectors = x$connectors[x$connectors$treenode_id%in%pruned$d$PointNo,]
+  relevant.points = subset(x$d, PointNo%in%pruned$d$PointNo)
+  y = pruned
+  y$d = relevant.points[match(pruned$d$PointNo,relevant.points$PointNo),]
+  y$d$Parent = pruned$d$Parent
+  class(y) = c("neuron","catmaidneuron")
+  y
+}
+prune_by_tag.neuronlist <- function(x, tag, remove.upstream = TRUE, ...){
+  nlapply(x, tag = tag, prune_by_tag, remove.upstream = remove.upstream, ...)
+}
+
+#' Find the location of specified tags for a CATMAID neuron
+#'
+#' @description  Find the location of tags in a CATMAID neuron, either as URLs to the location of a TODO tag in CATMAID or as a data.frame reporting the location and skeleton treenode locations of specified tags.
+#' @param x a neuron or neuronlist object
+#' @param tag a single character specifying which tag to look for. Defaults to TODO
+#' @param only.leaves whether or not to only return leaf nodes with the specified tag
+#' @param url if TRUE (default) a list of URLs pertaining to specified tag locations are returned. If FALSE, a data.frame subsetted from x$d is returned, reporting treenode ID and X,Y,Z positions for specified tags
+#' @param pid project id. Defaults to 1. For making the URL.
+#' @param conn CATMAID connection object, see ?catmaid::catmaid_login for details. For making the URL.
+#' @export
+#' @rdname catmaid_get_tag
+catmaid_get_tag<-function(x, tag = "TODO", url = FALSE, only.leaves = TRUE, conn = NULL, pid = 1) UseMethod("catmaid_get_tag")
+
+catmaid_get_tag.neuron <- function(x, tag = "TODO", url = FALSE, only.leaves = TRUE, conn = NULL, pid = 1){
+  TODO = unique(unlist(x$tags[[tag]]))
+  if(only.leaves){
+    TODO = TODO[TODO%in%x$d$PointNo[nat::endpoints(x)]]
+  }
+  if(is.null(TODO)){
+    NULL
+  }else if(length(TODO)){
+    df = subset(x$d,PointNo%in%TODO)
+    if(url){
+      catmaid_url = paste0(catmaid_get_server(conn), "?pid=",pid)
+      catmaid_url = paste0(catmaid_url, "&zp=", df[["Z"]])
+      catmaid_url = paste0(catmaid_url, "&yp=", df[["Y"]])
+      catmaid_url = paste0(catmaid_url, "&xp=", df[["X"]])
+      catmaid_url = paste0(catmaid_url, "&tool=tracingtool")
+      catmaid_url = paste0(catmaid_url, "&sid0=5&s0=0")
+      invisible(catmaid_url)
+    }
+    else{
+      df
+    }
+  }
+}
+
+catmaid_get_tag.neuronlist <- function(x, tag = "TODO", url = FALSE, only.leaves = TRUE, conn = NULL, pid = 1){
+  if(url){
+    unlist(lapply(x,catmaid_get_tag.neuron, url=url, tag= tag))
+  }else{
+    do.call(rbind,lapply(x,catmaid_get_tag.neuron, url=url, tag = tag))
+  }
+}
+