Merge pull request #51 from dcooley/issue49

Issue49
SymbolixAU · Jun 11, 2019 · ddfdf1b · ddfdf1b
2 parents f145df4 + 84442fe
commit ddfdf1b
Show file tree

Hide file tree

Showing 18 changed files with 306 additions and 143 deletions.
diff --git a/R/RcppExports.R b/R/RcppExports.R
@@ -1,12 +1,12 @@
 # Generated by using Rcpp::compileAttributes() -> do not edit by hand
 # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
 
-rcpp_colour_values_hex <- 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_hex`, x, palette, alpha, na_colour, include_alpha, format, format_type, digits, summary, n_summaries)
+rcpp_colour_values_hex <- function(x, palette, alpha, na_colour = "#808080", include_alpha = TRUE, format = FALSE, digits = 2L, summary = FALSE, n_summaries = 0L) {
+    .Call(`_colourvalues_rcpp_colour_values_hex`, x, palette, alpha, na_colour, include_alpha, format, digits, summary, n_summaries)
 }
 
-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_colour_values_rgb <- function(x, palette, alpha, na_colour = "#808080", include_alpha = TRUE, format = FALSE, digits = 2L, summary = FALSE, n_summaries = 0L) {
+    .Call(`_colourvalues_rcpp_colour_values_rgb`, x, palette, alpha, na_colour, include_alpha, format, digits, summary, n_summaries)
 }
 
 rcpp_convert_hex_to_rgb <- function(hex_strings) {
@@ -21,12 +21,20 @@ rcpp_convert_rgb_vec_to_hex <- function(rgb) {
     .Call(`_colourvalues_rcpp_convert_rgb_vec_to_hex`, rgb)
 }
 
+rcpp_get_format_type <- function(palette_type) {
+    .Call(`_colourvalues_rcpp_get_format_type`, palette_type)
+}
+
+rcpp_get_r_class <- function(obj) {
+    .Call(`_colourvalues_rcpp_get_r_class`, obj)
+}
+
 rcpp_vector_type <- function(new_type, existing_type) {
     .Call(`_colourvalues_rcpp_vector_type`, new_type, existing_type)
 }
 
-rcpp_list_size <- function(lst, total_size, existing_type) {
-    .Call(`_colourvalues_rcpp_list_size`, lst, total_size, existing_type)
+rcpp_list_size <- function(lst, total_size, existing_type, format_type) {
+    .Call(`_colourvalues_rcpp_list_size`, lst, total_size, existing_type, format_type)
 }
 
 rcpp_refil_list <- function(lst_sizes, colours, vector_position) {

diff --git a/R/colour_values_hex.R b/R/colour_values_hex.R
@@ -147,7 +147,6 @@ colour_values_to_hex.Date <-  function( x, palette, alpha, na_colour, include_al
     , include_alpha = include_alpha
     , n_summaries = n_summaries
     , format = format
-    , format_type = "Date"
     , digits = 0
   )
 }
@@ -165,7 +164,6 @@ colour_values_to_hex.POSIXct <-  function( x, palette, alpha, na_colour, include
     , include_alpha = include_alpha
     , n_summaries = n_summaries
     , format = format
-    , format_type = "POSIXct"
     , digits = 0
     )
 }
@@ -182,7 +180,6 @@ colour_values_to_hex.POSIXlt <-  function( x, palette, na_colour, alpha, include
     , include_alpha = include_alpha
     , n_summaries = n_summaries
     , format = format
-    , format_type = "POSIXct"
     , digits = 0
   )
 }
@@ -196,7 +193,6 @@ colour_values_to_hex.default <- function(
   na_colour,
   include_alpha,
   format = TRUE,
-  format_type = "numeric",
   digits = 2,
   summary = FALSE,
   n_summaries = 0
@@ -213,7 +209,6 @@ colour_values_to_hex.default <- function(
     , 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/R/colour_values_rgb.R b/R/colour_values_rgb.R
@@ -106,7 +106,6 @@ colour_values_to_rgb.Date <-  function( x, palette, alpha, na_colour, include_al
     , include_alpha = include_alpha
     , n_summaries = n_summaries
     , format = format
-    , format_type = "Date"
     , digits = 0
   )
 }
@@ -124,7 +123,6 @@ colour_values_to_rgb.POSIXct <-  function( x, palette, alpha, na_colour, include
     , include_alpha = include_alpha
     , n_summaries = n_summaries
     , format = format
-    , format_type = "POSIXct"
     , digits = 0
   )
 }
@@ -141,7 +139,6 @@ colour_values_to_rgb.POSIXlt <-  function( x, palette, na_colour, alpha, include
     , include_alpha = include_alpha
     , n_summaries = n_summaries
     , format = format
-    , format_type = "POSIXct"
     , digits = 0
   )
 }
@@ -155,7 +152,6 @@ colour_values_to_rgb.default <- function(
   na_colour,
   include_alpha,
   format = TRUE,
-  format_type = "numeric",
   digits = 2,
   summary = FALSE,
   n_summaries = 0
@@ -172,7 +168,6 @@ colour_values_to_rgb.default <- function(
     , 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/api.hpp b/inst/include/colourvalues/api/api.hpp
@@ -1,6 +1,8 @@
 #ifndef R_COLOURVALUES_API_H
 #define R_COLOURVALUES_API_H
 
+#include <Rcpp.h>
+
 #include "colourvalues/api/api_hex.hpp"
 #include "colourvalues/api/api_rgb.hpp"
 

diff --git a/inst/include/colourvalues/api/api_hex.hpp b/inst/include/colourvalues/api/api_hex.hpp
@@ -13,14 +13,13 @@ namespace api {
   /*
    * list with matrix palette
    */
-  SEXP colour_values_hex(
+  inline SEXP colour_values_hex(
       Rcpp::List lst,
       Rcpp::NumericMatrix& palette,
       Rcpp::NumericVector& alpha,
       std::string na_colour = "#808080",
       bool include_alpha = true,
       bool format = false,
-      std::string format_type = "numeric",
       int digits = 2,
       bool summary = false,
       int n_summaries = 0
@@ -30,7 +29,12 @@ namespace api {
 
     int position = 0;
 
-    Rcpp::List lst_sizes = colourvalues::list::list_size( lst, total_size, existing_type );
+
+    // TODO: get format_type depending on the type of list elements
+    std::string format_type = "numeric";
+    // follow heirarchy of classes:
+    //
+    Rcpp::List lst_sizes = colourvalues::list::list_size( lst, total_size, existing_type, format_type );
 
     switch( existing_type ) {
     case INTSXP: { } // 13
@@ -45,7 +49,7 @@ namespace api {
       }
 
       SEXP coloured_values = colourvalues::colours_hex::colour_value_hex(
-        colours, palette, na_colour, include_alpha, n_summaries, format, format_type, digits
+        colours, palette, na_colour, include_alpha, format_type, n_summaries, format, digits
       );
 
       position = 0;
@@ -89,14 +93,13 @@ namespace api {
   /*
    * list with string palette
    */
-  SEXP colour_values_hex(
+  inline SEXP colour_values_hex(
       Rcpp::List lst,
       std::string& palette,
       Rcpp::NumericVector& alpha,
       std::string na_colour = "#808080",
       bool include_alpha = true,
       bool format = false,
-      std::string format_type = "numeric",
       int digits = 2,
       bool summary = false,
       int n_summaries = 0
@@ -106,7 +109,12 @@ namespace api {
 
     int position = 0;
 
-    Rcpp::List lst_sizes = colourvalues::list::list_size( lst, total_size, existing_type );
+
+    // TODO: get format_type depending on the type of list elements
+    std::string format_type = "numeric";
+
+    Rcpp::List lst_sizes = colourvalues::list::list_size( lst, total_size, existing_type, format_type );
+
     switch( existing_type ) {
     case INTSXP: { } // 13
     case REALSXP: { // 14
@@ -120,7 +128,7 @@ namespace api {
       }
 
       SEXP coloured_values = colourvalues::colours_hex::colour_value_hex(
-        colours, palette, na_colour, alpha, include_alpha, n_summaries, format, format_type, digits
+        colours, palette, na_colour, alpha, include_alpha, format_type, n_summaries, format, digits
       );
 
       position = 0;
@@ -141,9 +149,9 @@ namespace api {
     default: {
 
       if( n_summaries > 0 ) {
-        Rcpp::warning("n_summaries not valid for character values, using summary = T");
-        summary = true;
-      }
+      Rcpp::warning("n_summaries not valid for character values, using summary = T");
+      summary = true;
+    }
 
       Rcpp::StringVector colours( total_size );
       colourvalues::list::unlist_list( lst, lst_sizes, colours, position );
@@ -175,37 +183,37 @@ namespace api {
    * when palette is unknown, but vector is numeric
    */
   inline SEXP colour_values_hex(
-    Rcpp::NumericVector& x,
-    SEXP palette,
-    Rcpp::NumericVector& alpha,
-    std::string& na_colour,
-    bool include_alpha = true,
-    bool format = false,
-    std::string format_type = "numeric",
-    int digits = 2,
-    int n_summaries = 0
+      Rcpp::NumericVector& x,
+      SEXP palette,
+      Rcpp::NumericVector& alpha,
+      std::string& format_type,
+      std::string& na_colour,
+      bool include_alpha = true,
+      bool format = false,
+      int digits = 2,
+      int n_summaries = 0
   ) {
 
     //Rcpp::Rcout << "NumericVector x, SEXP palette " << std::endl;
 
     switch( TYPEOF( palette ) ) {
-      // STringVector - needs to get std::string
+    // STringVector - needs to get std::string
     case STRSXP: {
       Rcpp::StringVector sv = Rcpp::as< Rcpp::StringVector >( palette );
       Rcpp::String s = sv[0];
       std::string pal = s;
       return colourvalues::colours_hex::colour_value_hex(
-        x, pal, na_colour, alpha, include_alpha, n_summaries, format, format_type, digits
+        x, pal, na_colour, alpha, include_alpha, format_type, n_summaries, format, digits
       );
     }
     case INTSXP: {}
     case REALSXP: {
       if( !Rf_isMatrix( palette ) ) {
-        Rcpp::stop("Unknown palette type - expecting a matrix");
-      }
+      Rcpp::stop("Unknown palette type - expecting a matrix");
+    }
       Rcpp::NumericMatrix pal = Rcpp::as< Rcpp::NumericMatrix >( palette );
       return colourvalues::colours_hex::colour_value_hex(
-        x, pal, na_colour, include_alpha, n_summaries, format, format_type, digits
+        x, pal, na_colour, include_alpha, format_type, n_summaries, format, digits
       );
     }
     default: {
@@ -222,10 +230,10 @@ namespace api {
       Rcpp::StringVector& x,
       SEXP palette,
       Rcpp::NumericVector& alpha,
+      std::string& format_type,
       std::string na_colour = "#808080",
       bool include_alpha = true,
       bool format = false,
-      std::string format_type = "numeric",
       int digits = 2,
       bool summary = false
   ) {
@@ -267,25 +275,25 @@ namespace api {
       std::string na_colour = "#808080",
       bool include_alpha = true,
       bool format = false,
-      std::string format_type = "numeric",
       int digits = 2,
       bool summary = false,
       int n_summaries = 0
   ) {
     //Rcpp::Rcout << "SEXP x, NumericMatrix palette " << std::endl;
     //Rcpp::Rcout << "include_alpha: " << include_alpha << std::endl;
+    std::string format_type = colourvalues::format::get_format_type( x );
 
     switch( TYPEOF( x ) ) {
     case INTSXP: {}
     case REALSXP: {
       Rcpp::NumericVector nv = Rcpp::as< Rcpp::NumericVector >( x );
       return colourvalues::colours_hex::colour_value_hex(
-        nv, palette, na_colour, include_alpha, n_summaries, format, format_type, digits
+        nv, palette, na_colour, include_alpha, format_type, n_summaries, format, digits
       );
     }
     case VECSXP: { // list
       Rcpp::List lst = Rcpp::as< Rcpp::List >( x );
-      return colour_values_hex( lst, palette, alpha, na_colour, include_alpha, format, format_type, digits, summary, n_summaries );
+      return colour_values_hex( lst, palette, alpha, na_colour, include_alpha, format, digits, summary, n_summaries );
 
     }
     case LGLSXP: {} // as.character
@@ -309,14 +317,14 @@ namespace api {
       std::string na_colour = "#808080",
       bool include_alpha = true,
       bool format = false,
-      std::string format_type = "numeric",
       int digits = 2,
       bool summary = false,
       int n_summaries = 0
   ) {
 
     //Rcpp::Rcout << "SEXP x, StringVector palette " << std::endl;
     //Rcpp::Rcout << "typeof x: " << TYPEOF( x ) << std::endl;
+    std::string format_type = colourvalues::format::get_format_type( x );
 
     Rcpp::String p = palette[0];
     std::string pal = p;
@@ -331,20 +339,20 @@ namespace api {
     } 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
+        nv, pal, na_colour, alpha, include_alpha, format_type, n_summaries, format, digits
       );
     }
     }
     case REALSXP: {
       //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
+        nv, pal, na_colour, alpha, include_alpha, format_type, n_summaries, format, digits
       );
     }
     case VECSXP: { // list
       Rcpp::List lst = Rcpp::as< Rcpp::List >( x );
-      return colour_values_hex( lst, pal, alpha, na_colour, include_alpha, format, format_type, digits, summary, n_summaries );
+      return colour_values_hex( lst, pal, alpha, na_colour, include_alpha, format, digits, summary, n_summaries );
     }
     case LGLSXP: {} // as.character
     default: {
@@ -369,27 +377,28 @@ namespace api {
       std::string na_colour = "#808080",
       bool include_alpha = true,
       bool format = false,
-      std::string format_type = "numeric",
       int digits = 2,
       bool summary = false,
       int n_summaries = 0
   ) {
 
     //Rcpp::Rcout << "SEXP x, SEXP palette " << std::endl;
+    std::string format_type = colourvalues::format::get_format_type( x );
+    //Rcpp::Rcout << "format_type: " << format_type << std::endl;
 
     switch( TYPEOF( palette ) ) {
     case INTSXP: {}
     case REALSXP: {
       Rcpp::NumericMatrix pal = Rcpp::as< Rcpp::NumericMatrix >( palette );
       return colour_values_hex(
-        x, pal, alpha, na_colour, include_alpha, format, format_type, digits, summary, n_summaries
+        x, pal, alpha, na_colour, include_alpha, format, digits, summary, n_summaries
       );
       break;
     }
     case STRSXP: {
       Rcpp::StringVector sv = Rcpp::as< Rcpp::StringVector >( palette );
       return colour_values_hex(
-        x, sv, alpha, na_colour, include_alpha, format, format_type, digits, summary, n_summaries
+        x, sv, alpha, na_colour, include_alpha, format, digits, summary, n_summaries
       );
       break;
     }
@@ -403,7 +412,6 @@ namespace api {
 
   }
 
-
 } // api
 } // colourvalues