version 0.0.2

DESCRIPTION

@@ -0,0 +1,34 @@
+Package: palette
+Title: Color Scheme Helpers
+Version: 0.0.2
+Authors@R: 
+    person(given = "Christopher T.",
+           family = "Kenny",
+           role = c("aut", "cre"),
+           email = "christopherkenny@fas.harvard.edu",
+           comment = c(ORCID = "0000-0002-9386-6860"))
+Description: Hexadecimal codes are typically used to represent colors in R.
+    Connecting these codes to their colors requires practice or memorization.
+    'palette' provides a 'vctrs' class for working with color palettes, including
+    printing and plotting functions. The goal of the class is to place visual
+    representations of color palettes directly on or, at least, next to their
+    corresponding character representations. Palette extensions also are provided
+    for data frames using 'pillar'.
+License: MIT + file LICENSE
+Encoding: UTF-8
+RoxygenNote: 7.3.1
+URL: https://github.com/christopherkenny/palette,
+        https://christophertkenny.com/palette/
+BugReports: https://github.com/christopherkenny/palette/issues
+Imports: cli, pillar, vctrs
+Suggests: ggplot2, spelling, testthat (>= 3.0.0), vdiffr
+Config/testthat/edition: 3
+Language: en-US
+Depends: R (>= 3.5)
+NeedsCompilation: no
+Packaged: 2024-03-14 17:07:36 UTC; chris
+Author: Christopher T. Kenny [aut, cre]
+    (<https://orcid.org/0000-0002-9386-6860>)
+Maintainer: Christopher T. Kenny <christopherkenny@fas.harvard.edu>
+Repository: CRAN
+Date/Publication: 2024-03-15 10:40:02 UTC

LICENSE

@@ -0,0 +1,2 @@
+YEAR: 2024
+COPYRIGHT HOLDER: palette authors

MD5

@@ -0,0 +1,51 @@
+15f0daaea802746a701874fec8fed0fa *DESCRIPTION
+3f71c0e2bd93f64e2a395fb27aaa1bef *LICENSE
+8dd9925ee74b4437236fa26c773c472c *NAMESPACE
+49d21d05c466bfab8a26b73a897082a2 *NEWS.md
+19c8dc14939eb370792a7c9246303051 *R/cast.R
+67371ad393bd129c64d22974f7899fc5 *R/coerce.R
+7f51a6133b1c7974a69a57a27107330f *R/data.R
+91b1fb77bad69ee4ba2f548b4c46f54d *R/format.R
+22bcd8ab9309cad3724fb54175108b4a *R/palette-package.R
+f9509796afaa83645984af65bf80a60f *R/palette.R
+f1ffd3bd6ace4c7ef22ef11c8b10e2be *R/palette_function.R
+3cdad17eef9d79397e53df0eab5f95cd *R/plot.R
+12cea7133b4e000d9a365379d537107d *R/sysdata.rda
+5f1898a2932a9c2a48a47416000cf68f *R/url.R
+53f76315fde1f3da6f53f76182db245c *R/utils.R
+573957f1b59c1dfad97ac0e0957052c7 *README.md
+ad57d26a7bf1c5e6a833d4e947fe1294 *inst/CITATION
+5ca87040a5ac2edc8319f71c3d55b115 *inst/WORDLIST
+b55b9a96f25459edf382d5cfd1d9cc97 *man/figures/README-pillar.png
+9294fa2e21361d0d13a04478874058a4 *man/figures/README-plot-1.png
+94b0e55ed117ad1144599d9d704ff17a *man/figures/README-print.png
+bdcb8e34a1a64023ae9cde877aeb2916 *man/figures/logo.png
+34c3bf6629aeb5f468f1844d03376ab0 *man/palette-package.Rd
+739c3eb1e1e91d3ab1f4b58cf49b0cf7 *man/palette-vctrs.Rd
+f6be25cc97824437da6e2751a6b6f928 *man/palette.Rd
+920c9a57be3e64637dc72b2863d436ea *man/palette_browse.Rd
+d1997e3acdc09b3dd1a034592a99a23c *man/palette_decode_url.Rd
+9e2740fa89042d35cc724dc6a9b17096 *man/palette_function.Rd
+08d55a54b2bf62c5a31f6ed324c3c090 *man/plot_palette.Rd
+cc5c3ce0d0455c991d355542df6c2ebd *man/roygbiv.Rd
+911b413615919f4bf562a827ab516783 *man/vec_cast.palette.Rd
+3bb7e705ebf6ea615f6bd67f5f4b08e3 *man/vec_ptype2.palette.Rd
+332173f20d20942c02019350ea4dcadc *tests/spelling.R
+875f30778f9ba98ec2ab37a2a5fafd08 *tests/testthat.R
+bbce3f121398a922f1fb0d54dd6ced25 *tests/testthat/_snaps/plot/plot-palette-base.svg
+7ec5b0d0c5a0c351ae46d6dc95426bdc *tests/testthat/_snaps/plot/plot-palette-ggplot.svg
+a1aab492679e3b4e07b5ab9619d0a1b1 *tests/testthat/output-pillar-na.txt
+e4872dca46545741b1fe94e496a7d103 *tests/testthat/output-pillar.txt
+35464712e3a9facdb0d8f5f3c48b0d06 *tests/testthat/output-print-empty.txt
+2c2538b3d0c5824e971303e4ce4d177d *tests/testthat/output-print-na.txt
+bb107ab0decef9bd1e034cd16bc530e1 *tests/testthat/output-print-named.txt
+44d6dfeef0e634ec8cd3532d03084cc6 *tests/testthat/output-print-overflow.txt
+18f95b66c16a3a05905678ae17ecde8c *tests/testthat/output-print.txt
+2a8b2b51818a5a039cc3fca575eca4b8 *tests/testthat/setup.R
+cfcd953e59614c3467f0b0dbc74e96b3 *tests/testthat/test-cast.R
+88efd5256448573bc217e721d1a413e9 *tests/testthat/test-coerce.R
+647833e5606421d794dee6efa00d5758 *tests/testthat/test-format.R
+a92b57297a25565044bbb5e0e7a264c7 *tests/testthat/test-palette.R
+d472bd0a0b1e802ab985f3f12f513039 *tests/testthat/test-palette_function.R
+f447a6dd39be923b97e8f14e2ce3693b *tests/testthat/test-plot.R
+420c7fa97b0e92d333befd00bf5ef8e9 *tests/testthat/test-url.R

NAMESPACE

@@ -0,0 +1,31 @@
+# Generated by roxygen2: do not edit by hand
+
+S3method(format,palette)
+S3method(obj_print_data,palette)
+S3method(pillar_shaft,palette)
+S3method(plot,palette)
+S3method(vec_cast,palette)
+S3method(vec_cast.character,palette)
+S3method(vec_cast.palette,character)
+S3method(vec_cast.palette,default)
+S3method(vec_ptype2,palette)
+S3method(vec_ptype2.character,palette)
+S3method(vec_ptype2.palette,character)
+S3method(vec_ptype2.palette,default)
+S3method(vec_ptype2.palette,palette)
+S3method(vec_ptype_abbr,palette)
+S3method(vec_ptype_full,palette)
+export(as_palette)
+export(is_palette)
+export(palette)
+export(palette_browse)
+export(palette_browse_url)
+export(palette_decode_url)
+export(palette_function)
+export(plot_palette)
+export(roygbiv)
+export(validate_palette)
+export(vec_cast.palette)
+export(vec_ptype2.palette)
+import(vctrs)
+importFrom(pillar,pillar_shaft)

NEWS.md

@@ -0,0 +1,13 @@
+# palette 0.0.2
+
+* Minor documentation fixes for CRAN resubmission.
+
+# palette 0.0.1
+
+* Initial CRAN submission.
+* Implements `palette` class with support for:
+  - `palette` vectors can be plotted using `plot()`.
+  - `palette` vectors have pretty printing in the console.
+  - `palette` vectors in `tibble`s have `pillar` methods for color display.
+* Adds a `palette_function()` generator to use `palette`s within `ggplot2` discrete scales.
+* Implements testing with `testthat` and `vdiffr`.

R/cast.R

@@ -0,0 +1,27 @@
+#' Palette Casting
+#'
+#' Dispatch methods for [vctrs::vec_cast()]
+#'
+#' @inheritParams vctrs::vec_cast
+#'
+#' @return a vector of the same length, as class `palette` if convertible, otherwise `character`
+#'
+#' @keywords internal
+#' @method vec_cast palette
+#' @export
+#' @export vec_cast.palette
+vec_cast.palette <- function(x, to, ...) {
+  UseMethod('vec_cast.palette')
+}
+
+#' @method vec_cast.palette default
+#' @export
+vec_cast.palette.default <- function(x, to, ...) vec_default_cast(vec_data(x), to, ...)
+
+#' @method vec_cast.palette character
+#' @export
+vec_cast.palette.character <- function(x, to, ...) palette(x)
+
+#' @method vec_cast.character palette
+#' @export
+vec_cast.character.palette <- function(x, to, ...) vec_data(x)

R/coerce.R

@@ -0,0 +1,39 @@
+#' Palette Coercion
+#'
+#' Coercion methods for [vctrs::vec_ptype2()]
+#'
+#' @inheritParams vctrs::vec_ptype2
+#'
+#' @return a vector of the same length, as class `palette` if convertible, otherwise `character`
+#'
+#' @keywords internal
+#' @method vec_ptype2 palette
+#' @export
+#' @export vec_ptype2.palette
+vec_ptype2.palette <- function(x, y, ...) {
+  UseMethod('vec_ptype2.palette', y)
+}
+
+#' @method vec_ptype2.palette default
+#' @export
+vec_ptype2.palette.default <- function(x, y, ..., x_arg = '', y_arg = '') {
+  vec_default_ptype2(x, y, ..., x_arg = x_arg, y_arg = y_arg)
+}
+
+#' @method vec_ptype2.palette palette
+#' @export
+vec_ptype2.palette.palette <- function(x, y, ...) {
+  new_palette()
+}
+
+#' @method vec_ptype2.palette character
+#' @export
+vec_ptype2.palette.character <- function(x, y, ..., x_arg = '', y_arg = '') {
+  new_palette()
+}
+
+#' @method vec_ptype2.character palette
+#' @export
+vec_ptype2.character.palette <- function(x, y, ..., x_arg = '', y_arg = '') {
+  new_palette()
+}

R/data.R

@@ -0,0 +1,9 @@
+#' Rainbow Colors
+#'
+#' @format character vector of 7 hex codes
+#'
+#' @examples
+#' palette(roygbiv)
+#"
+#' @export
+roygbiv <- c('#FF4444', '#FFAE4D', '#FFFF60', '#50FF50', '#3939FA', '#AB3FFB', '#F68BF6')

R/format.R

@@ -0,0 +1,147 @@
+#' @export
+vec_ptype_abbr.palette <- function(x, ...) {
+  'pal'
+}
+
+#' @export
+vec_ptype_full.palette <- function(x, ...) {
+  'palette'
+}
+
+#' @export
+format.palette <- function(x, ...) {
+  if (length(x) == 0) {
+    return(character())
+  }
+
+  # ifelse(is.na(x), '<NA>', vec_data(x))
+  vec_data(x)
+}
+
+#' @export
+obj_print_data.palette <- function(x, ...) {
+  if (length(x) == 0) {
+    return(invisible(NULL))
+  }
+
+  # format
+  l <- hex_to_luminosity(x)
+  l[is.na(x)] <- NA_real_
+
+  fmt_x <- paste0(' ', format(x), ' ')
+  # out <- character(length(x))
+  # out[is.na(x)] <- '<NA>'
+  # out[l > 0.5] <- cli::col_black(cli::make_ansi_style(x[!is.na(x) & l > 0.5], bg = TRUE)(fmt_x[l > 0.5]))
+  # out[l <= 0.5] <- cli::col_white(cli::make_ansi_style(x[!is.na(x) & l <= 0.5], bg = TRUE)(fmt_x[l <= 0.5]))
+  bg_fns <- stats::setNames(
+    lapply(unique(stats::na.omit(x)), function(col) {cli::make_ansi_style(col, bg = TRUE)}),
+    unique(stats::na.omit(x))
+  )
+
+  out <- vapply(
+    seq_along(x),
+    function(i) {
+      if (is.na(x[[i]])) {
+        return('<NA>')
+      }
+      bg_fns[[x[[i]]]](fmt_x[i])
+    },
+    FUN.VALUE = character(1)
+  )
+
+  if (any(!is.na(l) & l > 0.5)) {
+    out[!is.na(l) & l > 0.5] <- cli::col_black(out[!is.na(l) & l > 0.5])
+  }
+  if (any(!is.na(l) & l <= 0.5)) {
+    out[!is.na(l) &l <= 0.5] <- cli::col_white(out[!is.na(l) & l <= 0.5])
+  }
+
+  # setup printing
+  width_console <- cli::console_width()
+  chars <- cli::ansi_nchar(out)
+
+  max_print <- getOption('max.print')
+  if (is.null(max_print)) max_print <- length(out)
+
+  # print
+  row_id <- 1
+  new_row <- TRUE
+
+  if (is.null(vec_names(x))) {
+    len <- min(vec_size(out), max_print)
+    # assumes first row is always able to print once
+    for (i in seq_len(len)) {
+      if (new_row) {
+        cur_char <- chars[i] + 5
+        cat(lpad(paste0('[', row_id, '] '), 5))
+        new_row <- FALSE
+      }
+      cat(paste0(out[[i]], ' '))
+      cur_char <- cur_char + chars[[i]] + 1
+
+      if (i != len && ((cur_char + chars[[i + 1]]) > width_console)) {
+        cat('\n')
+        new_row <- TRUE
+        row_id <- row_id + 1
+      }
+    }
+  } else {
+    len <- max(c(10, cli::ansi_nchar(names(x)))) + 1L
+    n_per <- max(floor(width_console / len), 1)
+
+    i <- 1L
+    for (row in seq_len(ceiling(length(x) / n_per))) {
+      cat('  ')
+
+      for (co in seq_len(n_per)) {
+        if (i + co - 1L <= length(x)) {
+          cat(lpad(names(x)[[i + co - 1L]], len))
+        }
+      }
+      cat('\n  ')
+
+      for (co in seq_len(n_per)) {
+        if (i + co - 1L <= length(x)) {
+          cat(lpad(paste0(' ', out[[i + co - 1L]]), len))
+        }
+      }
+      cat('\n')
+      i <- i + n_per
+    }
+  }
+
+
+  # give a heads up if truncated
+  if (vec_size(out) > max_print) {
+    cat('\n[ reached getOption("max.print") -- omitted', vec_size(out) - max_print, 'entries.]\n')
+  }
+
+  invisible(x)
+}
+
+#' @export
+pillar_shaft.palette <- function(x, ...) {
+
+  l <- hex_to_luminosity(x)
+
+  fmt_x <- paste0(' ', format(x), ' ')
+  out <- vapply(
+    seq_along(x),
+    function(i) {
+      if (is.na(x[[i]])) {
+        return('<NA>')
+      }
+      cli::make_ansi_style(x[[i]], bg = TRUE)(fmt_x[[i]])
+    },
+    FUN.VALUE = character(1)
+  )
+
+  if (any(!is.na(l) & l > 0.5)) {
+    out[!is.na(l) & l > 0.5] <- cli::col_black(out[!is.na(l) & l > 0.5])
+  }
+  if (any(!is.na(l) & l <= 0.5)) {
+    out[!is.na(l) & l <= 0.5] <- cli::col_white(out[!is.na(l) & l <= 0.5])
+  }
+
+  pillar::new_pillar_shaft_simple(out, align = 'center')
+}

R/palette-package.R

@@ -0,0 +1,15 @@
+#' @keywords internal
+#' @aliases palette-package
+"_PACKAGE"
+
+## usethis namespace: start
+#' @importFrom pillar pillar_shaft
+## usethis namespace: end
+NULL
+
+#' Internal vctrs methods
+#'
+#' @import vctrs
+#' @keywords internal
+#' @name palette-vctrs
+NULL