diff --git a/inst/tests/other.Rraw b/inst/tests/other.Rraw index 11b00cc54..c6520a377 100644 --- a/inst/tests/other.Rraw +++ b/inst/tests/other.Rraw @@ -1,10 +1,16 @@ -pkgs = c("ggplot2", "hexbin", "plyr", "dplyr", "caret", "zoo", "xts", "gdata", "nlme", "bit64", "knitr", "parallel", "sf") +pkgs = c("ggplot2", "hexbin", "plyr", "dplyr", "caret", "zoo", "xts", "gdata", "nlme", "bit64", "knitr", "parallel", "sf", "nanotime", "R.utils", "yaml") # First expression of this file must be as above: .gitlab-ci.yml uses parse(,n=1L) to read one expression from this file and installs pkgs. # So that these dependencies of other.Rraw are maintained in a single place. # TEST_DATA_TABLE_WITH_OTHER_PACKAGES is off by default so this other.Rraw doesn't run on CRAN. It is run by GLCI, locally in dev, and by # users running test.data.table("other.Rraw"). # zoo needs to be before xts for #5101 otherwise xts's dependency zoo gets attached at position 2 if xts is loaded first +# Optional Suggest-ed package tests moved from tests.Rraw to here in #5516. Retaining their comments: +# "xts", # we have xts methods in R/xts.R +# "nanotime", # fwrite looks for the 'nanotime' class name at C level (but we have our own writer in C, though) +# "yaml" # for fread's yaml argument (csvy capability) +# # zoo # In DESCRIPTION:Suggests otherwise R CMD check warning: '::' or ':::' import not declared from: 'zoo'; it is tested in other.Rraw though + if (exists("test.data.table",.GlobalEnv,inherits=FALSE) || !"package:data.table" %in% search()) { stop("Usage: R CMD INSTALL; require(data.table); test.data.table('other.Rraw')") @@ -207,3 +213,481 @@ if (loaded[["sf"]]) { #2273 test(15, DT[1:3, .(NAME, FIPS, geometry)], output="Ashe.*-81.4.*Surry.*-80.4") } +if (loaded[["yaml"]]) { # csvy; #1701. Was 2032-2033 in tests.Rraw, #5516 + f = testDir("csvy/test.csvy") + DT = data.table(var1 = c("A", "B"), + var2 = c(1L, 3L), + var3 = c(2.5, 4.3)) + DT_yaml = copy(DT) + setattr(DT_yaml, 'yaml_metadata', + list(name = "my-dataset", + source = "https://github.com/leeper/csvy/tree/master/inst/examples", + schema = list(fields = list( + list(name = "var1", title = "variable 1", type = "string", + description = "explaining var1", + constraints = list(list(required = TRUE))), + list(name = "var2", title = "variable 2", type = "integer"), + list(name = "var3", title = "variable 3", type = "number") + )))) + ## with skip = '__auto__', fread can figure out + ## how to start after the metadata (just ignoring it) + test(16.01, fread(f), DT) + ## should be the same, but with yaml_metadata attribute + test(16.02, fread(f, yaml = TRUE), DT_yaml) + ## testing verbose messaging + test(16.03, fread(f, yaml = TRUE, verbose = TRUE), + DT_yaml, output = 'Processed.*YAML metadata.*') + ## this file is identical, except the body of the + ## YAML header is commented out with # (should read identically) + test(16.04, + fread(testDir('csvy/test_comment.csvy'), yaml = TRUE), + DT_yaml) + ## user input is taken as most intentional & overrides YAML + DT_yaml[ , var2 := as.numeric(var2)] + test(16.05, fread(f, yaml = TRUE, colClasses = list(numeric = 'var2')), + DT_yaml, message = 'colClasses.*YAML header are in conflict.*var2') + ## extraneous/unused fields shouldn't throw off reading + DT = fread(testDir('csvy/test_extraneous.csvy'), yaml = TRUE) + test(16.06, names(DT), c('Date', 'WTI')) + test(16.07, attr(DT, 'yaml_metadata'), + list(names = c("Date", "WTI"), class = "data.frame", + title = "Cushing, OK WTI Spot Price FOB", filename = "data.csv", + fileurl = "https://raw.githubusercontent.com/jrovegno/csvy/master/data.csv", + sourceurl = "http://www.eia.gov/dnav/pet/hist/LeafHandler.ashx?n=PET&s=RWTC&f=D", + source_csvy = "https://github.com/leeper/csvy/tree/master/inst/examples", + item = "PET", sourcekey = "RWTC", freq = "Daily", + rate = "MID", type = "price", units = "Dollars per Barrel", + latestdate = "2015-08-31", releasedate = "2015-09-02", + nextreleasedate = "2015-09-10", source = "Thomson Reuters", + contactemail = "infoctr@eia.doe.gov", contactphone = "(202) 586-8800")) + ## yaml can also handle sep, dec, quote, and na.strings + DT_out = data.table(var1 = c("A", "B"), + var2 = c(1L, NA), + var3 = c(2.5, 4.3)) + meta = + list(name = NULL, + schema = list(fields = list( + list(name = "var1", title = "variable 1", type = "string", + description = "a single-quoted character variable"), + list(name = "var2", title = "variable 2", type = "integer"), + list(name = "var3", title = "variable 3", type = "number", + description = "European-style numeric") + )), + header = TRUE, sep = "|", dec = ",", + quote = "'", na.strings = "@") + attr(DT_out, 'yaml_metadata') = meta + test(16.08, fread(testDir( 'csvy/test_attributes.csvy'), yaml = TRUE), DT_out) + ## user-specified attributes can override data from YAML + meta$sep = "-" + setattr(DT_out, 'yaml_metadata', meta) + test(16.09, fread(testDir('csvy/test_override_sep.csvy'), yaml = TRUE, sep = '|'), DT_out, + message = 'User-supplied.*sep.*override') + + meta$sep = "|" + setattr(DT_out, 'yaml_metadata', meta) + test(16.10, fread(testDir('csvy/test_override_header.csvy'), yaml = TRUE, header = FALSE), + DT_out, message = 'User-supplied.*header.*override') + col.names = c('x', 'y', 'z') + setnames(DT_out, col.names) + test(16.11, fread(testDir('csvy/test_override_header.csvy'), yaml = TRUE, header = FALSE, col.names = col.names), DT_out, + message = c('User-supplied.*header.*override', 'User-supplied.*col.names.*override')) + + test(16.12, fread(testDir('csvy/test_attributes.csvy'), yaml = TRUE, col.names = col.names), + DT_out, message = 'User-supplied.*col.names') + + setnames(DT_out, c('var1', 'var2', 'var3')) + meta$quote = "^" + setattr(DT_out, 'yaml_metadata', meta) + test(16.13, fread(testDir('csvy/test_override_quote.csvy'), yaml = TRUE, quote = "'"), + DT_out, message = 'User-supplied.*quote') + + meta$quote = "'" + meta$dec = "." + setattr(DT_out, 'yaml_metadata', meta) + test(16.14, fread(testDir('csvy/test_override_dec.csvy'), yaml = TRUE, dec = ','), + DT_out, message = 'User-supplied.*dec') + + meta$dec = ',' + meta$na.strings = 'NA' + setattr(DT_out, 'yaml_metadata', meta) + test(16.15, fread(testDir('csvy/test_override_na.csvy'), yaml = TRUE, na.strings = '@'), + DT_out, message = 'User-supplied.*na.strings') + + ## error if YAML malformed + test(16.16, fread(testDir('csvy/test_incomplete_header.csvy'), yaml = TRUE), + error = 'Reached the end.*YAML.*valid csvy') + ## use any other CSV in test directory which doesn't have YAML + if (loaded[["R.utils"]]) test(16.17, fread(testDir('issue_2051.csv.gz'), yaml = TRUE), + error = 'Encountered.*unskipped.*constitute.*valid YAML') + ## no problem if some fields are missing a type (just + ## resort to standard auto-inferral, i.e., identical to + ## the case of partially-specified colClasses) + DT = data.table(var1 = c("A", "B"), var2 = c(1L, 3L), + var3 = c(2.5, 4.3)) + setattr(DT, 'yaml_metadata', + list(name = "my-dataset", source = "https://github.com/leeper/csvy/tree/master/inst/examples", + schema = list(fields = list( + list(name = "var1"), list(name = "var2", type = "integer"), + list(name = "var3", type = "number") + )))) + test(16.18, fread(testDir('csvy/test_missing_type.csvy'), yaml = TRUE), DT) + ## skip applies starting after the YAML header + setattr(DT, 'yaml_metadata', + list(schema = list(fields = list( + list(name = "var1", type = "string"), + list(name = "var2", type = "integer"), + list(name = "var3", type = "number") + )))) + test(16.19, fread(testDir('csvy/test_skip.csvy'), yaml = TRUE, skip = 2L), DT) + ## user-supplied col.names override metadata (as for colClasses) + cn = paste0('V', 1:3) + setnames(DT, cn) + test(16.20, fread(testDir('csvy/test_skip.csvy'), + yaml = TRUE, skip = 2L, col.names = cn), + DT, message = 'User-supplied column names.*override.*YAML') + ## invalid value fails + test(16.21, fread(f, yaml = 'gobble'), + error = 'isTRUEorFALSE\\(yaml\\) is not TRUE') + + ## warning that skip-as-search doesn't work with yaml + DT_yaml[ , var2 := as.integer(var2)] + test(16.22, fread(f, skip = 'var1,', yaml = TRUE), + DT_yaml, warning = 'Combining a search.*YAML.*') + + # fwrite csvy: #3534 + tmp = tempfile() + DT = data.table(a = 1:5, b = c(pi, 1:4), c = letters[1:5]) + # force eol for platform independence + fwrite(DT, tmp, yaml = TRUE, eol = '\n') + as_read = readLines(tmp) + test(17.01, as_read[c(1L, 24L)], c('---', '---')) + test(17.02, grepl('source: R.*data.table.*fwrite', as_read[2L])) + test(17.03, grepl('creation_time_utc', as_read[3L])) + test(17.04, as_read[4:23], + c("schema:", " fields:", " - name: a", " type: integer", + " - name: b", " type: numeric", " - name: c", " type: character", + "header: yes", "sep: ','", "sep2:", "- ''", "- '|'", "- ''", + # NB: apparently \n is encoded like this in YAML + "eol: |2+", "", "na.strings: ''", "dec: '.'", "qmethod: double", + "logical01: no")) + tbl_body = c("a,b,c", "1,3.14159265358979,a", "2,1,b", "3,2,c", "4,3,d", "5,4,e") + test(17.05, as_read[25:30], tbl_body) + + # windows eol + fwrite(DT, tmp, yaml = TRUE, eol = '\r\n') + test(17.06, readLines(tmp)[18L], 'eol: "\\r\\n"') + + # multi-class columns + DT[ , t := .POSIXct(1:5, tz = 'UTC')] + fwrite(DT, tmp, yaml = TRUE) + as_read = readLines(tmp) + test(17.07, as_read[13L], " type: POSIXct") + + # ~invertibility~ + # fread side needs to be improved for Hugh's colClasses update + DT[ , t := NULL] + fwrite(DT, tmp, yaml = TRUE) + DT2 = fread(tmp, yaml = TRUE) + # remove metadata to compare + attr(DT2, 'yaml_metadata') = NULL + test(17.08, all.equal(DT, DT2)) + + test(17.09, fwrite(DT, append=TRUE, yaml=TRUE, verbose=TRUE), + output = paste0(c('Appending to existing file so setting bom=FALSE and yaml=FALSE', tbl_body[-1L]), collapse=".*")) + + # TODO: test gzip'd yaml which is now supported + + # yaml + bom arguments + DT = data.table(l=letters, n=1:26) + fwrite(DT, f<-tempfile(), bom=TRUE, yaml=TRUE) + fcon = file(f, encoding="UTF-8") # Windows readLines needs to be told; see also test 1658.50 in tests.Rraw + lines = readLines(fcon) + lines = lines[lines!=""] # an extra "" after "eol: |2+" (line 16) on Linux but not Windows + # remove the blank here so we don't need to change this test if/when that changes in yaml package + test(17.11, length(lines), 48L) + close(fcon) + test(17.12, readBin(f, raw(), 6L), as.raw(c(0xef, 0xbb, 0xbf, 0x2d, 0x2d, 0x2d))) + # re-write should have same output (not appended) + fwrite(DT, f<-tempfile(), bom=TRUE, yaml=TRUE) + fcon = file(f, encoding="UTF-8") + lines = readLines(fcon) + lines = lines[lines!=""] + test(17.13, length(lines), 48L) + close(fcon) + test(17.14, fread(f), DT) + unlink(f) +} + +if (loaded[["xts"]]) { # was 1465 in tests.Rraw, #5516 + # data.table-xts conversion #882 + # Date index + dt = data.table(index = as.Date((as.Date("2014-12-12")-49):as.Date("2014-12-12"),origin="1970-01-01"),quantity = as.numeric(rep(c(1:5),10)),value = rep(c(1:10)*100,5)) + xt = as.xts(matrix(data = c(dt$quantity, dt$value),ncol = 2,dimnames = list(NULL,c("quantity","value"))),order.by = dt$index) + dt_xt = as.data.table(xt) + xt_dt = as.xts.data.table(dt) + test(18.01, all.equal(dt, dt_xt, check.attributes = FALSE)) + test(18.02, xt, xt_dt) + # POSIXct index + dt <- data.table(index = as.POSIXct(as.Date((as.Date("2014-12-12")-49):as.Date("2014-12-12"),origin="1970-01-01"),origin="1970-01-01"),quantity = as.numeric(rep(c(1:5),10)),value = rep(c(1:10)*100,5)) + xt = as.xts(matrix(data = c(dt$quantity, dt$value),ncol = 2,dimnames = list(NULL,c("quantity","value"))),order.by = dt$index) + dt_xt = as.data.table(xt) + xt_dt = as.xts.data.table(dt) + test(18.03, all.equal(dt, dt_xt, check.attributes = FALSE)) + test(18.04, xt, xt_dt) + # index types returned from to.period + dt = data.table(index = as.Date((as.Date("2014-12-12") - 729):as.Date("2014-12-12"), origin = "1970-01-01"), quantity = as.numeric(rep(c(1:5), 73)), value = rep(c(1:73) * 100, 5)) + xt = as.xts(matrix(data = c(dt$quantity, dt$value), ncol = 2, dimnames = list(NULL, c("quantity", "value"))), order.by = dt$index) + xt_w = xts::to.weekly(xt) + xt_dt_xt_w = as.xts.data.table(as.data.table(xt_w)) + xt_m = xts::to.monthly(xt) + xt_dt_xt_m = as.xts.data.table(as.data.table(xt_m)) + xt_q = xts::to.quarterly(xt) + xt_dt_xt_q = as.xts.data.table(as.data.table(xt_q)) + xt_y = xts::to.yearly(xt) + xt_dt_xt_y = as.xts.data.table(as.data.table(xt_y)) + test(18.05, all.equal(xt_w, xt_dt_xt_w, check.attributes = FALSE)) + test(18.06, all.equal(xt_m, xt_dt_xt_m, check.attributes = FALSE)) + test(18.07, all.equal(xt_q, xt_dt_xt_q, check.attributes = FALSE)) + test(18.08, all.equal(xt_y, xt_dt_xt_y, check.attributes = FALSE)) + + test(18.09, xts::last(1:5), 5L) # was test 1531 + + # xts issue from Joshua, #1347 + x = as.Date(1:5, origin="2015-01-01") + test(18.10, last(x), tail(x, 1L)) # was test 1559 + + x = xts(1:100, Sys.Date()+1:100) + test(18.11, last(x,10), x[91:100,]) # was test 841 + # The important thing this tests is that data.table's last() dispatches to xts's method when data.table is loaded above xts. + # But that isn't tested by R CMD check because xts is loaded above data.table, there. + # So to make this test is relevant, run it in fresh R session directly, after: "require(xts);require(data.table)" + # rather than: "require(data.table);require(xts)" + # Which was the main thrust of bug#2312 fixed in v1.8.3 + + # fix for #1484; was test 1589 + x = xts::as.xts(8, order.by = as.Date("2016-01-03")) + test(18.12, all.equal(as.data.table(x), data.table(index = as.Date("2016-01-03"), V1 = 8), check.attributes=FALSE)) + + # IDate support in as.xts.data.table #1499; was test 1663 + dt <- data.table(date = c(as.IDate("2014-12-31"), + as.IDate("2015-12-31"), + as.IDate("2016-12-31")), + nav = c(100,101,99), + key = "date") + dt.xts <- as.xts.data.table(dt) + test(18.13, dt.xts[1L], xts::xts(data.table(nav=100), order.by=as.Date("2014-12-31"))) + + # additional coverage missing uncovered in #3117 + dt = data.table(index = as.Date((as.Date("2014-12-12")-49):as.Date("2014-12-12"),origin="1970-01-01"),quantity = as.numeric(rep(c(1:5),10)),value = rep(c(1:10)*100,5)) + xt = as.xts(matrix(data = c(dt$quantity, dt$value),ncol = 2,dimnames = list(NULL,c("quantity","value"))),order.by = dt$index) + test(18.14, as.data.table(xt, keep.rownames = FALSE), dt[ , !'index']) + names(xt)[1L] = 'index' + test(18.15, as.data.table(xt), error = 'Input xts object should not') + names(xt)[1L] = 'quantity' + setcolorder(dt, c(3, 1, 2)) + if (base::getRversion() < "3.6.0") as.xts = as.xts.data.table # fix for when we cannot register s3method for suggested dependency #3286 + test(18.16, as.xts(dt), error = 'data.table must have a time based') + setcolorder(dt, c(2, 3, 1)) + dt[ , char_col := 'a'] + test(18.17, as.xts(dt), xt, warning = 'columns are not numeric') + if (base::getRversion() < "3.6.0") rm(as.xts) + + # 890 -- key argument for as.data.table.xts + x = xts(1:10, as.Date(1:10, origin = "1970-01-01")) + old = options(datatable.verbose=FALSE) + test(18.18, capture.output(as.data.table(x, key="index")), + c(" index V1", " 1: 1970-01-02 1", " 2: 1970-01-03 2", + " 3: 1970-01-04 3", " 4: 1970-01-05 4", " 5: 1970-01-06 5", + " 6: 1970-01-07 6", " 7: 1970-01-08 7", " 8: 1970-01-09 8", + " 9: 1970-01-10 9", "10: 1970-01-11 10")) + options(old) + + # as.data.table.xts(foo) had incorrect integer index with a column name called 'x', #4897 + M = xts::as.xts(matrix(1, dimnames=list("2021-05-23", "x"))) # xts:: just to be extra robust; shouldn't be needed with rm(as.xts) above + test(18.19, inherits(as.data.table(M)$index,"POSIXct")) + + # non-numeric xts coredata, #5268 + x = xts::xts(x=c(TRUE,FALSE), order.by=Sys.Date()+(1:2)) + colnames(x) = "value" # perhaps relates to #4897 + test(18.20, identical(x, as.xts(as.data.table(x), numeric.only=FALSE))) +} + +# was 2108 in tests.Rraw, #5516 +# first and last should no longer load xts namespace, #3857, below commented test for interactive validation when xts present but not loaded or attached +# stopifnot("xts"%in%installed.packages(), !"xts"%in%loadedNamespaces()); library(data.table); x=as.POSIXct("2019-01-01"); last(x); stopifnot(!"xts" %in% loadedNamespaces()) +x = as.POSIXct("2019-09-09")+0:1 +old = options(datatable.verbose=TRUE) +test(19.01, last(x), x[length(x)], output="!is.xts(x)") +test(19.02, first(x), x[1L], output="!is.xts(x)") +if (loaded[["xts"]]) { + xt = xts(1:2, x) + test(19.03, last(xt, 2L), xt, output="using xts::last: is.xts(x)") + test(19.04, first(xt, 2L), xt, output="using xts::first: is.xts(x)") + xt = xts(matrix(1:4, 2L, 2L), x) + test(19.05, last(xt, 2L), xt, output="using xts::last: is.xts(x)") + test(19.06, first(xt, 2L), xt, output="using xts::first: is.xts(x)") +} +# first on empty df now match head(df, n=1L), #3858 +df = data.frame(a=integer(), b=integer()) +test(19.11, first(df), df, output="!is.xts(x)") +test(19.12, last(df), df, output="!is.xts(x)") +options(datatable.verbose=FALSE) # so the as.data.table() doesn't pollute output +# xts last-first dispatch fix #4053 +x = 1:3 +y = as.POSIXct(x, origin="1970-01-01") +df = data.frame(a=1:2, b=3:2) +dt = as.data.table(df) +mx = matrix(1:9, 3, 3) +ar = array(1:27, c(3,3,3)) +xt = structure( + c(142.25, 141.229996, 141.330002, 142.860001, 142.050003, 141.399994, + 140.570007, 140.610001, 140.380005, 141.369995, 141.669998, 140.539993, + 94807600, 69620600, 76645300, 108.999954, 109.231255, 108.360008), + class = c("xts", "zoo"), .indexCLASS = "Date", tclass = "Date", .indexTZ = "UTC", tzone = "UTC", + index = structure(c(1167782400, 1167868800, 1167955200), tzone = "UTC", tclass = "Date"), + .Dim = c(3L, 6L), .Dimnames = list(NULL, c("SPY.Open", "SPY.High", "SPY.Low", "SPY.Close", "SPY.Volume", "SPY.Adjusted")) +) +options(datatable.verbose=TRUE) +if (loaded[["xts"]]) { + test(19.21, last(x, n=2L), 2:3, output="using xts::last: !is.xts(x) & nargs>1 & 'package:xts'%in%search()") + test(19.22, last(y, n=2L), y[2:3], output="using xts::last: !is.xts(x) & nargs>1 & 'package:xts'%in%search()") + test(19.23, last(x, n=1L), 3L, output="using xts::last: !is.xts(x) & nargs>1 & 'package:xts'%in%search()") + test(19.24, last(y, n=1L), y[3L], output="using xts::last: !is.xts(x) & nargs>1 & 'package:xts'%in%search()") + xt_last = structure( + c(141.330002, 141.399994, 140.380005, 140.539993, 76645300, 108.360008), + class = c("xts", "zoo"), .indexCLASS = "Date", tclass = "Date", .indexTZ = "UTC", tzone = "UTC", + index = structure(1167955200, tzone = "UTC", tclass = "Date"), + .Dim = c(1L, 6L), .Dimnames = list(NULL, c("SPY.Open", "SPY.High", "SPY.Low", "SPY.Close", "SPY.Volume", "SPY.Adjusted")) + ) + xt_last2 = structure( + c(141.229996, 141.330002, 142.050003, 141.399994, 140.610001, 140.380005, + 141.669998, 140.539993, 69620600, 76645300, 109.231255, 108.360008), + class = c("xts", "zoo"), .indexCLASS = "Date", tclass = "Date", .indexTZ = "UTC", tzone = "UTC", + index = structure(c(1167868800, 1167955200), tzone = "UTC", tclass = "Date"), + .Dim = c(2L, 6L), .Dimnames = list(NULL, c("SPY.Open", "SPY.High", "SPY.Low", "SPY.Close", "SPY.Volume", "SPY.Adjusted")) + ) + test(19.25, last(xt), xt_last, output="using xts::last: is.xts(x)") + test(19.26, last(xt, n=2L), xt_last2, output="using xts::last: is.xts(x)") + test(19.31, first(x, n=2L), 1:2, output="using xts::first: !is.xts(x) & nargs>1 & 'package:xts'%in%search()") + test(19.32, first(y, n=2L), y[1:2], output="using xts::first: !is.xts(x) & nargs>1 & 'package:xts'%in%search()") + test(19.33, first(x, n=1L), 1L, output="using xts::first: !is.xts(x) & nargs>1 & 'package:xts'%in%search()") + test(19.34, first(y, n=1L), y[1L], output="using xts::first: !is.xts(x) & nargs>1 & 'package:xts'%in%search()") + xt_first = structure( + c(142.25, 142.860001, 140.570007, 141.369995, 94807600, 108.999954), + class = c("xts", "zoo"), .indexCLASS = "Date", tclass = "Date", .indexTZ = "UTC", tzone = "UTC", + index = structure(1167782400, tzone = "UTC", tclass = "Date"), + .Dim = c(1L, 6L), .Dimnames = list(NULL, c("SPY.Open", "SPY.High", "SPY.Low", "SPY.Close", "SPY.Volume", "SPY.Adjusted")) + ) + xt_first2 = structure( + c(142.25, 141.229996, 142.860001, 142.050003, 140.570007, 140.610001, 141.369995, 141.669998, 94807600, 69620600, 108.999954, 109.231255), + class = c("xts", "zoo"), .indexCLASS = "Date", tclass = "Date", .indexTZ = "UTC", tzone = "UTC", + index = structure(c(1167782400, 1167868800), tzone = "UTC", tclass = "Date"), + .Dim = c(2L, 6L), .Dimnames = list(NULL, c("SPY.Open", "SPY.High", "SPY.Low", "SPY.Close", "SPY.Volume", "SPY.Adjusted")) + ) + test(19.35, first(xt), xt_first, output="using xts::first: is.xts(x)") + test(19.36, first(xt, n=2L), xt_first2, output="using xts::first: is.xts(x)") +} else { + test(19.21, last(x, n=2L), 2:3, output="using utils::tail: !is.xts(x) & nargs>1 & !'package:xts'%in%search()") + test(19.22, last(y, n=2L), y[2:3], output="using utils::tail: !is.xts(x) & nargs>1 & !'package:xts'%in%search()") + test(19.23, last(x, n=1L), 3L, output="using utils::tail: !is.xts(x) & nargs>1 & !'package:xts'%in%search()") + test(19.24, last(y, n=1L), y[3L], output="using utils::tail: !is.xts(x) & nargs>1 & !'package:xts'%in%search()") + test(19.25, last(xt), error="you should have 'xts' installed already") + test(19.26, last(xt, n=2L), error="you should have 'xts' installed already") + test(19.31, first(x, n=2L), 1:2, output="using utils::head: !is.xts(x) & nargs>1 & !'package:xts'%in%search()") + test(19.32, first(y, n=2L), y[1:2], output="using utils::head: !is.xts(x) & nargs>1 & !'package:xts'%in%search()") + test(19.33, first(x, n=1L), 1L, output="using utils::head: !is.xts(x) & nargs>1 & !'package:xts'%in%search()") + test(19.34, first(y, n=1L), y[1L], output="using utils::head: !is.xts(x) & nargs>1 & !'package:xts'%in%search()") + test(19.35, first(xt), error="you should have 'xts' installed already") + test(19.36, first(xt, n=2L), error="you should have 'xts' installed already") +} +test(19.41, last(x), 3L, output="using 'x[[length(x)]]': !is.xts(x) & !nargs>1 & is.null(dim(x))") +test(19.42, last(y), y[3L], output="using 'x[[length(x)]]': !is.xts(x) & !nargs>1 & is.null(dim(x))") +test(19.51, first(x), 1L, output="using 'x[[1L]]': !is.xts(x) & !nargs>1 & is.null(dim(x))") +test(19.52, first(y), y[1L], output="using 'x[[1L]]': !is.xts(x) & !nargs>1 & is.null(dim(x))") +test(19.61, last(df), structure(list(a=2L, b=2L), row.names=2L, class="data.frame"), output="using 'x[nrow(x),]': !is.xts(x) & !nargs>1 & is.data.frame(x)") +test(19.62, last(dt), data.table(a=2L, b=2L), output="using 'x[nrow(x),]': !is.xts(x) & !nargs>1 & is.data.frame(x)") +test(19.71, first(df), structure(list(a=1L, b=3L), row.names=1L, class="data.frame"), output="using 'x[1L,]': !is.xts(x) & !nargs>1 & is.data.frame(x)") +test(19.72, first(dt), data.table(a=1L, b=3L), output="using 'x[1L,]': !is.xts(x) & !nargs>1 & is.data.frame(x)") +# matrix/array utils::tail behavior is likely to change in future R, Michael is more in the topic +test(19.81, last(mx), structure(c(3L, 6L, 9L), .Dim = c(1L, 3L), .Dimnames = list("[3,]", NULL)), output="using utils::tail: !is.xts(x) & !nargs>1 & !is.null(dim(x)) & !is.data.frame(x)") +expected = if (base::getRversion() < "3.7.0") 27L else structure(c(3L, 6L, 9L, 12L, 15L, 18L, 21L, 24L, 27L), .Dim = c(1L, 3L, 3L), .Dimnames = list("[3,]", NULL, NULL)) #4127 +test(19.82, last(ar), expected, output="using utils::tail: !is.xts(x) & !nargs>1 & !is.null(dim(x)) & !is.data.frame(x)") +test(19.91, first(mx), structure(c(1L, 4L, 7L), .Dim = c(1L, 3L)), output="using utils::head: !is.xts(x) & !nargs>1 & !is.null(dim(x)) & !is.data.frame(x)") +expected = if (base::getRversion() < "3.7.0") 1L else structure(c(1L, 4L, 7L, 10L, 13L, 16L, 19L, 22L, 25L), .Dim = c(1L, 3L, 3L)) #4127 +test(19.92, first(ar), expected, output="using utils::head: !is.xts(x) & !nargs>1 & !is.null(dim(x)) & !is.data.frame(x)") +options(old) + +if (loaded[["xts"]]) { # was 2133 in tests.Rraw, #5516 + # keep.rownames in as.data.table.xts() supports a string, #4232 + xts = xts::xts(1:10, structure(1:10, class = "Date")) + colnames(xts) = "VALUE" + DT = as.data.table(xts, keep.rownames = "DATE", key = "DATE") + test(20.1, colnames(DT), c("DATE", "VALUE")) + test(20.2, key(DT), "DATE") + test(20.3, as.data.table(xts, keep.rownames = "VALUE"), + error = "Input xts object should not have 'VALUE' column because it would result in duplicate column names. Rename 'VALUE' column in xts or use `keep.rownames` to change the index column name.") + test(20.4, as.data.table(xts, keep.rownames = character()), + error = "keep.rownames must be length 1") + test(20.5, as.data.table(xts, keep.rownames = NA_character_), + error = "keep.rownames must not be NA") +} + +if (loaded[["nanotime"]]) { + + # was 1463.62-65 in tests.Rraw, #5516 + x=nanotime(1:4) + test(21.1, shift(x ), c(nanotime::nanotime(NA), x[1:3])) + test(21.2, shift(x, fill=0L), c(nanotime::nanotime(0L), x[1:3])) + test(21.3, shift(x, 1, type="cyclic"), c(x[4L], x[-4L])) + test(21.4, shift(x, -1, type="cyclic"), c(x[-1L], x[1L])) + + # was 1752 in tests.Rraw, #5516 + DT = data.table(A=nanotime(tt<-c("2016-09-28T15:30:00.000000070Z", + "2016-09-29T23:59:00.000000001Z", + "2016-09-29T23:59:00.000000999Z", + "1970-01-01T00:01:01.000001000Z", + "1970-01-01T00:00:00.000000000Z", + "1969-12-31T23:59:59.999999999Z", + "1969-12-31T23:59:59.000000089Z", + "1969-12-31T12:13:14.000000000Z", + "1969-12-31T12:13:14.999999999Z", + "1969-12-31T12:13:14.000000001Z", + "1967-03-15T00:00:00.300000002Z", + "1967-03-15T23:59:59.300000002Z"))) + test(22, capture.output(fwrite(DT, verbose=FALSE))[-1], tt) + + # was 2060.401-405 in tests.Rraw, #5516 + nt = nanotime(c(1L, 2L, NA_integer_, 4L)) + nt_val = nanotime(1:4) + test(23.1, as.character(fcoalesce(nt, nanotime(3L))), as.character(nt_val)) # as.character due to eddelbuettel/nanotime#46 + test(23.2, as.character(fcoalesce(nt, nanotime(NA), nanotime(3L))), as.character(nt_val)) + test(23.3, as.character(fcoalesce(nt, nanotime(rep(3, 4L)))), as.character(nt_val)) + test(23.4, fcoalesce(nt, 1), error='Item 2 has a different class than item 1') + test(23.5, fcoalesce(nt, 1L), error = 'Item 2 is type integer but the first item is type double') + + # was 2080.01-05 in tests.Rraw, #5516 + n = nanotime(1:4) + n[2L] = NA + opt = options(datatable.verbose=TRUE) + test(24.1, between(n, nanotime(2), nanotime(10)), c(FALSE, NA, TRUE, TRUE), output="between parallel processing of integer64") + test(24.2, between(n, nanotime(3), nanotime(10), incbounds=FALSE), c(FALSE, NA, FALSE, TRUE), output="between parallel processing of integer64") + test(24.3, between(n, nanotime(3), nanotime(NA), incbounds=FALSE, NAbounds=NA), c(FALSE, NA, FALSE, NA), output="between parallel processing of integer64") + options(opt) + test(24.4, between(1:10, nanotime(3), nanotime(6)), error="x is not integer64 but.*Please align classes") + test(24.5, between(1:10, 3, nanotime(6)), error="x is not integer64 but.*Please align classes") + + # was 2085.11 in tests.Rraw, #5516 + n = nanotime(1:4) + test(25, fifelse(c(TRUE,FALSE,NA,TRUE), n, n+100), c(n[1L], n[2L]+100, nanotime(NA), n[4])) + + # was 2127.27 in tests.Rraw, #5516 + n = nanotime(1:12) + test(26, fcase(c(-5L:5L<0L,NA), n, c(-5L:5L>0L,NA), n+100), c(n[1L:5L], nanotime(NA), n[7L:11L]+100, as.integer64(NA))) + + # na.omit works for nanotime, #4744. Was 2205 in tests.Rraw, #5516 + DT = data.table(time=nanotime(c(1,NA,3))) + test(27, na.omit(DT), DT[c(1,3)]) + +} + + diff --git a/inst/tests/tests.Rraw b/inst/tests/tests.Rraw index 633a562c0..b242290df 100644 --- a/inst/tests/tests.Rraw +++ b/inst/tests/tests.Rraw @@ -100,15 +100,12 @@ if (exists("test.data.table", .GlobalEnv, inherits=FALSE)) { yearqtr = data.table::yearqtr # zoo } -# Load optional Suggests packages, which are tested by Travis for code coverage, and on CRAN -# The reason for inclusion here is stated next to each package +# Optional suggests are now tested in other.Rraw, #5516. No calls to require() or library() should occur +# in this file other than for methods and data.table above, and these here. +# These are included in code coverage, and on CRAN. The reason for inclusion is stated next to each package. sugg = c( "bit64", # if big integers are detected in file, fread reads them as bit64::integer64 if installed (warning if not) - "xts", # we have xts methods in R/xts.R - "nanotime", # fwrite looks for the 'nanotime' class name at C level (but we have our own writer in C, though) - "R.utils", # for fread to accept .gz and .bz2 files directly - "yaml" # for fread's yaml argument (csvy capability) - # zoo # In DESCRIPTION:Suggests otherwise R CMD check warning: '::' or ':::' import not declared from: 'zoo'; it is tested in other.Rraw though + "R.utils" # many fread test input files are compressed to save space; fundamental to test environment ) for (s in sugg) { assign(paste0("test_",s), loaded<-suppressWarnings(suppressMessages( @@ -6798,13 +6795,7 @@ ans = list(as.integer(c(NA, 1:9)), as.integer(c(NA, NA, 1:8))) setattr(ans, 'names', nm) test(1463.61, shift(x, 1:2, give.names=TRUE), ans) -if (test_nanotime) { - x=nanotime(1:4) - test(1463.62, shift(x ), c(nanotime::nanotime(NA), x[1:3])); - test(1463.63, shift(x, fill=0L), c(nanotime::nanotime(0L), x[1:3])); - test(1463.64, shift(x, 1, type="cyclic"), c(x[4L], x[-4L])); - test(1463.65, shift(x, -1, type="cyclic"), c(x[-1L], x[1L])); -} +# 1463.62-65 tested nanotime moved to other.Rraw 21, #5516 # shift circular x = 1:5 @@ -6837,106 +6828,7 @@ test(1464.12, rleidv(DT, 1:2), ans<-INT(1,2,3,4,5,6,6,6,7,8,8,9,10,11,12,13,14,1 test(1464.13, rleidv(DT, 2:1), ans) test(1464.14, rleidv(DT, c(3,1)), INT(1,1,2,2,3,4,5,5,6,7,8,9,10,11,12,13,14,15,16,17)) -if (test_xts) { - - Sys.unsetenv("_R_CHECK_LENGTH_1_LOGIC2_") - # package xts has an issue with an && clause (https://github.com/joshuaulrich/xts/pull/269). When that is fixed in xts and released to CRAN, we can remove this Sys.unsetenv - # Sys.setenv is called again at the end of this xts branch. The original env variable value was stored at the top of this file and restored at the end. - - # data.table-xts conversion #882 - # Date index - dt = data.table(index = as.Date((as.Date("2014-12-12")-49):as.Date("2014-12-12"),origin="1970-01-01"),quantity = as.numeric(rep(c(1:5),10)),value = rep(c(1:10)*100,5)) - xt = as.xts(matrix(data = c(dt$quantity, dt$value),ncol = 2,dimnames = list(NULL,c("quantity","value"))),order.by = dt$index) - dt_xt = as.data.table(xt) - xt_dt = as.xts.data.table(dt) - test(1465.01, all.equal(dt, dt_xt, check.attributes = FALSE)) - test(1465.02, xt, xt_dt) - # POSIXct index - dt <- data.table(index = as.POSIXct(as.Date((as.Date("2014-12-12")-49):as.Date("2014-12-12"),origin="1970-01-01"),origin="1970-01-01"),quantity = as.numeric(rep(c(1:5),10)),value = rep(c(1:10)*100,5)) - xt = as.xts(matrix(data = c(dt$quantity, dt$value),ncol = 2,dimnames = list(NULL,c("quantity","value"))),order.by = dt$index) - dt_xt = as.data.table(xt) - xt_dt = as.xts.data.table(dt) - test(1465.03, all.equal(dt, dt_xt, check.attributes = FALSE)) - test(1465.04, xt, xt_dt) - # index types returned from to.period - dt = data.table(index = as.Date((as.Date("2014-12-12") - 729):as.Date("2014-12-12"), origin = "1970-01-01"), quantity = as.numeric(rep(c(1:5), 73)), value = rep(c(1:73) * 100, 5)) - xt = as.xts(matrix(data = c(dt$quantity, dt$value), ncol = 2, dimnames = list(NULL, c("quantity", "value"))), order.by = dt$index) - xt_w = xts::to.weekly(xt) - xt_dt_xt_w = as.xts.data.table(as.data.table(xt_w)) - xt_m = xts::to.monthly(xt) - xt_dt_xt_m = as.xts.data.table(as.data.table(xt_m)) - xt_q = xts::to.quarterly(xt) - xt_dt_xt_q = as.xts.data.table(as.data.table(xt_q)) - xt_y = xts::to.yearly(xt) - xt_dt_xt_y = as.xts.data.table(as.data.table(xt_y)) - test(1465.05, all.equal(xt_w, xt_dt_xt_w, check.attributes = FALSE)) - test(1465.06, all.equal(xt_m, xt_dt_xt_m, check.attributes = FALSE)) - test(1465.07, all.equal(xt_q, xt_dt_xt_q, check.attributes = FALSE)) - test(1465.08, all.equal(xt_y, xt_dt_xt_y, check.attributes = FALSE)) - - test(1465.09, xts::last(1:5), 5L) # was test 1531 - - # xts issue from Joshua, #1347 - x = as.Date(1:5, origin="2015-01-01") - test(1465.10, last(x), tail(x, 1L)) # was test 1559 - - x = xts(1:100, Sys.Date()+1:100) - test(1465.11, last(x,10), x[91:100,]) # was test 841 - # The important thing this tests is that data.table's last() dispatches to xts's method when data.table is loaded above xts. - # But that isn't tested by R CMD check because xts is loaded above data.table, there. - # So to make this test is relevant, run it in fresh R session directly, after: "require(xts);require(data.table)" - # rather than: "require(data.table);require(xts)" - # Which was the main thrust of bug#2312 fixed in v1.8.3 - - # fix for #1484; was test 1589 - x = xts::as.xts(8, order.by = as.Date("2016-01-03")) - test(1465.12, all.equal(as.data.table(x), data.table(index = as.Date("2016-01-03"), V1 = 8), check.attributes=FALSE)) - - # IDate support in as.xts.data.table #1499; was test 1663 - dt <- data.table(date = c(as.IDate("2014-12-31"), - as.IDate("2015-12-31"), - as.IDate("2016-12-31")), - nav = c(100,101,99), - key = "date") - dt.xts <- as.xts.data.table(dt) - test(1465.13, dt.xts[1L], xts::xts(data.table(nav=100), order.by=as.Date("2014-12-31"))) - - # additional coverage missing uncovered in #3117 - dt = data.table(index = as.Date((as.Date("2014-12-12")-49):as.Date("2014-12-12"),origin="1970-01-01"),quantity = as.numeric(rep(c(1:5),10)),value = rep(c(1:10)*100,5)) - xt = as.xts(matrix(data = c(dt$quantity, dt$value),ncol = 2,dimnames = list(NULL,c("quantity","value"))),order.by = dt$index) - test(1465.14, as.data.table(xt, keep.rownames = FALSE), dt[ , !'index']) - names(xt)[1L] = 'index' - test(1465.15, as.data.table(xt), error = 'Input xts object should not') - names(xt)[1L] = 'quantity' - setcolorder(dt, c(3, 1, 2)) - if (base::getRversion() < "3.6.0") as.xts = as.xts.data.table # fix for when we cannot register s3method for suggested dependency #3286 - test(1465.16, as.xts(dt), error = 'data.table must have a time based') - setcolorder(dt, c(2, 3, 1)) - dt[ , char_col := 'a'] - test(1465.17, as.xts(dt), xt, warning = 'columns are not numeric') - if (base::getRversion() < "3.6.0") rm(as.xts) - - # 890 -- key argument for as.data.table.xts - x = xts(1:10, as.Date(1:10, origin = "1970-01-01")) - old = options(datatable.verbose=FALSE) - test(1465.18, capture.output(as.data.table(x, key="index")), - c(" index V1", " 1: 1970-01-02 1", " 2: 1970-01-03 2", - " 3: 1970-01-04 3", " 4: 1970-01-05 4", " 5: 1970-01-06 5", - " 6: 1970-01-07 6", " 7: 1970-01-08 7", " 8: 1970-01-09 8", - " 9: 1970-01-10 9", "10: 1970-01-11 10")) - options(old) - - # as.data.table.xts(foo) had incorrect integer index with a column name called 'x', #4897 - M = xts::as.xts(matrix(1, dimnames=list("2021-05-23", "x"))) # xts:: just to be extra robust; shouldn't be needed with rm(as.xts) above - test(1465.19, inherits(as.data.table(M)$index,"POSIXct")) - - # non-numeric xts coredata, #5268 - x = xts::xts(x=c(TRUE,FALSE), order.by=Sys.Date()+(1:2)) - colnames(x) = "value" # perhaps relates to #4897 - test(1465.20, identical(x, as.xts(as.data.table(x), numeric.only=FALSE))) - - Sys.setenv("_R_CHECK_LENGTH_1_LOGIC2_" = TRUE) -} +# 1465 tested xts moved to other.Rraw 18, #5516 # as.data.table.default #969 ar <- array(NA, dim=c(10,4),dimnames = list(NULL,paste("col",1:4,sep=""))) @@ -11503,23 +11395,7 @@ test(1751.3, capture.output(fwrite(DT,na="NA",verbose=FALSE)), c("\"x\"","NA")) test(1751.4, fread({fwrite(DT, f<-tempfile());f}), DT) # the important thing unlink(f) -if (test_nanotime) { - old = options(warnPartialMatchArgs=FALSE) # option off temporarily pending https://github.com/eddelbuettel/nanotime/pull/49 - DT = data.table(A=nanotime(tt<-c("2016-09-28T15:30:00.000000070Z", - "2016-09-29T23:59:00.000000001Z", - "2016-09-29T23:59:00.000000999Z", - "1970-01-01T00:01:01.000001000Z", - "1970-01-01T00:00:00.000000000Z", - "1969-12-31T23:59:59.999999999Z", - "1969-12-31T23:59:59.000000089Z", - "1969-12-31T12:13:14.000000000Z", - "1969-12-31T12:13:14.999999999Z", - "1969-12-31T12:13:14.000000001Z", - "1967-03-15T00:00:00.300000002Z", - "1967-03-15T23:59:59.300000002Z"))) - options(old) - test(1752, capture.output(fwrite(DT, verbose=FALSE))[-1], tt) -} +# 1752 tested nanotime moved to other.Rraw 22, #5516 # check too many fields error from ,\n line ending highlighted in #2044 test(1753.1, fread("X,Y\n1,2\n3,4\n5,6"), data.table(X=INT(1,3,5),Y=INT(2,4,6))) @@ -15106,210 +14982,7 @@ test(2030.18, .Last.updated, 0L) # zero match test(2031.01, rbind(data.table(A=1:3, B=7:9), data.table(A=4:6, B=as.list(10:12))), ans<-data.table(A=1:6, B=as.list(7:12))) test(2031.02, rbind(data.table(A=1:3, B=as.list(7:9)), data.table(A=4:6, B=10:12)), ans) -if (test_yaml) { # csvy; #1701 - f = testDir("csvy/test.csvy") - DT = data.table(var1 = c("A", "B"), - var2 = c(1L, 3L), - var3 = c(2.5, 4.3)) - DT_yaml = copy(DT) - setattr(DT_yaml, 'yaml_metadata', - list(name = "my-dataset", - source = "https://github.com/leeper/csvy/tree/master/inst/examples", - schema = list(fields = list( - list(name = "var1", title = "variable 1", type = "string", - description = "explaining var1", - constraints = list(list(required = TRUE))), - list(name = "var2", title = "variable 2", type = "integer"), - list(name = "var3", title = "variable 3", type = "number") - )))) - ## with skip = '__auto__', fread can figure out - ## how to start after the metadata (just ignoring it) - test(2032.01, fread(f), DT) - ## should be the same, but with yaml_metadata attribute - test(2032.02, fread(f, yaml = TRUE), DT_yaml) - ## testing verbose messaging - test(2032.03, fread(f, yaml = TRUE, verbose = TRUE), - DT_yaml, output = 'Processed.*YAML metadata.*') - ## this file is identical, except the body of the - ## YAML header is commented out with # (should read identically) - test(2032.04, - fread(testDir('csvy/test_comment.csvy'), yaml = TRUE), - DT_yaml) - ## user input is taken as most intentional & overrides YAML - DT_yaml[ , var2 := as.numeric(var2)] - test(2032.05, fread(f, yaml = TRUE, colClasses = list(numeric = 'var2')), - DT_yaml, message = 'colClasses.*YAML header are in conflict.*var2') - ## extraneous/unused fields shouldn't throw off reading - DT = fread(testDir('csvy/test_extraneous.csvy'), yaml = TRUE) - test(2032.06, names(DT), c('Date', 'WTI')) - test(2032.07, attr(DT, 'yaml_metadata'), - list(names = c("Date", "WTI"), class = "data.frame", - title = "Cushing, OK WTI Spot Price FOB", filename = "data.csv", - fileurl = "https://raw.githubusercontent.com/jrovegno/csvy/master/data.csv", - sourceurl = "http://www.eia.gov/dnav/pet/hist/LeafHandler.ashx?n=PET&s=RWTC&f=D", - source_csvy = "https://github.com/leeper/csvy/tree/master/inst/examples", - item = "PET", sourcekey = "RWTC", freq = "Daily", - rate = "MID", type = "price", units = "Dollars per Barrel", - latestdate = "2015-08-31", releasedate = "2015-09-02", - nextreleasedate = "2015-09-10", source = "Thomson Reuters", - contactemail = "infoctr@eia.doe.gov", contactphone = "(202) 586-8800")) - ## yaml can also handle sep, dec, quote, and na.strings - DT_out = data.table(var1 = c("A", "B"), - var2 = c(1L, NA), - var3 = c(2.5, 4.3)) - meta = - list(name = NULL, - schema = list(fields = list( - list(name = "var1", title = "variable 1", type = "string", - description = "a single-quoted character variable"), - list(name = "var2", title = "variable 2", type = "integer"), - list(name = "var3", title = "variable 3", type = "number", - description = "European-style numeric") - )), - header = TRUE, sep = "|", dec = ",", - quote = "'", na.strings = "@") - attr(DT_out, 'yaml_metadata') = meta - test(2032.08, fread(testDir( 'csvy/test_attributes.csvy'), yaml = TRUE), DT_out) - ## user-specified attributes can override data from YAML - meta$sep = "-" - setattr(DT_out, 'yaml_metadata', meta) - test(2032.09, fread(testDir('csvy/test_override_sep.csvy'), yaml = TRUE, sep = '|'), DT_out, - message = 'User-supplied.*sep.*override') - - meta$sep = "|" - setattr(DT_out, 'yaml_metadata', meta) - test(2032.10, fread(testDir('csvy/test_override_header.csvy'), yaml = TRUE, header = FALSE), - DT_out, message = 'User-supplied.*header.*override') - col.names = c('x', 'y', 'z') - setnames(DT_out, col.names) - test(2032.11, fread(testDir('csvy/test_override_header.csvy'), yaml = TRUE, header = FALSE, col.names = col.names), DT_out, - message = c('User-supplied.*header.*override', 'User-supplied.*col.names.*override')) - - test(2032.12, fread(testDir('csvy/test_attributes.csvy'), yaml = TRUE, col.names = col.names), - DT_out, message = 'User-supplied.*col.names') - - setnames(DT_out, c('var1', 'var2', 'var3')) - meta$quote = "^" - setattr(DT_out, 'yaml_metadata', meta) - test(2032.13, fread(testDir('csvy/test_override_quote.csvy'), yaml = TRUE, quote = "'"), - DT_out, message = 'User-supplied.*quote') - - meta$quote = "'" - meta$dec = "." - setattr(DT_out, 'yaml_metadata', meta) - test(2032.14, fread(testDir('csvy/test_override_dec.csvy'), yaml = TRUE, dec = ','), - DT_out, message = 'User-supplied.*dec') - - meta$dec = ',' - meta$na.strings = 'NA' - setattr(DT_out, 'yaml_metadata', meta) - test(2032.15, fread(testDir('csvy/test_override_na.csvy'), yaml = TRUE, na.strings = '@'), - DT_out, message = 'User-supplied.*na.strings') - - ## error if YAML malformed - test(2032.16, fread(testDir('csvy/test_incomplete_header.csvy'), yaml = TRUE), - error = 'Reached the end.*YAML.*valid csvy') - ## use any other CSV in test directory which doesn't have YAML - if (test_R.utils) test(2032.17, fread(testDir('issue_2051.csv.gz'), yaml = TRUE), - error = 'Encountered.*unskipped.*constitute.*valid YAML') - ## no problem if some fields are missing a type (just - ## resort to standard auto-inferral, i.e., identical to - ## the case of partially-specified colClasses) - DT = data.table(var1 = c("A", "B"), var2 = c(1L, 3L), - var3 = c(2.5, 4.3)) - setattr(DT, 'yaml_metadata', - list(name = "my-dataset", source = "https://github.com/leeper/csvy/tree/master/inst/examples", - schema = list(fields = list( - list(name = "var1"), list(name = "var2", type = "integer"), - list(name = "var3", type = "number") - )))) - test(2032.18, fread(testDir('csvy/test_missing_type.csvy'), yaml = TRUE), DT) - ## skip applies starting after the YAML header - setattr(DT, 'yaml_metadata', - list(schema = list(fields = list( - list(name = "var1", type = "string"), - list(name = "var2", type = "integer"), - list(name = "var3", type = "number") - )))) - test(2032.19, fread(testDir('csvy/test_skip.csvy'), yaml = TRUE, skip = 2L), DT) - ## user-supplied col.names override metadata (as for colClasses) - cn = paste0('V', 1:3) - setnames(DT, cn) - test(2032.20, fread(testDir('csvy/test_skip.csvy'), - yaml = TRUE, skip = 2L, col.names = cn), - DT, message = 'User-supplied column names.*override.*YAML') - ## invalid value fails - test(2032.21, fread(f, yaml = 'gobble'), - error = 'isTRUEorFALSE\\(yaml\\) is not TRUE') - - ## warning that skip-as-search doesn't work with yaml - DT_yaml[ , var2 := as.integer(var2)] - test(2032.22, fread(f, skip = 'var1,', yaml = TRUE), - DT_yaml, warning = 'Combining a search.*YAML.*') - - # fwrite csvy: #3534 - tmp = tempfile() - DT = data.table(a = 1:5, b = c(pi, 1:4), c = letters[1:5]) - # force eol for platform independence - fwrite(DT, tmp, yaml = TRUE, eol = '\n') - as_read = readLines(tmp) - test(2033.01, as_read[c(1L, 24L)], c('---', '---')) - test(2033.02, grepl('source: R.*data.table.*fwrite', as_read[2L])) - test(2033.03, grepl('creation_time_utc', as_read[3L])) - test(2033.04, as_read[4:23], - c("schema:", " fields:", " - name: a", " type: integer", - " - name: b", " type: numeric", " - name: c", " type: character", - "header: yes", "sep: ','", "sep2:", "- ''", "- '|'", "- ''", - # NB: apparently \n is encoded like this in YAML - "eol: |2+", "", "na.strings: ''", "dec: '.'", "qmethod: double", - "logical01: no")) - tbl_body = c("a,b,c", "1,3.14159265358979,a", "2,1,b", "3,2,c", "4,3,d", "5,4,e") - test(2033.05, as_read[25:30], tbl_body) - - # windows eol - fwrite(DT, tmp, yaml = TRUE, eol = '\r\n') - test(2033.06, readLines(tmp)[18L], 'eol: "\\r\\n"') - - # multi-class columns - DT[ , t := .POSIXct(1:5, tz = 'UTC')] - fwrite(DT, tmp, yaml = TRUE) - as_read = readLines(tmp) - test(2033.07, as_read[13L], " type: POSIXct") - - # ~invertibility~ - # fread side needs to be improved for Hugh's colClasses update - DT[ , t := NULL] - fwrite(DT, tmp, yaml = TRUE) - DT2 = fread(tmp, yaml = TRUE) - # remove metadata to compare - attr(DT2, 'yaml_metadata') = NULL - test(2033.08, all.equal(DT, DT2)) - - test(2033.09, fwrite(DT, append=TRUE, yaml=TRUE, verbose=TRUE), - output = paste0(c('Appending to existing file so setting bom=FALSE and yaml=FALSE', tbl_body[-1L]), collapse=".*")) - - # TODO: test gzip'd yaml which is now supported - - # yaml + bom arguments - DT = data.table(l=letters, n=1:26) - fwrite(DT, f<-tempfile(), bom=TRUE, yaml=TRUE) - fcon = file(f, encoding="UTF-8") # Windows readLines needs to be told; see also test 1658.50 - lines = readLines(fcon) - lines = lines[lines!=""] # an extra "" after "eol: |2+" (line 16) on Linux but not Windows - # remove the blank here so we don't need to change this test if/when that changes in yaml package - test(2033.11, length(lines), 48L) - close(fcon) - test(2033.12, readBin(f, raw(), 6L), as.raw(c(0xef, 0xbb, 0xbf, 0x2d, 0x2d, 0x2d))) - # re-write should have same output (not appended) - fwrite(DT, f<-tempfile(), bom=TRUE, yaml=TRUE) - fcon = file(f, encoding="UTF-8") - lines = readLines(fcon) - lines = lines[lines!=""] - test(2033.13, length(lines), 48L) - close(fcon) - test(2033.14, fread(f), DT) - unlink(f) -} +# 2032-2033 tested yaml moved to other.Rraw 16-17, #5516 # fcast coverage DT = data.table(a = rep(1:2, each = 2), b = rep(1:2, 2), c = 4:1, d = 5:8) @@ -15966,16 +15639,7 @@ if (test_bit64) { test(2060.304, fcoalesce(int64, 1), error='Item 2 has a different class than item 1') test(2060.305, fcoalesce(int64, 1L), error = 'Item 2 is type integer but the first item is type double') } -# nanotime tests -if (test_nanotime) { - nt = nanotime(int) - nt_val = nanotime(1:4) - test(2060.401, as.character(fcoalesce(nt, nanotime(3L))), as.character(nt_val)) # as.character due to eddelbuettel/nanotime#46 - test(2060.402, as.character(fcoalesce(nt, nanotime(NA), nanotime(3L))), as.character(nt_val)) - test(2060.403, as.character(fcoalesce(nt, nanotime(rep(3, 4L)))), as.character(nt_val)) - test(2060.404, fcoalesce(nt, 1), error='Item 2 has a different class than item 1') - test(2060.405, fcoalesce(nt, 1L), error = 'Item 2 is type integer but the first item is type double') -} +# 2060.401-405 tested nanotime moved to other.Rraw 23, #5516 # setcoalesce x = c(11L, NA, 13L, NA, 15L, NA) y = c(NA, 12L, 5L, NA, NA, NA) @@ -16466,18 +16130,7 @@ test(2078.32, between(c("a","c","e"), NA, c("b",NA,"e"), incbounds=FALSE, NAboun test(2079.01, between(1:5, 3L, NA, incbounds=TRUE, NAbounds=NA), c(FALSE, FALSE, NA, NA, NA)) test(2079.02, between(1:5, 3L, NA, incbounds=FALSE, NAbounds=TRUE), c(FALSE, FALSE, FALSE, TRUE, TRUE)) test(2079.03, between(1:5, 3L, NA, incbounds=FALSE, NAbounds=FALSE), error="NAbounds must be TRUE or NA") -# nanotime support -if (test_nanotime) { - n=nanotime(1:4) - n[2L]=NA - op = options(datatable.verbose=TRUE) - test(2080.01, between(n, nanotime(2), nanotime(10)), c(FALSE, NA, TRUE, TRUE), output="between parallel processing of integer64") - test(2080.02, between(n, nanotime(3), nanotime(10), incbounds=FALSE), c(FALSE, NA, FALSE, TRUE), output="between parallel processing of integer64") - test(2080.03, between(n, nanotime(3), nanotime(NA), incbounds=FALSE, NAbounds=NA), c(FALSE, NA, FALSE, NA), output="between parallel processing of integer64") - options(op) - test(2080.04, between(1:10, nanotime(3), nanotime(6)), error="x is not integer64 but.*Please align classes") - test(2080.05, between(1:10, 3, nanotime(6)), error="x is not integer64 but.*Please align classes") -} +# 2080.01-05 tested nanotime moved to other.Rraw 24, #5516 # use raw type to cover fallback to R in between.R old = options(datatable.verbose=TRUE) test(2081.01, between(as.raw(1:5), as.raw(2), as.raw(4)), c(FALSE, TRUE, TRUE, TRUE, FALSE), output="fallback to slow R") @@ -16521,10 +16174,7 @@ if (test_bit64) { i = as.integer64(1:4)+3e9 test(2085.01, fifelse(c(TRUE,FALSE,NA,TRUE), i, i+100), c(i[1L], i[2L]+100, as.integer64(NA), i[4])) } -if (test_nanotime) { - n = nanotime(1:4) - test(2085.11, fifelse(c(TRUE,FALSE,NA,TRUE), n, n+100), c(n[1L], n[2L]+100, nanotime(NA), n[4])) -} +# 2085.11 tested nanotime moved to other.Rraw 25, #5516 test(2085.21, fifelse(c(TRUE,FALSE,NA), 1:3, c(1,2,3)), c(1,2,NA)) test(2085.22, fifelse(c(TRUE,FALSE,NA), c(1,2,3), 1:3), c(1,2,NA)) test(2085.31, fifelse(c(a=TRUE,b=FALSE), list(m=1,n=2), list(x=11,y=12)), list(a=1, b=12)) @@ -16756,109 +16406,7 @@ test(2107.3, names(DT), c('A','b','c')) setnames(DT, -(1:2), toupper) test(2107.4, names(DT), c('A','b','C')) -# first and last should no longer load xts namespace, #3857, below commented test for interactive validation when xts present but not loaded or attached -#stopifnot("xts"%in%installed.packages(), !"xts"%in%loadedNamespaces()); library(data.table); x=as.POSIXct("2019-01-01"); last(x); stopifnot(!"xts" %in% loadedNamespaces()) -x = as.POSIXct("2019-09-09")+0:1 -old = options(datatable.verbose=TRUE) -test(2108.01, last(x), x[length(x)], output="!is.xts(x)") -test(2108.02, first(x), x[1L], output="!is.xts(x)") -if (test_xts) { - xt = xts(1:2, x) - test(2108.03, last(xt, 2L), xt, output="using xts::last: is.xts(x)") - test(2108.04, first(xt, 2L), xt, output="using xts::first: is.xts(x)") - xt = xts(matrix(1:4, 2L, 2L), x) - test(2108.05, last(xt, 2L), xt, output="using xts::last: is.xts(x)") - test(2108.06, first(xt, 2L), xt, output="using xts::first: is.xts(x)") -} -# first on empty df now match head(df, n=1L), #3858 -df = data.frame(a=integer(), b=integer()) -test(2108.11, first(df), df, output="!is.xts(x)") -test(2108.12, last(df), df, output="!is.xts(x)") -options(old) -# xts last-first dispatch fix #4053 -x = 1:3 -y = as.POSIXct(x, origin="1970-01-01") -df = data.frame(a=1:2, b=3:2) -dt = as.data.table(df) -mx = matrix(1:9, 3, 3) -ar = array(1:27, c(3,3,3)) -xt = structure( - c(142.25, 141.229996, 141.330002, 142.860001, 142.050003, 141.399994, - 140.570007, 140.610001, 140.380005, 141.369995, 141.669998, 140.539993, - 94807600, 69620600, 76645300, 108.999954, 109.231255, 108.360008), - class = c("xts", "zoo"), .indexCLASS = "Date", tclass = "Date", .indexTZ = "UTC", tzone = "UTC", - index = structure(c(1167782400, 1167868800, 1167955200), tzone = "UTC", tclass = "Date"), - .Dim = c(3L, 6L), .Dimnames = list(NULL, c("SPY.Open", "SPY.High", "SPY.Low", "SPY.Close", "SPY.Volume", "SPY.Adjusted")) -) -old = options(datatable.verbose=TRUE) -if (test_xts) { - test(2108.21, last(x, n=2L), 2:3, output="using xts::last: !is.xts(x) & nargs>1 & 'package:xts'%in%search()") - test(2108.22, last(y, n=2L), y[2:3], output="using xts::last: !is.xts(x) & nargs>1 & 'package:xts'%in%search()") - test(2108.23, last(x, n=1L), 3L, output="using xts::last: !is.xts(x) & nargs>1 & 'package:xts'%in%search()") - test(2108.24, last(y, n=1L), y[3L], output="using xts::last: !is.xts(x) & nargs>1 & 'package:xts'%in%search()") - xt_last = structure( - c(141.330002, 141.399994, 140.380005, 140.539993, 76645300, 108.360008), - class = c("xts", "zoo"), .indexCLASS = "Date", tclass = "Date", .indexTZ = "UTC", tzone = "UTC", - index = structure(1167955200, tzone = "UTC", tclass = "Date"), - .Dim = c(1L, 6L), .Dimnames = list(NULL, c("SPY.Open", "SPY.High", "SPY.Low", "SPY.Close", "SPY.Volume", "SPY.Adjusted")) - ) - xt_last2 = structure( - c(141.229996, 141.330002, 142.050003, 141.399994, 140.610001, 140.380005, - 141.669998, 140.539993, 69620600, 76645300, 109.231255, 108.360008), - class = c("xts", "zoo"), .indexCLASS = "Date", tclass = "Date", .indexTZ = "UTC", tzone = "UTC", - index = structure(c(1167868800, 1167955200), tzone = "UTC", tclass = "Date"), - .Dim = c(2L, 6L), .Dimnames = list(NULL, c("SPY.Open", "SPY.High", "SPY.Low", "SPY.Close", "SPY.Volume", "SPY.Adjusted")) - ) - test(2108.25, last(xt), xt_last, output="using xts::last: is.xts(x)") - test(2108.26, last(xt, n=2L), xt_last2, output="using xts::last: is.xts(x)") - test(2108.31, first(x, n=2L), 1:2, output="using xts::first: !is.xts(x) & nargs>1 & 'package:xts'%in%search()") - test(2108.32, first(y, n=2L), y[1:2], output="using xts::first: !is.xts(x) & nargs>1 & 'package:xts'%in%search()") - test(2108.33, first(x, n=1L), 1L, output="using xts::first: !is.xts(x) & nargs>1 & 'package:xts'%in%search()") - test(2108.34, first(y, n=1L), y[1L], output="using xts::first: !is.xts(x) & nargs>1 & 'package:xts'%in%search()") - xt_first = structure( - c(142.25, 142.860001, 140.570007, 141.369995, 94807600, 108.999954), - class = c("xts", "zoo"), .indexCLASS = "Date", tclass = "Date", .indexTZ = "UTC", tzone = "UTC", - index = structure(1167782400, tzone = "UTC", tclass = "Date"), - .Dim = c(1L, 6L), .Dimnames = list(NULL, c("SPY.Open", "SPY.High", "SPY.Low", "SPY.Close", "SPY.Volume", "SPY.Adjusted")) - ) - xt_first2 = structure( - c(142.25, 141.229996, 142.860001, 142.050003, 140.570007, 140.610001, 141.369995, 141.669998, 94807600, 69620600, 108.999954, 109.231255), - class = c("xts", "zoo"), .indexCLASS = "Date", tclass = "Date", .indexTZ = "UTC", tzone = "UTC", - index = structure(c(1167782400, 1167868800), tzone = "UTC", tclass = "Date"), - .Dim = c(2L, 6L), .Dimnames = list(NULL, c("SPY.Open", "SPY.High", "SPY.Low", "SPY.Close", "SPY.Volume", "SPY.Adjusted")) - ) - test(2108.35, first(xt), xt_first, output="using xts::first: is.xts(x)") - test(2108.36, first(xt, n=2L), xt_first2, output="using xts::first: is.xts(x)") -} else { - test(2108.21, last(x, n=2L), 2:3, output="using utils::tail: !is.xts(x) & nargs>1 & !'package:xts'%in%search()") - test(2108.22, last(y, n=2L), y[2:3], output="using utils::tail: !is.xts(x) & nargs>1 & !'package:xts'%in%search()") - test(2108.23, last(x, n=1L), 3L, output="using utils::tail: !is.xts(x) & nargs>1 & !'package:xts'%in%search()") - test(2108.24, last(y, n=1L), y[3L], output="using utils::tail: !is.xts(x) & nargs>1 & !'package:xts'%in%search()") - test(2108.25, last(xt), error="you should have 'xts' installed already") - test(2108.26, last(xt, n=2L), error="you should have 'xts' installed already") - test(2108.31, first(x, n=2L), 1:2, output="using utils::head: !is.xts(x) & nargs>1 & !'package:xts'%in%search()") - test(2108.32, first(y, n=2L), y[1:2], output="using utils::head: !is.xts(x) & nargs>1 & !'package:xts'%in%search()") - test(2108.33, first(x, n=1L), 1L, output="using utils::head: !is.xts(x) & nargs>1 & !'package:xts'%in%search()") - test(2108.34, first(y, n=1L), y[1L], output="using utils::head: !is.xts(x) & nargs>1 & !'package:xts'%in%search()") - test(2108.35, first(xt), error="you should have 'xts' installed already") - test(2108.36, first(xt, n=2L), error="you should have 'xts' installed already") -} -test(2108.41, last(x), 3L, output="using 'x[[length(x)]]': !is.xts(x) & !nargs>1 & is.null(dim(x))") -test(2108.42, last(y), y[3L], output="using 'x[[length(x)]]': !is.xts(x) & !nargs>1 & is.null(dim(x))") -test(2108.51, first(x), 1L, output="using 'x[[1L]]': !is.xts(x) & !nargs>1 & is.null(dim(x))") -test(2108.52, first(y), y[1L], output="using 'x[[1L]]': !is.xts(x) & !nargs>1 & is.null(dim(x))") -test(2108.61, last(df), structure(list(a=2L, b=2L), row.names=2L, class="data.frame"), output="using 'x[nrow(x),]': !is.xts(x) & !nargs>1 & is.data.frame(x)") -test(2108.62, last(dt), data.table(a=2L, b=2L), output="using 'x[nrow(x),]': !is.xts(x) & !nargs>1 & is.data.frame(x)") -test(2108.71, first(df), structure(list(a=1L, b=3L), row.names=1L, class="data.frame"), output="using 'x[1L,]': !is.xts(x) & !nargs>1 & is.data.frame(x)") -test(2108.72, first(dt), data.table(a=1L, b=3L), output="using 'x[1L,]': !is.xts(x) & !nargs>1 & is.data.frame(x)") -# matrix/array utils::tail behavior is likely to change in future R, Michael is more in the topic -test(2108.81, last(mx), structure(c(3L, 6L, 9L), .Dim = c(1L, 3L), .Dimnames = list("[3,]", NULL)), output="using utils::tail: !is.xts(x) & !nargs>1 & !is.null(dim(x)) & !is.data.frame(x)") -expected = if (base::getRversion() < "3.7.0") 27L else structure(c(3L, 6L, 9L, 12L, 15L, 18L, 21L, 24L, 27L), .Dim = c(1L, 3L, 3L), .Dimnames = list("[3,]", NULL, NULL)) #4127 -test(2108.82, last(ar), expected, output="using utils::tail: !is.xts(x) & !nargs>1 & !is.null(dim(x)) & !is.data.frame(x)") -test(2108.91, first(mx), structure(c(1L, 4L, 7L), .Dim = c(1L, 3L)), output="using utils::head: !is.xts(x) & !nargs>1 & !is.null(dim(x)) & !is.data.frame(x)") -expected = if (base::getRversion() < "3.7.0") 1L else structure(c(1L, 4L, 7L, 10L, 13L, 16L, 19L, 22L, 25L), .Dim = c(1L, 3L, 3L)) #4127 -test(2108.92, first(ar), expected, output="using utils::head: !is.xts(x) & !nargs>1 & !is.null(dim(x)) & !is.data.frame(x)") -options(old) +# 2108 tested xts moved to other.Rraw 19, #5516 # error in autonaming by={...}, #3156 DT = data.table(State=c("ERROR", "COMPLETED", "ERROR"), ExitCode=c(1, 0, 2)) @@ -17208,10 +16756,7 @@ if(test_bit64) { i=as.integer64(1:12)+3e9 test(2127.26, fcase(test_vec_na1, i, test_vec_na2, i+100), c(i[1L:5L], as.integer64(NA),i[7L:11L]+100, as.integer64(NA))) } -if(test_nanotime) { - n=nanotime(1:12) - test(2127.27, fcase(test_vec_na1, n, test_vec_na2, n+100), c(n[1L:5L], nanotime(NA),n[7L:11L]+100, as.integer64(NA))) -} +# 2127.27 tested nanotime moved to other.Rraw 26, #5516 test(2127.28, fcase(test_vec1, rep(1L,11L), test_vec2, rep(0L,11L)), as.integer(out_vec)) test(2127.29, fcase(test_vec1, rep(1,11L), test_vec2, rep(0,11L)), out_vec) test(2127.30, fcase(test_vec1, rep("1",11L), test_vec2, rep("0",11L)), as.character(out_vec)) @@ -17376,20 +16921,8 @@ test(2132.2, fifelse(TRUE, 1, s2), error = "S4 class objects (except nanot test(2132.3, fcase(TRUE, s1, FALSE, s2), error = "S4 class objects (except nanotime) are not supported. Please see") test(2132.4, fcase(FALSE, 1, TRUE, s1), error = "S4 class objects (except nanotime) are not supported. Please see") rm(s1, s2, class2132) -if (test_xts) { - # keep.rownames in as.data.table.xts() supports a string, #4232 - xts = xts::xts(1:10, structure(1:10, class = "Date")) - colnames(xts) = "VALUE" - DT = as.data.table(xts, keep.rownames = "DATE", key = "DATE") - test(2133.1, colnames(DT), c("DATE", "VALUE")) - test(2133.2, key(DT), "DATE") - test(2133.3, as.data.table(xts, keep.rownames = "VALUE"), - error = "Input xts object should not have 'VALUE' column because it would result in duplicate column names. Rename 'VALUE' column in xts or use `keep.rownames` to change the index column name.") - test(2133.4, as.data.table(xts, keep.rownames = character()), - error = "keep.rownames must be length 1") - test(2133.5, as.data.table(xts, keep.rownames = NA_character_), - error = "keep.rownames must not be NA") -} + +# 2133 tested xts moved to other.Rraw 20, #5516 # friendlier error for common mistake of using := in i instead of j, #4227 DT = data.table(a = 1) @@ -18213,11 +17746,7 @@ test(2203.20, tstrsplit(w, "/", type.convert=list()), error="not support empty l test(2204, as.data.table(mtcars, keep.rownames='model', key='model'), setnames(setkey(as.data.table(mtcars, keep.rownames = TRUE), rn), 'rn', 'model')) -# na.omit works for nanotime, #4744 -if (test_nanotime) { - DT = data.table(time=nanotime(c(1,NA,3))) - test(2205, na.omit(DT), DT[c(1,3)]) -} +# 2205 tested nanotime moved to other.Rraw 27, #5516 # isRealReallyInt, #3966 test(2206.01, isRealReallyInt(c(-2147483647.0, NA, 0.0, 2147483647.0)), TRUE)