Skip to content

Commit

Permalink
Add methods to ggplot split neurons
Browse files Browse the repository at this point in the history
  • Loading branch information
@alexanderbates
alexanderbates committed Aug 6, 2024
1 parent 9aede98 commit 1b47dc4
Show file tree
Hide file tree
Showing 10 changed files with 396 additions and 25 deletions.
5 changes: 5 additions & 0 deletions NAMESPACE
View file
Original file line number Diff line number Diff line change
@@ -1,5 +1,8 @@
# Generated by roxygen2: do not edit by hand

S3method(banc_add_synapses,default)
S3method(banc_add_synapses,neuron)
S3method(banc_add_synapses,neuronlist)
S3method(banc_decapitate,"NULL")
S3method(banc_decapitate,data.frame)
S3method(banc_decapitate,hxsurf)
Expand All @@ -21,6 +24,7 @@ S3method(geom_neuron,neuronlist)
S3method(ggplot2_neuron_path,mesh3d)
S3method(ggplot2_neuron_path,neuron)
S3method(ggplot2_neuron_path,neuronlist)
export(banc_add_synapses)
export(banc_all_synapses)
export(banc_backbone_proofread)
export(banc_brain_side_view)
Expand All @@ -43,6 +47,7 @@ export(banc_neuron_comparison_plot)
export(banc_nm2raw)
export(banc_nuclei)
export(banc_partner_summary)
export(banc_partners)
export(banc_peripheral_nerves)
export(banc_raw2nm)
export(banc_read_l2dp)
Expand Down
2 changes: 1 addition & 1 deletion R/banc-table.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -120,7 +120,7 @@ banctable_set_token <- function(user, pwd, url = "https://cloud.seatable.io/"){
password = pwd, server_url = url)
ac$auth()
Sys.setenv(banctable_TOKEN = ac$token)
cat("banctable_TOKEN='", ac$token, "'\n", sep = "", append = TRUE,
cat("BANCTABLE_TOKEN='", ac$token, "'\n", sep = "", append = TRUE,
file = path.expand("~/.Renviron"))
return(invisible(NULL))
}
Expand Down
161 changes: 161 additions & 0 deletions R/ggplot2.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -528,6 +528,167 @@ geom_neuron.dotprops <- function(x = NULL, rotation_matrix = NULL, root = 3, col
...)
}

#' @rdname geom_neuron
#' @method geom_neuron synapticneuron
#' @export
geom_neuron.synapticneuron <- function(x = NULL,
rotation_matrix = NULL,
root = 3,
cols = c("navy", "turquoise"),
stat = "identity", position = "identity",
na.rm = FALSE,
show.legend = NA,
inherit.aes = FALSE,
...) {
if("splitneuron"%in%class(x)){
geomneuron<-geom_neuron.splitneuron(x = x,
rotation_matrix = rotation_matrix,
root = root,
cols = cols,
stat = stat,
position = position,
na.rm = na.rm,
show.legend = show.legend,
inherit.aes = inherit.aes,
...)
}else{
geomneuron<-geom_neuron.neuron(x = x,
rotation_matrix = rotation_matrix,
root = root,
cols = cols,
stat = stat,
position = position,
na.rm = na.rm,
show.legend = show.legend,
inherit.aes = inherit.aes,
...)
}
if(!is.null(x$connectors)){
syns.in <- nat::xyzmatrix(subset(x$connectors, x$connectors$prepost==1))
syns.out <- nat::xyzmatrix(subset(x$connectors, x$connectors$prepost==0))
if(!is.null(rotation_matrix)){
syns.in <- as.data.frame(t(rotation_matrix[,1:3] %*% t(syns.in)))
syns.in <- syns.in[,-4]
colnames(syns.in) <- c("X","Y","Z")
syns.out <- as.data.frame(t(rotation_matrix[,1:3] %*% t(syns.out)))
syns.out <- syns.out[,-4]
colnames(syns.out) <- c("X","Y","Z")
}
glist <- list(
ggplot2::geom_point(data = syns.in,
mapping = ggplot2::aes(x = .data$X,
y = .data$Y),
color = "#132157",
size = root/50,
alpha = 0.5),
ggplot2::geom_point(data = syns.out,
mapping = ggplot2::aes(x = .data$X,
y = .data$Y),
color = "#D72000",
size = root/50,
alpha = 0.5)
)
c(geomneuron,glist)
}else{
geomneuron
}
}

#' @rdname geom_neuron
#' @method geom_neuron dotprops
#' @export
geom_neuron.splitneuron <- function(x = NULL,
rotation_matrix = NULL,
root = 3,
cols = c("navy", "turquoise"),
stat = "identity", position = "identity",
na.rm = FALSE,
show.legend = NA,
inherit.aes = FALSE,
...) {

# Get parts
if(root){
x$tags$soma <- nat::rootpoints(x)
}
soma <- catmaid::soma(x)
if(!is.null(rotation_matrix)){
soma <- as.data.frame(t(rotation_matrix[,1:3] %*% t(nat::xyzmatrix(soma))))
soma <- soma[,-4]
colnames(soma) <- c("X","Y","Z")
}
dendrites.v = subset(rownames(x$d), x$d$Label == 3)
axon.v = subset(rownames(x$d), x$d$Label == 2)
p.d.v = subset(rownames(x$d), x$d$Label == 4)
p.n.v = subset(rownames(x$d), x$d$Label == 7)
null.v = subset(rownames(x$d), x$d$Label == 0 | is.na(x$d$Label))

# Get cable
dendrites = tryCatch(nat::prune_vertices(x,
verticestoprune = as.integer(c(axon.v,p.d.v, p.n.v, null.v))),
error = function(e) NULL)
axon = tryCatch(nat::prune_vertices(x,
verticestoprune = as.integer(c(dendrites.v, p.d.v, p.n.v, null.v))),
error = function(e) NULL)
p.d = tryCatch(nat::prune_vertices(x, verticestoprune = as.integer(c(axon.v, dendrites.v, p.n.v, null.v))),
error = function(e) NULL)
p.n = tryCatch(nat::prune_vertices(x, verticestoprune = as.integer(c(axon.v, dendrites.v, p.d.v, null.v))),
error = function(e) NULL)
nulls = tryCatch(nat::prune_vertices(x, verticestoprune = as.integer(c(axon.v, dendrites.v, p.d.v, p.n.v))),
error = function(e) NULL)

# Make ggplot2 objects
g.dendrites <- ggplot2_neuron_path.neuron(dendrites, rotation_matrix = rotation_matrix)
g.axon <- ggplot2_neuron_path.neuron(axon, rotation_matrix = rotation_matrix)
g.p.d <- ggplot2_neuron_path.neuron(p.d, rotation_matrix = rotation_matrix)
g.p.n <- ggplot2_neuron_path.neuron(p.n, rotation_matrix = rotation_matrix)
g.nulls <- ggplot2_neuron_path.neuron(nulls, rotation_matrix = rotation_matrix)

# Make geom objects
list(
ggplot2::geom_path(mapping = ggplot2::aes(x = .data$X, y = .data$Y, group = .data$group),
data = g.dendrites, col = "#54BCD1",
stat = stat, position = position, na.rm = na.rm,
show.legend = show.legend, inherit.aes = inherit.aes, alpha = 1),
ggplot2::geom_path(mapping = ggplot2::aes(x = .data$X, y = .data$Y, group = .data$group),
data = g.axon, col = "#EF7C12",
stat = stat, position = position, na.rm = na.rm,
show.legend = show.legend, inherit.aes = inherit.aes, alpha = 1),
ggplot2::geom_path(mapping = ggplot2::aes(x = .data$X, y = .data$Y, group = .data$group),
data = g.p.d, col = "#8FDA04",
stat = stat, position = position, na.rm = na.rm,
show.legend = show.legend, inherit.aes = inherit.aes, alpha = 1),
ggplot2::geom_path(mapping = ggplot2::aes(x = .data$X, y = .data$Y, group = .data$group),
data = g.p.n, col = "#C70E7B",
stat = stat, position = position, na.rm = na.rm,
show.legend = show.legend, inherit.aes = inherit.aes, alpha = 1),
ggplot2::geom_path(mapping = ggplot2::aes(x = .data$X, y = .data$Y, group = .data$group),
data = g.nulls, col = "#B3B3B3",
stat = stat, position = position, na.rm = na.rm,
show.legend = show.legend, inherit.aes = inherit.aes, alpha = 1),
ggplot2::geom_point(mapping = ggplot2::aes(x = .data$X, y = .data$Y),
data = soma, col = "black",
color = cols[1], alpha = 0.75, size = root)
)
}


















#' Create a ggplot2 Visualisation of Neuron Objects
#'
#' @description
Expand Down
12 changes: 8 additions & 4 deletions R/l2.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -95,6 +95,8 @@ banc_read_l2skel <- function(id, OmitFailures=TRUE, dataset=NULL, ...) {
#' obtained using `bancr::banc_nuclei()`. This data frame is assumed to have
#' columns named `root_id` and `nucleus_position_nm`, where `nucleus_position_nm`
#' specifies the 3D coordinates of the soma for each `root_id`.
#' @param estimate if \code{TRUE} and nucleus position is not in `banc_nuclei`,
#' then root is estimated as a leaf node furthest outside of the brain neuropil.
#' @param ... Methods passed to \code{nat::nlapply}.
#'
#' @return The function returns the re-rooted `neuron` object.
Expand All @@ -107,12 +109,12 @@ banc_read_l2skel <- function(id, OmitFailures=TRUE, dataset=NULL, ...) {
#' }
#' @export
#' @rdname banc_reroot
banc_reroot <- function(x, id = NULL, banc_nuclei = bancr::banc_nuclei(), ...) UseMethod("banc_reroot")
banc_reroot <- function(x, id = NULL, banc_nuclei = bancr::banc_nuclei(), estimate = TRUE, ...) UseMethod("banc_reroot")

#' @rdname banc_reroot
#' @method banc_reroot neuron
#' @export
banc_reroot.neuron <- function(x, id = NULL, banc_nuclei = bancr::banc_nuclei(), ...){
banc_reroot.neuron <- function(x, id = NULL, banc_nuclei = bancr::banc_nuclei(), estimate = TRUE, ...){
if(is.null(id)){
id <- x$root_id
}
Expand All @@ -124,7 +126,7 @@ banc_reroot.neuron <- function(x, id = NULL, banc_nuclei = bancr::banc_nuclei(),
soma <- nat::xyzmatrix(df$nucleus_position_nm)[1,]
x <- nat::reroot(x = x, point = c(soma))
x$tags$soma <- nat::rootpoints(x )
}else{ # As best we can
}else if (estimate){ # 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,]
Expand All @@ -142,14 +144,16 @@ banc_reroot.neuron <- function(x, id = NULL, banc_nuclei = bancr::banc_nuclei(),
nat::xyzmatrix(bancr::banc_neck_connective.surf)), k = 1)
soma <-nat::xyzmatrix(npoints)[which.max(nearest$nn.dists),]
x <- nat::reroot(x = x, point = c(soma))
}else{
warning(sprintf("no valid nucleus ID detecting for %s, no action taken"),id)
}
x
}

#' @rdname banc_reroot
#' @method banc_reroot neuronlist
#' @export
banc_reroot.neuronlist <- function(x, id = NULL, banc_nuclei = bancr::banc_nuclei(), ...){
banc_reroot.neuronlist <- function(x, id = NULL, banc_nuclei = bancr::banc_nuclei(), estimate = TRUE, ...){
if(is.null(id)){
id <- names(x)
}
Expand Down
3 changes: 3 additions & 0 deletions R/partners.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -28,6 +28,7 @@
#' slice_max(weight, n = 20) %>%
#' banc_scene(open=TRUE)
#' }
#' @rdname banc_partners
banc_partner_summary <- function(rootids,
partners = c("outputs", "inputs"),
threshold = 0,
Expand Down Expand Up @@ -87,6 +88,8 @@ banc_datastack_name <- memoise::memoise(function() {
#' fpo=banc_partners(banc_latestid("720575941478275714"), partners='out')
#' points3d(banc_raw2nm(fpo$pre_pt_position), col='red')
#' }
#' @export
#' @rdname banc_partners
banc_partners <- function(rootids, partners=c("input", "output"), ...) {
partners=match.arg(partners)
rootids=banc_ids(rootids)
Expand Down
Loading

0 comments on commit 1b47dc4

Please sign in to comment.