Choose your own colours with bancsee

R/banc-table.R

@@ -375,7 +375,7 @@ banc_update_status <- function(df, update, col = "status", wipe = FALSE){
 banctable_updateids <- function(){
 
   # Get cell info table
-  cat('reading cell info cave table...')
+  cat('reading cell info cave table...\n')
   info <- banc_cell_info(rawcoords = TRUE)  %>%
     dplyr::mutate(pt_position = xyzmatrix2str(pt_position)) %>%
     dplyr::select(pt_root_id, pt_supervoxel_id,pt_position) %>%
@@ -391,13 +391,16 @@ banctable_updateids <- function(){
     dplyr::rowwise()
 
   # Get current table
-  cat('reading banc meta table...')
-  bc <- banctable_query(sql = 'select _id, root_id, supervoxel_id, position from banc_meta') %>%
-    dplyr::select(root_id, supervoxel_id, position, `_id`)
+  cat('reading banc meta seatable...\n')
+  bc <- banctable_query(sql = 'select _id, root_id, supervoxel_id, position, banc_match, banc_match_supervoxel_id, banc_png_match, banc_png_match_supervoxel_id, banc_nblast_match, banc_nblast_match_supervoxel_id from banc_meta') %>%
+    dplyr::select(root_id, supervoxel_id, position,
+                  banc_match, banc_match_supervoxel_id, banc_png_match, banc_png_match_supervoxel_id, banc_nblast_match, banc_nblast_match_supervoxel_id,
+                  `_id`)
   bc[bc=="0"] <- NA
   bc[bc==""] <- NA
 
   # Update
+  cat('updating column: root_id ...\n')
   bc.new <- bc %>%
     dplyr::left_join(info,
                      by = c("supervoxel_id"="pt_supervoxel_id")) %>%
@@ -406,16 +409,76 @@ banctable_updateids <- function(){
     dplyr::select(-pt_root_id,-pt_position)
 
   # Update root IDs directly where needed
-  bc.new <- banc_updateids(bc.new)
+  bc.new <- banc_updateids(bc.new, root.column = "root_id", supervoxel.column = "supervoxel_id")
+
+  # Make sure supervoxel and root position information that is missing, is filled in
   bc.new <- bc.new %>%
     dplyr::left_join(info %>% dplyr::distinct(pt_root_id, .keep_all = TRUE),
                      by = c("root_id"="pt_root_id")) %>%
     dplyr::mutate(supervoxel_id = ifelse(is.na(supervoxel_id),pt_supervoxel_id,supervoxel_id)) %>%
     dplyr::mutate(position = ifelse(is.na(position),pt_position,position)) %>%
     dplyr::select(-pt_supervoxel_id,-pt_position)
 
+  # Update match columns
+  lookup <- bc.new %>%
+    dplyr::select(root_id, supervoxel_id) %>%
+    dplyr::rename(lookup_root_id=root_id,
+                  lookup_supervoxel_id=supervoxel_id) %>%
+    dplyr::filter(!is.na(lookup_supervoxel_id), lookup_supervoxel_id!="0",
+                  !is.na(lookup_root_id), lookup_root_id!="0") %>%
+    dplyr::distinct(lookup_root_id,lookup_supervoxel_id)
+  bc.new <- bc.new %>%
+    dplyr::left_join(lookup, by = c("banc_match_supervoxel_id"="lookup_supervoxel_id")) %>%
+    dplyr::mutate(banc_match = dplyr::case_when(
+      !is.na(lookup_root_id) ~ lookup_root_id,
+      TRUE ~ banc_match
+    )) %>%
+    dplyr::select(-lookup_root_id) %>%
+    dplyr::left_join(lookup, by = c("banc_png_match_supervoxel_id"="lookup_supervoxel_id")) %>%
+    dplyr::mutate(banc_png_match = dplyr::case_when(
+      !is.na(lookup_root_id) ~ lookup_root_id,
+      TRUE ~ banc_png_match
+    )) %>%
+    dplyr::select(-lookup_root_id) %>%
+    dplyr::left_join(lookup, by = c("banc_nblast_match_supervoxel_id"="lookup_supervoxel_id")) %>%
+    dplyr::mutate(banc_nblast_match = dplyr::case_when(
+      !is.na(lookup_root_id) ~ lookup_root_id,
+      TRUE ~ banc_nblast_match
+    )) %>%
+    dplyr::select(-lookup_root_id)
+
+  # Update directly
+  cat('updating column: banc_match ...\n')
+  bc.new <- banc_updateids(bc.new, root.column = "banc_match", supervoxel.column = "banc_match_supervoxel_id")
+  cat('updating column: banc_png_match ...\n')
+  bc.new <- banc_updateids(bc.new, root.column = "banc_png_match", supervoxel.column = "banc_png_match_supervoxel_id")
+  cat('updating column: banc_nblast_match ...\n')
+  bc.new <- banc_updateids(bc.new, root.column = "banc_nblast_match", supervoxel.column = "banc_nblast_match_supervoxel_id")
+  bc.new <- bc.new %>%
+    dplyr::left_join(lookup %>%dplyr::distinct(lookup_root_id, .keep_all=TRUE),
+                     by = c("banc_match"="lookup_root_id")) %>%
+    dplyr::mutate(banc_match_supervoxel_id = dplyr::case_when(
+      is.na(banc_match_supervoxel_id)&!is.na(lookup_supervoxel_id) ~ lookup_supervoxel_id,
+      TRUE ~ banc_match_supervoxel_id
+    )) %>%
+    dplyr::select(-lookup_supervoxel_id) %>%
+    dplyr::left_join(lookup %>%dplyr::distinct(lookup_root_id, .keep_all=TRUE),
+                     by = c("banc_png_match"="lookup_root_id")) %>%
+    dplyr::mutate(banc_png_match_supervoxel_id = dplyr::case_when(
+      is.na(banc_png_match_supervoxel_id)&!is.na(lookup_supervoxel_id) ~ lookup_supervoxel_id,
+      TRUE ~ banc_png_match_supervoxel_id
+    )) %>%
+    dplyr::select(-lookup_supervoxel_id) %>%
+    dplyr::left_join(lookup %>%dplyr::distinct(lookup_root_id, .keep_all=TRUE),
+                     by = c("banc_nblast_match"="lookup_root_id")) %>%
+    dplyr::mutate(banc_nblast_match_supervoxel_id = dplyr::case_when(
+      is.na(banc_nblast_match_supervoxel_id)&!is.na(lookup_supervoxel_id) ~ lookup_supervoxel_id,
+      TRUE ~ banc_nblast_match_supervoxel_id
+    )) %>%
+    dplyr::select(-lookup_supervoxel_id)
+
   # Update
-  cat('updating banc meta table...')
+  cat('updating banc meta seatable...\n')
   bc.new[is.na(bc.new)] <- ''
   bc.new[bc.new=="0"] <- ''
   banctable_update_rows(df = bc.new,

R/ids.R

@@ -156,7 +156,8 @@ banc_islatest <- function(x, timestamp=NULL, ...) {
 #' Supervoxels will be preferentially used to update the `root_id` column.
 #' Else a vector of `BANC` root IDs.
 #' @param ... Additional arguments passed to \code{\link{flywire_latestid}}
-#'
+#' @param root.column when `x` is a `data.frame`, the `root_id` column you wish to update
+#' @param supervoxel.column when `x` is a `data.frame`, the `supervoxel_id` column you wish to use to update `root.column`
 #' @export
 #' @seealso \code{\link{banc_islatest}}
 #' @family banc-ids
@@ -170,45 +171,48 @@ banc_latestid <- function(rootid, sample=1000L, cloudvolume.url=NULL, Verbose=FA
 
 #' @export
 #' @rdname banc_latestid
-banc_updateids <- function(x, ...){
+banc_updateids <- function(x,
+                           root.column = "root_id",
+                           supervoxel.column = "supervoxel_id",
+                           ...){
   if(is.data.frame(x)){
+
     # what needs updating?
-    root.col <- intersect(c("root_id","pt_root_id"),colnames(x))[1]
-    if(!length(root.col)){
-      root.col <- "root_id"
+    if(!length(root.column)){
+      root.column <- "root_id"
     }
-    if(any(c("root_id","pt_root_id")%in%colnames(x))){
+    if(root.column%in%colnames(x)){
       cat('determining old root_ids...')
-      old <- !banc_islatest(x[[root.col]], ...)
+      old <- !banc_islatest(x[[root.column]], ...)
     }else{
       old <- rep(TRUE,nrow(x))
     }
-    old[is.na(old)] <- TRUE
+    old[is.na(old)] <- FALSE
     if(!sum(old)){
       return(x)
     }
 
     # update based on supervoxels
-    if(any(c("supervoxel_id","pt_supervoxel_id")%in%colnames(x))){
+    if(supervoxel.column%in%colnames(x)){
       cat('updating root_ids with a supervoxel_id...')
-      svid.col <- intersect(c("supervoxel_id","pt_supervoxel_id"),colnames(x))[1]
-      update <- unname(pbapply::pbsapply(x[old,][[svid.col]], banc_rootid, ...))
+      update <- unname(pbapply::pbsapply(x[old,][[supervoxel.column]], banc_rootid, ...))
       bad <- is.na(update)|update=="0"
       update <- update[!bad]
-      if(length(update)) x[old,][[root.col]][!bad] <- update
-      old[!bad] <- FALSE
+      if(length(update)) x[old,][[root.column]][!bad] <- update
+      old[old][!bad] <- FALSE
     }
-    old[is.na(old)] <- TRUE
+    old[is.na(old)] <- FALSE
 
     # update based on root Ids
-    if(any(c("root_id","pt_root_id")%in%colnames(x)) && sum(old)){
+    if(root.column%in%colnames(x) && sum(old)){
       cat('updating root_ids without a supervoxel_id...')
-      update <- banc_latestid(x[old,][[root.col]], ...)
+      update <- banc_latestid(x[old,][[root.column]], ...)
       bad <- is.na(update)|update=="0"
       update <- update[!bad]
-      if(length(update)) x[old,][[root.col]][!bad] <- update
-      old[!bad] <- FALSE
+      if(length(update)) x[old,][[root.column]][!bad] <- update
+      old[old][!bad] <- FALSE
     }
+    old[is.na(old)] <- FALSE
 
     # # update based on position
     # if(any(c("position","pt_position")%in%colnames(x)) && sum(old)){
@@ -217,7 +221,7 @@ banc_updateids <- function(x, ...){
     #   update <- unname(pbapply::pbsapply(x[old,][[pos.col]], banc_xyz2id, rawcoords = TRUE, ...))
     #   bad <- is.na(update)|update=="0"
     #   update <- update[!bad]
-    #   if(length(update)) x[old,][[root.col]][!bad] <- update
+    #   if(length(update)) x[old,][[root.column]][!bad] <- update
     #   old[!bad] <- FALSE
     # }
     # old[is.na(old)] <- TRUE

R/urls.R

@@ -64,6 +64,12 @@ banc_scene <- function(ids=NULL, open=FALSE, layer = NULL) {
 #' @param manc_ids A vector of neuron IDs from the MANC dataset. Default is NULL.
 #' @param nuclei_ids A vector of nuclei IDs for the BANC dataset. Default is NULL.
 #' @param open Logical; if TRUE, the function will open the Neuroglancer scene in a web browser. Default is FALSE.
+#' @param banc.cols Vector of hex codes describing a colour spectrum of colors to be interpolated for BANC neurons. Defaults are cyan-purple.
+#' @param fafb.cols Vector of hex codes describing a colour spectrum of colors to be interpolated for BANC neurons. Defaults are red hues.
+#' @param hemibrain.cols Vector of hex codes describing a colour spectrum of colors to be interpolated for BANC neurons. Defaults  green hues.
+#' @param hemibrain.mirrored.cols Vector of hex codes describing a colour spectrum of colors to be interpolated for BANC neurons. Defaults are yellow hues.
+#' @param manc.cols Vector of hex codes describing a colour spectrum of colors to be interpolated for MANC neurons. Defaults are orange hues.
+#' @param nulcei.col Hex code for the colour in which nuclei will be plotted. Default is pink.
 #'
 #' @return
 #' If `open = FALSE`, returns a character string containing the URL for the Neuroglancer scene.
@@ -114,7 +120,13 @@ bancsee <- function(banc_ids = NULL,
                     hemibrain_ids = NULL,
                     manc_ids = NULL,
                     nuclei_ids = NULL,
-                    open = FALSE){
+                    open = FALSE,
+                    banc.cols = c("#54BCD1", "#0000FF", "#8A2BE2"),
+                    fafb.cols = c("#C41E3A", "#FF3131", "#F88379"),
+                    hemibrain.cols = c("#00FF00", "#32CD32", "#006400"),
+                    hemibrain.mirrored.cols = c("#FFFF00", "#FFD700", "#FFA500"),
+                    manc.cols = c("#FFA07A", "#FF4500", "#FF8C00"),
+                    nulcei.col = "#FC6882"){
 
   # Do not get the neuroglancer warnings
   old_warn <- options(warn = -1)  # Suppress all warnings
@@ -134,7 +146,7 @@ bancsee <- function(banc_ids = NULL,
   if(length(banc_ids)){
     u1=banc_scene(banc_ids, open=F, layer = "segmentation proofreading")
     colourdf1 = data.frame(ids = banc_ids,
-                           col=grDevices::colorRampPalette(c("#54BCD1", "#0000FF", "#8A2BE2"))(length(banc_ids)))
+                           col=grDevices::colorRampPalette(banc.cols)(length(banc_ids)))
     sc1<-fafbseg::ngl_add_colours(u1, colourdf1, layer = "segmentation proofreading")
   }else{
     sc1 = fafbseg::ngl_decode_scene(banc_scene())
@@ -144,36 +156,36 @@ bancsee <- function(banc_ids = NULL,
   if(length(fafb_ids)){
     u2=banc_scene(fafb_ids, open=F, layer = "fafb v783 imported")
     colourdf2 = data.frame(ids = fafb_ids,
-                           col=grDevices::colorRampPalette(c("#EE4244", "#D72000", "#C23A4B"))(length(fafb_ids)))
+                           col=grDevices::colorRampPalette(fafb.cols)(length(fafb_ids)))
     sc2<-fafbseg::ngl_add_colours(u2, colourdf2, layer = "fafb v783 imported")
     fafbseg::ngl_layers(sc1)$`fafb v783 imported` <- fafbseg::ngl_layers(sc2)$`fafb v783 imported`
   }
 
   if(length(hemibrain_ids)){
     u3=banc_scene(hemibrain_ids, open=F, layer = "hemibrain v1.2.1 imported")
     colourdf3 = data.frame(ids = hemibrain_ids,
-                           col=grDevices::colorRampPalette(c("#00FF00", "#32CD32", "#006400"))(length(hemibrain_ids)))
+                           col=grDevices::colorRampPalette(hemibrain.cols)(length(hemibrain_ids)))
     sc3<-fafbseg::ngl_add_colours(u3, colourdf3, layer = "hemibrain v1.2.1 imported")
     fafbseg::ngl_layers(sc1)$`hemibrain v1.2.1 imported` <- fafbseg::ngl_layers(sc3)$`hemibrain v1.2.1 imported`
     u4=banc_scene(hemibrain_ids, open=F, layer = "hemibrain v1.2.1 imported, mirrored")
     colourdf4 = data.frame(ids = hemibrain_ids,
-                           col=grDevices::colorRampPalette(c("#FFFF00", "#FFD700", "#FFA500"))(length(hemibrain_ids)))
+                           col=grDevices::colorRampPalette(hemibrain.mirrored.cols)(length(hemibrain_ids)))
     sc4<-fafbseg::ngl_add_colours(u4, colourdf4, layer = "hemibrain v1.2.1 imported, mirrored")
     fafbseg::ngl_layers(sc1)$`hemibrain v1.2.1 imported, mirrored` <- fafbseg::ngl_layers(sc4)$`hemibrain v1.2.1 imported, mirrored`
   }
 
   if(length(manc_ids)){
     u5=banc_scene(manc_ids, open=F, layer = "manc v1.2.1 imported")
     colourdf5 = data.frame(ids = manc_ids,
-                           col=grDevices::colorRampPalette(c("#FFA07A", "#FF4500", "#FF8C00"))(length(manc_ids)))
+                           col=grDevices::colorRampPalette(manc.cols)(length(manc_ids)))
     sc5<-fafbseg::ngl_add_colours(u5, colourdf5, layer = "manc v1.2.1 imported")
     fafbseg::ngl_layers(sc1)$`manc v1.2.1 imported` <- fafbseg::ngl_layers(sc5)$`manc v1.2.1 imported`
   }
 
   if(length(nuclei_ids)){
     u6=banc_scene(manc_ids, open=F, layer = "nuclei (v1)")
     colourdf6 = data.frame(ids = nuclei_ids,
-                           col="#FC6882")
+                           col=nulcei.col)
     sc6<-fafbseg::ngl_add_colours(u6, colourdf6, layer = "nuclei (v1)")
     fafbseg::ngl_layers(sc1)$`nuclei (v1)` <- fafbseg::ngl_layers(sc6)$`nuclei (v1)`
   }