new function color_plot() added with tests

R/contrast_text.R

@@ -12,6 +12,7 @@
 #' @param method A character string that specifies the method for calculating 
 #' the luminance. Three different methods are available: 
 #' c("relative","perceived","perceived_2")
+#' @param ... parameter overflow. Ignored.
 #' @details
 #' This function aids in deciding the font color to print on a given background.
 #' The function is based on the example provided by teppo: 
@@ -32,7 +33,8 @@ contrast_text <- function(background,
                           light_text = 'white',
                           dark_text = 'black',
                           threshold = 0.5,
-                          method = "perceived_2") {
+                          method = "perceived_2",
+                          ...) {
   if (method == "relative") {
     luminance <-
       c(c(.2126, .7152, .0722) %*% grDevices::col2rgb(background) / 255)
@@ -50,3 +52,66 @@ contrast_text <- function(background,
          dark_text)
 }
 
+#' Plot color examples with contrasting text
+#'
+#' Plots color examples with contrasting text. Parameters are passed to 
+#' contrast_text.
+#' @param colors Vector of colors to plot
+#' @param labels Show color names. Default is TRUE
+#' @param borders Border parameter for 'rect()' function. Default is NULL
+#' @param cex_label Label size. Default is 1.
+#' @param ncol Desired number of columns. Default is ceiling of square root to
+#' the length of 'colors' vector provided.
+#' @param ... Parameters for the 
+#'
+#' @return base plot
+#' @export
+#' 
+#' @importFrom graphics par rect text
+#' 
+#' @examples
+#' par(bg=NULL)
+#' colors <- sample(colors(),size = 20)
+#' color_plot(colors, method="relative")
+#' 
+color_plot <-
+  function (colors,
+            labels = TRUE,
+            borders = NULL,
+            cex_label = 1,
+            ncol = NULL,
+            ...){
+    n <- length(colors)
+    ncol <- if (is.null(ncol)) ceiling(sqrt(length(colors))) else ncol
+    nrow <- ceiling(n / ncol)
+    colors <- c(colors, rep(NA, nrow * ncol - length(colors)))
+    colors <- matrix(colors, ncol = ncol, byrow = TRUE)
+    old <- par(pty = "s", mar = c(0, 0, 0, 0))
+    on.exit(par(old))
+    size <- max(dim(colors))
+    plot(
+      c(0, size),
+      c(0, -size),
+      type = "n",
+      xlab = "",
+      ylab = "",
+      axes = FALSE
+    )
+    rect(
+      col(colors) - 1,
+      -row(colors) + 1,
+      col(colors),
+      -row(colors),
+      col = colors,
+      border = borders
+    )
+    if (labels) {
+      label_col <- contrast_text(colors,...)
+      text(col(colors) - 0.5,
+           -row(colors) + 0.5,
+           colors,
+           cex = cex_label,
+           col = label_col)
+    }
+  }
+

man/color_plot.Rd

@@ -0,0 +1,42 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/contrast_text.R
+\name{color_plot}
+\alias{color_plot}
+\title{Plot color examples with contrasting text}
+\usage{
+color_plot(
+  colors,
+  labels = TRUE,
+  borders = NULL,
+  cex_label = 1,
+  ncol = NULL,
+  ...
+)
+}
+\arguments{
+\item{colors}{Vector of colors to plot}
+
+\item{labels}{Show color names. Default is TRUE}
+
+\item{borders}{Border parameter for 'rect()' function. Default is NULL}
+
+\item{cex_label}{Label size. Default is 1.}
+
+\item{ncol}{Desired number of columns. Default is ceiling of square root to
+the length of 'colors' vector provided.}
+
+\item{...}{Parameters for the}
+}
+\value{
+base plot
+}
+\description{
+Plots color examples with contrasting text. Parameters are passed to
+contrast_text.
+}
+\examples{
+par(bg=NULL)
+colors <- sample(colors(),size = 20)
+color_plot(colors, method="relative")
+
+}

man/contrast_text.Rd

@@ -9,7 +9,8 @@ contrast_text(
   light_text = "white",
   dark_text = "black",
   threshold = 0.5,
-  method = "perceived_2"
+  method = "perceived_2",
+  ...
 )
 }
 \arguments{
@@ -26,6 +27,8 @@ the luminance threshold of the background color for text color.}
 \item{method}{A character string that specifies the method for calculating
 the luminance. Three different methods are available:
 c("relative","perceived","perceived_2")}
+
+\item{...}{parameter overflow. Ignored.}
 }
 \value{
 A character string that contains the best contrast text color.

tests/testthat/test-contrast_text.R

@@ -2,6 +2,7 @@
 
 library(testthat)
 
+
 test_that("contrast_text() returns the correct text color", {
   expect_equal(contrast_text("#FFFFFF"), "black")
   expect_equal(contrast_text("#000000"), "white")
@@ -10,3 +11,50 @@ test_that("contrast_text() returns the correct text color", {
   expect_equal(contrast_text("#000000", light_text="blue", dark_text="green"), 
                "blue")
 })
+
+################################################################################
+
+library(devtools)
+
+install_github("MangoTheCat/visualTest")
+library(visualTest)
+
+test_that("New test of color_plot()", {
+  par(bg=NULL)
+  colors <- colors()[34:53]
+  
+  # old <- getwd()
+  # setwd("/Users/au301842/stRoke/tests/testthat")
+  # setwd(old)
+  
+  png(filename = "data/test1.png")
+  color_plot(colors,method="relative")
+  dev.off()
+  
+  # getFingerprint("data/test1.png")
+  
+  expect_equal(getFingerprint("data/test1.png"), "AD07D27813E1D867")
+  # isSimilar(tmp, "AD07D27813E1D867", threshold = 8)
+  
+  #############################
+  
+  # colors <- colors()[51:70]
+  png(filename = "data/test2.png")
+  color_plot(colors,labels = TRUE, borders = FALSE,cex_label = .5, ncol = 3, method="perceived_2")
+  dev.off()
+  
+  # getFingerprint("data/test2.png")
+  
+  expect_equal(getFingerprint("data/test2.png"), "8B0B54D4E4AF2BB1")
+  
+  #############################
+  
+  png(filename = "data/test3.png")
+  color_plot(colors,labels = FALSE, borders = TRUE, ncol = 6, method="perceived")
+  dev.off()
+  
+  # getFingerprint("data/test3.png")
+  
+  expect_equal(getFingerprint("data/test3.png"), "B706F0F1C119CCF8")
+})
+################################################################################