R/deprecated.R

In gmteunisse/Fantaxtic: Fantaxtic - nested bar plots for phyloseq data

#' @title Deprecated functions in package \pkg{fantaxtic}.
#' @description The functions listed below are deprecated and will be defunct in
#'   the near future. When possible, alternative functions with similar
#'   functionality are also mentioned. Help pages for deprecated functions are
#'   available at \code{help("<function>-deprecated")}.
#' @name fantaxtic-deprecated
#' @keywords internal
NULL


#' Get the most abundant taxa from a phyloseq object
#'
#' This function subsets a phyloseq object to the top \eqn{n} most abundant
#' taxa. Users can choose whether to select by absolute counts or relative
#' counts, and whether to discard or collapse remaining taxa.
#'
#' @param physeq_obj A phyloseq object with an \code{otu_table} and a
#' \code{tax_table}.
#' @param n The number of top taxa to subset to.
#' @param relative Select taxa based on relative abundance?
#' (default = \code{TRUE})
#' @param discard_other Discard remainig taxa? (default = \code{FALSE})
#' @param other_label Label to give to collapsed taxa.
#' @return A phyloseq object
#'
#' @name get_top_taxa-deprecated
#' @seealso \code{\link{fantaxtic-deprecated}}
#' @usage get_top_taxa(physeq_obj, n, relative = T, discard_other, other_label)
#' @examples
#' data(GlobalPatterns)
#' get_top_taxa(GlobalPatterns, 10)
#' get_top_taxa(GlobalPatterns, 10, relative = FALSE)
#' get_top_taxa(GlobalPatterns, 10, relative = TRUE, discard_other = TRUE)
#' get_top_taxa(GlobalPatterns, 10, relative = TRUE, other_label = "Non-abundant taxa")
NULL

#' @rdname fantaxtic-deprecated
#' @section get_top_taxa:
#' For \code{get_top_taxa}, use \code{\link{top_taxa}} or \code{\link{nested_top_taxa}}.
#'
#' @export
get_top_taxa <- function(physeq_obj, n, relative = TRUE, discard_other = FALSE, other_label = "Other"){

  .Deprecated(c("top_taxa", "nested_top_taxa"))

  #Define a temporary physeq object
  ps_tmp <- physeq_obj

  #Check for 0 entries
  smpl_sms <- phyloseq::sample_sums(ps_tmp)
  if (0 %in% smpl_sms){
    stop("Error: some samples contain 0 reads. These have to be removed to avoid
            downstream problems.")
  }

  #Extract the otu_table as a data.frame
  otu_tbl <- phyloseq::otu_table(ps_tmp)
  if (!phyloseq::taxa_are_rows(ps_tmp)){
    otu_tbl <- t(otu_tbl)
  }

  #Use relative abundances if requested
  if (relative){
    otu_tbl <- apply(otu_tbl, 2, function(x){
      x / sum (x)
    })
  }

  #Update the phyloseq object
  phyloseq::otu_table(ps_tmp) <- phyloseq::otu_table(otu_tbl, taxa_are_rows = T)

  #Get the top taxa names and discard or merge other taxa
  abun_taxa <- names(sort(phyloseq::taxa_sums(ps_tmp), decreasing = TRUE)[1:n])
  if (discard_other){
    physeq_obj <- phyloseq::prune_taxa(abun_taxa, physeq_obj)
  } else {
    to_merge <- phyloseq::taxa_names(physeq_obj)
    to_merge <- to_merge[!(to_merge %in% abun_taxa)]
    physeq_obj <- merge_taxa(physeq_obj, to_merge)
    tax_tbl <- phyloseq::tax_table(physeq_obj)
    indx <- which(row.names(tax_tbl) %in% to_merge)
    tax_tbl[indx,] <- other_label
    phyloseq::tax_table(physeq_obj) <- tax_tbl
  }
  return(physeq_obj)
}

#' Generate a color palette.
#'
#' This function generates \eqn{i_1, i_2, ... i_n} shades and tints specified
#' in \code{clr.tbl} for \eqn{n} colors \code{clr.pal}. If no \code{clr.tbl}
#' is specified, this function generates \eqn{n} maximally separated colors
#' with equal saturation and brightness from a base color.
#'
#' @param clr_tbl A \code{data.frame} or \code{matrix} with two columns: the
#' first column gives the labels to which colors need to be assigned; the
#' second column gives the number of tints and shades that need to be generated
#' for that color.
#' @param clr_pal A color palette with with \eqn{n} colors, where
#' \eqn{n =} \code{nrow(clr_tbl)}.
#' @param base_clr The base color from which to generate a color palette.
#' @return A list of \eqn{n} items, each containing \eqn{i_n} shades.
#'
#' @name gen_palette-deprecated
#' @seealso \code{\link{fantaxtic-deprecated}}
#' @usage gen_palette(clr_tbl, clr_pal = NULL, base_clr = "#6495ed")
#'
#' @examples
#' clr_tbl <- data.frame(Var = c("Phylum A", "Phylum B"),
#'                       Freq = c(5, 8))
#' gen_palette(clr_tbl)
#' gen_palette(clr_tbl, clr_pal = c("red", "blue"))
#' gen_palette(clr_tbl, base_clr = "blue")
NULL

#' @rdname fantaxtic-deprecated
#' @section gen_palette:
#' For \code{gen_palette}, use \code{\link[ggnested]{nested_palette}} in the ggnested package.
#'
#' @export
gen_palette <- function(clr_tbl, clr_pal = NULL, base_clr = "#6495ed"){

  .Deprecated(new = "nested_palette")

  #Define a palette
  base_pal <- c("#6495ed", "#ff7256", "#edbc64", "#8470ff", "#8ee5ee", "#EE8DD6")

  #Define the number of variants required per color
  clr_vars <- clr_tbl[,2]
  n_clrs <- length(clr_vars)

  #Check arguments and generate colors if required
  if (is.null(clr_pal)){
    if (base_clr != "#6495ed"){
      clr_pal <- gen_colors(n_clrs, base_clr)
    } else {
      if (n_clrs <= length(base_pal)){
        clr_pal <- base_pal[1:n_clrs]
      } else {
        clr_pal <- gen_colors(n_clrs, base_clr)
      }
    }
  } else {
    if (length(clr_pal) < n_clrs){
      stop(sprintf("Error: %d values required in clr.pal, %d provided.", n_clrs, length(clr_pal)))
    }
    clr_pal <- clr_pal[1:n_clrs]
  }

  #Create the translation table from color.by to their central colors
  clr_mtrx <- cbind(clr_tbl, clr_pal)
  names(clr_mtrx) <- c("Level", "N.color.shades", "Central.color")
  clr_mat <- clr_mtrx

  #Generate i vars for each clr in  clr.pal
  clr_mtrx <- cbind(clr_vars, clr_pal)
  clr_list <- split(clr_mtrx, seq(nrow(clr_mtrx)))
  palette <- lapply(clr_list, function(v){
    i <- as.numeric(v[1])
    clr <- v[2]
    gen_shades_tints(i, clr)
  })
  return(list(palette = palette,
              colours = clr_mat))
}

#' Generate a barplot of relative taxon abundances
#'
#' This function generates a \code{ggplot2} barplot for the relative abundances
#' of taxa in a phyloseq object.
#'
#' Coloring occurs by a user specified taxonomic
#' level, and subcoloring according to another level can be added if desired (e.g.
#' color by phylum, subcolor by genus). In addition, one or more taxon names can
#' be specified as "other" that receive a specific color (e.g. outliers,
#' collapsed taxa).
#'
#' By default, unique labels per taxon will be generated in the case that
#' multiple taxa with identical labels exist, unless the user chooses to suppress
#' this. Moreover, \code{NA} values in the \code{tax_table} of the phyloseq
#' object will be renamed to \code{"Unknown"} to avoid confusion. WARNING:
#' duplicate labels in the data lead to incorrect displaying of data and
#' labels.
#'
#' To facilitate visualisation and/or interpretation, samples can be reordered
#' according alphabetically, by the abundance of a certain taxon, by
#' hierarhical clustering or by the abundance of "other" taxa.
#'
#' @param physeq_obj A phyloseq object with an \code{otu_table}, a \code{tax_table}
#' and, in case of facetting, \code{sample_data}.
#' @param color_by The name of the taxonomic level by which to color the bars.
#' @param label_by The name of the taxonomic level by which to label the bars and
#' generate subcolors.
#' @param facet_by The name of the factor in the \code{sample_data} by which to
#' facet the plots.
#' @param grid_by The name of a second factor in the \code{sample_data} by which to
#' facet to plots, resulting in a grid.
#' @param facet_type The type of faceting from ggplot2 to use, either \code{grid}
#' or \code{wrap} (default).
#' @param facet_cols The number of columns to use for faceting.
#' @param gen_uniq_lbls Generate unique labels (default = \code{TRUE})?
#' @param other_label A character vector specifying the names of taxa in
#' \code{label_by} to use a specific color for.
#' @param order_alg The algorithm by which to order samples, or one or more taxa
#' found in \code{label_by}. Algorithms can be one of \code{hclust}
#' (hierarhical clustering; default), \code{as.is} (current order) or \code{alph}
#' (alphabetical).
#' @param color_levels Character vector containing names of levels. Useful to
#' enforce identical colors for levels across different plots or to pair levels
#' with colors.
#' @param base_color The base color from which to generate colors.
#' @param other_color The base color from which to generate shades for "other"
#' taxa.
#' @param palette A user specified palette to color the bars with. Replaces
#' \code{base_color}.
#' @param bar_width The width of the bars as a fraction of the binwidth
#' (default = 0.9).
#' @return A \code{ggplot2} object.
#' @import ggplot2 phyloseq reshape2
#'
#' @name fantaxtic_bar-deprecated
#' @seealso \code{\link{fantaxtic-deprecated}}
#' @usage fantaxtic_bar(physeq_obj, color_by, label_by = NULL, facet_by = NULL, grid_by = NULL, facet_type = "wrap", bar_width = 0.9, facet_cols =  1, gen_uniq_lbls = TRUE, other_label= NULL, order_alg = "hclust", color_levels = NULL, base_color = "#6495ed", other_color = "#f3f3f3", palette = NULL)
#'
#' @examples
#' #Load data
#' data(GlobalPatterns)
#'
#' #Get the 10 most abundant OTUs / ASVs
#' ps_tmp <- get_top_taxa(physeq_obj = GlobalPatterns, n = 10, relative = TRUE,
#'                        discard_other = FALSE, other_label = "Other")
#'
#' #Create labels for missing taxonomic ranks
#' ps_tmp <- name_taxa(ps_tmp, label = "Unkown", species = T, other_label = "Other")
#'
#' #Generate a barplot that is colored by Phylum and labeled by Species, coloring
#' #collapsed taxa grey.
#' fantaxtic_bar(ps_tmp, color_by = "Phylum", label_by = "Species", other_label = "Other")
#'
#' #Generate a barplot that is colored by Phylum and lebeled by Species. As multiple
#' # ASVs have the same family annotation, generate unique labels.
#' fantaxtic_bar(ps_tmp, color_by = "Phylum", label_by = "Family", other_label = "Other",
#'               gen_uniq_lbls = TRUE)
#'
#' #Change the sample ordering
#' fantaxtic_bar(ps_tmp, color_by = "Phylum", label_by = "Family", other_label = "Other",
#'               order_alg = "other.abnd")
#'
#' #Add faceting by sample type
#' fantaxtic_bar(ps_tmp, color_by = "Phylum", label_by = "Family",
#'               facet_by = "SampleType", other_label = "Other")
NULL

#' @rdname fantaxtic-deprecated
#' @section fantaxtic_bar:
#' For \code{fantaxtic_bar}, use \code{\link{plot_nested_bar}}.
#'
#' @export
fantaxtic_bar <- function(physeq_obj, color_by, label_by = NULL, facet_by = NULL,
                          grid_by = NULL, facet_type = "wrap", bar_width = 0.9,
                          facet_cols =  1, gen_uniq_lbls = TRUE, other_label= NULL,
                          order_alg = "hclust", color_levels = NULL,
                          base_color = "#6495ed",
                          other_color = "#f3f3f3", palette = NULL){

  .Deprecated(new = "fantaxtic")

  #Check for subcoloring
  if (is.null(label_by)){
    label_by <- color_by
  }

  #Extract tax_tbl and add OTU names
  tax_tbl <- as.data.frame(phyloseq::tax_table(physeq_obj))
  tax_tbl$otu_name <- row.names(tax_tbl)

  #Replace NAs with Unknown
  tax_tbl <- as.data.frame(apply(tax_tbl, 2, function(x){
    x[is.na(x)] <- "Unknown"
    return(x)
  }))

  #Move Other taxa to the beginning and alter taxonomic annotations
  #of Other taxa
  if(!is.null(other_label)){
    main_ind <- which(!tax_tbl[[label_by]] %in% other_label)
    other_ind <- which(tax_tbl[[label_by]] %in% other_label)
    new_color_by <- as.character(tax_tbl[[color_by]])
    new_color_by[other_ind] <- as.character(tax_tbl[[label_by]][other_ind])
    tax_tbl[[color_by]] <- as.factor(new_color_by)
    ordr <- c(other_ind, main_ind)
    tax_tbl <- tax_tbl[ordr,]
  }

  #Refactor for legend ordering and order
  if (is.null(color_levels)){
    tax_levels <- unique(tax_tbl[[color_by]])
  } else {
    if (is.null(other_label)){
      tax_levels <- color_levels
    } else {
      tax_levels <- c(other_label, color_levels)
    }
  }
  tax_tbl[[label_by]] <- factor(tax_tbl[[label_by]], unique(tax_tbl[[label_by]]), ordered = T)
  tax_tbl[[color_by]] <- factor(tax_tbl[[color_by]], tax_levels, ordered = T)
  tax_tbl <- tax_tbl[order(tax_tbl[[color_by]]),]

  #Get the tax and OTU tables
  otu_tbl <- as.data.frame(phyloseq::otu_table(physeq_obj))

  #Check the orientation of the otu_tbl and change if required
  if (!taxa_are_rows(phyloseq::otu_table(physeq_obj))){
    otu_tbl <- as.data.frame(t(otu_tbl))
  }

  #Calculate the number of colors and color variations required
  clr_tbl <- as.data.frame(table(tax_tbl[[color_by]], useNA = "ifany"), stringsAsFactors = F)
  if(!is.null(other_label)){
    ind <- which(!clr_tbl$Var1 %in% other_label)
    clr_tbl <- clr_tbl[ind,]
  }

  #Generate the required color palette
  clr_pal <- gen_palette(clr_tbl = clr_tbl, clr_pal = palette, base_clr = base_color)$palette
  names(clr_pal) <- clr_tbl$Var1
  clr_pal <- as.vector(unlist(clr_pal))
  if(!is.null(other_label)){
    n_other <- length(other_label)
    other_pal <- gen_shades_tints(n_other, clr = other_color)
    clr_pal <- c(other_pal, clr_pal)
  }

  #Generate unique label names if required
  if(gen_uniq_lbls){
    tax_tbl[[label_by]] <- gen_uniq_lbls(tax_tbl[[label_by]])
  }

  #Transform absolute taxon counts to relative values
  otu_tbl <- as.data.frame(apply(otu_tbl, 2, function(x){
    if (sum(x) > 0){x/sum(x)}
    else(x)
  }))

  #Match order of tax.tbl and otu.tbl
  ord <- match(tax_tbl$otu_name, row.names(otu_tbl))
  otu_tbl <- otu_tbl[ord,]

  #Order the samples according to the specified algorithm
  #Order according to selected taxonomies
  if (sum(order_alg %in% c("alph", "hclust", "as.is")) == 0){

    #Get the summed abundances
    sums <- list()
    i <- 0
    for (lvl in order_alg){
      i <- i + 1
      sums[[i]] <- round(colSums(otu_tbl[which(tax_tbl[[label_by]] == lvl),]), digits = 3)
    }

    #Sort
    cmd <- paste(sprintf("sums[[%d]]", 1:i), collapse = ", ")
    smpl_ord <- eval(parse(text = sprintf("order(%s)", cmd)))
    otu_tbl <- otu_tbl[,smpl_ord]

    #Order according to selected algorithm
  }else{
    if (order_alg == "alph"){
      otu_tbl <- otu_tbl[,order(names(otu_tbl))]
    } else {
      if(order_alg == "hclust"){
        hc <- hclust(dist(x = t(otu_tbl), method = "euclidian", upper = F))
        smpl_ord <- hc$order
        otu_tbl <- otu_tbl[,smpl_ord]
      } else {
        if (order_alg == "as.is"){
          #do nothing
        }
      }
    }
  }


  #Join labels and counts and transform to a long data format
  counts <- cbind(tax_tbl[[color_by]], tax_tbl[[label_by]], otu_tbl)
  names(counts) <- c("color_by", "label_by", colnames(otu_tbl))
  counts_long <- reshape2::melt(counts,
                                id.vars = c("color_by", "label_by"),
                                variable.name = "Sample",
                                value.name = "Abundance")

  #Add facet levels if needed and transform to a long data format
  if(is.null(facet_by) & !is.null(grid_by)){
    facet_by <- grid_by
    grid_by <- NULL
  }
  if (!is.null(facet_by)){
    facet <- as.data.frame(phyloseq::sample_data(physeq_obj))[[facet_by]]
    names(facet) <- row.names(phyloseq::sample_data(physeq_obj))
    ord <- match(counts_long$Sample, names(facet))
    facet <- facet[ord]
    counts_long$facet <- facet
  }
  if (!is.null(grid_by)){
    grid <- as.data.frame(phyloseq::sample_data(physeq_obj))[[grid_by]]
    names(grid) <- row.names(phyloseq::sample_data(physeq_obj))
    ord <- match(counts_long$Sample, names(grid))
    grid <- grid[ord]
    counts_long$grid <- grid
  }

  #Generate a plot
  p <- ggplot2::ggplot(counts_long, aes(x = Sample, y = Abundance, fill = label_by)) +
    ggplot2::geom_bar(position = "stack", stat = "identity", width = bar_width) +
    ggplot2::guides(fill=guide_legend(title = label_by, ncol = 1)) +
    ggplot2::scale_fill_manual(values = clr_pal) +
    ggplot2::scale_y_continuous(expand = c(0,0)) +
    ggplot2::theme(axis.line.x = element_line(colour = 'grey'),
                   axis.line.y = element_line(colour = 'grey'),
                   axis.ticks = element_line(colour = 'grey'),
                   axis.text.x = element_text(angle = 90, size = 6, hjust = 1, vjust = 0.5),
                   legend.background = element_rect(fill = 'transparent', colour = NA),
                   legend.key = element_rect(fill = "transparent"),
                   legend.key.size = unit(0.4, "cm"),
                   panel.background = element_rect(fill = 'transparent', colour = NA),
                   panel.grid.major.x = element_blank(),
                   panel.grid.major.y = element_line(colour = adjustcolor('grey', 0.2)),
                   panel.grid.minor = element_line(colour = NA),
                   plot.background = element_rect(fill = 'transparent', colour = NA),
                   plot.title = element_text(hjust = 0.5),
                   strip.background = element_blank(),
                   strip.text = element_text(size = 8, face = "bold"),
                   text = element_text(size = 8))

  if (!is.null(facet_by)) {
    if (facet_type == "wrap"){
      if (is.null(grid_by)){
        p <- p + ggplot2::facet_wrap(~facet, scales = "free", ncol = facet_cols)
      }else{
        p <- p + ggplot2::facet_wrap(~grid + facet, scales = "free", ncol = facet_cols)
      }
    }else{
      if (facet_type == "grid"){
        if (is.null(grid_by)){
          p <- p + ggplot2::facet_grid(~facet, scales = "free", space = "free")
        }else{
          p <- p + ggplot2::facet_grid(facet ~ grid, scales = "free", space = "free")
        }
      }
    }
  }

  return(p)
}

#' Generate a color palette.
#'
#' This function generates \code{n} maximally separated colors with equal
#' saturation and brightness from a base color.
#'
#' @param n The number of colors to generate.
#' @param clr The base color from which to generate other colors.
#' @return A vector of \code{n} colors.
#'
#' @name gen_colors-deprecated
#' @seealso \code{\link{fantaxtic-deprecated}}
#' @usage gen_colors(n, clr = "#6495ed")
#'
#' @examples
#' gen_colors(5)
#' gen_colors(5, "blue")
NULL

#' @rdname fantaxtic-deprecated
#' @section gen_colors:
#' For \code{gen_colors}, use \code{\link[ggnested]{nested_palette}} in the ggnested package.
#'
#' @export
gen_colors <- function(n, clr = "#6495ed"){

  .Deprecated(new = "nested_palette")
  if (n == 1){
    return(clr)
  }
  clr.rgb <- t(col2rgb(clr))
  clr.hsv <- t(rgb2hsv(clr.rgb[1], clr.rgb[2], clr.rgb[3], 255))
  clrs <- 0:(n-1)
  clrs <- sapply(clrs, function(x){
    offset <- x/(n)
    h <- (clr.hsv[1] + offset) %% 1
    s <- clr.hsv[2]
    v <- clr.hsv[3]
    clr <- hsv(h, s, v)
    return(clr)
  })
  clrs <- shuffle_colors(clrs)
  return(clrs)
}

#' Reshuffle a list of colors.
#'
#' This function reshuffles a vector of colours so that in a list of \code{n}
#' colors, every color \code{i} in \code{\{1, n / 2\}} will be placed next
#' to color \code{i + n / 2}. This is useful for visualization of
#' automatically generated color palettes based upon for example gradients
#' or HSL color circles.
#'
#' @param clrs A vector of colors to reshuffle.
#' @return A reshuffled vector of \code{clrs}.
#'
#' @name shuffle_colors-deprecated
#' @seealso \code{\link{fantaxtic-deprecated}}
#' @usage shuffle_colors(clrs)
#'
#' @examples
#' shuffle_colors(gen_colors(6))
NULL

#' @rdname fantaxtic-deprecated
#' @section shuffle_colors:
#' For \code{shuffle_colors}, use \code{\link[ggnested]{nested_palette}} in the ggnested package.
#'
#' @export
shuffle_colors <- function(clrs){

  .Deprecated(new = "nested_palette")

  n.col <- length(clrs)
  ordr <- rep(1:ceiling(n.col/2), each = 2, length.out = n.col)
  indx <- seq(2, length(ordr), 2)
  ordr[indx] <- ordr[indx] + ceiling(n.col/2)
  clrs <- clrs[ordr]
  return(clrs)
}

#' Generate shade and tint variants for a base color.
#'
#' \code{gen_shades_tints} returns \code{i/2} shades and \code{i/2} tints
#' of a base color.
#'
#' @param i The number of tints and/or shades to be generated.
#' @param clr The base color to use (hex or named color).
#' @param incl.base Should the base color be part of the generated palette?
#' @return \code{i} variants of a base color.
#'
#' @name gen_shades_tints-deprecated
#' @seealso \code{\link{fantaxtic-deprecated}}
#' @usage gen_shades_tints(i, clr = "#6495ed")
#'
#' @examples
#' gen_shades(3)
#' gen_tints(3)
#' gen_shades_tints(3)
#' gen_shades(3, "blue")
#' gen_tints(3, "blue")
#' gen_shades_tints(3, "blue")
NULL

#' @rdname fantaxtic-deprecated
#' @section gen_shades_tints:
#' For \code{gen_shades_tints}, use \code{\link[ggnested]{nested_palette}} in the ggnested package.
#'
#' @export
gen_shades_tints <- function(i, clr = "#6495ed"){

  .Deprecated(new = "nested_palette")
  if (i == 0){
    return(c())
  }
  if (i == 1){
    return(clr)
  }
  if (i == 2){
    n_tnts <- 2
    n_shds <- 1
    tnts <- gen_tints(n_tnts, clr, incl.base = F)[1]
  } else {
    n_tnts <- ceiling(i/2)
    n_shds <- i - n_tnts
    tnts <- gen_tints(n_tnts, clr, incl.base = F)
  }
  shds <- gen_shades(n_shds, clr, incl.base = T)
  clrs <- c(shds, tnts)
  return(clrs)
}

gen_shades <- function(i, clr = "#6495ed", incl.base = FALSE){
  if (i == 0){
    return(c())
  }
  if (i == 1){
    return(clr)
  }
  clr_rgb <- t(col2rgb(clr))
  shds <- (1 + round(i)):(2 * round(i) + 1)
  shds <- sapply(shds, function(x){
    shd_rgb <- clr_rgb * x / (2 * round(i) + 1)
    shd <- rgb(shd_rgb[1], shd_rgb[2], shd_rgb[3], maxColorValue = 255)
    return(shd)
  })
  if (incl.base){
    return(shds[1:i+1])
  }
  return(shds[1:i])
}

gen_tints <- function(i, clr = "#6495ed", incl.base = FALSE){
  if (i == 0){
    return(c())
  }
  if (i == 1){
    return(clr)
  }
  clr_rgb <- t(col2rgb(clr))
  tnts <- 0:i
  tnts <- sapply(tnts, function(x){
    tnt_rgb <- clr_rgb + (255 - clr_rgb) * x / (round(i) * 1.5)
    tnt <- rgb(tnt_rgb[1], tnt_rgb[2], tnt_rgb[3], maxColorValue = 255)
    return(tnt)
  })
  if (incl.base){
    return(tnts[1:i])
  }
  return(tnts[1:i+1])
}

#' Generate unique labels.
#'
#' This function generates unique labels for an input vector by adding a
#' count to labels of which multiple occurrences are found.
#'
#' @param lbls A vector of labels for which to generate unique names.
#' @param sep_char A (combination of) characters with which to separate labels
#' and their unique counts.
#' @return A factor of unique labels.
#'
#' @name gen_uniq_lbls-deprecated
#' @seealso \code{\link{fantaxtic-deprecated}}
#' @usage gen_uniq_lbls(lbls, sep_char = " ")
#'
#' @examples
#' lbls <- as.character(c("A", "B", "B", "C", "C", "C", "D"))
#' gen_uniq_lbls(lbls)
#' gen_uniq_lbls(lbls, sep_char = "_")
#'
#' #Also works with factors or numerics
#' gen_uniq_lvls(as.factor(lbls))
#' lbls <- as.numeric(c(1, 2, 2, 3, 3, 3, 4))
#' gen_uniq_lbls(lbls)
NULL

#' @rdname fantaxtic-deprecated
#' @section gen_uniq_lbls:
#' For \code{gen_uniq_lbls}, use \code{\link{name_na_taxa}} or \code{\link{label_duplicate_taxa}}.
#'
#' @export
gen_uniq_lbls <- function(lbls, sep_char = " "){

  .Deprecated(new = c("name_na_taxa", "label_duplicate_taxa"))

  lbls <- as.character(lbls)
  lbl_tbl <- as.data.frame(table(lbls))
  dupl <- which(lbl_tbl$Freq > 1)
  names(dupl) <- lbl_tbl$lbls[dupl]
  if(length(dupl) > 0){
    ind <- unlist(sapply(dupl, function(x){
      which(lbls %in% lbl_tbl$lbls[x])
    }))
    lbls_new <- unlist(sapply(dupl, function(x){
      paste(lbl_tbl$lbls[x], 1:lbl_tbl$Freq[x], sep = sep_char)
    }))
    lbls[ind] <- lbls_new
  }
  lbls <- factor(lbls, unique(lbls), ordered = T)
  return(lbls)
}

#' Add names for missing taxon names in phyloseq objects
#'
#' This function adds names for OTUs/ASVs with incomplete taxonomic
#' annotations, i.e. annotation is only available up to a certain
#' taxonomic rank. It replaces \code{NA} values with the lowest
#' available taxonomic annotation for an OTU/ASV and a label indicating
#' that the annotation is unknown. Species can be renamed to genus +
#' species if desired. To avoid downstream problem, it numbers
#' taxa with the same taxonomic annotation but different sequences.
#'
#' @param physeq_obj A phyloseq object with a \code{tax_table}.
#' @param label Label to prepend the taxon name with (default =
#' \code{"Unknown"}).
#' @param other_label The label(s) of samples whose names should not be altered.
#' @param species Generate a 'Genus species' (i.e. 'Escherichia Coli') label
#' for the species level?
#' @param unique_rank The taxonomic rank by which to generate unique labels
#' (added number) if desired (default = \code{"Unannotated"}).
#' @param unique_sep The text character(s) by which to separate the annotation
#' and the unique number (only when \code{!is.null(unique_rank)}).
#'
#' @name namep_taxa-deprecated
#' @seealso \code{\link{fantaxtic-deprecated}}
#' @usage name_taxa(physeq_obj, label = "Unannotated", other_label = NULL, species = FALSE, unique_rank = NULL, unique_sep = " ")
#' @examples
#' data(GlobalPatterns)
#' name_taxa(GlobalPatterns)
#' name_taxa(GlobalPatterns, label = "Unannotated")
NULL

#' @rdname fantaxtic-deprecated
#' @section name_taxa:
#' For \code{name_taxa}, use \code{\link{name_na_taxa}} or \code{\link{label_duplicate_taxa}}.
#'
#' @export
name_taxa <- function(physeq_obj, label = "Unannotated", other_label = NULL, species = FALSE, unique_rank = NULL, unique_sep = " "){

  .Deprecated(new = c("name_na_taxa", "label_duplicate_taxa"))

  #Get the tax table
  tax_tbl <- phyloseq::tax_table(physeq_obj)

  #Store the names
  tax_names <- colnames(tax_tbl)

  #Change any NA value to the lowest available taxonomic
  #annotation of that OTU/ASV
  tax_tbl <- t(apply(tax_tbl, 1, function(x){
    n <- length(x)
    if (sum(is.na(x)) == n){
      tax_ranks <- rep(label, n)
    } else {
      if (sum(is.na(x)) != 0){
        i <- max(which(!is.na(x)))
        rank <- x[i] #The last known rank
        x[which(is.na(x))] <- sprintf("%s %s (%s)", label, rank, names(x)[i])
      } else {
        if (!is.null(other_label)){
          if (sum(other_label %in%  x) > 0){
            tax_ranks <- x
          } else {
            if (species){
              x[n] <- sprintf("%s %s", x[n-1], x[n])
            }
          }
        } else {
          if (species){
            x[n] <- sprintf("%s %s", x[n-1], x[n])
          }
        }
      }
      tax_ranks <- x
      return(tax_ranks)
    }
  }))

  #Generate unique labels, i.e. add a number on the desired taxonomic level
  if (!is.null(unique_rank)){
    ind <- which(colnames(tax_tbl) == unique_rank)
    tax_tbl[,ind] <- as.character(tax_tbl[,ind])
    tax_tbl[,ind] <- as.character(gen_uniq_lbls(tax_tbl[,ind], sep_char = unique_sep))
  }

  #Update the phyloseq object
  phyloseq::tax_table(physeq_obj) <- tax_tbl
  colnames(phyloseq::tax_table(physeq_obj)) <- tax_names
  return(physeq_obj)
}