Helper function banc_reroot to root BANC neurons at soma

DESCRIPTION

@@ -59,7 +59,8 @@ Suggests:
     ggnewscale (>= 0.4.10.9000),
     ggpubr,
     catmaid,
-    grDevices
+    grDevices,
+    nabor
 Remotes: 
     natverse/nat,
     natverse/fafbseg,

NAMESPACE

@@ -7,6 +7,8 @@ S3method(banc_decapitate,matrix)
 S3method(banc_decapitate,mesh3d)
 S3method(banc_decapitate,neuron)
 S3method(banc_decapitate,neuronlist)
+S3method(banc_reroot,neuron)
+S3method(banc_reroot,neuronlist)
 S3method(geom_neuron,"NULL")
 S3method(geom_neuron,data.frame)
 S3method(geom_neuron,hxsurf)
@@ -46,6 +48,7 @@ export(banc_read_l2skel)
 export(banc_read_neuroglancer_mesh)
 export(banc_read_neuron_meshes)
 export(banc_read_nuclei_mesh)
+export(banc_reroot)
 export(banc_rootid)
 export(banc_scene)
 export(banc_segid_from_cellid)

R/ggplot2.R

@@ -413,7 +413,12 @@ geom_neuron.list <- function(x = NULL, rotation_matrix = NULL, root = 3, low = "
 geom_neuron.matrix <- function(x = NULL, rotation_matrix = NULL, root = 3, low = "navy", high = "turquoise",
                              stat = "identity", position = "identity", na.rm = FALSE, show.legend = NA,
                              inherit.aes = FALSE, ...) {
-  x<- as.data.frame(nat::xyzmatrix(x))
+  x<-as.data.frame(nat::xyzmatrix(x))
+  if(!is.null(rotation_matrix)){
+    x <- as.data.frame(t(rotation_matrix[,1:3] %*% t(nat::xyzmatrix(x))))
+    x <- x[,-4]
+    colnames(x) <- c("X","Y","Z")
+  }
   list(
     ggplot2::geom_point(data = x, mapping = ggplot2::aes(x = .data$X, y = .data$Y, color = .data$Z),
                         size = root,  ...),
@@ -436,6 +441,21 @@ geom_neuron.data.frame <- function(x = NULL, rotation_matrix = NULL, root = 3, l
                      ...)
 }
 
+#' @rdname geom_neuron
+#' @method geom_neuron dotprops
+#' @export
+geom_neuron.dotprops <- function(x = NULL, rotation_matrix = NULL, root = 3, low = "navy", high = "turquoise",
+                                   stat = "identity", position = "identity", na.rm = FALSE, show.legend = NA,
+                                   inherit.aes = FALSE, ...) {
+  x<-as.data.frame(nat::xyzmatrix(x))
+  geom_neuron.data.frame(x, rotation_matrix = rotation_matrix, root = root,
+                     low = low, high = high,
+                     stat = stat, position = position,
+                     na.rm = FALSE, show.legend = NA,
+                     inherit.aes = FALSE,
+                     ...)
+}
+
 #' Create a ggplot2 Visualisation of Neuron Objects
 #'
 #' @description
@@ -448,8 +468,8 @@ geom_neuron.data.frame <- function(x = NULL, rotation_matrix = NULL, root = 3, l
 #' Defaults to NULL, no volume plotted.
 #' @param info Optional. A string to be used as the plot title.
 #' @param rotation_matrix An optional 4x4 rotation matrix to apply to the neuron coordinates.
-#' @param low Color for the lowest Z values. Default is "turquoise".
-#' @param high Color for the highest Z values. Default is "navy".
+#' @param low1,low2 Color for the lowest Z values. Default is "turquoise".
+#' @param high1,high2 Color for the highest Z values. Default is "navy".
 #' @param alpha Transparency of the neuron visualization. Default is 0.5.
 #' @param title.col Color of the plot title. Default is "darkgrey".
 #' @param ... Additional arguments passed to geom_neuron().
@@ -483,16 +503,18 @@ ggneuron <- function(x,
                      volume = NULL,
                      info = NULL,
                      rotation_matrix = NULL,
-                     low = "turquoise",
-                     high = "navy",
+                     low1 = "turquoise",
+                     high1 = "navy",
+                     low2 = "grey75",
+                     high2 = "grey50",
                      alpha = 0.5,
                      title.col = "darkgrey",
                      ...){
   ggplot2::ggplot() +
     {if(!is.null(volume)){
-      geom_neuron(x = volume, rotation_matrix = rotation_matrix, alpha = max(alpha-0.25,0.01), low = "grey75", high = "grey50")
+      geom_neuron(x = volume, rotation_matrix = rotation_matrix, alpha = max(alpha-0.25,0.01), low = low2, high = high2)
     }} +
-    geom_neuron(x = x, rotation_matrix = rotation_matrix, low =  low, high = high, alpha = alpha, ...) +
+    geom_neuron(x = x, rotation_matrix = rotation_matrix, low =  low1, high = high1, alpha = alpha, ...) +
     ggplot2::coord_fixed() +
     ggplot2::theme_void() +
     ggplot2::guides(fill="none",color="none") +

R/l2.R

@@ -79,3 +79,80 @@ banc_read_l2skel <- function(id, OmitFailures=TRUE, dataset=NULL, ...) {
   sk=fp$flywire$l2_skeleton(id, omit_failures = OmitFailures, dataset=dataset, ...)
   fafbseg:::navis2nat_neuronlist(sk)
 }
+
+#' @title Re-root BANC neuron skeleton at soma
+#'
+#' @description
+#' This function re-roots a neuron skeleton represented as a `neuron`
+#' object at the location of the corresponding soma in the `banc_nuclei` data
+#' frame. It uses the `root_id` in the skeleton object to identify the soma
+#' location.
+#'
+#' @param x A `banc.neurite` object representing the neuron skeleton.
+#' @param id (Optional) The `root_id` of the neuron in the `banc_nuclei` data
+#' frame. If NULL, it will be taken from the `x$root_id` slot.
+#' @param banc_nuclei A data frame containing information about nuclei
+#' obtained using `bancr::banc_nuclei()`. This data frame is assumed to have
+#' columns named `root_id` and `soma_position_nm`, where `soma_position_nm`
+#' specifies the 3D coordinates of the soma for each `root_id`.
+#' @param ... Methods passed to \code{nat::nlapply}.
+#'
+#' @return The function returns the re-rooted `neuron` object.
+#'
+#' @examples
+#' \dontrun{
+#' x <- banc_read_l2skel(..., simplify = FALSE)
+#' banc_nuclei <- banc_nuclei()
+#' re-rooted_neuron <- banc_reroot(x, banc_nuclei = banc_nuclei)
+#' }
+#' @export
+#' @rdname banc_reroot
+banc_reroot <- function(x, id = NULL, banc_nuclei = bancr::banc_nuclei(), ...) UseMethod("banc_reroot")
+
+#' @rdname banc_reroot
+#' @method banc_reroot neuron
+#' @export
+banc_reroot.neuron <- function(x, id = NULL, banc_nuclei = bancr::banc_nuclei(), ...){
+  if(is.null(id)){
+    id <- x$root_id
+  }
+  if(is.null(id)){
+    stop("a root_id in banc_nuclei must be given")
+  }
+  df <- subset(banc_nuclei,banc_nuclei$root_id==id)
+  if( nrow(df) && !is.na(df$soma_position_nm[1]) & df$nucleus_id!="0"){
+    soma <- nat::xyzmatrix(df$soma_position_nm)[1,]
+    x <- nat::reroot(x = x, point = c(soma))
+    x$tags$soma <- nat::rootpoints(x )
+  }else{ # As best we can
+    warning(sprintf("no valid nucleus ID detecting for %s, estimating root point"),id)
+    leaves <- nat::endpoints(x)
+    npoints1 <- nat::xyzmatrix(x)[leaves,]
+    if(nrow(npoints1)){npoints=npoints1}
+    pin <- nat::pointsinside(x = npoints, surf = bancr::banc_neuropil.surf)
+    npoints2 <- data.frame(npoints[!pin,])
+    if(nrow(npoints2)){npoints=npoints2}
+    pin <- nat::pointsinside(x = npoints, surf = bancr::banc_neck_connective.surf)
+    npoints3 <- data.frame(npoints[!pin,])
+    if(nrow(npoints3)){npoints=npoints3}
+    npoints$nucleus_id <- 0
+    npoints$root_id <- id
+    nearest <- nabor::knn(query = nat::xyzmatrix(npoints), data = rbind(xyzmatrix(banc_neuropil.surf),xyzmatrix(banc_neck_connective.surf)), k = 1)
+    soma <-nat::xyzmatrix(npoints)[which.max(nearest$nn.dists),]
+    x <- nat::reroot(x = x, point = c(soma))
+  }
+  x
+}
+
+#' @rdname banc_reroot
+#' @method banc_reroot neuronlist
+#' @export
+banc_reroot.neuronlist <- function(x, id = NULL, banc_nuclei = bancr::banc_nuclei(), ...){
+  if(is.null(id)){
+    id <- names(x)
+  }
+  nat::nlapply(x, banc_reroot.neuron, FUN = banc_reroot.neuron, banc_nuclei = banc_nuclei, id = id, ...)
+}
+
+
+

R/meshes.R

@@ -49,7 +49,8 @@ banc_read_nuclei_mesh <- function(ids, lod = 0L, savedir=NULL,  method=c('vf', '
 #' @param x an object with 3d points to be subsetted, e.g. an xyz matrix, a \code{neuron}, \code{neuronlist} or a \code{mesh3d} object.
 #' Points must be in native BANC space, i.e. plottable inside \code{banc.surf}.
 #' @param y.cut Numeric, the Y-axis cut point, in nanometers, in BANC space,
-#'  that separates the head from the neck and ventral nerve cord.
+#'  that separates the head from the neck and ventral nerve cord. For fitting to the
+#'  MANC data set, a cut height of `y.cut=5e05` seems good.
 #' @param invert if \code{FALSE} returns brain points, if \code{TRUE} returns VNC points.
 #' @param ... Additional arguments passed to \code{\link{nlapply}} and then \code{\link{prune_vertices}}
 #'

R/vtk.R

@@ -1,5 +1,5 @@
 # And the same for the mesh
-write_mesh3d_to_vtk <- function(mesh, filename) {
+write_mesh3d_to_vtk <- function(mesh, filename, simplify = TRUE, percent = 0.1) {
   if (!requireNamespace("rgl", quietly = TRUE)) {
     stop("Package 'rgl' is required but not installed.")
   }
@@ -8,6 +8,12 @@ write_mesh3d_to_vtk <- function(mesh, filename) {
     stop("Input must be a mesh3d object")
   }
 
+  # Clean and simplify meesh
+  if(simplify){
+    mesh <- Rvcg::vcgQEdecim(mesh, percent = percent)
+    mesh <- Rvcg::vcgClean(mesh, sel=c(0,1,2,3,4,6,7))
+  }
+
   vertices <- t(mesh$vb[1:3,])
   faces <- t(mesh$it)