initial commit part 2

.Rbuildignore

@@ -0,0 +1,6 @@
+^.*\.Rproj$
+^\.Rproj\.user$
+^\.travis\.yml$
+^codecov\.yml$
+^README\.Rmd$
+^README-.*\.png$

.gitignore

@@ -14,3 +14,7 @@ vignettes/*.pdf
 
 # OAuth2 token, see https://github.com/hadley/httr/releases/tag/v0.3
 .httr-oauth
+.Rproj.user
+
+.DS_Store
+Rplots.pdf

.travis.yml

@@ -0,0 +1,27 @@
+# R for travis: see documentation at https://docs.travis-ci.com/user/languages/r
+
+
+# Header
+language: r
+sudo: false
+dist: trusty
+cache: packages
+latex: false
+
+
+matrix:
+  include:
+  - r: 3.4.0
+  - r: release
+
+  allow_failures:
+
+repos:
+  CRAN: https://cloud.r-project.org
+  ropensci: http://packages.ropensci.org
+
+r_packages:
+  - covr
+
+after_success:
+  - Rscript -e "library(covr); codecov(line_exclusions = list('R/colorgorical.R'=113:139))"

DESCRIPTION

@@ -0,0 +1,29 @@
+Package: visibly
+Type: Package
+Title: Functions and palettes related to visual enhancement
+Version: 0.1.0
+Authors@R: person("Michael", "Clark", role = c("aut", "cre"), email = "[email protected]")
+Maintainer: Michael Clark <[email protected]>
+Description: Palettes, themes, etc.
+License: MIT + file LICENSE
+Encoding: UTF-8
+LazyData: true
+URL: https://github.com/m-clark/visibly
+BugReports: https://github.com/m-clark/visibly/issues
+Year: 2018
+Depends:
+  R (>= 3.4.0)
+Imports:
+  colortools,
+  magrittr,
+  scales
+Suggests: 
+  colorspace,
+  covr,
+  httr,
+  jsonlite,
+  lazerhawk,
+  ggplot2,
+  plotly,
+  testthat
+RoxygenNote: 6.0.1

LICENSE

@@ -0,0 +1,2 @@
+YEAR: 2018
+COPYRIGHT HOLDER: Michael Clark

NAMESPACE

@@ -0,0 +1,21 @@
+# Generated by roxygen2: do not edit by hand
+
+export(colorgorical)
+export(create_palette)
+export(theme_blank)
+export(theme_plotly)
+export(theme_trueMinimal)
+importFrom(colortools,adjacent)
+importFrom(colortools,complementary)
+importFrom(colortools,pizza)
+importFrom(colortools,splitComp)
+importFrom(colortools,square)
+importFrom(colortools,tetradic)
+importFrom(colortools,triadic)
+importFrom(grDevices,convertColor)
+importFrom(graphics,layout)
+importFrom(graphics,mtext)
+importFrom(graphics,par)
+importFrom(magrittr,'%>%')
+importFrom(scales,alpha)
+importFrom(scales,col2hcl)

NEWS.md

@@ -0,0 +1,6 @@
+# visibly 0.1.0
+
+* Added a `NEWS.md` file to track changes to the package.
+
+
+

R/colorgorical.R

@@ -0,0 +1,140 @@
+#' @title  Create a colorgorical palette
+#' @description An interface for creating palettes from
+#'   \href{http://vrl.cs.brown.edu/color/}{colorgorical}.
+#'
+#' @param n Number of color values to return.
+#' @param perceptualDifference Value from 0 to 1. See details.
+#' @param nameDifference Value from 0 to 1. See details.
+#' @param nameUniqueness Value from 0 to 1. See details.
+#' @param pairPreference Value from 0 to 1. See details.
+#' @param hueFilters  Must be given as an element of a list. See details.
+#' @param lightnessRange See details.
+#' @param startPalette A starting point for the color as a vector of 3 CIE Lab
+#'   values. Must be given as an element of a list. See details.
+#' @param output Character string. Output may be given as LAB, sRGB, or HEX
+#'   values. If 'LAB' or 'sRGB', a matrix of those values where each row
+#'   represents a color. If 'HEX', the default, a character vector of hex values
+#'   is returned.
+#'
+#' @details This function accesses the colorgorical website to create a color
+#'   palette. It requires two other packages to work: \code{httr} and
+#'   \code{jsonlite}, and if you want a hex value, \code{colorspace}.
+#'
+#'   The following are relevant parts from the descriptions at the website.
+#'
+#'   \bold{Perceptual Distance}: Increasing Perceptual Distance favors palette
+#'   colors that are more easily discriminable to the human eye. To accurately
+#'   model human color acuity, this is performed using CIEDE2000 in CIE Lab
+#'   color space.
+#'
+#'   \bold{Name Difference}: Increasing Name Difference favors palette colors
+#'   that share few common names. This is similar to perceptual distance, but
+#'   can lead to different results in certain areas of color space. This happens
+#'   when there are many different names for perceptually close colors (e.g.,
+#'   red and pink are perceptually close but named differently). Colorgorical
+#'   calculates this using Heer and Stone's Name Difference function, which is
+#'   built on top of the XKCD color-name survey.
+#'
+#'   \bold{Pair Preference}: Increasing Pair Preference favors palette colors
+#'   that are, on average, predicted to be more aesthetically preferable
+#'   together. Typically these colors are similar in hue, have different
+#'   lightness, and are cooler colors (blues and greens). Pair Preference is
+#'   based off of Schloss and Palmer's research on color preference.
+#'
+#'   \bold{Name Uniqueness}: Increasing Name Uniqueness favors palette colors
+#'   that are uniquely named. Some colors like red are readily named and are
+#'   favored, whereas other colors are less obviously named and are ignored.
+#'   Like, Name Difference, Name Uniqueness is based on Heer and Stone's
+#'   color-name research.
+#'
+#'   \bold{Select hue filter}: You can limit which colors are selected by either
+#'   dragging over the wheel to select a hue range, or by entering the angles
+#'   manually (e.g., select only reds). You can also make multiple selections
+#'   after one another to select many different hue ranges (e.g., select both
+#'   greens and purples).
+#'
+#'   \bold{Select lightness range}: You can change whether Colorgorical samples
+#'   lighter or darker colors.
+#'
+#'   \bold{Add starting colors}: You can guarantee that certain colors are in
+#'   your palette. Note it is only guaranteed if you have already created a
+#'   palette at the website and start with one of the generated colors.
+#'   Otherwise, it appears to pick something close.
+#'
+#'   NOTE: Because JSON is being used behind the scenes, for \code{hueFilters}
+#'   and \code{startPalette}, the values must be given as a list.
+#'
+#'   For example:
+#'
+#'   \code{hueFilters = list(c(90, 180))}
+#'
+#'   \code{startPalette = list(c(59, 62, 70))}
+#'
+#'   The R code is based on the gist by Kamil Slowikowski found here:
+#'   \href{https://gist.github.com/slowkow/22daea426607416bfcd573ce9cbd89ab}{link}.
+#'
+#' @references
+#'
+#' \href{http://vrl.cs.brown.edu/color/}{The colorgorical website}.
+#'
+#' \href{https://github.com/connorgr/colorgorical}{Original Python source code at
+#' GitHub}.
+#'
+#' @return A character vector of color values in hex form.
+#'
+#' @examples
+#' \dontrun{
+#' colorgorical(n=12, pairPreference = 1, startPalette = list(c(10, -60, 45)))
+#' }
+#'
+#' @importFrom grDevices convertColor
+#'
+#' @export
+colorgorical <- function(n = 10,
+                         perceptualDifference = 0,
+                         nameDifference = 0,
+                         nameUniqueness = 0,
+                         pairPreference = 0,
+                         hueFilters = list(),
+                         lightnessRange = c("25", "85"),
+                         startPalette = list(),
+                         output = 'HEX') {
+
+  weights = c(perceptualDifference, nameDifference, nameUniqueness, pairPreference)
+  lr = as.numeric(lightnessRange)
+  output = tolower(output)  # to accept lowercase
+
+  # basic checks
+  if (any(c(weights > 1, weights < 0))) stop('Invalid weight supplied. All must be between 0 and 1.')
+  if (any(lr > 100 | lr < 0)) stop('Invalid value for lightnessRange supplied. Must be between 0 and 100 (as character string).')
+  if (! output %in% c('lab', 'srgb', 'hex')) stop("Invalid value for output supplied. Must be 'LAB', 'sRGB', or 'HEX'.")
+  if (!is.list(hueFilters) | !is.list(startPalette)) stop('hueFilters and startPalette must be supplied as a list.')
+
+  post_body <- jsonlite::toJSON(auto_unbox = TRUE,
+                                list(
+                                  'paletteSize' = n,
+                                  'weights' = list(
+                                    'ciede2000' = perceptualDifference,
+                                    'nameDifference' = nameDifference,
+                                    'nameUniqueness' = nameUniqueness,
+                                    'pairPreference' = pairPreference
+                                  ),
+                                  'hueFilters' = hueFilters,
+                                  'lightnessRange' = lightnessRange,
+                                  'startPalette' = startPalette
+                                )
+  )
+
+  retval <- httr::POST(url = 'http://vrl.cs.brown.edu/color/makePalette',
+                       body = post_body) %>%
+    httr::content()
+
+  labs = sapply(retval$palette, unlist)
+  if (output == 'lab') return(t(labs))
+
+  rgbs = grDevices::convertColor(t(labs), from = 'Lab', to = 'sRGB')
+  if (output == 'srgb') return(rgbs)
+
+  hex = apply(rgbs, 1, function(x) colorspace::hex(colorspace::sRGB(x[1], x[2], x[3])))
+  return(hex)
+}

R/create_palette.R

@@ -0,0 +1,70 @@
+#' Create a color palette
+#'
+#' @description Uses colortools package (and possibly scales) to easily create a
+#'   color palette based on a initial input color.
+#'
+#' @param colorhex  Hexadecimal value of color or an R color name.
+#' @param name optional name of color
+#' @param toHCL Convert colors to hcl. Defaults to \code{FALSE}.
+#' @param plot Plot the results. Defaults to \code{FALSE}.
+#' @param alpha Transparency. Takes values from 0 to 1. Default is 1.
+#'
+#' @details Will return complementary, analogous/adjacent, split complementary,
+#'   triadic, square and tetradic color values relative to the initial color. Note that if you want sequential, qualitative, diverging etc., other packages like \href{https://cran.rstudio.com/web/packages/colorspace/}{RColorBrewer}, \href{https://cran.rstudio.com/web/packages/colorspace/}{colorspace}, and \href{https://cran.rstudio.com/web/packages/colortools/}{colortools} will do that for you.
+#'
+#' @return A list of colors
+#' @importFrom colortools complementary adjacent splitComp triadic square
+#'   tetradic pizza
+#' @importFrom scales col2hcl alpha
+#' @importFrom graphics layout mtext par
+#' @examples
+#' create_palette(colorhex = '#ff5500', name='orange')
+#' create_palette(colorhex = '#ff5500', name='orange', alpha=.5)
+#'
+#' @export
+create_palette <- function(colorhex,
+                           name=NULL,
+                           toHCL=FALSE,
+                           plot=FALSE,
+                           alpha=1) {
+  if (is.null(name)) name = colorhex
+  if (!is.character(colorhex))
+    stop('color hex must be a character string of the form #ffffff
+    or an R color name.')
+  if (alpha < 0 | alpha > 1) stop('alpha must be between 0 and 1.')
+
+  l = list()
+  l[[name]] = colorhex
+
+
+  if (plot) par(mfrow=c(2,3))
+
+  l$complementary = colortools::complementary(colorhex, plot=plot)
+  l$analogous = colortools::adjacent(colorhex, plot=plot)
+  l$split_complentary = colortools::splitComp(colorhex, plot=plot)
+  l$triadic = colortools::triadic(colorhex, plot=plot)
+  l$square = colortools::square(colorhex, plot=plot)
+  l$tetradic = colortools::tetradic(colorhex, plot=plot)
+
+  if (alpha != 1) {
+    l = lapply(l, function(x) unname(sapply(x, scales::alpha, alpha)))
+    if (plot) {
+      lapply(l[-1], colortools::pizza)
+      mtext('Alpha applied', side = 3, line = -3, outer = TRUE)
+    }
+  }
+
+  # not sure if this is legit or not
+  if (toHCL) {
+    l = lapply(l, function(x) unname(sapply(x, scales::col2hcl, alpha=alpha)))
+    if (plot) {
+      lapply(l[-1], colortools::pizza)
+      mtext('HCL version', side = 3, line = -3, outer = TRUE)
+    }
+  }
+
+  # unlike most R packages that screw with the layout, return it to standard
+  if (plot) graphics::layout(1)
+
+  l
+}