R/colors.R

In elo2zero/juicystat.vis: Html widgets for juicystat

#' Palette data for the ggthemes package
#'
#' Data used by the palettes in the ggthemes package.
#'
#' @export
juicytheme_data <- {
  ## x to hold value of list as I create it
  x <- list()

  x$juicystat <-
    c(dkgray = rgb(60, 60, 60, max = 255),
      medgray = rgb(210, 210, 210, max = 255),
      ltgray = rgb(240, 240, 240, max = 255),
      red = rgb(255, 39, 0, max = 255),
      blue = rgb(0, 143, 213, max = 255),
      green = rgb(119, 171, 67, max = 255))

  x$hc <- list()
  x$hc$palettes <- list()
  x$hc$palettes$default <- c("#26BD7B","#F82035","#6D33BC","#0B61A4","#FF6D33","#FFED33","#626262")
  x$hc$palettes$primary <- c("#26BD7B","#ADFF9E")
  x$hc$palettes$secondary <- c("#F82035","#F23E3F","#FF7C8A")
  x$hc$bg <- c(default = "#FFFFFF")
  ## Return
  x

}

#' @export
bg_classification <- function(z){
  if( grepl("\\(1\\)", z ) ){return("#ffd700")}
  else if( grepl("\\(2\\)", z ) ){return("#c0c0c0")}
  else if( grepl("\\(3\\)", z ) ){return("#deb887")}
  else if( grepl("\\([4]\\)", z ) ){return("#90ee90")}
  else if( grepl("\\([4-8]\\)", z ) ){return("#cdf2d2")}
  else { return("transparent")}
}

#' @export
color_classification <- function(z){
  if(is.na(z)){return("white")}
  else {return("black")}
}


#' @import formattable
NULL
#' Formatter for formattable
#'
#' Classification formatter for formattable
#'
#' @export
classification_formatter <- {
  formattable::formatter("span",
            style = x ~ style(display = "block",
                              "border-radius" = "4px",
                              "padding-right" = "4px",
                              color = sapply(x,color_classification),
                              "background-color" = sapply(x,bg_classification)),
            x ~ gsub("\\(.+\\)","",x))
}


#' Formatter for formattable
#'
#' Gradient formatter for formattable
#'
#' @export
gradient_green_formatter <- {
  formattable::color_tile("transparent", x$hc$palettes$default[1])
}


#' @export
gradient_red_formatter <- {
  formattable::color_tile("transparent", x$hc$palettes$default[2])
}

#' @export
percent_bar <- function(color = "#ADFF9E") {
  formatter("span",
    style = x ~ style(
      display = "inline-block",
      direction = "rtl",
      "border-radius" = "4px",
      "padding-right" = "2px",
      "background-color" = csscolor(color),
      width = percent(x)
      ),
    x ~ percent(x) )
}