Merge pull request #1 from eddelbuettel/feature/asdouble2

New function (as.double2), plus documentation and tests.

DESCRIPTION

@@ -17,5 +17,6 @@ LinkingTo: Rcpp
 Suggests: tinytest
 URL: https://github.com/eddelbuettel/rcppfastfloat/
 BugReports: https://github.com/eddelbuettel/rcppfastfloat/issues
-RoxygenNote: 6.0.1
+RoxygenNote: 7.1.1
+Roxygen: list(markdown = TRUE)
 Encoding: UTF-8

R/RcppExports.R

@@ -1,6 +1,41 @@
 # Generated by using Rcpp::compileAttributes() -> do not edit by hand
 # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
 
+#' Ultra efficient string-to-`double` Conversion
+#'
+#' For `character` `vector`s,`as.double2()` is a drop-in replacement for `base::as.double()`.
+#'
+#' @param x A vector of type `character`.
+#'
+#' @seealso [base::as.double()]
+#'
+#' @examples
+#' set.seed(8675309)
+#' input <- sample(c(
+#'   paste0(" \r\n\t\f\v", c(0.0, sqrt(seq(1, 10))), " \r\n\t\f\v"),
+#'   c("NaN", "-NaN", "nan", "-nan",
+#'     "Inf", "-Inf", "inf", "-inf", "infinity", "-infinity",
+#'     NA_character_,
+#'     "  1970-01-01", "1970-01-02  ")
+#' ))
+#' input
+#'
+#' suppressWarnings(as.double2(input)) # NAs introduced by coercion
+#'
+#' comparison <- suppressWarnings(
+#'   matrix(c(as.double(input), as.double2(input)),
+#'          ncol = 2L,
+#'          dimnames = list(NULL, c("as.double()", "as.double2()")))
+#' )
+#' comparison
+#'
+#' all.equal(comparison[, "as.double()"], comparison[, "as.double2()"])
+#'
+#' @export
+as.double2 <- function(x) {
+    .Call(`_RcppFastFloat_as_dbl`, x)
+}
+
 #' Floating Point Parsing Example
 #'
 #' This example is adapted from the example of the upstream README.md file, and generalized

inst/tinytest/test_asdouble2.R

@@ -0,0 +1,13 @@
+library(RcppFastFloat)
+
+set.seed(8675309)
+input <- sample(c(
+  paste0(" \r\n\t\f\v", c(0.0, sqrt(seq(1, 10))), " \r\n\t\f\v"),
+  c("NaN", "-NaN", "nan", "-nan",
+    "Inf", "-Inf", "inf", "-inf", "infinity", "-infinity",
+    NA_character_,
+    "  1970-01-01", "1970-01-02  ")
+))
+
+expect_equal(suppressWarnings(as.double(input)),
+             suppressWarnings(as.double2(input)))

src/RcppExports.cpp

@@ -5,6 +5,22 @@
 
 using namespace Rcpp;
 
+#ifdef RCPP_USE_GLOBAL_ROSTREAM
+Rcpp::Rostream<true>&  Rcpp::Rcout = Rcpp::Rcpp_cout_get();
+Rcpp::Rostream<false>& Rcpp::Rcerr = Rcpp::Rcpp_cerr_get();
+#endif
+
+// as_dbl
+Rcpp::DoubleVector as_dbl(const Rcpp::CharacterVector x);
+RcppExport SEXP _RcppFastFloat_as_dbl(SEXP xSEXP) {
+BEGIN_RCPP
+    Rcpp::RObject rcpp_result_gen;
+    Rcpp::RNGScope rcpp_rngScope_gen;
+    Rcpp::traits::input_parameter< const Rcpp::CharacterVector >::type x(xSEXP);
+    rcpp_result_gen = Rcpp::wrap(as_dbl(x));
+    return rcpp_result_gen;
+END_RCPP
+}
 // parseExample
 double parseExample(const std::string& input, bool verbose);
 RcppExport SEXP _RcppFastFloat_parseExample(SEXP inputSEXP, SEXP verboseSEXP) {
@@ -19,6 +35,7 @@ END_RCPP
 }
 
 static const R_CallMethodDef CallEntries[] = {
+    {"_RcppFastFloat_as_dbl", (DL_FUNC) &_RcppFastFloat_as_dbl, 1},
     {"_RcppFastFloat_parseExample", (DL_FUNC) &_RcppFastFloat_parseExample, 2},
     {NULL, NULL, 0}
 };

src/as_double2.cpp

@@ -0,0 +1,73 @@
+#define STRICT_R_HEADERS
+#include <Rcpp.h>
+
+#include "fast_float/fast_float.h"
+
+/* essentially isBlankString(), but returns bool instead of Rboolean */
+bool is_only_whitespace(const char *s) noexcept {
+  while (*s) {
+    if (!std::isspace(static_cast<unsigned char>(*s))) {
+      return false;
+    }
+    ++s;
+  }
+  return true;
+}
+
+//' Ultra efficient string-to-`double` Conversion
+//'
+//' For `character` `vector`s,`as.double2()` is a drop-in replacement for `base::as.double()`.
+//'
+//' @param x A vector of type `character`.
+//'
+//' @seealso [base::as.double()]
+//'
+//' @examples
+//' set.seed(8675309)
+//' input <- sample(c(
+//'   paste0(" \r\n\t\f\v", c(0.0, sqrt(seq(1, 10))), " \r\n\t\f\v"),
+//'   c("NaN", "-NaN", "nan", "-nan",
+//'     "Inf", "-Inf", "inf", "-inf", "infinity", "-infinity",
+//'     NA_character_,
+//'     "  1970-01-01", "1970-01-02  ")
+//' ))
+//' input
+//'
+//' suppressWarnings(as.double2(input)) # NAs introduced by coercion
+//'
+//' comparison <- suppressWarnings(
+//'   matrix(c(as.double(input), as.double2(input)),
+//'          ncol = 2L,
+//'          dimnames = list(NULL, c("as.double()", "as.double2()")))
+//' )
+//' comparison
+//'
+//' all.equal(comparison[, "as.double()"], comparison[, "as.double2()"])
+//'
+//' @export
+// [[Rcpp::export(as.double2)]]
+Rcpp::DoubleVector
+as_dbl(const Rcpp::CharacterVector x) {
+  const auto n{x.size()};
+  Rcpp::DoubleVector out(n, NA_REAL);
+  bool any_failures{false};
+
+  for (R_xlen_t i = 0; i < n; ++i) {
+    const char *cstring = CHAR(x[i]);
+    double d;
+    const auto res = fast_float::from_chars(
+        cstring, cstring + std::char_traits<char>::length(cstring), d);
+
+    if (res.ec == std::errc() && is_only_whitespace(res.ptr)) {
+      out[i] = d;
+    } else {
+      any_failures = true;
+    }
+  }
+
+  if (any_failures) {
+    Rcpp::warning("NAs introduced by coercion");
+  }
+
+  return out;
+}