diff --git a/R/print.data.table.R b/R/print.data.table.R index 3453759449..c6c7314a64 100644 --- a/R/print.data.table.R +++ b/R/print.data.table.R @@ -139,6 +139,8 @@ print.data.table = function(x, topn=getOption("datatable.print.topn"), print_default(toprint) return(invisible(x)) } + if (col.names == "none") + colnames(toprint) = rep.int("", ncol(toprint)) if (nrow(toprint)>20L && col.names == "auto") # repeat colnames at the bottom if over 20 rows so you don't have to scroll up to see them # option to shut this off per request of Oleg Bondar on SO, #1482 diff --git a/inst/tests/tests.Rraw b/inst/tests/tests.Rraw index 6b2703176c..dcbeb40760 100644 --- a/inst/tests/tests.Rraw +++ b/inst/tests/tests.Rraw @@ -21141,3 +21141,149 @@ dt = data.table(id = 1:25) test(2314.1, any(grepl("", tail(capture.output(print(dt, class = TRUE)), 2))), TRUE) # Test that class=TRUE with col.names="top" doesn't show classes at bottom test(2314.2, !any(grepl("", tail(capture.output(print(dt, class = TRUE, col.names = "top")), 2))), TRUE) + +# forder.c coverage +N <- 70000L +DT <- data.table(i = rep(2:1, c(1L, N-1L))) +test(2315.1, tail(DT[order(i), i], 2L), 1:2) +# wider range of numbers needed for further coverage +DT[1L, i := 1000L] +test(2315.2, tail(DT[order(i), i], 2L), c(1L, 1000L)) + +# issue #6898, test that tzone behavior changes with ignore_tzone=TRUE +tms = list(.POSIXct(1), .POSIXct(1.0, "UTC")) +test(2316.1, between(tms[[1]], tms[[1L]], tms[[2L]]), error = "different tzone attributes") +test(2316.2, between(tms[[1]], tms[[1L]], tms[[2L]], ignore_tzone=TRUE)) +test(2316.3, between(tms[[1]], tms[[2L]], tms[[2L]]), message = "mismatched tzone attributes") +test(2316.4, between(tms[[1]], tms[[2L]], tms[[2L]], ignore_tzone=TRUE)) + +# tbl in i still allows 'i.' prefix reference for update join, #6998 +DT1 = data.table(a=1, b=2) +DT2 = data.table(a=1, c=3) +DF1 = data.frame(a=1, d=4) +DF2 = data.frame(a=1, e=5) +class(DF2) = c("tbl_df", "tbl", "data.frame") + +test(2317.1, DT1[DT2, on='a', c := i.c]$c, 3) +test(2317.2, DT1[DT2, on='a', c2 := x.a + i.c]$c2, 4) +test(2317.3, DT1[DT2, on='a', .(c = x.a + i.c)]$c, 4) +test(2317.4, DT1[DF1, on='a', d := i.d]$d, 4) +test(2317.5, DT1[DF1, on='a', d2 := x.a + i.d]$d2, 5) +test(2317.6, DT1[DF1, on='a', .(d = x.a + i.d)]$d, 5) +test(2317.7, DT1[DF2, on='a', e := i.e]$e, 5) +test(2317.8, DT1[DF2, on='a', e2 := x.a + i.e]$e2, 6) +test(2317.9, DT1[DF2, on='a', .(e = x.a + i.e)]$e, 6) + +#6864 +dt_get = data.frame(a = 1:3, b = letters[1:3]) +setDT(get("dt_get")) +test(2319.1, !is.null(attr(dt_get, ".internal.selfref"))) + +dt_get0 = data.frame(a = 1:3, b = letters[1:3]) +setDT(get0("dt_get0")) +test(2319.2, !is.null(attr(dt_get0, ".internal.selfref"))) + +# Improved fread error handling for cmd exe and decompression #5415 +test(2320.1, fread(cmd="false"), error="External command failed with exit code", warning = if (.Platform$OS.type=="windows") "execution failed") + +if (test_R.utils) local({ + tmp <- tempfile(fileext=".gz") + file.create(tmp); on.exit(unlink(tmp)) + local({ + conn <- file(tmp, 'wb'); on.exit(close(conn)) + writeBin(as.raw(c(31L, 139L)), conn) # Gzip header magic numbers to trigger that read path + }) + test(2320.2, fread(tmp), error="R.utils::decompressFile failed to decompress", warning="invalid") +}) + +# Create a data.table when one vector is transposed doesn't respect the name defined by user #4124 +test(2321.1, DT <- data.table(a=1:2, b=matrix(1:2)), data.table(a=1:2, b=1:2)) +test(2321.2, names(DT), names(data.frame(a=1:2, b=matrix(1:2)))) +test(2321.3, DT <- data.table(a=integer(), b=matrix(1L, nrow=0L, ncol=1L)), data.table(a=integer(), b=integer())) +test(2321.4, names(DT), names(data.frame(a=integer(), b=matrix(1L, nrow=0L, ncol=1L)))) +## but respect named column vectors +test(2321.5, DT <- data.table(a=1:2, cbind(b=3:4)), data.table(a=1:2, b=3:4)) +test(2321.6, names(DT), names(data.frame(a=1:2, cbind(b=3:4)))) + +# New fctr() helper: like factor() but retaining order by default #4837 +test(2322.01, levels(fctr(c("b","a","c"))), c("b","a","c")) +test(2322.02, levels(fctr(c(3,1,2))), c("3","1","2")) +test(2322.11, levels(fctr(c("b","a","c"), rev=TRUE)), c("c","a","b")) +test(2322.12, levels(fctr(c("b","a","c"), rev=NA)), error="TRUE or FALSE") +test(2322.21, levels(fctr(c("b","a","c"), sort=TRUE)), c("a","b","c")) +test(2322.22, levels(fctr(c("b","a","c"), sort=NA)), error="TRUE or FALSE") +test(2322.31, levels(fctr(c("b","a","c"), rev=TRUE, sort=TRUE)), c("c","b","a")) + +# data.frame() uses provided names of ITime inputs +it <- as.ITime('00:00:00') +test(2323.1, names(data.frame(COL = it)), "COL") +test(2323.2, names(data.frame(b = 1, COL = it)), c("b", "COL")) +test(2323.3, names(as.data.frame(it, optional=TRUE)), NULL) + +# 'sets' is a local variable in groupingsets(), cube(), rollup() and shouldn't leak into the 'j' expression +n = 24L +set.seed(25) +DT = data.table( + color = sample(c("green","yellow","red"), n, TRUE), + year = as.Date(sample(paste0(2011:2015,"-01-01"), n, TRUE)), + status = as.factor(sample(c("removed","active","inactive","archived"), n, TRUE)), + amount = sample(1:5, n, TRUE), + value = sample(c(3, 3.5, 2.5, 2), n, TRUE) +) +sets = 0 +test(2324.0, + groupingsets(DT, j = c(list(count=.N + ..sets)), by = c("color","year","status"), sets = list("color", c("year","status"), character()), id=TRUE), + groupingsets(DT, j = c(list(count=.N + 0)), by = c("color","year","status"), sets = list("color", c("year","status"), character()), id=TRUE) +) +test(2324.1, + cube(DT, j = sum(value) + ..sets, by = c("color","year","status"), id=TRUE), + cube(DT, j = sum(value), by = c("color","year","status"), id=TRUE) +) +test(2324.2, + rollup(DT, j = sum(value) + ..sets, by=c("color","year","status"), label="total"), + rollup(DT, j = sum(value), by=c("color","year","status"), label="total") +) + +# allow na.strings to be quoted, #6974 +f = tempfile() +DT = data.table( + "Date Example"=c("12/5/2012", NA), + "Question 1"=c("Yes", NA), + "Question 2"=c("Yes", NA), + "Site: Country"=c("Chile", "Virgin Islands, British") +) +fwrite(DT, f, na='""') +test(2325.1, fread(f, na.strings='""'), DT) +unlink(f) +test(2325.2, + fread('"foo","bar","baz"\n"a","b","c"', na.strings=c('"foo"', '"bar"', '"baz"'), header=FALSE), + data.table(V1=c(NA, "a"), V2=c(NA, "b"), V3=c(NA, "c"))) + +## ensure setDT will retain key and indices when it is called on the list (cbindlist assumes this) +local({ + d = data.table(x=1:2, y=2:1, z=2:1, v1=1:2) + setkeyv(d, "x"); setindexv(d, list("y", "z")) + a = attributes(d) + attributes(d) = a[!names(a) %in% c("class", ".internal.selfref", "row.names")] + test(2326.1, class(d), "list") + setDT(d) + test(2326.2, key(d), "x") + test(2326.3, indices(d), c("y", "z")) +}) + +#6964 +# Test 1: No warning from min() with simple data +DT = data.table(var = c("a", "b", "c", "d"), value=c(1:3, NA)) +test(2327.1, cube(DT, .(min(value)), "var"), + data.table(var = c("a", "b", "c", "d", NA), V1 = c(1.0, 2.0, 3.0, NA, NA))) +test(2327.2, cube(DT, .(as.numeric(base::min(value, na.rm=TRUE))), "var"), + data.table(var = c("a", "b", "c", "d", NA), V1 = c(1.0, 2.0, 3.0, Inf, 1.0)), + warning="no non-missing arguments to min") + +#6882 +dt = data.table(short = 1:3, verylongcolumnname = 4:6) +test(2328.1, print(dt, col.names = "none"), output = "1: 1 4\n2: 2 5\n3: 3 6\n") +dt = data.table(x = 123456, y = "wide_string") +test(2328.2, print(dt, col.names = "none"), output = "1: 123456 wide_string\n") +dt = data.table(a = NA_integer_, b = NaN) +test(2328.3, print(dt, col.names = "none"), output = "1: NA NaN\n")