integrating lists for #49 and #43

SymbolixAU · Jun 7, 2019 · e91edff · e91edff
1 parent c508fe0
commit e91edff
Show file tree

Hide file tree

Showing 14 changed files with 651 additions and 812 deletions.
diff --git a/NAMESPACE b/NAMESPACE
@@ -1,9 +1,5 @@
 # Generated by roxygen2: do not edit by hand
 
-S3method(colour_num_values_with_palette_rgb,character)
-S3method(colour_num_values_with_palette_rgb,matrix)
-S3method(colour_str_values_with_palette_rgb,character)
-S3method(colour_str_values_with_palette_rgb,matrix)
 S3method(colour_values_to_hex,Date)
 S3method(colour_values_to_hex,POSIXct)
 S3method(colour_values_to_hex,POSIXlt)

diff --git a/R/RcppExports.R b/R/RcppExports.R
@@ -5,68 +5,8 @@ rcpp_colour_values_hex <- function(x, palette, alpha, na_colour = "#808080", inc
     .Call(`_colourvalues_rcpp_colour_values_hex`, x, palette, alpha, na_colour, include_alpha, format, format_type, digits, summary, n_summaries)
 }
 
-rcpp_colour_num_value_string_palette_hex <- function(x, palette, na_colour, alpha, include_alpha) {
-    .Call(`_colourvalues_rcpp_colour_num_value_string_palette_hex`, x, palette, na_colour, alpha, include_alpha)
-}
-
-rcpp_colour_num_value_string_palette_summary_hex <- function(x, palette, na_colour, alpha, include_alpha, n_summaries, format = FALSE, format_type = "", digits = 2L) {
-    .Call(`_colourvalues_rcpp_colour_num_value_string_palette_summary_hex`, x, palette, na_colour, alpha, include_alpha, n_summaries, format, format_type, digits)
-}
-
-rcpp_colour_num_value_rgb_palette_hex <- function(x, palette, na_colour, include_alpha) {
-    .Call(`_colourvalues_rcpp_colour_num_value_rgb_palette_hex`, x, palette, na_colour, include_alpha)
-}
-
-rcpp_colour_num_value_rgb_palette_summary_hex <- function(x, palette, na_colour, include_alpha, n_summaries, format = FALSE, format_type = "", digits = 2L) {
-    .Call(`_colourvalues_rcpp_colour_num_value_rgb_palette_summary_hex`, x, palette, na_colour, include_alpha, n_summaries, format, format_type, digits)
-}
-
-rcpp_colour_str_value_string_palette_hex <- function(x, palette, na_colour, alpha, include_alpha) {
-    .Call(`_colourvalues_rcpp_colour_str_value_string_palette_hex`, x, palette, na_colour, alpha, include_alpha)
-}
-
-rcpp_colour_str_value_string_palette_summary_hex <- function(x, palette, na_colour, alpha, include_alpha, summary) {
-    .Call(`_colourvalues_rcpp_colour_str_value_string_palette_summary_hex`, x, palette, na_colour, alpha, include_alpha, summary)
-}
-
-rcpp_colour_str_value_rgb_palette_hex <- function(x, palette, na_colour, include_alpha) {
-    .Call(`_colourvalues_rcpp_colour_str_value_rgb_palette_hex`, x, palette, na_colour, include_alpha)
-}
-
-rcpp_colour_str_value_rgb_palette_summary_hex <- function(x, palette, na_colour, include_alpha, summary) {
-    .Call(`_colourvalues_rcpp_colour_str_value_rgb_palette_summary_hex`, x, palette, na_colour, include_alpha, summary)
-}
-
-rcpp_colour_num_value_string_palette_rgb <- function(x, palette, na_colour, alpha, include_alpha) {
-    .Call(`_colourvalues_rcpp_colour_num_value_string_palette_rgb`, x, palette, na_colour, alpha, include_alpha)
-}
-
-rcpp_colour_num_value_string_palette_summary_rgb <- function(x, palette, na_colour, alpha, include_alpha, n_summaries, format = FALSE, format_type = "", digits = 2L) {
-    .Call(`_colourvalues_rcpp_colour_num_value_string_palette_summary_rgb`, x, palette, na_colour, alpha, include_alpha, n_summaries, format, format_type, digits)
-}
-
-rcpp_colour_num_value_rgb_palette_rgb <- function(x, palette, na_colour, include_alpha) {
-    .Call(`_colourvalues_rcpp_colour_num_value_rgb_palette_rgb`, x, palette, na_colour, include_alpha)
-}
-
-rcpp_colour_num_value_rgb_palette_summary_rgb <- function(x, palette, na_colour, include_alpha, n_summaries, format = FALSE, format_type = "", digits = 2L) {
-    .Call(`_colourvalues_rcpp_colour_num_value_rgb_palette_summary_rgb`, x, palette, na_colour, include_alpha, n_summaries, format, format_type, digits)
-}
-
-rcpp_colour_str_value_string_palette_rgb <- function(x, palette, na_colour, alpha, include_alpha) {
-    .Call(`_colourvalues_rcpp_colour_str_value_string_palette_rgb`, x, palette, na_colour, alpha, include_alpha)
-}
-
-rcpp_colour_str_value_string_palette_summary_rgb <- function(x, palette, na_colour, alpha, include_alpha, summary) {
-    .Call(`_colourvalues_rcpp_colour_str_value_string_palette_summary_rgb`, x, palette, na_colour, alpha, include_alpha, summary)
-}
-
-rcpp_colour_str_value_rgb_palette_rgb <- function(x, palette, na_colour, include_alpha) {
-    .Call(`_colourvalues_rcpp_colour_str_value_rgb_palette_rgb`, x, palette, na_colour, include_alpha)
-}
-
-rcpp_colour_str_value_rgb_palette_summary_rgb <- function(x, palette, na_colour, include_alpha, summary) {
-    .Call(`_colourvalues_rcpp_colour_str_value_rgb_palette_summary_rgb`, x, palette, na_colour, include_alpha, summary)
+rcpp_colour_values_rgb <- function(x, palette, alpha, na_colour = "#808080", include_alpha = TRUE, format = FALSE, format_type = "numeric", digits = 2L, summary = FALSE, n_summaries = 0L) {
+    .Call(`_colourvalues_rcpp_colour_values_rgb`, x, palette, alpha, na_colour, include_alpha, format, format_type, digits, summary, n_summaries)
 }
 
 rcpp_convert_hex_to_rgb <- function(hex_strings) {
@@ -93,10 +33,6 @@ rcpp_refil_list <- function(lst_sizes, colours, vector_position) {
     .Call(`_colourvalues_rcpp_refil_list`, lst_sizes, colours, vector_position)
 }
 
-colour_list <- function(lst) {
-    .Call(`_colourvalues_colour_list`, lst)
-}
-
 rcpp_viridis <- function() {
     .Call(`_colourvalues_rcpp_viridis`)
 }

diff --git a/R/colour_values_rgb.R b/R/colour_values_rgb.R
@@ -25,138 +25,153 @@
 #'
 #'
 #' @export
-colour_values_rgb <- function( x, palette = "viridis", na_colour = "#808080FF", alpha = 255, include_alpha = TRUE, ... ) {
+colour_values_rgb <- function( x, palette = "viridis", alpha = 255, na_colour = "#808080FF", include_alpha = TRUE, ... ) {
   palette <- palette_check( palette )
-  colour_values_to_rgb( x, palette, na_colour, alpha, include_alpha, ... )
+  colour_values_to_rgb(
+    x = x
+    , palette = palette
+    , alpha = alpha
+    , na_colour = na_colour
+    , include_alpha = include_alpha
+    , ...
+  )
 }
 
-#' @rdname colour_values_rgb
-#' @export
-color_values_rgb <- colour_values_rgb
-
-
-### RGB ------------------------------------------------------------------------
-
-colour_num_values_with_palette_rgb <- function( palette, x, na_colour, alpha, include_alpha, ... ) {
-  UseMethod("colour_num_values_with_palette_rgb")
-}
-
-#' @export
-colour_num_values_with_palette_rgb.character <- function( palette, x, na_colour, alpha, include_alpha, n_summaries, format, format_type, digits ) {
-  if ( n_summaries > 0 ) {
-    return( rcpp_colour_num_value_string_palette_summary_rgb( x, palette, na_colour, alpha, include_alpha, n_summaries, format, format_type, digits ) )
-  } else {
-    return( rcpp_colour_num_value_string_palette_rgb( x, palette, na_colour, alpha, include_alpha ) )
-  }
-}
-
-#' @export
-colour_num_values_with_palette_rgb.matrix <- function( palette, x, na_colour, alpha, include_alpha, n_summaries, format, format_type, digits ) {
-  #palette_check( palette )
-  if ( n_summaries > 0 ) {
-    return( rcpp_colour_num_value_rgb_palette_summary_rgb( x, palette, na_colour, include_alpha, n_summaries, format, format_type, digits ) )
-  } else {
-    return( rcpp_colour_num_value_rgb_palette_rgb( x, palette, na_colour, include_alpha ) )
-  }
-}
-
-colour_str_values_with_palette_rgb <- function( palette, x, na_colour, alpha, include_alpha, ... ) {
-  UseMethod("colour_str_values_with_palette_rgb")
-}
-
-#' @export
-colour_str_values_with_palette_rgb.character <- function( palette, x, na_colour, alpha, include_alpha, summary ) {
-  if ( summary ) {
-    return( rcpp_colour_str_value_string_palette_summary_rgb(x, palette, na_colour, alpha, include_alpha, summary ) )
-  } else {
-    return( rcpp_colour_str_value_string_palette_rgb(x, palette, na_colour, alpha, include_alpha ) )
-  }
-}
 
+#' @rdname colour_values
 #' @export
-colour_str_values_with_palette_rgb.matrix <- function( palette, x, na_colour, alpha, include_alpha, summary ) {
-  #palette_check( palette )
-  if ( summary ) {
-    return( rcpp_colour_str_value_rgb_palette_summary_rgb( x, palette, na_colour, include_alpha, summary ) )
-  } else {
-    return( rcpp_colour_str_value_rgb_palette_rgb( x, palette, na_colour, include_alpha ) )
-  }
-}
+color_values_rgb <- colour_values_rgb
 
 colour_values_to_rgb <- function( x, palette = "viridis", na_colour, alpha, include_alpha, ... ) {
   UseMethod("colour_values_to_rgb")
 }
 
-#' @rdname colour_values_rgb
+#' @rdname colour_values
 #' @param summary logical indicating if a summary of the colours should be returned as
 #' well as the full colour mapping. This will be the unique elements of \code{x} mapped to the colour.
 #' @export
-colour_values_to_rgb.character <- function( x, palette, na_colour, alpha, include_alpha, summary = FALSE ) {
-  colour_str_values_with_palette_rgb( palette, x, na_colour, alpha, include_alpha, summary )
+colour_values_to_rgb.character <- function( x, palette, alpha, na_colour, include_alpha, summary = FALSE ) {
+  # rcpp_colour_values_rgb( palette, x, na_colour, alpha, include_alpha, summary )
+  # print( ".character" )
+  # print( include_alpha )
+  colour_values_to_rgb.default(
+    x = x
+    , palette = palette
+    , alpha = alpha
+    , na_colour = na_colour
+    , include_alpha = include_alpha
+    , summary = summary
+  )
 }
 
-#' @rdname colour_values_rgb
-#' @param n_summaries positive integer. If supplied a summary colour palette will be returned
-#' in a list, containing \code{n_summaries} equally spaced values of \code{x} in the range \code{[min(x),max(x)]},
-#' and their associated colours. If a non-numeric \code{x} is used this value is ignored
-#' @param format logical indicating if the summary values should be formatted. See details
-#' @param digits Integer. When summarising a numeric vector you can specify
-#' the number of decimal places to include in the summary values
-#'
-#' @details
-#'
-#' when \code{summary = TRUE}, the following rules are applied to the summary values
-#' \itemize{
-#'   \item{logical vectors are converted to "TRUE" or "FALSE" strings}
-#'   \item{all other types remain as-is, unless \code{format = T} is used}
-#' }
-#'
-#' when \code{format = TRUE},
-#' \itemize{
-#'   \item{numbers are converted to strings with the specified number of decimal places (using \code{digits} argument) }
-#'   \item{Dates are formatted as "yyyy-mm-dd"}
-#' }
-#'
+#' @rdname colour_values
 #' @export
-colour_values_to_rgb.default <- function( x, palette, na_colour, alpha, include_alpha, n_summaries = 0, format = TRUE, digits = 2 ) {
-  colour_num_values_with_palette_rgb( palette, x, na_colour, alpha, include_alpha, n_summaries, format, "numeric", digits )
+colour_values_to_rgb.logical <- function( x, palette, alpha, na_colour, include_alpha, summary = FALSE ) {
+  colour_values_to_rgb.default(
+    x = x
+    , palette = palette
+    , alpha = alpha
+    , na_colour = na_colour
+    , include_alpha = include_alpha
+    , summary = summary
+  )
 }
 
-#' #' @rdname colour_values_rgb
-#' #' @export
-#' colour_values_to_rgb.integer <-  function( x, palette, na_colour, alpha, include_alpha, n_summaries = 0, ... ) {
-#'   colour_num_values_with_palette_rgb( palette, x, na_colour, alpha, include_alpha, n_summaries, FALSE, "integer", 0)
-#' }
-
-#' @rdname colour_values_rgb
+#' @rdname colour_values
 #' @export
-colour_values_to_rgb.logical <-  function( x, palette, na_colour, alpha, include_alpha, summary = FALSE ) {
-  colour_values_to_rgb.character(x, palette, na_colour, alpha, include_alpha, summary)
+colour_values_to_rgb.factor <- function( x, palette, alpha, na_colour, include_alpha, summary = FALSE ) {
+  colour_values_to_rgb.default(
+    x = x
+    , palette = palette
+    , alpha = alpha
+    , na_colour = na_colour
+    , include_alpha = include_alpha
+    , summary = summary
+  )
 }
 
-#' @rdname colour_values_rgb
+#' @rdname colour_values
 #' @export
-colour_values_to_rgb.factor <-  function( x, palette, na_colour, alpha, include_alpha, summary = FALSE ) {
-  colour_values_to_rgb.character(x, palette, na_colour, alpha, include_alpha, summary)
+colour_values_to_rgb.Date <-  function( x, palette, alpha, na_colour, include_alpha, n_summaries = 0, format = TRUE ) {
+  # colour_num_values_with_palette_rgb( palette, x, na_colour, alpha, include_alpha, n_summaries, format, "Date", 0 )
+  colour_values_to_rgb.default(
+    x = x
+    , palette = palette
+    , alpha = alpha
+    , na_colour = na_colour
+    , include_alpha = include_alpha
+    , n_summaries = n_summaries
+    , format = format
+    , format_type = "Date"
+    , digits = 0
+  )
 }
 
-#' @rdname colour_values_rgb
+#' @rdname colour_values
 #' @export
-colour_values_to_rgb.Date <-  function( x, palette, na_colour, alpha, include_alpha, n_summaries = 0, format  = TRUE ) {
-  colour_num_values_with_palette_rgb( palette, x, na_colour, alpha, include_alpha, n_summaries, format, "Date", 0 )
+colour_values_to_rgb.POSIXct <-  function( x, palette, alpha, na_colour, include_alpha, n_summaries = 0, format = TRUE ) {
+  #colour_num_values_with_palette_rgb( palette, x, na_colour, alpha, include_alpha, n_summaries, format, "POSIXct", 0 )
+
+  colour_values_to_rgb.default(
+    x = x
+    , palette = palette
+    , alpha = alpha
+    , na_colour = na_colour
+    , include_alpha = include_alpha
+    , n_summaries = n_summaries
+    , format = format
+    , format_type = "POSIXct"
+    , digits = 0
+  )
 }
 
-#' @rdname colour_values_rgb
+#' @rdname colour_values
 #' @export
-colour_values_to_rgb.POSIXct <-  function( x, palette, na_colour, alpha, include_alpha, n_summaries = 0, format = TRUE ) {
-  colour_num_values_with_palette_rgb( palette, x, na_colour, alpha, include_alpha, n_summaries, format, "POSIXct", 0 )
+colour_values_to_rgb.POSIXlt <-  function( x, palette, na_colour, alpha, include_alpha, n_summaries = 0, format = TRUE ) {
+  # colour_num_values_with_palette_rgb( palette, as.POSIXct(x), na_colour, alpha, include_alpha, n_summaries, format, "POSIXct", 0 )
+  colour_values_to_rgb.default(
+    x = as.POSIXct( x )
+    , palette = palette
+    , alpha = alpha
+    , na_colour = na_colour
+    , include_alpha = include_alpha
+    , n_summaries = n_summaries
+    , format = format
+    , format_type = "POSIXct"
+    , digits = 0
+  )
 }
 
-#' @rdname colour_values_rgb
+
 #' @export
-colour_values_to_rgb.POSIXlt <-  function( x, palette, na_colour, alpha, include_alpha, n_summaries = 0, format = TRUE ) {
-  colour_num_values_with_palette_rgb( palette, as.POSIXct(x), na_colour, alpha, include_alpha, n_summaries, format, "POSIXct", 0 )
+colour_values_to_rgb.default <- function(
+  x,
+  palette,
+  alpha,
+  na_colour,
+  include_alpha,
+  format = TRUE,
+  format_type = "numeric",
+  digits = 2,
+  summary = FALSE,
+  n_summaries = 0
+) {
+
+  # print("default")
+  # print( include_alpha )
+  # print( n_summaries )
+  # print( summary )
+  rcpp_colour_values_rgb(
+    x = x
+    , palette = palette
+    , alpha = alpha
+    , na_colour = na_colour
+    , include_alpha = include_alpha
+    , format = format
+    , format_type = format_type
+    , digits = digits
+    , summary = summary
+    , n_summaries = n_summaries
+  )
 }
 
-
-### end RGB --------------------------------------------------------------------
diff --git a/R/scratch.R b/R/scratch.R
@@ -8,16 +8,17 @@
 #   , a = 10.1
 #   , b = as.POSIXct("2018-01-01 00:00:00")
 # )
-# colourvalues:::colour_list( l )
-
+# colour_values( l )
+# # colourvalues:::colour_list( l )
+#
 # l <- list(
 #   x = 1:100
 #   , y = letters
 #   , z = list( list( x = letters ) )
 #   , a = list( list( list( x = list( letters ) ) ) )
 # )
-#
-# colourvalues:::colour_list( l )
+# colour_values( l )
+# # colourvalues:::colour_list( l )