From 034de94c556c5aa23680aa9578d79b648eb8c0fb Mon Sep 17 00:00:00 2001 From: alexanderbates Date: Thu, 19 Sep 2024 05:41:13 -0400 Subject: [PATCH] Choose your own colours with bancsee --- R/banc-table.R | 75 ++++++++++++++++++++++++++++++++++++++++---- R/ids.R | 42 ++++++++++++++----------- R/urls.R | 26 ++++++++++----- man/banc_latestid.Rd | 11 ++++++- man/bancsee.Rd | 20 +++++++++++- 5 files changed, 140 insertions(+), 34 deletions(-) diff --git a/R/banc-table.R b/R/banc-table.R index 8f73a3f..07821d0 100644 --- a/R/banc-table.R +++ b/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,7 +409,9 @@ 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")) %>% @@ -414,8 +419,66 @@ banctable_updateids <- function(){ 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, diff --git a/R/ids.R b/R/ids.R index 35f5c51..2084244 100644 --- a/R/ids.R +++ b/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 diff --git a/R/urls.R b/R/urls.R index c8a6258..eb8ae97 100644 --- a/R/urls.R +++ b/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,7 +156,7 @@ 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` } @@ -152,12 +164,12 @@ bancsee <- function(banc_ids = NULL, 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` } @@ -165,7 +177,7 @@ bancsee <- function(banc_ids = NULL, 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` } @@ -173,7 +185,7 @@ bancsee <- function(banc_ids = NULL, 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)` } diff --git a/man/banc_latestid.Rd b/man/banc_latestid.Rd index 5784120..cfb76cc 100644 --- a/man/banc_latestid.Rd +++ b/man/banc_latestid.Rd @@ -13,7 +13,12 @@ banc_latestid( ... ) -banc_updateids(x, ...) +banc_updateids( + x, + root.column = "root_id", + supervoxel.column = "supervoxel_id", + ... +) } \arguments{ \item{rootid}{One ore more FlyWire rootids defining a segment (in any form @@ -34,6 +39,10 @@ of} \item{x}{a \code{data.frame} with at least one of: \code{root_id}, \code{pt_root_id}, \code{supervoxel_id} and/or \code{pt_supervoxel_id}. Supervoxels will be preferentially used to update the \code{root_id} column. Else a vector of \code{BANC} root IDs.} + +\item{root.column}{when \code{x} is a \code{data.frame}, the \code{root_id} column you wish to update} + +\item{supervoxel.column}{when \code{x} is a \code{data.frame}, the \code{supervoxel_id} column you wish to use to update \code{root.column}} } \description{ Find the latest id for a banc root id diff --git a/man/bancsee.Rd b/man/bancsee.Rd index f787798..2bb4097 100644 --- a/man/bancsee.Rd +++ b/man/bancsee.Rd @@ -10,7 +10,13 @@ bancsee( 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" ) } \arguments{ @@ -25,6 +31,18 @@ bancsee( \item{nuclei_ids}{A vector of nuclei IDs for the BANC dataset. Default is NULL.} \item{open}{Logical; if TRUE, the function will open the Neuroglancer scene in a web browser. Default is FALSE.} + +\item{banc.cols}{Vector of hex codes describing a colour spectrum of colors to be interpolated for BANC neurons. Defaults are cyan-purple.} + +\item{fafb.cols}{Vector of hex codes describing a colour spectrum of colors to be interpolated for BANC neurons. Defaults are red hues.} + +\item{hemibrain.cols}{Vector of hex codes describing a colour spectrum of colors to be interpolated for BANC neurons. Defaults green hues.} + +\item{hemibrain.mirrored.cols}{Vector of hex codes describing a colour spectrum of colors to be interpolated for BANC neurons. Defaults are yellow hues.} + +\item{manc.cols}{Vector of hex codes describing a colour spectrum of colors to be interpolated for MANC neurons. Defaults are orange hues.} + +\item{nulcei.col}{Hex code for the colour in which nuclei will be plotted. Default is pink.} } \value{ If \code{open = FALSE}, returns a character string containing the URL for the Neuroglancer scene.