Add forceDecimal parameter to fwrite (#7212)

* add new feature

* add more tests

* add const qualifier

* Use local for clearer test

* dec= test

* Update man/fwrite.Rd

Co-authored-by: Michael Chirico <[email protected]>

* nocov

* oops

* test #ing

---------

Co-authored-by: Michael Chirico <[email protected]>

Author: ben-schwen

R/fwrite.R

@@ -13,7 +13,8 @@ fwrite = function(x, file="", append=FALSE, quote="auto",
            yaml = FALSE,
            bom = FALSE,
            verbose=getOption("datatable.verbose", FALSE),
-           encoding = "") {
+           encoding = "",
+           forceDecimal = FALSE) {
   na = as.character(na[1L]) # fix for #1725
   if (length(encoding) != 1L || !encoding %chin% c("", "UTF-8", "native")) {
     stopf("Argument 'encoding' must be '', 'UTF-8' or 'native'.")
@@ -51,7 +52,7 @@ fwrite = function(x, file="", append=FALSE, quote="auto",
     length(compressLevel) == 1L && 0L <= compressLevel && compressLevel <= 9L,
     isTRUEorFALSE(col.names), isTRUEorFALSE(append), isTRUEorFALSE(row.names),
     isTRUEorFALSE(verbose), isTRUEorFALSE(showProgress), isTRUEorFALSE(logical01),
-    isTRUEorFALSE(bom),
+    isTRUEorFALSE(bom), isTRUEorFALSE(forceDecimal),
     length(na) == 1L, #1725, handles NULL or character(0) input
     is.character(file) && length(file)==1L && !is.na(file),
     length(buffMB)==1L && !is.na(buffMB) && 1L<=buffMB && buffMB<=1024L,
@@ -122,7 +123,7 @@ fwrite = function(x, file="", append=FALSE, quote="auto",
   }
   .Call(CfwriteR, x, file, sep, sep2, eol, na, dec, quote, qmethod=="escape", append,
         row.names, col.names, logical01, scipen, dateTimeAs, buffMB, nThread,
-        showProgress, is_gzip, compressLevel, bom, yaml, verbose, encoding)
+        showProgress, is_gzip, compressLevel, bom, yaml, verbose, encoding, forceDecimal)
   invisible()
 }
 

inst/tests/tests.Rraw

@@ -21602,3 +21602,21 @@ if (getRversion() >= "4.0.0") { # rely on stopifnot(named = ...) for correct mes
 test(2337.3, is.null(fwrite(data.table(c(0.1, 0.2)), dec=",", sep="\t")))
 test(2337.4, is.null(fwrite(data.table(a=numeric(), b=numeric()), dec=",", sep=",")))
 test(2337.5, is.null(fwrite(data.table(a=numeric()), dec=",", sep=",")))
+
+# 2864 force decimal points for whole numbers in numeric columns
+dd = data.table(x=c(1, 2, 3))
+di = data.table(x=c(1L, 2L, 3L))
+test(2338.1, capture.output(fwrite(dd, forceDecimal=TRUE)), c("x", "1.", "2.", "3."))
+test(2338.2, capture.output(fwrite(dd, forceDecimal=TRUE, dec=",", sep="\t")), c("x", "1,", "2,", "3,"))
+test(2338.3, capture.output(fwrite(dd, forceDecimal=FALSE)), c("x", "1", "2", "3"))
+test(2338.4, capture.output(fwrite(di, forceDecimal=TRUE)), c("x", "1", "2", "3"))
+test(2338.5, capture.output(fwrite(data.table(x=c(0.)), forceDecimal=TRUE)), c("x", "0."))
+test(2338.6, capture.output(fwrite(data.table(x=c(-0.)), forceDecimal=TRUE)), c("x", "0."))
+test(2338.7, capture.output(fwrite(data.table(x=c(0.00)), forceDecimal=TRUE)), c("x", "0."))
+# round trip
+local({
+  f <- tempfile(); on.exit(unlink(f))
+  test(2338.8, {fwrite(dd, f, forceDecimal=TRUE); fread(f)}, dd)
+  test(2338.9, {fwrite(dd, f, forceDecimal=FALSE); fread(f)}, di)
+})
+

man/fwrite.Rd

@@ -21,7 +21,8 @@ fwrite(x, file = "", append = FALSE, quote = "auto",
   yaml = FALSE,
   bom = FALSE,
   verbose = getOption("datatable.verbose", FALSE),
-  encoding = "")
+  encoding = "",
+  forceDecimal = FALSE)
 }
 \arguments{
   \item{x}{Any \code{list} of same length vectors; e.g. \code{data.frame} and \code{data.table}. If \code{matrix}, it gets internally coerced to \code{data.table} preserving col names but not row names}
@@ -62,6 +63,7 @@ fwrite(x, file = "", append = FALSE, quote = "auto",
   \item{bom}{If \code{TRUE} a BOM (Byte Order Mark) sequence (EF BB BF) is added at the beginning of the file; format 'UTF-8 with BOM'.}
   \item{verbose}{Be chatty and report timings?}
   \item{encoding}{ The encoding of the strings written to the CSV file. Default is \code{""}, which means writing raw bytes without considering the encoding. Other possible options are \code{"UTF-8"} and \code{"native"}. }
+  \item{forceDecimal}{ Should decimal points be forced for whole numbers in numeric columns? When \code{FALSE}, the default, whole numbers like \code{c(1.0, 2.0, 3.0)} will be written as \samp{1, 2, 3} i.e., dropping \code{dec}. }
 }
 \details{
 \code{fwrite} began as a community contribution with \href{https://github.com/Rdatatable/data.table/pull/1613}{pull request #1613} by Otto Seiskari. This gave Matt Dowle the impetus to specialize the numeric formatting and to parallelize: \url{https://h2o.ai/blog/2016/fast-csv-writing-for-r/}. Final items were tracked in \href{https://github.com/Rdatatable/data.table/issues/1664}{issue #1664} such as automatic quoting, \code{bit64::integer64} support, decimal/scientific formatting exactly matching \code{write.csv} between 2.225074e-308 and 1.797693e+308 to 15 significant figures, \code{row.names}, dates (between 0000-03-01 and 9999-12-31), times and \code{sep2} for \code{list} columns where each cell can itself be a vector.

src/data.table.h

@@ -319,7 +319,7 @@ SEXP chmatch_R(SEXP, SEXP, SEXP);
 SEXP chmatchdup_R(SEXP, SEXP, SEXP);
 SEXP chin_R(SEXP, SEXP);
 SEXP freadR(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP);
-SEXP fwriteR(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP);
+SEXP fwriteR(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP);
 SEXP rbindlist(SEXP, SEXP, SEXP, SEXP, SEXP);
 SEXP setlistelt(SEXP, SEXP, SEXP);
 SEXP setS4elt(SEXP, SEXP, SEXP);

src/fwrite.c

@@ -42,6 +42,7 @@ static int scipen;
 static bool squashDateTime=false;      // 0=ISO(yyyy-mm-dd) 1=squash(yyyymmdd)
 static bool verbose=false;
 static int gzip_level;
+static bool forceDecimal=false;       // force writing decimal points for numeric columns
 
 extern const char *getString(const void *, int64_t);
 extern int getStringLen(const void *, int64_t);
@@ -198,6 +199,9 @@ void writeFloat64(const void *col, int64_t row, char **pch)
     }
   } else if (x == 0.0) {
     *ch++ = '0';   // and we're done.  so much easier rather than passing back special cases
+    if (forceDecimal) {
+      *ch++ = dec;
+    }
   } else {
     if (x < 0.0) { *ch++ = '-'; x = -x; }  // and we're done on sign, already written. no need to pass back sign
     union { double d; uint64_t l; } u;
@@ -237,8 +241,13 @@ void writeFloat64(const void *col, int64_t row, char **pch)
     if (l % 10 >= 5) l += 10; // use the last digit to round
     l /= 10;
     if (l == 0) {
+      // # nocov start. Very likely not needed as such numbers (e.g. 2^-1075) likely not representable in R.
       if (*(ch - 1) == '-') ch--;
       *ch++ = '0';
+      if (forceDecimal) {
+        *ch++ = dec;
+      }
+      // # nocov end
     } else {
       // Count trailing zeros and therefore s.f. present in l
       int trailZero = 0;
@@ -257,6 +266,10 @@ void writeFloat64(const void *col, int64_t row, char **pch)
         if (sf > dr) width = sf + 1;                     // 1.234 and 123.4
         else { dl0 = 1; width = dr + 1 + dl0; }            // 0.1234, 0.0001234
       }
+      const bool isWholeNumber = (dr == 0 && dl0 >= 0);
+      if (forceDecimal && isWholeNumber) { 
+        width += 1; 
+      }
       // So:  3.1416 => l=31416, sf=5, exp=0     dr=4; dl0=0; width=6
       //      30460  => l=3046, sf=4, exp=4      dr=0; dl0=1; width=5
       //      0.0072 => l=72, sf=2, exp=-3       dr=4; dl0=1; width=6
@@ -269,6 +282,8 @@ void writeFloat64(const void *col, int64_t row, char **pch)
           while (dr && sf) { *ch-- = '0' + l % 10; l /= 10; dr--; sf--; }
           while (dr) { *ch-- = '0'; dr--; }
           *ch-- = dec;
+        } else if (forceDecimal && isWholeNumber) {
+          *ch-- = dec;
         }
         while (dl0) { *ch-- = '0'; dl0--; }
         while (sf) { *ch-- = '0' + l % 10; l /= 10; sf--; }
@@ -615,6 +630,7 @@ void fwriteMain(fwriteMainArgs args)
   int8_t quoteHeaders = args.doQuote;
   verbose = args.verbose;
   gzip_level = args.gzip_level;
+  forceDecimal = args.forceDecimal;
 
   size_t len;
   unsigned int crc;

src/fwrite.h

@@ -117,6 +117,7 @@ typedef struct fwriteMainArgs
   bool bom;
   const char *yaml;
   bool verbose;
+  bool forceDecimal;      // force writing decimal points for numeric columns
 } fwriteMainArgs;
 
 void fwriteMain(fwriteMainArgs args);

src/fwriteR.c

@@ -172,7 +172,8 @@ SEXP fwriteR(
   SEXP bom_Arg,
   SEXP yaml_Arg,
   SEXP verbose_Arg,
-  SEXP encoding_Arg
+  SEXP encoding_Arg,
+  SEXP forceDecimal_Arg    // TRUE|FALSE
   )
 {
   if (!isNewList(DF)) error(_("fwrite must be passed an object of type list; e.g. data.frame, data.table"));
@@ -183,6 +184,7 @@ SEXP fwriteR(
   args.bom = LOGICAL(bom_Arg)[0];
   args.yaml = CHAR(STRING_ELT(yaml_Arg, 0));
   args.verbose = LOGICAL(verbose_Arg)[0];
+  args.forceDecimal = LOGICAL(forceDecimal_Arg)[0];
   args.filename = CHAR(STRING_ELT(filename_Arg, 0));
   args.ncol = length(DF);
   if (args.ncol == 0) {