############  Colors  ###############

############ Constants ##############

#This structure contains the different color schemas used in karyoploteR
.karyoploter.colors <- list(
  cytobands=list(
    schemas=list(
      circos=c(gneg="#FFFFFF",
               gpos25="#C8C8C8",
               gpos33="#D2D2D2",
               gpos50="#C8C8C8",
               gpos66="#A0A0A0",
               gpos75="#828282",
               gpos100="#000000",
               gpos="#000000",
               stalk="#647FA4", #repetitive areas
               acen="#D92F27", #centromeres
               gvar="#DCDCDC",
               border="black"),
      only.centromeres=c(gneg="#C8C8C8",
                         gpos25="#C8C8C8",
                         gpos33="#C8C8C8",
                         gpos50="#C8C8C8",
                         gpos66="#C8C8C8",
                         gpos75="#C8C8C8",
                         gpos100="#C8C8C8",
                         gpos="#C8C8C8",
                         stalk="#C8C8C8", #repetitive areas
                         acen="#D92F27", #centromeres
                         gvar="#C8C8C8",
                         border=NA),
      biovizbase=c(gneg = "grey100", stalk = "brown3", acen = "brown4", gpos = "grey0", 
                   gvar = "grey0", gpos1 = "#FFFFFF", gpos2 = "#FCFCFC", gpos3 = "#F9F9F9", 
                   gpos4 = "#F7F7F7", gpos5 = "#F4F4F4", gpos6 = "#F2F2F2", gpos7 = "#EFEFEF", 
                   gpos8 = "#ECECEC", gpos9 = "#EAEAEA", gpos10 = "#E7E7E7", gpos11 = "#E5E5E5", 
                   gpos12 = "#E2E2E2", gpos13 = "#E0E0E0", gpos14 = "#DDDDDD", gpos15 = "#DADADA", 
                   gpos16 = "#D8D8D8", gpos17 = "#D5D5D5", gpos18 = "#D3D3D3", gpos19 = "#D0D0D0", 
                   gpos20 = "#CECECE", gpos21 = "#CBCBCB", gpos22 = "#C8C8C8", gpos23 = "#C6C6C6", 
                   gpos24 = "#C3C3C3", gpos25 = "#C1C1C1", gpos26 = "#BEBEBE", gpos27 = "#BCBCBC", 
                   gpos28 = "#B9B9B9", gpos29 = "#B6B6B6", gpos30 = "#B4B4B4", gpos31 = "#B1B1B1", 
                   gpos32 = "#AFAFAF", gpos33 = "#ACACAC", gpos34 = "#AAAAAA", gpos35 = "#A7A7A7", 
                   gpos36 = "#A4A4A4", gpos37 = "#A2A2A2", gpos38 = "#9F9F9F", gpos39 = "#9D9D9D", 
                   gpos40 = "#9A9A9A", gpos41 = "#979797", gpos42 = "#959595", gpos43 = "#929292", 
                   gpos44 = "#909090", gpos45 = "#8D8D8D", gpos46 = "#8B8B8B", gpos47 = "#888888", 
                   gpos48 = "#858585", gpos49 = "#838383", gpos50 = "#808080", gpos51 = "#7E7E7E", 
                   gpos52 = "#7B7B7B", gpos53 = "#797979", gpos54 = "#767676", gpos55 = "#737373", 
                   gpos56 = "#717171", gpos57 = "#6E6E6E", gpos58 = "#6C6C6C", gpos59 = "#696969", 
                   gpos60 = "#676767", gpos61 = "#646464", gpos62 = "#616161", gpos63 = "#5F5F5F", 
                   gpos64 = "#5C5C5C", gpos65 = "#5A5A5A", gpos66 = "#575757", gpos67 = "#545454", 
                   gpos68 = "#525252", gpos69 = "#4F4F4F", gpos70 = "#4D4D4D", gpos71 = "#4A4A4A", 
                   gpos72 = "#484848", gpos73 = "#454545", gpos74 = "#424242", gpos75 = "#404040", 
                   gpos76 = "#3D3D3D", gpos77 = "#3B3B3B", gpos78 = "#383838", gpos79 = "#363636", 
                   gpos80 = "#333333", gpos81 = "#303030", gpos82 = "#2E2E2E", gpos83 = "#2B2B2B", 
                   gpos84 = "#292929", gpos85 = "#262626", gpos86 = "#242424", gpos87 = "#212121", 
                   gpos88 = "#1E1E1E", gpos89 = "#1C1C1C", gpos90 = "#191919", gpos91 = "#171717", 
                   gpos92 = "#141414", gpos93 = "#121212", gpos94 = "#0F0F0F", gpos95 = "#0C0C0C", 
                   gpos96 = "#0A0A0A", gpos97 = "#070707", gpos98 = "#050505", gpos99 = "#020202", 
                   gpos100 = "#000000", border = "black")
    )
  ),
  chromosomes=list(
    schemas=list(
      "2grays"=c("#888888", "#444444"),
      "2blues"=c("#6caeff", "#2b5d9b"),
      "blackgreen"=c("black", "green"),
      "greengray"=c("#c6ffb7", "#888888"),
      "brewer.set1"=c("#E41A1C", "#377EB8", "#4DAF4A", "#984EA3", "#FF7F00", "#FFFF33", "#A65628", "#F781BF", "#999999"),
      "brewer.set2"=c("#66C2A5", "#FC8D62", "#8DA0CB", "#E78AC3", "#A6D854", "#FFD92F", "#E5C494", "#B3B3B3"),
      "brewer.set3"=c("#8DD3C7", "#FFFFB3", "#BEBADA", "#FB8072", "#80B1D3", "#FDB462", "#B3DE69", "#FCCDE5", "#D9D9D9", "#BC80BD", "#CCEBC5", "#FFED6F"),
      "brewer.pastel1"=c("#FBB4AE", "#B3CDE3", "#CCEBC5", "#DECBE4", "#FED9A6", "#FFFFCC", "#E5D8BD", "#FDDAEC", "#F2F2F2"),
      "brewer.pastel2"=c("#B3E2CD", "#FDCDAC", "#CBD5E8", "#F4CAE4", "#E6F5C9", "#FFF2AE", "#F1E2CC", "#CCCCCC")
    )
  )
  ,
  variants=list(
    schemas=list(
      cell21breast=c("C>A"="#4c64ae",
        "C>G"="#000000",
        "C>T"="#e40611",
        "T>A"="#bf4a96",
        "T>C"="#fbe800",
        "T>G"="#6eb529",
        "other"="#888888")
    )
  ),
  horizon=list(
    schemas=list(
      redblue6=c("#b51010", "#e73131", "#f7ad9c", "#ffffff", "#a5c6de", "#4284c6", "#005aad"),
      bluepurple10=c("#CAE5FF", "#AAD6FF", "#89C6FF", "#AAD6FF", "#CAE5FF", "#AFD2E9", "#9D96B8", "#9a7197", "#886176", "#7C5869"),
      bluegold3=c("#4284c6", "white", "gold"),
      greenorange=c("olivedrab3", "white", "orange2"),
      greenred=c("green", "white", "red"),
      greenblackred=c("green", "black", "red"),
      blueorange=c("deepskyblue", "white", "orangered"),
      blueblackorange=c("deepskyblue", "black", "orangered"),
      purplegreen=c("darkorchid1", "white", "chartreuse3"),
      purpleblackgreen=c("darkorchid1", "black", "chartreuse3")
    )
  )
)


#' getColorSchemas
#' 
#' @description 
#' Return a structure with the color schemas included in karyoploteR
#' 
#' @usage getColorSchemas()
#' 
#' @return
#' A list with the color schemas included in karyoploteR for cytobands,
#' variants, horizons...
#' 
#' @examples
#'  
#' getColorSchemas()
#'  
#' @export getColorSchemas
getColorSchemas <- function() {
  return(.karyoploter.colors)
}


#' plotPalette
#' 
#' @description 
#' Create a plot of the palette.
#' 
#' @details 
#' Creates a simple plot with a rectangle for every color of every palette.
#' cols must be either a vector of colors (in any format accepted by 
#' karyoploteR::"is.color") or a list of such vectors.
#' The names of the list elements will be treated as the palette names, if
#' the list has no names, palettes will be called "Pallete1", "Palette2", ...
#' 
#' @usage plotPalettes(cols, add.color.name=TRUE, border=NA, palette.names.col="black", palette.names.cex=1, palette.names.srt=0, color.names.col="auto", color.names.cex=1, color.names.srt=0, ...)
#' 
#' @param cols (color vector or list of color vectors) The colors to plot
#' @param add.color.name (logical) Wether to add or not the names of the colors, their definition.
#' @param palette.names.col (color) The color of the palette names (defaults to "black")
#' @param palette.names.cex (numeric) The cex value (size) for the palette names (defaults to 1)
#' @param palette.names.srt (numeric) The srt value (rotation) for the palette names (defaults to 0)
#' @param color.names.col (color) The color of the color names. If auto, it will be blak for light colors and white for the dark ones (defaults to "auto")
#' @param color.names.cex (numeric) The cex value (size) for the color names  (defaults to 1)
#' @param color.names.srt (numeric) The srt value (rotation) for the color names (defaults to 0)
#' @param border (color) The color of the border of the palette rectangles. If NA, no border. (defaults to NA)
#' @param ... Any additional plotting parameters
#' 
#' @return
#' nothing
#' 
#' 
#' @examples
#'  
#' plotPalettes(c("red", "blue", "yellow", "green"))
#' palettes <- list("P1"=c("red", "#000000", lighter("gold")), 
#'                  "P2"=c("orchid", "yellow"))
#' plotPalettes(palettes, color.names.col=c("blue", "green", "red"), border="black", color.names.srt=45)
#' plotPalettes(palettes, color.names.col="auto", border="black", color.names.srt=45)
#' 
#' @export plotPalettes
#' 
plotPalettes <- function(cols, add.color.name=TRUE, border=NA, palette.names.col="black", palette.names.cex=1, palette.names.srt=0, color.names.col="auto", color.names.cex=1, color.names.srt=0, ...) {
  if(!is.list(cols)) {
    cols <- list(cols)
  }
  if(any(!unlist(lapply(cols, is.color)))) stop("All elements in cols must be valid colors.")
  
  #Set the palette names if not available
  if(is.null(names(cols))) names(cols) <- paste0("Palette", seq_along(cols))
  
  #create an empty plot
  graphics::plot(x=0, type="n", 
       xlim=c(0, 10*max(unlist(lapply(cols, length)))), ylim=c(0, 10*length(cols)),
       ylab="", xlab="", axes=FALSE, xaxs="i", yaxs="i")
  
  #Add the names of the palettes as y labels
  graphics::axis(2, at = 4+(seq_along(cols)-1)*10, labels=rev(names(cols)), las=2, 
                 lwd = 0, cex=palette.names.cex, col=palette.names.col, srt=palette.names.srt)   
  
  #Plot the palettes as rectangles
  for(npal in seq_along(cols)) {
    pp <- cols[[length(cols) - npal + 1]]
    graphics::rect(xleft=10*(seq_along(pp)-1), xright=8+10*(seq_along(pp)-1), 
         ybottom = (npal-1)*10, ytop = 8+(npal-1)*10, col=pp, border = border, ...)
    if(add.color.name) {
      #if name colors are auto set as: black as default, white for darker colors
      if(length(color.names.col)==1 && color.names.col=="auto") {
        names.col <- rep("black", length(pp))
        names.col[colSums(col2rgb(pp))<100] <- "white"
      } else {
        names.col <- color.names.col
      }
      graphics::text(x=4+10*(seq_along(pp)-1), y=4+(npal-1)*10, 
                     labels=as.character(pp), col=names.col,
                     cex=color.names.cex, srt=color.names.srt)
    }
  }
}

#' lighter
#' 
#' @description 
#' Given a color, return a lighter one
#' 
#' @details 
#' Very simple utility function to create lighter colors. Given a color, it
#' transforms it to rgb space, adds a set amount to all chanels and transforms
#' it back to a color.
#' 
#' @usage lighter(col, amount=150)
#' 
#' @param col (color) The original color. Might be specified as a color name or a "#RRGGBB(AA)" hex color definition.
#' @param amount (integer, [0-255]) The fixed amount to add to each RGB channel (Defaults to 150).
#' 
#' @return
#' A lighter color
#' 
#' @seealso \code{\link{darker}}
#' 
#' @examples
#'  
#' lighter("red")
#' lighter("#333333")
#' lighter(c("red", 3, "#FF00FF"))
#'  
#' @export lighter
#' 

lighter <- function(col, amount=150) {
  #Colors must be specified by name or #RRGGBB(AA)
  if(!all(is.color(col))) stop("All elements in col must be valid colors. Use is.col(col) to check it.")
  if(!methods::is(amount, "numeric") || length(amount)!=1) stop("amount must be a single number")
  if(amount>255 || amount<0) stop("amount must be a number between 0 and 255")
  .lighter <- function(col, amount) {
    if(is.na(col)) return(NA)
    new.col <- ((grDevices::col2rgb(col))+amount)/255
    new.col[new.col[,1]>1,1] <- 1
    return(grDevices::rgb(t(new.col)))  
  }
  
  return(unlist(lapply(col, .lighter, amount)))
}

#' darker
#' 
#' @description 
#' Given a color, return a darker one
#' 
#' @details 
#' Very simple utility function to create darker colors. Given a color, it
#' transforms it to rgb space, adds a set amount to all chanels and transforms
#' it back to a color.
#' 
#' @usage darker(col, amount=150)
#' 
#' @param col (color) The original color. Might be specified as a color name or a "#RRGGBB(AA)" hex color definition.
#' @param amount (integer, [0-255]) The fixed amount to subtract to each RGB channel (Defaults to 150).
#' 
#' @return
#' A darker color
#' 
#' @seealso \code{\link{lighter}}
#' 
#' @examples
#'  
#' darker("red")
#' darker("#333333")
#' darker(c("red", 3, "#FF00FF"))
#'  
#' @export darker
#'

#Given a color, returns a darker one
darker <- function(col, amount=150) {
  #Colors must be specified by name or #RRGGBB(AA)
  if(!all(is.color(col))) stop("All elements in col must be valid colors. Use is.col(col) to check it.")
  if(!methods::is(amount, "numeric") || length(amount)!=1) stop("amount must be a single number")
  if(amount>255 || amount<0) stop("amount must be a number between 0 and 255")
  
  .darker <- function(col, amount) {
    if(is.na(col)) return(NA)
    new.col <- ((grDevices::col2rgb(col))-amount)/255
    new.col[new.col[,1]<0, 1] <- 0
    return(grDevices::rgb(t(new.col)))
  }
  
  return(unlist(lapply(col, .darker, amount)))
}


#' transparent
#' 
#' @description 
#' Given a color, return a transparent one
#' 
#' @details 
#' Very simple utility function to create transparent colors. Given a color, it
#' transforms it to rgb space, adds a set amount to all chanels and transforms
#' it back to a color.
#' 
#' @usage transparent(col, amount=0.5)
#' 
#' @param col (color) The original color. Might be specified as a color name or a "#RRGGBB(AA)" hex color definition.
#' @param amount (number, [0-1]) The amount of transparency. 0 for completely visible, 1 for completely transparent. (Defaults to 0.5).
#' 
#' @return
#' A transparent color
#' 
#' @seealso \code{\link{lighter}}
#' 
#' @examples
#'  
#' transparent("red")
#' transparent("#333333")
#'  
#' @export transparent
#' @importFrom grDevices adjustcolor

#Given a color, returns a transparent one
transparent <- function(col, amount=0.5) {
  #Colors must be specified by name or #RRGGBB(AA)
  if(!methods::is(col, "character")) stop("Unknown color definition.")
  if(!methods::is(amount, "numeric") || length(amount)!=1) stop("amount must be a single number")
  if(amount>1 || amount<0) stop("amount must be a number between 0 and 1")
  
  transp.col <- grDevices::adjustcolor(col, alpha.f = (1-amount))
  transp.col[is.na(col)] <- NA
  return(transp.col)
}



#' colByChr
#' 
#' @description 
#' Given a set of data elements, return a color for each one based on their chromosome
#' 
#' @details 
#' Returns a color for each data element based on its chromosome. The returned colors might
#' com from one of the predefined color sets or passed in as a parameter.
#' 
#' If \code{colors} is the name of one of the available color sets, it the color set is used. 
#' If it's a named character vector with the chromosome as names, they will be assigned by name
#' and any missing chromosome will be \code{default.col}. If it's a non-named chraracter vector,
#' will be used in order and recycled if necessary.
#' 
#' Data might be either a GRanges object or a vector of chromosomes.
#' 
#' @usage colByChr(data, colors="2grays", all.chrs=NULL, default.col="black")
#' 
#' @param data Either a vector of characters or a GRanges object
#' @param colors The name of a color set ("2grays", "blackgreen", "rainbow"...) or a vector of colors. If the vector is named, names are expected to be the chromosome names. (defaults to "2grays")
#' @param all.chrs A vector with all possible chromosomes. If NULL, the list will be extracted from data (using seqlevels if available). (defaults to NULL)
#' @param default.col The default color to return when something is unavailable
#' 
#'
#' @return
#' A vector of colors
#'
#' @note 
#' Available color.sets:
#' "2grays"=c("#888888", "#444444"),
#' "2blues"=c("#6caeff", "#2b5d9b")
#' "blackgreen"=c("black", "green"),
#' "greengray"=c("#c6ffb7", "#888888"),
#' "brewer.set1"=c("#E41A1C", "#377EB8", "#4DAF4A", "#984EA3", "#FF7F00", "#FFFF33", "#A65628", "#F781BF", "#999999")
#' "brewer.set2"=c("#66C2A5", "#FC8D62", "#8DA0CB", "#E78AC3", "#A6D854", "#FFD92F", "#E5C494", "#B3B3B3")
#' "brewer.set3"=c("#8DD3C7", "#FFFFB3", "#BEBADA", "#FB8072", "#80B1D3", "#FDB462", "#B3DE69", "#FCCDE5", "#D9D9D9", "#BC80BD", "#CCEBC5", "#FFED6F")
#' "brewer.pastel1"=c("#FBB4AE", "#B3CDE3", "#CCEBC5", "#DECBE4", "#FED9A6", "#FFFFCC", "#E5D8BD", "#FDDAEC", "#F2F2F2"),
#' "brewer.pastel2"=c("#B3E2CD", "#FDCDAC", "#CBD5E8", "#F4CAE4", "#E6F5C9", "#FFF2AE", "#F1E2CC", "#CCCCCC"),
#' "rainbow"=rainbow(n=length(all.chrs))
#'   
#' @seealso \code{\link{kpPoints}}
#' 
#' @examples
#' 
#' chrs <- c("chr1", "chr2", "chr2", "chr1", "chr5")
#' points <- toGRanges(paste0("chr", c(1:22, "X", "Y")), rep(10e6, 24), rep(10e6, 24))
#' 
#' colByChr(chrs)
#' colByChr(points)
#' 
#' kp <- plotKaryotype(plot.type=4, labels.plotter=NULL, ideogram.plotter=NULL)
#' kpAddChromosomeNames(kp, srt=45)
#' kpAddChromosomeSeparators(kp)
#' 
#' total.tracks <- 6
#' 
#' kpPoints(kp, points, col=colByChr(points), y=0.5, cex=1, r0=autotrack(1,total.tracks)$r0, r1=autotrack(1,total.tracks)$r1)
#' colors <- NULL
#' kpPoints(kp, points, y=0.5, col=colByChr(points, colors=colors), cex=1, r0=autotrack(2,total.tracks)$r0, r1=autotrack(2,total.tracks)$r1)
#' colors <- c("red", "blue")
#' kpPoints(kp, points, y=0.5, col=colByChr(points, colors=colors), cex=1, r0=autotrack(3,total.tracks)$r0, r1=autotrack(3,total.tracks)$r1)
#' colors <- c(chr1="red", chr7="blue")
#' kpPoints(kp, points, y=0.5, col=colByChr(points, colors=colors), cex=1, r0=autotrack(4,total.tracks)$r0, r1=autotrack(4,total.tracks)$r1)
#' kpPoints(kp, points, y=0.5, col=colByChr(points, colors=colors, default.col="green"), cex=1, r0=autotrack(5,total.tracks)$r0, r1=autotrack(5,total.tracks)$r1)
#' colors <- c("red", "yellow", 3, "orchid", "blue")
#' kpPoints(kp, points, y=0.5, col=colByChr(points, colors=colors), cex=1, r0=autotrack(6,total.tracks)$r0, r1=autotrack(6,total.tracks)$r1)
#' 
#' #Color sets
#' pp <- getDefaultPlotParams(plot.type=4)
#' pp$leftmargin <- 0.2
#' kp <- plotKaryotype(plot.type=4, labels.plotter=NULL, ideogram.plotter=NULL, plot.params=pp)
#' kpAddChromosomeNames(kp, srt=45)
#' kpAddChromosomeSeparators(kp)
#' 
#' color.sets <- c( "2grays", "2blues", "blackgreen", "greengray", "brewer.set1",
#'                    "brewer.set2", "brewer.set3", "brewer.pastel1", "brewer.pastel2", "rainbow" )
#' total.tracks <- length(color.sets)
#' for(i in seq_len(length(color.sets))) {
#'     kpPoints(kp, points, y=0.5, col=colByChr(points, colors=color.sets[i]), cex=1, r0=autotrack(i,total.tracks)$r0, r1=autotrack(i,total.tracks)$r1)
#'     kpAddLabels(kp, labels=color.sets[i], cex=0.7, r0=autotrack(i,total.tracks)$r0, r1=autotrack(i,total.tracks)$r1)
#' }
#' 
#' @export colByChr
#' @importFrom grDevices rainbow
#'

colByChr <- function(data, colors="2grays", all.chrs=NULL, default.col="black") {
  #Process data
  chrs <- NULL
  if(is.character(data)) {
    chrs <- data
  } else { #It's not a vector of chromosomes, try to extract them for other typical objects
    #GRanges
    chrs <- tryCatch(as.character(seqnames(data)), error=function(e) {return(NULL)})
    #TODO: VCF (we'll need to odepend on variant annotation)
    #if(is.null(chrs)) chrs <- tryCatch(as.character(seqnames(rowRanges(data))), error=function(e) {return(NULL)})
    #TODO: Summarized Experiment?
  }
  
  if(is.null(chrs)) {
    stop("Unknown data type passed to colByChr.")
  }
  
  #Try to get the chromosomes "in the right order" if possible
  if(is.null(all.chrs)) {
    all.chrs <- tryCatch(as.character(seqlevels(data)), error=function(e) {return(NULL)})
    if(is.null(all.chrs)) { #If it's not been possible, just get them in any order
      all.chrs <- unique(chrs)
    }
  }
  
  #Process color
  cols <- NULL
  if(!is.null(colors)) {
    color.sets <- .karyoploter.colors$chromosomes$schemas
    #And add rainbow, which depends on the number of chromosomes
    color.sets[["rainbow"]] <- rainbow(n=length(all.chrs))

    if(is.character(colors) && length(colors)==1L && colors %in% names(color.sets)) { #Name of a color set
      colors <- color.sets[[colors]]
    } 
    
    #Named color vector
    if(!is.null(names(colors))) {
      missing.chrs <- all.chrs[!(all.chrs %in% names(colors))] 
      cols <- c(colors, setNames(rep(default.col, length(missing.chrs)), missing.chrs))
    } else {
      cols <- setNames(rep(colors, length = length(all.chrs)), all.chrs)
    }   
  }
  if(is.null(cols)) cols <- setNames(rep(default.col, length(all.chrs)), all.chrs)
  
  #We now have chrs and cols, return thee colors per chromosome
  return(cols[chrs])
}




#' colByRegion
#' 
#' @description 
#' Given a set of data elements, return a color for each one based on whether 
#' they overlap a given set of regions. This might be useful, for example,  to
#' set a different color for data points overlapping a certain region of
#' interest.
#' 
#' @details 
#' Given a set of data elements, return a color for each one based on whether 
#' they overlap a given set of regions. The colors might be different for each
#' region and can be specified either in the regions object itself or in 
#' a separate \code{colors} parameter. If specified in \code{colors}, the values
#' will be recycled as needed. Data points not in the specified region can
#' take either a default color or keep their "original.color" if given. This
#' is useful when using colByRegion to highlight data points as in 
#' kpPlotManhattan.
#' 
#' 
#' @usage colByRegion(data, regions, colors=NULL, original.colors=NULL, default.col="black")
#' 
#' @param data Either a vector of characters or a GRanges object
#' @param regions (GRanges or equivalent) A set of regions where the color will be modified. Internally it will be converted into a Genomic Ranges object by \code{\link[regioneR]{toGRanges}} (from regioneR package) and so it can be either a GRanges, a data.frame, a character or any other value type accepted by that function. If \code{colors} is NULL (the default) and regions has additional columns in addition to chr, start and end, if any has a name in c("color", "colors", "col", "cols") it will be used. Otherwise the first additional column will be used.
#' @param colors (color) The colors to be used for each region. The content will be recycled if needed. If NULL, the colors are assumed to be available in the regions object. (defaults to NULL)
#' @param original.colors (color vector) The original colors of the data points. They will be use instead of the default color for data points not overlapping the regions. If NULL, the default color will be used. (defaults to NULL)
#' @param default.col The default color to return for data elements not overlapping the regions. Only used if original.colors is NULL (defaults to "black")
#' 
#'
#' @return
#' A vector of colors
#'
#' @seealso \link{kpPoints}, \link{colByChr}, \link[regioneR]{toGRanges}
#' 
#' @examples
#' 
#' data <- toGRanges("chr1", c(1e6*1:245), c(1e6*1:245)+10)
#' data$y <- rnorm(n = length(data), mean = 0.5, sd = 0.15)
#' 
#' regions <- toGRanges(c("chr1:10e6-20e6", "chr1:100e6-150e6"))
#' regions$col <- c("red", "blue")
#' 
#' kp <- plotKaryotype(chromosomes="chr1")
#' kpPoints(kp, data=data, r0=0, r1=0.2)
#' kpPoints(kp, data=data, r0=0.2, r1=0.4, col=colByRegion(data, regions = regions) )
#' kpText(kp, data=data, r0=0.4, r1=0.6, col=colByRegion(data, regions = regions), label="A", cex=0.5 )
#' kpBars(kp, data=data, y0=0, y1=data$y, r0=0.6, r1=0.8, border=colByRegion(data, regions = regions))
#' #It might not work wor objects where R expects a single color such as lines. Segments should be used instead
#' kpLines(kp, data=data, r0=0.8, r1=1, col=colByRegion(data, regions = regions) )
#' 
#' 
#' kp <- plotKaryotype(chromosomes="chr1")
#' kpPoints(kp, data=data, r0=0, r1=0.25)
#' kpPoints(kp, data=data, r0=0.25, r1=0.5, col=colByRegion(data, regions = regions, colors="green") )
#' kpText(kp, data=data, r0=0.5, r1=0.75, col=colByRegion(data, regions = regions, color=c("gray", "gold")), label="A", cex=0.5 )
#' kpBars(kp, data=data, y0=0, y1=data$y, r0=0.75, r1=1, border=colByRegion(data, regions = regions))
#' 
#' @export colByRegion
#'
#' @importFrom  GenomeInfoDb seqlevelsStyle

colByRegion <- function(data, regions, colors=NULL, original.colors=NULL, default.col="black") {
  data <- toGRanges(data)
  
  regions <- toGRanges(regions)
  
  #Get the colors if needed
  if(is.null(colors)) {
    #Get the color from the regions GRanges
    if(length(mcols(regions))>0) {
      colors.column <- which(names(mcols(regions)) %in% c("color", "colors", "col", "cols"))[1]
      #if no column has a valid name, use the first one
      if(is.na(colors.column)) colors.column <- 1
      colors <- mcols(regions)[,colors.column]
    }
  } else {
    colors <- rep(colors, length.out=length(regions))
  }
  
  if(!all(is.color(colors))) { stop("A valid color specification is needed. Either as a column of regions or in the 'colors' parameter") }
  
  #Make regions and data comparable
  #WARNING: We are doing this here but nowhere else in the package. Should we?
  GenomeInfoDb::seqlevelsStyle(regions) <- GenomeInfoDb::seqlevelsStyle(data)
  
  #Assign everything the default color and then change it for the data
  #overlapping the regions
  cols <- rep(default.col, length(data))
  for(num.reg in seq_len(length(regions))) {
    cols[overlapsAny(data, regions[num.reg])] <- colors[num.reg]
  }
  
  return(cols)
}


#' colByValue
#' 
#' @description 
#' Given a set of values, return a color for each of them based on their numeric
#' value.
#' 
#' @details 
#' A color ramp (similar to a gradient) will be built using the colors in the 
#' `colors` parameter using \code{\link[grDevices]{colorRamp}}.
#' Values will be normalized to [0,1] using `min` and `max`
#' (if NULL, min(value) will be 0 and max(value) will be 1) and these values
#' will be used to determine the color. It uses 
#' 
#' @note Alpha values (transparency) are also used in the color computation
#' (see examples)
#' 
#' @usage colByValue(value, colors, min=NULL, max=NULL) 
#' 
#' @param value A vector of numeric values
#' @param colors (color) The colors to built the color ramp. Refer to \code{\link[grDevices]{colorRamp}} for more details.
#' @param min (NULL or numeric) The min value used to normalize the values. If NULL, min(value) will be used. (defaults to NULL)
#' @param max (NULL or numeric) The max value used to normalize the values. If NULL, max(value) will be used. (defaults to NULL)
#' 
#'
#' @return
#' A vector of colors
#'
#' @seealso \link{kpPoints}, \link{colByChr}
#' 
#' @examples
#' 
#' colByValue(c(0,0.25,0.5,0.75,1), colors=c("red", "green"))
#' colByValue(c(0,0.25,0.5,0.75,1), colors=c("#00000000", "#00000011"))
#' 
#' data <- toGRanges("chr1", c(1e6*1:245), c(1e6*1:245)+10)
#' data$y <- rnorm(n = length(data), mean = 0.5, sd = 0.15)
#' 
#' kp <- plotKaryotype(chromosomes="chr1")
#' kpPoints(kp, data=data, r0=0, r1=0.3)
#' kpPoints(kp, data=data, r0=0.35, r1=0.65, col=colByValue(data$y, colors=c("black", "green")) )
#' kpPoints(kp, data=data, r0=0.7, r1=1, col=colByValue(data$y, colors=c("black", "green"), min=0.4, max=0.6))
#' 
#' kp <- plotKaryotype(chromosomes="chr1")
#' kpPoints(kp, data=data, r0=0, r1=0.3, col=colByValue(data$y, colors=c("#00000000", "#000000FF")))
#' kpPoints(kp, data=data, r0=0.35, r1=0.65, col=colByValue(data$y, colors=c("black", "orange", "green")) )
#' kpPoints(kp, data=data, r0=0.7, r1=1, col=colByValue(data$y, colors=c("red", "#00000022","#00000022", "green"),min=0.4, max=0.6))
#
#' 
#' @export colByValue
colByValue <- function(value, colors, min=NULL, max=NULL) {
  if(!is.numeric(value)) stop("value must be numeric")
  if(!all(is.color(colors))) stop("colors must be  a vector of valid colors")
  if(length(colors)<2) stop("at least 2 colors are required")
  if(is.null(min) && is.null(max) && length(value)<2) stop("if min and max are NULL, at least two values are needed")
  
  if(is.null(min)) min <- min(value)
  if(is.null(max)) max <- max(value)
  norm.value <- (value - min)/(max-min)
  norm.value[norm.value<0] <- 0
  norm.value[norm.value>1] <- 1
  ramp <- grDevices::colorRamp(colors, alpha=TRUE)
  cols <- ramp(norm.value)/255
  cols <- grDevices::rgb(cols, alpha = cols[,4])
  return(cols)
}


#' colByCategory
#' 
#' @description 
#' Given a vector of categorical values, assign a color to each one bases on 
#' its category
#' 
#' @details 
#' The vector of values will be first transformed into a factor (if it's not
#' already a factor) and then colors will be selected from the palette in the
#' order defined by the factor levels. If more colors than the ones available in
#' the palette are needed, they will be reused. If the color vector is named 
#' using the factor levels and all levels are included, the link bewteen
#' levels and colors will be honored.
#' If the color palette is set to "auto", it will create a palette using 
#' "rainbow".
#' 
#' @usage colByCategory(categories, colors) 
#' 
#' @param categories A vector of categories. Will be transformed into a factor if it's not one (if characters, integers, etc...)
#' @param colors (color vector, possibly named) The colors to to use for the different categories. If "auto", a rainbow palette will be used. (defaults to "auto")
#' 
#'
#' @return
#' A vector of colors of the same length as value
#'
#' @seealso \link{kpAddColorRect}, \link{colByValue}
#' 
#' @examples
#' 
#' colByCategory(c("A", "A", "C", "A", "C", "B"))
#' #The order of the colors is defined by the order of the factor, not the "natural order" of the elements
#' colByCategory(c("A", "A", "C", "A", "C", "B"), colors=c("red", "green", "blue"))
#' #integer categories plus reuse of colors
#' colByCategory(categories=c(3,3,1,2,1,4,2,3,2,1), colors=c("red", "green", "blue"))
#' 
#' @export colByCategory

colByCategory <- function(categories, colors="auto") {
  if(!is.factor(categories)) {
    categories <- tryCatch(as.factor(categories), error=function(e) {stop("Could not transform categories into a factor. ", e)})
  }
  
  if(length(colors)==1 && colors=="auto") {
    colors <- rainbow(length(levels(categories)))  
  }
  if(!all(is.color(colors))) stop('colors must be  a vector of valid colors or "auto"')
  
  if(length(colors)<length(levels(categories))) colors <- recycle.first(colors, levels(categories))
  if(is.null(names(colors)) || !all(levels(categories) %in% names(colors))) {
    names(colors) <- levels(categories)
  }
  return(colors[categories])
}




#' is.color
#' 
#' @description 
#' Test if something is a valid color
#' 
#' @details 
#' This function tests if something is a valid color. Returns TRUE or FALSE. 
#' The function is vectorised. 
#' 
#' 
#' @usage is.color(x)
#' 
#' @param x The element to test
#' 
#' @return
#' TRUE is x is a valid color, FALSE otherwise
#' 
#' 
#' @examples
#'  
#' is.color("red")
#' is.color("#333333")
#' is.color(NA)
#' is.color(NULL)
#' is.color("not_a_color")
#' is.color(3)
#' 
#' is.color(c("not_a_color", "red", 3, "#FF0000"))
#'  
#' @export is.color
#' 
#' @importFrom grDevices col2rgb
#' 
#'
# Adapted from https://stackoverflow.com/questions/13289009/check-if-character-string-is-a-valid-color-representation

is.color <- function(x) {
  if(is.null(x)) return(FALSE)
  return(setNames(vapply(x, function(X) {
    tryCatch(is.matrix(grDevices::col2rgb(X)), 
             error = function(e) FALSE)
  },
  FUN.VALUE = TRUE), NULL))
}






#TODO: Document and export?

#Preprocess col and border to assign one based on the other if any is NULL
preprocessColors <- function(col=NULL, border=NULL, default.col="gray70", amount=100) {
  #If both NULL, return the default values
  if(is.null(col) && is.null(border)) {
    return(list(col=default.col, border=darker(default.col, amount = amount)))
  }
  
  if(is.null(border)) {
    if(all(is.na(col))) {
      border <- darker(default.col, amount = amount)
    } else {
      border <- darker(col, amount = amount)
    }
  }
  
  if(is.null(col)) {
    if(all(is.na(border))) {
      col <- default.col
    } else {
      col <- lighter(border, amount = amount)
    }
  }
  

  return(list(col=col, border=border))
}








############################# Function specific color seleectors ##############################
#' horizonColors
#' 
#' @description 
#' Returns the color structure needed by kpPlotHorizon
#' 
#' @details 
#' This function transforms an array of colors into a list of colors 
#' **internally** needed by kpPlotHorizon: a list with two elements, "neg" 
#' and "pos", each an array of colors of length num.parts. If col is 
#' a character of length one, it is interpreted as the name of a color scheme.
#' 
#' 
#' horizonColors(col, num.parts) 
#' 
#' @param col (array of colors) An array of colors
#' @param num.parts (positive integer) The number of colors to generate for pos and neg
#' 
#' @return
#' A list with 2 elements, pos and neg, each with num.parts colors
#' 
#' 
#' @examples
#'  
#' horizonColors("redblue6", 3)
#' horizonColors("redblue6", 6)
#' horizonColors("bluegold3", 2)
#' horizonColors(c("red", "blue"), 3)
#' horizonColors(c("red", "#FFFFFF00", "blue"), 3)
#'  
#' @export horizonColors
#' @importFrom grDevices colorRamp
#' 
horizonColors <- function(col, num.parts) {
  if(is.character(col) && length(col)==1) col <- .karyoploter.colors$horizon$schemas[[col]]
  ramp <- grDevices::colorRamp(col, alpha=TRUE)
  num.cols <- num.parts*2
  cols <- ramp(1/(num.cols)*c(0:num.cols))/255
  cols <- grDevices::rgb(cols, alpha = cols[,4])
  return(list(neg=rev(cols[1:num.parts]),
              pos=cols[(num.parts+2):(2*num.parts+1)]
  ))
}
