From 2dc6795e7d509c021a7b765878b81fc6bf73bc22 Mon Sep 17 00:00:00 2001 From: "Watal M. Iwasaki" Date: Wed, 6 Feb 2019 12:50:06 +0900 Subject: [PATCH 1/3] Print zero-column data.frame properly --- NEWS.md | 2 ++ R/print.data.table.R | 4 ++-- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/NEWS.md b/NEWS.md index 3a1036e65..d824883e6 100644 --- a/NEWS.md +++ b/NEWS.md @@ -20,6 +20,8 @@ 4. The Travis build matrix is expanded to OSX and to the R previous major and R-devel releases [#3326](https://github.com/Rdatatable/data.table/issues/3326). An OpenMP enabled compiler is required to correctly build on OSX, therefore the homebrew llvm package is installed on the Travis (OSX) machine before R CMD build is run. The OSX build on R-devel was explicitly excluded because it's currently unstable. Thanks @marcusklik for the PR. +5. Improve `print.data.table()` to handle `data.frame` with 0 column properly. + Thanks @heavywatal for the PR. ### Changes in v1.12.0 (13 Jan 2019) diff --git a/R/print.data.table.R b/R/print.data.table.R index 05f2969bd..8ab68820e 100644 --- a/R/print.data.table.R +++ b/R/print.data.table.R @@ -42,9 +42,9 @@ print.data.table <- function(x, topn=getOption("datatable.print.topn"), cat("Ind", if (length(ixs) > 1L) "ices" else "ex", ": <", paste(ixs, collapse=">, <"), ">\n", sep="") } - if (nrow(x) == 0L) { + if (any(dim(x) == 0L)) { if (length(x)==0L) - cat("Null data.table (0 rows and 0 cols)\n") # See FAQ 2.5 and NEWS item in v1.8.9 + cat("Null data.table (", dim(x)[1L], " rows and 0 cols)\n", sep = "") # See FAQ 2.5 and NEWS item in v1.8.9 else cat("Empty data.table (0 rows) of ",length(x)," col",if(length(x)>1L)"s",": ",paste(head(names(x),6L),collapse=","),if(ncol(x)>6L)"...","\n",sep="") return(invisible(x)) From 8c361160860714307ce25cf9d743763aef4fc2a8 Mon Sep 17 00:00:00 2001 From: mattdowle Date: Thu, 7 Feb 2019 15:45:25 -0800 Subject: [PATCH 2/3] Tidied output; e.g. Null is specially for 0 row 0 col --- R/print.data.table.R | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/R/print.data.table.R b/R/print.data.table.R index 8ab68820e..cc0962d2a 100644 --- a/R/print.data.table.R +++ b/R/print.data.table.R @@ -42,11 +42,12 @@ print.data.table <- function(x, topn=getOption("datatable.print.topn"), cat("Ind", if (length(ixs) > 1L) "ices" else "ex", ": <", paste(ixs, collapse=">, <"), ">\n", sep="") } - if (any(dim(x) == 0L)) { - if (length(x)==0L) - cat("Null data.table (", dim(x)[1L], " rows and 0 cols)\n", sep = "") # See FAQ 2.5 and NEWS item in v1.8.9 + if (any(dim(x)==0L)) { + class = if (is.data.table(x)) "table" else "frame" # a data.frame could be passed to print.data.table() directly, #3363 + if (all(dim(x)==0L)) + cat("Null data.",class," (0 rows and 0 cols)\n", sep="") # See FAQ 2.5 and NEWS item in v1.8.9 else - cat("Empty data.table (0 rows) of ",length(x)," col",if(length(x)>1L)"s",": ",paste(head(names(x),6L),collapse=","),if(ncol(x)>6L)"...","\n",sep="") + cat("Empty data.",class," (", dim(x)[1L], " rows and ",length(x)," cols): ",paste(head(names(x),6L),collapse=","),if(ncol(x)>6L)"...","\n",sep="") return(invisible(x)) } if ((topn*2+1)nrows || !topnmiss)) { From 798e042699def0e674d04c2668cc104c2cb40e10 Mon Sep 17 00:00:00 2001 From: mattdowle Date: Thu, 7 Feb 2019 16:17:24 -0800 Subject: [PATCH 3/3] Fixed tests and added a new one to cover the fixed error --- NEWS.md | 4 ++-- R/print.data.table.R | 9 ++++++--- inst/tests/tests.Rraw | 18 ++++++++++-------- 3 files changed, 18 insertions(+), 13 deletions(-) diff --git a/NEWS.md b/NEWS.md index d824883e6..42416aa42 100644 --- a/NEWS.md +++ b/NEWS.md @@ -20,8 +20,8 @@ 4. The Travis build matrix is expanded to OSX and to the R previous major and R-devel releases [#3326](https://github.com/Rdatatable/data.table/issues/3326). An OpenMP enabled compiler is required to correctly build on OSX, therefore the homebrew llvm package is installed on the Travis (OSX) machine before R CMD build is run. The OSX build on R-devel was explicitly excluded because it's currently unstable. Thanks @marcusklik for the PR. -5. Improve `print.data.table()` to handle `data.frame` with 0 column properly. - Thanks @heavywatal for the PR. +5. Calling `data.table:::print.data.table()` directly (i.e. bypassing method dispatch by using 3 colons) and passing it a 0-column `data.frame` (not `data.table`) now works, [#3363](https://github.com/Rdatatable/data.table/pull/3363). Thanks @heavywatal for the PR. + ### Changes in v1.12.0 (13 Jan 2019) diff --git a/R/print.data.table.R b/R/print.data.table.R index cc0962d2a..502ded91e 100644 --- a/R/print.data.table.R +++ b/R/print.data.table.R @@ -44,10 +44,13 @@ print.data.table <- function(x, topn=getOption("datatable.print.topn"), } if (any(dim(x)==0L)) { class = if (is.data.table(x)) "table" else "frame" # a data.frame could be passed to print.data.table() directly, #3363 - if (all(dim(x)==0L)) + if (all(dim(x)==0L)) { cat("Null data.",class," (0 rows and 0 cols)\n", sep="") # See FAQ 2.5 and NEWS item in v1.8.9 - else - cat("Empty data.",class," (", dim(x)[1L], " rows and ",length(x)," cols): ",paste(head(names(x),6L),collapse=","),if(ncol(x)>6L)"...","\n",sep="") + } else { + cat("Empty data.",class," (", dim(x)[1L], " rows and ",length(x)," cols)", sep="") + if (length(x)>0L) cat(": ",paste(head(names(x),6L),collapse=","),if(length(x)>6L)"...",sep="") + cat("\n") + } return(invisible(x)) } if ((topn*2+1)nrows || !topnmiss)) { diff --git a/inst/tests/tests.Rraw b/inst/tests/tests.Rraw index 097ab1ec4..3ddfc6d9a 100644 --- a/inst/tests/tests.Rraw +++ b/inst/tests/tests.Rraw @@ -52,6 +52,7 @@ if (exists("test.data.table", .GlobalEnv, inherits=FALSE)) { groupingsets.data.table = data.table:::groupingsets.data.table dcast.data.table = data.table:::dcast.data.table all.equal.data.table = data.table:::all.equal.data.table + print.data.table = data.table:::print.data.table # Also, for functions that are masked by other packages, we need to map the data.table one. Or else, # the other package's function would be picked up. As above, we only need to do this because we desire @@ -476,7 +477,7 @@ g <- quote( list( d ) ) test(170, DT[,list(d)], DT[,eval(g)]) DT = data.table(A=c(25L,85L,25L,25L,85L), B=c("a","a","b","c","c"), C=c(2,65,9,82,823)) -test(171.1, DT[B=="b"][A==85], output="Empty data.table (0 rows) of 3 cols: A,B,C") +test(171.1, DT[B=="b"][A==85], output="Empty data.table (0 rows and 3 cols): A,B,C") test(171.2, DT[B=="b"][A==85,C], numeric()) test(171.3, DT[ , data.table( A, C )[ A==25, C ] + data.table( A, C )[ A==85, C ], by=B ], data.table(B=c("a","c"),V1=c(67,905))) test(172, DT[ , list(3,data.table( A, C )[ A==25, C ] + data.table( A, C )[ A==85, C ]), by=B ], data.table(B=c("a","b","c"),V1=3,V2=c(67,NA,905))) @@ -1669,9 +1670,10 @@ DT = data.table(a=1:3,v=1:6) test(581, DT[a<1,sum(v),by=a], data.table(a=integer(),V1=integer())) test(582, DT[a<1,sum(v),by=list(a)], data.table(a=integer(),V1=integer())) test(583, DT[a<1], DT[0]) -test(584, DT[a<1], output="Empty data.table (0 rows) of 2 cols: a,v") -test(585, DT[a<1,list(v)], output="Empty data.table (0 rows) of 1 col: v") -test(586, data.table(a=integer(),V1=integer()), output="Empty data.table (0 rows) of 2 cols: a,V1") +test(584, DT[a<1], output="Empty data.table (0 rows and 2 cols): a,v") +test(585, DT[a<1,list(v)], output="Empty data.table (0 rows and 1 cols): v") +test(586.1, data.table(a=integer(),V1=integer()), output="Empty data.table (0 rows and 2 cols): a,V1") +test(586.2, print.data.table(iris[,FALSE]), output="Empty data.frame (150 rows and 0 cols)") #3363 # Test that .N is available in by on empty table, also in #1945 test(587, DT[a<1,list(sum(v),.N),by=a], data.table(a=integer(),V1=integer(),N=integer())) @@ -2388,7 +2390,7 @@ test(867, names(ans2<-DT[,list(name1=sum(v),name2=sum(w)),by="a,b"]), c("a","b", test(868, ans1, ans2) # and related to setnames, too DT = data.table(a=1:3,b=1:6,key="a") -test(869, DT[J(2,42,84),print(.SD),by=.EACHI], output=" b\n.*1.*2\n2:.*5.*Empty data.table.*of 3 cols: a,V2,V3") # .* for when verbose mode +test(869, DT[J(2,42,84),print(.SD),by=.EACHI], output=" b\n.*1.*2\n2:.*5.*Empty data.table [(]0 rows and 3 cols[)]: a,V2,V3") # .* for when verbose mode # Test setnames with duplicate colnames DT = data.table(a=1:3,b=4:6,b=7:9) @@ -3056,9 +3058,9 @@ test(1061, x[c(0, 3), number:=5L], ans) # bug #2440 fix - seqfault when j refers to grouping variable when results are empty DT = data.table(x=rep(c("a","b"),each=3),v=c(42,42,42,4,5,6)) -test(1062, DT[x %in% c('z'),list(x2=x),by=x], output="Empty data.table (0 rows) of 2 cols: x,x2") -test(1063, DT[x %in% c('z'),list(vpaste=paste(v,collapse=','),x2=paste(x,x)),by=x], output="Empty data.table (0 rows) of 3 cols: x,vpaste,x2") -test(1064, DT[integer(0), list(x2=x), by=x], output="Empty data.table (0 rows) of 2 cols: x,x2") +test(1062, DT[x %in% c('z'),list(x2=x),by=x], output="Empty data.table (0 rows and 2 cols): x,x2") +test(1063, DT[x %in% c('z'),list(vpaste=paste(v,collapse=','),x2=paste(x,x)),by=x], output="Empty data.table (0 rows and 3 cols): x,vpaste,x2") +test(1064, DT[integer(0), list(x2=x), by=x], output="Empty data.table (0 rows and 2 cols): x,x2") # bug #2445 fix - := fails when subsetting yields NAs and with=FALSE X = data.table(A=1:3, B=1:6, key="A")