hex api working

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

Hide file tree

Showing 7 changed files with 168 additions and 154 deletions.
diff --git a/NAMESPACE b/NAMESPACE
@@ -1,11 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
-S3method(colour_num_values_with_palette_hex,character)
-S3method(colour_num_values_with_palette_hex,matrix)
 S3method(colour_num_values_with_palette_rgb,character)
 S3method(colour_num_values_with_palette_rgb,matrix)
-S3method(colour_str_values_with_palette_hex,character)
-S3method(colour_str_values_with_palette_hex,matrix)
 S3method(colour_str_values_with_palette_rgb,character)
 S3method(colour_str_values_with_palette_rgb,matrix)
 S3method(colour_values_to_hex,Date)

diff --git a/R/colour_values_hex.R b/R/colour_values_hex.R
@@ -66,66 +66,23 @@
 #' colour_values(-10:10, n_summaries = 5)
 #'
 #' @export
-colour_values <- function( x, palette = "viridis", na_colour = "#808080FF", alpha = 255, include_alpha = TRUE, ... ) {
+colour_values <- function( x, palette = "viridis", alpha = 255, na_colour = "#808080FF", include_alpha = TRUE, ... ) {
   palette <- palette_check( palette )
-  colour_values_to_hex( x, palette, na_colour, alpha, include_alpha, ... )
+  colour_values_to_hex(
+    x = x
+    , palette = palette
+    , alpha = alpha
+    , na_colour = na_colour
+    , include_alpha = include_alpha
+    , ...
+  )
 }
 
+
 #' @rdname colour_values
 #' @export
 color_values <- colour_values
 
-
-
-### HEX ------------------------------------------------------------------------
-
-colour_num_values_with_palette_hex <- function( palette, x, na_colour, alpha, include_alpha, ... ) {
-  UseMethod("colour_num_values_with_palette_hex")
-}
-
-#' @export
-colour_num_values_with_palette_hex.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_hex( x, palette, na_colour, alpha, include_alpha, n_summaries, format, format_type, digits ) )
-  } else {
-    return( rcpp_colour_num_value_string_palette_hex( x, palette, na_colour, alpha, include_alpha ) )
-  }
-}
-
-#' @export
-colour_num_values_with_palette_hex.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_hex( x, palette, na_colour, include_alpha, n_summaries, format, format_type, digits ) )
-  } else {
-    return( rcpp_colour_num_value_rgb_palette_hex( x, palette, na_colour, include_alpha ) )
-  }
-}
-
-colour_str_values_with_palette_hex <- function( palette, x, na_colour, alpha, include_alpha, ... ) {
-  UseMethod("colour_str_values_with_palette_hex")
-}
-
-#' @export
-colour_str_values_with_palette_hex.character <- function( palette, x, na_colour, alpha, include_alpha, summary ) {
-  if( summary ) {
-    return( rcpp_colour_str_value_string_palette_summary_hex(x, palette, na_colour, alpha, include_alpha, summary ) )
-  } else {
-    return( rcpp_colour_str_value_string_palette_hex(x, palette, na_colour, alpha, include_alpha ) )
-  }
-}
-
-#' @export
-colour_str_values_with_palette_hex.matrix <- function( palette, x, na_colour, alpha, include_alpha, summary ) {
-  #palette_check( palette )
-  if ( summary ) {
-    return( rcpp_colour_str_value_rgb_palette_summary_hex( x, palette, na_colour, include_alpha, summary ) )
-  } else {
-    return( rcpp_colour_str_value_rgb_palette_hex( x, palette, na_colour, include_alpha ) )
-  }
-}
-
-
 colour_values_to_hex <- function( x, palette = "viridis", na_colour, alpha, include_alpha, ... ) {
   UseMethod("colour_values_to_hex")
 }
@@ -134,73 +91,128 @@ colour_values_to_hex <- function( x, palette = "viridis", na_colour, alpha, incl
 #' @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_hex.character <- function( x, palette, na_colour, alpha, include_alpha, summary = FALSE ) {
-  colour_str_values_with_palette_hex( palette, x, na_colour, alpha, include_alpha, summary )
+colour_values_to_hex.character <- function( x, palette, alpha, na_colour, include_alpha, summary = FALSE ) {
+  # rcpp_colour_values_hex( palette, x, na_colour, alpha, include_alpha, summary )
+  # print( ".character" )
+  # print( include_alpha )
+  colour_values_to_hex.default(
+    x = x
+    , palette = palette
+    , alpha = alpha
+    , na_colour = na_colour
+    , include_alpha = include_alpha
+    , summary = summary
+  )
 }
 
 #' @rdname colour_values
-#' @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"}
-#' }
-#'
 #' @export
-colour_values_to_hex.default <- function( x, palette, na_colour, alpha, include_alpha, n_summaries = 0, format = TRUE, digits = 2 ) {
-  colour_num_values_with_palette_hex( palette, x, na_colour, alpha, include_alpha, n_summaries, format, "numeric", digits )
+colour_values_to_hex.logical <- function( x, palette, alpha, na_colour, include_alpha, summary = FALSE ) {
+  colour_values_to_hex.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_hex.integer <-  function( x, palette, na_colour, alpha, include_alpha, n_summaries = 0, ...) {
-#'   colour_num_values_with_palette_hex( palette, x, na_colour, alpha, include_alpha, n_summaries, FALSE, "integer", 0)
-#' }
-
 #' @rdname colour_values
 #' @export
-colour_values_to_hex.logical <-  function( x, palette, na_colour, alpha, include_alpha, summary = FALSE ) {
-  colour_values_to_hex.character(x, palette, na_colour, alpha, include_alpha, summary)
+colour_values_to_hex.factor <- function( x, palette, alpha, na_colour, include_alpha, summary = FALSE ) {
+  colour_values_to_hex.default(
+    x = x
+    , palette = palette
+    , alpha = alpha
+    , na_colour = na_colour
+    , include_alpha = include_alpha
+    , summary = summary
+  )
 }
 
 #' @rdname colour_values
 #' @export
-colour_values_to_hex.factor <-  function( x, palette, na_colour, alpha, include_alpha, summary = FALSE ) {
-  colour_values_to_hex.character(x, palette, na_colour, alpha, include_alpha, summary)
+colour_values_to_hex.Date <-  function( x, palette, alpha, na_colour, include_alpha, n_summaries = 0, format = TRUE ) {
+  # colour_num_values_with_palette_hex( palette, x, na_colour, alpha, include_alpha, n_summaries, format, "Date", 0 )
+  colour_values_to_hex.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
 #' @export
-colour_values_to_hex.Date <-  function( x, palette, na_colour, alpha, include_alpha, n_summaries = 0, format = TRUE ) {
-  colour_num_values_with_palette_hex( palette, x, na_colour, alpha, include_alpha, n_summaries, format, "Date", 0 )
-}
-
-#' @rdname colour_values
-#' @export
-colour_values_to_hex.POSIXct <-  function( x, palette, na_colour, alpha, include_alpha, n_summaries = 0, format = TRUE ) {
-  colour_num_values_with_palette_hex( palette, x, na_colour, alpha, include_alpha, n_summaries, format, "POSIXct", 0 )
+colour_values_to_hex.POSIXct <-  function( x, palette, alpha, na_colour, include_alpha, n_summaries = 0, format = TRUE ) {
+  #colour_num_values_with_palette_hex( palette, x, na_colour, alpha, include_alpha, n_summaries, format, "POSIXct", 0 )
+
+  colour_values_to_hex.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
 #' @export
 colour_values_to_hex.POSIXlt <-  function( x, palette, na_colour, alpha, include_alpha, n_summaries = 0, format = TRUE ) {
-  colour_num_values_with_palette_hex( palette, as.POSIXct(x), na_colour, alpha, include_alpha, n_summaries, format, "POSIXct", 0 )
+  # colour_num_values_with_palette_hex( palette, as.POSIXct(x), na_colour, alpha, include_alpha, n_summaries, format, "POSIXct", 0 )
+  colour_values_to_hex.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
+  )
 }
 
 
-### end HEX --------------------------------------------------------------------
+#' @export
+colour_values_to_hex.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_hex(
+    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
+    )
+}
 
diff --git a/inst/include/colourvalues/api.hpp b/inst/include/colourvalues/api.hpp
@@ -21,7 +21,7 @@ namespace api {
     int n_summaries = 0
   ) {
 
-    Rcpp::Rcout << "NumericVector x, SEXP palette " << std::endl;
+    //Rcpp::Rcout << "NumericVector x, SEXP palette " << std::endl;
 
     switch( TYPEOF( palette ) ) {
       // STringVector - needs to get std::string
@@ -64,7 +64,7 @@ namespace api {
       int digits = 2,
       bool summary = false
   ) {
-    Rcpp::Rcout << "stringVector x, SEXP palette " << std::endl;
+    //Rcpp::Rcout << "stringVector x, SEXP palette " << std::endl;
 
     switch( TYPEOF( palette ) ) {
     case STRSXP: {
@@ -107,7 +107,8 @@ namespace api {
       bool summary = false,
       int n_summaries = 0
   ) {
-    Rcpp::Rcout << "SEXP x, NumericMatrix palette " << std::endl;
+    //Rcpp::Rcout << "SEXP x, NumericMatrix palette " << std::endl;
+    //Rcpp::Rcout << "include_alpha: " << include_alpha << std::endl;
 
     switch( TYPEOF( x ) ) {
     case INTSXP: {}
@@ -126,7 +127,7 @@ namespace api {
     default: {
       Rcpp::StringVector sv = Rcpp::as< Rcpp::StringVector >( x );
       return colourvalues::colours_hex::colour_value_hex(
-        sv, palette, na_colour, alpha, summary
+        sv, palette, na_colour, include_alpha, summary
       );
     }
     }
@@ -149,16 +150,29 @@ namespace api {
       int n_summaries = 0
   ) {
 
-    Rcpp::Rcout << "SEXP x, StringVector palette " << std::endl;
-    Rcpp::Rcout << "typeof x: " << TYPEOF( x ) << std::endl;
+    //Rcpp::Rcout << "SEXP x, StringVector palette " << std::endl;
+    //Rcpp::Rcout << "typeof x: " << TYPEOF( x ) << std::endl;
 
     Rcpp::String p = palette[0];
     std::string pal = p;
 
     switch( TYPEOF( x ) ) {
-    case INTSXP: {}
+    case INTSXP: {
+      if( Rf_isFactor( x ) ) {
+      Rcpp::StringVector sv = Rcpp::as< Rcpp::StringVector >( x );
+      return colourvalues::colours_hex::colour_value_hex(
+        sv, pal, na_colour, alpha, include_alpha, summary
+      );
+    } else {
+      Rcpp::NumericVector nv = Rcpp::clone(x);
+      return colourvalues::colours_hex::colour_value_hex(
+        nv, pal, na_colour, alpha, include_alpha, n_summaries, format, format_type, digits
+      );
+    }
+    }
     case REALSXP: {
-      Rcpp::NumericVector nv = Rcpp::as< Rcpp::NumericVector >( x );
+      //Rcpp::NumericVector nv = Rcpp::as< Rcpp::NumericVector >( x );
+      Rcpp::NumericVector nv = Rcpp::clone(x);
       return colourvalues::colours_hex::colour_value_hex(
         nv, pal, na_colour, alpha, include_alpha, n_summaries, format, format_type, digits
       );
@@ -196,7 +210,7 @@ namespace api {
       int n_summaries = 0
   ) {
 
-    Rcpp::Rcout << "SEXP x, SEXP palette " << std::endl;
+    //Rcpp::Rcout << "SEXP x, SEXP palette " << std::endl;
 
     switch( TYPEOF( palette ) ) {
     case INTSXP: {}
@@ -209,8 +223,6 @@ namespace api {
     }
     case STRSXP: {
       Rcpp::StringVector sv = Rcpp::as< Rcpp::StringVector >( palette );
-//      Rcpp::String s = sv[0];
-//      std::string pal = s;
       return colour_values_hex(
         x, sv, alpha, na_colour, include_alpha, format, format_type, digits, summary, n_summaries
       );