support for neuron class annotations

DESCRIPTION

@@ -31,9 +31,11 @@ Imports:
     dplyr,
     magrittr,
     nabor,
-    reshape2
+    reshape2,
+    stringr,
+    memoise
 Remotes: 
-    natverse/neuprintr
+    natverse/neuprintr@feature/flexible-ids
 Language: en-GB
 RoxygenNote: 7.0.2
 URL: https://github.com/flyconnectome/hemibrainr, https://flyconnectome.github.io/hemibrainr

NAMESPACE

@@ -39,10 +39,12 @@ export(axonal_endings)
 export(axonic_cable)
 export(axonic_endings)
 export(axonic_points)
+export(class2ids)
 export(dendritic_cable)
 export(dendritic_endings)
 export(dendritic_points)
 export(flow_centrality)
+export(glomerulus)
 export(hemibrain_compartment_metrics)
 export(hemibrain_extract_connections)
 export(hemibrain_extract_synapses)
@@ -71,4 +73,5 @@ importFrom(nat,progress_natprogress)
 importFrom(nat,prune_vertices)
 importFrom(neuprintr,neuprint_ROI_mesh)
 importFrom(neuprintr,neuprint_ROIs)
+importFrom(neuprintr,neuprint_ids)
 importFrom(stats,sd)

R/annotations.R

@@ -0,0 +1,167 @@
+#' Return body ids for large classes of neurons
+#'
+#' Will use our google sheet annotation spreadsheets or neuPrint queries as
+#' appropriate
+#'
+#' @param x A class of neuron (e.g. ORN, PN, DAN, MBON LHON, TOON, TOLN, HRN
+#'   etc.)
+#' @param ... Additional arguments passed to internal functions
+#' @param unlist return all the bodyids
+#' @param unique Whether to ensure that no duplicate ids are returned when
+#'   \code{unlist=TRUE}.
+#' @param refresh Whether to refresh cached class information from remote
+#'   sources. When \code{FALSE} (the default) this is automatically refreshed
+#'   every hour.
+#'
+#' @return When \code{unlist=FALSE} a list with elements named by the elements
+#'   of \code{x} (classes of neurons). When \code{unlist=TRUE}, a vector without
+#'   names of all bodyids.
+#' @export
+#'
+#' @examples
+#' \donttest{
+#' class2ids("uPN")
+#' length(class2ids("ORN", possible = FALSE))
+#' length(class2ids("ORN", possible = TRUE))
+#'
+#' class2ids("DAN")
+#' class2ids("MBON")
+#' }
+class2ids <- function(x, ..., unlist=TRUE, unique=TRUE, refresh=FALSE) {
+  res=list()
+  aln=c("RN", "ORN", "HRN", "TRN", "PN", "uPN", "mPN", "ALLN", "VPPN")
+  aln.toget=intersect(x, aln)
+  if(length(aln.toget))
+    res=sapply(aln.toget, alns, simplify = F, refresh=refresh, ...)
+  x=setdiff(x, aln)
+
+  mbn=c("DAN","MBON")
+  mbn.toget=intersect(x, mbn)
+  if(length(mbn.toget))
+    res=c(res, sapply(mbn.toget, mbns, simplify = F, ...))
+  x=setdiff(x, mbn)
+
+  if(length(x)) {
+    stop("Classes:", paste(x, collapse=" "), " not yet implemented")
+  }
+
+  if(unlist) {
+    res=unlist(res, use.names = F)
+    if(unique) res=unique(res)
+  }
+  res
+}
+
+aldf <- function(...)
+  cached_read_sheet("124eTYqQ8evTGm_z75V8jNVmfBI763_s4h1EAPVMiSvI", ...)
+
+alns <- function(x="RN", possible=TRUE, refresh=FALSE) {
+  aldf=aldf(forget=refresh)
+  if(x=='RN') {
+    aldf$bodyid[which(aldf$class=="RN")]
+  } else if (x=="HRN") {
+    if(possible) {
+      aldf$bodyid[grepl("HRN_", aldf$our_type)]
+    } else {
+      aldf$bodyid[grepl("^HRN_", aldf$our_type)]
+    }
+  } else if (x=="TRN") {
+    if(possible) {
+      aldf$bodyid[grepl("TRN_", aldf$our_type)]
+    } else {
+      aldf$bodyid[grepl("^TRN_", aldf$our_type)]
+    }
+  } else if (x=="ORN") {
+    if(possible) {
+      aldf$bodyid[grepl("ORN_", aldf$our_type)]
+    } else {
+      aldf$bodyid[grepl("^ORN_", aldf$our_type)]
+    }
+  } else if(x=="ALLN") {
+    aldf$bodyid[which(aldf$class=="ALLN")]
+  } else if(x=="PN") {
+    aldf$bodyid[which(aldf$class=="PN")]
+  } else if(x=="uPN") {
+    upns=aldf$class == 'PN' &
+      stringr::str_detect(aldf$our_type, "multi", negate = T) &
+      stringr::str_detect(aldf$our_type, "\\+", negate = T)
+    aldf$bodyid[which(upns)]
+  } else if(x=="mPN") {
+    mpns=aldf$class == 'PN' &
+      stringr::str_detect(aldf$our_type, "multi", negate = F) |
+      stringr::str_detect(aldf$our_type, "\\+", negate = F)
+    aldf$bodyid[which(mpns)]
+  } else if(x=="VPPN") {
+    vppns=aldf$class == 'PN' &
+      stringr::str_detect(aldf$our_type, "VP", negate = F)
+    aldf$bodyid[which(vppns)]
+  } else stop("I do not recognise: ", x, " as a class of AL neuron!")
+}
+
+#' Find the antennal lobe glomerulus for hemibrain body ids
+#'
+#' @param bodyids Vector of bodyids or a search string passed to
+#'   \code{\link{neuprint_ids}}
+#' @param exclude.multi When \code{TRUE} multiglomerular neurons will be
+#'   returned as \code{NA}.
+#'
+#' @return A character vector of glomeruli named with the \code{bodyids}
+#' @export
+#'
+#' @examples
+#' \donttest{
+#' table(glomerulus(class2ids('PN')), useNA='ifany')
+#' table(glomerulus(class2ids('PN'), exclude.multi = TRUE), useNA='ifany')
+#' }
+#' @importFrom neuprintr neuprint_ids
+glomerulus <- function(bodyids, exclude.multi=FALSE) {
+
+  aldf <- aldf()
+  bodyids <- neuprint_ids(bodyids)
+
+  res=character(length = length(bodyids))
+  names(res)=bodyids
+
+  rns=intersect(bodyids, class2ids("RN"))
+  if(length(rns)) {
+    gloms=sub(".*RN_(.*)","\\1", aldf[match(rns, aldf$bodyid),'our_type'])
+    res[rns]==gloms
+  }
+
+  pns=intersect(bodyids, class2ids("PN"))
+  if(length(pns)) {
+    gloms=stringr::str_match(aldf[['our_type']][match(pns, aldf$bodyid)],
+                        "(.*)\\s+[a-z]+PN")[,2]
+    if(exclude.multi) {
+      gloms[grepl("multi", gloms)]=NA_character_
+    }
+    res[pns]=gloms
+  }
+  res
+}
+
+mbdf <- function(sheet=c("MBONs", "DANs"), ...) {
+  sheet=match.arg(sheet)
+  cached_read_sheet("1NvQjqt4sSZR_rqiuDZoIsuaPB1mTV9x-R-tAtfyCd2c", sheet=sheet, ...)
+}
+
+mbns <- function(x=c("MBON", "DAN"), possible=TRUE, refresh=FALSE) {
+  # FIXME decide what possible means for MBONs/DANs
+  x=match.arg(x)
+  mbdf=mbdf(x, forget=refresh)
+  if(x == "MBON")
+    neuprint_ids(mbdf[mbdf$classification=='safe',])
+  else
+    neuprint_ids(mbdf)
+}
+
+cached_read_sheet <- function(id, forget=FALSE, ...) {
+  if(forget)
+    memoise::forget(cached_read_sheet_memo)
+  cached_read_sheet_memo(id, ...)
+}
+
+cached_read_sheet_memo <- memoise::memoise(function(id, ...) {
+  googlesheets4::read_sheet(id, ...)
+}, ~memoise::timeout(3600))
+

inst/WORDLIST

@@ -1,13 +1,16 @@
 Account’
 Analyze
 analyzing
+antennal
 arbor
 axo
 axonic
 bioRxiv
+bodyids
 branchpoint
 branchpoints
 Cardona
+Codecov
 color
 colored
 connectome
@@ -16,20 +19,23 @@ connectomics
 dendro
 doi
 etc
-flavors
 flyem
 FlyEM
 FlyEM's
 FlyEM’s
 GSXE
 hemibrain
 HemiBrain
+HRN
 janelia
 Janelia
 Kazimiers
+LHON
 login’
 Longair
+MBON
 Mizell
+multiglomerular
 natverse
 Neo
 neuprint
@@ -42,6 +48,8 @@ neuronlist
 nlapply
 ORCID
 org
+ORN
+PN
 PointNo
 postsynapses
 presynapses
@@ -54,6 +62,7 @@ somas
 swc
 SWC
 syn
+TOLN
 www
 yaml
 Zwart