R/plot_umap.R

In dbrookeUAB/dbsinglecell: Dewey Brooke's Single-Cell Toolkit

#' UMAP Palette using HCL presets
#'
#' @param object
#' @param group_col
#' @param hcl_pal
#' @param jitter
#' @param comp integer setting the color complementary to be used
#'
#' @return
#' @export
#'
#' @examples
pal_hcl <- function(object,group_col, hcl_pal = 'Dark 3',alpha = 0.7, jitter = TRUE,comp = 3){
  col_levels <- object@meta.data[[group_col]]
  n <- length(unique(col_levels))
  if("-1" %in% col_levels){
    pal <- c('gray')
  } else {
    pal <- c()
  }
  jn <- floor(n/comp)
  new_order <- 1:n
  if(jitter){
    new_order <- as.integer(unlist(sapply(1:jn, function(x) seq(x, n,jn))))
  }
  pal <- c(pal, hcl.colors(n,palette = hcl_pal,alpha = alpha)[new_order])
  return(pal)
}

#' UMAP palette using rainbow colors
#'
#' @param object
#' @param group_col
#' @param jitter
#' @param comp  integer setting the color complementary to be used
#'
#' @return
#' @export
#'
#' @examples
pal_rainbow <- function(object,group_col, jitter = TRUE,comp = 3, alpha = 0.7){
  col_levels <- object@meta.data[[group_col]]
  n <- length(unique(col_levels))
  if("-1" %in% col_levels){
    pal <- c('gray')
  } else {
    pal <- c()
  }
  jn <- floor(n/comp)
  new_order <- 1:n
  if(jitter){
    new_order <- as.integer(unlist(sapply(1:jn, function(x) seq(x, n,jn))))
  }
  pal <- c(pal,rainbow(57,s = 0.7,v = 0.8,alpha = alpha)[new_order])
  return(pal)
}

#' UMAP Palette using soft hues
#'
#' @param object
#' @param group_col
#' @param jitter integer setting the color complementary to be used
#' @param comp integer setting the color complementary to be used
#'
#' @return
#' @export
#'
#' @import colorspace
#'
#' @examples
pal_hue <- function(object,group_col, jitter = TRUE,comp = 3, alpha = 0.8){
  col_levels <- object@meta.data[[group_col]]
  n <- length(unique(col_levels))
  if("-1" %in% col_levels){
    pal <- c('gray')
  } else {
    pal <- c()
  }
  jn <- floor(n/comp)
  new_order <- 1:n
  if(jitter){
    new_order <- as.integer(unlist(sapply(1:jn, function(x) seq(x, n,jn))))
  }
  pal <- c(pal, colorspace::sequential_hcl(n, h = c(0, 300), c = c(60, 60),alpha = alpha, l = 65)[new_order])
  return(pal)
}

gg_color_hue <- function(n, alpha = 0.7) {
  hues = seq(15, 375, length = n + 1)
  hcl(h = hues, l = 65, c = 100,alpha = alpha)[1:n]
}

#' UMAP Palette using ggplot2 colors
#'
#' @param object
#' @param group_col
#' @param jitter
#' @param comp  integer setting the color complementarity to be used
#'
#' @return
#' @export
#'
#' @examples
pal_ggplot <- function(object,group_col, jitter = TRUE,comp = 3,alpha = 0.7){
  col_levels <- object@meta.data[[group_col]]
  n <- length(unique(col_levels))
  if("-1" %in% col_levels){
    pal <- c('gray')
  } else {
    pal <- c()
  }
  jn <- floor(n/comp)
  new_order <- 1:n
  if(jitter){
    new_order <- as.integer(unlist(sapply(1:jn, function(x) seq(x, n,jn))))
  }
  pal <- c(pal, gg_color_hue(n, alpha = alpha)[new_order])
  return(pal)
}

hex_convert <- function(x){
  if(x>=256) stop()
  tmp <- c(0:9, LETTERS[1:6])

  first <- floor(x/16)

  first <- ifelse(first==16, 15, first)
  second <- x - first*16
  res <- paste0(tmp[first+1], tmp[second+1])
  return(res)
}

hex_convert <- Vectorize(hex_convert)

incA <- function(n, min = 0, base = '#E1E1E1'){
  low <- hex_convert(min/100*255)
  c1 <- paste0(base, low)

  res <- c(c1,paste0(
    substring(viridis::plasma(n), 1, 7),
    hex_convert(seq(min/100*255,255, length.out = n))))
  return(res)
}