Gardening

.Rbuildignore

@@ -7,5 +7,5 @@
 ^pkgdown$
 ^spare$
 ^vignettes/articles$
-
+^extdata$
 ^data-raw$

DESCRIPTION

@@ -21,13 +21,12 @@ URL: https://github.com/flyconnectome/bancr
 BugReports: https://github.com/flyconnectome/bancr/issues
 Depends: 
     R (>= 3.5.0),
-    fafbseg (>= 0.13.0.9100),
+    fafbseg (>= 0.14.1.9100),
     nat.flybrains
 Imports: 
     fancr,
     nat,
     nat.templatebrains,
-    catmaid,
     malevnc,
     rlang,
     rgl,
@@ -42,10 +41,8 @@ Imports:
     RSQLite,
     readr,
     checkmate,
-    utils,
-    ggplot2,
-    ggnewscale,
-    ggpubr
+    stringr,
+    utils
 Suggests: 
     testthat (>= 3.0.0),
     reticulate,
@@ -55,13 +52,17 @@ Suggests:
     usethis,
     rmarkdown,
     spelling,
-    arrow
+    arrow,
+    ggplot2,
+    ggnewscale,
+    ggpubr,
+    catmaid
 Remotes: 
     natverse/nat,
     natverse/fafbseg,
     natverse/nat.flybrains,
     natverse/nat.templatebrains,
-    natverse/rcatmat,
+    catmaid=natverse/rcatmaid,
     natverse/malevnc,
     flyconnectome/fancr,
     kassambara/ggpubr

NAMESPACE

@@ -35,6 +35,7 @@ export(banc_neck_connective_neurons)
 export(banc_neuron_comparison_plot)
 export(banc_nm2raw)
 export(banc_nuclei)
+export(banc_partner_summary)
 export(banc_peripheral_nerves)
 export(banc_raw2nm)
 export(banc_read_l2dp)
@@ -62,19 +63,9 @@ export(with_banc)
 import(bit64)
 import(fafbseg)
 import(nat.flybrains)
-importFrom(ggnewscale,new_scale_colour)
-importFrom(ggnewscale,new_scale_fill)
-importFrom(ggplot2,coord_fixed)
-importFrom(ggplot2,element_blank)
-importFrom(ggplot2,geom_point)
-importFrom(ggplot2,ggplot)
-importFrom(ggplot2,margin)
-importFrom(ggplot2,scale_color_gradient)
-importFrom(ggplot2,theme)
-importFrom(ggplot2,theme_void)
-importFrom(ggpubr,ggarrange)
 importFrom(magrittr,"%>%")
 importFrom(nat,xyzmatrix)
 importFrom(pbapply,pbsapply)
 importFrom(rlang,.data)
 importFrom(utils,browseURL)
+importFrom(utils,write.table)

R/cave-tables.R

@@ -21,7 +21,9 @@
 #' @examples
 #' \donttest{
 #' all_banc_soma_positions <- banc_nuclei()
-#' points3d(nat::xyzmatrix(all_banc_soma_positions))
+#' }
+#' \dontrun{
+#' points3d(nat::xyzmatrix(all_banc_soma_positions$pt_position))
 #' }
 #' @importFrom magrittr "%>%"
 banc_cave_tables <- function(datastack_name = getOption("fafbseg.cave.datastack_name"),
@@ -58,18 +60,18 @@ banc_nuclei <- function (rootids = NULL,
   if (!is.null(rootids) & !is.null(nucleus_ids))
     stop("You must supply only one of rootids or nucleus_ids!")
   res <- if (is.null(rootids) && is.null(nucleus_ids))
-    flywire_cave_query(table =  table , ...)
+    banc_cave_query(table =  table , ...)
   else if (!is.null(rootids)) {
-    rootids <- flywire_ids(rootids)
+    rootids <- banc_ids(rootids)
     nuclei <- if (length(rootids) < 200) {
       rid <- paste(rootids, collapse = ",")
       ridq <- reticulate::py_eval(sprintf("{\"pt_root_id\": [%s]}",
                                          rid), convert = F)
-      flywire_cave_query(table =  table,
+      banc_cave_query(table =  table,
                          filter_in_dict = ridq, ...)
     }
     else {
-      flywire_cave_query(table =  table,
+      banc_cave_query(table =  table,
                          live = F, ...)
     }
     if (nrow(nuclei) == 0)
@@ -82,14 +84,14 @@ banc_nuclei <- function (rootids = NULL,
       nuclei
     }
     else {
-      nuclei %>% dplyr::mutate(pt_root_id = flywire_updateids(.data$pt_root_id,
-                                                       svids = .data$pt_supervoxel_id))
+      nuclei %>% dplyr::mutate(pt_root_id = with_banc(flywire_updateids(.data$pt_root_id,
+                                                       svids = .data$pt_supervoxel_id)))
     }
   }else{
     nid <- paste(nucleus_ids, collapse = ",")
     nidq <- reticulate::py_eval(sprintf("{\"id\": [%s]}",
                                        nid), convert = F)
-    nuclei <- flywire_cave_query(table = table,
+    nuclei <- banc_cave_query(table = table,
                                 filter_in_dict = nidq, ...)
     nuclei %>% dplyr::right_join(data.frame(id = nucleus_ids), by = "id") %>%
       dplyr::select(colnames(nuclei))
@@ -101,7 +103,7 @@ banc_nuclei <- function (rootids = NULL,
     res
   else {
     res %>% dplyr::mutate(dplyr::across(dplyr::ends_with("position"), function(x)
-      nat::xyzmatrix2str(fancr::banc_raw2nm(x))))
+      nat::xyzmatrix2str(banc_raw2nm(x))))
   }
 }
 

R/cave.R

@@ -1,6 +1,6 @@
 #' Query banc tables in the CAVE annotation system
 #'
-#' @param ... Additional arguments passed to
+#' @param ... Additional arguments passed to \code{\link{flywire_cave_query}}
 #'   \code{\link[fafbseg]{flywire_cave_query}}
 #' @inheritParams banc_partner_summary
 #' @inheritParams fafbseg::flywire_cave_query
@@ -10,6 +10,14 @@
 #' @family banc-cave
 #' @export
 #' @seealso \code{\link[fafbseg]{flywire_cave_query}}
+#' @examples
+#' \donttest{
+#' library(dplyr)
+#' cell_info=banc_cave_query('cell_info')
+#' cell_info %>%
+#'   filter(tag2=='anterior-posterior projection pattern') %>%
+#'   count(tag)
+#' }
 banc_cave_query <- function(table, datastack_name = NULL, live=TRUE, ...) {
   if(is.null(datastack_name)) datastack_name=banc_datastack_name()
   fafbseg::flywire_cave_query(table = table, datastack_name = datastack_name, live=live, ...)

R/data.R

@@ -16,21 +16,27 @@
 #' }
 "banc.surf"
 
+#' @docType data
 #' @rdname banc.surf
 "banc_neuropil.surf"
 
+#' @docType data
 #' @rdname banc.surf
 "banc_brain_neuropil.surf"
 
+#' @docType data
 #' @rdname banc.surf
 "banc_vnc_neuropil.surf"
 
+#' @docType data
 #' @rdname banc.surf
 "banc_neck_connective.surf"
 
+#' @docType data
 #' @rdname banc.surf
 "banc_neuropils.surf"
 
+#' @docType data
 #' @rdname banc.surf
 "banc_al.surf"
 
@@ -92,6 +98,7 @@
 #' @docType data
 "banc_to_jrc2018f_tpsreg"
 
+#' @docType data
 #' @rdname banc_to_jrc2018f_tpsreg
 "jrc2018f_to_banc_tpsreg"
 

R/ggplot2.R

@@ -29,9 +29,6 @@
 #' Each view applies appropriate rotations and uses different neuropil meshes as backgrounds.
 #' The two neurons are plotted in different colors (navy/turquoise for neuron1, red/darkred for neuron2) for easy comparison.
 #'
-#' @importFrom ggplot2 ggplot geom_point scale_color_gradient coord_fixed theme_void theme element_blank margin
-#' @importFrom ggnewscale new_scale_colour new_scale_fill
-#' @importFrom ggpubr ggarrange
 #' @importFrom nat xyzmatrix
 #'
 #' @examples
@@ -55,6 +52,8 @@ banc_neuron_comparison_plot <- function(neuron1,
                                         height = 16) {
 
   # Get 3D spatial points
+  check_package_available('ggplot2')
+  check_package_available('ggpubr')
   glist <- list()
   title.col <- "black"
   if(is.null(banc_brain_neuropil)) banc_brain_neuropil <- utils::data("banc_brain_neuropil.surf", envir = environment())
@@ -304,6 +303,9 @@ geom_neuron <-function(x, rotation_matrix = NULL, low = "turquoise", high = "nav
 geom_neuron.neuron <- function(x = NULL, rotation_matrix = NULL, low = "turquoise", high = "navy",
                                stat = "identity", position = "identity", na.rm = FALSE, show.legend = NA,
                                inherit.aes = FALSE, ...) {
+
+  check_package_available('ggnewscale')
+  check_package_available('catmaid')
   soma <- catmaid::soma(x)
   if(!is.null(rotation_matrix)){
     soma <- as.data.frame(t(rotation_matrix[,1:3] %*% t(nat::xyzmatrix(soma))))
@@ -343,6 +345,7 @@ geom_neuron.neuronlist <- function(x = NULL, rotation_matrix = NULL, low = "turq
 geom_neuron.mesh3d <- function(x = NULL, rotation_matrix = NULL, low = "turquoise", high = "navy",
                                    stat = "identity", position = "identity", na.rm = FALSE, show.legend = NA,
                                    inherit.aes = FALSE, ...) {
+  check_package_available('ggnewscale')
   x <- ggplot2_neuron_path.mesh3d(x, rotation_matrix = rotation_matrix)
   list(
     ggplot2::geom_polygon(data = x, mapping = ggplot2::aes(x = .data$X, y = .data$Y, fill = .data$Z, group = .data$group),

R/ids.R

@@ -61,8 +61,10 @@ banc_leaves <- function(x, integer64=TRUE, ...) {
 #' @export
 #' @importFrom nat xyzmatrix
 #' @examples
+#' \dontrun{
 #' # a point from neuroglancer, should map to 648518346498932033
 #' banc_xyz2id(cbind(34495, 82783, 1954), rawcoords=TRUE)
+#' }
 banc_xyz2id <- function(xyz,
                         rawcoords=FALSE,
                         voxdims=c(4, 4, 45),

R/meshes.R

@@ -51,7 +51,7 @@ banc_read_nuclei_mesh <- function(ids, lod = 1L, savedir=NULL,  method=c('vf', '
 #' @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.
 #' @param invert if \code{FALSE} returns brain points, if \code{TRUE} returns VNC points.
-#' @param ... methods passed to `nat::nlapply`.
+#' @param ... Additional arguments passed to \code{\link{nlapply}} and then \code{\link{prune_vertices}}
 #'
 #' @return Remove points above or below the midsection of the neck connective of BANC.
 #' @seealso \code{\link{banc.surf}}
@@ -134,7 +134,7 @@ banc_decapitate.hxsurf <- function(x, y.cut = 325000, invert = FALSE, ...){
 #'
 #' @param x the numeric identifier that specifies the mesh to read, defaults to \code{1} the BANC outline mesh.
 #' @param url the URL that directs \code{bancr} to where BANC meshes are stored.
-#' @param ... arguments passed to `httr::GET`.
+#' @param ... additional arguments to \code{\link{GET}}
 #' @return a mesh3d object for the specified mesh.
 #' @export
 #' @seealso \code{\link{banc_read_neuron_meshes}}

R/partners.R

@@ -11,6 +11,23 @@
 #'
 #' @return a data.frame
 #' @seealso \code{\link{flywire_partner_summary}}, \code{\link{banc_latestid}}
+#' @export
+#'
+#' @examples
+#' \dontrun{
+#' # NB id must be up to date
+#' sample_id=banc_latestid("720575941480769421")
+#' head(banc_partner_summary(sample_id))
+#' head(banc_partner_summary(sample_id, partners='inputs'))
+#' # get the latest id for an outdate
+#' banc_partner_summary(banc_latestid("720575941480769421"))
+#'
+#' ## open banc/flywire scene containing top partners
+#' library(dplyr)
+#' banc_partner_summary(banc_latestid("720575941480769421"), partners='inputs') %>%
+#'   slice_max(weight, n = 20) %>%
+#'   banc_scene(open=TRUE)
+#' }
 banc_partner_summary <- function(rootids,
                                  partners = c("outputs", "inputs"),
                                  threshold = 0,

R/synapses.R

@@ -22,6 +22,7 @@
 #' \dontrun{
 #' syns <- banc_all_synapses()
 #' }
+#' # Helpful scene: https://spelunker.cave-explorer.org/#!middleauth+https://global.daf-apis.com/nglstate/api/v1/4753860997414912
 banc_all_synapses <- function(path = "gs://zetta_lee_fly_cns_001_synapse/240623_run/assignment/final_edgelist.df",
                               overwrite = FALSE,
                               n_max = 2000,

R/urls.R

@@ -71,12 +71,12 @@ banc_scene <- function(ids=NULL, open=FALSE) {
 #' options()[grep("^fafbseg.*url", names(options()))]
 #' }
 choose_banc <- function(set=TRUE) {
-  fafbseg::choose_segmentation(banc_scene(), set=set,
-                               moreoptions=list(fafbseg.cave.datastack_name=banc_datastack_name()))
-  fafbseg.cloudvolume.url <- getOption("fafbseg.cloudvolume.url")
-  fafbseg.cloudvolume.url <- gsub("middleauth\\+","",fafbseg.cloudvolume.url)
-  options(fafbseg.cloudvolume.url=fafbseg.cloudvolume.url)
-  invisible()
+  fafbseg::choose_segmentation(
+    banc_scene(),
+    set=set,
+    moreoptions=list(
+      fafbseg.cave.datastack_name=banc_datastack_name()
+      ))
 }
 
 #' @param expr An expression to evaluate while banc is the default

R/utils.R

@@ -1,38 +1,12 @@
-# And the same for the mesh
-write_mesh3d_to_vtk <- function(mesh, filename) {
-  if (!requireNamespace("rgl", quietly = TRUE)) {
-    stop("Package 'rgl' is required but not installed.")
+check_package_available <- function(pkg, repo=c("CRAN", "Bioconductor")) {
+  if(!requireNamespace(pkg, quietly = TRUE)) {
+    repo=match.arg(repo)
+    installmsg=switch(repo,
+                      CRAN=paste0("install.packages('",pkg,"')"),
+                      Bioconductor=paste0('if (!require("BiocManager", quietly = TRUE))',
+                                          '\n  install.packages("BiocManager")',
+                                          '\nBiocManager::install("',pkg,'")'))
+    stop("Please install suggested package: ", pkg, " by doing\n",
+         installmsg, call. = F)
   }
-
-  if (!inherits(mesh, "mesh3d")) {
-    stop("Input must be a mesh3d object")
-  }
-
-  vertices <- t(mesh$vb[1:3,])
-  faces <- t(mesh$it)
-
-  cat("Vertex count:", nrow(vertices), "\n")
-  cat("Face count:", nrow(faces), "\n")
-
-  con <- file(filename, "w")
-  on.exit(close(con))
-
-  writeLines("# vtk DataFile Version 2.0", con)
-  writeLines("Mesh exported from R", con)
-  writeLines("ASCII", con)
-  writeLines("DATASET POLYDATA", con)
-
-  writeLines(sprintf("POINTS %d float", nrow(vertices)), con)
-  utils::write.table(format(vertices, scientific = FALSE), con, row.names = FALSE, col.names = FALSE, quote = FALSE)
-
-  writeLines(sprintf("POLYGONS %d %d", nrow(faces), nrow(faces) * 4), con)
-  face_data <- cbind(3, faces - 1)
-  utils::write.table(face_data, con, row.names = FALSE, col.names = FALSE, quote = FALSE)
-
-  cat("Mesh successfully written to", filename, "\n")
-
-  # Check file content
-  cat("First few lines of the VTK file:\n")
-  system(sprintf("head -n 10 %s", filename))
 }
-