Add nginfo functions

NAMESPACE

@@ -47,6 +47,7 @@ export(download_neuron_obj)
 export(dr_fafbseg)
 export(fafb14_to_flywire_ids)
 export(fafb2flywire)
+export(fct2nginfo)
 export(fetch_all_curl)
 export(find_merged_segments)
 export(find_topn)
@@ -132,6 +133,7 @@ export(skeletor)
 export(swc2segmentid)
 export(tabify_coords)
 export(with_segmentation)
+export(write_nginfo)
 export(zip2segmentstem)
 import(data.table)
 importFrom(Matrix,sparseMatrix)

R/nginfo.R

@@ -0,0 +1,97 @@
+nginfo <- function(ids, values=NULL, sep='_') {
+  if(is.data.frame(ids)) {
+    if(ncol(ids)>2)
+      values=do.call(paste, c(ids[-1], sep=sep))
+    else
+      values=ids[[2]]
+    ids=ids[[1]]
+  }
+  l=list(`@type` = "neuroglancer_segment_properties",
+       inline = list(
+         ids = as.character(ids),
+         properties =
+           list(
+             list(
+             id = "label",
+             type = "label",
+             values = values
+           )
+         )
+       )
+     )
+  l
+}
+
+
+#' Read and write neuroglancer annotation info json files
+#'
+#' @details Note that there is nothing specific to flywire about these two
+#'   functions - they could be used for any data source.
+#'
+#' @param f Path to a json file. \code{write_nginfo} will create the enclosing
+#'   directory if necessary.
+#' @param anndf A data.frame in which the first column contains ids for each
+#'   neuron and additional columns contain annotations that will be joined into
+#'   a single string.
+#' @param sep The separator used to paste multiple columns of annotations
+#'   together.
+#'
+#' @return For \code{read_nginfo} a list containing annotations.For
+#'   \code{write_nginfo}, the path \code{f} invisibly.
+#' @export
+#' @seealso \code{\link{fct2nginfo}}
+#' @examples
+#' \donttest{
+#' tf=tempfile(pattern = "info")
+#' df=data.frame(id=c(10000,10002), type=c("DNp01"))
+#' write_nginfo(df, tf)
+#' }
+write_nginfo <- function(anndf, f, sep='_') {
+  l <- if(is.list(anndf) && !is.data.frame(anndf)) anndf else nginfo(anndf, sep=sep)
+  d <- dirname(f)
+  if(!file.exists(d))
+    dir.create(d, recursive = T)
+  jsonlite::write_json(l, path = f, auto_unbox=T)
+  invisible(f)
+}
+
+read_nginfo <- function(f) {
+  jsonlite::read_json(f, simplifyVector = T, simplifyDataFrame=F)
+}
+
+#' Convert flytable cell type information into a neuroglancer info file
+#'
+#' @param ids FlyWire root ids in any form understood by
+#'   \code{\link{flywire_ids}}
+#' @param gluestr Optional string passed to \code{glue::glue} which is
+#'   interpreted in the context of the annotation data.frame produced by
+#'   \code{\link{flytable_meta}}. This allows arbitrary formatting for
+#' @param ... Additional arguments passed to \code{\link{flytable_meta}} and
+#'   then eventually \code{\link{flytable_cell_types}}.
+#' @inheritParams write_nginfo
+#' @inheritParams add_celltype_info
+#' @seealso \code{\link{write_nginfo}}
+#'
+#' @return The path \code{f} invisibly
+#' @export
+#'
+#' @examples
+#' \dontrun{
+#' # all neurons in info table
+#' fct2nginfo(f='path/to/flytablev526/info', version=526)
+#' fct2nginfo(f='path/to/hemilineagev526/info', version=526,
+#'   gluestr="{ito_lee_hemilineage}_{toupper(substr(side,1,1))}")
+#' fct2nginfo("MBON%", 'path/to/mboninfo/info')
+#' }
+fct2nginfo <- function(f, ids=NULL, version=NULL, sep='_', gluestr=NULL, ...) {
+  fct <- flytable_meta(ids, version=version, ...)
+  anndf <- if(!is.null(gluestr)) {
+    check_package_available('glue')
+    cbind(fct[1],
+          value=glue::glue(gluestr, .envir = fct))
+  } else {
+    fct$side=toupper(substr(fct$side,1,1))
+    fct[c("root_id", "cell_type", "side", "super_class")]
+  }
+  write_nginfo(anndf, f = f, sep=sep)
+}

_pkgdown.yml

@@ -80,10 +80,12 @@ reference:
   - '`flytable_update_rows`'
   - '`flytable_list_selected`'
   - '`tabify_coords`'
+  - '`flywire_timestamp`'
   - '`flywire_ids`'
   - '`flytable_cell_types`'
   - '`add_celltype_info`'
-  - '`flywire_timestamp`'
+  - '`fct2nginfo`'
+  - '`write_nginfo`'
 - title: FAFB FFN1 segmentation skeletons
   desc: Read FAFB FFN1 segmentation skeletons (Peter Li, Google) from packaged zip
     files or over the web via brainmaps API.

tests/testthat/test-flytable.R

@@ -20,6 +20,10 @@ test_that("query works", {
   expect_true(length(flywire_ids('super:sensory', integer64 = T))>1000)
   expect_error(flywire_ids('pudding:sensory'))
 
+  tf=tempfile('info.json')
+  expect_silent(fct2nginfo(f=tf, ids = 'MBON%', gluestr = "{cell_type}_{toupper(substr(side,1,1))}"))
+  expect_true(is.list(l <- read_nginfo(tf)))
+  expect_equal(l$inline$ids, flywire_ids('MBON%'))
 
   expect_s3_class(df <- flytable_query("select fruit_name, person, _ctime, date_wminute FROM testfruit WHERE nid<=3", limit=3L),
                   'data.frame')

tests/testthat/test-nginfo.R

@@ -0,0 +1,17 @@
+test_that("nginfo works", {
+  df=data.frame(id=c(10000,10002), type=c("DNp01"), side=c("L", "R"))
+  tf=tempfile(pattern = 'mancinfo.json')
+  on.exit(unlink(tf))
+  expect_silent(write_nginfo(df, f = tf))
+  bl = list(`@type` = "neuroglancer_segment_properties",
+            inline = list(
+              ids = c("10000", "10002"),
+              properties = list(list(
+                id = "label",
+                type = "label",
+                values = c("DNp01_L", "DNp01_R")
+              ))
+            ))
+  expect_equal(read_nginfo(tf), bl)
+  expect_equal(read_nginfo(tf), nginfo(df))
+})