Add connectivity and basic metadata support for banc

.github/workflows/R-CMD-check.yaml

@@ -22,6 +22,7 @@ jobs:
       NEUPRINT_TOKEN: ${{ secrets.NEUPRINT_TOKEN }}
       CLIO_TOKEN: ${{ secrets.CLIO_TOKEN }}
       FLYWIRE_PRINCIPLES: IAGREETOTHEFLYWIREPRINCIPLES
+      CHUNKEDGRAPH_SECRET: ${{ secrets.CHUNKEDGRAPH_SECRET }}
 
     steps:
       - uses: actions/checkout@v3

DESCRIPTION

@@ -19,7 +19,7 @@ Depends:
     R (>= 2.10),
     nat (>= 1.10.2.9000)
 Imports: 
-    fafbseg (>= 0.14.1),
+    fafbseg (>= 0.15.0),
     nat.templatebrains (>= 1.0),
     pbapply,
     neuprintr (>= 1.3.2),
@@ -29,10 +29,11 @@ Imports:
     coconat (>= 0.1.2),
     stringr,
     magrittr,
-    bit64
+    bit64,
+    usethis
 Suggests: 
     malevnc (> 0.3.1),
-    fancr,
+    fancr (>= 0.5.0),
     testthat (>= 3.0.0),
     ComplexHeatmap,
     InteractiveComplexHeatmap,
@@ -55,7 +56,7 @@ Remotes:
     catmaid=natverse/rcatmaid,
     natverse/nat.h5reg,
     natverse/coconat
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.2
 URL: https://github.com/flyconnectome/coconatfly,
     https://flyconnectome.github.io/coconatfly/
 BugReports: https://github.com/flyconnectome/coconatfly/issues

NAMESPACE

@@ -28,6 +28,7 @@ importFrom(dplyr,group_by)
 importFrom(dplyr,left_join)
 importFrom(dplyr,mutate)
 importFrom(dplyr,n_distinct)
+importFrom(dplyr,pull)
 importFrom(dplyr,rename)
 importFrom(dplyr,rename_with)
 importFrom(dplyr,select)

R/datasets.R

@@ -1,6 +1,6 @@
 cf_datasets <- function(rval=c("all", 'available')) {
   rval=match.arg(rval)
-  datasets=c("flywire", "malecns", 'manc', 'fanc', 'hemibrain', 'opticlobe')
+  datasets=c("flywire", "malecns", 'manc', 'fanc', 'hemibrain', 'opticlobe', 'banc')
   if(rval=='all')
     datasets
   else
@@ -25,13 +25,13 @@ match_datasets <- function(ds) {
 abbreviate_datasets <- function(ds) {
   ds=match_datasets(ds)
   abbrevlist=c(hemibrain='hb', flywire='fw', manc='mv', fanc='fv', malecns='mc',
-               opticlobe='ol')
+               opticlobe='ol', banc='bc')
   unname(abbrevlist[ds])
 }
 
 lengthen_datasets <- function(ds) {
   longlist=c(hb="hemibrain", fw="flywire", mv="manc", fv="fanc", mc="malecns",
-             ol='opticlobe')
+             ol='opticlobe', bc='banc')
   ds=match.arg(ds, names(longlist), several.ok = T)
   unname(longlist[ds])
 }

R/ids.R

@@ -8,6 +8,19 @@ id2int64 <- function(x) {
   bit64::as.integer64(x)
 }
 
+# extract numeric ids but pass on other character vectors such as queries
+# always returns bit64 so results are easy to spot
+extract_ids <- function(x) {
+  if(is.character(x) && length(x)==1 && !fafbseg:::valid_id(x, na.ok = T) && !grepl("http", x) && grepl("^\\s*(([a-z:]{1,3}){0,1}[0-9,\\s]+)+$",x, perl=T)) {
+    sx=gsub("[a-z:,\\s]+"," ", x, perl = T)
+    x=scan(text = trimws(sx), sep = ' ', what = '', quiet = T)
+    x <- id2int64(x)
+  }
+  if(is.numeric(x) || is.integer(x)) {
+    x <- id2int64(x)
+  }
+  x
+}
 
 #' Interconvert between keys and ids/datasets
 #'
@@ -101,6 +114,8 @@ is_key <- function(x, compound=FALSE) {
 #' @param opticlobe Pass opticlobe specific query or ids to this argument
 #' @param fanc Pass fanc ids to this argument (at present we do not support
 #'   metadata queries for fanc)
+#' @param banc Pass banc ids to this argument (we only support basic metadata
+#'   queries for banc)
 #'
 #' @details all neuprint datasets (hemibrain, malevnc, opticlobe, malecns) use
 #'   the same query syntax although some fields may be dataset specific (see
@@ -130,19 +145,20 @@ is_key <- function(x, compound=FALSE) {
 cf_ids <- function(
     query=NULL,
     datasets=c("brain", "vnc", "hemibrain", "flywire", "malecns", "manc", "fanc",
-               "opticlobe"),
+               "opticlobe", "banc"),
     expand=FALSE,
     keys=FALSE,
     hemibrain=NULL, flywire=NULL, malecns=NULL, manc=NULL, fanc=NULL,
-    opticlobe=NULL) {
+    opticlobe=NULL, banc=NULL) {
 
   nds=sum(
     !is.null(hemibrain),
     !is.null(flywire),
     !is.null(malecns),
     !is.null(manc),
     !is.null(fanc),
-    !is.null(opticlobe)
+    !is.null(opticlobe),
+    !is.null(banc)
     )
   res <- if(!is.null(query)) {
     if(nds>0)
@@ -152,15 +168,16 @@ cf_ids <- function(
     datasets=match.arg(datasets, several.ok = T)
 
     if('brain' %in% datasets)
-      datasets=union(datasets[datasets!='brain'], c("hemibrain", "flywire", "malecns"))
+      datasets=union(datasets[datasets!='brain'], c("hemibrain", "flywire", "malecns", "banc"))
     if('vnc' %in% datasets)
       datasets=union(datasets[datasets!='vnc'], c("manc", "fanc"))
     datasets=unique(datasets)
     structure(as.list(rep(query, length(datasets))), .Names=datasets)
   } else {
     if(nds==0)
-      stop("You must supply either the `query` argument or one of hemibrain:opticlobe!")
-    l=list(hemibrain=hemibrain, flywire=flywire, malecns=malecns, manc=manc, fanc=fanc, opticlobe=opticlobe)
+      stop("You must supply either the `query` argument or one of hemibrain:banc!")
+    l=list(hemibrain=hemibrain, flywire=flywire, malecns=malecns, manc=manc,
+           fanc=fanc, opticlobe=opticlobe, banc=banc)
     # drop any empty datasets
     l[lengths(l)>0]
   }
@@ -230,6 +247,7 @@ expand_ids <- function(ids, dataset) {
     manc=malevnc::manc_ids,
     fanc=I,
     malecns=malecns::mcns_ids,
+    banc=banc_ids,
     flywire=function(ids) fafbseg::flywire_ids(ids, version=fafbseg::flywire_connectome_data_version()),
     function(ids) neuprintr::neuprint_ids(ids, conn=npconn(dataset)))
   tf=try(FUN(ids), silent = T)

R/meta.R

@@ -161,3 +161,92 @@ fanc_meta <- function(ids, ...) {
   data.frame(id=fancr::fanc_ids(ids), type=NA, side=NA)
 }
 
+banc_meta <- function(ids=NULL, ...) {
+  ids=banc_ids(ids)
+  # cell_info %>% tidyr::pivot_wider(id_cols = pt_root_id, names_from = tag2, values_from = tag, values_fn = function(x) paste(x, collapse = ';')) %>% colnames()
+  fid=list(tag2=c('primary class',"anterior-posterior projection pattern", "neuron identity"))
+  # FIXME - think of a better workaround for the fact that ids may not be in
+  # correct materialisation state
+  # if(length(ids)>0) {
+  #   fid[['pt_root_id']]=ids
+  # }
+  fid=list(cell_info=fid)
+  selc=list(cell_info=c("id", "tag", "tag2", "pt_root_id", 'pt_supervoxel_id'))
+
+  cell_infos=fancr::with_banc(
+    fafbseg::flywire_cave_query('cell_info', filter_in_dict=fid, select_columns=selc,
+                       version='latest', timetravel = T, allow_missing_lookups=T))
+  metadf <- if(nrow(cell_infos)<1) {
+    df=data.frame(id=character(), class=character(), type=character(), side=character())
+  } else {
+  cell_infosw <- cell_infos %>%
+    mutate(tag=sub("\n\n\n*banc-bot*","", fixed = T, tag)) %>%
+    tidyr::pivot_wider(id_cols = pt_root_id,
+                       names_from = tag2,
+                       values_from = tag,
+                       values_fn = function(x) {
+                         sux=sort(unique(x))
+                         # try removing ?
+                         sux2=sort(unique(sub("?","", x, fixed = T)))
+                         if(length(sux2)<length(sux)) sux=sux2
+                         paste(sux, collapse = ';')
+                         })
+  cell_infosw %>%
+    rename(id=pt_root_id, class=`primary class`, apc=`anterior-posterior projection pattern`,type=`neuron identity`) %>%
+    mutate(class=case_when(
+      class=='sensory neuron' & grepl('scending', apc) ~ paste('sensory', apc),
+      (is.na(class) | class=='central neuron') & apc=='ascending' ~ 'ascending',
+      (is.na(class) | class=='central neuron') & apc=='descending' ~ 'descending',
+      is.na(apc) & is.na(class) ~ 'unknown',
+      is.na(apc) ~ class,
+      T ~ paste(class, apc)
+    )) %>%
+    mutate(class=sub(" neuron", '', class)) %>%
+    select(id, class, type) %>%
+    mutate(id=as.character(id), side=NA)
+  }
+  if(length(ids))
+    left_join(data.frame(id=ids), metadf, by='id')
+  else
+    metadf
+}
+
+#' @importFrom dplyr pull
+banc_ids <- function(ids) {
+  # extract numeric ids if possible
+  ids <- extract_ids(ids)
+  if(is.character(ids) && length(ids)==1 && !fafbseg:::valid_id(ids)) {
+    # query
+    metadf=banc_meta()
+    if(isTRUE(ids=='all')) return(fancr::fanc_ids(metadf$id, integer64 = F))
+    if(isTRUE(ids=='neurons')) {
+      ids <- metadf %>%
+        filter(is.na(.data$class) | .data$class!='glia') %>%
+        pull(.data$id)
+      return(fancr::fanc_ids(ids, integer64 = F))
+    }
+    if(substr(ids, 1, 1)=="/")
+      ids=substr(ids, 2, nchar(ids))
+    if(!grepl(":", ids)) ids=paste0("type:", ids)
+    qsplit=stringr::str_match(ids, pattern = '[/]{0,1}(.+):(.+)')
+    field=qsplit[,2]
+    value=qsplit[,3]
+    if(!field %in% colnames(metadf)) {
+      stop("banc queries only work with these fields: ",
+           paste(colnames(metadf)[-1], collapse = ','))
+    }
+    ids <- metadf %>%
+      filter(grepl(value, .data[[field]])) %>%
+      pull(.data$id)
+  } else if(length(ids)>0) {
+    # check they are valid for current materialisation
+    ids=fancr::with_banc(fafbseg::flywire_latestid(ids, version = banc_version()))
+  }
+  return(fancr::fanc_ids(ids, integer64 = F))
+}
+
+banc_version <- function() {
+  bcc=fancr::banc_cave_client()
+  ver=bcc$materialize$version
+  ver
+}

R/partners.R

@@ -85,6 +85,15 @@ cf_partners <- function(ids, threshold=1L, partners=c("inputs", "outputs"),
     } else if (n=='fanc') {
       tres=fancr::fanc_partner_summary(ids[[n]], partners = partners,
                                        threshold = threshold-1L)
+    } else if (n=='banc') {
+      bids=banc_ids(ids[[n]])
+      tres=fancr::with_banc(fancr::fanc_partner_summary(bids, partners = partners,
+                                       threshold = threshold-1L, version=banc_version()))
+      partner_col=grep("_id", colnames(tres), value = T)
+      # metadf=banc_meta(tres[[partner_col]])
+      metadf=banc_meta()
+      colnames(metadf)[[1]]=partner_col
+      tres=left_join(tres, metadf, by = partner_col)
     } else if(n=='manc') {
       tres=malevnc::manc_connection_table(ids[[n]],partners = partners, threshold=threshold, chunk = neuprint.chunksize)
       tres %>% dplyr::select(partner, type, name) %>% dplyr::rename(bodyid=partner)

R/utils.R

@@ -42,27 +42,54 @@ cf_connections <- function() {
                               version=as.character(ver))
 
   # fanc
+  dslist[['fanc']]=check_fanc()
+  dslist[['banc']]=check_banc()
+  dslist
+  as.data.frame(dplyr::bind_rows(dslist, .id = 'dataset'))
+}
+
+
+check_fanc <- function() {
   if(requireNamespace('fancr', quietly = T)) {
-    furl=try({
-      u=fancr::with_fanc(fafbseg:::check_cloudvolume_url(set = F))
-      sub('graphene://','', u)
-    })
-    if(inherits(furl, 'try-error')) furl=NA_character_
-    ver=tryCatch({
-      fcc=fancr::fanc_cave_client()
-      as.character(fcc$materialize$version)
-    }, error=function(e) NA_character_)
+    have_token=!inherits(try(fafbseg::chunkedgraph_token(), silent = TRUE), 'try-error')
+    if(have_token) {
+      furl=try({
+        u=fancr::with_fanc(fafbseg:::check_cloudvolume_url(set = F), force = F)
+        sub('graphene://','', u)
+      }, silent = T)
+      if(inherits(furl, 'try-error')) furl=NA_character_
+      ver <- if(is.na(furl)) NA_character_
+      else {
+        ver=try(silent = T, {
+          fcc=fancr::fanc_cave_client()
+          as.character(fcc$materialize$version)
+        })
+        if(inherits(ver, 'try-error')) ver=NA_character_
+      }
+    } else {
+      furl=NA_character_
+      ver=NA_character_
+    }
     fres=list(installed=T,
               server=furl,
               version=ver)
   } else {
     fres=list(installed=F, server=NA_character_, version=NA_character_)
   }
-  dslist[['fanc']]=fres
-  dslist
-  as.data.frame(dplyr::bind_rows(dslist, .id = 'dataset'))
+  fres
 }
 
+check_banc <- function() {
+  if(requireNamespace('fancr', quietly = T)) {
+    fres=try(fancr::with_banc(check_fanc()), silent = T)
+    if(inherits(fres, 'try-error'))
+      fres=list(installed=T, server=NA_character_, version=NA_character_)
+  } else {
+    usethis::ui_info('Access to the BANC Dataset requires installation of fancr!')
+    fres=list(installed=F, server=NA_character_, version=NA_character_)
+  }
+  fres
+}
 
 #' Status report for coconatfly installation
 #'
@@ -118,5 +145,19 @@ dr_coconatfly <- function() {
     cli::cli_alert_danger(
       "To debug connection issues to the fanc dataset, try:\n{.code fancr::dr_fanc()}")
 
+  if(!isTRUE(filter(cfc, .data$dataset=='banc')$installed))
+    cli::cli_alert_danger(
+      "To use the fancr dataset do:\n{.code natmanager::install(pkgs = 'fancr')}")
+  else if(is.na(filter(cfc, .data$dataset=='banc')$server))
+    cli::cli_alert_danger(
+      "To debug connection issues to the banc dataset, try:\n{.code fancr::dr_fanc()}")
+
+  # special case of most common auth issue
+  have_token=!inherits(try(fafbseg::chunkedgraph_token(), silent = TRUE), 'try-error')
+  if(!have_token)
+    usethis::ui_info(paste0(
+    'No CAVE token found. This is required to access fanc/banc datasets!\n',
+    "Set one with {usethis::ui_code('fancr::fanc_set_token()')}"))
+
   invisible(cfc)
 }

README.Rmd

@@ -50,9 +50,10 @@ At present the following datasets are supported (dataset names used in the packa
 4. Wei Lee, John Tuthill and colleagues [Female Adult Nerve Cord](https://github.com/htem/FANC_auto_recon) (**fanc**)
 5. Janelia Male CNS (**malecns**)
 6. Janelia Male Optic Lobe (part of the malecns) (**opticlobe**)
+7. Wei Lee and colleagues [Brain and Nerve Cord](https://github.com/jasper-tms/the-BANC-fly-connectome/wiki) (**banc**)
 
-Datasets 1-4 and 6 are either public (hemibrain, manc, flywire, opticlobe) or 
-access can be requested subject to agreeing to certain terms of use (fanc). 
+Datasets 1-4 and 7 are either public (hemibrain, manc, flywire, opticlobe) or 
+access can be requested subject to agreeing to certain terms of use (fanc, banc). 
 The Male CNS dataset is currently undergoing 
 proofreading and annotation in a collaboration between the 
 [FlyEM](https://www.janelia.org/project-team/flyem) and