From 171ef99d1a14ed46df08b4c2458a4395ccd47b8f Mon Sep 17 00:00:00 2001 From: Dominik Krzeminski Date: Tue, 18 May 2021 09:46:36 +0100 Subject: [PATCH 1/2] topo.dotprops added --- NAMESPACE | 1 + R/dotprops.R | 51 +++++++++++++++++++++++++++++++++++++++++++++---- man/dotprops.Rd | 9 +++++++-- 3 files changed, 55 insertions(+), 6 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 5aebe4d3..bb77a79e 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -379,6 +379,7 @@ importFrom(igraph,decompose.graph) importFrom(igraph,degree) importFrom(igraph,delete.vertices) importFrom(igraph,diameter) +importFrom(igraph,distances) importFrom(igraph,get.diameter) importFrom(igraph,get.shortest.paths) importFrom(igraph,get.vertex.attribute) diff --git a/R/dotprops.R b/R/dotprops.R index 01a5726b..68852810 100644 --- a/R/dotprops.R +++ b/R/dotprops.R @@ -9,7 +9,8 @@ is.dotprops<-function(x) inherits(x,"dotprops") as.dotprops<-function(x, ...){ if(is.null(x)) return (NULL) if(!is.dotprops(x)) class(x)=c("dotprops",class(x)) - if(is.null(colnames(x$points))) colnames(x$points) <-c("X","Y","Z") + if("topo" %in% names(x)) class(x)=c("topo.dotprops",class(x)) + if(is.null(colnames(x$points))) colnames(x$points) <-c("X","Y","Z") x } @@ -153,12 +154,48 @@ dotprops.neuronlist<-function(x, ..., OmitFailures=NA) { #' @export #' @param resample When finite, a new length to which all segmented edges will #' be resampled. See \code{\link{resample.neuron}}. +#' @param topo flag that says whether or not to add topological features +#' (inverted Strahler's Order and distance from soma) #' @rdname dotprops -dotprops.neuron<-function(x, Labels=NULL, resample=NA, ...) { +dotprops.neuron<-function(x, Labels=NULL, resample=NA, topo=FALSE, ...) { if(is.finite(resample)) x=resample(x, stepsize = resample) if(is.null(Labels) || isTRUE(Labels)) Labels=x$d$Label else if(is.logical(labels) && labels==FALSE) Labels=NULL - dotprops(xyzmatrix(x), Labels=Labels, ...) + topo_features <- NULL + if (isTRUE(topo)) topo_features <- add_topo_features(x) + dotprops(xyzmatrix(x), Labels=Labels, topo_features=topo_features, ...) +} + +#' Add topological features +#' +#' @param nrn neuron object with soma +#' +#' @return +#' @examples +#' add_topo_features(Cell07PNs[[1]]) +add_topo_features <- function(nrn) { + topovec <- list() + topovec$distance <- get_distance_to_soma(nrn) + so <- strahler_order(nrn) + # normalizing so the main branch is always 0 + topovec$rso <- abs(so$points-max(so$points)) + topovec +} + +#' Get distance from soma +#' +#' Assigns to each node a distance from cell body. +#' +#' @param nrn neuron object with soma +#' +#' @return vector with distances from soma +#' @importFrom igraph distances +#' @examples +#' add_topo_features(Cell07PNs[[1]]) +get_distance_to_soma <- function(nrn) { + gw <- as.ngraph(nrn, weights=TRUE) + dst <- distances(gw, v = rootpoints(nrn)) + as.numeric(dst) } #' @export @@ -170,6 +207,7 @@ dotprops.neuron<-function(x, Labels=NULL, resample=NA, ...) { #' behaviour for different classes of input object, \code{TRUE} always uses #' labels when an incoming object has them and \code{FALSE} never uses labels. #' @param na.rm Whether to remove \code{NA} points (default FALSE) +#' @param topo_features topological features of each dotprop #' @importFrom nabor knn #' @references The dotprops format is essentially identical to that developed #' in: @@ -178,7 +216,8 @@ dotprops.neuron<-function(x, Labels=NULL, resample=NA, ...) { #' mutual information approach to automate identification of neuronal clusters #' in \emph{Drosophila} brain images. Frontiers in Neuroinformatics 6 (00021). #' \href{http://dx.doi.org/10.3389/fninf.2012.00021}{doi: 10.3389/fninf.2012.00021} -dotprops.default<-function(x, k=NULL, Labels=NULL, na.rm=FALSE, ...){ +dotprops.default<-function(x, k=NULL, Labels=NULL, na.rm=FALSE, topo_features=NULL, + ...){ # store labels from SWC format data if this is a neuron x=xyzmatrix(x) if(is.null(k)) k=20 @@ -220,6 +259,10 @@ dotprops.default<-function(x, k=NULL, Labels=NULL, na.rm=FALSE, ...){ rlist$labels=Labels + if (!is.null(topo_features)) { + rlist$topo <- topo_features + } + attr(rlist,'k')=k return(as.dotprops(rlist)) } diff --git a/man/dotprops.Rd b/man/dotprops.Rd index ddc6ccdd..4a5e6376 100644 --- a/man/dotprops.Rd +++ b/man/dotprops.Rd @@ -26,9 +26,9 @@ dotprops(x, ...) \method{dotprops}{neuronlist}(x, ..., OmitFailures = NA) -\method{dotprops}{neuron}(x, Labels = NULL, resample = NA, ...) +\method{dotprops}{neuron}(x, Labels = NULL, resample = NA, topo = FALSE, ...) -\method{dotprops}{default}(x, k = NULL, Labels = NULL, na.rm = FALSE, ...) +\method{dotprops}{default}(x, k = NULL, Labels = NULL, na.rm = FALSE, topo_features = NULL, ...) } \arguments{ \item{x}{Object to be tested/converted} @@ -54,7 +54,12 @@ labels when an incoming object has them and \code{FALSE} never uses labels.} \item{resample}{When finite, a new length to which all segmented edges will be resampled. See \code{\link{resample.neuron}}.} +\item{topo}{flag that says whether or not to add topological features +(inverted Strahler's Order and distance from soma)} + \item{na.rm}{Whether to remove \code{NA} points (default FALSE)} + +\item{topo_features}{topological features of each dotprop} } \description{ \code{dotprops} makes dotprops representation from raw 3D points From 494f113ec1b67c30b673cd65c980d45c98887eb9 Mon Sep 17 00:00:00 2001 From: Dominik Krzeminski Date: Tue, 18 May 2021 14:50:30 +0100 Subject: [PATCH 2/2] [upt] minor changes in topo utils + docs rebuilt + tests --- NAMESPACE | 2 ++ R/dotprops.R | 33 +++++++++++++++++++-------------- man/dotprops-topo.Rd | 29 +++++++++++++++++++++++++++++ tests/testthat/test-dotprops.R | 26 ++++++++++++++++++++++++++ 4 files changed, 76 insertions(+), 14 deletions(-) create mode 100644 man/dotprops-topo.Rd diff --git a/NAMESPACE b/NAMESPACE index bb77a79e..0cc46a00 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -240,6 +240,8 @@ export(fileformats) export(find.neuron) export(find.soma) export(flip) +export(get_distance_to_soma) +export(get_topo_features) export(getformatreader) export(getformatwriter) export(graph.nodes) diff --git a/R/dotprops.R b/R/dotprops.R index 68852810..45df2a3e 100644 --- a/R/dotprops.R +++ b/R/dotprops.R @@ -9,7 +9,7 @@ is.dotprops<-function(x) inherits(x,"dotprops") as.dotprops<-function(x, ...){ if(is.null(x)) return (NULL) if(!is.dotprops(x)) class(x)=c("dotprops",class(x)) - if("topo" %in% names(x)) class(x)=c("topo.dotprops",class(x)) + if("topo" %in% names(x)) class(x) = union("topo.dotprops", class(x)) if(is.null(colnames(x$points))) colnames(x$points) <-c("X","Y","Z") x } @@ -162,21 +162,23 @@ dotprops.neuron<-function(x, Labels=NULL, resample=NA, topo=FALSE, ...) { if(is.null(Labels) || isTRUE(Labels)) Labels=x$d$Label else if(is.logical(labels) && labels==FALSE) Labels=NULL topo_features <- NULL - if (isTRUE(topo)) topo_features <- add_topo_features(x) + if (isTRUE(topo)) topo_features <- get_topo_features(x) dotprops(xyzmatrix(x), Labels=Labels, topo_features=topo_features, ...) } -#' Add topological features +#' Get topological features per each node #' -#' @param nrn neuron object with soma +#' @param n neuron object with soma #' -#' @return +#' @return list with distance and Reversed Strahler order features per node. +#' @rdname dotprops-topo +#' @export #' @examples -#' add_topo_features(Cell07PNs[[1]]) -add_topo_features <- function(nrn) { +#' get_topo_features(Cell07PNs[[1]]) +get_topo_features <- function(n) { topovec <- list() - topovec$distance <- get_distance_to_soma(nrn) - so <- strahler_order(nrn) + topovec$distance <- get_distance_to_soma(n) + so <- strahler_order(n) # normalizing so the main branch is always 0 topovec$rso <- abs(so$points-max(so$points)) topovec @@ -186,15 +188,18 @@ add_topo_features <- function(nrn) { #' #' Assigns to each node a distance from cell body. #' -#' @param nrn neuron object with soma +#' @param n neuron object with soma #' #' @return vector with distances from soma #' @importFrom igraph distances +#' @rdname dotprops-topo +#' @export +#' @seealso \code{\link{dotprops}}, \code{\link{ngraph}} #' @examples -#' add_topo_features(Cell07PNs[[1]]) -get_distance_to_soma <- function(nrn) { - gw <- as.ngraph(nrn, weights=TRUE) - dst <- distances(gw, v = rootpoints(nrn)) +#' get_distance_to_soma(Cell07PNs[[1]]) +get_distance_to_soma <- function(n) { + gw <- as.ngraph(n, weights=TRUE) + dst <- distances(gw, v = rootpoints(n)) as.numeric(dst) } diff --git a/man/dotprops-topo.Rd b/man/dotprops-topo.Rd new file mode 100644 index 00000000..4bb0f3b7 --- /dev/null +++ b/man/dotprops-topo.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/dotprops.R +\name{get_topo_features} +\alias{get_topo_features} +\alias{get_distance_to_soma} +\title{Get topological features per each node} +\usage{ +get_topo_features(n) + +get_distance_to_soma(n) +} +\arguments{ +\item{n}{neuron object with soma} +} +\value{ +list with distance and Reversed Strahler order features per node. + +vector with distances from soma +} +\description{ +Assigns to each node a distance from cell body. +} +\examples{ +get_topo_features(Cell07PNs[[1]]) +get_distance_to_soma(Cell07PNs[[1]]) +} +\seealso{ +\code{\link{dotprops}}, \code{\link{ngraph}} +} diff --git a/tests/testthat/test-dotprops.R b/tests/testthat/test-dotprops.R index 113a4f00..6c4d1c5c 100644 --- a/tests/testthat/test-dotprops.R +++ b/tests/testthat/test-dotprops.R @@ -55,6 +55,13 @@ test_that("make a dotprops object from a neuron",{ expect_is(x<-dotprops(Cell07PNs[[1]], resample=1), 'dotprops') }) +test_that("make a topo.dotprops object from a neuron",{ + expect_is(x<-dotprops(Cell07PNs[[1]], k=5, topo=T), 'topo.dotprops') + expect_equal(xyzmatrix(x), xyzmatrix(Cell07PNs[[1]])) + expect_true("topo" %in% names(x)) +}) + + test_that("subset.dotprops", { x=kcs20[[1]] expect_equal(subset(x, T), x) @@ -114,3 +121,22 @@ test_that("math operators",{ (kcs20[[1]]-colMeans(xyzmatrix(kcs20[[1]])))*0.5) }) + +context('dotprops utils') + +test_that("get_topo_features",{ + pn1 = Cell07PNs[[1]] + res = get_topo_features(pn1) + expect_type(res, "list") + expect_true("distance" %in% names(res)) + expect_true("rso" %in% names(res)) + expect_true(any(0 == res$rso)) +}) + +test_that("get_topo_features",{ + pn1 = Cell07PNs[[1]] + res = get_distance_to_soma(pn1) + expect_equal(res[rootpoints(pn1)], 0) + expect_true(all(res[-rootpoints(pn1)] > 0)) +}) +