Merge branch 'master' into warn_encodings

Author: ben-schwen

NEWS.md

@@ -293,6 +293,7 @@
     #   user  system elapsed
     #  0.028   0.000   0.005
     ```
+    20. `fread()` now supports the `comment.char` argument to skip trailing comments or comment-only lines, consistent with `read.table()`, [#856](https://github.com/Rdatatable/data.table/issues/856). The default remains `comment.char = ""` (no comment parsing) for backward compatibility and performance, in contrast to `read.table(comment.char = "#")`. Thanks to @arunsrinivasan and many others for the suggestion and @ben-schwen for the implementation.
 
 ### BUG FIXES
 

R/fread.R

@@ -2,7 +2,7 @@ fread = function(
 input="", file=NULL, text=NULL, cmd=NULL, sep="auto", sep2="auto", dec="auto", quote="\"", nrows=Inf, header="auto",
 na.strings=getOption("datatable.na.strings","NA"), stringsAsFactors=FALSE, verbose=getOption("datatable.verbose",FALSE),
 skip="__auto__", select=NULL, drop=NULL, colClasses=NULL, integer64=getOption("datatable.integer64","integer64"),
-col.names, check.names=FALSE, encoding="UTF-8", strip.white=TRUE, fill=FALSE, blank.lines.skip=FALSE, key=NULL, index=NULL,
+col.names, check.names=FALSE, encoding="UTF-8", strip.white=TRUE, fill=FALSE, blank.lines.skip=FALSE, comment.char="", key=NULL, index=NULL,
 showProgress=getOption("datatable.showProgress",interactive()), data.table=getOption("datatable.fread.datatable",TRUE),
 nThread=getDTthreads(verbose), logical01=getOption("datatable.logical01",FALSE),
 logicalYN=getOption("datatable.logicalYN", FALSE),
@@ -30,6 +30,9 @@ yaml=FALSE, tmpdir=tempdir(), tz="UTC")
     isTRUEorFALSE(stringsAsFactors) || (is.double(stringsAsFactors) && length(stringsAsFactors)==1L && 0.0<=stringsAsFactors && stringsAsFactors<=1.0),
     is.numeric(nrows), length(nrows)==1L
   )
+  if (!is.character(comment.char) || length(comment.char) != 1L || is.na(comment.char) || nchar(comment.char) > 1L) {
+    stopf("comment.char= must be a single non-NA character.")
+  }
   fill = if(identical(fill, Inf)) .Machine$integer.max else as.integer(fill)
   nrows=as.double(nrows) #4686
   if (is.na(nrows) || nrows<0L) nrows=Inf   # accept -1 to mean Inf, as read.table does
@@ -289,7 +292,7 @@ yaml=FALSE, tmpdir=tempdir(), tz="UTC")
     if (identical(tt,"") || is_utc(tt)) # empty TZ env variable ("") means UTC in C library, unlike R; _unset_ TZ means local
       tz="UTC"
   }
-  ans = .Call(CfreadR,input,identical(input,file),sep,dec,quote,header,nrows,skip,na.strings,strip.white,blank.lines.skip,
+  ans = .Call(CfreadR,input,identical(input,file),sep,dec,quote,header,nrows,skip,na.strings,strip.white,blank.lines.skip,comment.char,
               fill,showProgress,nThread,verbose,warnings2errors,logical01,logicalYN,select,drop,colClasses,integer64,encoding,keepLeadingZeros,tz=="UTC")
   if (!length(ans)) return(null.data.table())  # test 1743.308 drops all columns
   nr = length(ans[[1L]])

inst/tests/tests.Rraw

@@ -21687,8 +21687,135 @@ test(2340.05, .selfref.ok(d3), FALSE)
 setDT(d3)
 test(2340.06, .selfref.ok(d3), TRUE)
 
+# implement comment.char argument in fread, #856
+test(2341.01, fread('a,b
+#a comment
+1,2
+#another comment
+3,4', comment.char='#'), data.table(a=c(1L,3L), b=c(2L,4L)))
+
+test(2341.02, fread('a,b #line-trailing comment
+1,2', comment.char='#'), data.table(a=1L, b=2L))
+
+test(2341.03, fread('a,b#line-trailing comment and no whitespace
+1,2', comment.char='#'), data.table(a=1L, b=2L))
+
+test(2341.04, fread('a,b
+1,2 #trailing after numeric', comment.char='#'), data.table(a=1L, b=2L))
+
+# comment char inside quotes
+test(2341.05, fread('a
+"#quotes#"', comment.char="#"), data.table(a="#quotes#"))
+
+# multi line comments
+test(2341.06, fread('# multi line
+# comment
+1,2 # line-end comment
+# multi line
+# comment
+3,4 # line-end comment
+# trailing comment', comment.char='#'), data.table(V1=c(1L,3L), V2=c(2L,4L)))
+
+test(2341.07, fread('id;value
+1;2,5! trailing comment
+2;NA
+!final comment', sep=';', dec=',', na.strings='NA', comment.char='!'), data.table(id=1:2, value=c(2.5, NA_real_)))
+
+# skip
+test(2341.08, fread('meta line
+DATA STARTS
+x,y
+# skip this
+1,2', skip="DATA", header=TRUE, comment.char='#'), data.table(x=1L, y=2L))
+
+# weird comment chars like space or quote
+test(2341.09, fread('a
+  inline comment
+1', comment.char=' '), data.table(a=1L))
+test(2341.10, fread('a,b
+1,2" trailing"
+"comment line"
+3,4', comment.char='"', quote=""), data.table(a=c(1L,3L), b=c(2L,4L)))
+
+# invalid comment chars
+test(2341.11, fread('a,b
+## multichar commentchar
+1,2', comment.char = '##'), error = "comment.char= must be a single non-NA character")
+
+test(2341.12, fread('a,b
+NA,NA
+1,2', comment.char = NA), error = "comment.char= must be a single non-NA character")
+
+# CLRF
+test(2341.13, fread('a,b\r\n# cmt\r\n1,2\r\n3,4\r\n', comment.char='#'), data.table(a=c(1L,3L), b=c(2L,4L)))
+
+# header comment
+test(2341.14, fread('# hdr cmt
+x,y
+1,2', header=TRUE, comment.char='#'), data.table(x=1L, y=2L))
+
+# nrow not counting comments
+test(2341.15, fread('a,b
+1,2
+# cmt
+3,4
+5,6', nrows=2, comment.char='#'), data.table(a=c(1L,3L), b=c(2L,4L)))
+
+# sep and comment char same
+test(2341.16, fread('a#b
+1#2
+# only comment', sep="#", comment.char="#"), data.table(a=1L))
+
+# na.strings
+local({
+  txt = 'v
+#NA
+1
+# comment'
+  writeLines(txt, tmp <- tempfile())
+  on.exit(unlink(tmp))
+  test(2341.170, fread(tmp, na.strings="#NA", comment.char='#'), data.table(v=1L))
+  test(2341.171, fread(tmp, na.strings="#NA", comment.char='#'), setDT(read.table(tmp, na.strings="#NA", comment.char='#', header=TRUE)))
+})
+
+test(2341.18, fread('a,b
+"p#q",2 # tail
+"r#s",3', comment.char='#'), data.table(a=c("p#q","r#s"), b=c(2L,3L)))
+
+test(2341.19, fread('   # lead comment with padding
+\t# and tab
+a,b
+1,2', comment.char='#'), data.table(a=1L, b=2L))
+
+test(2341.20, fread('a,b      # header cmt with padding # second cmt
+1,2
+3,4', comment.char='#'), data.table(a=c(1L,3L), b=c(2L,4L)))
+
+test(2341.21, fread('# meta1 # meta2
+a,b
+1,2', comment.char = '#'), data.table(a=1L, b=2L))
+test(2341.22, fread('a,b   # inline header comment\r\n1,2\r\n', comment.char = '#'), data.table(a=1L, b=2L))
+
+# control skipping white space before comments with strip.white
+test(2341.230, fread('a
+b  # trailing cmnt
+', comment.char = '#', strip.white = FALSE, sep = ","), data.table(a="b  "))
+test(2341.231, fread('a  # trailing header cmnt 
+b
+', comment.char = '#', strip.white = FALSE, sep = ","), data.table(`a  `="b"))
+test(2341.232, fread('a
+# full line cmnt
+  # full line with leading ws cmnt
+b
+', comment.char = '#', strip.white = FALSE, sep = ","), data.table(a=c("  ", "b")))
+
+test(2341.24, fread('a
+  # leading cmnt
+b
+', comment.char = '#', strip.white = FALSE, sep = ","), data.table(a=c("  ", "b")))
+
 # warn about different encodings in unique and duplicated, #469
 dt = data.table(x=c(iconv("\u00E9","UTF-8","latin1"), "\u00E9"))
-test(2341.1, unique(dt), data.table(x="\u00E9"), warning="Mixed encodings.*")
-test(2341.2, duplicated(dt), c(FALSE, TRUE), warning="Mixed encodings.*")
-test(2341.3, unique(dt[c(2L,2L)]), data.table(x="\u00E9"))
+test(2342.1, unique(dt), data.table(x="\u00E9"), warning="Mixed encodings.*")
+test(2342.2, duplicated(dt), c(FALSE, TRUE), warning="Mixed encodings.*")
+test(2342.3, unique(dt[c(2L,2L)]), data.table(x="\u00E9"))

man/fread.Rd

@@ -17,7 +17,7 @@ skip="__auto__", select=NULL, drop=NULL, colClasses=NULL,
 integer64=getOption("datatable.integer64", "integer64"),
 col.names,
 check.names=FALSE, encoding="unknown",
-strip.white=TRUE, fill=FALSE, blank.lines.skip=FALSE,
+strip.white=TRUE, fill=FALSE, blank.lines.skip=FALSE, comment.char="",
 key=NULL, index=NULL,
 showProgress=getOption("datatable.showProgress", interactive()),
 data.table=getOption("datatable.fread.datatable", TRUE),
@@ -56,6 +56,7 @@ yaml=FALSE, tmpdir=tempdir(), tz="UTC"
   \item{strip.white}{ Logical, default \code{TRUE}, in which case leading and trailing whitespace is stripped from unquoted \code{"character"} fields. \code{"numeric"} fields are always stripped of leading and trailing whitespace.}
   \item{fill}{logical or integer (default is \code{FALSE}). If \code{TRUE} then in case the rows have unequal length, number of columns is estimated and blank fields are implicitly filled. If an integer is provided it is used as an upper bound for the number of columns. If \code{fill=Inf} then the whole file is read for detecting the number of columns. }
   \item{blank.lines.skip}{\code{logical}, default is \code{FALSE}. If \code{TRUE} blank lines in the input are ignored.}
+  \item{comment.char}{Character vector of length one containing a single character of an empty string. Any text after the comment character in a line is ignored, including skipping comment-only lines. Use \code{""} to turn off the interpretation of comments altogether.}
   \item{key}{Character vector of one or more column names which is passed to \code{\link{setkey}}. Only valid when argument \code{data.table=TRUE}. Where applicable, this should refer to column names given in \code{col.names}. }
   \item{index}{ Character vector or list of character vectors of one or more column names which is passed to \code{\link{setindexv}}. As with \code{key}, comma-separated notation like \code{index="x,y,z"} is accepted for convenience. Only valid when argument \code{data.table=TRUE}. Where applicable, this should refer to column names given in \code{col.names}. }
   \item{showProgress}{ \code{TRUE} displays progress on the console if the ETA is greater than 3 seconds. It is produced in fread's C code where the very nice (but R level) txtProgressBar and tkProgressBar are not easily available. }

src/data.table.h

@@ -361,7 +361,7 @@ SEXP setcharvec(SEXP, SEXP, SEXP);
 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 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);
 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);