diff --git a/DESCRIPTION b/DESCRIPTION index d8aba90..2ff7481 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -11,7 +11,8 @@ Description: Basic functions, implemented in C, for large data manipulation. Fas URL: https://fastverse.org/kit/, https://github.com/fastverse/kit License: GPL-3 Depends: R (>= 3.1.0) -Suggests: knitr, rmarkdown +Suggests: knitr, rmarkdown, testthat (>= 3.0.0) +Config/testthat/edition: 3 VignetteBuilder: knitr Encoding: UTF-8 BugReports: https://github.com/fastverse/kit/issues diff --git a/tests/test_kit.R b/tests/test_kit.R deleted file mode 100644 index 21b6b71..0000000 --- a/tests/test_kit.R +++ /dev/null @@ -1,1912 +0,0 @@ -# -------------------------------------------------------------------------------------------------- -# Test Package kit -# -------------------------------------------------------------------------------------------------- - -set.seed(123) - -check = function(test,x,y,error=NULL,warning=NULL) { - opt = list("warning"=NULL, "error"=NULL) - warnFun = function(wrn) { opt$warning <<- c(opt$warning, conditionMessage(wrn)); invokeRestart("muffleWarning") } - errorFun = function(err) { opt$error <<- conditionMessage(err); err } - x = suppressMessages(withCallingHandlers(tryCatch(x, error=errorFun), warning=warnFun)) - for (len in c("warning","error")) { - output = opt[[len]]; input = get(len) - if (length(input) != length(output)) { - cat("Check",test,"failed.\n"); return(invisible(FALSE)) - } else { - for (i in seq_along(input)) { - if(!(length(grep(input[i], output[i], fixed=TRUE)) || - length( - tryCatch(grep(input[i], output[i], ignore.case=FALSE), error=function(err) NULL))) - ) { - cat("Check",test,"failed.\n"); return(invisible(FALSE)) - } - } - } - } - if (length(error) == 0) { - if (identical(x,y)) return(invisible(TRUE)) - if (is.atomic(x) && is.atomic(y) && isTRUE(all.equal(x,y,check.names=!isTRUE(y))) && - typeof(x)==typeof(y)) return(invisible(TRUE)) - cat("Check",test,"failed.\n") - } - return(invisible(FALSE)) -} - - -topn = kit::topn -setlevels = kit::setlevels -psum = kit::psum -pprod = kit::pprod -fpmin = kit::fpmin -fpmax = kit::fpmax -prange = kit::prange -nif = kit::nif -iif = kit::iif -fpos = kit::fpos -vswitch = kit::vswitch -pall = kit::pall -pallNA = kit::pallNA -pallv = kit::pallv -pany = kit::pany -panyNA = kit::panyNA -panyv = kit::panyv -pmean = kit::pmean -pfirst = kit::pfirst -plast = kit::plast -countNA = kit::countNA -count = kit::count -pcount = kit::pcount -pcountNA = kit::pcountNA -fduplicated = kit::fduplicated -funique = kit::funique -countOccur = kit::countOccur -uniqLen = kit::uniqLen -nswitch = kit::nswitch -psort = kit::psort -charToFact = kit::charToFact -shareData = kit::shareData -getData = kit::getData -clearData = kit::clearData - -# -------------------------------------------------------------------------------------------------- -# topn -# -------------------------------------------------------------------------------------------------- - -x0 = c(3L, 2L, 10L, NA_integer_, 1L, 1L, NA_integer_, NA_integer_, 10L, 20L, 20L, 20L, 30L) -x1 = as.numeric(x0) -x2 = c(NA_integer_, NA_integer_, NA_integer_) -x3 = as.numeric(x2) -x4 = as.raw(c(1,2,3)) -x5 = sample(c(1:1000),3e3,TRUE) -x6 = sample(as.numeric(c(1:1000)),1e3,TRUE) -class2134 = setClass("class2134", slots=list(x="numeric")) -s1 = class2134(x=20191231) -x7 = seq.int(1e4) - -check("0001.001", topn(x0, 1L, decreasing=FALSE), order(x0)[1:1]) -check("0001.002", topn(x0, 2L, decreasing=FALSE), order(x0)[1:2]) -check("0001.003", topn(x0, 3L, decreasing=FALSE), order(x0)[1:3]) -check("0001.004", topn(x0, 4L, decreasing=FALSE), order(x0)[1:4]) -check("0001.005", topn(x0, 5L, decreasing=FALSE), order(x0)[1:5]) -check("0001.006", topn(x0, 6L, decreasing=FALSE), order(x0)[1:6]) -check("0001.007", topn(x0, 7L, decreasing=FALSE), order(x0)[1:7]) -check("0001.008", topn(x0, 8L, decreasing=FALSE), order(x0)[1:8]) -check("0001.009", topn(x0, 9L, decreasing=FALSE), order(x0)[1:9]) -check("0001.010", topn(x0, 10L, decreasing=FALSE), order(x0)[1:10]) -check("0001.011", topn(x0, 11L, decreasing=FALSE), order(x0)[1:11]) -check("0001.012", topn(x0, 12L, decreasing=FALSE), order(x0)[1:12]) -check("0001.013", topn(x0, 13L, decreasing=FALSE), order(x0)[1:13]) -check("0001.014", topn(x1, 1L, decreasing=FALSE), order(x1)[1:1]) -check("0001.015", topn(x1, 2L, decreasing=FALSE), order(x1)[1:2]) -check("0001.016", topn(x1, 3L, decreasing=FALSE), order(x1)[1:3]) -check("0001.017", topn(x1, 4L, decreasing=FALSE), order(x1)[1:4]) -check("0001.018", topn(x1, 5L, decreasing=FALSE), order(x1)[1:5]) -check("0001.019", topn(x1, 6L, decreasing=FALSE), order(x1)[1:6]) -check("0001.020", topn(x1, 7L, decreasing=FALSE), order(x1)[1:7]) -check("0001.021", topn(x1, 8L, decreasing=FALSE), order(x1)[1:8]) -check("0001.022", topn(x1, 9L, decreasing=FALSE), order(x1)[1:9]) -check("0001.023", topn(x1, 10L, decreasing=FALSE), order(x1)[1:10]) -check("0001.024", topn(x1, 11L, decreasing=FALSE), order(x1)[1:11]) -check("0001.025", topn(x1, 12L, decreasing=FALSE), order(x1)[1:12]) -check("0001.026", topn(x1, 13L, decreasing=FALSE), order(x1)[1:13]) -check("0001.027", topn(x2, 1L, decreasing=FALSE), order(x2)[1:1]) -check("0001.028", topn(x2, 2L, decreasing=FALSE), order(x2)[1:2]) -check("0001.029", topn(x2, 3L, decreasing=FALSE), order(x2)[1:3]) -check("0001.030", topn(x3, 1L, decreasing=FALSE), order(x3)[1:1]) -check("0001.031", topn(x3, 2L, decreasing=FALSE), order(x3)[1:2]) -check("0001.032", topn(x3, 3L, decreasing=FALSE), order(x3)[1:3]) -check("0001.033", topn(x0, 1L, decreasing=TRUE), order(x0, decreasing=TRUE)[1:1]) -check("0001.034", topn(x0, 2L, decreasing=TRUE), order(x0, decreasing=TRUE)[1:2]) -check("0001.035", topn(x0, 3L, decreasing=TRUE), order(x0, decreasing=TRUE)[1:3]) -check("0001.036", topn(x0, 4L, decreasing=TRUE), order(x0, decreasing=TRUE)[1:4]) -check("0001.037", topn(x0, 5L, decreasing=TRUE), order(x0, decreasing=TRUE)[1:5]) -check("0001.038", topn(x0, 6L, decreasing=TRUE), order(x0, decreasing=TRUE)[1:6]) -check("0001.039", topn(x0, 7L, decreasing=TRUE), order(x0, decreasing=TRUE)[1:7]) -check("0001.040", topn(x0, 8L, decreasing=TRUE), order(x0, decreasing=TRUE)[1:8]) -check("0001.041", topn(x0, 9L, decreasing=TRUE), order(x0, decreasing=TRUE)[1:9]) -check("0001.042", topn(x0, 10L, decreasing=TRUE), order(x0, decreasing=TRUE)[1:10]) -check("0001.043", topn(x0, 11L, decreasing=TRUE), order(x0, decreasing=TRUE)[1:11]) -check("0001.044", topn(x0, 12L, decreasing=TRUE), order(x0, decreasing=TRUE)[1:12]) -check("0001.045", topn(x0, 13L, decreasing=TRUE), order(x0, decreasing=TRUE)[1:13]) -check("0001.046", topn(x1, 1L, decreasing=TRUE), order(x1, decreasing=TRUE)[1:1]) -check("0001.047", topn(x1, 2L, decreasing=TRUE), order(x1, decreasing=TRUE)[1:2]) -check("0001.048", topn(x1, 3L, decreasing=TRUE), order(x1, decreasing=TRUE)[1:3]) -check("0001.049", topn(x1, 4L, decreasing=TRUE), order(x1, decreasing=TRUE)[1:4]) -check("0001.050", topn(x1, 5L, decreasing=TRUE), order(x1, decreasing=TRUE)[1:5]) -check("0001.051", topn(x1, 6L, decreasing=TRUE), order(x1, decreasing=TRUE)[1:6]) -check("0001.052", topn(x1, 7L, decreasing=TRUE), order(x1, decreasing=TRUE)[1:7]) -check("0001.053", topn(x1, 8L, decreasing=TRUE), order(x1, decreasing=TRUE)[1:8]) -check("0001.054", topn(x1, 9L, decreasing=TRUE), order(x1, decreasing=TRUE)[1:9]) -check("0001.055", topn(x1, 10L, decreasing=TRUE), order(x1, decreasing=TRUE)[1:10]) -check("0001.056", topn(x1, 11L, decreasing=TRUE), order(x1, decreasing=TRUE)[1:11]) -check("0001.057", topn(x1, 12L, decreasing=TRUE), order(x1, decreasing=TRUE)[1:12]) -check("0001.058", topn(x1, 13L, decreasing=TRUE), order(x1, decreasing=TRUE)[1:13]) -check("0001.060", topn(x2, 1L, decreasing=TRUE), order(x2, decreasing=TRUE)[1:1]) -check("0001.061", topn(x2, 2L, decreasing=TRUE), order(x2, decreasing=TRUE)[1:2]) -check("0001.062", topn(x2, 3L, decreasing=TRUE), order(x2, decreasing=TRUE)[1:3]) -check("0001.063", topn(x3, 1L, decreasing=TRUE), order(x3, decreasing=TRUE)[1:1]) -check("0001.064", topn(x3, 2L, decreasing=TRUE), order(x3, decreasing=TRUE)[1:2]) -check("0001.065", topn(x3, 3L, decreasing=TRUE), order(x3, decreasing=TRUE)[1:3]) -check("0001.066", topn(x0, -1L), error = "Please enter a positive integer larger or equal to 1.") -check("0001.067", topn(x5, 2001L,decreasing = TRUE), order(x5, decreasing=TRUE)[1:2001]) -check("0001.068", topn(x0, 100L,decreasing = FALSE), order(x0)[1:13], warning = "'n' is larger than length of 'vec'. 'n' will be set to length of 'vec'.") -check("0001.069", topn(x0, 10L, decreasing = NA), error = "Argument 'decreasing' must be TRUE or FALSE and length 1.") -check("0001.070", topn(s1, 10L, decreasing = NA), error = "S4 class objects are not supported.") -check("0001.071", topn(x4, 2L), error = "Type raw is not supported.") -check("0001.072", topn(x4, 2L, decreasing = TRUE), error = "Type raw is not supported.") -check("0001.073", topn(x4, 2L, decreasing=FALSE), error = "Type raw is not supported.") -check("0001.074", topn(x5, 1L, decreasing=FALSE,hasna=FALSE), order(x5)[1:1]) -check("0001.075", topn(x5, 2L, decreasing=FALSE,hasna=FALSE), order(x5)[1:2]) -check("0001.076", topn(x5, 3L, decreasing=FALSE,hasna=FALSE), order(x5)[1:3]) -check("0001.077", topn(x5, 4L, decreasing=FALSE,hasna=FALSE), order(x5)[1:4]) -check("0001.078", topn(x5, 5L, decreasing=FALSE,hasna=FALSE), order(x5)[1:5]) -check("0001.079", topn(x5, 6L, decreasing=FALSE,hasna=FALSE), order(x5)[1:6]) -check("0001.080", topn(x5, 7L, decreasing=FALSE,hasna=FALSE), order(x5)[1:7]) -check("0001.081", topn(x5, 8L, decreasing=FALSE,hasna=FALSE), order(x5)[1:8]) -check("0001.082", topn(x5, 9L, decreasing=FALSE,hasna=FALSE), order(x5)[1:9]) -check("0001.083", topn(x5, 10L, decreasing=FALSE,hasna=FALSE), order(x5)[1:10]) -check("0001.084", topn(x5, 11L, decreasing=FALSE,hasna=FALSE), order(x5)[1:11]) -check("0001.085", topn(x5, 12L, decreasing=FALSE,hasna=FALSE), order(x5)[1:12]) -check("0001.086", topn(x5, 13L, decreasing=FALSE,hasna=FALSE), order(x5)[1:13]) -check("0001.087", topn(x5, 1L, decreasing=TRUE,hasna=FALSE), order(x5,decreasing = TRUE)[1:1]) -check("0001.088", topn(x5, 2L, decreasing=TRUE,hasna=FALSE), order(x5,decreasing = TRUE)[1:2]) -check("0001.089", topn(x5, 3L, decreasing=TRUE,hasna=FALSE), order(x5,decreasing = TRUE)[1:3]) -check("0001.090", topn(x5, 4L, decreasing=TRUE,hasna=FALSE), order(x5,decreasing = TRUE)[1:4]) -check("0001.091", topn(x5, 5L, decreasing=TRUE,hasna=FALSE), order(x5,decreasing = TRUE)[1:5]) -check("0001.092", topn(x5, 6L, decreasing=TRUE,hasna=FALSE), order(x5,decreasing = TRUE)[1:6]) -check("0001.093", topn(x5, 7L, decreasing=TRUE,hasna=FALSE), order(x5,decreasing = TRUE)[1:7]) -check("0001.094", topn(x5, 8L, decreasing=TRUE,hasna=FALSE), order(x5,decreasing = TRUE)[1:8]) -check("0001.095", topn(x5, 9L, decreasing=TRUE,hasna=FALSE), order(x5,decreasing = TRUE)[1:9]) -check("0001.096", topn(x5, 10L, decreasing=TRUE,hasna=FALSE), order(x5,decreasing = TRUE)[1:10]) -check("0001.097", topn(x5, 11L, decreasing=TRUE,hasna=FALSE), order(x5,decreasing = TRUE)[1:11]) -check("0001.098", topn(x5, 12L, decreasing=TRUE,hasna=FALSE), order(x5,decreasing = TRUE)[1:12]) -check("0001.099", topn(x5, 13L, decreasing=TRUE,hasna=FALSE), order(x5,decreasing = TRUE)[1:13]) -check("0001.100", topn(x6, 1L, decreasing=FALSE,hasna=FALSE), order(x6)[1:1]) -check("0001.101", topn(x6, 2L, decreasing=FALSE,hasna=FALSE), order(x6)[1:2]) -check("0001.102", topn(x6, 3L, decreasing=FALSE,hasna=FALSE), order(x6)[1:3]) -check("0001.103", topn(x6, 4L, decreasing=FALSE,hasna=FALSE), order(x6)[1:4]) -check("0001.104", topn(x6, 5L, decreasing=FALSE,hasna=FALSE), order(x6)[1:5]) -check("0001.105", topn(x6, 6L, decreasing=FALSE,hasna=FALSE), order(x6)[1:6]) -check("0001.106", topn(x6, 7L, decreasing=FALSE,hasna=FALSE), order(x6)[1:7]) -check("0001.107", topn(x6, 8L, decreasing=FALSE,hasna=FALSE), order(x6)[1:8]) -check("0001.108", topn(x6, 9L, decreasing=FALSE,hasna=FALSE), order(x6)[1:9]) -check("0001.109", topn(x6, 10L, decreasing=FALSE,hasna=FALSE), order(x6)[1:10]) -check("0001.110", topn(x6, 11L, decreasing=FALSE,hasna=FALSE), order(x6)[1:11]) -check("0001.111", topn(x6, 12L, decreasing=FALSE,hasna=FALSE), order(x6)[1:12]) -check("0001.112", topn(x6, 13L, decreasing=FALSE,hasna=FALSE), order(x6)[1:13]) -check("0001.113", topn(x6, 1L, decreasing=TRUE,hasna=FALSE), order(x6,decreasing = TRUE)[1:1]) -check("0001.114", topn(x6, 2L, decreasing=TRUE,hasna=FALSE), order(x6,decreasing = TRUE)[1:2]) -check("0001.115", topn(x6, 3L, decreasing=TRUE,hasna=FALSE), order(x6,decreasing = TRUE)[1:3]) -check("0001.116", topn(x6, 4L, decreasing=TRUE,hasna=FALSE), order(x6,decreasing = TRUE)[1:4]) -check("0001.117", topn(x6, 5L, decreasing=TRUE,hasna=FALSE), order(x6,decreasing = TRUE)[1:5]) -check("0001.118", topn(x6, 6L, decreasing=TRUE,hasna=FALSE), order(x6,decreasing = TRUE)[1:6]) -check("0001.119", topn(x6, 7L, decreasing=TRUE,hasna=FALSE), order(x6,decreasing = TRUE)[1:7]) -check("0001.120", topn(x6, 8L, decreasing=TRUE,hasna=FALSE), order(x6,decreasing = TRUE)[1:8]) -check("0001.121", topn(x6, 9L, decreasing=TRUE,hasna=FALSE), order(x6,decreasing = TRUE)[1:9]) -check("0001.122", topn(x6, 10L, decreasing=TRUE,hasna=FALSE), order(x6,decreasing = TRUE)[1:10]) -check("0001.123", topn(x6, 11L, decreasing=TRUE,hasna=FALSE), order(x6,decreasing = TRUE)[1:11]) -check("0001.124", topn(x6, 12L, decreasing=TRUE,hasna=FALSE), order(x6,decreasing = TRUE)[1:12]) -check("0001.125", topn(x6, 13L, decreasing=TRUE,hasna=FALSE), order(x6,decreasing = TRUE)[1:13]) -check("0001.126", topn(x4, 2L, decreasing = TRUE,hasna = FALSE), error = "Type raw is not supported.") -check("0001.127", topn(x4, 2L, decreasing=FALSE,hasna = FALSE), error = "Type raw is not supported.") -check("0001.128", topn(c(1,2,4,10,2,3), 2L, hasna=c(FALSE,TRUE)), error = "Argument 'hasna' must be TRUE or FALSE and length 1.") -check("0001.129", topn(x5, 2001L,decreasing = FALSE), order(x5, decreasing=FALSE)[1:2001]) -check("0001.130", topn(x7,1e4,decreasing=FALSE), order(x7, decreasing=FALSE)) -check("0001.131", topn(as.numeric(x7),1e4,decreasing=FALSE), order(as.numeric(x7), decreasing=FALSE)) - -rm(s1, class2134, x0, x1, x2, x3, x4, x5, x6, x7) - -# -------------------------------------------------------------------------------------------------- -# iif -# -------------------------------------------------------------------------------------------------- - -class2132 = setClass("class2132", slots=list(x="numeric")) -s1 = class2132(x=20191231) -s2 = class2132(x=20191230) -test_vec = -5L:5L < 0L -test_vec_na = c(test_vec, NA) -out_vec = rep(1:0, 5:6) -out_vec_na = c(out_vec, NA_integer_) -date_vec = as.Date(14975:14979, origin = '1970-01-01') - -check("0002.001", iif(test_vec, 1L, 0L), out_vec) -check("0002.002", iif(test_vec, 1, 0), as.numeric(out_vec)) -check("0002.003", iif(test_vec, TRUE, FALSE), as.logical(out_vec)) -check("0002.004", iif(test_vec, "1", "0"), as.character(out_vec)) -check("0002.005", iif(test_vec_na, TRUE, NA), c(rep(TRUE,5L), rep(NA,7L))) -check("0002.006", iif(test_vec, rep(1L,11L), rep(0L,11L)), out_vec) -check("0002.007", iif(test_vec, rep(1L,11L), 0L), out_vec) -check("0002.008", iif(test_vec, 1L, rep(0L,11L)), out_vec) -check("0002.009", iif(test_vec, rep(1L,11L), rep(0L,10L)), error="Length of 'no' is 10 but must be 1 or length of 'test' (11).") -check("0002.010", iif(test_vec, rep(1,10L), rep(0,11L)), error="Length of 'yes' is 10 but must be 1 or length of 'test' (11).") -check("0002.011", iif(test_vec, rep(TRUE,10L), rep(FALSE,10L)), error="Length of 'yes' is 10 but must be 1 or length of 'test' (11).") -check("0002.012", iif(0:1, rep(TRUE,2L), rep(FALSE,2L)), error="Argument 'test' must be logical.") -check("0002.013", iif(test_vec, TRUE, "FALSE"), error="'yes' is of type logical but 'no' is of type character. Please") -check("0002.014", iif(test_vec, list(1),list(2,4)), error="Length of 'no' is 2 but must be 1 or length of 'test' (11).") -check("0002.015", iif(test_vec, list(1,3),list(2,4)), error="Length of 'yes' is 2 but must be 1 or length of 'test' (11).") -check("0002.016", iif(test_vec, list(1), list(0)), as.list(as.numeric(out_vec))) -check("0002.017", iif(test_vec, list(1), list(0)), as.list(as.numeric(out_vec))) -check("0002.018", iif(date_vec == "2011-01-01", date_vec - 1L, date_vec), c(date_vec[1L] - 1L, date_vec[2:5])) -check("0002.019", iif(c(TRUE,FALSE,TRUE,TRUE,FALSE), factor(letters[1:5]), factor("a", levels=letters[1:5])), factor(c("a","a","c","d","a"), levels=letters[1:5])) -check("0002.020", iif(test_vec_na, 1L, 0L), out_vec_na) -check("0002.021", iif(test_vec_na, rep(1L,12L), 0L), out_vec_na) -check("0002.022", iif(test_vec_na, rep(1L,12L), rep(0L,12L)), out_vec_na) -check("0002.023", iif(test_vec_na, 1L, rep(0L,12L)), out_vec_na) -check("0002.024", iif(test_vec_na, 1, 0), as.numeric(out_vec_na)) -check("0002.025", iif(test_vec_na, rep(1,12L), 0), as.numeric(out_vec_na)) -check("0002.026", iif(test_vec_na, rep(1,12L), rep(0,12L)), as.numeric(out_vec_na)) -check("0002.027", iif(test_vec_na, 1, rep(0,12L)), as.numeric(out_vec_na)) -check("0002.028", iif(test_vec_na, TRUE, rep(FALSE,12L)), as.logical(out_vec_na)) -check("0002.029", iif(test_vec_na, rep(TRUE,12L), FALSE), as.logical(out_vec_na)) -check("0002.030", iif(test_vec_na, rep(TRUE,12L), rep(FALSE,12L)), as.logical(out_vec_na)) -check("0002.031", iif(test_vec_na, "1", rep("0",12L)), as.character(out_vec_na)) -check("0002.032", iif(test_vec_na, rep("1",12L), "0"), as.character(out_vec_na)) -check("0002.033", iif(test_vec_na, rep("1",12L), rep("0",12L)), as.character(out_vec_na)) -check("0002.034", iif(test_vec_na, "1", "0"), as.character(out_vec_na)) -check("0002.035", iif(test_vec, as.Date("2011-01-01"), FALSE), error="'yes' is of type double but 'no' is of type logical. Please") -check("0002.036", iif(test_vec_na, 1+0i, 0+0i), as.complex(out_vec_na)) -check("0002.037", iif(test_vec_na, rep(1+0i,12L), 0+0i), as.complex(out_vec_na)) -check("0002.038", iif(test_vec_na, rep(1+0i,12L), rep(0+0i,12L)), as.complex(out_vec_na)) -check("0002.039", iif(test_vec_na, 1+0i, rep(0+0i,12L)), as.complex(out_vec_na)) -check("0002.040", iif(test_vec, as.raw(0), as.raw(1)), error="Type raw is not supported.") -check("0002.041", iif(TRUE,1,as.Date("2019-07-07")), error="'yes' has different class than 'no'. Please") -check("0002.042", iif(TRUE,1L,factor(letters[1])), error="'yes' has different class than 'no'. Please") -check("0002.043", iif(TRUE, list(1:5), list(5:1)), list(1:5)) -check("0002.044", iif(as.logical(NA), list(1:5), list(5:1)), list(NULL)) -check("0002.045", iif(FALSE, list(1:5), list(5:1)), list(5:1)) -check("0002.048", iif(TRUE, list(data.frame(1:5)), list(data.frame(5:1))), list(data.frame(1:5))) -check("0002.049", iif(FALSE, list(data.frame(1:5)), list(data.frame(5:1))), list(data.frame(5:1))) -check("0002.050", iif(c(TRUE,FALSE), list(1:5,6:10), list(10:6,5:1)), list(1:5,5:1)) -check("0002.051", iif(c(NA,TRUE), list(1:5,6:10), list(10:6,5:1)), list(NULL,6:10)) -check("0002.052", iif(c(FALSE,TRUE), list(1:5,6:10), list(10:6,5:1)), list(10:6,6:10)) -check("0002.053", iif(c(NA,TRUE), list(1:5), list(10:6,5:1)), list(NULL,1:5)) -check("0002.054", iif(c(NA,TRUE), list(1:5,6:10), list(5:1)), list(NULL,6:10)) -check("0002.055", iif(c(FALSE,TRUE), list(TRUE), list(10:6,5:1)), list(10:6,TRUE)) -check("0002.056", iif(c(FALSE,TRUE), list(as.Date("2019-07-07")), list(10:6,5:1)), list(10:6,as.Date("2019-07-07"))) -check("0002.057", iif(c(FALSE,TRUE), list(factor(letters[1:5])), list(10:6,5:1)), list(10:6,factor(letters[1:5]))) -check("0002.058", iif(c(NA,FALSE), list(1:5), list(10:6,5:1)), list(NULL,5:1)) -check("0002.059", iif(c(NA,FALSE), list(1:5,6:10), list(5:1)), list(NULL,5:1)) -check("0002.060", iif(c(NA,FALSE), list(1:5), list(5:1)), list(NULL,5:1)) -check("0002.061", iif(c(TRUE,FALSE), list(1L), list(0L)), list(1L,0L)) -check("0002.062", iif(c(TRUE,FALSE), list(1L), list(0L)), list(1L,0L)) -check("0002.063", iif(c(TRUE,FALSE), factor(c("a","b")), factor(c("a","c"))), error="'yes' and 'no' are both type factor but their levels are different") -check("0002.064", iif(c(TRUE, TRUE, TRUE, FALSE, FALSE), factor(NA, levels=letters[1:5]), factor(letters[1:5])), factor(c(NA,NA,NA,"d","e"),levels=letters[1:5])) -check("0002.065", iif(c(TRUE, TRUE, TRUE, FALSE, NA, FALSE), factor(NA, levels=letters[1:6]), factor(letters[1:6])), factor(c(NA,NA,NA,"d",NA,"f"),levels=letters[1:6])) -check("0002.066", iif(c(TRUE, TRUE, TRUE, FALSE, NA, FALSE), factor(letters[1:6]), factor(NA, levels=letters[1:6])), factor(c("a","b","c",NA,NA,NA), levels=letters[1:6])) -check("0002.067", iif(c(TRUE, NA, TRUE, FALSE, FALSE, FALSE), factor(NA), factor(NA)), factor(c(NA,NA,NA,NA,NA,NA))) -check("0002.068", iif(c(a=TRUE,b=FALSE), list(m=1,n=2), list(x=11,y=12)), list(a=1, b=12)) -check("0002.069", iif(c(a=TRUE,b=FALSE), c(m=1,n=2), c(x=11,y=12)), c(a=1, b=12)) -check("0002.070", ifelse(c(a=TRUE,b=FALSE), c(1,2), c(11,12)), c(a=1, b=12)) -check("0002.071", iif(TRUE, s1, s2), error = "S4 class objects are not supported.") -check("0002.072", iif(TRUE, 1, s2), error = "S4 class objects are not supported.") -check("0002.073", iif(test_vec, 1L, 0,tprom = TRUE), as.numeric(out_vec)) -check("0002.074", iif(test_vec, 1L, raw(0),tprom = TRUE), error = "Type raw (argument 'no') is not supported.") -check("0002.075", iif(test_vec, raw(1), 0,tprom = TRUE), error = "Type raw (argument 'yes') is not supported.") -check("0002.076", iif(test_vec, 1L, 0, "NA", TRUE), error = "Type of 'na' (character) is higher than double (highest type of 'yes' and 'no'). Please make sure that it is at lower or the same.") -check("0002.077", iif(test_vec_na, 1, 0, NA, TRUE), as.numeric(out_vec_na)) -check("0002.078", iif(test_vec_na, rep(1L, 12L), rep(0, 12L), rep(NA, 12L), TRUE), as.numeric(out_vec_na)) -check("0002.079", iif(test_vec_na, rep(1, 12L), rep(0L, 12L), rep(NA, 12L), TRUE), as.numeric(out_vec_na)) -check("0002.080", iif(test_vec_na, 1, rep(0L, 12L), rep(NA, 12L), TRUE), as.numeric(out_vec_na)) -check("0002.081", iif(test_vec_na, 1, rep(0L, 12L), NA, TRUE), as.numeric(out_vec_na)) -check("0002.082", iif(test_vec_na, rep(1, 12L), 0L, rep(NA, 12L), TRUE), as.numeric(out_vec_na)) -check("0002.083", iif(test_vec_na, rep(1L, 12L), rep(0, 12L), rep(NA, 12L), TRUE), as.numeric(out_vec_na)) -check("0002.084", iif(c(TRUE, TRUE, TRUE, FALSE, NA, FALSE), factor(letters[1:6]), factor("a", levels=letters[1:6]), tprom = TRUE), factor(c("a","b","c","a",NA,"a"), levels=letters[1:6])) -check("0002.085", iif(test_vec_na, 1, 0, rep(NA, 12L), TRUE), as.numeric(out_vec_na)) -check("0002.086", iif(c(date_vec == "2011-01-01", NA), c(date_vec - 1L, date_vec[1L]), c(date_vec, date_vec[1L]), NA, TRUE), c(date_vec[1L] - 1L, date_vec[2:5], NA)) -check("0002.087", iif(c(date_vec == "2011-01-01", NA), c(date_vec - 1L, date_vec[1L]), c(date_vec, date_vec[1L]), NA, FALSE), error = "'yes' is of type double but 'na' is of type logical. Please make sure that both arguments have the same type.") -check("0002.088", iif(c(date_vec == "2011-01-01", NA), c(date_vec - 1L, date_vec[1L]), c(date_vec, date_vec[1L]), as.Date("2020-05-05"), TRUE), c(date_vec[1L] - 1L, date_vec[2:5], as.Date("2020-05-05"))) -check("0002.089", iif(c(date_vec == "2011-01-01", NA), c(date_vec - 1L, date_vec[1L]), c(date_vec, date_vec[1L]), 3L, TRUE), c(date_vec[1L] - 1L, date_vec[2:5], as.Date(3L,origin = "1970-01-01"))) -check("0002.090", iif(c(date_vec == "2011-01-01", NA), c(date_vec - 1L, date_vec[1L]), c(date_vec, date_vec[1L]), 3, TRUE), c(date_vec[1L] - 1L, date_vec[2:5], as.Date(3,origin = "1970-01-01"))) -check("0002.091", iif(c(date_vec == "2011-01-01", NA), c(date_vec - 1L, date_vec[1L]), c(date_vec, date_vec[1L]), 1L, TRUE), c(date_vec[1L] - 1L, date_vec[2:5], as.Date(1,origin = "1970-01-01"))) -check("0002.092", iif(test_vec_na, 1, 0, rep(NA, 12L), c(TRUE,FALSE)), error = "Argument 'tprom' must be either FALSE or TRUE and length 1.") -check("0002.093", iif(test_vec_na, 1, 0, rep(NA, 11L), TRUE), error = "Length of 'na' is 11 but must be 1 or length of 'test' (12).") -check("0002.094", iif(TRUE, as.Date("2020-04-14"), as.Date("2020-04-12"), 2), error = "'yes' has different class than 'na'. Please make sure that both arguments have the same class.") -check("0002.095", iif(TRUE, factor(c("a"),levels=c("a","b")), factor(c("b"),levels=c("a","b")), factor(c("c"),levels=c("a","c"))), error = "'yes' and 'na' are both type factor but their levels are different.") -check("0002.096", iif(c(TRUE, NA), list(1,2), list(3,4),list(5,6)), list(1,6)) -check("0002.097", iif(c(TRUE, NA, FALSE), as.Date("2020-04-14"), 18368, as.Date("2020-04-15"), TRUE), c(as.Date("2020-04-14"), as.Date("2020-04-15"), as.Date("2020-04-16"))) -check("0002.098", iif(c(TRUE, NA, FALSE), 18366, as.Date("2020-04-16"), as.Date("2020-04-15"), TRUE), c(18366, 18367, 18368)) -check("0002.099", iif(c(TRUE, NA, FALSE), as.Date("2020-04-14"), as.Date("2020-04-16"), 18367, TRUE), c(as.Date("2020-04-14"), as.Date("2020-04-15"), as.Date("2020-04-16"))) -check("0002.100", iif(c(TRUE, NA, FALSE), TRUE, FALSE, NA), c(TRUE, NA, FALSE)) -check("0002.101", iif(c(TRUE, NA, FALSE), rep(TRUE,3L), FALSE, NA), c(TRUE, NA, FALSE)) -check("0002.101", iif(c(TRUE, NA, FALSE), rep(TRUE,3L), rep(FALSE,3L), NA), c(TRUE, NA, FALSE)) -check("0002.102", iif(c(TRUE, NA, FALSE), TRUE, rep(FALSE,3L), NA), c(TRUE, NA, FALSE)) -check("0002.103", iif(c(TRUE, NA, FALSE), 1L, 0L, NA_integer_), c(1L, NA_integer_, 0L)) -check("0002.104", iif(c(TRUE, NA, FALSE), rep(1L,3L), 0L, NA_integer_), c(1L, NA_integer_, 0L)) -check("0002.105", iif(c(TRUE, NA, FALSE), rep(1L,3L), rep(0L,3L), NA_integer_), c(1L, NA_integer_, 0L)) -check("0002.106", iif(c(TRUE, NA, FALSE), 1L, rep(0L,3L), NA_integer_), c(1L, NA_integer_, 0L)) -check("0002.107", iif(c(TRUE, NA, FALSE), 1+0i, 0+0i, NA_complex_), c(1+0i, NA_complex_, 0+0i)) -check("0002.108", iif(c(TRUE, NA, FALSE), rep(1+0i,3L), 0+0i, NA_complex_), c(1+0i, NA_complex_, 0+0i)) -check("0002.109", iif(c(TRUE, NA, FALSE), rep(1+0i,3L), rep(0+0i,3L), NA_complex_), c(1+0i, NA_complex_, 0+0i)) -check("0002.110", iif(c(TRUE, NA, FALSE), 1+0i, rep(0+0i,3L), NA_complex_), c(1+0i, NA_complex_, 0+0i)) - -rm(s1, s2, class2132, date_vec, out_vec, out_vec_na, test_vec, test_vec_na) - -# -------------------------------------------------------------------------------------------------- -# nif -# -------------------------------------------------------------------------------------------------- - -test_vec1 = -5L:5L < 0L -test_vec2 = -5L:5L > 0L -test_vec3 = -5L:5L < 5L -test_vec_na1 = c(test_vec1, NA) -test_vec_na2 = c(test_vec2, NA) -out_vec = c(1,1,1,1,1,NA,0,0,0,0,0) -out_vec_def = c(1,1,1,1,1,2,0,0,0,0,0) -out_vec_na= c(1,1,1,1,1,NA,0,0,0,0,0,NA) -out_vec_oc= c(1,1,1,1,1,NA,NA,NA,NA,NA,NA) - -class2132 = setClass("class2132", slots=list(x="numeric")) -s1 = class2132(x=20191231) -s2 = class2132(x=20191230) - -V1 = rnorm(1000000L) -V2 = rnorm(1000000L) -V3 = rnorm(1000000L) - -V0 = nif( - V1 > 0 & V2 <= 1 & V3 > 1, V2 * 100L, - V1 > 1 & V2 <= 0 & V3 > 0, V3 * 100L, - V1 > -1 & V2 <= 2 & V3 > 1, V1 * 100L, - V1 > 1 & V2 <= 0 & V3 > 2, 300, - V1 > 0 & V2 <= 1 & V3 > 1, 100, - V1 > -1 & V2 <= 0 & V3 > -1, V1 * 100L, - default = 0 -) - -V4 = iif(V1 > 0 & V2 <= 1 & V3 > 1, V2 * 100L, - iif(V1 > 1 & V2 <= 0 & V3 > 0, V3 * 100L, - iif(V1 > -1 & V2 <= 2 & V3 > 1, V1 * 100L, - iif(V1 > 1 & V2 <= 0 & V3 > 2, 300, - iif(V1 > 0 & V2 <= 1 & V3 > 1, 100, - iif(V1 > -1 & V2 <= 0 & V3 > -1, V1 * 100L, 0) - ) - ) - ) - ) -) - -n = 1e7 -x = structure(rnorm(n), class = 'abc') - -check("0003.001", nif(test_vec1, 1L, test_vec2, 0L), as.integer(out_vec)) -check("0003.002", nif(test_vec1, 1, test_vec2, 0), out_vec) -check("0003.003", nif(test_vec1, "1", test_vec2, "0"), as.character(out_vec)) -check("0003.004", nif(test_vec1, TRUE, test_vec2, FALSE), as.logical(out_vec)) -check("0003.005", nif(test_vec1, 1+0i, test_vec2, 0+0i), as.complex(out_vec)) -check("0003.006", nif(test_vec1, list(1), test_vec2, list(0)), list(1,1,1,1,1, NULL, 0, 0, 0, 0, 0)) -check("0003.007", nif(test_vec1, as.Date("2019-10-11"), test_vec2, as.Date("2019-10-14")), c(rep(as.Date("2019-10-11"),5),NA,rep(as.Date("2019-10-14"),5))) -check("0003.008", nif(test_vec1, factor("a", levels=letters[1:3]), test_vec2, factor("b", levels=letters[1:3])), factor(c(rep("a",5),NA,rep("b",5)), levels=letters[1:3])) -check("0003.009", nif(test_vec1, 1L, test_vec2, 0L, default=2L), as.integer(out_vec_def)) -check("0003.010", nif(test_vec1, 1, test_vec2, 0,default=2), out_vec_def) -check("0003.011", nif(test_vec1, "1", test_vec2, "0", default ="2"), as.character(out_vec_def)) -check("0003.012", nif(test_vec1, TRUE, test_vec2, FALSE, default=TRUE), as.logical(out_vec_def)) -check("0003.013", nif(test_vec1, 1+0i, test_vec2, 0+0i, default=2+0i), as.complex(out_vec_def)) -check("0003.014", nif(test_vec1, list(1), test_vec2, list(0),default=list(2)), list(1,1,1,1,1, 2, 0, 0, 0, 0, 0)) -check("0003.015", nif(test_vec1, as.Date("2019-10-11"), test_vec2, as.Date("2019-10-14"),default=as.Date("2019-10-15")), c(rep(as.Date("2019-10-11"),5),as.Date("2019-10-15"),rep(as.Date("2019-10-14"),5))) -check("0003.016", nif(test_vec1, factor("a", levels=letters[1:3]), test_vec2, factor("b", levels=letters[1:3]),default=factor("c", levels=letters[1:3])), factor(c(rep("a",5),"c",rep("b",5)), levels=letters[1:3])) -check("0003.017", nif(test_vec1, as.raw(1), test_vec2, as.raw(0)), error="Type raw is not supported.") -check("0003.018", nif(test_vec1, factor("a", levels=letters[1]), test_vec2, factor("b", levels=letters[1:3])), error="Argument #2 and argument #4 are both factor but their levels are different.") -check("0003.019", nif(test_vec1, factor("a", levels=letters[1:2]), test_vec2, factor("b", levels=letters[1:2]),default=factor("c", levels=letters[1:3])), error="Resulting value and 'default' are both type factor but their levels are different.") -check("0003.020", nif(test_vec1, 1L:10L, test_vec2, 3L:12L, test_vec2), error="Received 5 inputs; please supply an even number of arguments in ... consisting of logical condition, resulting value pairs (in that order). Note that argument 'default' must be named explicitly (e.g.: default=0)") -check("0003.021", nif(test_vec1, 1L, test_vec2, 3), error="Argument #4 is of type double, however argument #2 is of type integer. Please make sure all output values have the same type.") -check("0003.022", nif(test_vec1, "FALSE", test_vec2, TRUE), error="Argument #4 is of type logical, however argument #2 is of type character. Please make sure all output values have the same type.") -check("0003.023", nif(test_vec1, "FALSE", test_vec2, 5L), error="Argument #4 is of type integer, however argument #2 is of type character. Please make sure all output values have the same type.") -check("0003.024", nif(test_vec1, as.Date("2019-10-11"), test_vec2, as.Date("2019-10-14"),default="2019-10-15"), error="Resulting value is of type double but 'default' is of type character. Please make sure that both arguments have the same type.") -check("0003.025", nif(test_vec1, as.Date("2019-10-11"), test_vec2, as.Date("2019-10-14"),default=123), error="Resulting value has different class than 'default'. Please make sure that both arguments have the same class.") -check("0003.026", nif(test_vec1, 1L, test_vec2, 0L, default=rep(2L, 11)), as.integer(out_vec_def)) -check("0003.027", nif(test_vec1, 1L, test_vec2, rep(0L, 11), default=rep(2L, 11)), as.integer(out_vec_def)) -check("0003.028", nif(test_vec1, rep(1L,11L), test_vec2, rep(0L,11L)), as.integer(out_vec)) -check("0003.029", nif(test_vec1, rep(1,11L), test_vec2, rep(0,11L)), out_vec) -check("0003.030", nif(test_vec1, rep("1",11L), test_vec2, rep("0",11L)), as.character(out_vec)) -check("0003.031", nif(test_vec1, rep(TRUE,11L), test_vec2, rep(FALSE,11L)), as.logical(out_vec)) -check("0003.032", nif(test_vec1, rep(1+0i,11L), test_vec2, rep(0+0i,11L)), as.complex(out_vec)) -check("0003.033", nif(test_vec1, rep(list(1),11L), test_vec2, rep(list(0),11L)), list(1,1,1,1,1, NULL, 0, 0, 0, 0, 0)) -check("0003.034", nif(test_vec1, rep(as.Date("2019-10-11"),11L), test_vec2, rep(as.Date("2019-10-14"),11L)), c(rep(as.Date("2019-10-11"),5),NA,rep(as.Date("2019-10-14"),5))) -check("0003.035", nif(test_vec1, rep(factor("a", levels=letters[1:3]),11L), test_vec2, rep(factor("b", levels=letters[1:3]),11L)), factor(c(rep("a",5),NA,rep("b",5)), levels=letters[1:3])) -check("0003.036", nif(test_vec_na1, 1L, test_vec_na2, 0L), as.integer(out_vec_na)) -check("0003.037", nif(test_vec_na1, 1, test_vec_na2, 0), out_vec_na) -check("0003.038", nif(test_vec_na1, "1", test_vec_na2, "0"), as.character(out_vec_na)) -check("0003.039", nif(test_vec_na1, TRUE, test_vec_na2, FALSE), as.logical(out_vec_na)) -check("0003.040", nif(test_vec_na1, 1+0i, test_vec_na2, 0+0i), as.complex(out_vec_na)) -check("0003.041", nif(test_vec_na1, list(1), test_vec_na2, list(0)), list(1,1,1,1,1, NULL, 0, 0, 0, 0, 0,NULL)) -check("0003.042", nif(c(TRUE,TRUE,TRUE,FALSE,FALSE),factor(NA,levels=letters[1:5]),c(FALSE,FALSE,FALSE,TRUE,TRUE),factor(letters[1:5])),factor(c(NA,NA,NA,"d","e"),levels=letters[1:5])) -check("0003.043", nif(c(TRUE,TRUE,TRUE,FALSE,NA,FALSE),factor(NA,levels=letters[1:6]),c(FALSE,FALSE,FALSE,TRUE,NA,TRUE),factor(letters[1:6])),factor(c(NA,NA,NA,"d",NA,"f"),levels=letters[1:6])) -check("0003.044", nif(c(TRUE,TRUE,TRUE,FALSE,NA,FALSE),factor(letters[1:6]),c(FALSE,FALSE,FALSE,TRUE,NA,TRUE),factor(NA,levels = letters[1:6])),factor(c("a","b","c",NA,NA,NA),levels=letters[1:6])) -check("0003.045", nif(c(TRUE,NA,TRUE,FALSE,FALSE,FALSE),factor(NA),c(TRUE,TRUE,TRUE,FALSE,NA,FALSE),factor(NA)),factor(c(NA,NA,NA,NA,NA,NA))) -check("0003.046", nif(test_vec1, 1L, test_vec2, 0L, default=NA), error = "Resulting value is of type integer but 'default' is of type logical. Please make sure that both arguments have the same type.") -check("0003.047", nif(test_vec1, 1L, test_vec2, rep(0L, 11), default=NA), error = "Resulting value is of type integer but 'default' is of type logical. Please make sure that both arguments have the same type.") -check("0003.048", nif(TRUE, list(data.frame(1:5)), FALSE, list(data.frame(5:1))), list(data.frame(1:5))) -check("0003.049", nif(FALSE, list(data.frame(1:5)), TRUE, list(data.frame(5:1))), list(data.frame(5:1))) -check("0003.050", nif(1L,1L,TRUE,0L), error = "Argument #1 must be logical.") -check("0003.051", nif(TRUE,1L,5L,0L), 1L) -check("0003.052", nif(test_vec1, 1L, test_vec2, 0L, test_vec3, 2L), as.integer(out_vec_def)) -check("0003.053", nif(test_vec1, 1, test_vec2, 0, test_vec3, 2), out_vec_def) -check("0003.054", nif(test_vec1, "1", test_vec2, "0", test_vec3, "2"), as.character(out_vec_def)) -check("0003.055", nif(test_vec1, TRUE, test_vec2, FALSE, test_vec3, TRUE), as.logical(out_vec_def)) -check("0003.056", nif(test_vec1, 1+0i, test_vec2, 0+0i, test_vec3, 2+0i), as.complex(out_vec_def)) -check("0003.057", nif(test_vec1, list(1), test_vec2, list(0), test_vec3, list(2)), list(1,1,1,1,1, 2, 0, 0, 0, 0, 0)) -check("0003.058", nif(test_vec1, as.Date("2019-10-11"), test_vec2, as.Date("2019-10-14"), test_vec3, as.Date("2019-10-15")), c(rep(as.Date("2019-10-11"),5),as.Date("2019-10-15"),rep(as.Date("2019-10-14"),5))) -check("0003.059", nif(test_vec1, factor("a", levels=letters[1:3]), test_vec2, factor("b", levels=letters[1:3]), test_vec3, factor("c", levels=letters[1:3])), factor(c(rep("a",5),"c",rep("b",5)), levels=letters[1:3])) -check("0003.060", nif(test_vec1, 1L), as.integer(out_vec_oc)) -check("0003.061", nif(test_vec1, 1), out_vec_oc) -check("0003.062", nif(test_vec1, "1"), as.character(out_vec_oc)) -check("0003.063", nif(test_vec1, TRUE), as.logical(out_vec_oc)) -check("0003.064", nif(test_vec1, 1+0i), as.complex(out_vec_oc)) -check("0003.065", nif(test_vec1, list(1)), list(1,1,1,1,1, NULL, NULL, NULL, NULL, NULL, NULL)) -check("0003.066", nif(test_vec1, as.Date("2019-10-11")), c(rep(as.Date("2019-10-11"),5),rep(NA,6))) -check("0003.067", nif(test_vec1, factor("a", levels=letters[1:3])), factor(c(rep("a",5),rep("NA",6)), levels=letters[1:3])) -check("0003.068", nif(test_vec1, 1L, default = 1:2), error = "Length of 'default' must either be 1 or length of logical condition.") -check("0003.069", nif(test_vec1, 1L, test_vec_na1, 2L), error = "Argument #3 has a different length than argument #1. Please make sure all logical conditions have the same length.") -check("0003.070", nif(test_vec1, as.Date("2019-10-11"), test_vec2, 2), error = "Argument #4 has different class than argument #2, Please make sure all output values have the same class.") -check("0003.071", nif(test_vec1, 1L, test_vec2, 2:3), error = "Length of output value #4 must either be 1 or length of logical condition.") -check("0003.072", nif(TRUE, 1L, FALSE, stop("bang!")), 1L) -check("0003.073", nif(test_vec1, 1L, test_vec2, 0:10), as.integer(c( 1, 1, 1, 1, 1, NA, 6, 7, 8, 9, 10))) -check("0003.074", nif(test_vec1, 0:10, test_vec2, 0L), as.integer(c( 0, 1, 2, 3, 4, NA, 0, 0, 0, 0, 0))) -check("0003.075", nif(test_vec1, 1, test_vec2, as.numeric(0:10)), as.numeric(c( 1, 1, 1, 1, 1, NA, 6, 7, 8, 9, 10))) -check("0003.076", nif(test_vec1, as.numeric(0:10), test_vec2, 0), as.numeric(c( 0, 1, 2, 3, 4, NA, 0, 0, 0, 0, 0))) -check("0003.077", nif(test_vec1, "1", test_vec2, as.character(0:10)), as.character(c( 1, 1, 1, 1, 1, NA, 6, 7, 8, 9, 10))) -check("0003.078", nif(test_vec1, as.character(0:10), test_vec2, "0"), as.character(c( 0, 1, 2, 3, 4, NA, 0, 0, 0, 0, 0))) -check("0003.079", nif(test_vec1, TRUE, test_vec2, rep(FALSE, 11L)), as.logical(out_vec)) -check("0003.080", nif(test_vec1, rep(TRUE, 11L), test_vec2, FALSE), as.logical(out_vec)) -check("0003.081", nif(test_vec1, 1+0i, test_vec2, rep(0+0i, 11L)), as.complex(out_vec)) -check("0003.082", nif(test_vec1, rep(1+0i, 11L), test_vec2, 0+0i), as.complex(out_vec)) -check("0003.083", nif(test_vec1, list(rep(1, 11L)), test_vec2, list(0)), list(rep(1, 11L),rep(1, 11L),rep(1, 11L),rep(1, 11L),rep(1, 11L), NULL, 0, 0, 0, 0, 0)) -check("0003.084", nif(test_vec1, list(1), test_vec2, list(rep(0,11L))), list(1,1,1,1,1, NULL, rep(0,11L), rep(0,11L), rep(0,11L), rep(0,11L), rep(0,11L))) -check("0003.085", nif(test_vec1, list(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1), test_vec2, list(0)), list(1,1,1,1,1, NULL, 0, 0, 0, 0, 0)) -check("0003.086", nif(test_vec1, list(1), test_vec2, list(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)), list(1,1,1,1,1, NULL, 0, 0, 0, 0, 0)) -check("0003.087", nif(TRUE, s1, FALSE, s2), error = "S4 class objects are not supported.") -check("0003.088", nif(test_vec1, rep(1L, 11), test_vec2, 0L, default=rep(2L, 11)), as.integer(out_vec_def)) -check("0003.089", nif(test_vec1, 1, test_vec2, 0, default=rep(2, 11)), as.numeric(out_vec_def)) -check("0003.090", nif(test_vec1, rep(1, 11), test_vec2, rep(0, 11), default=rep(2, 11)), as.numeric(out_vec_def)) -check("0003.091", nif(test_vec1, 1, test_vec2, rep(0, 11), default=rep(2, 11)), as.numeric(out_vec_def)) -check("0003.092", nif(test_vec1, rep(1, 11), test_vec2, 0, default=rep(2, 11)), as.numeric(out_vec_def)) -check("0003.093", nif(test_vec1, 1+0i, test_vec2, 0+0i, default=rep(2+0i, 11)), as.complex(out_vec_def)) -check("0003.094", nif(test_vec1, rep(1+0i, 11), test_vec2, rep(0+0i, 11), default=rep(2+0i, 11)), as.complex(out_vec_def)) -check("0003.095", nif(test_vec1, 1+0i, test_vec2, rep(0+0i, 11), default=rep(2+0i, 11)), as.complex(out_vec_def)) -check("0003.096", nif(test_vec1, rep(1+0i, 11), test_vec2, 0+0i, default=rep(2+0i, 11)), as.complex(out_vec_def)) -check("0003.097", nif(test_vec1, "1", test_vec2, "0", default=rep("2", 11)), as.character(out_vec_def)) -check("0003.098", nif(test_vec1, rep("1", 11), test_vec2, rep("0", 11), default=rep("2", 11)), as.character(out_vec_def)) -check("0003.099", nif(test_vec1, "1", test_vec2, rep("0", 11), default=rep("2", 11)), as.character(out_vec_def)) -check("0003.100", nif(test_vec1, rep("1", 11), test_vec2, "0", default=rep("2", 11)), as.character(out_vec_def)) -check("0003.101", nif(test_vec1, TRUE, test_vec2, FALSE, default=rep(TRUE, 11)), as.logical(out_vec_def)) -check("0003.102", nif(test_vec1, rep(TRUE, 11), test_vec2, rep(FALSE, 11), default=rep(TRUE, 11)), as.logical(out_vec_def)) -check("0003.103", nif(test_vec1, TRUE, test_vec2, rep(FALSE, 11), default=rep(TRUE, 11)), as.logical(out_vec_def)) -check("0003.104", nif(test_vec1, rep(TRUE, 11), test_vec2, FALSE, default=rep(TRUE, 11)), as.logical(out_vec_def)) -check("0003.105", nif(test_vec1, list(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1), test_vec2, list(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),default=list(2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)), list(1,1,1,1,1, 2, 0, 0, 0, 0, 0)) -check("0003.106", nif(test_vec1, list(1), test_vec2, list(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),default=list(2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)), list(1,1,1,1,1, 2, 0, 0, 0, 0, 0)) -check("0003.107", nif(test_vec1, list(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1), test_vec2, list(0),default=list(2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)), list(1,1,1,1,1, 2, 0, 0, 0, 0, 0)) -check("0003.108", nif(test_vec1, list(1), test_vec2, list(0),default=list(2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)), list(1,1,1,1,1, 2, 0, 0, 0, 0, 0)) -check("0003.109", V0, V4) -check("0003.110", - nif(x <= -100, structure(x * 1.0, class = 'abc'), - x <= -10, structure(x * 1.0, class = 'abc'), - x <= 0, structure(x * 1.0, class = 'abc'), - x <= 100, structure(x * 1.0, class = 'abc'), - x <= 1000, structure(x * 1.0, class = 'abc'), - x >= 1000, structure(x * 1.0, class = 'abc')), - structure(x, class = 'abc') -) -check("0003.111", nif(c(TRUE,FALSE), 1, c(FALSE,TRUE), s2), error = "S4 class objects are not supported.") - - -rm(s1, s2, class2132, out_vec, out_vec_def, out_vec_na, out_vec_oc, test_vec1, test_vec2, test_vec3, test_vec_na1, test_vec_na2) -rm(V0,V1,V2,V3,V4) -rm(n, x) - -# -------------------------------------------------------------------------------------------------- -# fpos -# -------------------------------------------------------------------------------------------------- - -mymatrix = matrix( - c(30,-16,22,17,-14,13,43,-26,45,49,-46,-20,-48,-45,5,-43,34,-4,-46,-32, - 3,3,-46,-38,-2,21,-41,-29,12,-22,-1,-28,-19,-31,-3,42,47,12,-39,17, - 42,16,24,-41,9,1,-21,-11,24,-25,36,43,22,27,-32,-12,-16,-14,-47,36, - -41,0,28,11,35,-4,42,42,28,10,13,-25,14,-36,-45,0,18,10,16,-6, - -11,26,-14,19,-19,-30,-6,20,-28,-36,-34,-12,-45,-28,-41,-34,39,27,-34,15, - -45,41,-10,33,34,-46,24,-15,-40,36,21,-4,-18,-3,-1,30,-18,-12,-46,44, - 30,3,-26,29,7,-8,38,-11,-19,24,-15,-13,20,-26,-19,46,-5,-1,26,41, - 6,-47,-4,29,27,-37,46,21,13,12,37,50,12,30,34,-35,-22,23,-31,22, - -8,38,-16,14,-2,0,-4,47,-2,13,6,-26,-36,31,43,-36,20,37,45,37, - 8,37,-43,-48,37,-39,6,23,-8,-14,26,14,14,48,4,-3,3,-32,-35,1, - 8,42,28,-6,-16,-27,19,-38,-14,-43,-33,-35,-17,49,-7,22,36,-31,17,-45, - -40,4,-32,-39,33,-41,18,-50,-48,38,-5,-27,-44,7,23,38,-13,9,31,29, - -21,-6,-43,-42,-25,-46,-4,48,11,3,-43,42,-9,45,48,16,24,-38,-32,38, - 38,44,18,11,-5,45,-29,26,-50,18,-11,-43,-8,-37,24,-41,-37,44,-18,38, - 25,-39,-13,26,-20,30,-1,-5,-22,42,-11,-2,-42,-43,0,-49,12,-2,-16,34), - nrow = 20, ncol = 15 -) - -mat_lgl_a = mat_cpl_a = mat_chr_a = mat_dbl_a = mat_int_a = mymatrix -mat_cpl_b = mat_dbl_b = mat_chr_b = mat_int_b = mat_lgl_b = mat_int_a - -storage.mode(mat_dbl_a) = "numeric" -storage.mode(mat_int_a) = "integer" -storage.mode(mat_chr_a) = "character" -storage.mode(mat_cpl_a) = "complex" -storage.mode(mat_lgl_a) = "logical" -mat_raw_a = abs(mat_int_a); storage.mode(mat_raw_a) = "raw" - -mat_dbl_b[2,2] = NA; storage.mode(mat_dbl_b) = "numeric" -mat_int_b[2,2] = NA; storage.mode(mat_int_b) = "integer" -mat_chr_b[2,2] = NA; storage.mode(mat_chr_b) = "character" -mat_lgl_b[2,2] = NA; storage.mode(mat_lgl_b) = "logical" -mat_cpl_b[2,2] = NA; storage.mode(mat_cpl_b) = "complex" - -big_matrix = matrix(c(1:5), nrow = 10, ncol = 5) -small_matrix = matrix(c(2:3), nrow = 2, ncol = 2) - -big_matrix_d = big_matrix_ch = big_matrix_l = big_matrix_cp = big_matrix -small_matrix_d = small_matrix_ch = small_matrix_l = small_matrix_cp = small_matrix - -storage.mode(big_matrix_d) = "numeric" -storage.mode(big_matrix_ch) = "character" -storage.mode(big_matrix_cp) = "complex" -storage.mode(big_matrix_l) = "logical" - -storage.mode(small_matrix_d) = "numeric" -storage.mode(small_matrix_ch) = "character" -storage.mode(small_matrix_cp) = "complex" -storage.mode(small_matrix_l) = "logical" - -class2133 = setClass("class2133", slots=list(x="numeric")) -s1 = class2133(x=20191231) -s2 = class2133(x=20191230) - -check("0004.001", fpos(mat_dbl_a[1:2,1:2], mat_dbl_a, FALSE), matrix(c(1L,1L),nrow = 1)) -check("0004.002", fpos(mat_dbl_a[1:2,9:10], mat_dbl_a, FALSE), matrix(c(1L,9L),nrow = 1)) -check("0004.003", fpos(mat_dbl_a[19:20,1:2], mat_dbl_a, FALSE), matrix(c(19L,1L),nrow = 1)) -check("0004.004", fpos(mat_dbl_a[19:20,9:10], mat_dbl_a, FALSE), matrix(c(19L,9L),nrow = 1)) -check("0004.005", fpos(mat_int_a[1:2,1:2], mat_int_a, TRUE), matrix(c(1L,1L),nrow = 1)) -check("0004.006", fpos(mat_int_a[1:2,9:10], mat_int_a, TRUE), matrix(c(1L,9L),nrow = 1)) -check("0004.007", fpos(mat_int_a[19:20,1:2], mat_int_a, TRUE), matrix(c(19L,1L),nrow = 1)) -check("0004.008", fpos(mat_int_a[19:20,9:10], mat_int_a, TRUE), matrix(c(19L,9L),nrow = 1)) -check("0004.009", fpos(mat_chr_a[1:2,1:2], mat_chr_a, FALSE), matrix(c(1L,1L),nrow = 1)) -check("0004.010", fpos(mat_chr_a[1:2,9:10], mat_chr_a, FALSE), matrix(c(1L,9L),nrow = 1)) -check("0004.011", fpos(mat_chr_a[19:20,1:2], mat_chr_a, FALSE), matrix(c(19L,1L),nrow = 1)) -check("0004.012", fpos(mat_chr_a[19:20,9:10], mat_chr_a, FALSE), matrix(c(19L,9L),nrow = 1)) -check("0004.013", fpos(mat_lgl_a[2:3,4:5], mat_lgl_a, TRUE), matrix(c(2L,16L,6L,4L,4L,9L),nrow = 3)) -check("0004.014", fpos(mat_lgl_a[1:2,9:10], mat_lgl_a, FALSE), matrix(c(1L,1L),nrow = 1)) -check("0004.015", fpos(mat_lgl_a[19:20,1:2], mat_lgl_a, FALSE), matrix(c(1L,1L),nrow = 1)) -check("0004.016", fpos(mat_lgl_a[14:15,14:15], mat_lgl_a, TRUE), matrix(c(1L,15L,5L,14L,3L,3L,8L,14L),nrow = 4)) -check("0004.017", fpos(mat_lgl_a[19:20,9:10], mat_lgl_a, c(TRUE,FALSE)), error = "Argument 'all' must be TRUE or FALSE and length 1.") -check("0004.018", fpos(mat_lgl_a[19:20,9:10], c(1:5),TRUE), error = "One of the dimension of the small matrix is greater than the large matrix.") -check("0004.019", fpos(TRUE, mat_lgl_a[19:20,9:10], FALSE), matrix(c(1L,1L),nrow = 1)) -check("0004.020", fpos(mat_lgl_a, mat_lgl_a[19:20,9:10], TRUE), error = "One of the dimension of the small matrix is greater than the large matrix.") -check("0004.021", fpos(mat_raw_a[1:2,1:2], mat_raw_a, TRUE), error = "Type raw for 'haystack' is not supported.") -check("0004.022", fpos(mat_raw_a[1:2,1:2], mat_int_a, TRUE), error = "Type raw for 'needle' is not supported.") -check("0004.023", fpos(mat_dbl_b[1:2,1:2], mat_dbl_b, FALSE), matrix(c(1L,1L),nrow = 1)) -check("0004.024", fpos(mat_int_b[1:2,1:2], mat_int_b, FALSE), matrix(c(1L,1L),nrow = 1)) -check("0004.025", fpos(mat_chr_b[1:2,1:2], mat_chr_b, FALSE), matrix(c(1L,1L),nrow = 1)) -check("0004.026", fpos(mat_lgl_b[1:2,1:2], mat_lgl_b, FALSE), matrix(c(1L,1L),nrow = 1)) -check("0004.027", fpos(mat_cpl_b[1:2,1:2], mat_cpl_b, FALSE), matrix(c(1L,1L),nrow = 1)) -check("0004.028", fpos(mat_cpl_a[1:2,1:2], mat_cpl_a, TRUE), matrix(c(1L,1L),nrow = 1)) -check("0004.029", fpos(mat_cpl_a[2:3,2:3], mat_cpl_a, TRUE), matrix(c(2L,2L),nrow = 1)) -check("0004.030", fpos(matrix(13), matrix(c(1:30),nrow = 5), TRUE), matrix(c(3L, 3L),nrow = 1)) -check("0004.031", fpos(matrix(c(19,24), nrow = 1), matrix(c(1:30),nrow = 5), TRUE), matrix(c(4L, 4L),nrow = 1)) -check("0004.032", fpos(mat_int_a[19:20,9:10], mat_lgl_a), error = "Haystack type (logical) and needle type (integer) are different. Please make sure that they have the same type.") -check("0004.033", fpos(mat_int_a[19:20,9:10], mat_dbl_a), matrix(c(19L,9L),nrow = 1)) -check("0004.034", fpos(mat_dbl_a[19:20,9:10], mat_int_a), matrix(c(19L,9L),nrow = 1)) -check("0004.035", fpos(small_matrix, big_matrix), matrix(c(2L,7L,2L,7L,2L,7L,2L,7L,1L,1L,2L,2L,3L,3L,4L,4L),nrow = 8)) -check("0004.036", fpos(small_matrix, big_matrix, all = FALSE), matrix(c(2L,1L),nrow = 1)) -check("0004.037", fpos(small_matrix, big_matrix, overlap = FALSE), matrix(c(2L,7L,2L,7L,1L,1L,3L,3L),nrow = 4)) -check("0004.038", fpos(small_matrix_d, big_matrix_d), matrix(c(2L,7L,2L,7L,2L,7L,2L,7L,1L,1L,2L,2L,3L,3L,4L,4L),nrow = 8)) -check("0004.039", fpos(small_matrix_d, big_matrix_d, all = FALSE), matrix(c(2L,1L),nrow = 1)) -check("0004.040", fpos(small_matrix_d, big_matrix_d, overlap = FALSE), matrix(c(2L,7L,2L,7L,1L,1L,3L,3L),nrow = 4)) -check("0004.041", head(fpos(small_matrix_l, big_matrix_l),6), matrix(c(1L,2L,3L,4L,5L,6L,1L,1L,1L,1L,1L,1L),nrow = 6)) -check("0004.042", fpos(small_matrix_l, big_matrix_l, all = FALSE), matrix(c(1L,1L),nrow = 1)) -check("0004.043", fpos(small_matrix_l, big_matrix_l, overlap = FALSE), matrix(c(1L,3L,5L,7L,9L,1L,3L,5L,7L,9L,1L,1L,1L,1L,1L,3L,3L,3L,3L,3L),nrow = 10)) -check("0004.044", fpos(small_matrix_cp, big_matrix_cp), matrix(c(2L,7L,2L,7L,2L,7L,2L,7L,1L,1L,2L,2L,3L,3L,4L,4L),nrow = 8)) -check("0004.045", fpos(small_matrix_cp, big_matrix_cp, all = FALSE), matrix(c(2L,1L),nrow = 1)) -check("0004.046", fpos(small_matrix_cp, big_matrix_cp, overlap = FALSE), matrix(c(2L,7L,2L,7L,1L,1L,3L,3L),nrow = 4)) -check("0004.047", fpos(small_matrix_ch, big_matrix_ch), matrix(c(2L,7L,2L,7L,2L,7L,2L,7L,1L,1L,2L,2L,3L,3L,4L,4L),nrow = 8)) -check("0004.048", fpos(small_matrix_ch, big_matrix_ch, all = FALSE), matrix(c(2L,1L),nrow = 1)) -check("0004.049", fpos(small_matrix_ch, big_matrix_ch, overlap = FALSE), matrix(c(2L,7L,2L,7L,1L,1L,3L,3L),nrow = 4)) -check("0004.050", fpos(small_matrix_ch, big_matrix_ch, overlap = c(TRUE,FALSE)), error = "Argument 'overlap' must be TRUE or FALSE and length 1.") -check("0004.051", fpos(TRUE, TRUE), 1L) -check("0004.052", fpos(FALSE, TRUE), NULL) -check("0004.053", fpos(NA, TRUE), NULL) -check("0004.054", fpos(TRUE, matrix(c(FALSE, TRUE, TRUE, FALSE), nrow = 2)), matrix(c(2L,1L,1L,2L),nrow = 2)) -check("0004.055", fpos(s1, TRUE), error = "S4 class objects are not supported.") -check("0004.056", fpos(TRUE, s2), error = "S4 class objects are not supported.") -check("0004.057", fpos(TRUE, data.frame(c(1:10))), error = "Please note that data.frame(s) are not supported.") -check("0004.058", fpos(TRUE, list(1:10)), error = "Type list for 'haystack' is not supported.") -check("0004.059", fpos(iris3, TRUE), error = "Arrays are not supported for argument 'needle'.") -check("0004.060", fpos(TRUE, iris3), error = "Arrays are not supported for argument 'haystack'.") -check("0004.061", fpos(TRUE, TRUE,c(TRUE,FALSE)), error = "Argument 'all' must be TRUE or FALSE and length 1.") -check("0004.062", fpos(TRUE, TRUE,TRUE,c(TRUE,FALSE)), error = "Argument 'overlap' must be TRUE or FALSE and length 1.") -check("0004.063", fpos(list(1:10),TRUE), error = "Type list for 'needle' is not supported.") -check("0004.064", fpos(c(TRUE,FALSE),TRUE), error = "The 'needle' vector length is greater than the 'haystack' vector length.") -check("0004.065", fpos(1L,TRUE), error = "Haystack type (logical) and needle type (integer) are different. Please make sure that they have the same type.") -check("0004.066", fpos(mat_dbl_b[2,1:2],mat_dbl_b[2,]), 1L) -check("0004.067", fpos(mat_chr_b[2,1:2],mat_chr_b[2,]), 1L) -check("0004.068", fpos(mat_cpl_b[2,1:2],mat_cpl_b[2,]), 1L) -check("0004.069", fpos(mat_int_b[2,1:2],mat_int_b[2,]), 1L) -check("0004.070", fpos(mat_lgl_b[2,1:2],mat_lgl_b[2,]), 1L) -check("0004.071", fpos(mat_dbl_b,mat_dbl_a), NULL) -check("0004.072", fpos(mat_dbl_b[2,1:2],as.integer(mat_dbl_b[2,])), 1L) -check("0004.073", fpos(as.integer(mat_dbl_b[2,1:2]),mat_dbl_b[2,]), 1L) -check("0004.074", fpos(c(1L,2L), c(1L,2L,5L,1L,2L), all = TRUE, overlap = TRUE), c(1L,4L)) -check("0004.075", fpos(c(1L,1L), c(1L,1L,1L,1L,1L), all = TRUE, overlap = TRUE),c(1L,2L,3L,4L)) -check("0004.076", fpos(c(1L,1L), c(1L,1L,1L,1L,1L), all = FALSE, overlap = TRUE),c(1L)) -check("0004.077", fpos(c(1L,1L), c(1L,1L,1L,1L,1L), all = TRUE, overlap = FALSE),c(1L,3L)) -check("0004.078", fpos(c(1L,NA_integer_), c(1L,NA_integer_,1L,NA_integer_,1L), all = TRUE, overlap = FALSE),c(1L,3L)) -check("0004.079", fpos(c(1,2), c(1L,2L,5L,1L,2L), all = TRUE, overlap = TRUE), c(1L,4L)) -check("0004.080", fpos(c(1,1), c(1L,1L,1L,1L,1L), all = TRUE, overlap = TRUE),c(1L,2L,3L,4L)) -check("0004.081", fpos(c(1,1), c(1L,1L,1L,1L,1L), all = FALSE, overlap = TRUE),c(1L)) -check("0004.082", fpos(c(1,1), c(1L,1L,1L,1L,1L), all = TRUE, overlap = FALSE),c(1L,3L)) -check("0004.083", fpos(c(1,NA_real_), c(1L,NA_integer_,1L,NA_integer_,1L), all = TRUE, overlap = FALSE),c(1L,3L)) -check("0004.084", fpos(as.complex(c(1L,2L)), as.complex(c(1L,2L,5L,1L,2L)), all = TRUE, overlap = TRUE), c(1L,4L)) -check("0004.085", fpos(as.complex(c(1L,1L)), as.complex(c(1L,1L,1L,1L,1L)), all = TRUE, overlap = TRUE),c(1L,2L,3L,4L)) -check("0004.086", fpos(as.complex(c(1L,1L)), as.complex(c(1L,1L,1L,1L,1L)), all = FALSE, overlap = TRUE),c(1L)) -check("0004.087", fpos(as.complex(c(1L,1L)), as.complex(c(1L,1L,1L,1L,1L)), all = TRUE, overlap = FALSE),c(1L,3L)) -check("0004.088", fpos(as.complex(c(1L,NA_integer_)), as.complex(c(1L,NA_integer_,1L,NA_integer_,1L)), all = TRUE, overlap = FALSE),c(1L,3L)) -check("0004.089", fpos(as.character(c(1L,2L)), as.character(c(1L,2L,5L,1L,2L)), all = TRUE, overlap = TRUE), c(1L,4L)) -check("0004.090", fpos(as.character(c(1L,1L)), as.character(c(1L,1L,1L,1L,1L)), all = TRUE, overlap = TRUE),c(1L,2L,3L,4L)) -check("0004.091", fpos(as.character(c(1L,1L)), as.character(c(1L,1L,1L,1L,1L)), all = FALSE, overlap = TRUE),c(1L)) -check("0004.092", fpos(as.character(c(1L,1L)), as.character(c(1L,1L,1L,1L,1L)), all = TRUE, overlap = FALSE),c(1L,3L)) -check("0004.093", fpos(as.character(c(1L,NA_integer_)), as.character(c(1L,NA_integer_,1L,NA_integer_,1L)), all = TRUE, overlap = FALSE),c(1L,3L)) -check("0004.094", fpos(as.logical(c(1L,2L)), as.logical(c(1L,2L,5L,1L,2L)), all = TRUE, overlap = TRUE), c(1L,2L,3L,4L)) -check("0004.095", fpos(as.logical(c(1L,1L)), as.logical(c(1L,1L,1L,1L,1L)), all = TRUE, overlap = TRUE),c(1L,2L,3L,4L)) -check("0004.096", fpos(as.logical(c(1L,1L)), as.logical(c(1L,1L,1L,1L,1L)), all = FALSE, overlap = TRUE),c(1L)) -check("0004.097", fpos(as.logical(c(1L,1L)), as.logical(c(1L,1L,1L,1L,1L)), all = TRUE, overlap = FALSE),c(1L,3L)) -check("0004.098", fpos(as.logical(c(1L,NA_integer_)), as.logical(c(1L,NA_integer_,1L,NA_integer_,1L)), all = TRUE, overlap = FALSE),c(1L,3L)) - -rm(s1, s2, class2133, big_matrix, big_matrix_ch, big_matrix_cp, big_matrix_d, big_matrix_l, mat_chr_a, mat_chr_b, mat_cpl_a, - mat_cpl_b, mat_dbl_a, mat_dbl_b, mat_int_a, mat_int_b, mat_lgl_a, mat_lgl_b, mat_raw_a, mymatrix, small_matrix, small_matrix_ch, - small_matrix_cp, small_matrix_d, small_matrix_l) - -# -------------------------------------------------------------------------------------------------- -# psum -# -------------------------------------------------------------------------------------------------- - -x = c(1, 3, NA, 5) -y = c(2, NA, 4, 1) -z = c(3, 4, 4, 1) -x0 = rnorm(1000L) -y0 = rnorm(1000L) -z0 = rnorm(1000L) - -check("0005.001", psum(x, y, z, na.rm = FALSE), c(6, NA, NA, 7)) -check("0005.002", psum(x, y, z, na.rm = TRUE), c(6, 7, 8, 7)) -check("0005.003", psum(as.integer(x), as.integer(y), as.integer(z), na.rm = FALSE), c(6L, NA_integer_, NA_integer_, 7L)) -check("0005.004", psum(as.integer(x), as.integer(y), as.integer(z), na.rm = TRUE), c(6L, 7L, 8L, 7L)) -check("0005.005", psum(as.raw(z), y, na.rm = TRUE), error = "Argument 1 is of type raw. Only integer/logical, double and complex types are supported. A data.frame (of the previous types) is also supported as a single input.") -check("0005.006", psum(x, y, 1:2, na.rm = FALSE), error = "Argument 3 is of length 2 but argument 1 is of length 4. If you wish to 'recycle' your argument, please use rep() to make this intent clear to the readers of your code.") -check("0005.007", psum(1:10, 1:5, na.rm = FALSE), error = "Argument 2 is of length 5 but argument 1 is of length 10. If you wish to 'recycle' your argument, please use rep() to make this intent clear to the readers of your code.") -check("0005.008", psum(x, as.raw(z), y, na.rm = TRUE), error = "Argument 2 is of type raw. Only integer/logical, double and complex types are supported.") -check("0005.009", psum(1:10, 1:10, 21:30), 1:10 + 1:10 + 21:30) -check("0005.010", psum(x, y, z, na.rm = NA), error = "Argument 'na.rm' must be TRUE or FALSE and length 1.") -check("0005.011", psum(x, na.rm = FALSE), x) -check("0005.012", psum(as.integer(x), y, z, na.rm = TRUE), c(6, 7, 8, 7)) -check("0005.013", psum(c(1,3,NA,5,NA), c(2,NA,4,1,NA), na.rm = TRUE), c(3, 3, 4, 6, 0)) -check("0005.014", psum(x, y, as.integer(z), na.rm = FALSE), c(6, NA, NA, 7)) -check("0005.015", psum(na.rm = FALSE), error = "Please supply at least 1 argument. (0 argument supplied)") -check("0005.016", psum(x0, y0, z0), x0+y0+z0) -check("0005.017", psum(as.complex(x0), as.complex(y0), as.complex(z0)), as.complex(x0)+as.complex(y0)+as.complex(z0)) -check("0005.018", psum(as.complex(x0), as.complex(y0), z0), as.complex(x0)+as.complex(y0)+z0) -check("0005.019", psum(as.complex(x), as.complex(y), as.complex(z), na.rm = FALSE), as.complex(c(6, NA, NA, 7))) -check("0005.020", psum(as.complex(x), as.complex(y), as.complex(z), na.rm = TRUE), as.complex(c(6, 7, 8, 7))) -check("0005.021", psum(x, y, z, rep(Inf,4L), na.rm = FALSE), x+y+z+Inf) -check("0005.022", psum(x, y, z, rep(Inf,4L), na.rm = TRUE), rep(Inf, 4L)) -check("0005.023", psum(NA_integer_, na.rm = TRUE), 0L) -check("0005.024", psum(NA_real_, na.rm = TRUE), 0) -check("0005.025", psum(NA_complex_, na.rm = TRUE), 0+0i) -check("0005.026", psum(iris[,1:2]), rowSums(iris[,1:2])) -check("0005.027", psum(iris[,1:2],iris[,1:2]), error = "Argument 1 is of type list. Only integer/logical, double and complex types are supported. A data.frame (of the previous types) is also supported as a single input.") -check("0005.028", psum(1:150,iris$Species, na.rm = FALSE), error="Function 'psum' is not meaningful for factors.") -check("0005.029", psum(unclass(mtcars)),psum(mtcars)) - -# -------------------------------------------------------------------------------------------------- -# pprod -# -------------------------------------------------------------------------------------------------- - -check("0006.001", pprod(x, y, z, na.rm = FALSE), c(6, NA, NA, 5)) -check("0006.002", pprod(x, y, z, na.rm = TRUE), c(6, 12, 16, 5)) -check("0006.003", pprod(as.integer(x), as.integer(y), as.integer(z), na.rm = FALSE), c(6, NA_real_, NA_real_, 5)) -check("0006.004", pprod(as.integer(x), as.integer(y), as.integer(z), na.rm = TRUE), c(6, 12, 16, 5)) -check("0006.005", pprod(as.raw(z), y, na.rm = TRUE), error = "Argument 1 is of type raw. Only integer/logical, double and complex types are supported. A data.frame (of the previous types) is also supported as a single input.") -check("0006.006", pprod(x, y, 1:2, na.rm = FALSE), error = "Argument 3 is of length 2 but argument 1 is of length 4. If you wish to 'recycle' your argument, please use rep() to make this intent clear to the readers of your code.") -check("0006.007", pprod(1:10, 1:5, na.rm = FALSE), error = "Argument 2 is of length 5 but argument 1 is of length 10. If you wish to 'recycle' your argument, please use rep() to make this intent clear to the readers of your code.") -check("0006.008", pprod(x, as.raw(z), y, na.rm = TRUE), error = "Argument 2 is of type raw. Only integer/logical, double and complex types are supported.") -check("0006.009", pprod(1:10, 1:10, 21:30), as.double(1:10 * 1:10 * 21:30)) -check("0006.010", pprod(x, y, z, na.rm = NA), error = "Argument 'na.rm' must be TRUE or FALSE and length 1.") -check("0006.011", pprod(x, na.rm = FALSE), x) -check("0006.012", pprod(as.integer(x), y, z, na.rm = TRUE), c(6, 12, 16, 5)) -check("0006.013", pprod(c(1,3,NA,5,NA), c(2,NA,4,1,NA), na.rm = TRUE), c(2, 3, 4, 5, 1)) -check("0006.014", pprod(x, y, as.integer(z), na.rm = FALSE), c(6, NA, NA, 5)) -check("0006.015", pprod(na.rm = FALSE), error = "Please supply at least 1 argument. (0 argument supplied)") -check("0006.016", pprod(x0, y0, z0), x0*y0*z0) -check("0006.017", pprod(as.complex(x0), as.complex(y0), as.complex(z0)), as.complex(x0)*as.complex(y0)*as.complex(z0)) -check("0006.018", pprod(as.complex(x0), as.complex(y0), z0), as.complex(x0)*as.complex(y0)*z0) -check("0006.019", pprod(as.complex(x), as.complex(y), as.complex(z), na.rm = FALSE), as.complex(c(6, NA, NA, 5))) -check("0006.020", pprod(as.complex(x), as.complex(y), as.complex(z), na.rm = TRUE), as.complex(c(6, 12, 16, 5))) -check("0006.021", pprod(x, y, z, rep(Inf, 4L), na.rm = FALSE), x*y*z*Inf) -check("0006.022", pprod(x, y, z, rep(Inf, 4L), na.rm = TRUE), rep(Inf, 4L)) -check("0006.023", pprod(NA_integer_, na.rm = TRUE), 1) -check("0006.024", pprod(NA_real_, na.rm = TRUE), 1) -check("0006.025", pprod(NA_complex_, na.rm = TRUE), 1+0i) -check("0006.026", pprod(iris[,1:2]), iris$Sepal.Length*iris$Sepal.Width) -check("0006.027", pprod(iris[,1:2],iris[,1:2]), error = "Argument 1 is of type list. Only integer/logical, double and complex types are supported. A data.frame (of the previous types) is also supported as a single input.") -check("0006.028", pprod(1:150,iris$Species, na.rm = FALSE), error="Function 'pprod' is not meaningful for factors.") -check("0006.029", pprod(unclass(mtcars)),pprod(mtcars)) - -rm(x, y, z, x0, y0, z0) - -# -------------------------------------------------------------------------------------------------- -# fpmin, fpmax, prange -# -------------------------------------------------------------------------------------------------- - -x = c(1, 3, NA, 5) -y = c(2, NA, 4, 1) -z = c(3, 4, 4, 1) -x0 = rnorm(1000L) -y0 = rnorm(1000L) -z0 = rnorm(1000L) - -# fpmin tests -check("0008.001", fpmin(x, y, z, na.rm = FALSE), c(1, NA, NA, 1)) -check("0008.002", fpmin(x, y, z, na.rm = TRUE), c(1, 3, 4, 1)) -check("0008.003", fpmin(as.integer(x), as.integer(y), as.integer(z), na.rm = FALSE), c(1L, NA_integer_, NA_integer_, 1L)) -check("0008.004", fpmin(as.integer(x), as.integer(y), as.integer(z), na.rm = TRUE), c(1L, 3L, 4L, 1L)) -check("0008.005", fpmin(c(TRUE, FALSE, NA), c(FALSE, TRUE, FALSE), na.rm = FALSE), c(FALSE, FALSE, NA)) -check("0008.006", fpmin(c(TRUE, FALSE, NA), c(FALSE, TRUE, FALSE), na.rm = TRUE), c(FALSE, FALSE, FALSE)) -check("0008.007", fpmin(as.raw(z), y, na.rm = TRUE), error = "Argument 1 is of type raw. Only integer/logical and double types are supported. A data.frame (of the previous types) is also supported as a single input.") -check("0008.008", fpmin(x, y, 1:2, na.rm = FALSE), error = "Argument 3 is of length 2 but argument 1 is of length 4. If you wish to 'recycle' your argument, please use rep() to make this intent clear to the readers of your code.") -check("0008.009", fpmin(x, y, z, na.rm = NA), error = "Argument 'na.rm' must be TRUE or FALSE and length 1.") -check("0008.010", fpmin(x, na.rm = FALSE), x) -check("0008.011", fpmin(as.integer(x), y, z, na.rm = TRUE), c(1, 3, 4, 1)) -check("0008.012", fpmin(x, y, as.integer(z), na.rm = FALSE), c(1, NA, NA, 1)) -check("0008.013", fpmin(na.rm = FALSE), error = "Please supply at least 1 argument. (0 argument supplied)") -check("0008.014", fpmin(x0, y0, z0), pmin(x0, y0, z0)) -check("0008.015", fpmin(c(1,3,NA,5,NA), c(2,NA,4,1,NA), na.rm = TRUE), c(1, 3, 4, 1, NA)) -check("0008.016", fpmin(NA_integer_, na.rm = TRUE), NA_integer_) -check("0008.017", fpmin(NA_real_, na.rm = TRUE), NA_real_) -check("0008.018", fpmin(iris[,1:2]), pmin(iris$Sepal.Length, iris$Sepal.Width)) -check("0008.019", fpmin(1:150,iris$Species, na.rm = FALSE), error="Function 'fpmin' is not meaningful for factors.") - -# fpmax tests -check("0009.001", fpmax(x, y, z, na.rm = FALSE), c(3, NA, NA, 5)) -check("0009.002", fpmax(x, y, z, na.rm = TRUE), c(3, 4, 4, 5)) -check("0009.003", fpmax(as.integer(x), as.integer(y), as.integer(z), na.rm = FALSE), c(3L, NA_integer_, NA_integer_, 5L)) -check("0009.004", fpmax(as.integer(x), as.integer(y), as.integer(z), na.rm = TRUE), c(3L, 4L, 4L, 5L)) -check("0009.005", fpmax(c(TRUE, FALSE, NA), c(FALSE, TRUE, FALSE), na.rm = FALSE), c(TRUE, TRUE, NA)) -check("0009.006", fpmax(c(TRUE, FALSE, NA), c(FALSE, TRUE, FALSE), na.rm = TRUE), c(TRUE, TRUE, FALSE)) -check("0009.007", fpmax(as.raw(z), y, na.rm = TRUE), error = "Argument 1 is of type raw. Only integer/logical and double types are supported. A data.frame (of the previous types) is also supported as a single input.") -check("0009.008", fpmax(x, y, 1:2, na.rm = FALSE), error = "Argument 3 is of length 2 but argument 1 is of length 4. If you wish to 'recycle' your argument, please use rep() to make this intent clear to the readers of your code.") -check("0009.009", fpmax(x, y, z, na.rm = NA), error = "Argument 'na.rm' must be TRUE or FALSE and length 1.") -check("0009.010", fpmax(x, na.rm = FALSE), x) -check("0009.011", fpmax(as.integer(x), y, z, na.rm = TRUE), c(3, 4, 4, 5)) -check("0009.012", fpmax(x, y, as.integer(z), na.rm = FALSE), c(3, NA, NA, 5)) -check("0009.013", fpmax(na.rm = FALSE), error = "Please supply at least 1 argument. (0 argument supplied)") -check("0009.014", fpmax(x0, y0, z0), pmax(x0, y0, z0)) -check("0009.015", fpmax(c(1,3,NA,5,NA), c(2,NA,4,1,NA), na.rm = TRUE), c(2, 3, 4, 5, NA)) -check("0009.016", fpmax(NA_integer_, na.rm = TRUE), NA_integer_) -check("0009.017", fpmax(NA_real_, na.rm = TRUE), NA_real_) -check("0009.018", fpmax(iris[,1:2]), pmax(iris$Sepal.Length, iris$Sepal.Width)) -check("0009.019", fpmax(1:150,iris$Species, na.rm = FALSE), error="Function 'fpmax' is not meaningful for factors.") - -# prange tests -check("0010.001", prange(x, y, z, na.rm = FALSE), c(2, NA, NA, 4)) -check("0010.002", prange(x, y, z, na.rm = TRUE), c(2, 1, 0, 4)) -check("0010.003", prange(as.integer(x), as.integer(y), as.integer(z), na.rm = FALSE), c(2, NA, NA, 4)) -check("0010.004", prange(as.integer(x), as.integer(y), as.integer(z), na.rm = TRUE), c(2, 1, 0, 4)) -check("0010.005", prange(c(TRUE, FALSE, NA), c(FALSE, TRUE, FALSE), na.rm = FALSE), c(1, 1, NA)) -check("0010.006", prange(c(TRUE, FALSE, NA), c(FALSE, TRUE, FALSE), na.rm = TRUE), c(1, 1, 0)) -check("0010.007", prange(as.raw(z), y, na.rm = TRUE), error = "Argument 1 is of type raw. Only integer/logical and double types are supported. A data.frame (of the previous types) is also supported as a single input.") -check("0010.008", prange(x, y, 1:2, na.rm = FALSE), error = "Argument 3 is of length 2 but argument 1 is of length 4. If you wish to 'recycle' your argument, please use rep() to make this intent clear to the readers of your code.") -check("0010.009", prange(x, y, z, na.rm = NA), error = "Argument 'na.rm' must be TRUE or FALSE and length 1.") -check("0010.010", prange(x, na.rm = FALSE), c(0, 0, NA, 0)) -check("0010.011", prange(as.integer(x), y, z, na.rm = TRUE), c(2, 1, 0, 4)) -check("0010.012", prange(x, y, as.integer(z), na.rm = FALSE), c(2, NA, NA, 4)) -check("0010.013", prange(na.rm = FALSE), error = "Please supply at least 1 argument. (0 argument supplied)") -check("0010.014", prange(x0, y0, z0), pmax(x0, y0, z0) - pmin(x0, y0, z0)) -check("0010.015", prange(c(1,3,NA,5,NA), c(2,NA,4,1,NA), na.rm = TRUE), c(1, 0, 0, 4, NA)) -check("0010.016", prange(NA_integer_, na.rm = TRUE), NA_real_) -check("0010.017", prange(NA_real_, na.rm = TRUE), NA_real_) -check("0010.018", prange(iris[,1:2]), pmax(iris$Sepal.Length, iris$Sepal.Width) - pmin(iris$Sepal.Length, iris$Sepal.Width)) -check("0010.019", prange(1:150,iris$Species, na.rm = FALSE), error="Function 'prange' is not meaningful for factors.") - -rm(x, y, z, x0, y0, z0) - -# -------------------------------------------------------------------------------------------------- -# setlevels -# -------------------------------------------------------------------------------------------------- - -check("0007.01", setlevels(factor(c("A", "A", "B", "B", "B", "C")), c("A", "B", "C"), c("X", "Y", "Z")), factor(c("X", "X", "Y", "Y", "Y", "Z"))) -check("0007.02", setlevels(factor(c("A", "A", "B", "B", "B", "C")), c("A", "B"), c("X", "Y", "Z")), error = "'old' and 'new' are not the same length.") -check("0007.03", setlevels(factor(c("A", "A", "B", "B", "B", "C")), c("A", "B", "B"), c("X", "Y", "Z")), error = "'old' has duplicated value. Please make sure no duplicated values are introduced.") -check("0007.04", setlevels(factor(c("A", "A", "B", "B", "B", "C")), c("A", "B", "C"), c("X", "X", "Z")), error = "'new' has duplicated value. Please make sure no duplicated values are introduced.") -check("0007.05", setlevels(factor(c("A", "A", "B", "B", "B", "C")), c("A"), c("X")), factor(c("X", "X", "B", "B", "B", "C"), levels = c("X", "B", "C"))) -check("0007.06", setlevels(factor(c(1, 1, 2, 2, 2, 3)), c("1","2","3"), c("X","Y","Z")), factor(c("X", "X", "Y", "Y", "Y", "Z"))) -check("0007.07", setlevels(factor(c(1, 1, 2, 2, 2, 3)), 1:3, c("X","Y","Z")), error = "Type of 'old' must be character.") -check("0007.08", setlevels(factor(c(1, 1, 2, 2, 2, 3)), c("1","2","3"), 1:3), error = "Type of 'new' must be character.") -check("0007.09", setlevels(factor(c("A", "A", "B", "B", "B", "C")), new = c("X", "Y", "Z")), factor(c("X", "X", "Y", "Y", "Y", "Z"))) -check("0007.10", setlevels(factor(c("A", "A", "B", "B", "B", "C")), c("A", "B", "D"), c("X", "Y", "Z")), error = "Element 'D' of 'old' does not exist in 'x'.") -check("0007.11", setlevels(factor(c("A", "A", "B", "B", "B", "C"))), error = "argument \"new\" is missing, with no default") -check("0007.12", setlevels(c("A", "A", "B", "B", "B", "C"), c("A", "B", "C"), c("X", "Y", "Z")), error = "'setlevels' must be passed a factor.") -check("0007.13", setlevels(factor(c("A", "A", "B", "B", "B", "C")), c("A", "A","B", "B"), c("X", "X","Y", "Z")), error = "'old' has duplicated value. Please make sure no duplicated values are introduced.") -check("0007.14", setlevels(factor(c("A", "A", "B", "B", "B", "C"), levels = c("C","A","B")), c("C", "A", "B"), c("Z", "X", "Y")), factor(c("X", "X", "Y", "Y", "Y", "Z"), levels = c("Z", "X", "Y"))) -check("0007.15", setlevels(factor(c("A", "A", "B", "B", "B", "C"), levels = c("C","A","B","D")), c("A", "B", "C"), c("X", "Y", "Z")), factor(c("X", "X", "Y", "Y", "Y", "Z"), levels = c("Z", "X", "Y","D"))) -check("0007.16", setlevels(factor(c("A", "A", "B", "B", "B", "C", NA, NA), levels = c("C","A","B","D")), c("A", "B", "C"), c("X", "Y", "Z")), factor(c("X", "X", "Y", "Y", "Y", "Z",NA,NA), levels = c("Z", "X", "Y","D"))) -check("0007.17", setlevels(factor(c("A", "A", "B", "B", "B", "C", NA, NA), levels = c("C","A","B",NA), exclude = NULL), c("A", "B", "C"), c("X", "Y", "Z")), factor(c("X", "X", "Y", "Y", "Y", "Z",NA,NA), levels = c("Z", "X", "Y",NA), exclude=NULL)) -check("0007.18", setlevels(factor(c("A", "A", "B", "B", "B", "C"), levels = c("C","A","B",NA), exclude = NULL), c("A", "B", "C"), c("X", "Y", "Z")), factor(c("X", "X", "Y", "Y", "Y", "Z"), levels = c("Z", "X", "Y",NA), exclude=NULL)) -check("0007.19", setlevels(factor(c("A", "A", "B", "B", "B", "C", NA, NA), levels = c("C","A","B",NA), exclude = NULL), c("A", NA), c("X","D")), factor(c("X", "X", "B", "B", "B", "C","D","D"), levels = c("C", "X", "B","D"))) -check("0007.20", setlevels(factor(c("A", "A", "B", "B", "B", "C", NA, NA), levels = c("C","A","B",NA), exclude = NULL), as.character(NA), "D"), factor(c("A", "A", "B", "B", "B", "C","D","D"), levels = c("C", "A", "B","D"))) -check("0007.21", setlevels(factor(c("A", "A", "B", "B", "B", "C", NA, NA), levels = c("C","A","B",NA), exclude = NULL), NA_character_, "D"), factor(c("A", "A", "B", "B", "B", "C","D","D"), levels = c("C", "A", "B","D"))) -check("0007.22", setlevels(factor(c("A", "A", "B", "B", "B", "C", NA, NA), levels = c("C","A","B",NA), exclude = NULL), NA, "D"), error = "Type of 'old' must be character.") -check("0007.23", setlevels(factor(c("A", "A", "B", "B", "B", "C", NA, NA), levels = c("C","A","B",NA), exclude = NULL), "A", NA), error = "Type of 'new' must be character.") -check("0007.24", setlevels(factor(c("A", "A", "B", "B", "B", "C"), levels = c("A","B","C")), c("A", "B", "C"), c("X", "Y", "Z"), c(FALSE,TRUE)), error = "Argument 'skip_absent' must be TRUE or FALSE and length 1.") -check("0007.25", setlevels(factor(c("A", "A", "B", "B", "B", "C")), c("A", "B", "D"), c("X", "Y", "Z"), TRUE), factor(c("X", "X", "Y", "Y", "Y", "C"), levels = c("X","Y","C"))) - -# -------------------------------------------------------------------------------------------------- -# vswitch -# -------------------------------------------------------------------------------------------------- - -x0 = c(1L, 0L, 0L, 1L, NA_integer_, 1L, NA_integer_) -x1 = c(NA_integer_, 1L, 0L, 1L, NA_integer_, 1L, NA_integer_) -values0 = c(0L, 1L) -outputs0 = list(0L, 1L) -outputs1 = list(11:17, 21:27) -outputs0l = list(FALSE, TRUE) -outputs1l = list(as.logical(11:17), as.logical( 21:27)) -outputs0n = list(0, 1) -outputs1n = list(as.numeric(11:17), as.numeric( 21:27)) -outputs0c = list(0+0i, 1+0i) -outputs1c = list(as.complex(11:17), as.complex( 21:27)) -outputs0s = list("0", "1") -outputs1s = list(as.character(11:17), as.character(21:27)) -outputs0v = list(as.list(0L), as.list(1L)) -outputs1v = list(as.list(11:17), as.list(21:27)) -na0 = NA_integer_ -na1 = 1:7 -out11 = c(NA_integer_, 22L, 13L, 24L, NA_integer_, 26L, NA_integer_) -out12 = c(1L, 22L, 13L, 24L, 5L, 26L, 7L) -x0l = list(1L, 0L, 0L, 1L, NULL, 1L, NULL) -x1l = list(NULL, 1L, 0L, 1L, NULL, 1L, NULL) -out11l = list(NULL, 22L, 13L, 24L, NULL, 26L, NULL) -out12l = list(1L, 22L, 13L, 24L, 5L, 26L, 7L) -na0l = list(NULL) -class2133 = setClass("class2133", slots=list(x="numeric")) -s1 = class2133(x=20191231) -s2 = class2133(x=20191230) -enc1 = "fa\xE7ile" -Encoding(enc1) = "latin1" -enc2 = enc2utf8(enc1) - -check("0008.001", vswitch(x0, values0, outputs0), x0) -check("0008.002", vswitch(x0, values0, outputs0, na0), x0) -check("0008.003", vswitch(x1, values0, outputs1), out11) -check("0008.004", vswitch(x1, values0, outputs1, na1), out12) -check("0008.005", vswitch(s1, values0, outputs0), error = "S4 class objects for argument 'x' are not supported.") -check("0008.006", vswitch(x0, s1, outputs0), error = "S4 class objects for argument 'values' are not supported.") -check("0008.007", vswitch(x0, values0, outputs0, s1), error = "S4 class objects for argument 'na' are not supported.") -check("0008.008", vswitch(x0, values0[1L], outputs0), error = "Length of 'values' and 'outputs' are different. Please make sure they are the same.") -check("0008.009", vswitch(x0, as.logical(values0), outputs0), error = "Type of 'x' and 'values' are different. Please make sure they are the same.") -check("0008.010", vswitch(x0, values0, outputs0, NA), error = "Type of 'na' and 'outputs' are different. Please make sure they are the same.") -check("0008.011", vswitch(x0, values0, outputs0, 1:2), error = "Length of 'na' is different than 1 and length of 'x'. Please make length of 'na' is 1 or length of 'x'.") -check("0008.012", vswitch(1, c(as.Date("2020-04-14")), list(1L)), error = "Argument 'x' and 'values' must have same class.") -check("0008.013", vswitch(1, 1, 1L), 1L) -check("0008.014", vswitch(factor("a"), factor("b"), list(1L)), error = "Argument 'x' and 'values' are both factor but their levels are different.") -check("0008.015", vswitch(x0, values0[1], list(as.Date("2020-04-14")), 2), error = "Argument 'na' and items of 'outputs' must have same class.") -check("0008.016", vswitch(x0, values0, list(factor(c("a","b")),factor(c("a","b"))), factor("c")), error = "Argument 'na' and items of 'outputs' are both factor but their levels are different.") -check("0008.017", vswitch(as.numeric(x0), as.numeric(values0), outputs0), x0) -check("0008.018", vswitch(as.numeric(x0), as.numeric(values0), outputs0, na0), x0) -check("0008.019", vswitch(as.numeric(x1), as.numeric(values0), outputs1), out11) -check("0008.020", vswitch(as.numeric(x1), as.numeric(values0), outputs1, na1), out12) -check("0008.021", vswitch(as.complex(x0), as.complex(values0), outputs0), x0) -check("0008.022", vswitch(as.complex(x0), as.complex(values0), outputs0, na0), x0) -check("0008.023", vswitch(as.complex(x1), as.complex(values0), outputs1), out11) -check("0008.024", vswitch(as.complex(x1), as.complex(values0), outputs1, na1), out12) -check("0008.025", vswitch(as.logical(x0), as.logical(values0), outputs0), x0) -check("0008.026", vswitch(as.logical(x0), as.logical(values0), outputs0, na0), x0) -check("0008.027", vswitch(as.logical(x1), as.logical(values0), outputs1), out11) -check("0008.028", vswitch(as.logical(x1), as.logical(values0), outputs1, na1), out12) -check("0008.029", vswitch(as.character(x0), as.character(values0), outputs0), x0) -check("0008.030", vswitch(as.character(x0), as.character(values0), outputs0, na0), x0) -check("0008.031", vswitch(as.character(x1), as.character(values0), outputs1), out11) -check("0008.032", vswitch(as.character(x1), as.character(values0), outputs1, na1), out12) -check("0008.033", vswitch(as.list(x0), as.list(values0), outputs0), x0) -check("0008.034", vswitch(as.list(x0), as.list(values0), outputs0, na0), x0) -check("0008.035", vswitch(as.list(x1), as.list(values0), outputs1), out11) -check("0008.036", vswitch(as.list(x1), as.list(values0), outputs1, na1), out12) -check("0008.037", vswitch(x0, values0, outputs0l), as.logical(x0)) -check("0008.038", vswitch(x0, values0, outputs0l, as.logical(na0)), as.logical(x0)) -check("0008.039", vswitch(x1, values0, outputs1l), as.logical(out11)) -check("0008.040", vswitch(x1, values0, outputs1l, as.logical(na1)), as.logical(out12)) -check("0008.041", vswitch(as.numeric(x0), as.numeric(values0), outputs0l), as.logical(x0)) -check("0008.042", vswitch(as.numeric(x0), as.numeric(values0), outputs0l, as.logical(na0)), as.logical(x0)) -check("0008.043", vswitch(as.numeric(x1), as.numeric(values0), outputs1l), as.logical(out11)) -check("0008.044", vswitch(as.numeric(x1), as.numeric(values0), outputs1l, as.logical(na1)), as.logical(out12)) -check("0008.045", vswitch(as.complex(x0), as.complex(values0), outputs0l), as.logical(x0)) -check("0008.046", vswitch(as.complex(x0), as.complex(values0), outputs0l, as.logical(na0)), as.logical(x0)) -check("0008.047", vswitch(as.complex(x1), as.complex(values0), outputs1l), as.logical(out11)) -check("0008.048", vswitch(as.complex(x1), as.complex(values0), outputs1l, as.logical(na1)), as.logical(out12)) -check("0008.049", vswitch(as.logical(x0), as.logical(values0), outputs0l), as.logical(x0)) -check("0008.050", vswitch(as.logical(x0), as.logical(values0), outputs0l, as.logical(na0)), as.logical(x0)) -check("0008.051", vswitch(as.logical(x1), as.logical(values0), outputs1l), as.logical(out11)) -check("0008.052", vswitch(as.logical(x1), as.logical(values0), outputs1l, as.logical(na1)), as.logical(out12)) -check("0008.053", vswitch(as.character(x0), as.character(values0), outputs0l), as.logical(x0)) -check("0008.054", vswitch(as.character(x0), as.character(values0), outputs0l, as.logical(na0)), as.logical(x0)) -check("0008.055", vswitch(as.character(x1), as.character(values0), outputs1l), as.logical(out11)) -check("0008.056", vswitch(as.character(x1), as.character(values0), outputs1l, as.logical(na1)), as.logical(out12)) -check("0008.057", vswitch(as.list(x0), as.list(values0), outputs0l), as.logical(x0)) -check("0008.058", vswitch(as.list(x0), as.list(values0), outputs0l, as.logical(na0)), as.logical(x0)) -check("0008.059", vswitch(as.list(x1), as.list(values0), outputs1l), as.logical(out11)) -check("0008.060", vswitch(as.list(x1), as.list(values0), outputs1l, as.logical(na1)), as.logical(out12)) -check("0008.061", vswitch(x0, values0, outputs0n), as.numeric(x0)) -check("0008.062", vswitch(x0, values0, outputs0n, as.numeric(na0)), as.numeric(x0)) -check("0008.063", vswitch(x1, values0, outputs1n), as.numeric(out11)) -check("0008.064", vswitch(x1, values0, outputs1n, as.numeric(na1)), as.numeric(out12)) -check("0008.065", vswitch(as.numeric(x0), as.numeric(values0), outputs0n), as.numeric(x0)) -check("0008.066", vswitch(as.numeric(x0), as.numeric(values0), outputs0n, as.numeric(na0)), as.numeric(x0)) -check("0008.067", vswitch(as.numeric(x1), as.numeric(values0), outputs1n), as.numeric(out11)) -check("0008.068", vswitch(as.numeric(x1), as.numeric(values0), outputs1n, as.numeric(na1)), as.numeric(out12)) -check("0008.069", vswitch(as.complex(x0), as.complex(values0), outputs0n), as.numeric(x0)) -check("0008.070", vswitch(as.complex(x0), as.complex(values0), outputs0n, as.numeric(na0)), as.numeric(x0)) -check("0008.071", vswitch(as.complex(x1), as.complex(values0), outputs1n), as.numeric(out11)) -check("0008.072", vswitch(as.complex(x1), as.complex(values0), outputs1n, as.numeric(na1)), as.numeric(out12)) -check("0008.073", vswitch(as.logical(x0), as.logical(values0), outputs0n), as.numeric(x0)) -check("0008.074", vswitch(as.logical(x0), as.logical(values0), outputs0n, as.numeric(na0)), as.numeric(x0)) -check("0008.075", vswitch(as.logical(x1), as.logical(values0), outputs1n), as.numeric(out11)) -check("0008.076", vswitch(as.logical(x1), as.logical(values0), outputs1n, as.numeric(na1)), as.numeric(out12)) -check("0008.077", vswitch(as.character(x0), as.character(values0), outputs0n), as.numeric(x0)) -check("0008.078", vswitch(as.character(x0), as.character(values0), outputs0n, as.numeric(na0)), as.numeric(x0)) -check("0008.079", vswitch(as.character(x1), as.character(values0), outputs1n), as.numeric(out11)) -check("0008.080", vswitch(as.character(x1), as.character(values0), outputs1n, as.numeric(na1)), as.numeric(out12)) -check("0008.081", vswitch(as.list(x0), as.list(values0), outputs0n), as.numeric(x0)) -check("0008.082", vswitch(as.list(x0), as.list(values0), outputs0n, as.numeric(na0)), as.numeric(x0)) -check("0008.083", vswitch(as.list(x1), as.list(values0), outputs1n), as.numeric(out11)) -check("0008.084", vswitch(as.list(x1), as.list(values0), outputs1n, as.numeric(na1)), as.numeric(out12)) -check("0008.085", vswitch(x0, values0, outputs0s), as.character(x0)) -check("0008.086", vswitch(x0, values0, outputs0s, as.character(na0)), as.character(x0)) -check("0008.087", vswitch(x1, values0, outputs1s), as.character(out11)) -check("0008.088", vswitch(x1, values0, outputs1s, as.character(na1)), as.character(out12)) -check("0008.089", vswitch(as.numeric(x0), as.numeric(values0), outputs0s), as.character(x0)) -check("0008.090", vswitch(as.numeric(x0), as.numeric(values0), outputs0s, as.character(na0)), as.character(x0)) -check("0008.091", vswitch(as.numeric(x1), as.numeric(values0), outputs1s), as.character(out11)) -check("0008.092", vswitch(as.numeric(x1), as.numeric(values0), outputs1s, as.character(na1)), as.character(out12)) -check("0008.093", vswitch(as.complex(x0), as.complex(values0), outputs0s), as.character(x0)) -check("0008.094", vswitch(as.complex(x0), as.complex(values0), outputs0s, as.character(na0)), as.character(x0)) -check("0008.095", vswitch(as.complex(x1), as.complex(values0), outputs1s), as.character(out11)) -check("0008.096", vswitch(as.complex(x1), as.complex(values0), outputs1s, as.character(na1)), as.character(out12)) -check("0008.097", vswitch(as.logical(x0), as.logical(values0), outputs0s), as.character(x0)) -check("0008.098", vswitch(as.logical(x0), as.logical(values0), outputs0s, as.character(na0)), as.character(x0)) -check("0008.099", vswitch(as.logical(x1), as.logical(values0), outputs1s), as.character(out11)) -check("0008.100", vswitch(as.logical(x1), as.logical(values0), outputs1s, as.character(na1)), as.character(out12)) -check("0008.101", vswitch(as.character(x0), as.character(values0), outputs0s), as.character(x0)) -check("0008.102", vswitch(as.character(x0), as.character(values0), outputs0s, as.character(na0)), as.character(x0)) -check("0008.103", vswitch(as.character(x1), as.character(values0), outputs1s), as.character(out11)) -check("0008.104", vswitch(as.character(x1), as.character(values0), outputs1s, as.character(na1)), as.character(out12)) -check("0008.105", vswitch(as.list(x0), as.list(values0), outputs0s), as.character(x0)) -check("0008.106", vswitch(as.list(x0), as.list(values0), outputs0s, as.character(na0)), as.character(x0)) -check("0008.107", vswitch(as.list(x1), as.list(values0), outputs1s), as.character(out11)) -check("0008.108", vswitch(as.list(x1), as.list(values0), outputs1s, as.character(na1)), as.character(out12)) -check("0008.109", vswitch(x0, values0, outputs0v), x0l) -check("0008.110", vswitch(x0, values0, outputs0v, na0l), x0l) -check("0008.111", vswitch(x1, values0, outputs1v), out11l) -check("0008.112", vswitch(x1, values0, outputs1v, as.list(na1)), out12l) -check("0008.113", vswitch(as.numeric(x0), as.numeric(values0), outputs0v), x0l) -check("0008.114", vswitch(as.numeric(x0), as.numeric(values0), outputs0v, na0l), x0l) -check("0008.115", vswitch(as.numeric(x1), as.numeric(values0), outputs1v), out11l) -check("0008.116", vswitch(as.numeric(x1), as.numeric(values0), outputs1v, as.list(na1)), out12l) -check("0008.117", vswitch(as.complex(x0), as.complex(values0), outputs0v), x0l) -check("0008.118", vswitch(as.complex(x0), as.complex(values0), outputs0v, na0l), x0l) -check("0008.119", vswitch(as.complex(x1), as.complex(values0), outputs1v), out11l) -check("0008.120", vswitch(as.complex(x1), as.complex(values0), outputs1v, as.list(na1)), out12l) -check("0008.121", vswitch(as.logical(x0), as.logical(values0), outputs0v), x0l) -check("0008.122", vswitch(as.logical(x0), as.logical(values0), outputs0v, na0l), x0l) -check("0008.123", vswitch(as.logical(x1), as.logical(values0), outputs1v), out11l) -check("0008.124", vswitch(as.logical(x1), as.logical(values0), outputs1v, as.list(na1)), out12l) -check("0008.125", vswitch(as.character(x0), as.character(values0), outputs0v), x0l) -check("0008.126", vswitch(as.character(x0), as.character(values0), outputs0v, na0l), x0l) -check("0008.127", vswitch(as.character(x1), as.character(values0), outputs1v), out11l) -check("0008.128", vswitch(as.character(x1), as.character(values0), outputs1v, as.list(na1)), out12l) -check("0008.129", vswitch(as.list(x0), as.list(values0), outputs0v), x0l) -check("0008.130", vswitch(as.list(x0), as.list(values0), outputs0v, na0l), x0l) -check("0008.131", vswitch(as.list(x1), as.list(values0), outputs1v), out11l) -check("0008.132", vswitch(as.list(x1), as.list(values0), outputs1v, as.list(na1)), out12l) -check("0008.133", vswitch(x0, values0, list(as.raw(0),as.raw(1))), error="Type raw is not supported for argument 'outputs'") -check("0008.134", vswitch(as.raw(rep(0,7L)), c(as.raw(0), as.raw(1)), outputs0), error="Type raw is not supported for argument 'x'.") -check("0008.135", vswitch(as.raw(rep(0,7L)), c(as.raw(0), as.raw(1)), outputs0l), error="Type raw is not supported for argument 'x'.") -check("0008.136", vswitch(as.raw(rep(0,7L)), c(as.raw(0), as.raw(1)), outputs0n), error="Type raw is not supported for argument 'x'.") -check("0008.137", vswitch(as.raw(rep(0,7L)), c(as.raw(0), as.raw(1)), outputs0s), error="Type raw is not supported for argument 'x'.") -check("0008.138", vswitch(as.raw(rep(0,7L)), c(as.raw(0), as.raw(1)), outputs0c), error="Type raw is not supported for argument 'x'.") -check("0008.139", vswitch(as.raw(rep(0,7L)), c(as.raw(0), as.raw(1)), outputs0v), error="Type raw is not supported for argument 'x'.") -check("0008.140", vswitch(factor(c("a","b"), levels=letters[1:2]), factor("a", levels=letters[1:2]), list(1L)), c(1L, NA_integer_)) -check("0008.141", vswitch(x0, values0, list(factor("a", levels=letters[1:2]),factor("a", levels=letters[1:2])), factor("b", levels=letters[1:2])), factor(c("a","a","a","a","b","a","b"), levels=letters[1:2])) -check("0008.142", vswitch(x0, values0, list(1L,s2)), error ="S4 class objects for argument 'outputs' (item 2) are not supported.") -check("0008.143", vswitch(x0, values0, list(as.Date("2020-04-14"),as.Date("2020-04-15"))), c(as.Date("2020-04-15"),as.Date("2020-04-14"),as.Date("2020-04-14"),as.Date("2020-04-15"),NA,as.Date("2020-04-15"),NA)) -check("0008.144", vswitch(x0, values0, list(1:2,3)), error = "Length of item 1 of 'output' is different than 1 and length of 'x'. Please make sure that all items of 'output' have length 1 or length of 'x'(7).") -check("0008.145", vswitch(x0, values0, outputs0c), as.complex(x0)) -check("0008.146", vswitch(x0, values0, outputs0c, as.complex(na0)), as.complex(x0)) -check("0008.147", vswitch(x1, values0, outputs1c), as.complex(out11)) -check("0008.148", vswitch(x1, values0, outputs1c, as.complex(na1)), as.complex(out12)) -check("0008.149", vswitch(as.numeric(x0), as.numeric(values0), outputs0c), as.complex(x0)) -check("0008.150", vswitch(as.numeric(x0), as.numeric(values0), outputs0c, as.complex(na0)), as.complex(x0)) -check("0008.151", vswitch(as.numeric(x1), as.numeric(values0), outputs1c), as.complex(out11)) -check("0008.152", vswitch(as.numeric(x1), as.numeric(values0), outputs1c, as.complex(na1)), as.complex(out12)) -check("0008.153", vswitch(as.complex(x0), as.complex(values0), outputs0c), as.complex(x0)) -check("0008.154", vswitch(as.complex(x0), as.complex(values0), outputs0c, as.complex(na0)), as.complex(x0)) -check("0008.155", vswitch(as.complex(x1), as.complex(values0), outputs1c), as.complex(out11)) -check("0008.156", vswitch(as.complex(x1), as.complex(values0), outputs1c, as.complex(na1)), as.complex(out12)) -check("0008.157", vswitch(as.logical(x0), as.logical(values0), outputs0c), as.complex(x0)) -check("0008.158", vswitch(as.logical(x0), as.logical(values0), outputs0c, as.complex(na0)), as.complex(x0)) -check("0008.159", vswitch(as.logical(x1), as.logical(values0), outputs1c), as.complex(out11)) -check("0008.160", vswitch(as.logical(x1), as.logical(values0), outputs1c, as.complex(na1)), as.complex(out12)) -check("0008.161", vswitch(as.character(x0), as.character(values0), outputs0c), as.complex(x0)) -check("0008.162", vswitch(as.character(x0), as.character(values0), outputs0c, as.complex(na0)), as.complex(x0)) -check("0008.163", vswitch(as.character(x1), as.character(values0), outputs1c), as.complex(out11)) -check("0008.164", vswitch(as.character(x1), as.character(values0), outputs1c, as.complex(na1)), as.complex(out12)) -check("0008.165", vswitch(as.list(x0), as.list(values0), outputs0c), as.complex(x0)) -check("0008.166", vswitch(as.list(x0), as.list(values0), outputs0c, as.complex(na0)), as.complex(x0)) -check("0008.167", vswitch(as.list(x1), as.list(values0), outputs1c), as.complex(out11)) -check("0008.168", vswitch(as.list(x1), as.list(values0), outputs1c, as.complex(na1)), as.complex(out12)) -check("0008.169", vswitch(x0, values0, list(as.Date("2020-04-14"),10)), error = "Items 1 and 2 of 'outputs' must have same class.") -check("0008.170", vswitch(x0, values0, list(factor("a", levels = letters[1:2]),factor("c", levels = letters[1:3]))), error = "Items 1 and 2 of 'outputs' are both factor but their levels are different.") -check("0008.171", vswitch(x0, values0, as.integer(outputs0)), x0) -check("0008.172", vswitch(x0, values0, as.numeric(outputs0)), as.numeric(x0)) -check("0008.173", vswitch(x0, values0, as.logical(outputs0)), as.logical(x0)) -check("0008.174", vswitch(x0, values0, as.character(outputs0)), as.character(x0)) -check("0008.175", vswitch(x0, values0, as.complex(outputs0)), as.complex(x0)) -check("0008.176", vswitch(as.numeric(x0), as.numeric(values0), as.integer(outputs0)), x0) -check("0008.177", vswitch(as.numeric(x0), as.numeric(values0), as.numeric(outputs0)), as.numeric(x0)) -check("0008.178", vswitch(as.numeric(x0), as.numeric(values0), as.logical(outputs0)), as.logical(x0)) -check("0008.179", vswitch(as.numeric(x0), as.numeric(values0), as.character(outputs0)), as.character(x0)) -check("0008.180", vswitch(as.numeric(x0), as.numeric(values0), as.complex(outputs0)), as.complex(x0)) -check("0008.181", vswitch(as.logical(x0), as.logical(values0), as.integer(outputs0)), x0) -check("0008.182", vswitch(as.logical(x0), as.logical(values0), as.numeric(outputs0)), as.numeric(x0)) -check("0008.183", vswitch(as.logical(x0), as.logical(values0), as.logical(outputs0)), as.logical(x0)) -check("0008.184", vswitch(as.logical(x0), as.logical(values0), as.character(outputs0)), as.character(x0)) -check("0008.185", vswitch(as.logical(x0), as.logical(values0), as.complex(outputs0)), as.complex(x0)) -check("0008.186", vswitch(as.complex(x0), as.complex(values0), as.integer(outputs0)), x0) -check("0008.187", vswitch(as.complex(x0), as.complex(values0), as.numeric(outputs0)), as.numeric(x0)) -check("0008.188", vswitch(as.complex(x0), as.complex(values0), as.logical(outputs0)), as.logical(x0)) -check("0008.189", vswitch(as.complex(x0), as.complex(values0), as.character(outputs0)), as.character(x0)) -check("0008.190", vswitch(as.complex(x0), as.complex(values0), as.complex(outputs0)), as.complex(x0)) -check("0008.191", vswitch(as.character(x0), as.character(values0), as.integer(outputs0)), x0) -check("0008.192", vswitch(as.character(x0), as.character(values0), as.numeric(outputs0)), as.numeric(x0)) -check("0008.193", vswitch(as.character(x0), as.character(values0), as.logical(outputs0)), as.logical(x0)) -check("0008.194", vswitch(as.character(x0), as.character(values0), as.character(outputs0)), as.character(x0)) -check("0008.195", vswitch(as.character(x0), as.character(values0), as.complex(outputs0)), as.complex(x0)) -check("0008.196", vswitch(as.list(x0), as.list(values0), as.integer(outputs0)), x0) -check("0008.197", vswitch(as.list(x0), as.list(values0), as.numeric(outputs0)), as.numeric(x0)) -check("0008.198", vswitch(as.list(x0), as.list(values0), as.logical(outputs0)), as.logical(x0)) -check("0008.199", vswitch(as.list(x0), as.list(values0), as.character(outputs0)), as.character(x0)) -check("0008.200", vswitch(as.list(x0), as.list(values0), as.complex(outputs0)), as.complex(x0)) -check("0008.201", vswitch(x0, values0, as.integer(outputs0), NA_character_), error = "Type of 'na' and 'outputs' are different. Please make sure they are the same.") -check("0008.202", vswitch(x0, values0, as.raw(c(0,1))), error="Type raw is not supported for argument 'outputs'") -check("0008.203", vswitch(x0, values0[1], as.Date("2020-04-14"), 2), error = "Argument 'na' and 'outputs' must have same class.") -check("0008.204", vswitch(x0, values0, factor(c("a","b")), factor("c")), error = "Argument 'na' and 'outputs' are both factor but their levels are different.") -check("0008.205", vswitch(x0, values0[1], factor(c("a"),levels=c("a","b")), factor(("b"),levels = c("a","b"))), factor(c("b","a","a","b","b","b","b"),levels=c("a","b"))) -check("0008.206", vswitch(as.raw(rep(0,7L)), c(as.raw(0), as.raw(1)), as.integer(outputs0)), error="Type raw is not supported for argument 'x'.") -check("0008.207", vswitch(as.raw(rep(0,7L)), c(as.raw(0), as.raw(1)), as.numeric(outputs0)), error="Type raw is not supported for argument 'x'.") -check("0008.208", vswitch(as.raw(rep(0,7L)), c(as.raw(0), as.raw(1)), as.logical(outputs0)), error="Type raw is not supported for argument 'x'.") -check("0008.209", vswitch(as.raw(rep(0,7L)), c(as.raw(0), as.raw(1)), as.character(outputs0)), error="Type raw is not supported for argument 'x'.") -check("0008.210", vswitch(as.raw(rep(0,7L)), c(as.raw(0), as.raw(1)), as.complex(outputs0)), error="Type raw is not supported for argument 'x'.") -check("0008.211", vswitch(c(enc1,enc2),enc1,1),c(1,1)) -check("0008.212", vswitch(c(enc1,enc1),enc1,1),c(1,1)) -check("0008.213", vswitch(c(enc2,enc2),enc2,1),c(1,1)) -check("0008.214", vswitch(c(enc1,enc2),enc2,1),c(1,1)) -check("0008.215", vswitch("a",character(),1),error = "Argument'values' cannot be zero-length vector.") -check("0008.216", vswitch("a","b",1,checkEnc = NA),error = "Argument 'checkEnc' must be TRUE or FALSE and length 1.") -# check("0008.217", vswitch(character(),"a",1),numeric(0)) -# check("0008.218", vswitch(numeric(),2,1),numeric(0)) - -rm(outputs0, outputs1, s1, s2, class2133, x0,x1,values0,out11,out12,na1,na0) -rm(outputs0l,outputs1l,outputs0n,outputs1n,outputs0c,outputs1c,outputs0s,outputs1s,outputs0v,outputs1v) -rm(na0l,out11l,out12l,x0l,x1l,enc1,enc2) - -# -------------------------------------------------------------------------------------------------- -# pall -# -------------------------------------------------------------------------------------------------- - -x = c(TRUE, FALSE, NA, FALSE) -y = c(TRUE, NA, TRUE, TRUE) -z = c(TRUE, TRUE, FALSE, NA) -x0 = sample(c(TRUE, FALSE, NA),1e3,TRUE) -y0 = sample(c(TRUE, FALSE, NA),1e3,TRUE) -z0 = sample(c(TRUE, FALSE, NA),1e3,TRUE) - -check("0009.001", pall(x, y, z, na.rm = FALSE), sapply(1:4, function(i) all(x[i],y[i],z[i],na.rm=FALSE))) -check("0009.002", pall(x, y, z, na.rm = TRUE), sapply(1:4, function(i) all(x[i],y[i],z[i],na.rm=TRUE))) -check("0009.003", pall(x, y, TRUE, na.rm = FALSE), error = "Argument 3 is of length 1 but argument 1 is of length 4. If you wish to 'recycle' your argument, please use rep() to make this intent clear to the readers of your code.") -check("0009.004", pall(c(TRUE,FALSE,NA), c(TRUE,FALSE), na.rm = FALSE), error = "Argument 2 is of length 2 but argument 1 is of length 3. If you wish to 'recycle' your argument, please use rep() to make this intent clear to the readers of your code.") -check("0009.005", pall(x, y, z, na.rm = NA), error = "Argument 'na.rm' must be TRUE or FALSE and length 1.") -check("0009.006", pall(x, na.rm = FALSE), x) -check("0009.007", pall(na.rm = FALSE), error = "Please supply at least 1 argument. (0 argument supplied)") -check("0009.008", pall(x, as.integer(z), y, na.rm = TRUE), error = "Argument 2 is of type integer. Only logical type is supported.") -check("0009.009", pall(as.double(z), y, na.rm = TRUE), error = "Argument 1 is of type double. Only logical type is supported.Data.frame (of logical vectors) is also supported as a single input.") -check("0009.010", pall(NA, na.rm = TRUE), TRUE) -check("0009.011", pall(NA, na.rm = FALSE), NA) -check("0009.012", pall(x0, y0, z0, na.rm = FALSE), sapply(1:1e3, function(i) all(x0[i],y0[i],z0[i],na.rm=FALSE))) -check("0009.013", pall(x0, y0, z0, na.rm = TRUE), sapply(1:1e3, function(i) all(x0[i],y0[i],z0[i],na.rm=TRUE))) -check("0009.014", pall(data.frame(x,y), na.rm = FALSE), pall(x,y, na.rm = FALSE)) - -# -------------------------------------------------------------------------------------------------- -# pany -# -------------------------------------------------------------------------------------------------- - -check("0010.001", pany(x, y, z, na.rm = FALSE), sapply(1:4, function(i) any(x[i],y[i],z[i],na.rm=FALSE))) -check("0010.002", pany(x, y, z, na.rm = TRUE), sapply(1:4, function(i) any(x[i],y[i],z[i],na.rm=TRUE))) -check("0010.003", pany(x, y, TRUE, na.rm = FALSE), error = "Argument 3 is of length 1 but argument 1 is of length 4. If you wish to 'recycle' your argument, please use rep() to make this intent clear to the readers of your code.") -check("0010.004", pany(c(TRUE,FALSE,NA), c(TRUE,FALSE), na.rm = FALSE), error = "Argument 2 is of length 2 but argument 1 is of length 3. If you wish to 'recycle' your argument, please use rep() to make this intent clear to the readers of your code.") -check("0010.005", pany(x, y, z, na.rm = NA), error = "Argument 'na.rm' must be TRUE or FALSE and length 1.") -check("0010.006", pany(x, na.rm = FALSE), x) -check("0010.007", pany(na.rm = FALSE), error = "Please supply at least 1 argument. (0 argument supplied)") -check("0010.008", pany(x, as.integer(z), y, na.rm = TRUE), error = "Argument 2 is of type integer. Only logical type is supported.") -check("0010.009", pany(as.double(z), y, na.rm = TRUE), error = "Argument 1 is of type double. Only logical type is supported.Data.frame (of logical vectors) is also supported as a single input.") -check("0010.010", pany(NA, na.rm = TRUE), TRUE) -check("0010.011", pany(NA, na.rm = FALSE), NA) -check("0010.012", pany(x0, y0, z0, na.rm = FALSE), sapply(1:1e3, function(i) any(x0[i],y0[i],z0[i],na.rm=FALSE))) -check("0010.013", pany(x0, y0, z0, na.rm = TRUE), sapply(1:1e3, function(i) any(x0[i],y0[i],z0[i],na.rm=TRUE))) -check("0010.014", pany(data.frame(x,y), na.rm = FALSE), pany(x,y, na.rm = FALSE)) - -rm(x, y, z, x0, y0, z0) - -# -------------------------------------------------------------------------------------------------- -# pmean -# -------------------------------------------------------------------------------------------------- - -x = c(1, 3, NA, 5) -y = c(2, NA, 4, 1) -z = c(3, 4, 4, 1) -x0 = rnorm(100L) -y0 = rnorm(100L) -z0 = rnorm(100L) -x1 = sample(c(1,2,NA),1e2,TRUE) -y1 = sample(c(1,2,NA),1e2,TRUE) -z1 = sample(c(1,2,NA),1e2,TRUE) - -check("0011.001", pmean(x, y, z, na.rm = FALSE), sapply(1:4, function(i) mean(c(x[i], y[i], z[i]), na.rm = FALSE))) -check("0011.002", pmean(x, y, z, na.rm = TRUE), sapply(1:4, function(i) mean(c(x[i], y[i], z[i]), na.rm = TRUE))) -check("0011.003", pmean(as.raw(z), y, na.rm = TRUE), error = "Argument 1 is of type raw. Only integer/logical and double types are supported. A data.frame (of the previous types) is also supported as a single input.") -check("0011.004", pmean(x, y, 1:2, na.rm = FALSE), error = "Argument 3 is of length 2 but argument 1 is of length 4. If you wish to 'recycle' your argument, please use rep() to make this intent clear to the readers of your code.") -check("0011.005", pmean(1:10, 1:5, na.rm = FALSE), error = "Argument 2 is of length 5 but argument 1 is of length 10. If you wish to 'recycle' your argument, please use rep() to make this intent clear to the readers of your code.") -check("0011.006", pmean(x, as.raw(z), y, na.rm = TRUE), error = "Argument 2 is of type raw. Only integer/logical and double types are supported.") -check("0011.007", pmean(x, y, z, na.rm = NA), error = "Argument 'na.rm' must be TRUE or FALSE and length 1.") -check("0011.008", pmean(x, na.rm = FALSE), sapply(1:4, function(i) mean(c(x[i]), na.rm = FALSE))) -check("0011.009", pmean(c(1,3,NA,5,NA), c(2,NA,4,1,NA), na.rm = TRUE), sapply(1:5, function(i) mean(c(c(1,3,NA,5,NA)[i], c(2,NA,4,1,NA)[i]), na.rm = TRUE))) -check("0011.010", pmean(na.rm = FALSE), error = "Please supply at least 1 argument. (0 argument supplied)") -check("0011.011", pmean(x0, y0, z0), sapply(1:100, function(i) mean(c(x0[i], y0[i], z0[i]), na.rm = FALSE))) -check("0011.012", pmean(x, y, z, rep(Inf,4L), na.rm = FALSE), sapply(1:4, function(i) mean(c(x[i], y[i], z[i],rep(Inf,4L)[i]), na.rm = FALSE))) -check("0011.013", pmean(x, y, z, rep(Inf,4L), na.rm = TRUE), sapply(1:4, function(i) mean(c(x[i], y[i], z[i],rep(Inf,4L)[i]), na.rm = TRUE))) -check("0011.014", pmean(as.integer(x), as.integer(y), as.integer(z), na.rm = FALSE), sapply(1:4, function(i) mean(c(as.integer(x[i]), as.integer(y[i]), as.integer(z[i])), na.rm = FALSE))) -check("0011.015", pmean(as.integer(x), as.integer(y), as.integer(z), na.rm = TRUE), sapply(1:4, function(i) mean(c(as.integer(x[i]), as.integer(y[i]), as.integer(z[i])), na.rm = TRUE))) -check("0011.016", pmean(as.integer(x), y, z, na.rm = TRUE), sapply(1:4, function(i) mean(c(as.integer(x[i]), y[i], z[i]), na.rm = TRUE))) -check("0011.017", pmean(x, y, as.integer(z), na.rm = FALSE), sapply(1:4, function(i) mean(c(x[i], y[i], as.integer(z[i])), na.rm = FALSE))) -check("0011.018", pmean(NA_integer_, na.rm = FALSE), mean(NA_integer_,na.rm = FALSE)) -check("0011.019", pmean(NA_real_, na.rm = FALSE), mean(NA_real_,na.rm = FALSE)) -check("0011.020", pmean(x0, y0, z0, na.rm = TRUE), sapply(1:100, function(i) mean(c(x0[i], y0[i], z0[i]), na.rm = TRUE))) -check("0011.021", pmean(x1, y1, z1, na.rm = FALSE), sapply(1:100, function(i) mean(c(x1[i], y1[i], z1[i]), na.rm = FALSE))) -check("0011.022", pmean(x1, y1, z1, na.rm = TRUE), sapply(1:100, function(i) mean(c(x1[i], y1[i], z1[i]), na.rm = TRUE))) -check("0011.023", pmean(NA_integer_, na.rm = TRUE), mean(NA_integer_,na.rm = TRUE)) -check("0011.024", pmean(NA_real_, na.rm = TRUE), mean(NA_real_,na.rm = TRUE)) -check("0011.025", pmean(data.frame(x,y,z), na.rm = TRUE), pmean(x,y,z,na.rm = TRUE)) -check("0011.026", pmean(1:150,iris$Species, na.rm = FALSE), error="Function 'pmean' is not meaningful for factors.") -check("0011.027", pmean(unclass(mtcars)),pmean(mtcars)) - -rm(x, y, z, x0, y0, z0, x1, y1, z1) - -# -------------------------------------------------------------------------------------------------- -# countNA -# -------------------------------------------------------------------------------------------------- - -x = c(0L,1L,2L,NA_integer_) - -check("0012.001", countNA(x), sum(is.na(x))) -check("0012.002", countNA(as.logical(x)), sum(is.na(as.logical(x)))) -check("0012.003", countNA(as.numeric(x)), sum(is.na(as.numeric(x)))) -check("0012.004", countNA(as.complex(x)), sum(is.na(as.complex(x)))) -check("0012.005", countNA(as.character(x)), sum(is.na(as.character(x)))) -check("0012.006", countNA(as.list(x)), list(0L,0L,0L,1L)) -check("0012.007", countNA(NaN), sum(is.na(NaN))) -check("0012.008", countNA(as.raw("0")), error = "Type raw is not supported.") -check("0012.009", countNA(NULL), 0L) -check("0012.010", countNA(list(c(0L,1L,2L,NA_integer_),NULL)), list(1L,0L)) -check("0012.011", countNA(list(x,list(x,1),1)), list(1L,list(1L,0L),0L)) - -rm(x) - -# -------------------------------------------------------------------------------------------------- -# count -# -------------------------------------------------------------------------------------------------- - -x = c(0L,1L,2L,NA_integer_) - -check("0013.001", count(x, 1L), sum(x == 1L,na.rm = TRUE)) -check("0013.002", count(as.logical(x), TRUE), sum(as.logical(x) == TRUE,na.rm = TRUE)) -check("0013.003", count(as.numeric(x), 1), sum(as.numeric(x) == 1,na.rm = TRUE)) -check("0013.004", count(as.complex(x), 1+0i), sum(as.complex(x) == 1+0i,na.rm = TRUE)) -check("0013.005", count(as.character(x), "2"), sum(as.character(x) == "2",na.rm = TRUE)) -check("0013.006", count(NULL,NA), error = "Type of 'value' (logical) is different than type of 'x' (NULL). Please make sure both have the same type.") -check("0013.007", count(NaN, NA_real_), 0L) -check("0013.008", count(as.raw("00"),as.raw("01")), error = "Type raw is not supported.") -check("0013.009", count(NULL,NULL), error = "Argument 'value' must be non NULL and length 1.") -check("0013.010", count(c(as.Date("2020-06-20"),as.Date("2020-06-21")), as.Date("2020-06-20")), 1L) -check("0013.011", count(c(as.Date("2020-06-20"),as.Date("2020-06-21")), 0), error = "'x' has different class than 'y'. Please make sure that both arguments have the same class.") -check("0013.012", count(iris$Species, factor("setosa","setosa")), error = "'x' and 'y' are both type factor but their levels are different.") -check("0013.013", count(iris$Species, iris$Species[1]), 50L) - -rm(x) - -# -------------------------------------------------------------------------------------------------- -# pcount -# -------------------------------------------------------------------------------------------------- - -x = c(1, 3, NA, 5) -y = c(2, NA, 4, 1) -z = c(3, 4, 4, 1) - -d1 = c(as.Date("2020-06-20"),as.Date("2020-06-21"),as.Date("2020-06-20"),as.Date("2020-06-21")) -d2 = c(as.Date("2020-06-22"),as.Date("2020-06-23"),as.Date("2020-06-22"),as.Date("2020-06-23")) - -f1 = factor(c("a","b","c","d"), c("a","b","c","d")) -f2 = factor(c("a","a","c","a"), c("a","b","c","d")) - -check("0014.001", pcount(x, value = 3), sapply(1:4, function(i) count(x[i], 3))) -check("0014.002", pcount(as.integer(x), value = 3L), sapply(1:4, function(i) count(as.integer(x[i]), 3L))) -check("0014.003", pcount(as.character(x), value = "3"), sapply(1:4, function(i) count(as.character(x[i]), "3"))) -check("0014.004", pcount(as.complex(x), value = 3+0i), sapply(1:4, function(i) count(as.complex(x[i]), 3+0i))) -check("0014.005", pcount(as.logical(x), value = TRUE), sapply(1:4, function(i) count(as.logical(x[i]), TRUE))) -check("0014.006", pcount(as.logical(x), value = NULL), error = "argument is of length zero") -check("0014.007", pcount(x, value = NA_real_), c(0L,0L,1L,0L)) -check("0014.008", pcount(value = TRUE), error = "Please supply at least 1 argument. (0 argument supplied)") -check("0014.009", pcount(x,y,z,value = 3), c(1L,1L,0L,0L)) -check("0014.010", pcount(x,y,z,value = 4), c(0L,1L,2L,0L)) -check("0014.011", pcount(x,y,z[1:3],value = 4), error = "Argument 3 is of length 3 but argument 1 is of length 4. If you wish to 'recycle' your argument, please use rep() to make this intent clear to the readers of your code.") -check("0014.012", pcount(x,y,as.logical(z),value = 4), error = "Type of argument 3 is logical but argument 1 is of type double. Please make sure both have the same type.") -check("0014.013", pcount(x,y,z,value = 4L), error = "Type of 'value' (integer) is different than type of Argument 1 (double). Please make sure both have the same type.") -check("0014.014", pcount(list(x),y,z,value = 4), error = "Argument 1 is of type list. Only logical, integer, double, complex and character types are supported.") -check("0014.015", pcount(d1, d2, value = as.Date("2020-06-20")), c(1L, 0L, 1L, 0L)) -check("0014.016", pcount(d1, d2, value = 5), error = "Class of 'value' is different than class of Argument 1. Please make sure both have the same class.") -check("0014.017", pcount(d1, c(1,2,3,4), value = as.Date("2020-06-20")), error = "Class of 'value' is different than class of Argument 2. Please make sure both have the same class.") -check("0014.018", pcount(f1, f2, value = factor("a", c("a","b","c","d"))), c(2L, 1L, 0L, 1L)) -check("0014.019", pcount(f1, f2, value = factor("a", c("a","b","c"))), error = "Levels of 'value' are different than levels of Argument 1. Please make sure both have the same levels.") -check("0014.020", pcount(f1, factor("a", c("a","b","c")), value = factor("a", c("a","b","c","d"))), error = "Levels of 'value' are different than levels of Argument 2. Please make sure both have the same levels.") - -rm(x,y,z, d1, d2, f1, f2) - -# --------------------------------------------------------------------------------------------------------------------------- -# fduplicated -# --------------------------------------------------------------------------------------------------------------------------- - -x1 = sample(c(1:1000,NA_integer_),1e3,TRUE) -x2 = sample(c(TRUE,NA,FALSE),1e3,TRUE) -x3 = sample(as.numeric(c(1:1000,NA_integer_)),1e3,TRUE) -x4 = sample(as.complex(c(1:1000,NA_complex_,(NaN+0i)/0,NaN)),1e3,TRUE) -x5 = sample(as.character(c(1:1000,NA_integer_)),1e3,TRUE) -x6 = data.frame(a = rep(seq.POSIXt(as.POSIXct("2020-01-01"),as.POSIXct("2020-01-30"),length.out = 5),4L),b = rep(rnorm(5),4L)) - -check("0015.001", fduplicated(iris$Species), duplicated(iris$Species)) -check("0015.002", fduplicated(iris$Petal.Width), duplicated(iris$Petal.Width)) -check("0015.003", fduplicated(iris$Petal.Length), duplicated(iris$Petal.Length)) -check("0015.004", fduplicated(iris$Sepal.Length), duplicated(iris$Sepal.Length)) -check("0015.005", fduplicated(iris$Sepal.Width), duplicated(iris$Sepal.Width)) -check("0015.006", fduplicated(as.character(iris$Petal.Width)), duplicated(as.character(iris$Petal.Width))) -check("0015.007", fduplicated(c(TRUE,FALSE,TRUE,FALSE,NA,NA,TRUE)), duplicated(c(TRUE,FALSE,TRUE,FALSE,NA,NA,TRUE))) -check("0015.008", fduplicated(x1), duplicated(x1)) -check("0015.009", fduplicated(x2), duplicated(x2)) -check("0015.010", fduplicated(x3), duplicated(x3)) -check("0015.011", fduplicated(x4), duplicated(x4)) -check("0015.012", fduplicated(x5), duplicated(x5)) -check("0015.013", fduplicated(data.frame(a=x1,b=x1)),duplicated(data.frame(a=x1,b=x1))) -check("0015.014", fduplicated(data.frame(a=x2,b=x2)),duplicated(data.frame(a=x2,b=x2))) -check("0015.015", fduplicated(data.frame(a=x3,b=x3)),duplicated(data.frame(a=x3,b=x3))) -check("0015.016", fduplicated(data.frame(a=x4,b=x4)),duplicated(data.frame(a=x4,b=x4))) -check("0015.017", fduplicated(data.frame(a=x5,b=x5)),duplicated(data.frame(a=x5,b=x5))) -check("0015.018", fduplicated(iris[,5:4]), duplicated(iris[,5:4])) -check("0015.019", fduplicated(iris[,5:3]), duplicated(iris[,5:3])) -check("0015.020", fduplicated(iris[,5:2]), duplicated(iris[,5:2])) -check("0015.021", fduplicated(iris[,5:1]), duplicated(iris[,5:1])) -check("0015.022", fduplicated(raw(4L)),error = "Type raw is not supported.") -check("0015.023", fduplicated(iris3),error = "Arrays are not yet supported. (please raise a feature request if needed)") -check("0015.024", fduplicated(matrix(c(1,1,1,1),nrow = 2)),c(FALSE,TRUE)) -check("0015.025", fduplicated(matrix(c(1L,1L,1L,1L),nrow = 2)),c(FALSE,TRUE)) -check("0015.026", fduplicated(matrix(c(TRUE,TRUE,FALSE,FALSE),nrow = 2)),c(FALSE,TRUE)) -check("0015.027", fduplicated(matrix(c("1","1","1","1"),nrow = 2)),c(FALSE,TRUE)) -check("0015.028", fduplicated(matrix(as.complex(c(1,1,1,1)),nrow = 2)),c(FALSE,TRUE)) -check("0015.029", fduplicated(matrix(as.raw(c(1,1,1,1)),nrow = 2)),error = "Matrix of type raw are not supported.") -check("0015.030", fduplicated(x6),duplicated(x6)) -check("0015.031", fduplicated(x1, fromLast=TRUE), duplicated(x1, fromLast=TRUE)) -check("0015.032", fduplicated(x2, fromLast=TRUE), duplicated(x2, fromLast=TRUE)) -check("0015.033", fduplicated(x3, fromLast=TRUE), duplicated(x3, fromLast=TRUE)) -check("0015.034", fduplicated(x4, fromLast=TRUE), duplicated(x4, fromLast=TRUE)) -check("0015.035", fduplicated(x5, fromLast=TRUE), duplicated(x5, fromLast=TRUE)) -check("0015.036", fduplicated(matrix(c(1,1,1,1),nrow = 2),fromLast = TRUE),c(TRUE,FALSE)) -check("0015.037", fduplicated(matrix(c(1L,1L,1L,1L),nrow = 2),fromLast = TRUE),c(TRUE,FALSE)) -check("0015.038", fduplicated(matrix(c(TRUE,TRUE,FALSE,FALSE),nrow = 2),fromLast = TRUE),c(TRUE,FALSE)) -check("0015.039", fduplicated(matrix(c("1","1","1","1"),nrow = 2),fromLast = TRUE),c(TRUE,FALSE)) -check("0015.040", fduplicated(matrix(as.complex(c(1,1,1,1)),nrow = 2),fromLast = TRUE),c(TRUE,FALSE)) -check("0015.041", fduplicated(data.frame(a=x1,b=x1),fromLast = TRUE),duplicated(data.frame(a=x1,b=x1),fromLast = TRUE)) -check("0015.042", fduplicated(data.frame(a=x2,b=x2),fromLast = TRUE),duplicated(data.frame(a=x2,b=x2),fromLast = TRUE)) -check("0015.043", fduplicated(data.frame(a=x3,b=x3),fromLast = TRUE),duplicated(data.frame(a=x3,b=x3),fromLast = TRUE)) -check("0015.044", fduplicated(data.frame(a=x4,b=x4),fromLast = TRUE),duplicated(data.frame(a=x4,b=x4),fromLast = TRUE)) -check("0015.045", fduplicated(data.frame(a=x5,b=x5),fromLast = TRUE),duplicated(data.frame(a=x5,b=x5),fromLast = TRUE)) -check("0015.046", fduplicated(iris[,5:4],fromLast = TRUE), duplicated(iris[,5:4],fromLast = TRUE)) - -# -------------------------------------------------------------------------------------------------- -# funique -# -------------------------------------------------------------------------------------------------- - -df = iris -df$Petal.Width = as.double(df$Petal.Width) -df$Petal.Length = as.character(df$Petal.Length) -df$Sepal.Width = as.logical(df$Sepal.Width) -df$Sepal.Length = as.complex(df$Sepal.Length) -rdn = sample(c(1,NA_real_,NaN),1e3,TRUE) -x7 = c("UK","USA","FR","IT","IT") -attr(x7,"label") = "Country" -x8 = c(1+1i,1+1i,2+1i,2+1i) -attr(x8,"label") = "complex" -x9 = c(TRUE,TRUE,FALSE,FALSE) -attr(x9,"label") = "logical" -f1 = factor(c("A","B","C","C")) -f2 = factor(c("A","B","C","A")) -f3 = factor(c("A","C","A"),levels = c("A","B","C")) - -check("0016.001", funique(iris$Species), unique(iris$Species)) -check("0016.002", funique(iris$Petal.Width), unique(iris$Petal.Width)) -check("0016.003", funique(iris$Petal.Length), unique(iris$Petal.Length)) -check("0016.004", funique(iris$Sepal.Length), unique(iris$Sepal.Length)) -check("0016.005", funique(iris$Sepal.Width), unique(iris$Sepal.Width)) -check("0016.006", funique(as.character(iris$Petal.Width)), unique(as.character(iris$Petal.Width))) -check("0016.007", funique(c(TRUE,FALSE,TRUE,FALSE,NA,NA,TRUE)), unique(c(TRUE,FALSE,TRUE,FALSE,NA,NA,TRUE))) -check("0016.008", funique(x1), unique(x1)) -check("0016.009", funique(x2), unique(x2)) -check("0016.010", funique(x3), unique(x3)) -check("0016.011", funique(x4), unique(x4)) -check("0016.012", funique(x5), unique(x5)) -check("0016.013", funique(data.frame(a=x1,b=x1)),{out = unique(data.frame(a=x1,b=x1)); row.names(out)<-NULL;out}) -check("0016.014", funique(data.frame(a=x2,b=x2)),{out = unique(data.frame(a=x2,b=x2)); row.names(out)<-NULL;out}) -check("0016.015", funique(data.frame(a=x3,b=x3)),{out = unique(data.frame(a=x3,b=x3)); row.names(out)<-NULL;out}) -check("0016.016", funique(data.frame(a=x4,b=x4)),{out = unique(data.frame(a=x4,b=x4)); row.names(out)<-NULL;out}) -check("0016.017", funique(data.frame(a=x5,b=x5)),{out = unique(data.frame(a=x5,b=x5)); row.names(out)<-NULL;out}) -check("0016.018", funique(df), {adf = unique(df); row.names(adf) <- NULL; adf }) -check("0016.019", funique(c(as.Date("2020-05-01"),as.Date("2020-05-01"))), as.Date("2020-05-01")) -check("0016.020", funique(data.frame(a = c(as.Date("2020-05-01"),as.Date("2020-05-01")), b = c(as.Date("2020-05-01"),as.Date("2020-05-01")))), data.frame(a = c(as.Date("2020-05-01")), b = c(as.Date("2020-05-01")))) -check("0016.021", funique(matrix(c(1,1,1,1,2,2,3,3,2,2),nrow = 5)),matrix(c(1,1,2,2,3,2),nrow = 3)) -check("0016.022", funique(matrix(as.integer(c(1,1,1,1,2,2,3,3,2,2)),nrow = 5)),matrix(c(1L,1L,2L,2L,3L,2L),nrow = 3)) -check("0016.023", funique(matrix(c(TRUE,TRUE,FALSE,FALSE,TRUE,TRUE,TRUE,TRUE,FALSE,FALSE,NA,NA),nrow = 6)),matrix(c(TRUE,FALSE,TRUE,TRUE,FALSE,NA),nrow = 3)) -check("0016.024", funique(matrix(as.character(c(1,1,1,1,2,2,3,3,2,2)),nrow = 5)),matrix(as.character(c(1,1,2,2,3,2)),nrow = 3)) -check("0016.025", funique(matrix(as.complex(c(1,1,1,1,2,2,3,3,2,2)),nrow = 5)),matrix(as.complex(c(1,1,2,2,3,2)),nrow = 3)) -check("0016.026", funique(matrix(as.raw(c(1,1,1,1)),nrow = 2)),error = "Matrix of type raw are not supported.") -check("0016.027", funique(iris3), error = "Arrays are not yet supported. (please raise a feature request if needed)") -check("0016.028", funique(matrix(x1[1:100],ncol=10)), unique(matrix(x1[1:100],ncol=10))) -check("0016.029", funique(matrix(x2[1:100],ncol=10)), unique(matrix(x2[1:100],ncol=10))) -check("0016.030", funique(matrix(x3[1:100],ncol=10)), unique(matrix(x3[1:100],ncol=10))) -check("0016.031", funique(matrix(x4[1:100],ncol=10)), unique(matrix(x4[1:100],ncol=10))) -check("0016.032", funique(matrix(x5[1:100],ncol=10)), unique(matrix(x5[1:100],ncol=10))) -check("0016.033", funique(matrix(rdn,ncol=10)), unique(matrix(rdn,ncol=10))) -check("0016.034", funique(x6),unique(x6)) -check("0016.035", funique(x1, fromLast=TRUE), unique(x1, fromLast=TRUE)) -check("0016.036", funique(x2, fromLast=TRUE), unique(x2, fromLast=TRUE)) -check("0016.037", funique(x3, fromLast=TRUE), unique(x3, fromLast=TRUE)) -check("0016.038", funique(x4, fromLast=TRUE), unique(x4, fromLast=TRUE)) -check("0016.039", funique(x5, fromLast=TRUE), unique(x5, fromLast=TRUE)) -check("0016.040", funique(x5, fromLast=NA), error = "Argument 'fromLast' must be TRUE or FALSE and length 1.") -check("0016.041", funique(matrix(x1[1:100],ncol=10),fromLast = TRUE), unique(matrix(x1[1:100],ncol=10),fromLast = TRUE)) -check("0016.042", funique(matrix(x2[1:100],ncol=10),fromLast = TRUE), unique(matrix(x2[1:100],ncol=10),fromLast = TRUE)) -check("0016.043", funique(matrix(x3[1:100],ncol=10),fromLast = TRUE), unique(matrix(x3[1:100],ncol=10),fromLast = TRUE)) -check("0016.044", funique(matrix(x4[1:100],ncol=10),fromLast = TRUE), unique(matrix(x4[1:100],ncol=10),fromLast = TRUE)) -check("0016.045", funique(matrix(x5[1:100],ncol=10),fromLast = TRUE), unique(matrix(x5[1:100],ncol=10),fromLast = TRUE)) -check("0016.046", funique(matrix(x5[1:100],ncol=10),fromLast=NA), error = "Argument 'fromLast' must be TRUE or FALSE and length 1.") -check("0016.047", funique(data.frame(a=x1,b=x1),fromLast = TRUE),{out = unique(data.frame(a=x1,b=x1),fromLast = TRUE); row.names(out)<-NULL;out}) -check("0016.048", funique(data.frame(a=x2,b=x2),fromLast = TRUE),{out = unique(data.frame(a=x2,b=x2),fromLast = TRUE); row.names(out)<-NULL;out}) -check("0016.049", funique(data.frame(a=x3,b=x3),fromLast = TRUE),{out = unique(data.frame(a=x3,b=x3),fromLast = TRUE); row.names(out)<-NULL;out}) -check("0016.050", funique(data.frame(a=x4,b=x4),fromLast = TRUE),{out = unique(data.frame(a=x4,b=x4),fromLast = TRUE); row.names(out)<-NULL;out}) -check("0016.051", funique(data.frame(a=x5,b=x5),fromLast = TRUE),{out = unique(data.frame(a=x5,b=x5),fromLast = TRUE); row.names(out)<-NULL;out}) -check("0016.052", funique(data.frame(a=x5,b=x5),fromLast = NA),error = "Argument 'fromLast' must be TRUE or FALSE and length 1.") -check("0016.053", funique(iris[,5:4],fromLast = TRUE), {out = unique(iris[,5:4],fromLast = TRUE); row.names(out)<-NULL;out}) -check("0016.054", attr(funique(x7),"label"),"Country") -check("0016.055", attr(funique(data.frame(a=x7,b=x7,stringsAsFactors = FALSE))[,1],"label"),"Country") -check("0016.056", attr(funique(x8),"label"),"complex") -check("0016.057", attr(funique(data.frame(a=x8,b=x8,stringsAsFactors = FALSE))[,1],"label"),"complex") -check("0016.058", attr(funique(x9),"label"),"logical") -check("0016.059", attr(funique(data.frame(a=x9,b=x9,stringsAsFactors = FALSE))[,1],"label"),"logical") -check("0016.060", funique(iris$Species[iris$Species != "setosa"]), unique(iris$Species[iris$Species != "setosa"])) -check("0016.061", funique(c(FALSE,FALSE,NA,TRUE,NA)),unique(c(FALSE,FALSE,NA,TRUE,NA))) -check("0016.062", funique(c(FALSE,FALSE,NA,TRUE,NA),fromLast = TRUE),unique(c(FALSE,FALSE,NA,TRUE,NA),fromLast = TRUE)) -check("0016.063", funique(c(TRUE,TRUE,NA,FALSE,NA)),unique(c(TRUE,TRUE,NA,FALSE,NA))) -check("0016.064", funique(c(TRUE,TRUE,NA,FALSE,NA),fromLast = TRUE),unique(c(TRUE,TRUE,NA,FALSE,NA),fromLast = TRUE)) -check("0016.065", funique(c(NA,NA,FALSE)),unique(c(NA,NA,FALSE))) -check("0016.065", funique(c(NA,NA,FALSE),fromLast = TRUE),unique(c(NA,NA,FALSE),fromLast = TRUE)) -check("0016.066", funique(f1),unique(f1)) -check("0016.067", funique(f2),unique(f2)) -check("0016.068", funique(f3),unique(f3)) -check("0016.069", funique(f1,fromLast = TRUE),unique(f1,fromLast = TRUE)) -check("0016.070", funique(f2,fromLast = TRUE),unique(f2,fromLast = TRUE)) -check("0016.071", funique(f3,fromLast = TRUE),unique(f3,fromLast = TRUE)) -check("0016.072", funique(data.frame(a=c(1,NA,NA,NaN,NaN),b=c(2,2,2,2,2))),{out = unique(data.frame(a=c(1,NA,NA,NaN,NaN),b=c(2,2,2,2,2))); row.names(out)<-NULL;out}) -check("0016.073", funique(data.frame(a=as.complex(c(1,NA,NA,NaN,NaN)),b=c(2,2,2,2,2))),{out = unique(data.frame(a=as.complex(c(1,NA,NA,NaN,NaN)),b=c(2,2,2,2,2)));row.names(out)<-NULL;out}) - -rm(x1, x2, x3, x4, x5, x6, x7, x8, x9, adf, df, rdn, out, f1, f2, f3) - -# -------------------------------------------------------------------------------------------------- -# countOccur -# -------------------------------------------------------------------------------------------------- - -x1 = sample(c(1:1000,NA_integer_),1e4,TRUE) -x2 = sample(as.logical(c(1:1000,NA_integer_)),1e4,TRUE) -x3 = sample(as.numeric(c(1:1000,NA_integer_)),1e4,TRUE) -x4 = sample(as.complex(c(1:1000,NA_complex_,(NaN+0i)/0,NaN)),1e4,TRUE) -x5 = sample(as.character(c(1:1000,NA_integer_)),1e4,TRUE) -df1 = countOccur(x1) -df2 = countOccur(x2) -df3 = countOccur(x3) -df4 = countOccur(x4) -df5 = countOccur(x5) -out = data.frame(unique(iris[,5:4]),Count = as.integer(c(29,7,7,5,1,1,7,10,13,3,7,3,1,5,1,3,5,6,11,3,1,6,3,8,2,1,1))) -row.names(out) = NULL -out2 = mtcars -out2$Count = 1L -out2 = aggregate(out2$Count,by=out2[,10:11],FUN = length) -out2 = out2[order(out2$gear,out2$carb),] -row.names(out2) = NULL -names(out2)[3] = "Count" -out3 = countOccur(mtcars[,10:11]) -out3 = out3[order(out3$gear,out3$carb),] -row.names(out3) = NULL - -check("0017.000", countOccur(iris$Species)[[2]], c(50L,50L,50L)) -check("0017.001", countOccur(as.numeric(iris$Species))[[2]], c(50L,50L,50L)) -check("0017.002", countOccur(as.complex(iris$Species))[[2]], c(50L,50L,50L)) -check("0017.003", countOccur(as.character(iris$Species))[[2]], c(50L,50L,50L)) -check("0017.004", countOccur(c(NA,TRUE,TRUE,FALSE,NA,FALSE))[[2]], c(2L,2L,2L)) -check("0017.005", countOccur(raw(2L)), error = "Type raw is not supported.") -check("0017.006", df1[order(df1$Variable),2], as.vector(table(x1,useNA = "always"))) -check("0017.007", df2[order(df2$Variable),2], as.vector(table(x2,useNA = "always"))) -check("0017.008", df3[order(df3$Variable),2], as.vector(table(x3,useNA = "always"))) -check("0017.009", df4[order(df4$Variable),2], as.vector(table(x4,useNA = "always"))) -check("0017.010", df5[order(df5$Variable),2], as.vector(table(x5,useNA = "always"))) -check("0017.011", countOccur(rep(as.Date("2020-06-02"),10L))[[2]], 10L) -check("0017.012", countOccur(data.frame(a = c(as.Date("2020-05-01"),as.Date("2020-05-01")), b = c(as.Date("2020-05-01"),as.Date("2020-05-01")))),data.frame(a = c(as.Date("2020-05-01")), b = c(as.Date("2020-05-01")), Count = 2L)) -check("0017.013", countOccur(iris[,5:4]), out) -check("0017.014",out3 ,out2) -check("0017.015",countOccur(matrix(c(1,1,1,1),nrow = 2)),error = "Array are not yet supported.") - -rm(x1, x2, x3, x4, x5,df1, df2, df3, df4, df5, out, out2, out3) - -# -------------------------------------------------------------------------------------------------- -# uniqLen -# -------------------------------------------------------------------------------------------------- - -df = iris -df$Petal.Width = as.double(df$Petal.Width) -df$Petal.Length = as.character(df$Petal.Length) -df$Sepal.Width = as.logical(df$Sepal.Width) -df$Sepal.Length = as.complex(df$Sepal.Length) -rdn = sample(c(1,NA_real_,NaN),1e3,TRUE) -x1 = sample(c(1:1000,NA_integer_),1e6,TRUE) -x2 = sample(c(TRUE,NA,FALSE),1e3,TRUE) -x3 = sample(as.numeric(c(1:1000,NA_integer_)),1e3,TRUE) -x4 = sample(as.complex(c(1:1000,NA_complex_,(NaN+0i)/0,NaN)),1e3,TRUE) -x5 = sample(as.character(c(1:1000,NA_integer_)),1e3,TRUE) -x6 = data.frame(a = rep(seq.POSIXt(as.POSIXct("2020-01-01"),as.POSIXct("2020-01-30"),length.out = 5),4L),b = rep(rnorm(5),4L)) - -check("0018.001", uniqLen(iris$Species), length(unique(iris$Species))) -check("0018.002", uniqLen(iris$Petal.Width), length(unique(iris$Petal.Width))) -check("0018.003", uniqLen(iris$Petal.Length), length(unique(iris$Petal.Length))) -check("0018.004", uniqLen(iris$Sepal.Length), length(unique(iris$Sepal.Length))) -check("0018.005", uniqLen(iris$Sepal.Width), length(unique(iris$Sepal.Width))) -check("0018.006", uniqLen(as.character(iris$Petal.Width)), length(unique(as.character(iris$Petal.Width)))) -check("0018.007", uniqLen(c(TRUE,FALSE,TRUE,FALSE,NA,NA,TRUE)), length(unique(c(TRUE,FALSE,TRUE,FALSE,NA,NA,TRUE)))) -check("0018.008", uniqLen(x1), length(unique(x1))) -check("0018.009", uniqLen(x2), length(unique(x2))) -check("0018.010", uniqLen(x3), length(unique(x3))) -check("0018.011", uniqLen(x4), length(unique(x4))) -check("0018.012", uniqLen(x5), length(unique(x5))) -check("0018.013", uniqLen(data.frame(a=x1,b=x1)),dim(unique(data.frame(a=x1,b=x1)))[1]) -check("0018.014", uniqLen(data.frame(a=x2,b=x2)),dim(unique(data.frame(a=x2,b=x2)))[1]) -check("0018.015", uniqLen(data.frame(a=x3,b=x3)),dim(unique(data.frame(a=x3,b=x3)))[1]) -check("0018.016", uniqLen(data.frame(a=x4,b=x4)),dim(unique(data.frame(a=x4,b=x4)))[1]) -check("0018.017", uniqLen(data.frame(a=x5,b=x5)),dim(unique(data.frame(a=x5,b=x5)))[1]) -check("0018.018", uniqLen(df), dim(unique(df))[1]) -check("0018.019", uniqLen(c(as.Date("2020-05-01"),as.Date("2020-05-01"))), 1L) -check("0018.020", uniqLen(data.frame(a = c(as.Date("2020-05-01"),as.Date("2020-05-01")), b = c(as.Date("2020-05-01"),as.Date("2020-05-01")))),1L) -check("0018.021", uniqLen(matrix(c(1,1,1,1,2,2,3,3,2,2),nrow = 5)),3L) -check("0018.022", uniqLen(matrix(as.integer(c(1,1,1,1,2,2,3,3,2,2)),nrow = 5)),3L) -check("0018.023", uniqLen(matrix(c(TRUE,TRUE,FALSE,FALSE,TRUE,TRUE,TRUE,TRUE,FALSE,FALSE,NA,NA),nrow = 6)),3L) -check("0018.024", uniqLen(matrix(as.character(c(1,1,1,1,2,2,3,3,2,2)),nrow = 5)),3L) -check("0018.025", uniqLen(matrix(as.complex(c(1,1,1,1,2,2,3,3,2,2)),nrow = 5)),3L) -check("0018.026", uniqLen(matrix(as.raw(c(1,1,1,1)),nrow = 2)),error = "Matrix of type raw are not supported.") -check("0018.027", uniqLen(iris3), error = "Arrays are not yet supported. (please raise a feature request if needed)") -check("0018.028", uniqLen(matrix(x1[1:100],ncol=10)), dim(unique(matrix(x1[1:100],ncol=10)))[1]) -check("0018.029", uniqLen(matrix(x2[1:100],ncol=10)), dim(unique(matrix(x2[1:100],ncol=10)))[1]) -check("0018.030", uniqLen(matrix(x3[1:100],ncol=10)), dim(unique(matrix(x3[1:100],ncol=10)))[1]) -check("0018.031", uniqLen(matrix(x4[1:100],ncol=10)), dim(unique(matrix(x4[1:100],ncol=10)))[1]) -check("0018.032", uniqLen(matrix(x5[1:100],ncol=10)), dim(unique(matrix(x5[1:100],ncol=10)))[1]) -check("0018.033", uniqLen(matrix(rdn,ncol=10)), dim(unique(matrix(rdn,ncol=10)))[1]) -check("0018.034", uniqLen(x6),dim(unique(x6))[1]) -check("0018.035", uniqLen(c(TRUE,FALSE,FALSE,FALSE,TRUE)),length(unique(c(TRUE,FALSE,FALSE,FALSE,TRUE)))) -check("0018.036", uniqLen(factor(c("A","C","A"),levels = c("A","B","C"))),2L) - -rm(x1, x2, x3, x4, x5, x6, df, rdn) - -# -------------------------------------------------------------------------------------------------- -# nswitch -# -------------------------------------------------------------------------------------------------- - -x1 = c(0L, 0L, 1L, 2L, 3L, 2L) -x2 = as.logical(x1) -x3 = as.numeric(x1) -x4 = as.complex(x1) -x5 = as.character(x1) -x6 = as.list(x1) - -class2133 = setClass("class2133", slots=list(x="numeric")) -s1 = class2133(x=20191231) -s2 = class2133(x=20191230) - -enc1 = "fa\xE7ile" -Encoding(enc1) = "latin1" -enc2 = enc2utf8(enc1) - -check("0019.001", nswitch(x1, 0L, FALSE, 1L, TRUE, 2L, TRUE, default = FALSE), c(FALSE,FALSE,TRUE,TRUE,FALSE,TRUE)) -check("0019.002", nswitch(x2, FALSE, FALSE, TRUE, TRUE, default = FALSE), c(FALSE,FALSE,TRUE,TRUE,TRUE,TRUE)) -check("0019.003", nswitch(x3, 0, FALSE, 1, TRUE, 2, TRUE, default = FALSE), c(FALSE,FALSE,TRUE,TRUE,FALSE,TRUE)) -check("0019.004", nswitch(x4, 0+0i, FALSE, 1+0i, TRUE, 2+0i, TRUE, default = FALSE), c(FALSE,FALSE,TRUE,TRUE,FALSE,TRUE)) -check("0019.005", nswitch(x5, "0", FALSE, "1", TRUE, "2", TRUE, default = FALSE), c(FALSE,FALSE,TRUE,TRUE,FALSE,TRUE)) -check("0019.006", nswitch(x1, 0L, 1L, 1L, 2L, 2L, 3L, default = 4L), c(1L,1L,2L,3L,4L,3L)) -check("0019.007", nswitch(x2, TRUE, 1L, FALSE, 2L, default = 0L), c(2L,2L,1L,1L,1L,1L)) -check("0019.008", nswitch(x3, 0, 1L, 1, 2L, 2, 3L, default = 4L), c(1L,1L,2L,3L,4L,3L)) -check("0019.009", nswitch(x4, 0+0i, 0L, 1+0i, 1L, 2+0i, 2L, default = 3L), c(0L,0L,1L,2L,3L,2L)) -check("0019.010", nswitch(x5, "0", 0L, "1", 1L, "2", 2L, default = 3L), c(0L,0L,1L,2L,3L,2L)) -check("0019.011", nswitch(x1, 0L, 1, 1L, 2, 2L, 3, default = 4), c(1,1,2,3,4,3)) -check("0019.012", nswitch(x2, TRUE, 1, FALSE, 2, default = 0), c(2,2,1,1,1,1)) -check("0019.013", nswitch(x3, 0, 1, 1, 2, 2, 3, default = 4), c(1,1,2,3,4,3)) -check("0019.014", nswitch(x4, 0+0i, 0, 1+0i, 1, 2+0i, 2, default = 3), c(0,0,1,2,3,2)) -check("0019.015", nswitch(x5, "0", 0, "1", 1, "2", 2, default = 3), c(0,0,1,2,3,2)) -check("0019.016", nswitch(x1, 0L, 1+0i, 1L, 2+0i, 2L, 3+0i, default = 4+0i), c(1+0i,1+0i,2+0i,3+0i,4+0i,3+0i)) -check("0019.017", nswitch(x2, TRUE, 1+0i, FALSE, 2+0i, default = 0+0i), c(2+0i,2+0i,1+0i,1+0i,1+0i,1+0i)) -check("0019.018", nswitch(x3, 0, 1+0i, 1, 2+0i, 2, 3+0i, default = 4+0i), c(1+0i,1+0i,2+0i,3+0i,4+0i,3+0i)) -check("0019.019", nswitch(x4, 0+0i, 0+0i, 1+0i, 1+0i, 2+0i, 2+0i, default = 3+0i), c(0+0i,0+0i,1+0i,2+0i,3+0i,2+0i)) -check("0019.020", nswitch(x5, "0", 0+0i, "1", 1+0i, "2", 2+0i, default = 3+0i), c(0+0i,0+0i,1+0i,2+0i,3+0i,2+0i)) -check("0019.021", nswitch(x1, 0L, "1+0i", 1L, "2+0i", 2L, "3+0i", default = "4+0i"), c("1+0i","1+0i","2+0i","3+0i","4+0i","3+0i")) -check("0019.022", nswitch(x2, TRUE, "1+0i", FALSE, "2+0i", default = "0+0i"), c("2+0i","2+0i","1+0i","1+0i","1+0i","1+0i")) -check("0019.023", nswitch(x3, 0, "1+0i", 1, "2+0i", 2, "3+0i", default = "4+0i"), c("1+0i","1+0i","2+0i","3+0i","4+0i","3+0i")) -check("0019.024", nswitch(x4, 0+0i, "0+0i", 1+0i, "1+0i", 2+0i, "2+0i", default = "3+0i"), c("0+0i","0+0i","1+0i","2+0i","3+0i","2+0i")) -check("0019.025", nswitch(x5, "0", "0+0i", "1", "1+0i", "2", "2+0i", default = "3+0i"), c("0+0i","0+0i","1+0i","2+0i","3+0i","2+0i")) -check("0019.026", nswitch(x1, 0L, FALSE, 1L, TRUE, 2L, TRUE, checkEnc = 2), error = "Argument 'checkEnc' must be TRUE or FALSE and length 1.") -check("0019.027", nswitch(x1, 0L, FALSE, 1L, TRUE, 2L), error = "Received 5 inputs; please supply an even number of arguments in ... consisting of target value, resulting output pairs (in that order). Note that argument 'default' must be named explicitly (e.g.: default=0)") -check("0019.028", nswitch(x1, 0L, FALSE, 1L, TRUE, 2L, TRUE, default = s1), error = "S4 class objects for argument 'na' are not supported.") -check("0019.029", nswitch(x1, 0L, FALSE, 1L, TRUE, 2L, TRUE, default = c(0L,1L)), error = "Length of 'default' must either be 1 or length of 'x'.") -check("0019.030", nswitch(x1, 0L, FALSE, 1L, TRUE, 2L, TRUE, default = 1), error = "Resulting value is of type logical but 'default' is of type double. Please make sure that both arguments have the same type.") -check("0019.031", nswitch(s1, 0L, FALSE, 1L, TRUE, 2L, TRUE), error = "S4 class objects for argument 'x' are not supported.") -check("0019.032", nswitch(x6, list(0L), FALSE, list(1L), TRUE, list(2L), TRUE, default = FALSE), c(FALSE,FALSE,TRUE,TRUE,FALSE,TRUE)) -check("0019.033", nswitch(x6, list(0L), 0L, list(1L), 1L, list(2L), 2L, default = 3L), c(0L,0L,1L,2L,3L,2L)) -check("0019.034", nswitch(x6, list(0L), 0, list(1L), 1, list(2L), 2, default = 3), c(0,0,1,2,3,2)) -check("0019.035", nswitch(x6, list(0L), 0+0i, list(1L), 1+0i, list(2L), 2+0i, default = 3+0i), c(0+0i,0+0i,1+0i,2+0i,3+0i,2+0i)) -check("0019.036", nswitch(x6, list(0L), "0", list(1L), "1", list(2L), "2", default = "3"), c("0","0","1","2","3","2")) -check("0019.037", nswitch(x6, 0L, list("0"), 1L, list("1"), 2L, list("2"), default = list("3")), error = "Type of 'x' and 'values' are different. Please make sure they are the same.") -check("0019.038", nswitch(x6, list(0L), list("0"), list(1L), list("1"), list(2L), list("2"), default = list("3")), list("0","0","1","2","3","2")) -check("0019.039", nswitch(x1, 0L, list("0"), 1L, list("1"), 2L, list("2"), default = list("3")), list("0","0","1","2","3","2")) -check("0019.040", nswitch(x2, TRUE, list("0"), FALSE, list("1"), default = list("3")), list("1","1","0","0","0","0")) -check("0019.041", nswitch(x3, 0, list("0"), 1, list("1"), 2, list("2"), default = list("3")), list("0","0","1","2","3","2")) -check("0019.042", nswitch(x4, 0+0i, list("0"), 1+0i, list("1"), 2+0i, list("2"), default = list("3")), list("0","0","1","2","3","2")) -check("0019.043", nswitch(x5, "0", list("0"), "1", list("1"), "2", list("2"), default = list("3")), list("0","0","1","2","3","2")) -check("0019.044", nswitch(x1, 0L, as.raw("00"), 1L, as.raw("01"), 2L, as.raw("02"), default = as.raw("03")), error = "Type raw is not supported for argument 'outputs'") -check("0019.045", nswitch(x1, 0L, 1, 1L, 2, 2L, 3, default = as.Date("2020-01-01")), error = "Resulting value has different class than 'default'. Please make sure that both arguments have the same class.") -check("0019.046", nswitch(as.raw(x1), as.raw(0L), 1, as.raw(1L), 2, as.raw(2L), 3, default = 4), error = "Type raw is not supported for argument 'x'.") -check("0019.047", nswitch(as.raw(x1), as.raw(0L), 1L, as.raw(1L), 2L, as.raw(2L), 3L, default = 4L), error = "Type raw is not supported for argument 'x'.") -check("0019.048", nswitch(as.raw(x1), as.raw(0L), 1+0i, as.raw(1L), 2+0i, as.raw(2L), 3+0i, default = 4+0i), error = "Type raw is not supported for argument 'x'.") -check("0019.049", nswitch(as.raw(x1), as.raw(0L), "1", as.raw(1L), "2", as.raw(2L), "3", default = "4"), error = "Type raw is not supported for argument 'x'.") -check("0019.050", nswitch(as.raw(x1), as.raw(0L), list(1), as.raw(1L), list(2), as.raw(2L), list(3), default = list(4)), error = "Type raw is not supported for argument 'x'.") -check("0019.051", nswitch(as.raw(x1), as.raw(0L), TRUE, as.raw(1L), FALSE), error = "Type raw is not supported for argument 'x'.") -check("0019.052", nswitch(x1, 0L, as.factor(1L), default = as.factor(4L)), error = "Resulting value and 'default' are both type factor but their levels are different.") -check("0019.053", nswitch(x1, 0L, as.factor(1L),1L, as.factor(2L), default = as.factor(1L)), error = "Items 2 and 4 of '...' are both factor but their levels are different.") -check("0019.054", nswitch(x1, 0L, 1, 1L, as.Date("2020-01-01"), default = 2), error = "Items 2 and 4 of '...' must have same class.") -check("0019.055", nswitch(x1, 0L, 1L, 1L, s1), error = "S4 class objects for argument '...' (item 2) are not supported.") -check("0019.056", nswitch(x1, 0L, 1L, 1L, c(2L,3L)), error = "Length of item 4 of '...' is different than 1 and length of 'x'. Please make sure that all items of 'output' have length 1 or length of 'x'(6).") -check("0019.057", nswitch(x1, 0L, 1L, 1L, 2, 2L, 3L), error = "Item 2 and 4 of '...' are not of the same type.") -check("0019.058", nswitch(x1, 0L, 1L, 1, 2L, 2L, 3L), error = "Item 1 and 3 of '...' are not of the same type.") -check("0019.059", nswitch(x1, c(0L,1L), 1L, 1L, 2L, 2L, 3L), error = "Length of item 1 of '...' is different than 1. Please make sure it has length 1.") -check("0019.060", nswitch(c(enc1,enc2),enc1,1),c(1,1)) -check("0019.061", nswitch(c(enc1,enc1),enc1,1),c(1,1)) -check("0019.062", nswitch(c(enc2,enc2),enc2,1),c(1,1)) -check("0019.063", nswitch(c(enc1,enc2),enc2,1),c(1,1)) -check("0019.064", nswitch(c(enc1,enc1),enc2,1),c(1,1)) -check("0019.065", nswitch(rep(1:4, each = 2), 1L, 1:8, 2L, 11:18, 3L, 21:28, 4L, 31:38), vswitch(x = rep(1:4, each = 2), values = c(1L,2L,3L,4L), outputs = list(1:8,11:18,21:28,31:38))) -check("0019.066", nswitch(rep(1:4, each = 2), 1L, as.numeric(1:8), 2L, as.numeric(11:18), 3L, as.numeric(21:28), 4L, as.numeric(31:38)), vswitch(x = rep(1:4, each = 2), values = c(1L,2L,3L,4L), outputs = list(as.numeric(1:8),as.numeric(11:18),as.numeric(21:28),as.numeric(31:38)))) -check("0019.067", nswitch(rep(1:4, each = 2), 1L, as.character(1:8), 2L, as.character(11:18), 3L, as.character(21:28), 4L, as.character(31:38)), vswitch(x = rep(1:4, each = 2), values = c(1L,2L,3L,4L), outputs = list(as.character(1:8),as.character(11:18),as.character(21:28),as.character(31:38)))) -check("0019.068", nswitch(rep(as.numeric(1:4), each = 2), 1, 1:8, 2, 11:18, 3, 21:28, 4, 31:38), vswitch(x = rep(as.numeric(1:4), each = 2), values = c(1,2,3,4), outputs = list(1:8,11:18,21:28,31:38))) -check("0019.069", nswitch(rep(as.numeric(1:4), each = 2), 1, as.numeric(1:8), 2, as.numeric(11:18), 3, as.numeric(21:28), 4, as.numeric(31:38)), vswitch(x = rep(as.numeric(1:4), each = 2), values = c(1,2,3,4), outputs = list(as.numeric(1:8),as.numeric(11:18),as.numeric(21:28),as.numeric(31:38)))) -check("0019.070", nswitch(rep(as.numeric(1:4), each = 2), 1, as.character(1:8), 2, as.character(11:18), 3, as.character(21:28), 4, as.character(31:38)), vswitch(x = rep(as.numeric(1:4), each = 2), values = c(1,2,3,4), outputs = list(as.character(1:8),as.character(11:18),as.character(21:28),as.character(31:38)))) - -rm(x1,x2,x3,x4,x5,x6,s1,s2,class2133, enc1, enc2) - -# -------------------------------------------------------------------------------------------------- -# psort -# -------------------------------------------------------------------------------------------------- - -x1 = c("a","ab","c","b","a","c") -x2 = c("aaaba","dfjasdlifjai","jiifjeogiejogp","aabaaaa","gsgj","gerph","aaaaaaa","htjltjlrth", - "joasdjfisdjfdo","hthe","aaaaaba","j","a","jrykpjl","hkoptjltp","aaaaaa","lprrjt") -x3 = sample(c(letters,LETTERS),1e4,TRUE) -x4 = c("a","ab","c","b","a",NA,"c") -x5 = c("a","ab","c","b"," ","a",NA,"c") -x6 = c("a","ab","c","b"," "," ","a",NA," d","c") -x7 = c("a","ab","c","b"," ","a","",NA," ","c") -x8 = c("b","a","d","c",NA,"") -x9 = sample(c("a","ab","c","b"," ","","a",NA," d","c"), 1e4, TRUE) -x10 = c("b","a","A","B","\xe4","d","c",NA) -Encoding(x10) = "UTF-8" -Encoding(x10[5]) = "latin1" -x11 = rep(x10,3L) - -check("0020.001", psort(c(2L,1L,3L),c.locale = FALSE),sort(c(2L,1L,3L)),warning = "Function 'psort' was only implemented for character vectors. Defaulting to base::sort.") -check("0020.002", psort(x1),sort(x1)) -check("0020.003", psort(x1,decreasing = TRUE),sort(x1,decreasing = TRUE)) -check("0020.004", psort(x2),sort(x2)) -check("0020.005", psort(x2,decreasing = TRUE),sort(x2,decreasing = TRUE)) -check("0020.006", psort(x3,c.locale = FALSE),sort(x3)) -check("0020.007", psort(x3,decreasing = TRUE,c.locale = FALSE),sort(x3,decreasing = TRUE)) -check("0020.008", psort(x4,na.last = TRUE), sort(x4,na.last = TRUE)) -check("0020.009", psort(x4,na.last = FALSE),sort(x4,na.last = FALSE)) -check("0020.010", psort(x5,na.last = TRUE), sort(x5,na.last = TRUE)) -check("0020.011", psort(x5,na.last = FALSE),sort(x5,na.last = FALSE)) -check("0020.012", psort(x6,na.last = TRUE), sort(x6,na.last = TRUE)) -check("0020.013", psort(x6,na.last = FALSE),sort(x6,na.last = FALSE)) -check("0020.014", psort(x7,na.last = TRUE),sort(x7,na.last = TRUE)) -check("0020.015", psort(x7,na.last = FALSE), sort(x7,na.last = FALSE)) -check("0020.016", psort(x4,na.last = TRUE,decreasing = TRUE), sort(x4,na.last = TRUE,decreasing = TRUE)) -check("0020.017", psort(x4,na.last = FALSE,decreasing = TRUE),sort(x4,na.last = FALSE,decreasing = TRUE)) -check("0020.018", psort(x5,na.last = TRUE,decreasing = TRUE), sort(x5,na.last = TRUE,decreasing = TRUE)) -check("0020.019", psort(x5,na.last = FALSE,decreasing = TRUE),sort(x5,na.last = FALSE,decreasing = TRUE)) -check("0020.020", psort(x6,na.last = TRUE,decreasing = TRUE), sort(x6,na.last = TRUE,decreasing = TRUE)) -check("0020.021", psort(x6,na.last = FALSE,decreasing = TRUE),sort(x6,na.last = FALSE,decreasing = TRUE)) -check("0020.022", psort(x7,na.last = TRUE,decreasing = TRUE),sort(x7,na.last = TRUE,decreasing = TRUE)) -check("0020.023", psort(x7,na.last = FALSE,decreasing = TRUE), sort(x7,na.last = FALSE,decreasing = TRUE)) -check("0020.024", psort(x4,na.last = NA), sort(x4,na.last = NA)) -check("0020.025", psort(x5,na.last = NA), sort(x5,na.last = NA)) -check("0020.026", psort(x6,na.last = NA), sort(x6,na.last = NA)) -check("0020.027", psort(x7,na.last = NA),sort(x7,na.last = NA)) -check("0020.028", psort(x4,na.last = NA,decreasing = TRUE), sort(x4,na.last = NA,decreasing = TRUE)) -check("0020.029", psort(x5,na.last = NA,decreasing = TRUE), sort(x5,na.last = NA,decreasing = TRUE)) -check("0020.030", psort(x6,na.last = NA,decreasing = TRUE), sort(x6,na.last = NA,decreasing = TRUE)) -check("0020.031", psort(x7,na.last = NA,decreasing = TRUE), sort(x7,na.last = NA,decreasing = TRUE)) -check("0020.032", psort(x8,na.last = TRUE),sort(x8,na.last = TRUE)) -check("0020.033", psort(x8,na.last = FALSE), sort(x8,na.last = FALSE)) -check("0020.034", psort(x8,na.last = TRUE,decreasing = TRUE),sort(x8,na.last = TRUE,decreasing = TRUE)) -check("0020.035", psort(x8,na.last = FALSE,decreasing = TRUE), sort(x8,na.last = FALSE,decreasing = TRUE)) -check("0020.036", psort(x8,na.last = NA),sort(x8,na.last = NA)) -check("0020.037", psort(x8,na.last = NA,decreasing = TRUE),sort(x8,na.last = NA,decreasing = TRUE)) -# check("0020.038", psort(x9,index.return = TRUE,na.last = TRUE),order(x9,na.last = TRUE)) -# check("0020.039", psort(x9,index.return = TRUE,decreasing = TRUE,na.last = TRUE),order(x9,decreasing = TRUE,na.last = TRUE)) -# check("0020.040", psort(x9,index.return = TRUE,na.last = FALSE),order(x9,na.last = FALSE)) -# check("0020.041", psort(x9,index.return = TRUE,decreasing = TRUE,na.last = FALSE),order(x9,decreasing = TRUE,na.last = FALSE)) -# check("0020.042", psort(x9,index.return = TRUE,na.last = NA),order(x9,na.last = NA)) -# check("0020.043", psort(x9,index.return = TRUE,decreasing = TRUE,na.last = NA),order(x9,decreasing = TRUE,na.last = NA)) -# check("0020.044", psort(x8,index.return = TRUE,na.last = TRUE),order(x8,na.last = TRUE)) -# check("0020.045", psort(x8,index.return = TRUE,decreasing = TRUE,na.last = TRUE),order(x8,decreasing = TRUE,na.last = TRUE)) -# check("0020.046", psort(x8,index.return = TRUE,na.last = FALSE),order(x8,na.last = FALSE)) -# check("0020.047", psort(x8,index.return = TRUE,decreasing = TRUE,na.last = FALSE),order(x8,decreasing = TRUE,na.last = FALSE)) -# check("0020.048", psort(x8,index.return = TRUE,na.last = NA),order(x8,na.last = NA)) -# check("0020.049", psort(x8,index.return = TRUE,decreasing = TRUE,na.last = NA),order(x8,decreasing = TRUE,na.last = NA)) -check("0020.050", psort(x10,c.locale = FALSE),sort(x10)) -check("0020.051", psort(x10,decreasing = TRUE,c.locale = FALSE),sort(x10,decreasing = TRUE)) -check("0020.052", psort(x1,na.last = 2),error = "Argument 'na.last' must be TRUE, FALSE or NA.") -check("0020.053", psort(x1,decreasing = 2),error = "Argument 'decreasing' must be TRUE or FALSE.") -# check("0020.054", psort(x1,na.last = 2,index.return = TRUE),error = "Argument 'na.last' must be TRUE, FALSE or NA.") -# check("0020.055", psort(x1,decreasing = 2,index.return = TRUE),error = "Argument 'decreasing' must be TRUE or FALSE.") -check("0020.056", psort(c("2L","1L","3L"),nThread=1), error="Argument 'nThread' (double) must be of type integer.") -# check("0020.057", psort(c("2L","1L","3L"),index.return=1), error="Argument 'index.return' must be TRUE or FALSE.") -check("0020.058", psort(x1,c.locale = NA),error = "Argument 'c.locale' must be TRUE or FALSE.") -check("0020.059", psort(x1,c.locale = TRUE),sort(x1,method="radix")) -check("0020.060", psort(x1,decreasing = TRUE,c.locale = TRUE),sort(x1,decreasing = TRUE,method="radix")) -check("0020.061", psort(x2,c.locale = TRUE),sort(x2,method="radix")) -check("0020.062", psort(x2,decreasing = TRUE,c.locale = TRUE),sort(x2,decreasing = TRUE,method="radix")) -check("0020.063", psort(x6,c.locale = TRUE),sort(x6,method="radix")) -check("0020.064", psort(x6,decreasing = TRUE,c.locale = TRUE),sort(x6,decreasing = TRUE,method="radix")) -check("0020.065", psort(x6,c.locale = TRUE,na.last = TRUE),sort(x6,method="radix",na.last = TRUE)) -check("0020.066", psort(x6,decreasing = TRUE,c.locale = TRUE,na.last = TRUE),sort(x6,decreasing = TRUE,method="radix",na.last = TRUE)) -check("0020.067", psort(x6,c.locale = TRUE,na.last = FALSE),sort(x6,method="radix",na.last = FALSE)) -check("0020.068", psort(x6,decreasing = TRUE,c.locale = TRUE,na.last = FALSE),sort(x6,decreasing = TRUE,method="radix",na.last = FALSE)) -check("0020.069", psort(x10,c.locale = TRUE),sort(x10,method="radix")) -check("0020.070", psort(x10,decreasing = TRUE,c.locale = TRUE),sort(x10,decreasing = TRUE,method="radix")) -check("0020.071", psort(x11,c.locale = TRUE),sort(x11,method="radix")) -check("0020.072", psort(x11,decreasing = TRUE,c.locale = TRUE),sort(x11,decreasing = TRUE,method="radix")) -check("0020.073", psort(x11,c.locale = FALSE),sort(x11)) -check("0020.074", psort(x11,decreasing = TRUE,c.locale = FALSE),sort(x11,decreasing = TRUE)) - -rm(x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11) - -# -------------------------------------------------------------------------------------------------- -# charToFact -# -------------------------------------------------------------------------------------------------- - -x1 = sample(c(letters,LETTERS),1e2,TRUE) - -check("0021.001", charToFact(c("a","b")), as.factor(c("a","b"))) -check("0021.002", charToFact(c("a","b","a")), as.factor(c("a","b","a"))) -check("0021.003", charToFact(x1), as.factor(x1)) -check("0021.004", charToFact(c("2L","1L","3L"),nThread=1), error="Argument 'nThread' (double) must be of type integer.") -check("0021.005", charToFact(1L), error="Argument 'x' must be of type character.") -check("0021.006", charToFact(c("a","b",NA,"a")), addNA(as.factor(c("a","b",NA,"a")))) -check("0021.007", levels(charToFact(x1,decreasing = TRUE)), sort(levels(as.factor(x1)),decreasing = TRUE)) -check("0021.008", charToFact(c("a","b"),addNA=NA), error="Argument 'addNA' must be TRUE or FALSE.") -check("0021.009", charToFact(c("a","b",NA,"a"), addNA=FALSE), as.factor(c("a","b",NA,"a"))) -check("0021.010", charToFact(c("a","b",NA,"c")), addNA(as.factor(c("a","b",NA,"c")))) -check("0021.011", charToFact(c("a","b",NA,"c"),addNA=FALSE), as.factor(c("a","b",NA,"c"))) -check("0021.012", charToFact(c("a",NA,"b")), addNA(as.factor(c("a",NA,"b")))) -check("0021.013", charToFact(c("a",NA,"a","b")), addNA(as.factor(c("a",NA,"a","b")))) -check("0021.014", charToFact(c("a",NA,"aa","b")), addNA(as.factor(c("a",NA,"aa","b")))) -check("0021.015", charToFact(c("a",NA,"aa")), addNA(as.factor(c("a",NA,"aa")))) - -rm(x1) - -# -------------------------------------------------------------------------------------------------- -# shareData -# -------------------------------------------------------------------------------------------------- - -x = tryCatch(shareData(mtcars,"share1"), error=function(err) { - cat("Skipping shareData tests:", conditionMessage(err), "\n") - NULL -}) - -if (!is.null(x)) { - check("0022.001", getData("share1"), mtcars) - check("0022.002", clearData(x), TRUE) -} - -rm(x) - -# -------------------------------------------------------------------------------------------------- -# pcountNA -# -------------------------------------------------------------------------------------------------- - -v = c("hello",NA,"bye","john") -w = c(NA_integer_,2L,8L,9L) -x = c(1, 3, NA, 5) -y = c(2, NA, 4, 1) -z = c(3, 4, 4, 1) - -d1 = c(as.Date("2020-06-22"),as.Date("2020-06-23"),as.Date("2020-06-22"),NA) -f1 = factor(c("a","b","c",NA), c("a","b","c",NA)) - -check("0023.001", pcountNA(x), c(0L,0L,1L,0L)) -check("0023.002", pcountNA(x, y), c(0L,1L,1L,0L)) -check("0023.003", pcountNA(x, y, z), c(0L,1L,1L,0L)) -check("0023.004", pcountNA(x, y, z, v), c(0L,2L,1L,0L)) -check("0023.005", pcountNA(x, y, z, v, w), c(1L,2L,1L,0L)) -check("0023.006", pcountNA(data.frame(x, y, z, v, w, f1, d1)), c(1L,2L,1L,2L)) - -# -------------------------------------------------------------------------------------------------- -# pallNA -# -------------------------------------------------------------------------------------------------- - -check("0024.001", pallNA(data.frame(x, y, z, v, w, f1, d1)), c(FALSE, FALSE, FALSE, FALSE)) -check("0024.002", pallNA(data.frame(x, x, x, x)), c(FALSE, FALSE, TRUE, FALSE)) -check("0024.003", pallNA(v), c(FALSE, TRUE, FALSE, FALSE)) -check("0024.004", pallNA(w), c(TRUE, FALSE, FALSE, FALSE)) -check("0024.005", pallNA(x), c(FALSE, FALSE, TRUE, FALSE)) - -# -------------------------------------------------------------------------------------------------- -# pallv -# -------------------------------------------------------------------------------------------------- - -check("0025.001", pallv(data.frame(a=c(1,1,2,2),b=c(1,2,1,2)),value=1), c(TRUE, FALSE, FALSE, FALSE)) -check("0025.002", pallv(v, value = "bye"), c(FALSE, FALSE, TRUE, FALSE)) -check("0025.003", pallv(x, x, value = 3), c(FALSE, TRUE, FALSE, FALSE)) -check("0025.004", pallv(w, value = 8L), c(FALSE, FALSE, TRUE, FALSE)) - -# -------------------------------------------------------------------------------------------------- -# panyv -# -------------------------------------------------------------------------------------------------- - -check("0026.001", panyv(data.frame(a=c(1,1,2,2),b=c(1,2,1,2)),value=1), c(TRUE, TRUE, TRUE, FALSE)) -check("0026.002", panyv(v, value = "bye"), c(FALSE, FALSE, TRUE, FALSE)) -check("0026.003", panyv(x, y, value = 1), c(TRUE, FALSE, FALSE, TRUE)) -check("0026.004", panyv(w, value = 8L), c(FALSE, FALSE, TRUE, FALSE)) - -# -------------------------------------------------------------------------------------------------- -# panyNA -# -------------------------------------------------------------------------------------------------- - -check("0027.001", panyNA(data.frame(x, y, z, v, w, f1, d1)), c(TRUE, TRUE, TRUE, TRUE)) -check("0027.002", panyNA(data.frame(y, z, v, w, f1, d1)), c(TRUE, TRUE, FALSE, TRUE)) -check("0027.003", panyNA(v), c(FALSE, TRUE, FALSE, FALSE)) -check("0027.004", panyNA(w), c(TRUE, FALSE, FALSE, FALSE)) -check("0027.005", panyNA(x), c(FALSE, FALSE, TRUE, FALSE)) - -rm(v,w,x,y,z,f1,d1) - -# -------------------------------------------------------------------------------------------------- -# pfirst and plast -# -------------------------------------------------------------------------------------------------- - -x = c(1, 3, NA, 5) -y = c(2, NA, 4, 1) -z = c(3, 4, 4, NA) -x1 = sample(c("a","b",NA),1e2,TRUE) -y1 = sample(c("c","d",NA),1e2,TRUE) -z1 = sample(c("e","f",NA),1e2,TRUE) - -base_pfirst <- function(...) { - x = if(...length() == 1L && is.list(..1)) unclass(..1) else list(...) - res = x[[1]] - if(length(x) == 1L) return(res) - for(i in 2:length(x)) { - miss <- is.na(res) - res[miss] <- x[[i]][miss] - } - res -} - -base_plast <- function(...) { - x = if(...length() == 1L && is.list(..1)) unclass(..1) else list(...) - n = length(x) - res = x[[n]] - if(n == 1L) return(res) - for(i in (n-1):1) { - miss <- is.na(res) - res[miss] <- x[[i]][miss] - } - res -} - -check("0028.001", pfirst(x, y, z), base_pfirst(x, y, z)) -check("0028.002", plast(x, y, z), base_plast(x, y, z)) -check("0028.003", pfirst(y, z, x), base_pfirst(y, z, x)) -check("0028.004", plast(y, z, x), base_plast(y, z, x)) - -check("0028.005", pfirst(x1, y1, z1), base_pfirst(x1, y1, z1)) -check("0028.006", plast(x1, y1, z1), base_plast(x1, y1, z1)) -check("0028.007", pfirst(y1, z1, x1), base_pfirst(y1, z1, x1)) -check("0028.008", plast(y1, z1, x1), base_plast(y1, z1, x1)) - -check("0028.009", pfirst(list(x1, y1, z1)), base_pfirst(list(x1, y1, z1))) -check("0028.010", plast(list(x1, y1, z1)), base_plast(list(x1, y1, z1))) -check("0028.011", pfirst(data.frame(y1, z1, x1)), base_pfirst(data.frame(y1, z1, x1))) -check("0028.012", plast(data.frame(y1, z1, x1)), base_plast(data.frame(y1, z1, x1))) - -check("0028.013", pfirst(list(1, NULL), list(NULL, 2)), list(1, 2)) -check("0028.014", plast(list(1, NULL), list(NULL, 2)), list(1, 2)) - -check("0028.015", pfirst(as.character(z), y), error = "All arguments need to have the same data type, except for numeric and logical types") -check("0028.016", pfirst(x, y, 1:2), error = "Argument 3 is of length 2 but argument 1 is of length 4. If you wish to 'recycle' your argument, please use rep() to make this intent clear to the readers of your code.") -check("0028.017", pfirst(1:10, 1:5), error = "Argument 2 is of length 5 but argument 1 is of length 10. If you wish to 'recycle' your argument, please use rep() to make this intent clear to the readers of your code.") -check("0028.018", pfirst(x, as.list(z), y), error = "All arguments need to have the same data type, except for numeric and logical types") - -check("0028.019", typeof(pfirst(1:4, x)), "double") -check("0028.020", typeof(pfirst(x, 1:4)), "double") - -check("0028.021", pfirst(as.factor(x), x), error = "If one argument is a factor, all arguments need to be factors") -check("0028.022", pfirst(x, as.factor(x)), error = "If one argument is a factor, all arguments need to be factors") -check("0028.023", pfirst(as.factor(x), as.factor(y)), error = "All factors need to have identical levels") -check("0028.024", class(pfirst(as.factor(x1), as.factor(x1))), "factor") - -rm(x, y, z, x1, y1, z1, base_pfirst, base_plast) - -# -------------------------------------------------------------------------------------------------- -# CLEAN FUNCTIONS -# -------------------------------------------------------------------------------------------------- - -rm(check,count,countNA,countOccur,fduplicated,fpos,funique,iif,nswitch,nif,pall,pany,pcount,pcountNA, - pmean,pprod,psum,setlevels,topn,uniqLen,vswitch,psort,charToFact,shareData,getData,clearData, - pallNA, pallv, panyv, panyNA, pfirst, plast, fpmax, fpmin, prange) - -# -------------------------------------------------------------------------------------------------- -# END -# -------------------------------------------------------------------------------------------------- - diff --git a/tests/testthat.R b/tests/testthat.R new file mode 100644 index 0000000..82b6ba2 --- /dev/null +++ b/tests/testthat.R @@ -0,0 +1,4 @@ +library(testthat) +library(kit) + +test_check("kit") diff --git a/tests/testthat/helper-kit.R b/tests/testthat/helper-kit.R new file mode 100644 index 0000000..e18e0f6 --- /dev/null +++ b/tests/testthat/helper-kit.R @@ -0,0 +1,18 @@ +# Helper for legacy tolerant comparisons (issue #54) +# Mirrors the old tests/test_kit.R check() value logic: +# pass if identical() OR (atomic + all.equal() + same typeof()) +# Needed for 31 cases where identical() is FALSE but all.equal() is TRUE, +# e.g. complex NA imaginary part (NA vs 0) and C-vs-R floating-point summation +# order differences in pmean(). testthat 3e expect_equal() (waldo) is strict +# about these and would fail, while the legacy suite passed. +expect_kit_equal <- function(object, expected) { + ok <- identical(object, expected) || + (is.atomic(object) && is.atomic(expected) && + isTRUE(all.equal(object, expected, check.names = !isTRUE(expected))) && + typeof(object) == typeof(expected)) + testthat::expect( + ok, + failure_message = "kit legacy tolerant check failed (identical() FALSE and all.equal()+typeof() FALSE)" + ) + invisible(NULL) +} diff --git a/tests/testthat/test-charToFact.R b/tests/testthat/test-charToFact.R new file mode 100644 index 0000000..a883787 --- /dev/null +++ b/tests/testthat/test-charToFact.R @@ -0,0 +1,87 @@ +# Tests for charToFact() — character to factor +# Migrated from tests/test_kit.R (custom check() suite) to testthat 3e — see issue #54. +# Each legacy check("id", actual, expected) maps to expect_identical(); +# 31 tolerant cases (identical FALSE but all.equal+typeof TRUE) use expect_kit_equal(); +# check(..., error=) maps to expect_error(regexp=, fixed=TRUE). +# Legacy IDs are preserved as test_that() labels (prefixed by function for uniqueness). +# Setup and expectations stay interleaved in legacy order: later sections may +# redefine x/y/out_vec/... so setup must not be hoisted above earlier tests. + +set.seed(123) + +x1 = sample(c(letters,LETTERS),1e2,TRUE) + +test_that("charToFact-0021.001", { + expect_identical(charToFact(c("a","b")), as.factor(c("a","b"))) +}) + + +test_that("charToFact-0021.002", { + expect_identical(charToFact(c("a","b","a")), as.factor(c("a","b","a"))) +}) + + +test_that("charToFact-0021.003", { + expect_identical(charToFact(x1), as.factor(x1)) +}) + + +test_that("charToFact-0021.004", { + expect_error(charToFact(c("2L","1L","3L"),nThread=1), regexp = "Argument 'nThread' (double) must be of type integer.", fixed = TRUE) +}) + + +test_that("charToFact-0021.005", { + expect_error(charToFact(1L), regexp = "Argument 'x' must be of type character.", fixed = TRUE) +}) + + +test_that("charToFact-0021.006", { + expect_identical(charToFact(c("a","b",NA,"a")), addNA(as.factor(c("a","b",NA,"a")))) +}) + + +test_that("levels-0021.007", { + expect_identical(levels(charToFact(x1,decreasing = TRUE)), sort(levels(as.factor(x1)),decreasing = TRUE)) +}) + + +test_that("charToFact-0021.008", { + expect_error(charToFact(c("a","b"),addNA=NA), regexp = "Argument 'addNA' must be TRUE or FALSE.", fixed = TRUE) +}) + + +test_that("charToFact-0021.009", { + expect_identical(charToFact(c("a","b",NA,"a"), addNA=FALSE), as.factor(c("a","b",NA,"a"))) +}) + + +test_that("charToFact-0021.010", { + expect_identical(charToFact(c("a","b",NA,"c")), addNA(as.factor(c("a","b",NA,"c")))) +}) + + +test_that("charToFact-0021.011", { + expect_identical(charToFact(c("a","b",NA,"c"),addNA=FALSE), as.factor(c("a","b",NA,"c"))) +}) + + +test_that("charToFact-0021.012", { + expect_identical(charToFact(c("a",NA,"b")), addNA(as.factor(c("a",NA,"b")))) +}) + + +test_that("charToFact-0021.013", { + expect_identical(charToFact(c("a",NA,"a","b")), addNA(as.factor(c("a",NA,"a","b")))) +}) + + +test_that("charToFact-0021.014", { + expect_identical(charToFact(c("a",NA,"aa","b")), addNA(as.factor(c("a",NA,"aa","b")))) +}) + + +test_that("charToFact-0021.015", { + expect_identical(charToFact(c("a",NA,"aa")), addNA(as.factor(c("a",NA,"aa")))) +}) + diff --git a/tests/testthat/test-count.R b/tests/testthat/test-count.R new file mode 100644 index 0000000..bf4cc25 --- /dev/null +++ b/tests/testthat/test-count.R @@ -0,0 +1,367 @@ +# Tests for counting — countNA, count, pcount, pcountNA, pallNA, pallv, panyv, panyNA +# Migrated from tests/test_kit.R (custom check() suite) to testthat 3e — see issue #54. +# Each legacy check("id", actual, expected) maps to expect_identical(); +# 31 tolerant cases (identical FALSE but all.equal+typeof TRUE) use expect_kit_equal(); +# check(..., error=) maps to expect_error(regexp=, fixed=TRUE). +# Legacy IDs are preserved as test_that() labels (prefixed by function for uniqueness). +# Setup and expectations stay interleaved in legacy order: later sections may +# redefine x/y/out_vec/... so setup must not be hoisted above earlier tests. + +set.seed(123) + +x = c(0L,1L,2L,NA_integer_) + +test_that("countNA-0012.001", { + expect_identical(countNA(x), sum(is.na(x))) +}) + + +test_that("countNA-0012.002", { + expect_identical(countNA(as.logical(x)), sum(is.na(as.logical(x)))) +}) + + +test_that("countNA-0012.003", { + expect_identical(countNA(as.numeric(x)), sum(is.na(as.numeric(x)))) +}) + + +test_that("countNA-0012.004", { + expect_identical(countNA(as.complex(x)), sum(is.na(as.complex(x)))) +}) + + +test_that("countNA-0012.005", { + expect_identical(countNA(as.character(x)), sum(is.na(as.character(x)))) +}) + + +test_that("countNA-0012.006", { + expect_identical(countNA(as.list(x)), list(0L,0L,0L,1L)) +}) + + +test_that("countNA-0012.007", { + expect_identical(countNA(NaN), sum(is.na(NaN))) +}) + + +test_that("countNA-0012.008", { + expect_error(countNA(as.raw("0")), regexp = "Type raw is not supported.", fixed = TRUE) +}) + + +test_that("countNA-0012.009", { + expect_identical(countNA(NULL), 0L) +}) + + +test_that("countNA-0012.010", { + expect_identical(countNA(list(c(0L,1L,2L,NA_integer_),NULL)), list(1L,0L)) +}) + + +test_that("countNA-0012.011", { + expect_identical(countNA(list(x,list(x,1),1)), list(1L,list(1L,0L),0L)) +}) + +x = c(0L,1L,2L,NA_integer_) + +test_that("count-0013.001", { + expect_identical(count(x, 1L), sum(x == 1L,na.rm = TRUE)) +}) + + +test_that("count-0013.002", { + expect_identical(count(as.logical(x), TRUE), sum(as.logical(x) == TRUE,na.rm = TRUE)) +}) + + +test_that("count-0013.003", { + expect_identical(count(as.numeric(x), 1), sum(as.numeric(x) == 1,na.rm = TRUE)) +}) + + +test_that("count-0013.004", { + expect_identical(count(as.complex(x), 1+0i), sum(as.complex(x) == 1+0i,na.rm = TRUE)) +}) + + +test_that("count-0013.005", { + expect_identical(count(as.character(x), "2"), sum(as.character(x) == "2",na.rm = TRUE)) +}) + + +test_that("count-0013.006", { + expect_error(count(NULL,NA), regexp = "Type of 'value' (logical) is different than type of 'x' (NULL). Please make sure both have the same type.", fixed = TRUE) +}) + + +test_that("count-0013.007", { + expect_identical(count(NaN, NA_real_), 0L) +}) + + +test_that("count-0013.008", { + expect_error(count(as.raw("00"),as.raw("01")), regexp = "Type raw is not supported.", fixed = TRUE) +}) + + +test_that("count-0013.009", { + expect_error(count(NULL,NULL), regexp = "Argument 'value' must be non NULL and length 1.", fixed = TRUE) +}) + + +test_that("count-0013.010", { + expect_identical(count(c(as.Date("2020-06-20"),as.Date("2020-06-21")), as.Date("2020-06-20")), 1L) +}) + + +test_that("count-0013.011", { + expect_error(count(c(as.Date("2020-06-20"),as.Date("2020-06-21")), 0), regexp = "'x' has different class than 'y'. Please make sure that both arguments have the same class.", fixed = TRUE) +}) + + +test_that("count-0013.012", { + expect_error(count(iris$Species, factor("setosa","setosa")), regexp = "'x' and 'y' are both type factor but their levels are different.", fixed = TRUE) +}) + + +test_that("count-0013.013", { + expect_identical(count(iris$Species, iris$Species[1]), 50L) +}) + +x = c(1, 3, NA, 5) +y = c(2, NA, 4, 1) +z = c(3, 4, 4, 1) +d1 = c(as.Date("2020-06-20"),as.Date("2020-06-21"),as.Date("2020-06-20"),as.Date("2020-06-21")) +d2 = c(as.Date("2020-06-22"),as.Date("2020-06-23"),as.Date("2020-06-22"),as.Date("2020-06-23")) +f1 = factor(c("a","b","c","d"), c("a","b","c","d")) +f2 = factor(c("a","a","c","a"), c("a","b","c","d")) + +test_that("pcount-0014.001", { + expect_identical(pcount(x, value = 3), sapply(1:4, function(i) count(x[i], 3))) +}) + + +test_that("pcount-0014.002", { + expect_identical(pcount(as.integer(x), value = 3L), sapply(1:4, function(i) count(as.integer(x[i]), 3L))) +}) + + +test_that("pcount-0014.003", { + expect_identical(pcount(as.character(x), value = "3"), sapply(1:4, function(i) count(as.character(x[i]), "3"))) +}) + + +test_that("pcount-0014.004", { + expect_identical(pcount(as.complex(x), value = 3+0i), sapply(1:4, function(i) count(as.complex(x[i]), 3+0i))) +}) + + +test_that("pcount-0014.005", { + expect_identical(pcount(as.logical(x), value = TRUE), sapply(1:4, function(i) count(as.logical(x[i]), TRUE))) +}) + + +test_that("pcount-0014.006", { + expect_error(pcount(as.logical(x), value = NULL), regexp = "argument is of length zero", fixed = TRUE) +}) + + +test_that("pcount-0014.007", { + expect_identical(pcount(x, value = NA_real_), c(0L,0L,1L,0L)) +}) + + +test_that("pcount-0014.008", { + expect_error(pcount(value = TRUE), regexp = "Please supply at least 1 argument. (0 argument supplied)", fixed = TRUE) +}) + + +test_that("pcount-0014.009", { + expect_identical(pcount(x,y,z,value = 3), c(1L,1L,0L,0L)) +}) + + +test_that("pcount-0014.010", { + expect_identical(pcount(x,y,z,value = 4), c(0L,1L,2L,0L)) +}) + + +test_that("pcount-0014.011", { + expect_error(pcount(x,y,z[1:3],value = 4), regexp = "Argument 3 is of length 3 but argument 1 is of length 4. If you wish to 'recycle' your argument, please use rep() to make this intent clear to the readers of your code.", fixed = TRUE) +}) + + +test_that("pcount-0014.012", { + expect_error(pcount(x,y,as.logical(z),value = 4), regexp = "Type of argument 3 is logical but argument 1 is of type double. Please make sure both have the same type.", fixed = TRUE) +}) + + +test_that("pcount-0014.013", { + expect_error(pcount(x,y,z,value = 4L), regexp = "Type of 'value' (integer) is different than type of Argument 1 (double). Please make sure both have the same type.", fixed = TRUE) +}) + + +test_that("pcount-0014.014", { + expect_error(pcount(list(x),y,z,value = 4), regexp = "Argument 1 is of type list. Only logical, integer, double, complex and character types are supported.", fixed = TRUE) +}) + + +test_that("pcount-0014.015", { + expect_identical(pcount(d1, d2, value = as.Date("2020-06-20")), c(1L, 0L, 1L, 0L)) +}) + + +test_that("pcount-0014.016", { + expect_error(pcount(d1, d2, value = 5), regexp = "Class of 'value' is different than class of Argument 1. Please make sure both have the same class.", fixed = TRUE) +}) + + +test_that("pcount-0014.017", { + expect_error(pcount(d1, c(1,2,3,4), value = as.Date("2020-06-20")), regexp = "Class of 'value' is different than class of Argument 2. Please make sure both have the same class.", fixed = TRUE) +}) + + +test_that("pcount-0014.018", { + expect_identical(pcount(f1, f2, value = factor("a", c("a","b","c","d"))), c(2L, 1L, 0L, 1L)) +}) + + +test_that("pcount-0014.019", { + expect_error(pcount(f1, f2, value = factor("a", c("a","b","c"))), regexp = "Levels of 'value' are different than levels of Argument 1. Please make sure both have the same levels.", fixed = TRUE) +}) + + +test_that("pcount-0014.020", { + expect_error(pcount(f1, factor("a", c("a","b","c")), value = factor("a", c("a","b","c","d"))), regexp = "Levels of 'value' are different than levels of Argument 2. Please make sure both have the same levels.", fixed = TRUE) +}) + +v = c("hello",NA,"bye","john") +w = c(NA_integer_,2L,8L,9L) +x = c(1, 3, NA, 5) +y = c(2, NA, 4, 1) +z = c(3, 4, 4, 1) +d1 = c(as.Date("2020-06-22"),as.Date("2020-06-23"),as.Date("2020-06-22"),NA) +f1 = factor(c("a","b","c",NA), c("a","b","c",NA)) + +test_that("pcountNA-0023.001", { + expect_identical(pcountNA(x), c(0L,0L,1L,0L)) +}) + + +test_that("pcountNA-0023.002", { + expect_identical(pcountNA(x, y), c(0L,1L,1L,0L)) +}) + + +test_that("pcountNA-0023.003", { + expect_identical(pcountNA(x, y, z), c(0L,1L,1L,0L)) +}) + + +test_that("pcountNA-0023.004", { + expect_identical(pcountNA(x, y, z, v), c(0L,2L,1L,0L)) +}) + + +test_that("pcountNA-0023.005", { + expect_identical(pcountNA(x, y, z, v, w), c(1L,2L,1L,0L)) +}) + + +test_that("pcountNA-0023.006", { + expect_identical(pcountNA(data.frame(x, y, z, v, w, f1, d1)), c(1L,2L,1L,2L)) +}) + + +test_that("pallNA-0024.001", { + expect_identical(pallNA(data.frame(x, y, z, v, w, f1, d1)), c(FALSE, FALSE, FALSE, FALSE)) +}) + + +test_that("pallNA-0024.002", { + expect_identical(pallNA(data.frame(x, x, x, x)), c(FALSE, FALSE, TRUE, FALSE)) +}) + + +test_that("pallNA-0024.003", { + expect_identical(pallNA(v), c(FALSE, TRUE, FALSE, FALSE)) +}) + + +test_that("pallNA-0024.004", { + expect_identical(pallNA(w), c(TRUE, FALSE, FALSE, FALSE)) +}) + + +test_that("pallNA-0024.005", { + expect_identical(pallNA(x), c(FALSE, FALSE, TRUE, FALSE)) +}) + + +test_that("pallv-0025.001", { + expect_identical(pallv(data.frame(a=c(1,1,2,2),b=c(1,2,1,2)),value=1), c(TRUE, FALSE, FALSE, FALSE)) +}) + + +test_that("pallv-0025.002", { + expect_identical(pallv(v, value = "bye"), c(FALSE, FALSE, TRUE, FALSE)) +}) + + +test_that("pallv-0025.003", { + expect_identical(pallv(x, x, value = 3), c(FALSE, TRUE, FALSE, FALSE)) +}) + + +test_that("pallv-0025.004", { + expect_identical(pallv(w, value = 8L), c(FALSE, FALSE, TRUE, FALSE)) +}) + + +test_that("panyv-0026.001", { + expect_identical(panyv(data.frame(a=c(1,1,2,2),b=c(1,2,1,2)),value=1), c(TRUE, TRUE, TRUE, FALSE)) +}) + + +test_that("panyv-0026.002", { + expect_identical(panyv(v, value = "bye"), c(FALSE, FALSE, TRUE, FALSE)) +}) + + +test_that("panyv-0026.003", { + expect_identical(panyv(x, y, value = 1), c(TRUE, FALSE, FALSE, TRUE)) +}) + + +test_that("panyv-0026.004", { + expect_identical(panyv(w, value = 8L), c(FALSE, FALSE, TRUE, FALSE)) +}) + + +test_that("panyNA-0027.001", { + expect_identical(panyNA(data.frame(x, y, z, v, w, f1, d1)), c(TRUE, TRUE, TRUE, TRUE)) +}) + + +test_that("panyNA-0027.002", { + expect_identical(panyNA(data.frame(y, z, v, w, f1, d1)), c(TRUE, TRUE, FALSE, TRUE)) +}) + + +test_that("panyNA-0027.003", { + expect_identical(panyNA(v), c(FALSE, TRUE, FALSE, FALSE)) +}) + + +test_that("panyNA-0027.004", { + expect_identical(panyNA(w), c(TRUE, FALSE, FALSE, FALSE)) +}) + + +test_that("panyNA-0027.005", { + expect_identical(panyNA(x), c(FALSE, FALSE, TRUE, FALSE)) +}) + diff --git a/tests/testthat/test-fpos.R b/tests/testthat/test-fpos.R new file mode 100644 index 0000000..5cf69d7 --- /dev/null +++ b/tests/testthat/test-fpos.R @@ -0,0 +1,546 @@ +# Tests for fpos() — fast matrix pattern search +# Migrated from tests/test_kit.R (custom check() suite) to testthat 3e — see issue #54. +# Each legacy check("id", actual, expected) maps to expect_identical(); +# 31 tolerant cases (identical FALSE but all.equal+typeof TRUE) use expect_kit_equal(); +# check(..., error=) maps to expect_error(regexp=, fixed=TRUE). +# Legacy IDs are preserved as test_that() labels (prefixed by function for uniqueness). +# Setup and expectations stay interleaved in legacy order: later sections may +# redefine x/y/out_vec/... so setup must not be hoisted above earlier tests. + +set.seed(123) + +mymatrix = matrix( + c(30,-16,22,17,-14,13,43,-26,45,49,-46,-20,-48,-45,5,-43,34,-4,-46,-32, + 3,3,-46,-38,-2,21,-41,-29,12,-22,-1,-28,-19,-31,-3,42,47,12,-39,17, + 42,16,24,-41,9,1,-21,-11,24,-25,36,43,22,27,-32,-12,-16,-14,-47,36, + -41,0,28,11,35,-4,42,42,28,10,13,-25,14,-36,-45,0,18,10,16,-6, + -11,26,-14,19,-19,-30,-6,20,-28,-36,-34,-12,-45,-28,-41,-34,39,27,-34,15, + -45,41,-10,33,34,-46,24,-15,-40,36,21,-4,-18,-3,-1,30,-18,-12,-46,44, + 30,3,-26,29,7,-8,38,-11,-19,24,-15,-13,20,-26,-19,46,-5,-1,26,41, + 6,-47,-4,29,27,-37,46,21,13,12,37,50,12,30,34,-35,-22,23,-31,22, + -8,38,-16,14,-2,0,-4,47,-2,13,6,-26,-36,31,43,-36,20,37,45,37, + 8,37,-43,-48,37,-39,6,23,-8,-14,26,14,14,48,4,-3,3,-32,-35,1, + 8,42,28,-6,-16,-27,19,-38,-14,-43,-33,-35,-17,49,-7,22,36,-31,17,-45, + -40,4,-32,-39,33,-41,18,-50,-48,38,-5,-27,-44,7,23,38,-13,9,31,29, + -21,-6,-43,-42,-25,-46,-4,48,11,3,-43,42,-9,45,48,16,24,-38,-32,38, + 38,44,18,11,-5,45,-29,26,-50,18,-11,-43,-8,-37,24,-41,-37,44,-18,38, + 25,-39,-13,26,-20,30,-1,-5,-22,42,-11,-2,-42,-43,0,-49,12,-2,-16,34), + nrow = 20, ncol = 15 +) +mat_lgl_a = mat_cpl_a = mat_chr_a = mat_dbl_a = mat_int_a = mymatrix +mat_cpl_b = mat_dbl_b = mat_chr_b = mat_int_b = mat_lgl_b = mat_int_a +storage.mode(mat_dbl_a) = "numeric" +storage.mode(mat_int_a) = "integer" +storage.mode(mat_chr_a) = "character" +storage.mode(mat_cpl_a) = "complex" +storage.mode(mat_lgl_a) = "logical" +mat_raw_a = abs(mat_int_a); storage.mode(mat_raw_a) = "raw" +mat_dbl_b[2,2] = NA; storage.mode(mat_dbl_b) = "numeric" +mat_int_b[2,2] = NA; storage.mode(mat_int_b) = "integer" +mat_chr_b[2,2] = NA; storage.mode(mat_chr_b) = "character" +mat_lgl_b[2,2] = NA; storage.mode(mat_lgl_b) = "logical" +mat_cpl_b[2,2] = NA; storage.mode(mat_cpl_b) = "complex" +big_matrix = matrix(c(1:5), nrow = 10, ncol = 5) +small_matrix = matrix(c(2:3), nrow = 2, ncol = 2) +big_matrix_d = big_matrix_ch = big_matrix_l = big_matrix_cp = big_matrix +small_matrix_d = small_matrix_ch = small_matrix_l = small_matrix_cp = small_matrix +storage.mode(big_matrix_d) = "numeric" +storage.mode(big_matrix_ch) = "character" +storage.mode(big_matrix_cp) = "complex" +storage.mode(big_matrix_l) = "logical" +storage.mode(small_matrix_d) = "numeric" +storage.mode(small_matrix_ch) = "character" +storage.mode(small_matrix_cp) = "complex" +storage.mode(small_matrix_l) = "logical" +class2133 = setClass("class2133", slots=list(x="numeric")) +s1 = class2133(x=20191231) +s2 = class2133(x=20191230) + +test_that("fpos-0004.001", { + expect_identical(fpos(mat_dbl_a[1:2,1:2], mat_dbl_a, FALSE), matrix(c(1L,1L),nrow = 1)) +}) + + +test_that("fpos-0004.002", { + expect_identical(fpos(mat_dbl_a[1:2,9:10], mat_dbl_a, FALSE), matrix(c(1L,9L),nrow = 1)) +}) + + +test_that("fpos-0004.003", { + expect_identical(fpos(mat_dbl_a[19:20,1:2], mat_dbl_a, FALSE), matrix(c(19L,1L),nrow = 1)) +}) + + +test_that("fpos-0004.004", { + expect_identical(fpos(mat_dbl_a[19:20,9:10], mat_dbl_a, FALSE), matrix(c(19L,9L),nrow = 1)) +}) + + +test_that("fpos-0004.005", { + expect_identical(fpos(mat_int_a[1:2,1:2], mat_int_a, TRUE), matrix(c(1L,1L),nrow = 1)) +}) + + +test_that("fpos-0004.006", { + expect_identical(fpos(mat_int_a[1:2,9:10], mat_int_a, TRUE), matrix(c(1L,9L),nrow = 1)) +}) + + +test_that("fpos-0004.007", { + expect_identical(fpos(mat_int_a[19:20,1:2], mat_int_a, TRUE), matrix(c(19L,1L),nrow = 1)) +}) + + +test_that("fpos-0004.008", { + expect_identical(fpos(mat_int_a[19:20,9:10], mat_int_a, TRUE), matrix(c(19L,9L),nrow = 1)) +}) + + +test_that("fpos-0004.009", { + expect_identical(fpos(mat_chr_a[1:2,1:2], mat_chr_a, FALSE), matrix(c(1L,1L),nrow = 1)) +}) + + +test_that("fpos-0004.010", { + expect_identical(fpos(mat_chr_a[1:2,9:10], mat_chr_a, FALSE), matrix(c(1L,9L),nrow = 1)) +}) + + +test_that("fpos-0004.011", { + expect_identical(fpos(mat_chr_a[19:20,1:2], mat_chr_a, FALSE), matrix(c(19L,1L),nrow = 1)) +}) + + +test_that("fpos-0004.012", { + expect_identical(fpos(mat_chr_a[19:20,9:10], mat_chr_a, FALSE), matrix(c(19L,9L),nrow = 1)) +}) + + +test_that("fpos-0004.013", { + expect_identical(fpos(mat_lgl_a[2:3,4:5], mat_lgl_a, TRUE), matrix(c(2L,16L,6L,4L,4L,9L),nrow = 3)) +}) + + +test_that("fpos-0004.014", { + expect_identical(fpos(mat_lgl_a[1:2,9:10], mat_lgl_a, FALSE), matrix(c(1L,1L),nrow = 1)) +}) + + +test_that("fpos-0004.015", { + expect_identical(fpos(mat_lgl_a[19:20,1:2], mat_lgl_a, FALSE), matrix(c(1L,1L),nrow = 1)) +}) + + +test_that("fpos-0004.016", { + expect_identical(fpos(mat_lgl_a[14:15,14:15], mat_lgl_a, TRUE), matrix(c(1L,15L,5L,14L,3L,3L,8L,14L),nrow = 4)) +}) + + +test_that("fpos-0004.017", { + expect_error(fpos(mat_lgl_a[19:20,9:10], mat_lgl_a, c(TRUE,FALSE)), regexp = "Argument 'all' must be TRUE or FALSE and length 1.", fixed = TRUE) +}) + + +test_that("fpos-0004.018", { + expect_error(fpos(mat_lgl_a[19:20,9:10], c(1:5),TRUE), regexp = "One of the dimension of the small matrix is greater than the large matrix.", fixed = TRUE) +}) + + +test_that("fpos-0004.019", { + expect_identical(fpos(TRUE, mat_lgl_a[19:20,9:10], FALSE), matrix(c(1L,1L),nrow = 1)) +}) + + +test_that("fpos-0004.020", { + expect_error(fpos(mat_lgl_a, mat_lgl_a[19:20,9:10], TRUE), regexp = "One of the dimension of the small matrix is greater than the large matrix.", fixed = TRUE) +}) + + +test_that("fpos-0004.021", { + expect_error(fpos(mat_raw_a[1:2,1:2], mat_raw_a, TRUE), regexp = "Type raw for 'haystack' is not supported.", fixed = TRUE) +}) + + +test_that("fpos-0004.022", { + expect_error(fpos(mat_raw_a[1:2,1:2], mat_int_a, TRUE), regexp = "Type raw for 'needle' is not supported.", fixed = TRUE) +}) + + +test_that("fpos-0004.023", { + expect_identical(fpos(mat_dbl_b[1:2,1:2], mat_dbl_b, FALSE), matrix(c(1L,1L),nrow = 1)) +}) + + +test_that("fpos-0004.024", { + expect_identical(fpos(mat_int_b[1:2,1:2], mat_int_b, FALSE), matrix(c(1L,1L),nrow = 1)) +}) + + +test_that("fpos-0004.025", { + expect_identical(fpos(mat_chr_b[1:2,1:2], mat_chr_b, FALSE), matrix(c(1L,1L),nrow = 1)) +}) + + +test_that("fpos-0004.026", { + expect_identical(fpos(mat_lgl_b[1:2,1:2], mat_lgl_b, FALSE), matrix(c(1L,1L),nrow = 1)) +}) + + +test_that("fpos-0004.027", { + expect_identical(fpos(mat_cpl_b[1:2,1:2], mat_cpl_b, FALSE), matrix(c(1L,1L),nrow = 1)) +}) + + +test_that("fpos-0004.028", { + expect_identical(fpos(mat_cpl_a[1:2,1:2], mat_cpl_a, TRUE), matrix(c(1L,1L),nrow = 1)) +}) + + +test_that("fpos-0004.029", { + expect_identical(fpos(mat_cpl_a[2:3,2:3], mat_cpl_a, TRUE), matrix(c(2L,2L),nrow = 1)) +}) + + +test_that("fpos-0004.030", { + expect_identical(fpos(matrix(13), matrix(c(1:30),nrow = 5), TRUE), matrix(c(3L, 3L),nrow = 1)) +}) + + +test_that("fpos-0004.031", { + expect_identical(fpos(matrix(c(19,24), nrow = 1), matrix(c(1:30),nrow = 5), TRUE), matrix(c(4L, 4L),nrow = 1)) +}) + + +test_that("fpos-0004.032", { + expect_error(fpos(mat_int_a[19:20,9:10], mat_lgl_a), regexp = "Haystack type (logical) and needle type (integer) are different. Please make sure that they have the same type.", fixed = TRUE) +}) + + +test_that("fpos-0004.033", { + expect_identical(fpos(mat_int_a[19:20,9:10], mat_dbl_a), matrix(c(19L,9L),nrow = 1)) +}) + + +test_that("fpos-0004.034", { + expect_identical(fpos(mat_dbl_a[19:20,9:10], mat_int_a), matrix(c(19L,9L),nrow = 1)) +}) + + +test_that("fpos-0004.035", { + expect_identical(fpos(small_matrix, big_matrix), matrix(c(2L,7L,2L,7L,2L,7L,2L,7L,1L,1L,2L,2L,3L,3L,4L,4L),nrow = 8)) +}) + + +test_that("fpos-0004.036", { + expect_identical(fpos(small_matrix, big_matrix, all = FALSE), matrix(c(2L,1L),nrow = 1)) +}) + + +test_that("fpos-0004.037", { + expect_identical(fpos(small_matrix, big_matrix, overlap = FALSE), matrix(c(2L,7L,2L,7L,1L,1L,3L,3L),nrow = 4)) +}) + + +test_that("fpos-0004.038", { + expect_identical(fpos(small_matrix_d, big_matrix_d), matrix(c(2L,7L,2L,7L,2L,7L,2L,7L,1L,1L,2L,2L,3L,3L,4L,4L),nrow = 8)) +}) + + +test_that("fpos-0004.039", { + expect_identical(fpos(small_matrix_d, big_matrix_d, all = FALSE), matrix(c(2L,1L),nrow = 1)) +}) + + +test_that("fpos-0004.040", { + expect_identical(fpos(small_matrix_d, big_matrix_d, overlap = FALSE), matrix(c(2L,7L,2L,7L,1L,1L,3L,3L),nrow = 4)) +}) + + +test_that("head-0004.041", { + expect_identical(head(fpos(small_matrix_l, big_matrix_l),6), matrix(c(1L,2L,3L,4L,5L,6L,1L,1L,1L,1L,1L,1L),nrow = 6)) +}) + + +test_that("fpos-0004.042", { + expect_identical(fpos(small_matrix_l, big_matrix_l, all = FALSE), matrix(c(1L,1L),nrow = 1)) +}) + + +test_that("fpos-0004.043", { + expect_identical(fpos(small_matrix_l, big_matrix_l, overlap = FALSE), matrix(c(1L,3L,5L,7L,9L,1L,3L,5L,7L,9L,1L,1L,1L,1L,1L,3L,3L,3L,3L,3L),nrow = 10)) +}) + + +test_that("fpos-0004.044", { + expect_identical(fpos(small_matrix_cp, big_matrix_cp), matrix(c(2L,7L,2L,7L,2L,7L,2L,7L,1L,1L,2L,2L,3L,3L,4L,4L),nrow = 8)) +}) + + +test_that("fpos-0004.045", { + expect_identical(fpos(small_matrix_cp, big_matrix_cp, all = FALSE), matrix(c(2L,1L),nrow = 1)) +}) + + +test_that("fpos-0004.046", { + expect_identical(fpos(small_matrix_cp, big_matrix_cp, overlap = FALSE), matrix(c(2L,7L,2L,7L,1L,1L,3L,3L),nrow = 4)) +}) + + +test_that("fpos-0004.047", { + expect_identical(fpos(small_matrix_ch, big_matrix_ch), matrix(c(2L,7L,2L,7L,2L,7L,2L,7L,1L,1L,2L,2L,3L,3L,4L,4L),nrow = 8)) +}) + + +test_that("fpos-0004.048", { + expect_identical(fpos(small_matrix_ch, big_matrix_ch, all = FALSE), matrix(c(2L,1L),nrow = 1)) +}) + + +test_that("fpos-0004.049", { + expect_identical(fpos(small_matrix_ch, big_matrix_ch, overlap = FALSE), matrix(c(2L,7L,2L,7L,1L,1L,3L,3L),nrow = 4)) +}) + + +test_that("fpos-0004.050", { + expect_error(fpos(small_matrix_ch, big_matrix_ch, overlap = c(TRUE,FALSE)), regexp = "Argument 'overlap' must be TRUE or FALSE and length 1.", fixed = TRUE) +}) + + +test_that("fpos-0004.051", { + expect_identical(fpos(TRUE, TRUE), 1L) +}) + + +test_that("fpos-0004.052", { + expect_identical(fpos(FALSE, TRUE), NULL) +}) + + +test_that("fpos-0004.053", { + expect_identical(fpos(NA, TRUE), NULL) +}) + + +test_that("fpos-0004.054", { + expect_identical(fpos(TRUE, matrix(c(FALSE, TRUE, TRUE, FALSE), nrow = 2)), matrix(c(2L,1L,1L,2L),nrow = 2)) +}) + + +test_that("fpos-0004.055", { + expect_error(fpos(s1, TRUE), regexp = "S4 class objects are not supported.", fixed = TRUE) +}) + + +test_that("fpos-0004.056", { + expect_error(fpos(TRUE, s2), regexp = "S4 class objects are not supported.", fixed = TRUE) +}) + + +test_that("fpos-0004.057", { + expect_error(fpos(TRUE, data.frame(c(1:10))), regexp = "Please note that data.frame(s) are not supported.", fixed = TRUE) +}) + + +test_that("fpos-0004.058", { + expect_error(fpos(TRUE, list(1:10)), regexp = "Type list for 'haystack' is not supported.", fixed = TRUE) +}) + + +test_that("fpos-0004.059", { + expect_error(fpos(iris3, TRUE), regexp = "Arrays are not supported for argument 'needle'.", fixed = TRUE) +}) + + +test_that("fpos-0004.060", { + expect_error(fpos(TRUE, iris3), regexp = "Arrays are not supported for argument 'haystack'.", fixed = TRUE) +}) + + +test_that("fpos-0004.061", { + expect_error(fpos(TRUE, TRUE,c(TRUE,FALSE)), regexp = "Argument 'all' must be TRUE or FALSE and length 1.", fixed = TRUE) +}) + + +test_that("fpos-0004.062", { + expect_error(fpos(TRUE, TRUE,TRUE,c(TRUE,FALSE)), regexp = "Argument 'overlap' must be TRUE or FALSE and length 1.", fixed = TRUE) +}) + + +test_that("fpos-0004.063", { + expect_error(fpos(list(1:10),TRUE), regexp = "Type list for 'needle' is not supported.", fixed = TRUE) +}) + + +test_that("fpos-0004.064", { + expect_error(fpos(c(TRUE,FALSE),TRUE), regexp = "The 'needle' vector length is greater than the 'haystack' vector length.", fixed = TRUE) +}) + + +test_that("fpos-0004.065", { + expect_error(fpos(1L,TRUE), regexp = "Haystack type (logical) and needle type (integer) are different. Please make sure that they have the same type.", fixed = TRUE) +}) + + +test_that("fpos-0004.066", { + expect_identical(fpos(mat_dbl_b[2,1:2],mat_dbl_b[2,]), 1L) +}) + + +test_that("fpos-0004.067", { + expect_identical(fpos(mat_chr_b[2,1:2],mat_chr_b[2,]), 1L) +}) + + +test_that("fpos-0004.068", { + expect_identical(fpos(mat_cpl_b[2,1:2],mat_cpl_b[2,]), 1L) +}) + + +test_that("fpos-0004.069", { + expect_identical(fpos(mat_int_b[2,1:2],mat_int_b[2,]), 1L) +}) + + +test_that("fpos-0004.070", { + expect_identical(fpos(mat_lgl_b[2,1:2],mat_lgl_b[2,]), 1L) +}) + + +test_that("fpos-0004.071", { + expect_identical(fpos(mat_dbl_b,mat_dbl_a), NULL) +}) + + +test_that("fpos-0004.072", { + expect_identical(fpos(mat_dbl_b[2,1:2],as.integer(mat_dbl_b[2,])), 1L) +}) + + +test_that("fpos-0004.073", { + expect_identical(fpos(as.integer(mat_dbl_b[2,1:2]),mat_dbl_b[2,]), 1L) +}) + + +test_that("fpos-0004.074", { + expect_identical(fpos(c(1L,2L), c(1L,2L,5L,1L,2L), all = TRUE, overlap = TRUE), c(1L,4L)) +}) + + +test_that("fpos-0004.075", { + expect_identical(fpos(c(1L,1L), c(1L,1L,1L,1L,1L), all = TRUE, overlap = TRUE), c(1L,2L,3L,4L)) +}) + + +test_that("fpos-0004.076", { + expect_identical(fpos(c(1L,1L), c(1L,1L,1L,1L,1L), all = FALSE, overlap = TRUE), c(1L)) +}) + + +test_that("fpos-0004.077", { + expect_identical(fpos(c(1L,1L), c(1L,1L,1L,1L,1L), all = TRUE, overlap = FALSE), c(1L,3L)) +}) + + +test_that("fpos-0004.078", { + expect_identical(fpos(c(1L,NA_integer_), c(1L,NA_integer_,1L,NA_integer_,1L), all = TRUE, overlap = FALSE), c(1L,3L)) +}) + + +test_that("fpos-0004.079", { + expect_identical(fpos(c(1,2), c(1L,2L,5L,1L,2L), all = TRUE, overlap = TRUE), c(1L,4L)) +}) + + +test_that("fpos-0004.080", { + expect_identical(fpos(c(1,1), c(1L,1L,1L,1L,1L), all = TRUE, overlap = TRUE), c(1L,2L,3L,4L)) +}) + + +test_that("fpos-0004.081", { + expect_identical(fpos(c(1,1), c(1L,1L,1L,1L,1L), all = FALSE, overlap = TRUE), c(1L)) +}) + + +test_that("fpos-0004.082", { + expect_identical(fpos(c(1,1), c(1L,1L,1L,1L,1L), all = TRUE, overlap = FALSE), c(1L,3L)) +}) + + +test_that("fpos-0004.083", { + expect_identical(fpos(c(1,NA_real_), c(1L,NA_integer_,1L,NA_integer_,1L), all = TRUE, overlap = FALSE), c(1L,3L)) +}) + + +test_that("fpos-0004.084", { + expect_identical(fpos(as.complex(c(1L,2L)), as.complex(c(1L,2L,5L,1L,2L)), all = TRUE, overlap = TRUE), c(1L,4L)) +}) + + +test_that("fpos-0004.085", { + expect_identical(fpos(as.complex(c(1L,1L)), as.complex(c(1L,1L,1L,1L,1L)), all = TRUE, overlap = TRUE), c(1L,2L,3L,4L)) +}) + + +test_that("fpos-0004.086", { + expect_identical(fpos(as.complex(c(1L,1L)), as.complex(c(1L,1L,1L,1L,1L)), all = FALSE, overlap = TRUE), c(1L)) +}) + + +test_that("fpos-0004.087", { + expect_identical(fpos(as.complex(c(1L,1L)), as.complex(c(1L,1L,1L,1L,1L)), all = TRUE, overlap = FALSE), c(1L,3L)) +}) + + +test_that("fpos-0004.088", { + expect_identical(fpos(as.complex(c(1L,NA_integer_)), as.complex(c(1L,NA_integer_,1L,NA_integer_,1L)), all = TRUE, overlap = FALSE), c(1L,3L)) +}) + + +test_that("fpos-0004.089", { + expect_identical(fpos(as.character(c(1L,2L)), as.character(c(1L,2L,5L,1L,2L)), all = TRUE, overlap = TRUE), c(1L,4L)) +}) + + +test_that("fpos-0004.090", { + expect_identical(fpos(as.character(c(1L,1L)), as.character(c(1L,1L,1L,1L,1L)), all = TRUE, overlap = TRUE), c(1L,2L,3L,4L)) +}) + + +test_that("fpos-0004.091", { + expect_identical(fpos(as.character(c(1L,1L)), as.character(c(1L,1L,1L,1L,1L)), all = FALSE, overlap = TRUE), c(1L)) +}) + + +test_that("fpos-0004.092", { + expect_identical(fpos(as.character(c(1L,1L)), as.character(c(1L,1L,1L,1L,1L)), all = TRUE, overlap = FALSE), c(1L,3L)) +}) + + +test_that("fpos-0004.093", { + expect_identical(fpos(as.character(c(1L,NA_integer_)), as.character(c(1L,NA_integer_,1L,NA_integer_,1L)), all = TRUE, overlap = FALSE), c(1L,3L)) +}) + + +test_that("fpos-0004.094", { + expect_identical(fpos(as.logical(c(1L,2L)), as.logical(c(1L,2L,5L,1L,2L)), all = TRUE, overlap = TRUE), c(1L,2L,3L,4L)) +}) + + +test_that("fpos-0004.095", { + expect_identical(fpos(as.logical(c(1L,1L)), as.logical(c(1L,1L,1L,1L,1L)), all = TRUE, overlap = TRUE), c(1L,2L,3L,4L)) +}) + + +test_that("fpos-0004.096", { + expect_identical(fpos(as.logical(c(1L,1L)), as.logical(c(1L,1L,1L,1L,1L)), all = FALSE, overlap = TRUE), c(1L)) +}) + + +test_that("fpos-0004.097", { + expect_identical(fpos(as.logical(c(1L,1L)), as.logical(c(1L,1L,1L,1L,1L)), all = TRUE, overlap = FALSE), c(1L,3L)) +}) + + +test_that("fpos-0004.098", { + expect_identical(fpos(as.logical(c(1L,NA_integer_)), as.logical(c(1L,NA_integer_,1L,NA_integer_,1L)), all = TRUE, overlap = FALSE), c(1L,3L)) +}) diff --git a/tests/testthat/test-iif-nif.R b/tests/testthat/test-iif-nif.R new file mode 100644 index 0000000..b5917cd --- /dev/null +++ b/tests/testthat/test-iif-nif.R @@ -0,0 +1,1161 @@ +# Tests for iif() and nif() — vectorised if / nested if +# Migrated from tests/test_kit.R (custom check() suite) to testthat 3e — see issue #54. +# Each legacy check("id", actual, expected) maps to expect_identical(); +# 31 tolerant cases (identical FALSE but all.equal+typeof TRUE) use expect_kit_equal(); +# check(..., error=) maps to expect_error(regexp=, fixed=TRUE). +# Legacy IDs are preserved as test_that() labels (prefixed by function for uniqueness). +# Setup and expectations stay interleaved in legacy order: later sections may +# redefine x/y/out_vec/... so setup must not be hoisted above earlier tests. + +set.seed(123) + +class2132 = setClass("class2132", slots=list(x="numeric")) +s1 = class2132(x=20191231) +s2 = class2132(x=20191230) +test_vec = -5L:5L < 0L +test_vec_na = c(test_vec, NA) +out_vec = rep(1:0, 5:6) +out_vec_na = c(out_vec, NA_integer_) +date_vec = as.Date(14975:14979, origin = '1970-01-01') + +test_that("iif-0002.001", { + expect_identical(iif(test_vec, 1L, 0L), out_vec) +}) + + +test_that("iif-0002.002", { + expect_identical(iif(test_vec, 1, 0), as.numeric(out_vec)) +}) + + +test_that("iif-0002.003", { + expect_identical(iif(test_vec, TRUE, FALSE), as.logical(out_vec)) +}) + + +test_that("iif-0002.004", { + expect_identical(iif(test_vec, "1", "0"), as.character(out_vec)) +}) + + +test_that("iif-0002.005", { + expect_identical(iif(test_vec_na, TRUE, NA), c(rep(TRUE,5L), rep(NA,7L))) +}) + + +test_that("iif-0002.006", { + expect_identical(iif(test_vec, rep(1L,11L), rep(0L,11L)), out_vec) +}) + + +test_that("iif-0002.007", { + expect_identical(iif(test_vec, rep(1L,11L), 0L), out_vec) +}) + + +test_that("iif-0002.008", { + expect_identical(iif(test_vec, 1L, rep(0L,11L)), out_vec) +}) + + +test_that("iif-0002.009", { + expect_error(iif(test_vec, rep(1L,11L), rep(0L,10L)), regexp = "Length of 'no' is 10 but must be 1 or length of 'test' (11).", fixed = TRUE) +}) + + +test_that("iif-0002.010", { + expect_error(iif(test_vec, rep(1,10L), rep(0,11L)), regexp = "Length of 'yes' is 10 but must be 1 or length of 'test' (11).", fixed = TRUE) +}) + + +test_that("iif-0002.011", { + expect_error(iif(test_vec, rep(TRUE,10L), rep(FALSE,10L)), regexp = "Length of 'yes' is 10 but must be 1 or length of 'test' (11).", fixed = TRUE) +}) + + +test_that("iif-0002.012", { + expect_error(iif(0:1, rep(TRUE,2L), rep(FALSE,2L)), regexp = "Argument 'test' must be logical.", fixed = TRUE) +}) + + +test_that("iif-0002.013", { + expect_error(iif(test_vec, TRUE, "FALSE"), regexp = "'yes' is of type logical but 'no' is of type character. Please", fixed = TRUE) +}) + + +test_that("iif-0002.014", { + expect_error(iif(test_vec, list(1),list(2,4)), regexp = "Length of 'no' is 2 but must be 1 or length of 'test' (11).", fixed = TRUE) +}) + + +test_that("iif-0002.015", { + expect_error(iif(test_vec, list(1,3),list(2,4)), regexp = "Length of 'yes' is 2 but must be 1 or length of 'test' (11).", fixed = TRUE) +}) + + +test_that("iif-0002.016", { + expect_identical(iif(test_vec, list(1), list(0)), as.list(as.numeric(out_vec))) +}) + + +test_that("iif-0002.017", { + expect_identical(iif(test_vec, list(1), list(0)), as.list(as.numeric(out_vec))) +}) + + +test_that("iif-0002.018", { + expect_identical(iif(date_vec == "2011-01-01", date_vec - 1L, date_vec), c(date_vec[1L] - 1L, date_vec[2:5])) +}) + + +test_that("iif-0002.019", { + expect_identical(iif(c(TRUE,FALSE,TRUE,TRUE,FALSE), factor(letters[1:5]), factor("a", levels=letters[1:5])), factor(c("a","a","c","d","a"), levels=letters[1:5])) +}) + + +test_that("iif-0002.020", { + expect_identical(iif(test_vec_na, 1L, 0L), out_vec_na) +}) + + +test_that("iif-0002.021", { + expect_identical(iif(test_vec_na, rep(1L,12L), 0L), out_vec_na) +}) + + +test_that("iif-0002.022", { + expect_identical(iif(test_vec_na, rep(1L,12L), rep(0L,12L)), out_vec_na) +}) + + +test_that("iif-0002.023", { + expect_identical(iif(test_vec_na, 1L, rep(0L,12L)), out_vec_na) +}) + + +test_that("iif-0002.024", { + expect_identical(iif(test_vec_na, 1, 0), as.numeric(out_vec_na)) +}) + + +test_that("iif-0002.025", { + expect_identical(iif(test_vec_na, rep(1,12L), 0), as.numeric(out_vec_na)) +}) + + +test_that("iif-0002.026", { + expect_identical(iif(test_vec_na, rep(1,12L), rep(0,12L)), as.numeric(out_vec_na)) +}) + + +test_that("iif-0002.027", { + expect_identical(iif(test_vec_na, 1, rep(0,12L)), as.numeric(out_vec_na)) +}) + + +test_that("iif-0002.028", { + expect_identical(iif(test_vec_na, TRUE, rep(FALSE,12L)), as.logical(out_vec_na)) +}) + + +test_that("iif-0002.029", { + expect_identical(iif(test_vec_na, rep(TRUE,12L), FALSE), as.logical(out_vec_na)) +}) + + +test_that("iif-0002.030", { + expect_identical(iif(test_vec_na, rep(TRUE,12L), rep(FALSE,12L)), as.logical(out_vec_na)) +}) + + +test_that("iif-0002.031", { + expect_identical(iif(test_vec_na, "1", rep("0",12L)), as.character(out_vec_na)) +}) + + +test_that("iif-0002.032", { + expect_identical(iif(test_vec_na, rep("1",12L), "0"), as.character(out_vec_na)) +}) + + +test_that("iif-0002.033", { + expect_identical(iif(test_vec_na, rep("1",12L), rep("0",12L)), as.character(out_vec_na)) +}) + + +test_that("iif-0002.034", { + expect_identical(iif(test_vec_na, "1", "0"), as.character(out_vec_na)) +}) + + +test_that("iif-0002.035", { + expect_error(iif(test_vec, as.Date("2011-01-01"), FALSE), regexp = "'yes' is of type double but 'no' is of type logical. Please", fixed = TRUE) +}) + + +test_that("iif-0002.036", { + expect_kit_equal(iif(test_vec_na, 1+0i, 0+0i), as.complex(out_vec_na)) +}) + + +test_that("iif-0002.037", { + expect_kit_equal(iif(test_vec_na, rep(1+0i,12L), 0+0i), as.complex(out_vec_na)) +}) + + +test_that("iif-0002.038", { + expect_kit_equal(iif(test_vec_na, rep(1+0i,12L), rep(0+0i,12L)), as.complex(out_vec_na)) +}) + + +test_that("iif-0002.039", { + expect_kit_equal(iif(test_vec_na, 1+0i, rep(0+0i,12L)), as.complex(out_vec_na)) +}) + + +test_that("iif-0002.040", { + expect_error(iif(test_vec, as.raw(0), as.raw(1)), regexp = "Type raw is not supported.", fixed = TRUE) +}) + + +test_that("iif-0002.041", { + expect_error(iif(TRUE,1,as.Date("2019-07-07")), regexp = "'yes' has different class than 'no'. Please", fixed = TRUE) +}) + + +test_that("iif-0002.042", { + expect_error(iif(TRUE,1L,factor(letters[1])), regexp = "'yes' has different class than 'no'. Please", fixed = TRUE) +}) + + +test_that("iif-0002.043", { + expect_identical(iif(TRUE, list(1:5), list(5:1)), list(1:5)) +}) + + +test_that("iif-0002.044", { + expect_identical(iif(as.logical(NA), list(1:5), list(5:1)), list(NULL)) +}) + + +test_that("iif-0002.045", { + expect_identical(iif(FALSE, list(1:5), list(5:1)), list(5:1)) +}) + + +test_that("iif-0002.048", { + expect_identical(iif(TRUE, list(data.frame(1:5)), list(data.frame(5:1))), list(data.frame(1:5))) +}) + + +test_that("iif-0002.049", { + expect_identical(iif(FALSE, list(data.frame(1:5)), list(data.frame(5:1))), list(data.frame(5:1))) +}) + + +test_that("iif-0002.050", { + expect_identical(iif(c(TRUE,FALSE), list(1:5,6:10), list(10:6,5:1)), list(1:5,5:1)) +}) + + +test_that("iif-0002.051", { + expect_identical(iif(c(NA,TRUE), list(1:5,6:10), list(10:6,5:1)), list(NULL,6:10)) +}) + + +test_that("iif-0002.052", { + expect_identical(iif(c(FALSE,TRUE), list(1:5,6:10), list(10:6,5:1)), list(10:6,6:10)) +}) + + +test_that("iif-0002.053", { + expect_identical(iif(c(NA,TRUE), list(1:5), list(10:6,5:1)), list(NULL,1:5)) +}) + + +test_that("iif-0002.054", { + expect_identical(iif(c(NA,TRUE), list(1:5,6:10), list(5:1)), list(NULL,6:10)) +}) + + +test_that("iif-0002.055", { + expect_identical(iif(c(FALSE,TRUE), list(TRUE), list(10:6,5:1)), list(10:6,TRUE)) +}) + + +test_that("iif-0002.056", { + expect_identical(iif(c(FALSE,TRUE), list(as.Date("2019-07-07")), list(10:6,5:1)), list(10:6,as.Date("2019-07-07"))) +}) + + +test_that("iif-0002.057", { + expect_identical(iif(c(FALSE,TRUE), list(factor(letters[1:5])), list(10:6,5:1)), list(10:6,factor(letters[1:5]))) +}) + + +test_that("iif-0002.058", { + expect_identical(iif(c(NA,FALSE), list(1:5), list(10:6,5:1)), list(NULL,5:1)) +}) + + +test_that("iif-0002.059", { + expect_identical(iif(c(NA,FALSE), list(1:5,6:10), list(5:1)), list(NULL,5:1)) +}) + + +test_that("iif-0002.060", { + expect_identical(iif(c(NA,FALSE), list(1:5), list(5:1)), list(NULL,5:1)) +}) + + +test_that("iif-0002.061", { + expect_identical(iif(c(TRUE,FALSE), list(1L), list(0L)), list(1L,0L)) +}) + + +test_that("iif-0002.062", { + expect_identical(iif(c(TRUE,FALSE), list(1L), list(0L)), list(1L,0L)) +}) + + +test_that("iif-0002.063", { + expect_error(iif(c(TRUE,FALSE), factor(c("a","b")), factor(c("a","c"))), regexp = "'yes' and 'no' are both type factor but their levels are different", fixed = TRUE) +}) + + +test_that("iif-0002.064", { + expect_identical(iif(c(TRUE, TRUE, TRUE, FALSE, FALSE), factor(NA, levels=letters[1:5]), factor(letters[1:5])), factor(c(NA,NA,NA,"d","e"),levels=letters[1:5])) +}) + + +test_that("iif-0002.065", { + expect_identical(iif(c(TRUE, TRUE, TRUE, FALSE, NA, FALSE), factor(NA, levels=letters[1:6]), factor(letters[1:6])), factor(c(NA,NA,NA,"d",NA,"f"),levels=letters[1:6])) +}) + + +test_that("iif-0002.066", { + expect_identical(iif(c(TRUE, TRUE, TRUE, FALSE, NA, FALSE), factor(letters[1:6]), factor(NA, levels=letters[1:6])), factor(c("a","b","c",NA,NA,NA), levels=letters[1:6])) +}) + + +test_that("iif-0002.067", { + expect_identical(iif(c(TRUE, NA, TRUE, FALSE, FALSE, FALSE), factor(NA), factor(NA)), factor(c(NA,NA,NA,NA,NA,NA))) +}) + + +test_that("iif-0002.068", { + expect_identical(iif(c(a=TRUE,b=FALSE), list(m=1,n=2), list(x=11,y=12)), list(a=1, b=12)) +}) + + +test_that("iif-0002.069", { + expect_identical(iif(c(a=TRUE,b=FALSE), c(m=1,n=2), c(x=11,y=12)), c(a=1, b=12)) +}) + + +test_that("ifelse-0002.070", { + expect_identical(ifelse(c(a=TRUE,b=FALSE), c(1,2), c(11,12)), c(a=1, b=12)) +}) + + +test_that("iif-0002.071", { + expect_error(iif(TRUE, s1, s2), regexp = "S4 class objects are not supported.", fixed = TRUE) +}) + + +test_that("iif-0002.072", { + expect_error(iif(TRUE, 1, s2), regexp = "S4 class objects are not supported.", fixed = TRUE) +}) + + +test_that("iif-0002.073", { + expect_identical(iif(test_vec, 1L, 0,tprom = TRUE), as.numeric(out_vec)) +}) + + +test_that("iif-0002.074", { + expect_error(iif(test_vec, 1L, raw(0),tprom = TRUE), regexp = "Type raw (argument 'no') is not supported.", fixed = TRUE) +}) + + +test_that("iif-0002.075", { + expect_error(iif(test_vec, raw(1), 0,tprom = TRUE), regexp = "Type raw (argument 'yes') is not supported.", fixed = TRUE) +}) + + +test_that("iif-0002.076", { + expect_error(iif(test_vec, 1L, 0, "NA", TRUE), regexp = "Type of 'na' (character) is higher than double (highest type of 'yes' and 'no'). Please make sure that it is at lower or the same.", fixed = TRUE) +}) + + +test_that("iif-0002.077", { + expect_identical(iif(test_vec_na, 1, 0, NA, TRUE), as.numeric(out_vec_na)) +}) + + +test_that("iif-0002.078", { + expect_identical(iif(test_vec_na, rep(1L, 12L), rep(0, 12L), rep(NA, 12L), TRUE), as.numeric(out_vec_na)) +}) + + +test_that("iif-0002.079", { + expect_identical(iif(test_vec_na, rep(1, 12L), rep(0L, 12L), rep(NA, 12L), TRUE), as.numeric(out_vec_na)) +}) + + +test_that("iif-0002.080", { + expect_identical(iif(test_vec_na, 1, rep(0L, 12L), rep(NA, 12L), TRUE), as.numeric(out_vec_na)) +}) + + +test_that("iif-0002.081", { + expect_identical(iif(test_vec_na, 1, rep(0L, 12L), NA, TRUE), as.numeric(out_vec_na)) +}) + + +test_that("iif-0002.082", { + expect_identical(iif(test_vec_na, rep(1, 12L), 0L, rep(NA, 12L), TRUE), as.numeric(out_vec_na)) +}) + + +test_that("iif-0002.083", { + expect_identical(iif(test_vec_na, rep(1L, 12L), rep(0, 12L), rep(NA, 12L), TRUE), as.numeric(out_vec_na)) +}) + + +test_that("iif-0002.084", { + expect_identical(iif(c(TRUE, TRUE, TRUE, FALSE, NA, FALSE), factor(letters[1:6]), factor("a", levels=letters[1:6]), tprom = TRUE), factor(c("a","b","c","a",NA,"a"), levels=letters[1:6])) +}) + + +test_that("iif-0002.085", { + expect_identical(iif(test_vec_na, 1, 0, rep(NA, 12L), TRUE), as.numeric(out_vec_na)) +}) + + +test_that("iif-0002.086", { + expect_identical(iif(c(date_vec == "2011-01-01", NA), c(date_vec - 1L, date_vec[1L]), c(date_vec, date_vec[1L]), NA, TRUE), c(date_vec[1L] - 1L, date_vec[2:5], NA)) +}) + + +test_that("iif-0002.087", { + expect_error(iif(c(date_vec == "2011-01-01", NA), c(date_vec - 1L, date_vec[1L]), c(date_vec, date_vec[1L]), NA, FALSE), regexp = "'yes' is of type double but 'na' is of type logical. Please make sure that both arguments have the same type.", fixed = TRUE) +}) + + +test_that("iif-0002.088", { + expect_identical(iif(c(date_vec == "2011-01-01", NA), c(date_vec - 1L, date_vec[1L]), c(date_vec, date_vec[1L]), as.Date("2020-05-05"), TRUE), c(date_vec[1L] - 1L, date_vec[2:5], as.Date("2020-05-05"))) +}) + + +test_that("iif-0002.089", { + expect_identical(iif(c(date_vec == "2011-01-01", NA), c(date_vec - 1L, date_vec[1L]), c(date_vec, date_vec[1L]), 3L, TRUE), c(date_vec[1L] - 1L, date_vec[2:5], as.Date(3L,origin = "1970-01-01"))) +}) + + +test_that("iif-0002.090", { + expect_identical(iif(c(date_vec == "2011-01-01", NA), c(date_vec - 1L, date_vec[1L]), c(date_vec, date_vec[1L]), 3, TRUE), c(date_vec[1L] - 1L, date_vec[2:5], as.Date(3,origin = "1970-01-01"))) +}) + + +test_that("iif-0002.091", { + expect_identical(iif(c(date_vec == "2011-01-01", NA), c(date_vec - 1L, date_vec[1L]), c(date_vec, date_vec[1L]), 1L, TRUE), c(date_vec[1L] - 1L, date_vec[2:5], as.Date(1,origin = "1970-01-01"))) +}) + + +test_that("iif-0002.092", { + expect_error(iif(test_vec_na, 1, 0, rep(NA, 12L), c(TRUE,FALSE)), regexp = "Argument 'tprom' must be either FALSE or TRUE and length 1.", fixed = TRUE) +}) + + +test_that("iif-0002.093", { + expect_error(iif(test_vec_na, 1, 0, rep(NA, 11L), TRUE), regexp = "Length of 'na' is 11 but must be 1 or length of 'test' (12).", fixed = TRUE) +}) + + +test_that("iif-0002.094", { + expect_error(iif(TRUE, as.Date("2020-04-14"), as.Date("2020-04-12"), 2), regexp = "'yes' has different class than 'na'. Please make sure that both arguments have the same class.", fixed = TRUE) +}) + + +test_that("iif-0002.095", { + expect_error(iif(TRUE, factor(c("a"),levels=c("a","b")), factor(c("b"),levels=c("a","b")), factor(c("c"),levels=c("a","c"))), regexp = "'yes' and 'na' are both type factor but their levels are different.", fixed = TRUE) +}) + + +test_that("iif-0002.096", { + expect_identical(iif(c(TRUE, NA), list(1,2), list(3,4),list(5,6)), list(1,6)) +}) + + +test_that("iif-0002.097", { + expect_identical(iif(c(TRUE, NA, FALSE), as.Date("2020-04-14"), 18368, as.Date("2020-04-15"), TRUE), c(as.Date("2020-04-14"), as.Date("2020-04-15"), as.Date("2020-04-16"))) +}) + + +test_that("iif-0002.098", { + expect_identical(iif(c(TRUE, NA, FALSE), 18366, as.Date("2020-04-16"), as.Date("2020-04-15"), TRUE), c(18366, 18367, 18368)) +}) + + +test_that("iif-0002.099", { + expect_identical(iif(c(TRUE, NA, FALSE), as.Date("2020-04-14"), as.Date("2020-04-16"), 18367, TRUE), c(as.Date("2020-04-14"), as.Date("2020-04-15"), as.Date("2020-04-16"))) +}) + + +test_that("iif-0002.100", { + expect_identical(iif(c(TRUE, NA, FALSE), TRUE, FALSE, NA), c(TRUE, NA, FALSE)) +}) + + +test_that("iif-0002.101", { + expect_identical(iif(c(TRUE, NA, FALSE), rep(TRUE,3L), FALSE, NA), c(TRUE, NA, FALSE)) +}) + + +test_that("iif-0002.101-2", { + expect_identical(iif(c(TRUE, NA, FALSE), rep(TRUE,3L), rep(FALSE,3L), NA), c(TRUE, NA, FALSE)) +}) + + +test_that("iif-0002.102", { + expect_identical(iif(c(TRUE, NA, FALSE), TRUE, rep(FALSE,3L), NA), c(TRUE, NA, FALSE)) +}) + + +test_that("iif-0002.103", { + expect_identical(iif(c(TRUE, NA, FALSE), 1L, 0L, NA_integer_), c(1L, NA_integer_, 0L)) +}) + + +test_that("iif-0002.104", { + expect_identical(iif(c(TRUE, NA, FALSE), rep(1L,3L), 0L, NA_integer_), c(1L, NA_integer_, 0L)) +}) + + +test_that("iif-0002.105", { + expect_identical(iif(c(TRUE, NA, FALSE), rep(1L,3L), rep(0L,3L), NA_integer_), c(1L, NA_integer_, 0L)) +}) + + +test_that("iif-0002.106", { + expect_identical(iif(c(TRUE, NA, FALSE), 1L, rep(0L,3L), NA_integer_), c(1L, NA_integer_, 0L)) +}) + + +test_that("iif-0002.107", { + expect_identical(iif(c(TRUE, NA, FALSE), 1+0i, 0+0i, NA_complex_), c(1+0i, NA_complex_, 0+0i)) +}) + + +test_that("iif-0002.108", { + expect_identical(iif(c(TRUE, NA, FALSE), rep(1+0i,3L), 0+0i, NA_complex_), c(1+0i, NA_complex_, 0+0i)) +}) + + +test_that("iif-0002.109", { + expect_identical(iif(c(TRUE, NA, FALSE), rep(1+0i,3L), rep(0+0i,3L), NA_complex_), c(1+0i, NA_complex_, 0+0i)) +}) + + +test_that("iif-0002.110", { + expect_identical(iif(c(TRUE, NA, FALSE), 1+0i, rep(0+0i,3L), NA_complex_), c(1+0i, NA_complex_, 0+0i)) +}) + +test_vec1 = -5L:5L < 0L +test_vec2 = -5L:5L > 0L +test_vec3 = -5L:5L < 5L +test_vec_na1 = c(test_vec1, NA) +test_vec_na2 = c(test_vec2, NA) +out_vec = c(1,1,1,1,1,NA,0,0,0,0,0) +out_vec_def = c(1,1,1,1,1,2,0,0,0,0,0) +out_vec_na= c(1,1,1,1,1,NA,0,0,0,0,0,NA) +out_vec_oc= c(1,1,1,1,1,NA,NA,NA,NA,NA,NA) +class2132 = setClass("class2132", slots=list(x="numeric")) +s1 = class2132(x=20191231) +s2 = class2132(x=20191230) +V1 = rnorm(1000000L) +V2 = rnorm(1000000L) +V3 = rnorm(1000000L) +V0 = nif( + V1 > 0 & V2 <= 1 & V3 > 1, V2 * 100L, + V1 > 1 & V2 <= 0 & V3 > 0, V3 * 100L, + V1 > -1 & V2 <= 2 & V3 > 1, V1 * 100L, + V1 > 1 & V2 <= 0 & V3 > 2, 300, + V1 > 0 & V2 <= 1 & V3 > 1, 100, + V1 > -1 & V2 <= 0 & V3 > -1, V1 * 100L, + default = 0 +) +V4 = iif(V1 > 0 & V2 <= 1 & V3 > 1, V2 * 100L, + iif(V1 > 1 & V2 <= 0 & V3 > 0, V3 * 100L, + iif(V1 > -1 & V2 <= 2 & V3 > 1, V1 * 100L, + iif(V1 > 1 & V2 <= 0 & V3 > 2, 300, + iif(V1 > 0 & V2 <= 1 & V3 > 1, 100, + iif(V1 > -1 & V2 <= 0 & V3 > -1, V1 * 100L, 0) + ) + ) + ) + ) +) +n = 1e7 +x = structure(rnorm(n), class = 'abc') + +test_that("nif-0003.001", { + expect_identical(nif(test_vec1, 1L, test_vec2, 0L), as.integer(out_vec)) +}) + + +test_that("nif-0003.002", { + expect_identical(nif(test_vec1, 1, test_vec2, 0), out_vec) +}) + + +test_that("nif-0003.003", { + expect_identical(nif(test_vec1, "1", test_vec2, "0"), as.character(out_vec)) +}) + + +test_that("nif-0003.004", { + expect_identical(nif(test_vec1, TRUE, test_vec2, FALSE), as.logical(out_vec)) +}) + + +test_that("nif-0003.005", { + expect_kit_equal(nif(test_vec1, 1+0i, test_vec2, 0+0i), as.complex(out_vec)) +}) + + +test_that("nif-0003.006", { + expect_identical(nif(test_vec1, list(1), test_vec2, list(0)), list(1,1,1,1,1, NULL, 0, 0, 0, 0, 0)) +}) + + +test_that("nif-0003.007", { + expect_identical(nif(test_vec1, as.Date("2019-10-11"), test_vec2, as.Date("2019-10-14")), c(rep(as.Date("2019-10-11"),5),NA,rep(as.Date("2019-10-14"),5))) +}) + + +test_that("nif-0003.008", { + expect_identical(nif(test_vec1, factor("a", levels=letters[1:3]), test_vec2, factor("b", levels=letters[1:3])), factor(c(rep("a",5),NA,rep("b",5)), levels=letters[1:3])) +}) + + +test_that("nif-0003.009", { + expect_identical(nif(test_vec1, 1L, test_vec2, 0L, default=2L), as.integer(out_vec_def)) +}) + + +test_that("nif-0003.010", { + expect_identical(nif(test_vec1, 1, test_vec2, 0,default=2), out_vec_def) +}) + + +test_that("nif-0003.011", { + expect_identical(nif(test_vec1, "1", test_vec2, "0", default ="2"), as.character(out_vec_def)) +}) + + +test_that("nif-0003.012", { + expect_identical(nif(test_vec1, TRUE, test_vec2, FALSE, default=TRUE), as.logical(out_vec_def)) +}) + + +test_that("nif-0003.013", { + expect_identical(nif(test_vec1, 1+0i, test_vec2, 0+0i, default=2+0i), as.complex(out_vec_def)) +}) + + +test_that("nif-0003.014", { + expect_identical(nif(test_vec1, list(1), test_vec2, list(0),default=list(2)), list(1,1,1,1,1, 2, 0, 0, 0, 0, 0)) +}) + + +test_that("nif-0003.015", { + expect_identical(nif(test_vec1, as.Date("2019-10-11"), test_vec2, as.Date("2019-10-14"),default=as.Date("2019-10-15")), c(rep(as.Date("2019-10-11"),5),as.Date("2019-10-15"),rep(as.Date("2019-10-14"),5))) +}) + + +test_that("nif-0003.016", { + expect_identical(nif(test_vec1, factor("a", levels=letters[1:3]), test_vec2, factor("b", levels=letters[1:3]),default=factor("c", levels=letters[1:3])), factor(c(rep("a",5),"c",rep("b",5)), levels=letters[1:3])) +}) + + +test_that("nif-0003.017", { + expect_error(nif(test_vec1, as.raw(1), test_vec2, as.raw(0)), regexp = "Type raw is not supported.", fixed = TRUE) +}) + + +test_that("nif-0003.018", { + expect_error(nif(test_vec1, factor("a", levels=letters[1]), test_vec2, factor("b", levels=letters[1:3])), regexp = "Argument #2 and argument #4 are both factor but their levels are different.", fixed = TRUE) +}) + + +test_that("nif-0003.019", { + expect_error(nif(test_vec1, factor("a", levels=letters[1:2]), test_vec2, factor("b", levels=letters[1:2]),default=factor("c", levels=letters[1:3])), regexp = "Resulting value and 'default' are both type factor but their levels are different.", fixed = TRUE) +}) + + +test_that("nif-0003.020", { + expect_error(nif(test_vec1, 1L:10L, test_vec2, 3L:12L, test_vec2), regexp = "Received 5 inputs; please supply an even number of arguments in ... consisting of logical condition, resulting value pairs (in that order). Note that argument 'default' must be named explicitly (e.g.: default=0)", fixed = TRUE) +}) + + +test_that("nif-0003.021", { + expect_error(nif(test_vec1, 1L, test_vec2, 3), regexp = "Argument #4 is of type double, however argument #2 is of type integer. Please make sure all output values have the same type.", fixed = TRUE) +}) + + +test_that("nif-0003.022", { + expect_error(nif(test_vec1, "FALSE", test_vec2, TRUE), regexp = "Argument #4 is of type logical, however argument #2 is of type character. Please make sure all output values have the same type.", fixed = TRUE) +}) + + +test_that("nif-0003.023", { + expect_error(nif(test_vec1, "FALSE", test_vec2, 5L), regexp = "Argument #4 is of type integer, however argument #2 is of type character. Please make sure all output values have the same type.", fixed = TRUE) +}) + + +test_that("nif-0003.024", { + expect_error(nif(test_vec1, as.Date("2019-10-11"), test_vec2, as.Date("2019-10-14"),default="2019-10-15"), regexp = "Resulting value is of type double but 'default' is of type character. Please make sure that both arguments have the same type.", fixed = TRUE) +}) + + +test_that("nif-0003.025", { + expect_error(nif(test_vec1, as.Date("2019-10-11"), test_vec2, as.Date("2019-10-14"),default=123), regexp = "Resulting value has different class than 'default'. Please make sure that both arguments have the same class.", fixed = TRUE) +}) + + +test_that("nif-0003.026", { + expect_identical(nif(test_vec1, 1L, test_vec2, 0L, default=rep(2L, 11)), as.integer(out_vec_def)) +}) + + +test_that("nif-0003.027", { + expect_identical(nif(test_vec1, 1L, test_vec2, rep(0L, 11), default=rep(2L, 11)), as.integer(out_vec_def)) +}) + + +test_that("nif-0003.028", { + expect_identical(nif(test_vec1, rep(1L,11L), test_vec2, rep(0L,11L)), as.integer(out_vec)) +}) + + +test_that("nif-0003.029", { + expect_identical(nif(test_vec1, rep(1,11L), test_vec2, rep(0,11L)), out_vec) +}) + + +test_that("nif-0003.030", { + expect_identical(nif(test_vec1, rep("1",11L), test_vec2, rep("0",11L)), as.character(out_vec)) +}) + + +test_that("nif-0003.031", { + expect_identical(nif(test_vec1, rep(TRUE,11L), test_vec2, rep(FALSE,11L)), as.logical(out_vec)) +}) + + +test_that("nif-0003.032", { + expect_kit_equal(nif(test_vec1, rep(1+0i,11L), test_vec2, rep(0+0i,11L)), as.complex(out_vec)) +}) + + +test_that("nif-0003.033", { + expect_identical(nif(test_vec1, rep(list(1),11L), test_vec2, rep(list(0),11L)), list(1,1,1,1,1, NULL, 0, 0, 0, 0, 0)) +}) + + +test_that("nif-0003.034", { + expect_identical(nif(test_vec1, rep(as.Date("2019-10-11"),11L), test_vec2, rep(as.Date("2019-10-14"),11L)), c(rep(as.Date("2019-10-11"),5),NA,rep(as.Date("2019-10-14"),5))) +}) + + +test_that("nif-0003.035", { + expect_identical(nif(test_vec1, rep(factor("a", levels=letters[1:3]),11L), test_vec2, rep(factor("b", levels=letters[1:3]),11L)), factor(c(rep("a",5),NA,rep("b",5)), levels=letters[1:3])) +}) + + +test_that("nif-0003.036", { + expect_identical(nif(test_vec_na1, 1L, test_vec_na2, 0L), as.integer(out_vec_na)) +}) + + +test_that("nif-0003.037", { + expect_identical(nif(test_vec_na1, 1, test_vec_na2, 0), out_vec_na) +}) + + +test_that("nif-0003.038", { + expect_identical(nif(test_vec_na1, "1", test_vec_na2, "0"), as.character(out_vec_na)) +}) + + +test_that("nif-0003.039", { + expect_identical(nif(test_vec_na1, TRUE, test_vec_na2, FALSE), as.logical(out_vec_na)) +}) + + +test_that("nif-0003.040", { + expect_kit_equal(nif(test_vec_na1, 1+0i, test_vec_na2, 0+0i), as.complex(out_vec_na)) +}) + + +test_that("nif-0003.041", { + expect_identical(nif(test_vec_na1, list(1), test_vec_na2, list(0)), list(1,1,1,1,1, NULL, 0, 0, 0, 0, 0,NULL)) +}) + + +test_that("nif-0003.042", { + expect_identical(nif(c(TRUE,TRUE,TRUE,FALSE,FALSE),factor(NA,levels=letters[1:5]),c(FALSE,FALSE,FALSE,TRUE,TRUE),factor(letters[1:5])), factor(c(NA,NA,NA,"d","e"),levels=letters[1:5])) +}) + + +test_that("nif-0003.043", { + expect_identical(nif(c(TRUE,TRUE,TRUE,FALSE,NA,FALSE),factor(NA,levels=letters[1:6]),c(FALSE,FALSE,FALSE,TRUE,NA,TRUE),factor(letters[1:6])), factor(c(NA,NA,NA,"d",NA,"f"),levels=letters[1:6])) +}) + + +test_that("nif-0003.044", { + expect_identical(nif(c(TRUE,TRUE,TRUE,FALSE,NA,FALSE),factor(letters[1:6]),c(FALSE,FALSE,FALSE,TRUE,NA,TRUE),factor(NA,levels = letters[1:6])), factor(c("a","b","c",NA,NA,NA),levels=letters[1:6])) +}) + + +test_that("nif-0003.045", { + expect_identical(nif(c(TRUE,NA,TRUE,FALSE,FALSE,FALSE),factor(NA),c(TRUE,TRUE,TRUE,FALSE,NA,FALSE),factor(NA)), factor(c(NA,NA,NA,NA,NA,NA))) +}) + + +test_that("nif-0003.046", { + expect_error(nif(test_vec1, 1L, test_vec2, 0L, default=NA), regexp = "Resulting value is of type integer but 'default' is of type logical. Please make sure that both arguments have the same type.", fixed = TRUE) +}) + + +test_that("nif-0003.047", { + expect_error(nif(test_vec1, 1L, test_vec2, rep(0L, 11), default=NA), regexp = "Resulting value is of type integer but 'default' is of type logical. Please make sure that both arguments have the same type.", fixed = TRUE) +}) + + +test_that("nif-0003.048", { + expect_identical(nif(TRUE, list(data.frame(1:5)), FALSE, list(data.frame(5:1))), list(data.frame(1:5))) +}) + + +test_that("nif-0003.049", { + expect_identical(nif(FALSE, list(data.frame(1:5)), TRUE, list(data.frame(5:1))), list(data.frame(5:1))) +}) + + +test_that("nif-0003.050", { + expect_error(nif(1L,1L,TRUE,0L), regexp = "Argument #1 must be logical.", fixed = TRUE) +}) + + +test_that("nif-0003.051", { + expect_identical(nif(TRUE,1L,5L,0L), 1L) +}) + + +test_that("nif-0003.052", { + expect_identical(nif(test_vec1, 1L, test_vec2, 0L, test_vec3, 2L), as.integer(out_vec_def)) +}) + + +test_that("nif-0003.053", { + expect_identical(nif(test_vec1, 1, test_vec2, 0, test_vec3, 2), out_vec_def) +}) + + +test_that("nif-0003.054", { + expect_identical(nif(test_vec1, "1", test_vec2, "0", test_vec3, "2"), as.character(out_vec_def)) +}) + + +test_that("nif-0003.055", { + expect_identical(nif(test_vec1, TRUE, test_vec2, FALSE, test_vec3, TRUE), as.logical(out_vec_def)) +}) + + +test_that("nif-0003.056", { + expect_identical(nif(test_vec1, 1+0i, test_vec2, 0+0i, test_vec3, 2+0i), as.complex(out_vec_def)) +}) + + +test_that("nif-0003.057", { + expect_identical(nif(test_vec1, list(1), test_vec2, list(0), test_vec3, list(2)), list(1,1,1,1,1, 2, 0, 0, 0, 0, 0)) +}) + + +test_that("nif-0003.058", { + expect_identical(nif(test_vec1, as.Date("2019-10-11"), test_vec2, as.Date("2019-10-14"), test_vec3, as.Date("2019-10-15")), c(rep(as.Date("2019-10-11"),5),as.Date("2019-10-15"),rep(as.Date("2019-10-14"),5))) +}) + + +test_that("nif-0003.059", { + expect_identical(nif(test_vec1, factor("a", levels=letters[1:3]), test_vec2, factor("b", levels=letters[1:3]), test_vec3, factor("c", levels=letters[1:3])), factor(c(rep("a",5),"c",rep("b",5)), levels=letters[1:3])) +}) + + +test_that("nif-0003.060", { + expect_identical(nif(test_vec1, 1L), as.integer(out_vec_oc)) +}) + + +test_that("nif-0003.061", { + expect_identical(nif(test_vec1, 1), out_vec_oc) +}) + + +test_that("nif-0003.062", { + expect_identical(nif(test_vec1, "1"), as.character(out_vec_oc)) +}) + + +test_that("nif-0003.063", { + expect_identical(nif(test_vec1, TRUE), as.logical(out_vec_oc)) +}) + + +test_that("nif-0003.064", { + expect_kit_equal(nif(test_vec1, 1+0i), as.complex(out_vec_oc)) +}) + + +test_that("nif-0003.065", { + expect_identical(nif(test_vec1, list(1)), list(1,1,1,1,1, NULL, NULL, NULL, NULL, NULL, NULL)) +}) + + +test_that("nif-0003.066", { + expect_identical(nif(test_vec1, as.Date("2019-10-11")), c(rep(as.Date("2019-10-11"),5),rep(NA,6))) +}) + + +test_that("nif-0003.067", { + expect_identical(nif(test_vec1, factor("a", levels=letters[1:3])), factor(c(rep("a",5),rep("NA",6)), levels=letters[1:3])) +}) + + +test_that("nif-0003.068", { + expect_error(nif(test_vec1, 1L, default = 1:2), regexp = "Length of 'default' must either be 1 or length of logical condition.", fixed = TRUE) +}) + + +test_that("nif-0003.069", { + expect_error(nif(test_vec1, 1L, test_vec_na1, 2L), regexp = "Argument #3 has a different length than argument #1. Please make sure all logical conditions have the same length.", fixed = TRUE) +}) + + +test_that("nif-0003.070", { + expect_error(nif(test_vec1, as.Date("2019-10-11"), test_vec2, 2), regexp = "Argument #4 has different class than argument #2, Please make sure all output values have the same class.", fixed = TRUE) +}) + + +test_that("nif-0003.071", { + expect_error(nif(test_vec1, 1L, test_vec2, 2:3), regexp = "Length of output value #4 must either be 1 or length of logical condition.", fixed = TRUE) +}) + + +test_that("nif-0003.072", { + expect_identical(nif(TRUE, 1L, FALSE, stop("bang!")), 1L) +}) + + +test_that("nif-0003.073", { + expect_identical(nif(test_vec1, 1L, test_vec2, 0:10), as.integer(c( 1, 1, 1, 1, 1, NA, 6, 7, 8, 9, 10))) +}) + + +test_that("nif-0003.074", { + expect_identical(nif(test_vec1, 0:10, test_vec2, 0L), as.integer(c( 0, 1, 2, 3, 4, NA, 0, 0, 0, 0, 0))) +}) + + +test_that("nif-0003.075", { + expect_identical(nif(test_vec1, 1, test_vec2, as.numeric(0:10)), as.numeric(c( 1, 1, 1, 1, 1, NA, 6, 7, 8, 9, 10))) +}) + + +test_that("nif-0003.076", { + expect_identical(nif(test_vec1, as.numeric(0:10), test_vec2, 0), as.numeric(c( 0, 1, 2, 3, 4, NA, 0, 0, 0, 0, 0))) +}) + + +test_that("nif-0003.077", { + expect_identical(nif(test_vec1, "1", test_vec2, as.character(0:10)), as.character(c( 1, 1, 1, 1, 1, NA, 6, 7, 8, 9, 10))) +}) + + +test_that("nif-0003.078", { + expect_identical(nif(test_vec1, as.character(0:10), test_vec2, "0"), as.character(c( 0, 1, 2, 3, 4, NA, 0, 0, 0, 0, 0))) +}) + + +test_that("nif-0003.079", { + expect_identical(nif(test_vec1, TRUE, test_vec2, rep(FALSE, 11L)), as.logical(out_vec)) +}) + + +test_that("nif-0003.080", { + expect_identical(nif(test_vec1, rep(TRUE, 11L), test_vec2, FALSE), as.logical(out_vec)) +}) + + +test_that("nif-0003.081", { + expect_kit_equal(nif(test_vec1, 1+0i, test_vec2, rep(0+0i, 11L)), as.complex(out_vec)) +}) + + +test_that("nif-0003.082", { + expect_kit_equal(nif(test_vec1, rep(1+0i, 11L), test_vec2, 0+0i), as.complex(out_vec)) +}) + + +test_that("nif-0003.083", { + expect_identical(nif(test_vec1, list(rep(1, 11L)), test_vec2, list(0)), list(rep(1, 11L),rep(1, 11L),rep(1, 11L),rep(1, 11L),rep(1, 11L), NULL, 0, 0, 0, 0, 0)) +}) + + +test_that("nif-0003.084", { + expect_identical(nif(test_vec1, list(1), test_vec2, list(rep(0,11L))), list(1,1,1,1,1, NULL, rep(0,11L), rep(0,11L), rep(0,11L), rep(0,11L), rep(0,11L))) +}) + + +test_that("nif-0003.085", { + expect_identical(nif(test_vec1, list(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1), test_vec2, list(0)), list(1,1,1,1,1, NULL, 0, 0, 0, 0, 0)) +}) + + +test_that("nif-0003.086", { + expect_identical(nif(test_vec1, list(1), test_vec2, list(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)), list(1,1,1,1,1, NULL, 0, 0, 0, 0, 0)) +}) + + +test_that("nif-0003.087", { + expect_error(nif(TRUE, s1, FALSE, s2), regexp = "S4 class objects are not supported.", fixed = TRUE) +}) + + +test_that("nif-0003.088", { + expect_identical(nif(test_vec1, rep(1L, 11), test_vec2, 0L, default=rep(2L, 11)), as.integer(out_vec_def)) +}) + + +test_that("nif-0003.089", { + expect_identical(nif(test_vec1, 1, test_vec2, 0, default=rep(2, 11)), as.numeric(out_vec_def)) +}) + + +test_that("nif-0003.090", { + expect_identical(nif(test_vec1, rep(1, 11), test_vec2, rep(0, 11), default=rep(2, 11)), as.numeric(out_vec_def)) +}) + + +test_that("nif-0003.091", { + expect_identical(nif(test_vec1, 1, test_vec2, rep(0, 11), default=rep(2, 11)), as.numeric(out_vec_def)) +}) + + +test_that("nif-0003.092", { + expect_identical(nif(test_vec1, rep(1, 11), test_vec2, 0, default=rep(2, 11)), as.numeric(out_vec_def)) +}) + + +test_that("nif-0003.093", { + expect_identical(nif(test_vec1, 1+0i, test_vec2, 0+0i, default=rep(2+0i, 11)), as.complex(out_vec_def)) +}) + + +test_that("nif-0003.094", { + expect_identical(nif(test_vec1, rep(1+0i, 11), test_vec2, rep(0+0i, 11), default=rep(2+0i, 11)), as.complex(out_vec_def)) +}) + + +test_that("nif-0003.095", { + expect_identical(nif(test_vec1, 1+0i, test_vec2, rep(0+0i, 11), default=rep(2+0i, 11)), as.complex(out_vec_def)) +}) + + +test_that("nif-0003.096", { + expect_identical(nif(test_vec1, rep(1+0i, 11), test_vec2, 0+0i, default=rep(2+0i, 11)), as.complex(out_vec_def)) +}) + + +test_that("nif-0003.097", { + expect_identical(nif(test_vec1, "1", test_vec2, "0", default=rep("2", 11)), as.character(out_vec_def)) +}) + + +test_that("nif-0003.098", { + expect_identical(nif(test_vec1, rep("1", 11), test_vec2, rep("0", 11), default=rep("2", 11)), as.character(out_vec_def)) +}) + + +test_that("nif-0003.099", { + expect_identical(nif(test_vec1, "1", test_vec2, rep("0", 11), default=rep("2", 11)), as.character(out_vec_def)) +}) + + +test_that("nif-0003.100", { + expect_identical(nif(test_vec1, rep("1", 11), test_vec2, "0", default=rep("2", 11)), as.character(out_vec_def)) +}) + + +test_that("nif-0003.101", { + expect_identical(nif(test_vec1, TRUE, test_vec2, FALSE, default=rep(TRUE, 11)), as.logical(out_vec_def)) +}) + + +test_that("nif-0003.102", { + expect_identical(nif(test_vec1, rep(TRUE, 11), test_vec2, rep(FALSE, 11), default=rep(TRUE, 11)), as.logical(out_vec_def)) +}) + + +test_that("nif-0003.103", { + expect_identical(nif(test_vec1, TRUE, test_vec2, rep(FALSE, 11), default=rep(TRUE, 11)), as.logical(out_vec_def)) +}) + + +test_that("nif-0003.104", { + expect_identical(nif(test_vec1, rep(TRUE, 11), test_vec2, FALSE, default=rep(TRUE, 11)), as.logical(out_vec_def)) +}) + + +test_that("nif-0003.105", { + expect_identical(nif(test_vec1, list(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1), test_vec2, list(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),default=list(2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)), list(1,1,1,1,1, 2, 0, 0, 0, 0, 0)) +}) + + +test_that("nif-0003.106", { + expect_identical(nif(test_vec1, list(1), test_vec2, list(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),default=list(2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)), list(1,1,1,1,1, 2, 0, 0, 0, 0, 0)) +}) + + +test_that("nif-0003.107", { + expect_identical(nif(test_vec1, list(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1), test_vec2, list(0),default=list(2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)), list(1,1,1,1,1, 2, 0, 0, 0, 0, 0)) +}) + + +test_that("nif-0003.108", { + expect_identical(nif(test_vec1, list(1), test_vec2, list(0),default=list(2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)), list(1,1,1,1,1, 2, 0, 0, 0, 0, 0)) +}) + + +test_that("0003.109", { + expect_identical(V0, V4) +}) + + +test_that("nif-0003.110", { + expect_identical(nif(x <= -100, structure(x * 1.0, class = 'abc'), + x <= -10, structure(x * 1.0, class = 'abc'), + x <= 0, structure(x * 1.0, class = 'abc'), + x <= 100, structure(x * 1.0, class = 'abc'), + x <= 1000, structure(x * 1.0, class = 'abc'), + x >= 1000, structure(x * 1.0, class = 'abc')), structure(x, class = 'abc')) +}) + + +test_that("nif-0003.111", { + expect_error(nif(c(TRUE,FALSE), 1, c(FALSE,TRUE), s2), regexp = "S4 class objects are not supported.", fixed = TRUE) +}) + diff --git a/tests/testthat/test-parallel.R b/tests/testthat/test-parallel.R new file mode 100644 index 0000000..8c968cf --- /dev/null +++ b/tests/testthat/test-parallel.R @@ -0,0 +1,888 @@ +# Tests for parallel reductions — psum, pprod, fpmin, fpmax, prange, pall, pany, pmean +# Migrated from tests/test_kit.R (custom check() suite) to testthat 3e — see issue #54. +# Each legacy check("id", actual, expected) maps to expect_identical(); +# 31 tolerant cases (identical FALSE but all.equal+typeof TRUE) use expect_kit_equal(); +# check(..., error=) maps to expect_error(regexp=, fixed=TRUE). +# Legacy IDs are preserved as test_that() labels (prefixed by function for uniqueness). +# Setup and expectations stay interleaved in legacy order: later sections may +# redefine x/y/out_vec/... so setup must not be hoisted above earlier tests. + +set.seed(123) + +x = c(1, 3, NA, 5) +y = c(2, NA, 4, 1) +z = c(3, 4, 4, 1) +x0 = rnorm(1000L) +y0 = rnorm(1000L) +z0 = rnorm(1000L) + +test_that("psum-0005.001", { + expect_identical(psum(x, y, z, na.rm = FALSE), c(6, NA, NA, 7)) +}) + + +test_that("psum-0005.002", { + expect_identical(psum(x, y, z, na.rm = TRUE), c(6, 7, 8, 7)) +}) + + +test_that("psum-0005.003", { + expect_identical(psum(as.integer(x), as.integer(y), as.integer(z), na.rm = FALSE), c(6L, NA_integer_, NA_integer_, 7L)) +}) + + +test_that("psum-0005.004", { + expect_identical(psum(as.integer(x), as.integer(y), as.integer(z), na.rm = TRUE), c(6L, 7L, 8L, 7L)) +}) + + +test_that("psum-0005.005", { + expect_error(psum(as.raw(z), y, na.rm = TRUE), regexp = "Argument 1 is of type raw. Only integer/logical, double and complex types are supported. A data.frame (of the previous types) is also supported as a single input.", fixed = TRUE) +}) + + +test_that("psum-0005.006", { + expect_error(psum(x, y, 1:2, na.rm = FALSE), regexp = "Argument 3 is of length 2 but argument 1 is of length 4. If you wish to 'recycle' your argument, please use rep() to make this intent clear to the readers of your code.", fixed = TRUE) +}) + + +test_that("psum-0005.007", { + expect_error(psum(1:10, 1:5, na.rm = FALSE), regexp = "Argument 2 is of length 5 but argument 1 is of length 10. If you wish to 'recycle' your argument, please use rep() to make this intent clear to the readers of your code.", fixed = TRUE) +}) + + +test_that("psum-0005.008", { + expect_error(psum(x, as.raw(z), y, na.rm = TRUE), regexp = "Argument 2 is of type raw. Only integer/logical, double and complex types are supported.", fixed = TRUE) +}) + + +test_that("psum-0005.009", { + expect_identical(psum(1:10, 1:10, 21:30), 1:10 + 1:10 + 21:30) +}) + + +test_that("psum-0005.010", { + expect_error(psum(x, y, z, na.rm = NA), regexp = "Argument 'na.rm' must be TRUE or FALSE and length 1.", fixed = TRUE) +}) + + +test_that("psum-0005.011", { + expect_identical(psum(x, na.rm = FALSE), x) +}) + + +test_that("psum-0005.012", { + expect_identical(psum(as.integer(x), y, z, na.rm = TRUE), c(6, 7, 8, 7)) +}) + + +test_that("psum-0005.013", { + expect_identical(psum(c(1,3,NA,5,NA), c(2,NA,4,1,NA), na.rm = TRUE), c(3, 3, 4, 6, 0)) +}) + + +test_that("psum-0005.014", { + expect_identical(psum(x, y, as.integer(z), na.rm = FALSE), c(6, NA, NA, 7)) +}) + + +test_that("psum-0005.015", { + expect_error(psum(na.rm = FALSE), regexp = "Please supply at least 1 argument. (0 argument supplied)", fixed = TRUE) +}) + + +test_that("psum-0005.016", { + expect_identical(psum(x0, y0, z0), x0+y0+z0) +}) + + +test_that("psum-0005.017", { + expect_identical(psum(as.complex(x0), as.complex(y0), as.complex(z0)), as.complex(x0)+as.complex(y0)+as.complex(z0)) +}) + + +test_that("psum-0005.018", { + expect_identical(psum(as.complex(x0), as.complex(y0), z0), as.complex(x0)+as.complex(y0)+z0) +}) + + +test_that("psum-0005.019", { + expect_identical(psum(as.complex(x), as.complex(y), as.complex(z), na.rm = FALSE), as.complex(c(6, NA, NA, 7))) +}) + + +test_that("psum-0005.020", { + expect_identical(psum(as.complex(x), as.complex(y), as.complex(z), na.rm = TRUE), as.complex(c(6, 7, 8, 7))) +}) + + +test_that("psum-0005.021", { + expect_identical(psum(x, y, z, rep(Inf,4L), na.rm = FALSE), x+y+z+Inf) +}) + + +test_that("psum-0005.022", { + expect_identical(psum(x, y, z, rep(Inf,4L), na.rm = TRUE), rep(Inf, 4L)) +}) + + +test_that("psum-0005.023", { + expect_identical(psum(NA_integer_, na.rm = TRUE), 0L) +}) + + +test_that("psum-0005.024", { + expect_identical(psum(NA_real_, na.rm = TRUE), 0) +}) + + +test_that("psum-0005.025", { + expect_identical(psum(NA_complex_, na.rm = TRUE), 0+0i) +}) + + +test_that("psum-0005.026", { + expect_identical(psum(iris[,1:2]), rowSums(iris[,1:2])) +}) + + +test_that("psum-0005.027", { + expect_error(psum(iris[,1:2],iris[,1:2]), regexp = "Argument 1 is of type list. Only integer/logical, double and complex types are supported. A data.frame (of the previous types) is also supported as a single input.", fixed = TRUE) +}) + + +test_that("psum-0005.028", { + expect_error(psum(1:150,iris$Species, na.rm = FALSE), regexp = "Function 'psum' is not meaningful for factors.", fixed = TRUE) +}) + + +test_that("psum-0005.029", { + expect_identical(psum(unclass(mtcars)), psum(mtcars)) +}) + + +test_that("pprod-0006.001", { + expect_identical(pprod(x, y, z, na.rm = FALSE), c(6, NA, NA, 5)) +}) + + +test_that("pprod-0006.002", { + expect_identical(pprod(x, y, z, na.rm = TRUE), c(6, 12, 16, 5)) +}) + + +test_that("pprod-0006.003", { + expect_identical(pprod(as.integer(x), as.integer(y), as.integer(z), na.rm = FALSE), c(6, NA_real_, NA_real_, 5)) +}) + + +test_that("pprod-0006.004", { + expect_identical(pprod(as.integer(x), as.integer(y), as.integer(z), na.rm = TRUE), c(6, 12, 16, 5)) +}) + + +test_that("pprod-0006.005", { + expect_error(pprod(as.raw(z), y, na.rm = TRUE), regexp = "Argument 1 is of type raw. Only integer/logical, double and complex types are supported. A data.frame (of the previous types) is also supported as a single input.", fixed = TRUE) +}) + + +test_that("pprod-0006.006", { + expect_error(pprod(x, y, 1:2, na.rm = FALSE), regexp = "Argument 3 is of length 2 but argument 1 is of length 4. If you wish to 'recycle' your argument, please use rep() to make this intent clear to the readers of your code.", fixed = TRUE) +}) + + +test_that("pprod-0006.007", { + expect_error(pprod(1:10, 1:5, na.rm = FALSE), regexp = "Argument 2 is of length 5 but argument 1 is of length 10. If you wish to 'recycle' your argument, please use rep() to make this intent clear to the readers of your code.", fixed = TRUE) +}) + + +test_that("pprod-0006.008", { + expect_error(pprod(x, as.raw(z), y, na.rm = TRUE), regexp = "Argument 2 is of type raw. Only integer/logical, double and complex types are supported.", fixed = TRUE) +}) + + +test_that("pprod-0006.009", { + expect_identical(pprod(1:10, 1:10, 21:30), as.double(1:10 * 1:10 * 21:30)) +}) + + +test_that("pprod-0006.010", { + expect_error(pprod(x, y, z, na.rm = NA), regexp = "Argument 'na.rm' must be TRUE or FALSE and length 1.", fixed = TRUE) +}) + + +test_that("pprod-0006.011", { + expect_identical(pprod(x, na.rm = FALSE), x) +}) + + +test_that("pprod-0006.012", { + expect_identical(pprod(as.integer(x), y, z, na.rm = TRUE), c(6, 12, 16, 5)) +}) + + +test_that("pprod-0006.013", { + expect_identical(pprod(c(1,3,NA,5,NA), c(2,NA,4,1,NA), na.rm = TRUE), c(2, 3, 4, 5, 1)) +}) + + +test_that("pprod-0006.014", { + expect_identical(pprod(x, y, as.integer(z), na.rm = FALSE), c(6, NA, NA, 5)) +}) + + +test_that("pprod-0006.015", { + expect_error(pprod(na.rm = FALSE), regexp = "Please supply at least 1 argument. (0 argument supplied)", fixed = TRUE) +}) + + +test_that("pprod-0006.016", { + expect_identical(pprod(x0, y0, z0), x0*y0*z0) +}) + + +test_that("pprod-0006.017", { + expect_identical(pprod(as.complex(x0), as.complex(y0), as.complex(z0)), as.complex(x0)*as.complex(y0)*as.complex(z0)) +}) + + +test_that("pprod-0006.018", { + expect_identical(pprod(as.complex(x0), as.complex(y0), z0), as.complex(x0)*as.complex(y0)*z0) +}) + + +test_that("pprod-0006.019", { + expect_kit_equal(pprod(as.complex(x), as.complex(y), as.complex(z), na.rm = FALSE), as.complex(c(6, NA, NA, 5))) +}) + + +test_that("pprod-0006.020", { + expect_identical(pprod(as.complex(x), as.complex(y), as.complex(z), na.rm = TRUE), as.complex(c(6, 12, 16, 5))) +}) + + +test_that("pprod-0006.021", { + expect_identical(pprod(x, y, z, rep(Inf, 4L), na.rm = FALSE), x*y*z*Inf) +}) + + +test_that("pprod-0006.022", { + expect_identical(pprod(x, y, z, rep(Inf, 4L), na.rm = TRUE), rep(Inf, 4L)) +}) + + +test_that("pprod-0006.023", { + expect_identical(pprod(NA_integer_, na.rm = TRUE), 1) +}) + + +test_that("pprod-0006.024", { + expect_identical(pprod(NA_real_, na.rm = TRUE), 1) +}) + + +test_that("pprod-0006.025", { + expect_identical(pprod(NA_complex_, na.rm = TRUE), 1+0i) +}) + + +test_that("pprod-0006.026", { + expect_identical(pprod(iris[,1:2]), iris$Sepal.Length*iris$Sepal.Width) +}) + + +test_that("pprod-0006.027", { + expect_error(pprod(iris[,1:2],iris[,1:2]), regexp = "Argument 1 is of type list. Only integer/logical, double and complex types are supported. A data.frame (of the previous types) is also supported as a single input.", fixed = TRUE) +}) + + +test_that("pprod-0006.028", { + expect_error(pprod(1:150,iris$Species, na.rm = FALSE), regexp = "Function 'pprod' is not meaningful for factors.", fixed = TRUE) +}) + + +test_that("pprod-0006.029", { + expect_identical(pprod(unclass(mtcars)), pprod(mtcars)) +}) + +x = c(1, 3, NA, 5) +y = c(2, NA, 4, 1) +z = c(3, 4, 4, 1) +x0 = rnorm(1000L) +y0 = rnorm(1000L) +z0 = rnorm(1000L) + +test_that("fpmin-0008.001", { + expect_identical(fpmin(x, y, z, na.rm = FALSE), c(1, NA, NA, 1)) +}) + + +test_that("fpmin-0008.002", { + expect_identical(fpmin(x, y, z, na.rm = TRUE), c(1, 3, 4, 1)) +}) + + +test_that("fpmin-0008.003", { + expect_identical(fpmin(as.integer(x), as.integer(y), as.integer(z), na.rm = FALSE), c(1L, NA_integer_, NA_integer_, 1L)) +}) + + +test_that("fpmin-0008.004", { + expect_identical(fpmin(as.integer(x), as.integer(y), as.integer(z), na.rm = TRUE), c(1L, 3L, 4L, 1L)) +}) + + +test_that("fpmin-0008.005", { + expect_identical(fpmin(c(TRUE, FALSE, NA), c(FALSE, TRUE, FALSE), na.rm = FALSE), c(FALSE, FALSE, NA)) +}) + + +test_that("fpmin-0008.006", { + expect_identical(fpmin(c(TRUE, FALSE, NA), c(FALSE, TRUE, FALSE), na.rm = TRUE), c(FALSE, FALSE, FALSE)) +}) + + +test_that("fpmin-0008.007", { + expect_error(fpmin(as.raw(z), y, na.rm = TRUE), regexp = "Argument 1 is of type raw. Only integer/logical and double types are supported. A data.frame (of the previous types) is also supported as a single input.", fixed = TRUE) +}) + + +test_that("fpmin-0008.008", { + expect_error(fpmin(x, y, 1:2, na.rm = FALSE), regexp = "Argument 3 is of length 2 but argument 1 is of length 4. If you wish to 'recycle' your argument, please use rep() to make this intent clear to the readers of your code.", fixed = TRUE) +}) + + +test_that("fpmin-0008.009", { + expect_error(fpmin(x, y, z, na.rm = NA), regexp = "Argument 'na.rm' must be TRUE or FALSE and length 1.", fixed = TRUE) +}) + + +test_that("fpmin-0008.010", { + expect_identical(fpmin(x, na.rm = FALSE), x) +}) + + +test_that("fpmin-0008.011", { + expect_identical(fpmin(as.integer(x), y, z, na.rm = TRUE), c(1, 3, 4, 1)) +}) + + +test_that("fpmin-0008.012", { + expect_identical(fpmin(x, y, as.integer(z), na.rm = FALSE), c(1, NA, NA, 1)) +}) + + +test_that("fpmin-0008.013", { + expect_error(fpmin(na.rm = FALSE), regexp = "Please supply at least 1 argument. (0 argument supplied)", fixed = TRUE) +}) + + +test_that("fpmin-0008.014", { + expect_identical(fpmin(x0, y0, z0), pmin(x0, y0, z0)) +}) + + +test_that("fpmin-0008.015", { + expect_identical(fpmin(c(1,3,NA,5,NA), c(2,NA,4,1,NA), na.rm = TRUE), c(1, 3, 4, 1, NA)) +}) + + +test_that("fpmin-0008.016", { + expect_identical(fpmin(NA_integer_, na.rm = TRUE), NA_integer_) +}) + + +test_that("fpmin-0008.017", { + expect_identical(fpmin(NA_real_, na.rm = TRUE), NA_real_) +}) + + +test_that("fpmin-0008.018", { + expect_identical(fpmin(iris[,1:2]), pmin(iris$Sepal.Length, iris$Sepal.Width)) +}) + + +test_that("fpmin-0008.019", { + expect_error(fpmin(1:150,iris$Species, na.rm = FALSE), regexp = "Function 'fpmin' is not meaningful for factors.", fixed = TRUE) +}) + + +test_that("fpmax-0009.001", { + expect_identical(fpmax(x, y, z, na.rm = FALSE), c(3, NA, NA, 5)) +}) + + +test_that("fpmax-0009.002", { + expect_identical(fpmax(x, y, z, na.rm = TRUE), c(3, 4, 4, 5)) +}) + + +test_that("fpmax-0009.003", { + expect_identical(fpmax(as.integer(x), as.integer(y), as.integer(z), na.rm = FALSE), c(3L, NA_integer_, NA_integer_, 5L)) +}) + + +test_that("fpmax-0009.004", { + expect_identical(fpmax(as.integer(x), as.integer(y), as.integer(z), na.rm = TRUE), c(3L, 4L, 4L, 5L)) +}) + + +test_that("fpmax-0009.005", { + expect_identical(fpmax(c(TRUE, FALSE, NA), c(FALSE, TRUE, FALSE), na.rm = FALSE), c(TRUE, TRUE, NA)) +}) + + +test_that("fpmax-0009.006", { + expect_identical(fpmax(c(TRUE, FALSE, NA), c(FALSE, TRUE, FALSE), na.rm = TRUE), c(TRUE, TRUE, FALSE)) +}) + + +test_that("fpmax-0009.007", { + expect_error(fpmax(as.raw(z), y, na.rm = TRUE), regexp = "Argument 1 is of type raw. Only integer/logical and double types are supported. A data.frame (of the previous types) is also supported as a single input.", fixed = TRUE) +}) + + +test_that("fpmax-0009.008", { + expect_error(fpmax(x, y, 1:2, na.rm = FALSE), regexp = "Argument 3 is of length 2 but argument 1 is of length 4. If you wish to 'recycle' your argument, please use rep() to make this intent clear to the readers of your code.", fixed = TRUE) +}) + + +test_that("fpmax-0009.009", { + expect_error(fpmax(x, y, z, na.rm = NA), regexp = "Argument 'na.rm' must be TRUE or FALSE and length 1.", fixed = TRUE) +}) + + +test_that("fpmax-0009.010", { + expect_identical(fpmax(x, na.rm = FALSE), x) +}) + + +test_that("fpmax-0009.011", { + expect_identical(fpmax(as.integer(x), y, z, na.rm = TRUE), c(3, 4, 4, 5)) +}) + + +test_that("fpmax-0009.012", { + expect_identical(fpmax(x, y, as.integer(z), na.rm = FALSE), c(3, NA, NA, 5)) +}) + + +test_that("fpmax-0009.013", { + expect_error(fpmax(na.rm = FALSE), regexp = "Please supply at least 1 argument. (0 argument supplied)", fixed = TRUE) +}) + + +test_that("fpmax-0009.014", { + expect_identical(fpmax(x0, y0, z0), pmax(x0, y0, z0)) +}) + + +test_that("fpmax-0009.015", { + expect_identical(fpmax(c(1,3,NA,5,NA), c(2,NA,4,1,NA), na.rm = TRUE), c(2, 3, 4, 5, NA)) +}) + + +test_that("fpmax-0009.016", { + expect_identical(fpmax(NA_integer_, na.rm = TRUE), NA_integer_) +}) + + +test_that("fpmax-0009.017", { + expect_identical(fpmax(NA_real_, na.rm = TRUE), NA_real_) +}) + + +test_that("fpmax-0009.018", { + expect_identical(fpmax(iris[,1:2]), pmax(iris$Sepal.Length, iris$Sepal.Width)) +}) + + +test_that("fpmax-0009.019", { + expect_error(fpmax(1:150,iris$Species, na.rm = FALSE), regexp = "Function 'fpmax' is not meaningful for factors.", fixed = TRUE) +}) + + +test_that("prange-0010.001", { + expect_identical(prange(x, y, z, na.rm = FALSE), c(2, NA, NA, 4)) +}) + + +test_that("prange-0010.002", { + expect_identical(prange(x, y, z, na.rm = TRUE), c(2, 1, 0, 4)) +}) + + +test_that("prange-0010.003", { + expect_identical(prange(as.integer(x), as.integer(y), as.integer(z), na.rm = FALSE), c(2, NA, NA, 4)) +}) + + +test_that("prange-0010.004", { + expect_identical(prange(as.integer(x), as.integer(y), as.integer(z), na.rm = TRUE), c(2, 1, 0, 4)) +}) + + +test_that("prange-0010.005", { + expect_identical(prange(c(TRUE, FALSE, NA), c(FALSE, TRUE, FALSE), na.rm = FALSE), c(1, 1, NA)) +}) + + +test_that("prange-0010.006", { + expect_identical(prange(c(TRUE, FALSE, NA), c(FALSE, TRUE, FALSE), na.rm = TRUE), c(1, 1, 0)) +}) + + +test_that("prange-0010.007", { + expect_error(prange(as.raw(z), y, na.rm = TRUE), regexp = "Argument 1 is of type raw. Only integer/logical and double types are supported. A data.frame (of the previous types) is also supported as a single input.", fixed = TRUE) +}) + + +test_that("prange-0010.008", { + expect_error(prange(x, y, 1:2, na.rm = FALSE), regexp = "Argument 3 is of length 2 but argument 1 is of length 4. If you wish to 'recycle' your argument, please use rep() to make this intent clear to the readers of your code.", fixed = TRUE) +}) + + +test_that("prange-0010.009", { + expect_error(prange(x, y, z, na.rm = NA), regexp = "Argument 'na.rm' must be TRUE or FALSE and length 1.", fixed = TRUE) +}) + + +test_that("prange-0010.010", { + expect_identical(prange(x, na.rm = FALSE), c(0, 0, NA, 0)) +}) + + +test_that("prange-0010.011", { + expect_identical(prange(as.integer(x), y, z, na.rm = TRUE), c(2, 1, 0, 4)) +}) + + +test_that("prange-0010.012", { + expect_identical(prange(x, y, as.integer(z), na.rm = FALSE), c(2, NA, NA, 4)) +}) + + +test_that("prange-0010.013", { + expect_error(prange(na.rm = FALSE), regexp = "Please supply at least 1 argument. (0 argument supplied)", fixed = TRUE) +}) + + +test_that("prange-0010.014", { + expect_identical(prange(x0, y0, z0), pmax(x0, y0, z0) - pmin(x0, y0, z0)) +}) + + +test_that("prange-0010.015", { + expect_identical(prange(c(1,3,NA,5,NA), c(2,NA,4,1,NA), na.rm = TRUE), c(1, 0, 0, 4, NA)) +}) + + +test_that("prange-0010.016", { + expect_identical(prange(NA_integer_, na.rm = TRUE), NA_real_) +}) + + +test_that("prange-0010.017", { + expect_identical(prange(NA_real_, na.rm = TRUE), NA_real_) +}) + + +test_that("prange-0010.018", { + expect_identical(prange(iris[,1:2]), pmax(iris$Sepal.Length, iris$Sepal.Width) - pmin(iris$Sepal.Length, iris$Sepal.Width)) +}) + + +test_that("prange-0010.019", { + expect_error(prange(1:150,iris$Species, na.rm = FALSE), regexp = "Function 'prange' is not meaningful for factors.", fixed = TRUE) +}) + +x = c(TRUE, FALSE, NA, FALSE) +y = c(TRUE, NA, TRUE, TRUE) +z = c(TRUE, TRUE, FALSE, NA) +x0 = sample(c(TRUE, FALSE, NA),1e3,TRUE) +y0 = sample(c(TRUE, FALSE, NA),1e3,TRUE) +z0 = sample(c(TRUE, FALSE, NA),1e3,TRUE) + +test_that("pall-0009.001", { + expect_identical(pall(x, y, z, na.rm = FALSE), sapply(1:4, function(i) all(x[i],y[i],z[i],na.rm=FALSE))) +}) + + +test_that("pall-0009.002", { + expect_identical(pall(x, y, z, na.rm = TRUE), sapply(1:4, function(i) all(x[i],y[i],z[i],na.rm=TRUE))) +}) + + +test_that("pall-0009.003", { + expect_error(pall(x, y, TRUE, na.rm = FALSE), regexp = "Argument 3 is of length 1 but argument 1 is of length 4. If you wish to 'recycle' your argument, please use rep() to make this intent clear to the readers of your code.", fixed = TRUE) +}) + + +test_that("pall-0009.004", { + expect_error(pall(c(TRUE,FALSE,NA), c(TRUE,FALSE), na.rm = FALSE), regexp = "Argument 2 is of length 2 but argument 1 is of length 3. If you wish to 'recycle' your argument, please use rep() to make this intent clear to the readers of your code.", fixed = TRUE) +}) + + +test_that("pall-0009.005", { + expect_error(pall(x, y, z, na.rm = NA), regexp = "Argument 'na.rm' must be TRUE or FALSE and length 1.", fixed = TRUE) +}) + + +test_that("pall-0009.006", { + expect_identical(pall(x, na.rm = FALSE), x) +}) + + +test_that("pall-0009.007", { + expect_error(pall(na.rm = FALSE), regexp = "Please supply at least 1 argument. (0 argument supplied)", fixed = TRUE) +}) + + +test_that("pall-0009.008", { + expect_error(pall(x, as.integer(z), y, na.rm = TRUE), regexp = "Argument 2 is of type integer. Only logical type is supported.", fixed = TRUE) +}) + + +test_that("pall-0009.009", { + expect_error(pall(as.double(z), y, na.rm = TRUE), regexp = "Argument 1 is of type double. Only logical type is supported.Data.frame (of logical vectors) is also supported as a single input.", fixed = TRUE) +}) + + +test_that("pall-0009.010", { + expect_identical(pall(NA, na.rm = TRUE), TRUE) +}) + + +test_that("pall-0009.011", { + expect_identical(pall(NA, na.rm = FALSE), NA) +}) + + +test_that("pall-0009.012", { + expect_identical(pall(x0, y0, z0, na.rm = FALSE), sapply(1:1e3, function(i) all(x0[i],y0[i],z0[i],na.rm=FALSE))) +}) + + +test_that("pall-0009.013", { + expect_identical(pall(x0, y0, z0, na.rm = TRUE), sapply(1:1e3, function(i) all(x0[i],y0[i],z0[i],na.rm=TRUE))) +}) + + +test_that("pall-0009.014", { + expect_identical(pall(data.frame(x,y), na.rm = FALSE), pall(x,y, na.rm = FALSE)) +}) + + +test_that("pany-0010.001", { + expect_identical(pany(x, y, z, na.rm = FALSE), sapply(1:4, function(i) any(x[i],y[i],z[i],na.rm=FALSE))) +}) + + +test_that("pany-0010.002", { + expect_identical(pany(x, y, z, na.rm = TRUE), sapply(1:4, function(i) any(x[i],y[i],z[i],na.rm=TRUE))) +}) + + +test_that("pany-0010.003", { + expect_error(pany(x, y, TRUE, na.rm = FALSE), regexp = "Argument 3 is of length 1 but argument 1 is of length 4. If you wish to 'recycle' your argument, please use rep() to make this intent clear to the readers of your code.", fixed = TRUE) +}) + + +test_that("pany-0010.004", { + expect_error(pany(c(TRUE,FALSE,NA), c(TRUE,FALSE), na.rm = FALSE), regexp = "Argument 2 is of length 2 but argument 1 is of length 3. If you wish to 'recycle' your argument, please use rep() to make this intent clear to the readers of your code.", fixed = TRUE) +}) + + +test_that("pany-0010.005", { + expect_error(pany(x, y, z, na.rm = NA), regexp = "Argument 'na.rm' must be TRUE or FALSE and length 1.", fixed = TRUE) +}) + + +test_that("pany-0010.006", { + expect_identical(pany(x, na.rm = FALSE), x) +}) + + +test_that("pany-0010.007", { + expect_error(pany(na.rm = FALSE), regexp = "Please supply at least 1 argument. (0 argument supplied)", fixed = TRUE) +}) + + +test_that("pany-0010.008", { + expect_error(pany(x, as.integer(z), y, na.rm = TRUE), regexp = "Argument 2 is of type integer. Only logical type is supported.", fixed = TRUE) +}) + + +test_that("pany-0010.009", { + expect_error(pany(as.double(z), y, na.rm = TRUE), regexp = "Argument 1 is of type double. Only logical type is supported.Data.frame (of logical vectors) is also supported as a single input.", fixed = TRUE) +}) + + +test_that("pany-0010.010", { + expect_identical(pany(NA, na.rm = TRUE), TRUE) +}) + + +test_that("pany-0010.011", { + expect_identical(pany(NA, na.rm = FALSE), NA) +}) + + +test_that("pany-0010.012", { + expect_identical(pany(x0, y0, z0, na.rm = FALSE), sapply(1:1e3, function(i) any(x0[i],y0[i],z0[i],na.rm=FALSE))) +}) + + +test_that("pany-0010.013", { + expect_identical(pany(x0, y0, z0, na.rm = TRUE), sapply(1:1e3, function(i) any(x0[i],y0[i],z0[i],na.rm=TRUE))) +}) + + +test_that("pany-0010.014", { + expect_identical(pany(data.frame(x,y), na.rm = FALSE), pany(x,y, na.rm = FALSE)) +}) + +x = c(1, 3, NA, 5) +y = c(2, NA, 4, 1) +z = c(3, 4, 4, 1) +x0 = rnorm(100L) +y0 = rnorm(100L) +z0 = rnorm(100L) +x1 = sample(c(1,2,NA),1e2,TRUE) +y1 = sample(c(1,2,NA),1e2,TRUE) +z1 = sample(c(1,2,NA),1e2,TRUE) + +test_that("pmean-0011.001", { + expect_identical(pmean(x, y, z, na.rm = FALSE), sapply(1:4, function(i) mean(c(x[i], y[i], z[i]), na.rm = FALSE))) +}) + + +test_that("pmean-0011.002", { + expect_identical(pmean(x, y, z, na.rm = TRUE), sapply(1:4, function(i) mean(c(x[i], y[i], z[i]), na.rm = TRUE))) +}) + + +test_that("pmean-0011.003", { + expect_error(pmean(as.raw(z), y, na.rm = TRUE), regexp = "Argument 1 is of type raw. Only integer/logical and double types are supported. A data.frame (of the previous types) is also supported as a single input.", fixed = TRUE) +}) + + +test_that("pmean-0011.004", { + expect_error(pmean(x, y, 1:2, na.rm = FALSE), regexp = "Argument 3 is of length 2 but argument 1 is of length 4. If you wish to 'recycle' your argument, please use rep() to make this intent clear to the readers of your code.", fixed = TRUE) +}) + + +test_that("pmean-0011.005", { + expect_error(pmean(1:10, 1:5, na.rm = FALSE), regexp = "Argument 2 is of length 5 but argument 1 is of length 10. If you wish to 'recycle' your argument, please use rep() to make this intent clear to the readers of your code.", fixed = TRUE) +}) + + +test_that("pmean-0011.006", { + expect_error(pmean(x, as.raw(z), y, na.rm = TRUE), regexp = "Argument 2 is of type raw. Only integer/logical and double types are supported.", fixed = TRUE) +}) + + +test_that("pmean-0011.007", { + expect_error(pmean(x, y, z, na.rm = NA), regexp = "Argument 'na.rm' must be TRUE or FALSE and length 1.", fixed = TRUE) +}) + + +test_that("pmean-0011.008", { + expect_identical(pmean(x, na.rm = FALSE), sapply(1:4, function(i) mean(c(x[i]), na.rm = FALSE))) +}) + + +test_that("pmean-0011.009", { + expect_identical(pmean(c(1,3,NA,5,NA), c(2,NA,4,1,NA), na.rm = TRUE), sapply(1:5, function(i) mean(c(c(1,3,NA,5,NA)[i], c(2,NA,4,1,NA)[i]), na.rm = TRUE))) +}) + + +test_that("pmean-0011.010", { + expect_error(pmean(na.rm = FALSE), regexp = "Please supply at least 1 argument. (0 argument supplied)", fixed = TRUE) +}) + + +test_that("pmean-0011.011", { + expect_kit_equal(pmean(x0, y0, z0), sapply(1:100, function(i) mean(c(x0[i], y0[i], z0[i]), na.rm = FALSE))) +}) + + +test_that("pmean-0011.012", { + expect_identical(pmean(x, y, z, rep(Inf,4L), na.rm = FALSE), sapply(1:4, function(i) mean(c(x[i], y[i], z[i],rep(Inf,4L)[i]), na.rm = FALSE))) +}) + + +test_that("pmean-0011.013", { + expect_identical(pmean(x, y, z, rep(Inf,4L), na.rm = TRUE), sapply(1:4, function(i) mean(c(x[i], y[i], z[i],rep(Inf,4L)[i]), na.rm = TRUE))) +}) + + +test_that("pmean-0011.014", { + expect_identical(pmean(as.integer(x), as.integer(y), as.integer(z), na.rm = FALSE), sapply(1:4, function(i) mean(c(as.integer(x[i]), as.integer(y[i]), as.integer(z[i])), na.rm = FALSE))) +}) + + +test_that("pmean-0011.015", { + expect_identical(pmean(as.integer(x), as.integer(y), as.integer(z), na.rm = TRUE), sapply(1:4, function(i) mean(c(as.integer(x[i]), as.integer(y[i]), as.integer(z[i])), na.rm = TRUE))) +}) + + +test_that("pmean-0011.016", { + expect_identical(pmean(as.integer(x), y, z, na.rm = TRUE), sapply(1:4, function(i) mean(c(as.integer(x[i]), y[i], z[i]), na.rm = TRUE))) +}) + + +test_that("pmean-0011.017", { + expect_identical(pmean(x, y, as.integer(z), na.rm = FALSE), sapply(1:4, function(i) mean(c(x[i], y[i], as.integer(z[i])), na.rm = FALSE))) +}) + + +test_that("pmean-0011.018", { + expect_identical(pmean(NA_integer_, na.rm = FALSE), mean(NA_integer_,na.rm = FALSE)) +}) + + +test_that("pmean-0011.019", { + expect_identical(pmean(NA_real_, na.rm = FALSE), mean(NA_real_,na.rm = FALSE)) +}) + + +test_that("pmean-0011.020", { + expect_kit_equal(pmean(x0, y0, z0, na.rm = TRUE), sapply(1:100, function(i) mean(c(x0[i], y0[i], z0[i]), na.rm = TRUE))) +}) + + +test_that("pmean-0011.021", { + expect_identical(pmean(x1, y1, z1, na.rm = FALSE), sapply(1:100, function(i) mean(c(x1[i], y1[i], z1[i]), na.rm = FALSE))) +}) + + +test_that("pmean-0011.022", { + expect_identical(pmean(x1, y1, z1, na.rm = TRUE), sapply(1:100, function(i) mean(c(x1[i], y1[i], z1[i]), na.rm = TRUE))) +}) + + +test_that("pmean-0011.023", { + expect_identical(pmean(NA_integer_, na.rm = TRUE), mean(NA_integer_,na.rm = TRUE)) +}) + + +test_that("pmean-0011.024", { + expect_identical(pmean(NA_real_, na.rm = TRUE), mean(NA_real_,na.rm = TRUE)) +}) + + +test_that("pmean-0011.025", { + expect_identical(pmean(data.frame(x,y,z), na.rm = TRUE), pmean(x,y,z,na.rm = TRUE)) +}) + + +test_that("pmean-0011.026", { + expect_error(pmean(1:150,iris$Species, na.rm = FALSE), regexp = "Function 'pmean' is not meaningful for factors.", fixed = TRUE) +}) + + +test_that("pmean-0011.027", { + expect_identical(pmean(unclass(mtcars)), pmean(mtcars)) +}) + diff --git a/tests/testthat/test-pfirst-plast.R b/tests/testthat/test-pfirst-plast.R new file mode 100644 index 0000000..7e193c1 --- /dev/null +++ b/tests/testthat/test-pfirst-plast.R @@ -0,0 +1,157 @@ +# Tests for pfirst() / plast() — parallel first/last non-NA +# Migrated from tests/test_kit.R (custom check() suite) to testthat 3e — see issue #54. +# Each legacy check("id", actual, expected) maps to expect_identical(); +# 31 tolerant cases (identical FALSE but all.equal+typeof TRUE) use expect_kit_equal(); +# check(..., error=) maps to expect_error(regexp=, fixed=TRUE). +# Legacy IDs are preserved as test_that() labels (prefixed by function for uniqueness). +# Setup and expectations stay interleaved in legacy order: later sections may +# redefine x/y/out_vec/... so setup must not be hoisted above earlier tests. + +set.seed(123) + +x = c(1, 3, NA, 5) +y = c(2, NA, 4, 1) +z = c(3, 4, 4, NA) +x1 = sample(c("a","b",NA),1e2,TRUE) +y1 = sample(c("c","d",NA),1e2,TRUE) +z1 = sample(c("e","f",NA),1e2,TRUE) +base_pfirst <- function(...) { + x = if(...length() == 1L && is.list(..1)) unclass(..1) else list(...) + res = x[[1]] + if(length(x) == 1L) return(res) + for(i in 2:length(x)) { + miss <- is.na(res) + res[miss] <- x[[i]][miss] + } + res +} +base_plast <- function(...) { + x = if(...length() == 1L && is.list(..1)) unclass(..1) else list(...) + n = length(x) + res = x[[n]] + if(n == 1L) return(res) + for(i in (n-1):1) { + miss <- is.na(res) + res[miss] <- x[[i]][miss] + } + res +} + +test_that("pfirst-0028.001", { + expect_identical(pfirst(x, y, z), base_pfirst(x, y, z)) +}) + + +test_that("plast-0028.002", { + expect_identical(plast(x, y, z), base_plast(x, y, z)) +}) + + +test_that("pfirst-0028.003", { + expect_identical(pfirst(y, z, x), base_pfirst(y, z, x)) +}) + + +test_that("plast-0028.004", { + expect_identical(plast(y, z, x), base_plast(y, z, x)) +}) + + +test_that("pfirst-0028.005", { + expect_identical(pfirst(x1, y1, z1), base_pfirst(x1, y1, z1)) +}) + + +test_that("plast-0028.006", { + expect_identical(plast(x1, y1, z1), base_plast(x1, y1, z1)) +}) + + +test_that("pfirst-0028.007", { + expect_identical(pfirst(y1, z1, x1), base_pfirst(y1, z1, x1)) +}) + + +test_that("plast-0028.008", { + expect_identical(plast(y1, z1, x1), base_plast(y1, z1, x1)) +}) + + +test_that("pfirst-0028.009", { + expect_identical(pfirst(list(x1, y1, z1)), base_pfirst(list(x1, y1, z1))) +}) + + +test_that("plast-0028.010", { + expect_identical(plast(list(x1, y1, z1)), base_plast(list(x1, y1, z1))) +}) + + +test_that("pfirst-0028.011", { + expect_identical(pfirst(data.frame(y1, z1, x1)), base_pfirst(data.frame(y1, z1, x1))) +}) + + +test_that("plast-0028.012", { + expect_identical(plast(data.frame(y1, z1, x1)), base_plast(data.frame(y1, z1, x1))) +}) + + +test_that("pfirst-0028.013", { + expect_identical(pfirst(list(1, NULL), list(NULL, 2)), list(1, 2)) +}) + + +test_that("plast-0028.014", { + expect_identical(plast(list(1, NULL), list(NULL, 2)), list(1, 2)) +}) + + +test_that("pfirst-0028.015", { + expect_error(pfirst(as.character(z), y), regexp = "All arguments need to have the same data type, except for numeric and logical types", fixed = TRUE) +}) + + +test_that("pfirst-0028.016", { + expect_error(pfirst(x, y, 1:2), regexp = "Argument 3 is of length 2 but argument 1 is of length 4. If you wish to 'recycle' your argument, please use rep() to make this intent clear to the readers of your code.", fixed = TRUE) +}) + + +test_that("pfirst-0028.017", { + expect_error(pfirst(1:10, 1:5), regexp = "Argument 2 is of length 5 but argument 1 is of length 10. If you wish to 'recycle' your argument, please use rep() to make this intent clear to the readers of your code.", fixed = TRUE) +}) + + +test_that("pfirst-0028.018", { + expect_error(pfirst(x, as.list(z), y), regexp = "All arguments need to have the same data type, except for numeric and logical types", fixed = TRUE) +}) + + +test_that("typeof-0028.019", { + expect_identical(typeof(pfirst(1:4, x)), "double") +}) + + +test_that("typeof-0028.020", { + expect_identical(typeof(pfirst(x, 1:4)), "double") +}) + + +test_that("pfirst-0028.021", { + expect_error(pfirst(as.factor(x), x), regexp = "If one argument is a factor, all arguments need to be factors", fixed = TRUE) +}) + + +test_that("pfirst-0028.022", { + expect_error(pfirst(x, as.factor(x)), regexp = "If one argument is a factor, all arguments need to be factors", fixed = TRUE) +}) + + +test_that("pfirst-0028.023", { + expect_error(pfirst(as.factor(x), as.factor(y)), regexp = "All factors need to have identical levels", fixed = TRUE) +}) + + +test_that("class-0028.024", { + expect_identical(class(pfirst(as.factor(x1), as.factor(x1))), "factor") +}) diff --git a/tests/testthat/test-psort.R b/tests/testthat/test-psort.R new file mode 100644 index 0000000..8d24b4f --- /dev/null +++ b/tests/testthat/test-psort.R @@ -0,0 +1,321 @@ +# Tests for psort() — parallel string sort +# Migrated from tests/test_kit.R (custom check() suite) to testthat 3e — see issue #54. +# Each legacy check("id", actual, expected) maps to expect_identical(); +# 31 tolerant cases (identical FALSE but all.equal+typeof TRUE) use expect_kit_equal(); +# check(..., error=) maps to expect_error(regexp=, fixed=TRUE). +# Legacy IDs are preserved as test_that() labels (prefixed by function for uniqueness). +# Setup and expectations stay interleaved in legacy order: later sections may +# redefine x/y/out_vec/... so setup must not be hoisted above earlier tests. + +set.seed(123) + +x1 = c("a","ab","c","b","a","c") +x2 = c("aaaba","dfjasdlifjai","jiifjeogiejogp","aabaaaa","gsgj","gerph","aaaaaaa","htjltjlrth", + "joasdjfisdjfdo","hthe","aaaaaba","j","a","jrykpjl","hkoptjltp","aaaaaa","lprrjt") +x3 = sample(c(letters,LETTERS),1e4,TRUE) +x4 = c("a","ab","c","b","a",NA,"c") +x5 = c("a","ab","c","b"," ","a",NA,"c") +x6 = c("a","ab","c","b"," "," ","a",NA," d","c") +x7 = c("a","ab","c","b"," ","a","",NA," ","c") +x8 = c("b","a","d","c",NA,"") +x9 = sample(c("a","ab","c","b"," ","","a",NA," d","c"), 1e4, TRUE) +x10 = c("b","a","A","B","\xe4","d","c",NA) +Encoding(x10) = "UTF-8" +Encoding(x10[5]) = "latin1" +x11 = rep(x10,3L) + +test_that("psort-0020.001", { + expect_warning(res <- psort(c(2L,1L,3L),c.locale = FALSE), regexp = "Function 'psort' was only implemented for character vectors. Defaulting to base::sort.", fixed = TRUE) + expect_identical(res, sort(c(2L,1L,3L))) +}) + + +test_that("psort-0020.002", { + expect_identical(psort(x1), sort(x1)) +}) + + +test_that("psort-0020.003", { + expect_identical(psort(x1,decreasing = TRUE), sort(x1,decreasing = TRUE)) +}) + + +test_that("psort-0020.004", { + expect_identical(psort(x2), sort(x2)) +}) + + +test_that("psort-0020.005", { + expect_identical(psort(x2,decreasing = TRUE), sort(x2,decreasing = TRUE)) +}) + + +test_that("psort-0020.006", { + expect_identical(psort(x3,c.locale = FALSE), sort(x3)) +}) + + +test_that("psort-0020.007", { + expect_identical(psort(x3,decreasing = TRUE,c.locale = FALSE), sort(x3,decreasing = TRUE)) +}) + + +test_that("psort-0020.008", { + expect_identical(psort(x4,na.last = TRUE), sort(x4,na.last = TRUE)) +}) + + +test_that("psort-0020.009", { + expect_identical(psort(x4,na.last = FALSE), sort(x4,na.last = FALSE)) +}) + + +test_that("psort-0020.010", { + expect_identical(psort(x5,na.last = TRUE), sort(x5,na.last = TRUE)) +}) + + +test_that("psort-0020.011", { + expect_identical(psort(x5,na.last = FALSE), sort(x5,na.last = FALSE)) +}) + + +test_that("psort-0020.012", { + expect_identical(psort(x6,na.last = TRUE), sort(x6,na.last = TRUE)) +}) + + +test_that("psort-0020.013", { + expect_identical(psort(x6,na.last = FALSE), sort(x6,na.last = FALSE)) +}) + + +test_that("psort-0020.014", { + expect_identical(psort(x7,na.last = TRUE), sort(x7,na.last = TRUE)) +}) + + +test_that("psort-0020.015", { + expect_identical(psort(x7,na.last = FALSE), sort(x7,na.last = FALSE)) +}) + + +test_that("psort-0020.016", { + expect_identical(psort(x4,na.last = TRUE,decreasing = TRUE), sort(x4,na.last = TRUE,decreasing = TRUE)) +}) + + +test_that("psort-0020.017", { + expect_identical(psort(x4,na.last = FALSE,decreasing = TRUE), sort(x4,na.last = FALSE,decreasing = TRUE)) +}) + + +test_that("psort-0020.018", { + expect_identical(psort(x5,na.last = TRUE,decreasing = TRUE), sort(x5,na.last = TRUE,decreasing = TRUE)) +}) + + +test_that("psort-0020.019", { + expect_identical(psort(x5,na.last = FALSE,decreasing = TRUE), sort(x5,na.last = FALSE,decreasing = TRUE)) +}) + + +test_that("psort-0020.020", { + expect_identical(psort(x6,na.last = TRUE,decreasing = TRUE), sort(x6,na.last = TRUE,decreasing = TRUE)) +}) + + +test_that("psort-0020.021", { + expect_identical(psort(x6,na.last = FALSE,decreasing = TRUE), sort(x6,na.last = FALSE,decreasing = TRUE)) +}) + + +test_that("psort-0020.022", { + expect_identical(psort(x7,na.last = TRUE,decreasing = TRUE), sort(x7,na.last = TRUE,decreasing = TRUE)) +}) + + +test_that("psort-0020.023", { + expect_identical(psort(x7,na.last = FALSE,decreasing = TRUE), sort(x7,na.last = FALSE,decreasing = TRUE)) +}) + + +test_that("psort-0020.024", { + expect_identical(psort(x4,na.last = NA), sort(x4,na.last = NA)) +}) + + +test_that("psort-0020.025", { + expect_identical(psort(x5,na.last = NA), sort(x5,na.last = NA)) +}) + + +test_that("psort-0020.026", { + expect_identical(psort(x6,na.last = NA), sort(x6,na.last = NA)) +}) + + +test_that("psort-0020.027", { + expect_identical(psort(x7,na.last = NA), sort(x7,na.last = NA)) +}) + + +test_that("psort-0020.028", { + expect_identical(psort(x4,na.last = NA,decreasing = TRUE), sort(x4,na.last = NA,decreasing = TRUE)) +}) + + +test_that("psort-0020.029", { + expect_identical(psort(x5,na.last = NA,decreasing = TRUE), sort(x5,na.last = NA,decreasing = TRUE)) +}) + + +test_that("psort-0020.030", { + expect_identical(psort(x6,na.last = NA,decreasing = TRUE), sort(x6,na.last = NA,decreasing = TRUE)) +}) + + +test_that("psort-0020.031", { + expect_identical(psort(x7,na.last = NA,decreasing = TRUE), sort(x7,na.last = NA,decreasing = TRUE)) +}) + + +test_that("psort-0020.032", { + expect_identical(psort(x8,na.last = TRUE), sort(x8,na.last = TRUE)) +}) + + +test_that("psort-0020.033", { + expect_identical(psort(x8,na.last = FALSE), sort(x8,na.last = FALSE)) +}) + + +test_that("psort-0020.034", { + expect_identical(psort(x8,na.last = TRUE,decreasing = TRUE), sort(x8,na.last = TRUE,decreasing = TRUE)) +}) + + +test_that("psort-0020.035", { + expect_identical(psort(x8,na.last = FALSE,decreasing = TRUE), sort(x8,na.last = FALSE,decreasing = TRUE)) +}) + + +test_that("psort-0020.036", { + expect_identical(psort(x8,na.last = NA), sort(x8,na.last = NA)) +}) + + +test_that("psort-0020.037", { + expect_identical(psort(x8,na.last = NA,decreasing = TRUE), sort(x8,na.last = NA,decreasing = TRUE)) +}) + + +test_that("psort-0020.050", { + expect_identical(psort(x10,c.locale = FALSE), sort(x10)) +}) + + +test_that("psort-0020.051", { + expect_identical(psort(x10,decreasing = TRUE,c.locale = FALSE), sort(x10,decreasing = TRUE)) +}) + + +test_that("psort-0020.052", { + expect_error(psort(x1,na.last = 2), regexp = "Argument 'na.last' must be TRUE, FALSE or NA.", fixed = TRUE) +}) + + +test_that("psort-0020.053", { + expect_error(psort(x1,decreasing = 2), regexp = "Argument 'decreasing' must be TRUE or FALSE.", fixed = TRUE) +}) + + +test_that("psort-0020.056", { + expect_error(psort(c("2L","1L","3L"),nThread=1), regexp = "Argument 'nThread' (double) must be of type integer.", fixed = TRUE) +}) + + +test_that("psort-0020.058", { + expect_error(psort(x1,c.locale = NA), regexp = "Argument 'c.locale' must be TRUE or FALSE.", fixed = TRUE) +}) + + +test_that("psort-0020.059", { + expect_identical(psort(x1,c.locale = TRUE), sort(x1,method="radix")) +}) + + +test_that("psort-0020.060", { + expect_identical(psort(x1,decreasing = TRUE,c.locale = TRUE), sort(x1,decreasing = TRUE,method="radix")) +}) + + +test_that("psort-0020.061", { + expect_identical(psort(x2,c.locale = TRUE), sort(x2,method="radix")) +}) + + +test_that("psort-0020.062", { + expect_identical(psort(x2,decreasing = TRUE,c.locale = TRUE), sort(x2,decreasing = TRUE,method="radix")) +}) + + +test_that("psort-0020.063", { + expect_identical(psort(x6,c.locale = TRUE), sort(x6,method="radix")) +}) + + +test_that("psort-0020.064", { + expect_identical(psort(x6,decreasing = TRUE,c.locale = TRUE), sort(x6,decreasing = TRUE,method="radix")) +}) + + +test_that("psort-0020.065", { + expect_identical(psort(x6,c.locale = TRUE,na.last = TRUE), sort(x6,method="radix",na.last = TRUE)) +}) + + +test_that("psort-0020.066", { + expect_identical(psort(x6,decreasing = TRUE,c.locale = TRUE,na.last = TRUE), sort(x6,decreasing = TRUE,method="radix",na.last = TRUE)) +}) + + +test_that("psort-0020.067", { + expect_identical(psort(x6,c.locale = TRUE,na.last = FALSE), sort(x6,method="radix",na.last = FALSE)) +}) + + +test_that("psort-0020.068", { + expect_identical(psort(x6,decreasing = TRUE,c.locale = TRUE,na.last = FALSE), sort(x6,decreasing = TRUE,method="radix",na.last = FALSE)) +}) + + +test_that("psort-0020.069", { + expect_identical(psort(x10,c.locale = TRUE), sort(x10,method="radix")) +}) + + +test_that("psort-0020.070", { + expect_identical(psort(x10,decreasing = TRUE,c.locale = TRUE), sort(x10,decreasing = TRUE,method="radix")) +}) + + +test_that("psort-0020.071", { + expect_identical(psort(x11,c.locale = TRUE), sort(x11,method="radix")) +}) + + +test_that("psort-0020.072", { + expect_identical(psort(x11,decreasing = TRUE,c.locale = TRUE), sort(x11,decreasing = TRUE,method="radix")) +}) + + +test_that("psort-0020.073", { + expect_identical(psort(x11,c.locale = FALSE), sort(x11)) +}) + + +test_that("psort-0020.074", { + expect_identical(psort(x11,decreasing = TRUE,c.locale = FALSE), sort(x11,decreasing = TRUE)) +}) + diff --git a/tests/testthat/test-setlevels.R b/tests/testthat/test-setlevels.R new file mode 100644 index 0000000..7c4772d --- /dev/null +++ b/tests/testthat/test-setlevels.R @@ -0,0 +1,136 @@ +# Tests for setlevels() — fast factor level recoding +# Migrated from tests/test_kit.R (custom check() suite) to testthat 3e — see issue #54. +# Each legacy check("id", actual, expected) maps to expect_identical(); +# 31 tolerant cases (identical FALSE but all.equal+typeof TRUE) use expect_kit_equal(); +# check(..., error=) maps to expect_error(regexp=, fixed=TRUE). +# Legacy IDs are preserved as test_that() labels (prefixed by function for uniqueness). +# Setup and expectations stay interleaved in legacy order: later sections may +# redefine x/y/out_vec/... so setup must not be hoisted above earlier tests. + +set.seed(123) + + +test_that("setlevels-0007.01", { + expect_identical(setlevels(factor(c("A", "A", "B", "B", "B", "C")), c("A", "B", "C"), c("X", "Y", "Z")), factor(c("X", "X", "Y", "Y", "Y", "Z"))) +}) + + +test_that("setlevels-0007.02", { + expect_error(setlevels(factor(c("A", "A", "B", "B", "B", "C")), c("A", "B"), c("X", "Y", "Z")), regexp = "'old' and 'new' are not the same length.", fixed = TRUE) +}) + + +test_that("setlevels-0007.03", { + expect_error(setlevels(factor(c("A", "A", "B", "B", "B", "C")), c("A", "B", "B"), c("X", "Y", "Z")), regexp = "'old' has duplicated value. Please make sure no duplicated values are introduced.", fixed = TRUE) +}) + + +test_that("setlevels-0007.04", { + expect_error(setlevels(factor(c("A", "A", "B", "B", "B", "C")), c("A", "B", "C"), c("X", "X", "Z")), regexp = "'new' has duplicated value. Please make sure no duplicated values are introduced.", fixed = TRUE) +}) + + +test_that("setlevels-0007.05", { + expect_identical(setlevels(factor(c("A", "A", "B", "B", "B", "C")), c("A"), c("X")), factor(c("X", "X", "B", "B", "B", "C"), levels = c("X", "B", "C"))) +}) + + +test_that("setlevels-0007.06", { + expect_identical(setlevels(factor(c(1, 1, 2, 2, 2, 3)), c("1","2","3"), c("X","Y","Z")), factor(c("X", "X", "Y", "Y", "Y", "Z"))) +}) + + +test_that("setlevels-0007.07", { + expect_error(setlevels(factor(c(1, 1, 2, 2, 2, 3)), 1:3, c("X","Y","Z")), regexp = "Type of 'old' must be character.", fixed = TRUE) +}) + + +test_that("setlevels-0007.08", { + expect_error(setlevels(factor(c(1, 1, 2, 2, 2, 3)), c("1","2","3"), 1:3), regexp = "Type of 'new' must be character.", fixed = TRUE) +}) + + +test_that("setlevels-0007.09", { + expect_identical(setlevels(factor(c("A", "A", "B", "B", "B", "C")), new = c("X", "Y", "Z")), factor(c("X", "X", "Y", "Y", "Y", "Z"))) +}) + + +test_that("setlevels-0007.10", { + expect_error(setlevels(factor(c("A", "A", "B", "B", "B", "C")), c("A", "B", "D"), c("X", "Y", "Z")), regexp = "Element 'D' of 'old' does not exist in 'x'.", fixed = TRUE) +}) + + +test_that("setlevels-0007.11", { + expect_error(setlevels(factor(c("A", "A", "B", "B", "B", "C"))), regexp = "argument \"new\" is missing, with no default", fixed = TRUE) +}) + + +test_that("setlevels-0007.12", { + expect_error(setlevels(c("A", "A", "B", "B", "B", "C"), c("A", "B", "C"), c("X", "Y", "Z")), regexp = "'setlevels' must be passed a factor.", fixed = TRUE) +}) + + +test_that("setlevels-0007.13", { + expect_error(setlevels(factor(c("A", "A", "B", "B", "B", "C")), c("A", "A","B", "B"), c("X", "X","Y", "Z")), regexp = "'old' has duplicated value. Please make sure no duplicated values are introduced.", fixed = TRUE) +}) + + +test_that("setlevels-0007.14", { + expect_identical(setlevels(factor(c("A", "A", "B", "B", "B", "C"), levels = c("C","A","B")), c("C", "A", "B"), c("Z", "X", "Y")), factor(c("X", "X", "Y", "Y", "Y", "Z"), levels = c("Z", "X", "Y"))) +}) + + +test_that("setlevels-0007.15", { + expect_identical(setlevels(factor(c("A", "A", "B", "B", "B", "C"), levels = c("C","A","B","D")), c("A", "B", "C"), c("X", "Y", "Z")), factor(c("X", "X", "Y", "Y", "Y", "Z"), levels = c("Z", "X", "Y","D"))) +}) + + +test_that("setlevels-0007.16", { + expect_identical(setlevels(factor(c("A", "A", "B", "B", "B", "C", NA, NA), levels = c("C","A","B","D")), c("A", "B", "C"), c("X", "Y", "Z")), factor(c("X", "X", "Y", "Y", "Y", "Z",NA,NA), levels = c("Z", "X", "Y","D"))) +}) + + +test_that("setlevels-0007.17", { + expect_identical(setlevels(factor(c("A", "A", "B", "B", "B", "C", NA, NA), levels = c("C","A","B",NA), exclude = NULL), c("A", "B", "C"), c("X", "Y", "Z")), factor(c("X", "X", "Y", "Y", "Y", "Z",NA,NA), levels = c("Z", "X", "Y",NA), exclude=NULL)) +}) + + +test_that("setlevels-0007.18", { + expect_identical(setlevels(factor(c("A", "A", "B", "B", "B", "C"), levels = c("C","A","B",NA), exclude = NULL), c("A", "B", "C"), c("X", "Y", "Z")), factor(c("X", "X", "Y", "Y", "Y", "Z"), levels = c("Z", "X", "Y",NA), exclude=NULL)) +}) + + +test_that("setlevels-0007.19", { + expect_identical(setlevels(factor(c("A", "A", "B", "B", "B", "C", NA, NA), levels = c("C","A","B",NA), exclude = NULL), c("A", NA), c("X","D")), factor(c("X", "X", "B", "B", "B", "C","D","D"), levels = c("C", "X", "B","D"))) +}) + + +test_that("setlevels-0007.20", { + expect_identical(setlevels(factor(c("A", "A", "B", "B", "B", "C", NA, NA), levels = c("C","A","B",NA), exclude = NULL), as.character(NA), "D"), factor(c("A", "A", "B", "B", "B", "C","D","D"), levels = c("C", "A", "B","D"))) +}) + + +test_that("setlevels-0007.21", { + expect_identical(setlevels(factor(c("A", "A", "B", "B", "B", "C", NA, NA), levels = c("C","A","B",NA), exclude = NULL), NA_character_, "D"), factor(c("A", "A", "B", "B", "B", "C","D","D"), levels = c("C", "A", "B","D"))) +}) + + +test_that("setlevels-0007.22", { + expect_error(setlevels(factor(c("A", "A", "B", "B", "B", "C", NA, NA), levels = c("C","A","B",NA), exclude = NULL), NA, "D"), regexp = "Type of 'old' must be character.", fixed = TRUE) +}) + + +test_that("setlevels-0007.23", { + expect_error(setlevels(factor(c("A", "A", "B", "B", "B", "C", NA, NA), levels = c("C","A","B",NA), exclude = NULL), "A", NA), regexp = "Type of 'new' must be character.", fixed = TRUE) +}) + + +test_that("setlevels-0007.24", { + expect_error(setlevels(factor(c("A", "A", "B", "B", "B", "C"), levels = c("A","B","C")), c("A", "B", "C"), c("X", "Y", "Z"), c(FALSE,TRUE)), regexp = "Argument 'skip_absent' must be TRUE or FALSE and length 1.", fixed = TRUE) +}) + + +test_that("setlevels-0007.25", { + expect_identical(setlevels(factor(c("A", "A", "B", "B", "B", "C")), c("A", "B", "D"), c("X", "Y", "Z"), TRUE), factor(c("X", "X", "Y", "Y", "Y", "C"), levels = c("X","Y","C"))) +}) + diff --git a/tests/testthat/test-share.R b/tests/testthat/test-share.R new file mode 100644 index 0000000..162132b --- /dev/null +++ b/tests/testthat/test-share.R @@ -0,0 +1,10 @@ +# Tests for shareData() / getData() / clearData() — shared-memory data sharing +# Migrated from tests/test_kit.R (custom check() suite) to testthat 3e — see issue #54. +# Legacy IDs 0022.001-0022.002 preserved as test_that() labels. + +test_that("share-0022.001 getData roundtrip", { + x <- tryCatch(shareData(mtcars, "share1"), error = function(err) NULL) + skip_if(is.null(x), "shared memory unavailable - skipping shareData tests") + expect_identical(getData("share1"), mtcars) + expect_true(clearData(x)) +}) diff --git a/tests/testthat/test-topn.R b/tests/testthat/test-topn.R new file mode 100644 index 0000000..2248bf5 --- /dev/null +++ b/tests/testthat/test-topn.R @@ -0,0 +1,672 @@ +# Tests for topn() — indices of top-n elements +# Migrated from tests/test_kit.R (custom check() suite) to testthat 3e — see issue #54. +# Each legacy check("id", actual, expected) maps to expect_identical(); +# 31 tolerant cases (identical FALSE but all.equal+typeof TRUE) use expect_kit_equal(); +# check(..., error=) maps to expect_error(regexp=, fixed=TRUE). +# Legacy IDs are preserved as test_that() labels (prefixed by function for uniqueness). +# Setup and expectations stay interleaved in legacy order: later sections may +# redefine x/y/out_vec/... so setup must not be hoisted above earlier tests. + +set.seed(123) + +x0 = c(3L, 2L, 10L, NA_integer_, 1L, 1L, NA_integer_, NA_integer_, 10L, 20L, 20L, 20L, 30L) +x1 = as.numeric(x0) +x2 = c(NA_integer_, NA_integer_, NA_integer_) +x3 = as.numeric(x2) +x4 = as.raw(c(1,2,3)) +x5 = sample(c(1:1000),3e3,TRUE) +x6 = sample(as.numeric(c(1:1000)),1e3,TRUE) +class2134 = setClass("class2134", slots=list(x="numeric")) +s1 = class2134(x=20191231) +x7 = seq.int(1e4) + +test_that("topn-0001.001", { + expect_identical(topn(x0, 1L, decreasing=FALSE), order(x0)[1:1]) +}) + + +test_that("topn-0001.002", { + expect_identical(topn(x0, 2L, decreasing=FALSE), order(x0)[1:2]) +}) + + +test_that("topn-0001.003", { + expect_identical(topn(x0, 3L, decreasing=FALSE), order(x0)[1:3]) +}) + + +test_that("topn-0001.004", { + expect_identical(topn(x0, 4L, decreasing=FALSE), order(x0)[1:4]) +}) + + +test_that("topn-0001.005", { + expect_identical(topn(x0, 5L, decreasing=FALSE), order(x0)[1:5]) +}) + + +test_that("topn-0001.006", { + expect_identical(topn(x0, 6L, decreasing=FALSE), order(x0)[1:6]) +}) + + +test_that("topn-0001.007", { + expect_identical(topn(x0, 7L, decreasing=FALSE), order(x0)[1:7]) +}) + + +test_that("topn-0001.008", { + expect_identical(topn(x0, 8L, decreasing=FALSE), order(x0)[1:8]) +}) + + +test_that("topn-0001.009", { + expect_identical(topn(x0, 9L, decreasing=FALSE), order(x0)[1:9]) +}) + + +test_that("topn-0001.010", { + expect_identical(topn(x0, 10L, decreasing=FALSE), order(x0)[1:10]) +}) + + +test_that("topn-0001.011", { + expect_identical(topn(x0, 11L, decreasing=FALSE), order(x0)[1:11]) +}) + + +test_that("topn-0001.012", { + expect_identical(topn(x0, 12L, decreasing=FALSE), order(x0)[1:12]) +}) + + +test_that("topn-0001.013", { + expect_identical(topn(x0, 13L, decreasing=FALSE), order(x0)[1:13]) +}) + + +test_that("topn-0001.014", { + expect_identical(topn(x1, 1L, decreasing=FALSE), order(x1)[1:1]) +}) + + +test_that("topn-0001.015", { + expect_identical(topn(x1, 2L, decreasing=FALSE), order(x1)[1:2]) +}) + + +test_that("topn-0001.016", { + expect_identical(topn(x1, 3L, decreasing=FALSE), order(x1)[1:3]) +}) + + +test_that("topn-0001.017", { + expect_identical(topn(x1, 4L, decreasing=FALSE), order(x1)[1:4]) +}) + + +test_that("topn-0001.018", { + expect_identical(topn(x1, 5L, decreasing=FALSE), order(x1)[1:5]) +}) + + +test_that("topn-0001.019", { + expect_identical(topn(x1, 6L, decreasing=FALSE), order(x1)[1:6]) +}) + + +test_that("topn-0001.020", { + expect_identical(topn(x1, 7L, decreasing=FALSE), order(x1)[1:7]) +}) + + +test_that("topn-0001.021", { + expect_identical(topn(x1, 8L, decreasing=FALSE), order(x1)[1:8]) +}) + + +test_that("topn-0001.022", { + expect_identical(topn(x1, 9L, decreasing=FALSE), order(x1)[1:9]) +}) + + +test_that("topn-0001.023", { + expect_identical(topn(x1, 10L, decreasing=FALSE), order(x1)[1:10]) +}) + + +test_that("topn-0001.024", { + expect_identical(topn(x1, 11L, decreasing=FALSE), order(x1)[1:11]) +}) + + +test_that("topn-0001.025", { + expect_identical(topn(x1, 12L, decreasing=FALSE), order(x1)[1:12]) +}) + + +test_that("topn-0001.026", { + expect_identical(topn(x1, 13L, decreasing=FALSE), order(x1)[1:13]) +}) + + +test_that("topn-0001.027", { + expect_identical(topn(x2, 1L, decreasing=FALSE), order(x2)[1:1]) +}) + + +test_that("topn-0001.028", { + expect_identical(topn(x2, 2L, decreasing=FALSE), order(x2)[1:2]) +}) + + +test_that("topn-0001.029", { + expect_identical(topn(x2, 3L, decreasing=FALSE), order(x2)[1:3]) +}) + + +test_that("topn-0001.030", { + expect_identical(topn(x3, 1L, decreasing=FALSE), order(x3)[1:1]) +}) + + +test_that("topn-0001.031", { + expect_identical(topn(x3, 2L, decreasing=FALSE), order(x3)[1:2]) +}) + + +test_that("topn-0001.032", { + expect_identical(topn(x3, 3L, decreasing=FALSE), order(x3)[1:3]) +}) + + +test_that("topn-0001.033", { + expect_identical(topn(x0, 1L, decreasing=TRUE), order(x0, decreasing=TRUE)[1:1]) +}) + + +test_that("topn-0001.034", { + expect_identical(topn(x0, 2L, decreasing=TRUE), order(x0, decreasing=TRUE)[1:2]) +}) + + +test_that("topn-0001.035", { + expect_identical(topn(x0, 3L, decreasing=TRUE), order(x0, decreasing=TRUE)[1:3]) +}) + + +test_that("topn-0001.036", { + expect_identical(topn(x0, 4L, decreasing=TRUE), order(x0, decreasing=TRUE)[1:4]) +}) + + +test_that("topn-0001.037", { + expect_identical(topn(x0, 5L, decreasing=TRUE), order(x0, decreasing=TRUE)[1:5]) +}) + + +test_that("topn-0001.038", { + expect_identical(topn(x0, 6L, decreasing=TRUE), order(x0, decreasing=TRUE)[1:6]) +}) + + +test_that("topn-0001.039", { + expect_identical(topn(x0, 7L, decreasing=TRUE), order(x0, decreasing=TRUE)[1:7]) +}) + + +test_that("topn-0001.040", { + expect_identical(topn(x0, 8L, decreasing=TRUE), order(x0, decreasing=TRUE)[1:8]) +}) + + +test_that("topn-0001.041", { + expect_identical(topn(x0, 9L, decreasing=TRUE), order(x0, decreasing=TRUE)[1:9]) +}) + + +test_that("topn-0001.042", { + expect_identical(topn(x0, 10L, decreasing=TRUE), order(x0, decreasing=TRUE)[1:10]) +}) + + +test_that("topn-0001.043", { + expect_identical(topn(x0, 11L, decreasing=TRUE), order(x0, decreasing=TRUE)[1:11]) +}) + + +test_that("topn-0001.044", { + expect_identical(topn(x0, 12L, decreasing=TRUE), order(x0, decreasing=TRUE)[1:12]) +}) + + +test_that("topn-0001.045", { + expect_identical(topn(x0, 13L, decreasing=TRUE), order(x0, decreasing=TRUE)[1:13]) +}) + + +test_that("topn-0001.046", { + expect_identical(topn(x1, 1L, decreasing=TRUE), order(x1, decreasing=TRUE)[1:1]) +}) + + +test_that("topn-0001.047", { + expect_identical(topn(x1, 2L, decreasing=TRUE), order(x1, decreasing=TRUE)[1:2]) +}) + + +test_that("topn-0001.048", { + expect_identical(topn(x1, 3L, decreasing=TRUE), order(x1, decreasing=TRUE)[1:3]) +}) + + +test_that("topn-0001.049", { + expect_identical(topn(x1, 4L, decreasing=TRUE), order(x1, decreasing=TRUE)[1:4]) +}) + + +test_that("topn-0001.050", { + expect_identical(topn(x1, 5L, decreasing=TRUE), order(x1, decreasing=TRUE)[1:5]) +}) + + +test_that("topn-0001.051", { + expect_identical(topn(x1, 6L, decreasing=TRUE), order(x1, decreasing=TRUE)[1:6]) +}) + + +test_that("topn-0001.052", { + expect_identical(topn(x1, 7L, decreasing=TRUE), order(x1, decreasing=TRUE)[1:7]) +}) + + +test_that("topn-0001.053", { + expect_identical(topn(x1, 8L, decreasing=TRUE), order(x1, decreasing=TRUE)[1:8]) +}) + + +test_that("topn-0001.054", { + expect_identical(topn(x1, 9L, decreasing=TRUE), order(x1, decreasing=TRUE)[1:9]) +}) + + +test_that("topn-0001.055", { + expect_identical(topn(x1, 10L, decreasing=TRUE), order(x1, decreasing=TRUE)[1:10]) +}) + + +test_that("topn-0001.056", { + expect_identical(topn(x1, 11L, decreasing=TRUE), order(x1, decreasing=TRUE)[1:11]) +}) + + +test_that("topn-0001.057", { + expect_identical(topn(x1, 12L, decreasing=TRUE), order(x1, decreasing=TRUE)[1:12]) +}) + + +test_that("topn-0001.058", { + expect_identical(topn(x1, 13L, decreasing=TRUE), order(x1, decreasing=TRUE)[1:13]) +}) + + +test_that("topn-0001.060", { + expect_identical(topn(x2, 1L, decreasing=TRUE), order(x2, decreasing=TRUE)[1:1]) +}) + + +test_that("topn-0001.061", { + expect_identical(topn(x2, 2L, decreasing=TRUE), order(x2, decreasing=TRUE)[1:2]) +}) + + +test_that("topn-0001.062", { + expect_identical(topn(x2, 3L, decreasing=TRUE), order(x2, decreasing=TRUE)[1:3]) +}) + + +test_that("topn-0001.063", { + expect_identical(topn(x3, 1L, decreasing=TRUE), order(x3, decreasing=TRUE)[1:1]) +}) + + +test_that("topn-0001.064", { + expect_identical(topn(x3, 2L, decreasing=TRUE), order(x3, decreasing=TRUE)[1:2]) +}) + + +test_that("topn-0001.065", { + expect_identical(topn(x3, 3L, decreasing=TRUE), order(x3, decreasing=TRUE)[1:3]) +}) + + +test_that("topn-0001.066", { + expect_error(topn(x0, -1L), regexp = "Please enter a positive integer larger or equal to 1.", fixed = TRUE) +}) + + +test_that("topn-0001.067", { + expect_identical(topn(x5, 2001L,decreasing = TRUE), order(x5, decreasing=TRUE)[1:2001]) +}) + + +test_that("topn-0001.068", { + expect_warning(res <- topn(x0, 100L,decreasing = FALSE), regexp = "'n' is larger than length of 'vec'. 'n' will be set to length of 'vec'.", fixed = TRUE) + expect_identical(res, order(x0)[1:13]) +}) + + +test_that("topn-0001.069", { + expect_error(topn(x0, 10L, decreasing = NA), regexp = "Argument 'decreasing' must be TRUE or FALSE and length 1.", fixed = TRUE) +}) + + +test_that("topn-0001.070", { + expect_error(topn(s1, 10L, decreasing = NA), regexp = "S4 class objects are not supported.", fixed = TRUE) +}) + + +test_that("topn-0001.071", { + expect_error(topn(x4, 2L), regexp = "Type raw is not supported.", fixed = TRUE) +}) + + +test_that("topn-0001.072", { + expect_error(topn(x4, 2L, decreasing = TRUE), regexp = "Type raw is not supported.", fixed = TRUE) +}) + + +test_that("topn-0001.073", { + expect_error(topn(x4, 2L, decreasing=FALSE), regexp = "Type raw is not supported.", fixed = TRUE) +}) + + +test_that("topn-0001.074", { + expect_identical(topn(x5, 1L, decreasing=FALSE,hasna=FALSE), order(x5)[1:1]) +}) + + +test_that("topn-0001.075", { + expect_identical(topn(x5, 2L, decreasing=FALSE,hasna=FALSE), order(x5)[1:2]) +}) + + +test_that("topn-0001.076", { + expect_identical(topn(x5, 3L, decreasing=FALSE,hasna=FALSE), order(x5)[1:3]) +}) + + +test_that("topn-0001.077", { + expect_identical(topn(x5, 4L, decreasing=FALSE,hasna=FALSE), order(x5)[1:4]) +}) + + +test_that("topn-0001.078", { + expect_identical(topn(x5, 5L, decreasing=FALSE,hasna=FALSE), order(x5)[1:5]) +}) + + +test_that("topn-0001.079", { + expect_identical(topn(x5, 6L, decreasing=FALSE,hasna=FALSE), order(x5)[1:6]) +}) + + +test_that("topn-0001.080", { + expect_identical(topn(x5, 7L, decreasing=FALSE,hasna=FALSE), order(x5)[1:7]) +}) + + +test_that("topn-0001.081", { + expect_identical(topn(x5, 8L, decreasing=FALSE,hasna=FALSE), order(x5)[1:8]) +}) + + +test_that("topn-0001.082", { + expect_identical(topn(x5, 9L, decreasing=FALSE,hasna=FALSE), order(x5)[1:9]) +}) + + +test_that("topn-0001.083", { + expect_identical(topn(x5, 10L, decreasing=FALSE,hasna=FALSE), order(x5)[1:10]) +}) + + +test_that("topn-0001.084", { + expect_identical(topn(x5, 11L, decreasing=FALSE,hasna=FALSE), order(x5)[1:11]) +}) + + +test_that("topn-0001.085", { + expect_identical(topn(x5, 12L, decreasing=FALSE,hasna=FALSE), order(x5)[1:12]) +}) + + +test_that("topn-0001.086", { + expect_identical(topn(x5, 13L, decreasing=FALSE,hasna=FALSE), order(x5)[1:13]) +}) + + +test_that("topn-0001.087", { + expect_identical(topn(x5, 1L, decreasing=TRUE,hasna=FALSE), order(x5,decreasing = TRUE)[1:1]) +}) + + +test_that("topn-0001.088", { + expect_identical(topn(x5, 2L, decreasing=TRUE,hasna=FALSE), order(x5,decreasing = TRUE)[1:2]) +}) + + +test_that("topn-0001.089", { + expect_identical(topn(x5, 3L, decreasing=TRUE,hasna=FALSE), order(x5,decreasing = TRUE)[1:3]) +}) + + +test_that("topn-0001.090", { + expect_identical(topn(x5, 4L, decreasing=TRUE,hasna=FALSE), order(x5,decreasing = TRUE)[1:4]) +}) + + +test_that("topn-0001.091", { + expect_identical(topn(x5, 5L, decreasing=TRUE,hasna=FALSE), order(x5,decreasing = TRUE)[1:5]) +}) + + +test_that("topn-0001.092", { + expect_identical(topn(x5, 6L, decreasing=TRUE,hasna=FALSE), order(x5,decreasing = TRUE)[1:6]) +}) + + +test_that("topn-0001.093", { + expect_identical(topn(x5, 7L, decreasing=TRUE,hasna=FALSE), order(x5,decreasing = TRUE)[1:7]) +}) + + +test_that("topn-0001.094", { + expect_identical(topn(x5, 8L, decreasing=TRUE,hasna=FALSE), order(x5,decreasing = TRUE)[1:8]) +}) + + +test_that("topn-0001.095", { + expect_identical(topn(x5, 9L, decreasing=TRUE,hasna=FALSE), order(x5,decreasing = TRUE)[1:9]) +}) + + +test_that("topn-0001.096", { + expect_identical(topn(x5, 10L, decreasing=TRUE,hasna=FALSE), order(x5,decreasing = TRUE)[1:10]) +}) + + +test_that("topn-0001.097", { + expect_identical(topn(x5, 11L, decreasing=TRUE,hasna=FALSE), order(x5,decreasing = TRUE)[1:11]) +}) + + +test_that("topn-0001.098", { + expect_identical(topn(x5, 12L, decreasing=TRUE,hasna=FALSE), order(x5,decreasing = TRUE)[1:12]) +}) + + +test_that("topn-0001.099", { + expect_identical(topn(x5, 13L, decreasing=TRUE,hasna=FALSE), order(x5,decreasing = TRUE)[1:13]) +}) + + +test_that("topn-0001.100", { + expect_identical(topn(x6, 1L, decreasing=FALSE,hasna=FALSE), order(x6)[1:1]) +}) + + +test_that("topn-0001.101", { + expect_identical(topn(x6, 2L, decreasing=FALSE,hasna=FALSE), order(x6)[1:2]) +}) + + +test_that("topn-0001.102", { + expect_identical(topn(x6, 3L, decreasing=FALSE,hasna=FALSE), order(x6)[1:3]) +}) + + +test_that("topn-0001.103", { + expect_identical(topn(x6, 4L, decreasing=FALSE,hasna=FALSE), order(x6)[1:4]) +}) + + +test_that("topn-0001.104", { + expect_identical(topn(x6, 5L, decreasing=FALSE,hasna=FALSE), order(x6)[1:5]) +}) + + +test_that("topn-0001.105", { + expect_identical(topn(x6, 6L, decreasing=FALSE,hasna=FALSE), order(x6)[1:6]) +}) + + +test_that("topn-0001.106", { + expect_identical(topn(x6, 7L, decreasing=FALSE,hasna=FALSE), order(x6)[1:7]) +}) + + +test_that("topn-0001.107", { + expect_identical(topn(x6, 8L, decreasing=FALSE,hasna=FALSE), order(x6)[1:8]) +}) + + +test_that("topn-0001.108", { + expect_identical(topn(x6, 9L, decreasing=FALSE,hasna=FALSE), order(x6)[1:9]) +}) + + +test_that("topn-0001.109", { + expect_identical(topn(x6, 10L, decreasing=FALSE,hasna=FALSE), order(x6)[1:10]) +}) + + +test_that("topn-0001.110", { + expect_identical(topn(x6, 11L, decreasing=FALSE,hasna=FALSE), order(x6)[1:11]) +}) + + +test_that("topn-0001.111", { + expect_identical(topn(x6, 12L, decreasing=FALSE,hasna=FALSE), order(x6)[1:12]) +}) + + +test_that("topn-0001.112", { + expect_identical(topn(x6, 13L, decreasing=FALSE,hasna=FALSE), order(x6)[1:13]) +}) + + +test_that("topn-0001.113", { + expect_identical(topn(x6, 1L, decreasing=TRUE,hasna=FALSE), order(x6,decreasing = TRUE)[1:1]) +}) + + +test_that("topn-0001.114", { + expect_identical(topn(x6, 2L, decreasing=TRUE,hasna=FALSE), order(x6,decreasing = TRUE)[1:2]) +}) + + +test_that("topn-0001.115", { + expect_identical(topn(x6, 3L, decreasing=TRUE,hasna=FALSE), order(x6,decreasing = TRUE)[1:3]) +}) + + +test_that("topn-0001.116", { + expect_identical(topn(x6, 4L, decreasing=TRUE,hasna=FALSE), order(x6,decreasing = TRUE)[1:4]) +}) + + +test_that("topn-0001.117", { + expect_identical(topn(x6, 5L, decreasing=TRUE,hasna=FALSE), order(x6,decreasing = TRUE)[1:5]) +}) + + +test_that("topn-0001.118", { + expect_identical(topn(x6, 6L, decreasing=TRUE,hasna=FALSE), order(x6,decreasing = TRUE)[1:6]) +}) + + +test_that("topn-0001.119", { + expect_identical(topn(x6, 7L, decreasing=TRUE,hasna=FALSE), order(x6,decreasing = TRUE)[1:7]) +}) + + +test_that("topn-0001.120", { + expect_identical(topn(x6, 8L, decreasing=TRUE,hasna=FALSE), order(x6,decreasing = TRUE)[1:8]) +}) + + +test_that("topn-0001.121", { + expect_identical(topn(x6, 9L, decreasing=TRUE,hasna=FALSE), order(x6,decreasing = TRUE)[1:9]) +}) + + +test_that("topn-0001.122", { + expect_identical(topn(x6, 10L, decreasing=TRUE,hasna=FALSE), order(x6,decreasing = TRUE)[1:10]) +}) + + +test_that("topn-0001.123", { + expect_identical(topn(x6, 11L, decreasing=TRUE,hasna=FALSE), order(x6,decreasing = TRUE)[1:11]) +}) + + +test_that("topn-0001.124", { + expect_identical(topn(x6, 12L, decreasing=TRUE,hasna=FALSE), order(x6,decreasing = TRUE)[1:12]) +}) + + +test_that("topn-0001.125", { + expect_identical(topn(x6, 13L, decreasing=TRUE,hasna=FALSE), order(x6,decreasing = TRUE)[1:13]) +}) + + +test_that("topn-0001.126", { + expect_error(topn(x4, 2L, decreasing = TRUE,hasna = FALSE), regexp = "Type raw is not supported.", fixed = TRUE) +}) + + +test_that("topn-0001.127", { + expect_error(topn(x4, 2L, decreasing=FALSE,hasna = FALSE), regexp = "Type raw is not supported.", fixed = TRUE) +}) + + +test_that("topn-0001.128", { + expect_error(topn(c(1,2,4,10,2,3), 2L, hasna=c(FALSE,TRUE)), regexp = "Argument 'hasna' must be TRUE or FALSE and length 1.", fixed = TRUE) +}) + + +test_that("topn-0001.129", { + expect_identical(topn(x5, 2001L,decreasing = FALSE), order(x5, decreasing=FALSE)[1:2001]) +}) + + +test_that("topn-0001.130", { + expect_identical(topn(x7,1e4,decreasing=FALSE), order(x7, decreasing=FALSE)) +}) + + +test_that("topn-0001.131", { + expect_identical(topn(as.numeric(x7),1e4,decreasing=FALSE), order(as.numeric(x7), decreasing=FALSE)) +}) + diff --git a/tests/testthat/test-unique.R b/tests/testthat/test-unique.R new file mode 100644 index 0000000..110e548 --- /dev/null +++ b/tests/testthat/test-unique.R @@ -0,0 +1,925 @@ +# Tests for uniqueness — fduplicated, funique, countOccur, uniqLen +# Migrated from tests/test_kit.R (custom check() suite) to testthat 3e — see issue #54. +# Each legacy check("id", actual, expected) maps to expect_identical(); +# 31 tolerant cases (identical FALSE but all.equal+typeof TRUE) use expect_kit_equal(); +# check(..., error=) maps to expect_error(regexp=, fixed=TRUE). +# Legacy IDs are preserved as test_that() labels (prefixed by function for uniqueness). +# Setup and expectations stay interleaved in legacy order: later sections may +# redefine x/y/out_vec/... so setup must not be hoisted above earlier tests. + +set.seed(123) + +x1 = sample(c(1:1000,NA_integer_),1e3,TRUE) +x2 = sample(c(TRUE,NA,FALSE),1e3,TRUE) +x3 = sample(as.numeric(c(1:1000,NA_integer_)),1e3,TRUE) +x4 = sample(as.complex(c(1:1000,NA_complex_,(NaN+0i)/0,NaN)),1e3,TRUE) +x5 = sample(as.character(c(1:1000,NA_integer_)),1e3,TRUE) +x6 = data.frame(a = rep(seq.POSIXt(as.POSIXct("2020-01-01"),as.POSIXct("2020-01-30"),length.out = 5),4L),b = rep(rnorm(5),4L)) + +test_that("fduplicated-0015.001", { + expect_identical(fduplicated(iris$Species), duplicated(iris$Species)) +}) + + +test_that("fduplicated-0015.002", { + expect_identical(fduplicated(iris$Petal.Width), duplicated(iris$Petal.Width)) +}) + + +test_that("fduplicated-0015.003", { + expect_identical(fduplicated(iris$Petal.Length), duplicated(iris$Petal.Length)) +}) + + +test_that("fduplicated-0015.004", { + expect_identical(fduplicated(iris$Sepal.Length), duplicated(iris$Sepal.Length)) +}) + + +test_that("fduplicated-0015.005", { + expect_identical(fduplicated(iris$Sepal.Width), duplicated(iris$Sepal.Width)) +}) + + +test_that("fduplicated-0015.006", { + expect_identical(fduplicated(as.character(iris$Petal.Width)), duplicated(as.character(iris$Petal.Width))) +}) + + +test_that("fduplicated-0015.007", { + expect_identical(fduplicated(c(TRUE,FALSE,TRUE,FALSE,NA,NA,TRUE)), duplicated(c(TRUE,FALSE,TRUE,FALSE,NA,NA,TRUE))) +}) + + +test_that("fduplicated-0015.008", { + expect_identical(fduplicated(x1), duplicated(x1)) +}) + + +test_that("fduplicated-0015.009", { + expect_identical(fduplicated(x2), duplicated(x2)) +}) + + +test_that("fduplicated-0015.010", { + expect_identical(fduplicated(x3), duplicated(x3)) +}) + + +test_that("fduplicated-0015.011", { + expect_identical(fduplicated(x4), duplicated(x4)) +}) + + +test_that("fduplicated-0015.012", { + expect_identical(fduplicated(x5), duplicated(x5)) +}) + + +test_that("fduplicated-0015.013", { + expect_identical(fduplicated(data.frame(a=x1,b=x1)), duplicated(data.frame(a=x1,b=x1))) +}) + + +test_that("fduplicated-0015.014", { + expect_identical(fduplicated(data.frame(a=x2,b=x2)), duplicated(data.frame(a=x2,b=x2))) +}) + + +test_that("fduplicated-0015.015", { + expect_identical(fduplicated(data.frame(a=x3,b=x3)), duplicated(data.frame(a=x3,b=x3))) +}) + + +test_that("fduplicated-0015.016", { + expect_identical(fduplicated(data.frame(a=x4,b=x4)), duplicated(data.frame(a=x4,b=x4))) +}) + + +test_that("fduplicated-0015.017", { + expect_identical(fduplicated(data.frame(a=x5,b=x5)), duplicated(data.frame(a=x5,b=x5))) +}) + + +test_that("fduplicated-0015.018", { + expect_identical(fduplicated(iris[,5:4]), duplicated(iris[,5:4])) +}) + + +test_that("fduplicated-0015.019", { + expect_identical(fduplicated(iris[,5:3]), duplicated(iris[,5:3])) +}) + + +test_that("fduplicated-0015.020", { + expect_identical(fduplicated(iris[,5:2]), duplicated(iris[,5:2])) +}) + + +test_that("fduplicated-0015.021", { + expect_identical(fduplicated(iris[,5:1]), duplicated(iris[,5:1])) +}) + + +test_that("fduplicated-0015.022", { + expect_error(fduplicated(raw(4L)), regexp = "Type raw is not supported.", fixed = TRUE) +}) + + +test_that("fduplicated-0015.023", { + expect_error(fduplicated(iris3), regexp = "Arrays are not yet supported. (please raise a feature request if needed)", fixed = TRUE) +}) + + +test_that("fduplicated-0015.024", { + expect_identical(fduplicated(matrix(c(1,1,1,1),nrow = 2)), c(FALSE,TRUE)) +}) + + +test_that("fduplicated-0015.025", { + expect_identical(fduplicated(matrix(c(1L,1L,1L,1L),nrow = 2)), c(FALSE,TRUE)) +}) + + +test_that("fduplicated-0015.026", { + expect_identical(fduplicated(matrix(c(TRUE,TRUE,FALSE,FALSE),nrow = 2)), c(FALSE,TRUE)) +}) + + +test_that("fduplicated-0015.027", { + expect_identical(fduplicated(matrix(c("1","1","1","1"),nrow = 2)), c(FALSE,TRUE)) +}) + + +test_that("fduplicated-0015.028", { + expect_identical(fduplicated(matrix(as.complex(c(1,1,1,1)),nrow = 2)), c(FALSE,TRUE)) +}) + + +test_that("fduplicated-0015.029", { + expect_error(fduplicated(matrix(as.raw(c(1,1,1,1)),nrow = 2)), regexp = "Matrix of type raw are not supported.", fixed = TRUE) +}) + + +test_that("fduplicated-0015.030", { + expect_identical(fduplicated(x6), duplicated(x6)) +}) + + +test_that("fduplicated-0015.031", { + expect_identical(fduplicated(x1, fromLast=TRUE), duplicated(x1, fromLast=TRUE)) +}) + + +test_that("fduplicated-0015.032", { + expect_identical(fduplicated(x2, fromLast=TRUE), duplicated(x2, fromLast=TRUE)) +}) + + +test_that("fduplicated-0015.033", { + expect_identical(fduplicated(x3, fromLast=TRUE), duplicated(x3, fromLast=TRUE)) +}) + + +test_that("fduplicated-0015.034", { + expect_identical(fduplicated(x4, fromLast=TRUE), duplicated(x4, fromLast=TRUE)) +}) + + +test_that("fduplicated-0015.035", { + expect_identical(fduplicated(x5, fromLast=TRUE), duplicated(x5, fromLast=TRUE)) +}) + + +test_that("fduplicated-0015.036", { + expect_identical(fduplicated(matrix(c(1,1,1,1),nrow = 2),fromLast = TRUE), c(TRUE,FALSE)) +}) + + +test_that("fduplicated-0015.037", { + expect_identical(fduplicated(matrix(c(1L,1L,1L,1L),nrow = 2),fromLast = TRUE), c(TRUE,FALSE)) +}) + + +test_that("fduplicated-0015.038", { + expect_identical(fduplicated(matrix(c(TRUE,TRUE,FALSE,FALSE),nrow = 2),fromLast = TRUE), c(TRUE,FALSE)) +}) + + +test_that("fduplicated-0015.039", { + expect_identical(fduplicated(matrix(c("1","1","1","1"),nrow = 2),fromLast = TRUE), c(TRUE,FALSE)) +}) + + +test_that("fduplicated-0015.040", { + expect_identical(fduplicated(matrix(as.complex(c(1,1,1,1)),nrow = 2),fromLast = TRUE), c(TRUE,FALSE)) +}) + + +test_that("fduplicated-0015.041", { + expect_identical(fduplicated(data.frame(a=x1,b=x1),fromLast = TRUE), duplicated(data.frame(a=x1,b=x1),fromLast = TRUE)) +}) + + +test_that("fduplicated-0015.042", { + expect_identical(fduplicated(data.frame(a=x2,b=x2),fromLast = TRUE), duplicated(data.frame(a=x2,b=x2),fromLast = TRUE)) +}) + + +test_that("fduplicated-0015.043", { + expect_identical(fduplicated(data.frame(a=x3,b=x3),fromLast = TRUE), duplicated(data.frame(a=x3,b=x3),fromLast = TRUE)) +}) + + +test_that("fduplicated-0015.044", { + expect_identical(fduplicated(data.frame(a=x4,b=x4),fromLast = TRUE), duplicated(data.frame(a=x4,b=x4),fromLast = TRUE)) +}) + + +test_that("fduplicated-0015.045", { + expect_identical(fduplicated(data.frame(a=x5,b=x5),fromLast = TRUE), duplicated(data.frame(a=x5,b=x5),fromLast = TRUE)) +}) + + +test_that("fduplicated-0015.046", { + expect_identical(fduplicated(iris[,5:4],fromLast = TRUE), duplicated(iris[,5:4],fromLast = TRUE)) +}) + +df = iris +df$Petal.Width = as.double(df$Petal.Width) +df$Petal.Length = as.character(df$Petal.Length) +df$Sepal.Width = as.logical(df$Sepal.Width) +df$Sepal.Length = as.complex(df$Sepal.Length) +rdn = sample(c(1,NA_real_,NaN),1e3,TRUE) +x7 = c("UK","USA","FR","IT","IT") +attr(x7,"label") = "Country" +x8 = c(1+1i,1+1i,2+1i,2+1i) +attr(x8,"label") = "complex" +x9 = c(TRUE,TRUE,FALSE,FALSE) +attr(x9,"label") = "logical" +f1 = factor(c("A","B","C","C")) +f2 = factor(c("A","B","C","A")) +f3 = factor(c("A","C","A"),levels = c("A","B","C")) + +test_that("funique-0016.001", { + expect_identical(funique(iris$Species), unique(iris$Species)) +}) + + +test_that("funique-0016.002", { + expect_identical(funique(iris$Petal.Width), unique(iris$Petal.Width)) +}) + + +test_that("funique-0016.003", { + expect_identical(funique(iris$Petal.Length), unique(iris$Petal.Length)) +}) + + +test_that("funique-0016.004", { + expect_identical(funique(iris$Sepal.Length), unique(iris$Sepal.Length)) +}) + + +test_that("funique-0016.005", { + expect_identical(funique(iris$Sepal.Width), unique(iris$Sepal.Width)) +}) + + +test_that("funique-0016.006", { + expect_identical(funique(as.character(iris$Petal.Width)), unique(as.character(iris$Petal.Width))) +}) + + +test_that("funique-0016.007", { + expect_identical(funique(c(TRUE,FALSE,TRUE,FALSE,NA,NA,TRUE)), unique(c(TRUE,FALSE,TRUE,FALSE,NA,NA,TRUE))) +}) + + +test_that("funique-0016.008", { + expect_identical(funique(x1), unique(x1)) +}) + + +test_that("funique-0016.009", { + expect_identical(funique(x2), unique(x2)) +}) + + +test_that("funique-0016.010", { + expect_identical(funique(x3), unique(x3)) +}) + + +test_that("funique-0016.011", { + expect_identical(funique(x4), unique(x4)) +}) + + +test_that("funique-0016.012", { + expect_identical(funique(x5), unique(x5)) +}) + + +test_that("funique-0016.013", { + expect_identical(funique(data.frame(a=x1,b=x1)), {out = unique(data.frame(a=x1,b=x1)); row.names(out)<-NULL;out}) +}) + + +test_that("funique-0016.014", { + expect_identical(funique(data.frame(a=x2,b=x2)), {out = unique(data.frame(a=x2,b=x2)); row.names(out)<-NULL;out}) +}) + + +test_that("funique-0016.015", { + expect_identical(funique(data.frame(a=x3,b=x3)), {out = unique(data.frame(a=x3,b=x3)); row.names(out)<-NULL;out}) +}) + + +test_that("funique-0016.016", { + expect_identical(funique(data.frame(a=x4,b=x4)), {out = unique(data.frame(a=x4,b=x4)); row.names(out)<-NULL;out}) +}) + + +test_that("funique-0016.017", { + expect_identical(funique(data.frame(a=x5,b=x5)), {out = unique(data.frame(a=x5,b=x5)); row.names(out)<-NULL;out}) +}) + + +test_that("funique-0016.018", { + expect_identical(funique(df), {adf = unique(df); row.names(adf) <- NULL; adf }) +}) + + +test_that("funique-0016.019", { + expect_identical(funique(c(as.Date("2020-05-01"),as.Date("2020-05-01"))), as.Date("2020-05-01")) +}) + + +test_that("funique-0016.020", { + expect_identical(funique(data.frame(a = c(as.Date("2020-05-01"),as.Date("2020-05-01")), b = c(as.Date("2020-05-01"),as.Date("2020-05-01")))), data.frame(a = c(as.Date("2020-05-01")), b = c(as.Date("2020-05-01")))) +}) + + +test_that("funique-0016.021", { + expect_identical(funique(matrix(c(1,1,1,1,2,2,3,3,2,2),nrow = 5)), matrix(c(1,1,2,2,3,2),nrow = 3)) +}) + + +test_that("funique-0016.022", { + expect_identical(funique(matrix(as.integer(c(1,1,1,1,2,2,3,3,2,2)),nrow = 5)), matrix(c(1L,1L,2L,2L,3L,2L),nrow = 3)) +}) + + +test_that("funique-0016.023", { + expect_identical(funique(matrix(c(TRUE,TRUE,FALSE,FALSE,TRUE,TRUE,TRUE,TRUE,FALSE,FALSE,NA,NA),nrow = 6)), matrix(c(TRUE,FALSE,TRUE,TRUE,FALSE,NA),nrow = 3)) +}) + + +test_that("funique-0016.024", { + expect_identical(funique(matrix(as.character(c(1,1,1,1,2,2,3,3,2,2)),nrow = 5)), matrix(as.character(c(1,1,2,2,3,2)),nrow = 3)) +}) + + +test_that("funique-0016.025", { + expect_identical(funique(matrix(as.complex(c(1,1,1,1,2,2,3,3,2,2)),nrow = 5)), matrix(as.complex(c(1,1,2,2,3,2)),nrow = 3)) +}) + + +test_that("funique-0016.026", { + expect_error(funique(matrix(as.raw(c(1,1,1,1)),nrow = 2)), regexp = "Matrix of type raw are not supported.", fixed = TRUE) +}) + + +test_that("funique-0016.027", { + expect_error(funique(iris3), regexp = "Arrays are not yet supported. (please raise a feature request if needed)", fixed = TRUE) +}) + + +test_that("funique-0016.028", { + expect_identical(funique(matrix(x1[1:100],ncol=10)), unique(matrix(x1[1:100],ncol=10))) +}) + + +test_that("funique-0016.029", { + expect_identical(funique(matrix(x2[1:100],ncol=10)), unique(matrix(x2[1:100],ncol=10))) +}) + + +test_that("funique-0016.030", { + expect_identical(funique(matrix(x3[1:100],ncol=10)), unique(matrix(x3[1:100],ncol=10))) +}) + + +test_that("funique-0016.031", { + expect_identical(funique(matrix(x4[1:100],ncol=10)), unique(matrix(x4[1:100],ncol=10))) +}) + + +test_that("funique-0016.032", { + expect_identical(funique(matrix(x5[1:100],ncol=10)), unique(matrix(x5[1:100],ncol=10))) +}) + + +test_that("funique-0016.033", { + expect_identical(funique(matrix(rdn,ncol=10)), unique(matrix(rdn,ncol=10))) +}) + + +test_that("funique-0016.034", { + expect_identical(funique(x6), unique(x6)) +}) + + +test_that("funique-0016.035", { + expect_identical(funique(x1, fromLast=TRUE), unique(x1, fromLast=TRUE)) +}) + + +test_that("funique-0016.036", { + expect_identical(funique(x2, fromLast=TRUE), unique(x2, fromLast=TRUE)) +}) + + +test_that("funique-0016.037", { + expect_identical(funique(x3, fromLast=TRUE), unique(x3, fromLast=TRUE)) +}) + + +test_that("funique-0016.038", { + expect_identical(funique(x4, fromLast=TRUE), unique(x4, fromLast=TRUE)) +}) + + +test_that("funique-0016.039", { + expect_identical(funique(x5, fromLast=TRUE), unique(x5, fromLast=TRUE)) +}) + + +test_that("funique-0016.040", { + expect_error(funique(x5, fromLast=NA), regexp = "Argument 'fromLast' must be TRUE or FALSE and length 1.", fixed = TRUE) +}) + + +test_that("funique-0016.041", { + expect_identical(funique(matrix(x1[1:100],ncol=10),fromLast = TRUE), unique(matrix(x1[1:100],ncol=10),fromLast = TRUE)) +}) + + +test_that("funique-0016.042", { + expect_identical(funique(matrix(x2[1:100],ncol=10),fromLast = TRUE), unique(matrix(x2[1:100],ncol=10),fromLast = TRUE)) +}) + + +test_that("funique-0016.043", { + expect_identical(funique(matrix(x3[1:100],ncol=10),fromLast = TRUE), unique(matrix(x3[1:100],ncol=10),fromLast = TRUE)) +}) + + +test_that("funique-0016.044", { + expect_identical(funique(matrix(x4[1:100],ncol=10),fromLast = TRUE), unique(matrix(x4[1:100],ncol=10),fromLast = TRUE)) +}) + + +test_that("funique-0016.045", { + expect_identical(funique(matrix(x5[1:100],ncol=10),fromLast = TRUE), unique(matrix(x5[1:100],ncol=10),fromLast = TRUE)) +}) + + +test_that("funique-0016.046", { + expect_error(funique(matrix(x5[1:100],ncol=10),fromLast=NA), regexp = "Argument 'fromLast' must be TRUE or FALSE and length 1.", fixed = TRUE) +}) + + +test_that("funique-0016.047", { + expect_identical(funique(data.frame(a=x1,b=x1),fromLast = TRUE), {out = unique(data.frame(a=x1,b=x1),fromLast = TRUE); row.names(out)<-NULL;out}) +}) + + +test_that("funique-0016.048", { + expect_identical(funique(data.frame(a=x2,b=x2),fromLast = TRUE), {out = unique(data.frame(a=x2,b=x2),fromLast = TRUE); row.names(out)<-NULL;out}) +}) + + +test_that("funique-0016.049", { + expect_identical(funique(data.frame(a=x3,b=x3),fromLast = TRUE), {out = unique(data.frame(a=x3,b=x3),fromLast = TRUE); row.names(out)<-NULL;out}) +}) + + +test_that("funique-0016.050", { + expect_identical(funique(data.frame(a=x4,b=x4),fromLast = TRUE), {out = unique(data.frame(a=x4,b=x4),fromLast = TRUE); row.names(out)<-NULL;out}) +}) + + +test_that("funique-0016.051", { + expect_identical(funique(data.frame(a=x5,b=x5),fromLast = TRUE), {out = unique(data.frame(a=x5,b=x5),fromLast = TRUE); row.names(out)<-NULL;out}) +}) + + +test_that("funique-0016.052", { + expect_error(funique(data.frame(a=x5,b=x5),fromLast = NA), regexp = "Argument 'fromLast' must be TRUE or FALSE and length 1.", fixed = TRUE) +}) + + +test_that("funique-0016.053", { + expect_identical(funique(iris[,5:4],fromLast = TRUE), {out = unique(iris[,5:4],fromLast = TRUE); row.names(out)<-NULL;out}) +}) + + +test_that("attr-0016.054", { + expect_identical(attr(funique(x7),"label"), "Country") +}) + + +test_that("attr-0016.055", { + expect_identical(attr(funique(data.frame(a=x7,b=x7,stringsAsFactors = FALSE))[,1],"label"), "Country") +}) + + +test_that("attr-0016.056", { + expect_identical(attr(funique(x8),"label"), "complex") +}) + + +test_that("attr-0016.057", { + expect_identical(attr(funique(data.frame(a=x8,b=x8,stringsAsFactors = FALSE))[,1],"label"), "complex") +}) + + +test_that("attr-0016.058", { + expect_identical(attr(funique(x9),"label"), "logical") +}) + + +test_that("attr-0016.059", { + expect_identical(attr(funique(data.frame(a=x9,b=x9,stringsAsFactors = FALSE))[,1],"label"), "logical") +}) + + +test_that("funique-0016.060", { + expect_identical(funique(iris$Species[iris$Species != "setosa"]), unique(iris$Species[iris$Species != "setosa"])) +}) + + +test_that("funique-0016.061", { + expect_identical(funique(c(FALSE,FALSE,NA,TRUE,NA)), unique(c(FALSE,FALSE,NA,TRUE,NA))) +}) + + +test_that("funique-0016.062", { + expect_identical(funique(c(FALSE,FALSE,NA,TRUE,NA),fromLast = TRUE), unique(c(FALSE,FALSE,NA,TRUE,NA),fromLast = TRUE)) +}) + + +test_that("funique-0016.063", { + expect_identical(funique(c(TRUE,TRUE,NA,FALSE,NA)), unique(c(TRUE,TRUE,NA,FALSE,NA))) +}) + + +test_that("funique-0016.064", { + expect_identical(funique(c(TRUE,TRUE,NA,FALSE,NA),fromLast = TRUE), unique(c(TRUE,TRUE,NA,FALSE,NA),fromLast = TRUE)) +}) + + +test_that("funique-0016.065", { + expect_identical(funique(c(NA,NA,FALSE)), unique(c(NA,NA,FALSE))) +}) + + +test_that("funique-0016.065-2", { + expect_identical(funique(c(NA,NA,FALSE),fromLast = TRUE), unique(c(NA,NA,FALSE),fromLast = TRUE)) +}) + + +test_that("funique-0016.066", { + expect_identical(funique(f1), unique(f1)) +}) + + +test_that("funique-0016.067", { + expect_identical(funique(f2), unique(f2)) +}) + + +test_that("funique-0016.068", { + expect_identical(funique(f3), unique(f3)) +}) + + +test_that("funique-0016.069", { + expect_identical(funique(f1,fromLast = TRUE), unique(f1,fromLast = TRUE)) +}) + + +test_that("funique-0016.070", { + expect_identical(funique(f2,fromLast = TRUE), unique(f2,fromLast = TRUE)) +}) + + +test_that("funique-0016.071", { + expect_identical(funique(f3,fromLast = TRUE), unique(f3,fromLast = TRUE)) +}) + + +test_that("funique-0016.072", { + expect_identical(funique(data.frame(a=c(1,NA,NA,NaN,NaN),b=c(2,2,2,2,2))), {out = unique(data.frame(a=c(1,NA,NA,NaN,NaN),b=c(2,2,2,2,2))); row.names(out)<-NULL;out}) +}) + + +test_that("funique-0016.073", { + expect_identical(funique(data.frame(a=as.complex(c(1,NA,NA,NaN,NaN)),b=c(2,2,2,2,2))), {out = unique(data.frame(a=as.complex(c(1,NA,NA,NaN,NaN)),b=c(2,2,2,2,2)));row.names(out)<-NULL;out}) +}) + +x1 = sample(c(1:1000,NA_integer_),1e4,TRUE) +x2 = sample(as.logical(c(1:1000,NA_integer_)),1e4,TRUE) +x3 = sample(as.numeric(c(1:1000,NA_integer_)),1e4,TRUE) +x4 = sample(as.complex(c(1:1000,NA_complex_,(NaN+0i)/0,NaN)),1e4,TRUE) +x5 = sample(as.character(c(1:1000,NA_integer_)),1e4,TRUE) +df1 = countOccur(x1) +df2 = countOccur(x2) +df3 = countOccur(x3) +df4 = countOccur(x4) +df5 = countOccur(x5) +out = data.frame(unique(iris[,5:4]),Count = as.integer(c(29,7,7,5,1,1,7,10,13,3,7,3,1,5,1,3,5,6,11,3,1,6,3,8,2,1,1))) +row.names(out) = NULL +out2 = mtcars +out2$Count = 1L +out2 = aggregate(out2$Count,by=out2[,10:11],FUN = length) +out2 = out2[order(out2$gear,out2$carb),] +row.names(out2) = NULL +names(out2)[3] = "Count" +out3 = countOccur(mtcars[,10:11]) +out3 = out3[order(out3$gear,out3$carb),] +row.names(out3) = NULL + +test_that("countOccur-0017.000", { + expect_identical(countOccur(iris$Species)[[2]], c(50L,50L,50L)) +}) + + +test_that("countOccur-0017.001", { + expect_identical(countOccur(as.numeric(iris$Species))[[2]], c(50L,50L,50L)) +}) + + +test_that("countOccur-0017.002", { + expect_identical(countOccur(as.complex(iris$Species))[[2]], c(50L,50L,50L)) +}) + + +test_that("countOccur-0017.003", { + expect_identical(countOccur(as.character(iris$Species))[[2]], c(50L,50L,50L)) +}) + + +test_that("countOccur-0017.004", { + expect_identical(countOccur(c(NA,TRUE,TRUE,FALSE,NA,FALSE))[[2]], c(2L,2L,2L)) +}) + + +test_that("countOccur-0017.005", { + expect_error(countOccur(raw(2L)), regexp = "Type raw is not supported.", fixed = TRUE) +}) + + +test_that("0017.006", { + expect_identical(df1[order(df1$Variable),2], as.vector(table(x1,useNA = "always"))) +}) + + +test_that("0017.007", { + expect_identical(df2[order(df2$Variable),2], as.vector(table(x2,useNA = "always"))) +}) + + +test_that("0017.008", { + expect_identical(df3[order(df3$Variable),2], as.vector(table(x3,useNA = "always"))) +}) + + +test_that("0017.009", { + expect_identical(df4[order(df4$Variable),2], as.vector(table(x4,useNA = "always"))) +}) + + +test_that("0017.010", { + expect_identical(df5[order(df5$Variable),2], as.vector(table(x5,useNA = "always"))) +}) + + +test_that("countOccur-0017.011", { + expect_identical(countOccur(rep(as.Date("2020-06-02"),10L))[[2]], 10L) +}) + + +test_that("countOccur-0017.012", { + expect_identical(countOccur(data.frame(a = c(as.Date("2020-05-01"),as.Date("2020-05-01")), b = c(as.Date("2020-05-01"),as.Date("2020-05-01")))), data.frame(a = c(as.Date("2020-05-01")), b = c(as.Date("2020-05-01")), Count = 2L)) +}) + + +test_that("countOccur-0017.013", { + expect_identical(countOccur(iris[,5:4]), out) +}) + + +test_that("0017.014", { + expect_identical(out3, out2) +}) + + +test_that("countOccur-0017.015", { + expect_error(countOccur(matrix(c(1,1,1,1),nrow = 2)), regexp = "Array are not yet supported.", fixed = TRUE) +}) + +df = iris +df$Petal.Width = as.double(df$Petal.Width) +df$Petal.Length = as.character(df$Petal.Length) +df$Sepal.Width = as.logical(df$Sepal.Width) +df$Sepal.Length = as.complex(df$Sepal.Length) +rdn = sample(c(1,NA_real_,NaN),1e3,TRUE) +x1 = sample(c(1:1000,NA_integer_),1e6,TRUE) +x2 = sample(c(TRUE,NA,FALSE),1e3,TRUE) +x3 = sample(as.numeric(c(1:1000,NA_integer_)),1e3,TRUE) +x4 = sample(as.complex(c(1:1000,NA_complex_,(NaN+0i)/0,NaN)),1e3,TRUE) +x5 = sample(as.character(c(1:1000,NA_integer_)),1e3,TRUE) +x6 = data.frame(a = rep(seq.POSIXt(as.POSIXct("2020-01-01"),as.POSIXct("2020-01-30"),length.out = 5),4L),b = rep(rnorm(5),4L)) + +test_that("uniqLen-0018.001", { + expect_identical(uniqLen(iris$Species), length(unique(iris$Species))) +}) + + +test_that("uniqLen-0018.002", { + expect_identical(uniqLen(iris$Petal.Width), length(unique(iris$Petal.Width))) +}) + + +test_that("uniqLen-0018.003", { + expect_identical(uniqLen(iris$Petal.Length), length(unique(iris$Petal.Length))) +}) + + +test_that("uniqLen-0018.004", { + expect_identical(uniqLen(iris$Sepal.Length), length(unique(iris$Sepal.Length))) +}) + + +test_that("uniqLen-0018.005", { + expect_identical(uniqLen(iris$Sepal.Width), length(unique(iris$Sepal.Width))) +}) + + +test_that("uniqLen-0018.006", { + expect_identical(uniqLen(as.character(iris$Petal.Width)), length(unique(as.character(iris$Petal.Width)))) +}) + + +test_that("uniqLen-0018.007", { + expect_identical(uniqLen(c(TRUE,FALSE,TRUE,FALSE,NA,NA,TRUE)), length(unique(c(TRUE,FALSE,TRUE,FALSE,NA,NA,TRUE)))) +}) + + +test_that("uniqLen-0018.008", { + expect_identical(uniqLen(x1), length(unique(x1))) +}) + + +test_that("uniqLen-0018.009", { + expect_identical(uniqLen(x2), length(unique(x2))) +}) + + +test_that("uniqLen-0018.010", { + expect_identical(uniqLen(x3), length(unique(x3))) +}) + + +test_that("uniqLen-0018.011", { + expect_identical(uniqLen(x4), length(unique(x4))) +}) + + +test_that("uniqLen-0018.012", { + expect_identical(uniqLen(x5), length(unique(x5))) +}) + + +test_that("uniqLen-0018.013", { + expect_identical(uniqLen(data.frame(a=x1,b=x1)), dim(unique(data.frame(a=x1,b=x1)))[1]) +}) + + +test_that("uniqLen-0018.014", { + expect_identical(uniqLen(data.frame(a=x2,b=x2)), dim(unique(data.frame(a=x2,b=x2)))[1]) +}) + + +test_that("uniqLen-0018.015", { + expect_identical(uniqLen(data.frame(a=x3,b=x3)), dim(unique(data.frame(a=x3,b=x3)))[1]) +}) + + +test_that("uniqLen-0018.016", { + expect_identical(uniqLen(data.frame(a=x4,b=x4)), dim(unique(data.frame(a=x4,b=x4)))[1]) +}) + + +test_that("uniqLen-0018.017", { + expect_identical(uniqLen(data.frame(a=x5,b=x5)), dim(unique(data.frame(a=x5,b=x5)))[1]) +}) + + +test_that("uniqLen-0018.018", { + expect_identical(uniqLen(df), dim(unique(df))[1]) +}) + + +test_that("uniqLen-0018.019", { + expect_identical(uniqLen(c(as.Date("2020-05-01"),as.Date("2020-05-01"))), 1L) +}) + + +test_that("uniqLen-0018.020", { + expect_identical(uniqLen(data.frame(a = c(as.Date("2020-05-01"),as.Date("2020-05-01")), b = c(as.Date("2020-05-01"),as.Date("2020-05-01")))), 1L) +}) + + +test_that("uniqLen-0018.021", { + expect_identical(uniqLen(matrix(c(1,1,1,1,2,2,3,3,2,2),nrow = 5)), 3L) +}) + + +test_that("uniqLen-0018.022", { + expect_identical(uniqLen(matrix(as.integer(c(1,1,1,1,2,2,3,3,2,2)),nrow = 5)), 3L) +}) + + +test_that("uniqLen-0018.023", { + expect_identical(uniqLen(matrix(c(TRUE,TRUE,FALSE,FALSE,TRUE,TRUE,TRUE,TRUE,FALSE,FALSE,NA,NA),nrow = 6)), 3L) +}) + + +test_that("uniqLen-0018.024", { + expect_identical(uniqLen(matrix(as.character(c(1,1,1,1,2,2,3,3,2,2)),nrow = 5)), 3L) +}) + + +test_that("uniqLen-0018.025", { + expect_identical(uniqLen(matrix(as.complex(c(1,1,1,1,2,2,3,3,2,2)),nrow = 5)), 3L) +}) + + +test_that("uniqLen-0018.026", { + expect_error(uniqLen(matrix(as.raw(c(1,1,1,1)),nrow = 2)), regexp = "Matrix of type raw are not supported.", fixed = TRUE) +}) + + +test_that("uniqLen-0018.027", { + expect_error(uniqLen(iris3), regexp = "Arrays are not yet supported. (please raise a feature request if needed)", fixed = TRUE) +}) + + +test_that("uniqLen-0018.028", { + expect_identical(uniqLen(matrix(x1[1:100],ncol=10)), dim(unique(matrix(x1[1:100],ncol=10)))[1]) +}) + + +test_that("uniqLen-0018.029", { + expect_identical(uniqLen(matrix(x2[1:100],ncol=10)), dim(unique(matrix(x2[1:100],ncol=10)))[1]) +}) + + +test_that("uniqLen-0018.030", { + expect_identical(uniqLen(matrix(x3[1:100],ncol=10)), dim(unique(matrix(x3[1:100],ncol=10)))[1]) +}) + + +test_that("uniqLen-0018.031", { + expect_identical(uniqLen(matrix(x4[1:100],ncol=10)), dim(unique(matrix(x4[1:100],ncol=10)))[1]) +}) + + +test_that("uniqLen-0018.032", { + expect_identical(uniqLen(matrix(x5[1:100],ncol=10)), dim(unique(matrix(x5[1:100],ncol=10)))[1]) +}) + + +test_that("uniqLen-0018.033", { + expect_identical(uniqLen(matrix(rdn,ncol=10)), dim(unique(matrix(rdn,ncol=10)))[1]) +}) + + +test_that("uniqLen-0018.034", { + expect_identical(uniqLen(x6), dim(unique(x6))[1]) +}) + + +test_that("uniqLen-0018.035", { + expect_identical(uniqLen(c(TRUE,FALSE,FALSE,FALSE,TRUE)), length(unique(c(TRUE,FALSE,FALSE,FALSE,TRUE)))) +}) + + +test_that("uniqLen-0018.036", { + expect_identical(uniqLen(factor(c("A","C","A"),levels = c("A","B","C"))), 2L) +}) + diff --git a/tests/testthat/test-vswitch-nswitch.R b/tests/testthat/test-vswitch-nswitch.R new file mode 100644 index 0000000..ab47cb9 --- /dev/null +++ b/tests/testthat/test-vswitch-nswitch.R @@ -0,0 +1,1483 @@ +# Tests for vswitch() and nswitch() — vectorised switch +# Migrated from tests/test_kit.R (custom check() suite) to testthat 3e — see issue #54. +# Each legacy check("id", actual, expected) maps to expect_identical(); +# 31 tolerant cases (identical FALSE but all.equal+typeof TRUE) use expect_kit_equal(); +# check(..., error=) maps to expect_error(regexp=, fixed=TRUE). +# Legacy IDs are preserved as test_that() labels (prefixed by function for uniqueness). +# Setup and expectations stay interleaved in legacy order: later sections may +# redefine x/y/out_vec/... so setup must not be hoisted above earlier tests. + +set.seed(123) + +x0 = c(1L, 0L, 0L, 1L, NA_integer_, 1L, NA_integer_) +x1 = c(NA_integer_, 1L, 0L, 1L, NA_integer_, 1L, NA_integer_) +values0 = c(0L, 1L) +outputs0 = list(0L, 1L) +outputs1 = list(11:17, 21:27) +outputs0l = list(FALSE, TRUE) +outputs1l = list(as.logical(11:17), as.logical( 21:27)) +outputs0n = list(0, 1) +outputs1n = list(as.numeric(11:17), as.numeric( 21:27)) +outputs0c = list(0+0i, 1+0i) +outputs1c = list(as.complex(11:17), as.complex( 21:27)) +outputs0s = list("0", "1") +outputs1s = list(as.character(11:17), as.character(21:27)) +outputs0v = list(as.list(0L), as.list(1L)) +outputs1v = list(as.list(11:17), as.list(21:27)) +na0 = NA_integer_ +na1 = 1:7 +out11 = c(NA_integer_, 22L, 13L, 24L, NA_integer_, 26L, NA_integer_) +out12 = c(1L, 22L, 13L, 24L, 5L, 26L, 7L) +x0l = list(1L, 0L, 0L, 1L, NULL, 1L, NULL) +x1l = list(NULL, 1L, 0L, 1L, NULL, 1L, NULL) +out11l = list(NULL, 22L, 13L, 24L, NULL, 26L, NULL) +out12l = list(1L, 22L, 13L, 24L, 5L, 26L, 7L) +na0l = list(NULL) +class2133 = setClass("class2133", slots=list(x="numeric")) +s1 = class2133(x=20191231) +s2 = class2133(x=20191230) +enc1 = "fa\xE7ile" +Encoding(enc1) = "latin1" +enc2 = enc2utf8(enc1) + +test_that("vswitch-0008.001", { + expect_identical(vswitch(x0, values0, outputs0), x0) +}) + + +test_that("vswitch-0008.002", { + expect_identical(vswitch(x0, values0, outputs0, na0), x0) +}) + + +test_that("vswitch-0008.003", { + expect_identical(vswitch(x1, values0, outputs1), out11) +}) + + +test_that("vswitch-0008.004", { + expect_identical(vswitch(x1, values0, outputs1, na1), out12) +}) + + +test_that("vswitch-0008.005", { + expect_error(vswitch(s1, values0, outputs0), regexp = "S4 class objects for argument 'x' are not supported.", fixed = TRUE) +}) + + +test_that("vswitch-0008.006", { + expect_error(vswitch(x0, s1, outputs0), regexp = "S4 class objects for argument 'values' are not supported.", fixed = TRUE) +}) + + +test_that("vswitch-0008.007", { + expect_error(vswitch(x0, values0, outputs0, s1), regexp = "S4 class objects for argument 'na' are not supported.", fixed = TRUE) +}) + + +test_that("vswitch-0008.008", { + expect_error(vswitch(x0, values0[1L], outputs0), regexp = "Length of 'values' and 'outputs' are different. Please make sure they are the same.", fixed = TRUE) +}) + + +test_that("vswitch-0008.009", { + expect_error(vswitch(x0, as.logical(values0), outputs0), regexp = "Type of 'x' and 'values' are different. Please make sure they are the same.", fixed = TRUE) +}) + + +test_that("vswitch-0008.010", { + expect_error(vswitch(x0, values0, outputs0, NA), regexp = "Type of 'na' and 'outputs' are different. Please make sure they are the same.", fixed = TRUE) +}) + + +test_that("vswitch-0008.011", { + expect_error(vswitch(x0, values0, outputs0, 1:2), regexp = "Length of 'na' is different than 1 and length of 'x'. Please make length of 'na' is 1 or length of 'x'.", fixed = TRUE) +}) + + +test_that("vswitch-0008.012", { + expect_error(vswitch(1, c(as.Date("2020-04-14")), list(1L)), regexp = "Argument 'x' and 'values' must have same class.", fixed = TRUE) +}) + + +test_that("vswitch-0008.013", { + expect_identical(vswitch(1, 1, 1L), 1L) +}) + + +test_that("vswitch-0008.014", { + expect_error(vswitch(factor("a"), factor("b"), list(1L)), regexp = "Argument 'x' and 'values' are both factor but their levels are different.", fixed = TRUE) +}) + + +test_that("vswitch-0008.015", { + expect_error(vswitch(x0, values0[1], list(as.Date("2020-04-14")), 2), regexp = "Argument 'na' and items of 'outputs' must have same class.", fixed = TRUE) +}) + + +test_that("vswitch-0008.016", { + expect_error(vswitch(x0, values0, list(factor(c("a","b")),factor(c("a","b"))), factor("c")), regexp = "Argument 'na' and items of 'outputs' are both factor but their levels are different.", fixed = TRUE) +}) + + +test_that("vswitch-0008.017", { + expect_identical(vswitch(as.numeric(x0), as.numeric(values0), outputs0), x0) +}) + + +test_that("vswitch-0008.018", { + expect_identical(vswitch(as.numeric(x0), as.numeric(values0), outputs0, na0), x0) +}) + + +test_that("vswitch-0008.019", { + expect_identical(vswitch(as.numeric(x1), as.numeric(values0), outputs1), out11) +}) + + +test_that("vswitch-0008.020", { + expect_identical(vswitch(as.numeric(x1), as.numeric(values0), outputs1, na1), out12) +}) + + +test_that("vswitch-0008.021", { + expect_identical(vswitch(as.complex(x0), as.complex(values0), outputs0), x0) +}) + + +test_that("vswitch-0008.022", { + expect_identical(vswitch(as.complex(x0), as.complex(values0), outputs0, na0), x0) +}) + + +test_that("vswitch-0008.023", { + expect_identical(vswitch(as.complex(x1), as.complex(values0), outputs1), out11) +}) + + +test_that("vswitch-0008.024", { + expect_identical(vswitch(as.complex(x1), as.complex(values0), outputs1, na1), out12) +}) + + +test_that("vswitch-0008.025", { + expect_identical(vswitch(as.logical(x0), as.logical(values0), outputs0), x0) +}) + + +test_that("vswitch-0008.026", { + expect_identical(vswitch(as.logical(x0), as.logical(values0), outputs0, na0), x0) +}) + + +test_that("vswitch-0008.027", { + expect_identical(vswitch(as.logical(x1), as.logical(values0), outputs1), out11) +}) + + +test_that("vswitch-0008.028", { + expect_identical(vswitch(as.logical(x1), as.logical(values0), outputs1, na1), out12) +}) + + +test_that("vswitch-0008.029", { + expect_identical(vswitch(as.character(x0), as.character(values0), outputs0), x0) +}) + + +test_that("vswitch-0008.030", { + expect_identical(vswitch(as.character(x0), as.character(values0), outputs0, na0), x0) +}) + + +test_that("vswitch-0008.031", { + expect_identical(vswitch(as.character(x1), as.character(values0), outputs1), out11) +}) + + +test_that("vswitch-0008.032", { + expect_identical(vswitch(as.character(x1), as.character(values0), outputs1, na1), out12) +}) + + +test_that("vswitch-0008.033", { + expect_identical(vswitch(as.list(x0), as.list(values0), outputs0), x0) +}) + + +test_that("vswitch-0008.034", { + expect_identical(vswitch(as.list(x0), as.list(values0), outputs0, na0), x0) +}) + + +test_that("vswitch-0008.035", { + expect_identical(vswitch(as.list(x1), as.list(values0), outputs1), out11) +}) + + +test_that("vswitch-0008.036", { + expect_identical(vswitch(as.list(x1), as.list(values0), outputs1, na1), out12) +}) + + +test_that("vswitch-0008.037", { + expect_identical(vswitch(x0, values0, outputs0l), as.logical(x0)) +}) + + +test_that("vswitch-0008.038", { + expect_identical(vswitch(x0, values0, outputs0l, as.logical(na0)), as.logical(x0)) +}) + + +test_that("vswitch-0008.039", { + expect_identical(vswitch(x1, values0, outputs1l), as.logical(out11)) +}) + + +test_that("vswitch-0008.040", { + expect_identical(vswitch(x1, values0, outputs1l, as.logical(na1)), as.logical(out12)) +}) + + +test_that("vswitch-0008.041", { + expect_identical(vswitch(as.numeric(x0), as.numeric(values0), outputs0l), as.logical(x0)) +}) + + +test_that("vswitch-0008.042", { + expect_identical(vswitch(as.numeric(x0), as.numeric(values0), outputs0l, as.logical(na0)), as.logical(x0)) +}) + + +test_that("vswitch-0008.043", { + expect_identical(vswitch(as.numeric(x1), as.numeric(values0), outputs1l), as.logical(out11)) +}) + + +test_that("vswitch-0008.044", { + expect_identical(vswitch(as.numeric(x1), as.numeric(values0), outputs1l, as.logical(na1)), as.logical(out12)) +}) + + +test_that("vswitch-0008.045", { + expect_identical(vswitch(as.complex(x0), as.complex(values0), outputs0l), as.logical(x0)) +}) + + +test_that("vswitch-0008.046", { + expect_identical(vswitch(as.complex(x0), as.complex(values0), outputs0l, as.logical(na0)), as.logical(x0)) +}) + + +test_that("vswitch-0008.047", { + expect_identical(vswitch(as.complex(x1), as.complex(values0), outputs1l), as.logical(out11)) +}) + + +test_that("vswitch-0008.048", { + expect_identical(vswitch(as.complex(x1), as.complex(values0), outputs1l, as.logical(na1)), as.logical(out12)) +}) + + +test_that("vswitch-0008.049", { + expect_identical(vswitch(as.logical(x0), as.logical(values0), outputs0l), as.logical(x0)) +}) + + +test_that("vswitch-0008.050", { + expect_identical(vswitch(as.logical(x0), as.logical(values0), outputs0l, as.logical(na0)), as.logical(x0)) +}) + + +test_that("vswitch-0008.051", { + expect_identical(vswitch(as.logical(x1), as.logical(values0), outputs1l), as.logical(out11)) +}) + + +test_that("vswitch-0008.052", { + expect_identical(vswitch(as.logical(x1), as.logical(values0), outputs1l, as.logical(na1)), as.logical(out12)) +}) + + +test_that("vswitch-0008.053", { + expect_identical(vswitch(as.character(x0), as.character(values0), outputs0l), as.logical(x0)) +}) + + +test_that("vswitch-0008.054", { + expect_identical(vswitch(as.character(x0), as.character(values0), outputs0l, as.logical(na0)), as.logical(x0)) +}) + + +test_that("vswitch-0008.055", { + expect_identical(vswitch(as.character(x1), as.character(values0), outputs1l), as.logical(out11)) +}) + + +test_that("vswitch-0008.056", { + expect_identical(vswitch(as.character(x1), as.character(values0), outputs1l, as.logical(na1)), as.logical(out12)) +}) + + +test_that("vswitch-0008.057", { + expect_identical(vswitch(as.list(x0), as.list(values0), outputs0l), as.logical(x0)) +}) + + +test_that("vswitch-0008.058", { + expect_identical(vswitch(as.list(x0), as.list(values0), outputs0l, as.logical(na0)), as.logical(x0)) +}) + + +test_that("vswitch-0008.059", { + expect_identical(vswitch(as.list(x1), as.list(values0), outputs1l), as.logical(out11)) +}) + + +test_that("vswitch-0008.060", { + expect_identical(vswitch(as.list(x1), as.list(values0), outputs1l, as.logical(na1)), as.logical(out12)) +}) + + +test_that("vswitch-0008.061", { + expect_identical(vswitch(x0, values0, outputs0n), as.numeric(x0)) +}) + + +test_that("vswitch-0008.062", { + expect_identical(vswitch(x0, values0, outputs0n, as.numeric(na0)), as.numeric(x0)) +}) + + +test_that("vswitch-0008.063", { + expect_identical(vswitch(x1, values0, outputs1n), as.numeric(out11)) +}) + + +test_that("vswitch-0008.064", { + expect_identical(vswitch(x1, values0, outputs1n, as.numeric(na1)), as.numeric(out12)) +}) + + +test_that("vswitch-0008.065", { + expect_identical(vswitch(as.numeric(x0), as.numeric(values0), outputs0n), as.numeric(x0)) +}) + + +test_that("vswitch-0008.066", { + expect_identical(vswitch(as.numeric(x0), as.numeric(values0), outputs0n, as.numeric(na0)), as.numeric(x0)) +}) + + +test_that("vswitch-0008.067", { + expect_identical(vswitch(as.numeric(x1), as.numeric(values0), outputs1n), as.numeric(out11)) +}) + + +test_that("vswitch-0008.068", { + expect_identical(vswitch(as.numeric(x1), as.numeric(values0), outputs1n, as.numeric(na1)), as.numeric(out12)) +}) + + +test_that("vswitch-0008.069", { + expect_identical(vswitch(as.complex(x0), as.complex(values0), outputs0n), as.numeric(x0)) +}) + + +test_that("vswitch-0008.070", { + expect_identical(vswitch(as.complex(x0), as.complex(values0), outputs0n, as.numeric(na0)), as.numeric(x0)) +}) + + +test_that("vswitch-0008.071", { + expect_identical(vswitch(as.complex(x1), as.complex(values0), outputs1n), as.numeric(out11)) +}) + + +test_that("vswitch-0008.072", { + expect_identical(vswitch(as.complex(x1), as.complex(values0), outputs1n, as.numeric(na1)), as.numeric(out12)) +}) + + +test_that("vswitch-0008.073", { + expect_identical(vswitch(as.logical(x0), as.logical(values0), outputs0n), as.numeric(x0)) +}) + + +test_that("vswitch-0008.074", { + expect_identical(vswitch(as.logical(x0), as.logical(values0), outputs0n, as.numeric(na0)), as.numeric(x0)) +}) + + +test_that("vswitch-0008.075", { + expect_identical(vswitch(as.logical(x1), as.logical(values0), outputs1n), as.numeric(out11)) +}) + + +test_that("vswitch-0008.076", { + expect_identical(vswitch(as.logical(x1), as.logical(values0), outputs1n, as.numeric(na1)), as.numeric(out12)) +}) + + +test_that("vswitch-0008.077", { + expect_identical(vswitch(as.character(x0), as.character(values0), outputs0n), as.numeric(x0)) +}) + + +test_that("vswitch-0008.078", { + expect_identical(vswitch(as.character(x0), as.character(values0), outputs0n, as.numeric(na0)), as.numeric(x0)) +}) + + +test_that("vswitch-0008.079", { + expect_identical(vswitch(as.character(x1), as.character(values0), outputs1n), as.numeric(out11)) +}) + + +test_that("vswitch-0008.080", { + expect_identical(vswitch(as.character(x1), as.character(values0), outputs1n, as.numeric(na1)), as.numeric(out12)) +}) + + +test_that("vswitch-0008.081", { + expect_identical(vswitch(as.list(x0), as.list(values0), outputs0n), as.numeric(x0)) +}) + + +test_that("vswitch-0008.082", { + expect_identical(vswitch(as.list(x0), as.list(values0), outputs0n, as.numeric(na0)), as.numeric(x0)) +}) + + +test_that("vswitch-0008.083", { + expect_identical(vswitch(as.list(x1), as.list(values0), outputs1n), as.numeric(out11)) +}) + + +test_that("vswitch-0008.084", { + expect_identical(vswitch(as.list(x1), as.list(values0), outputs1n, as.numeric(na1)), as.numeric(out12)) +}) + + +test_that("vswitch-0008.085", { + expect_identical(vswitch(x0, values0, outputs0s), as.character(x0)) +}) + + +test_that("vswitch-0008.086", { + expect_identical(vswitch(x0, values0, outputs0s, as.character(na0)), as.character(x0)) +}) + + +test_that("vswitch-0008.087", { + expect_identical(vswitch(x1, values0, outputs1s), as.character(out11)) +}) + + +test_that("vswitch-0008.088", { + expect_identical(vswitch(x1, values0, outputs1s, as.character(na1)), as.character(out12)) +}) + + +test_that("vswitch-0008.089", { + expect_identical(vswitch(as.numeric(x0), as.numeric(values0), outputs0s), as.character(x0)) +}) + + +test_that("vswitch-0008.090", { + expect_identical(vswitch(as.numeric(x0), as.numeric(values0), outputs0s, as.character(na0)), as.character(x0)) +}) + + +test_that("vswitch-0008.091", { + expect_identical(vswitch(as.numeric(x1), as.numeric(values0), outputs1s), as.character(out11)) +}) + + +test_that("vswitch-0008.092", { + expect_identical(vswitch(as.numeric(x1), as.numeric(values0), outputs1s, as.character(na1)), as.character(out12)) +}) + + +test_that("vswitch-0008.093", { + expect_identical(vswitch(as.complex(x0), as.complex(values0), outputs0s), as.character(x0)) +}) + + +test_that("vswitch-0008.094", { + expect_identical(vswitch(as.complex(x0), as.complex(values0), outputs0s, as.character(na0)), as.character(x0)) +}) + + +test_that("vswitch-0008.095", { + expect_identical(vswitch(as.complex(x1), as.complex(values0), outputs1s), as.character(out11)) +}) + + +test_that("vswitch-0008.096", { + expect_identical(vswitch(as.complex(x1), as.complex(values0), outputs1s, as.character(na1)), as.character(out12)) +}) + + +test_that("vswitch-0008.097", { + expect_identical(vswitch(as.logical(x0), as.logical(values0), outputs0s), as.character(x0)) +}) + + +test_that("vswitch-0008.098", { + expect_identical(vswitch(as.logical(x0), as.logical(values0), outputs0s, as.character(na0)), as.character(x0)) +}) + + +test_that("vswitch-0008.099", { + expect_identical(vswitch(as.logical(x1), as.logical(values0), outputs1s), as.character(out11)) +}) + + +test_that("vswitch-0008.100", { + expect_identical(vswitch(as.logical(x1), as.logical(values0), outputs1s, as.character(na1)), as.character(out12)) +}) + + +test_that("vswitch-0008.101", { + expect_identical(vswitch(as.character(x0), as.character(values0), outputs0s), as.character(x0)) +}) + + +test_that("vswitch-0008.102", { + expect_identical(vswitch(as.character(x0), as.character(values0), outputs0s, as.character(na0)), as.character(x0)) +}) + + +test_that("vswitch-0008.103", { + expect_identical(vswitch(as.character(x1), as.character(values0), outputs1s), as.character(out11)) +}) + + +test_that("vswitch-0008.104", { + expect_identical(vswitch(as.character(x1), as.character(values0), outputs1s, as.character(na1)), as.character(out12)) +}) + + +test_that("vswitch-0008.105", { + expect_identical(vswitch(as.list(x0), as.list(values0), outputs0s), as.character(x0)) +}) + + +test_that("vswitch-0008.106", { + expect_identical(vswitch(as.list(x0), as.list(values0), outputs0s, as.character(na0)), as.character(x0)) +}) + + +test_that("vswitch-0008.107", { + expect_identical(vswitch(as.list(x1), as.list(values0), outputs1s), as.character(out11)) +}) + + +test_that("vswitch-0008.108", { + expect_identical(vswitch(as.list(x1), as.list(values0), outputs1s, as.character(na1)), as.character(out12)) +}) + + +test_that("vswitch-0008.109", { + expect_identical(vswitch(x0, values0, outputs0v), x0l) +}) + + +test_that("vswitch-0008.110", { + expect_identical(vswitch(x0, values0, outputs0v, na0l), x0l) +}) + + +test_that("vswitch-0008.111", { + expect_identical(vswitch(x1, values0, outputs1v), out11l) +}) + + +test_that("vswitch-0008.112", { + expect_identical(vswitch(x1, values0, outputs1v, as.list(na1)), out12l) +}) + + +test_that("vswitch-0008.113", { + expect_identical(vswitch(as.numeric(x0), as.numeric(values0), outputs0v), x0l) +}) + + +test_that("vswitch-0008.114", { + expect_identical(vswitch(as.numeric(x0), as.numeric(values0), outputs0v, na0l), x0l) +}) + + +test_that("vswitch-0008.115", { + expect_identical(vswitch(as.numeric(x1), as.numeric(values0), outputs1v), out11l) +}) + + +test_that("vswitch-0008.116", { + expect_identical(vswitch(as.numeric(x1), as.numeric(values0), outputs1v, as.list(na1)), out12l) +}) + + +test_that("vswitch-0008.117", { + expect_identical(vswitch(as.complex(x0), as.complex(values0), outputs0v), x0l) +}) + + +test_that("vswitch-0008.118", { + expect_identical(vswitch(as.complex(x0), as.complex(values0), outputs0v, na0l), x0l) +}) + + +test_that("vswitch-0008.119", { + expect_identical(vswitch(as.complex(x1), as.complex(values0), outputs1v), out11l) +}) + + +test_that("vswitch-0008.120", { + expect_identical(vswitch(as.complex(x1), as.complex(values0), outputs1v, as.list(na1)), out12l) +}) + + +test_that("vswitch-0008.121", { + expect_identical(vswitch(as.logical(x0), as.logical(values0), outputs0v), x0l) +}) + + +test_that("vswitch-0008.122", { + expect_identical(vswitch(as.logical(x0), as.logical(values0), outputs0v, na0l), x0l) +}) + + +test_that("vswitch-0008.123", { + expect_identical(vswitch(as.logical(x1), as.logical(values0), outputs1v), out11l) +}) + + +test_that("vswitch-0008.124", { + expect_identical(vswitch(as.logical(x1), as.logical(values0), outputs1v, as.list(na1)), out12l) +}) + + +test_that("vswitch-0008.125", { + expect_identical(vswitch(as.character(x0), as.character(values0), outputs0v), x0l) +}) + + +test_that("vswitch-0008.126", { + expect_identical(vswitch(as.character(x0), as.character(values0), outputs0v, na0l), x0l) +}) + + +test_that("vswitch-0008.127", { + expect_identical(vswitch(as.character(x1), as.character(values0), outputs1v), out11l) +}) + + +test_that("vswitch-0008.128", { + expect_identical(vswitch(as.character(x1), as.character(values0), outputs1v, as.list(na1)), out12l) +}) + + +test_that("vswitch-0008.129", { + expect_identical(vswitch(as.list(x0), as.list(values0), outputs0v), x0l) +}) + + +test_that("vswitch-0008.130", { + expect_identical(vswitch(as.list(x0), as.list(values0), outputs0v, na0l), x0l) +}) + + +test_that("vswitch-0008.131", { + expect_identical(vswitch(as.list(x1), as.list(values0), outputs1v), out11l) +}) + + +test_that("vswitch-0008.132", { + expect_identical(vswitch(as.list(x1), as.list(values0), outputs1v, as.list(na1)), out12l) +}) + + +test_that("vswitch-0008.133", { + expect_error(vswitch(x0, values0, list(as.raw(0),as.raw(1))), regexp = "Type raw is not supported for argument 'outputs'", fixed = TRUE) +}) + + +test_that("vswitch-0008.134", { + expect_error(vswitch(as.raw(rep(0,7L)), c(as.raw(0), as.raw(1)), outputs0), regexp = "Type raw is not supported for argument 'x'.", fixed = TRUE) +}) + + +test_that("vswitch-0008.135", { + expect_error(vswitch(as.raw(rep(0,7L)), c(as.raw(0), as.raw(1)), outputs0l), regexp = "Type raw is not supported for argument 'x'.", fixed = TRUE) +}) + + +test_that("vswitch-0008.136", { + expect_error(vswitch(as.raw(rep(0,7L)), c(as.raw(0), as.raw(1)), outputs0n), regexp = "Type raw is not supported for argument 'x'.", fixed = TRUE) +}) + + +test_that("vswitch-0008.137", { + expect_error(vswitch(as.raw(rep(0,7L)), c(as.raw(0), as.raw(1)), outputs0s), regexp = "Type raw is not supported for argument 'x'.", fixed = TRUE) +}) + + +test_that("vswitch-0008.138", { + expect_error(vswitch(as.raw(rep(0,7L)), c(as.raw(0), as.raw(1)), outputs0c), regexp = "Type raw is not supported for argument 'x'.", fixed = TRUE) +}) + + +test_that("vswitch-0008.139", { + expect_error(vswitch(as.raw(rep(0,7L)), c(as.raw(0), as.raw(1)), outputs0v), regexp = "Type raw is not supported for argument 'x'.", fixed = TRUE) +}) + + +test_that("vswitch-0008.140", { + expect_identical(vswitch(factor(c("a","b"), levels=letters[1:2]), factor("a", levels=letters[1:2]), list(1L)), c(1L, NA_integer_)) +}) + + +test_that("vswitch-0008.141", { + expect_identical(vswitch(x0, values0, list(factor("a", levels=letters[1:2]),factor("a", levels=letters[1:2])), factor("b", levels=letters[1:2])), factor(c("a","a","a","a","b","a","b"), levels=letters[1:2])) +}) + + +test_that("vswitch-0008.142", { + expect_error(vswitch(x0, values0, list(1L,s2)), regexp = "S4 class objects for argument 'outputs' (item 2) are not supported.", fixed = TRUE) +}) + + +test_that("vswitch-0008.143", { + expect_identical(vswitch(x0, values0, list(as.Date("2020-04-14"),as.Date("2020-04-15"))), c(as.Date("2020-04-15"),as.Date("2020-04-14"),as.Date("2020-04-14"),as.Date("2020-04-15"),NA,as.Date("2020-04-15"),NA)) +}) + + +test_that("vswitch-0008.144", { + expect_error(vswitch(x0, values0, list(1:2,3)), regexp = "Length of item 1 of 'output' is different than 1 and length of 'x'. Please make sure that all items of 'output' have length 1 or length of 'x'(7).", fixed = TRUE) +}) + + +test_that("vswitch-0008.145", { + expect_kit_equal(vswitch(x0, values0, outputs0c), as.complex(x0)) +}) + + +test_that("vswitch-0008.146", { + expect_identical(vswitch(x0, values0, outputs0c, as.complex(na0)), as.complex(x0)) +}) + + +test_that("vswitch-0008.147", { + expect_kit_equal(vswitch(x1, values0, outputs1c), as.complex(out11)) +}) + + +test_that("vswitch-0008.148", { + expect_identical(vswitch(x1, values0, outputs1c, as.complex(na1)), as.complex(out12)) +}) + + +test_that("vswitch-0008.149", { + expect_kit_equal(vswitch(as.numeric(x0), as.numeric(values0), outputs0c), as.complex(x0)) +}) + + +test_that("vswitch-0008.150", { + expect_identical(vswitch(as.numeric(x0), as.numeric(values0), outputs0c, as.complex(na0)), as.complex(x0)) +}) + + +test_that("vswitch-0008.151", { + expect_kit_equal(vswitch(as.numeric(x1), as.numeric(values0), outputs1c), as.complex(out11)) +}) + + +test_that("vswitch-0008.152", { + expect_identical(vswitch(as.numeric(x1), as.numeric(values0), outputs1c, as.complex(na1)), as.complex(out12)) +}) + + +test_that("vswitch-0008.153", { + expect_kit_equal(vswitch(as.complex(x0), as.complex(values0), outputs0c), as.complex(x0)) +}) + + +test_that("vswitch-0008.154", { + expect_identical(vswitch(as.complex(x0), as.complex(values0), outputs0c, as.complex(na0)), as.complex(x0)) +}) + + +test_that("vswitch-0008.155", { + expect_kit_equal(vswitch(as.complex(x1), as.complex(values0), outputs1c), as.complex(out11)) +}) + + +test_that("vswitch-0008.156", { + expect_identical(vswitch(as.complex(x1), as.complex(values0), outputs1c, as.complex(na1)), as.complex(out12)) +}) + + +test_that("vswitch-0008.157", { + expect_kit_equal(vswitch(as.logical(x0), as.logical(values0), outputs0c), as.complex(x0)) +}) + + +test_that("vswitch-0008.158", { + expect_identical(vswitch(as.logical(x0), as.logical(values0), outputs0c, as.complex(na0)), as.complex(x0)) +}) + + +test_that("vswitch-0008.159", { + expect_kit_equal(vswitch(as.logical(x1), as.logical(values0), outputs1c), as.complex(out11)) +}) + + +test_that("vswitch-0008.160", { + expect_identical(vswitch(as.logical(x1), as.logical(values0), outputs1c, as.complex(na1)), as.complex(out12)) +}) + + +test_that("vswitch-0008.161", { + expect_kit_equal(vswitch(as.character(x0), as.character(values0), outputs0c), as.complex(x0)) +}) + + +test_that("vswitch-0008.162", { + expect_identical(vswitch(as.character(x0), as.character(values0), outputs0c, as.complex(na0)), as.complex(x0)) +}) + + +test_that("vswitch-0008.163", { + expect_kit_equal(vswitch(as.character(x1), as.character(values0), outputs1c), as.complex(out11)) +}) + + +test_that("vswitch-0008.164", { + expect_identical(vswitch(as.character(x1), as.character(values0), outputs1c, as.complex(na1)), as.complex(out12)) +}) + + +test_that("vswitch-0008.165", { + expect_kit_equal(vswitch(as.list(x0), as.list(values0), outputs0c), as.complex(x0)) +}) + + +test_that("vswitch-0008.166", { + expect_identical(vswitch(as.list(x0), as.list(values0), outputs0c, as.complex(na0)), as.complex(x0)) +}) + + +test_that("vswitch-0008.167", { + expect_kit_equal(vswitch(as.list(x1), as.list(values0), outputs1c), as.complex(out11)) +}) + + +test_that("vswitch-0008.168", { + expect_identical(vswitch(as.list(x1), as.list(values0), outputs1c, as.complex(na1)), as.complex(out12)) +}) + + +test_that("vswitch-0008.169", { + expect_error(vswitch(x0, values0, list(as.Date("2020-04-14"),10)), regexp = "Items 1 and 2 of 'outputs' must have same class.", fixed = TRUE) +}) + + +test_that("vswitch-0008.170", { + expect_error(vswitch(x0, values0, list(factor("a", levels = letters[1:2]),factor("c", levels = letters[1:3]))), regexp = "Items 1 and 2 of 'outputs' are both factor but their levels are different.", fixed = TRUE) +}) + + +test_that("vswitch-0008.171", { + expect_identical(vswitch(x0, values0, as.integer(outputs0)), x0) +}) + + +test_that("vswitch-0008.172", { + expect_identical(vswitch(x0, values0, as.numeric(outputs0)), as.numeric(x0)) +}) + + +test_that("vswitch-0008.173", { + expect_identical(vswitch(x0, values0, as.logical(outputs0)), as.logical(x0)) +}) + + +test_that("vswitch-0008.174", { + expect_identical(vswitch(x0, values0, as.character(outputs0)), as.character(x0)) +}) + + +test_that("vswitch-0008.175", { + expect_kit_equal(vswitch(x0, values0, as.complex(outputs0)), as.complex(x0)) +}) + + +test_that("vswitch-0008.176", { + expect_identical(vswitch(as.numeric(x0), as.numeric(values0), as.integer(outputs0)), x0) +}) + + +test_that("vswitch-0008.177", { + expect_identical(vswitch(as.numeric(x0), as.numeric(values0), as.numeric(outputs0)), as.numeric(x0)) +}) + + +test_that("vswitch-0008.178", { + expect_identical(vswitch(as.numeric(x0), as.numeric(values0), as.logical(outputs0)), as.logical(x0)) +}) + + +test_that("vswitch-0008.179", { + expect_identical(vswitch(as.numeric(x0), as.numeric(values0), as.character(outputs0)), as.character(x0)) +}) + + +test_that("vswitch-0008.180", { + expect_kit_equal(vswitch(as.numeric(x0), as.numeric(values0), as.complex(outputs0)), as.complex(x0)) +}) + + +test_that("vswitch-0008.181", { + expect_identical(vswitch(as.logical(x0), as.logical(values0), as.integer(outputs0)), x0) +}) + + +test_that("vswitch-0008.182", { + expect_identical(vswitch(as.logical(x0), as.logical(values0), as.numeric(outputs0)), as.numeric(x0)) +}) + + +test_that("vswitch-0008.183", { + expect_identical(vswitch(as.logical(x0), as.logical(values0), as.logical(outputs0)), as.logical(x0)) +}) + + +test_that("vswitch-0008.184", { + expect_identical(vswitch(as.logical(x0), as.logical(values0), as.character(outputs0)), as.character(x0)) +}) + + +test_that("vswitch-0008.185", { + expect_kit_equal(vswitch(as.logical(x0), as.logical(values0), as.complex(outputs0)), as.complex(x0)) +}) + + +test_that("vswitch-0008.186", { + expect_identical(vswitch(as.complex(x0), as.complex(values0), as.integer(outputs0)), x0) +}) + + +test_that("vswitch-0008.187", { + expect_identical(vswitch(as.complex(x0), as.complex(values0), as.numeric(outputs0)), as.numeric(x0)) +}) + + +test_that("vswitch-0008.188", { + expect_identical(vswitch(as.complex(x0), as.complex(values0), as.logical(outputs0)), as.logical(x0)) +}) + + +test_that("vswitch-0008.189", { + expect_identical(vswitch(as.complex(x0), as.complex(values0), as.character(outputs0)), as.character(x0)) +}) + + +test_that("vswitch-0008.190", { + expect_kit_equal(vswitch(as.complex(x0), as.complex(values0), as.complex(outputs0)), as.complex(x0)) +}) + + +test_that("vswitch-0008.191", { + expect_identical(vswitch(as.character(x0), as.character(values0), as.integer(outputs0)), x0) +}) + + +test_that("vswitch-0008.192", { + expect_identical(vswitch(as.character(x0), as.character(values0), as.numeric(outputs0)), as.numeric(x0)) +}) + + +test_that("vswitch-0008.193", { + expect_identical(vswitch(as.character(x0), as.character(values0), as.logical(outputs0)), as.logical(x0)) +}) + + +test_that("vswitch-0008.194", { + expect_identical(vswitch(as.character(x0), as.character(values0), as.character(outputs0)), as.character(x0)) +}) + + +test_that("vswitch-0008.195", { + expect_kit_equal(vswitch(as.character(x0), as.character(values0), as.complex(outputs0)), as.complex(x0)) +}) + + +test_that("vswitch-0008.196", { + expect_identical(vswitch(as.list(x0), as.list(values0), as.integer(outputs0)), x0) +}) + + +test_that("vswitch-0008.197", { + expect_identical(vswitch(as.list(x0), as.list(values0), as.numeric(outputs0)), as.numeric(x0)) +}) + + +test_that("vswitch-0008.198", { + expect_identical(vswitch(as.list(x0), as.list(values0), as.logical(outputs0)), as.logical(x0)) +}) + + +test_that("vswitch-0008.199", { + expect_identical(vswitch(as.list(x0), as.list(values0), as.character(outputs0)), as.character(x0)) +}) + + +test_that("vswitch-0008.200", { + expect_kit_equal(vswitch(as.list(x0), as.list(values0), as.complex(outputs0)), as.complex(x0)) +}) + + +test_that("vswitch-0008.201", { + expect_error(vswitch(x0, values0, as.integer(outputs0), NA_character_), regexp = "Type of 'na' and 'outputs' are different. Please make sure they are the same.", fixed = TRUE) +}) + + +test_that("vswitch-0008.202", { + expect_error(vswitch(x0, values0, as.raw(c(0,1))), regexp = "Type raw is not supported for argument 'outputs'", fixed = TRUE) +}) + + +test_that("vswitch-0008.203", { + expect_error(vswitch(x0, values0[1], as.Date("2020-04-14"), 2), regexp = "Argument 'na' and 'outputs' must have same class.", fixed = TRUE) +}) + + +test_that("vswitch-0008.204", { + expect_error(vswitch(x0, values0, factor(c("a","b")), factor("c")), regexp = "Argument 'na' and 'outputs' are both factor but their levels are different.", fixed = TRUE) +}) + + +test_that("vswitch-0008.205", { + expect_identical(vswitch(x0, values0[1], factor(c("a"),levels=c("a","b")), factor(("b"),levels = c("a","b"))), factor(c("b","a","a","b","b","b","b"),levels=c("a","b"))) +}) + + +test_that("vswitch-0008.206", { + expect_error(vswitch(as.raw(rep(0,7L)), c(as.raw(0), as.raw(1)), as.integer(outputs0)), regexp = "Type raw is not supported for argument 'x'.", fixed = TRUE) +}) + + +test_that("vswitch-0008.207", { + expect_error(vswitch(as.raw(rep(0,7L)), c(as.raw(0), as.raw(1)), as.numeric(outputs0)), regexp = "Type raw is not supported for argument 'x'.", fixed = TRUE) +}) + + +test_that("vswitch-0008.208", { + expect_error(vswitch(as.raw(rep(0,7L)), c(as.raw(0), as.raw(1)), as.logical(outputs0)), regexp = "Type raw is not supported for argument 'x'.", fixed = TRUE) +}) + + +test_that("vswitch-0008.209", { + expect_error(vswitch(as.raw(rep(0,7L)), c(as.raw(0), as.raw(1)), as.character(outputs0)), regexp = "Type raw is not supported for argument 'x'.", fixed = TRUE) +}) + + +test_that("vswitch-0008.210", { + expect_error(vswitch(as.raw(rep(0,7L)), c(as.raw(0), as.raw(1)), as.complex(outputs0)), regexp = "Type raw is not supported for argument 'x'.", fixed = TRUE) +}) + + +test_that("vswitch-0008.211", { + expect_identical(vswitch(c(enc1,enc2),enc1,1), c(1,1)) +}) + + +test_that("vswitch-0008.212", { + expect_identical(vswitch(c(enc1,enc1),enc1,1), c(1,1)) +}) + + +test_that("vswitch-0008.213", { + expect_identical(vswitch(c(enc2,enc2),enc2,1), c(1,1)) +}) + + +test_that("vswitch-0008.214", { + expect_identical(vswitch(c(enc1,enc2),enc2,1), c(1,1)) +}) + + +test_that("vswitch-0008.215", { + expect_error(vswitch("a",character(),1), regexp = "Argument'values' cannot be zero-length vector.", fixed = TRUE) +}) + + +test_that("vswitch-0008.216", { + expect_error(vswitch("a","b",1,checkEnc = NA), regexp = "Argument 'checkEnc' must be TRUE or FALSE and length 1.", fixed = TRUE) +}) + +x1 = c(0L, 0L, 1L, 2L, 3L, 2L) +x2 = as.logical(x1) +x3 = as.numeric(x1) +x4 = as.complex(x1) +x5 = as.character(x1) +x6 = as.list(x1) +class2133 = setClass("class2133", slots=list(x="numeric")) +s1 = class2133(x=20191231) +s2 = class2133(x=20191230) +enc1 = "fa\xE7ile" +Encoding(enc1) = "latin1" +enc2 = enc2utf8(enc1) + +test_that("nswitch-0019.001", { + expect_identical(nswitch(x1, 0L, FALSE, 1L, TRUE, 2L, TRUE, default = FALSE), c(FALSE,FALSE,TRUE,TRUE,FALSE,TRUE)) +}) + + +test_that("nswitch-0019.002", { + expect_identical(nswitch(x2, FALSE, FALSE, TRUE, TRUE, default = FALSE), c(FALSE,FALSE,TRUE,TRUE,TRUE,TRUE)) +}) + + +test_that("nswitch-0019.003", { + expect_identical(nswitch(x3, 0, FALSE, 1, TRUE, 2, TRUE, default = FALSE), c(FALSE,FALSE,TRUE,TRUE,FALSE,TRUE)) +}) + + +test_that("nswitch-0019.004", { + expect_identical(nswitch(x4, 0+0i, FALSE, 1+0i, TRUE, 2+0i, TRUE, default = FALSE), c(FALSE,FALSE,TRUE,TRUE,FALSE,TRUE)) +}) + + +test_that("nswitch-0019.005", { + expect_identical(nswitch(x5, "0", FALSE, "1", TRUE, "2", TRUE, default = FALSE), c(FALSE,FALSE,TRUE,TRUE,FALSE,TRUE)) +}) + + +test_that("nswitch-0019.006", { + expect_identical(nswitch(x1, 0L, 1L, 1L, 2L, 2L, 3L, default = 4L), c(1L,1L,2L,3L,4L,3L)) +}) + + +test_that("nswitch-0019.007", { + expect_identical(nswitch(x2, TRUE, 1L, FALSE, 2L, default = 0L), c(2L,2L,1L,1L,1L,1L)) +}) + + +test_that("nswitch-0019.008", { + expect_identical(nswitch(x3, 0, 1L, 1, 2L, 2, 3L, default = 4L), c(1L,1L,2L,3L,4L,3L)) +}) + + +test_that("nswitch-0019.009", { + expect_identical(nswitch(x4, 0+0i, 0L, 1+0i, 1L, 2+0i, 2L, default = 3L), c(0L,0L,1L,2L,3L,2L)) +}) + + +test_that("nswitch-0019.010", { + expect_identical(nswitch(x5, "0", 0L, "1", 1L, "2", 2L, default = 3L), c(0L,0L,1L,2L,3L,2L)) +}) + + +test_that("nswitch-0019.011", { + expect_identical(nswitch(x1, 0L, 1, 1L, 2, 2L, 3, default = 4), c(1,1,2,3,4,3)) +}) + + +test_that("nswitch-0019.012", { + expect_identical(nswitch(x2, TRUE, 1, FALSE, 2, default = 0), c(2,2,1,1,1,1)) +}) + + +test_that("nswitch-0019.013", { + expect_identical(nswitch(x3, 0, 1, 1, 2, 2, 3, default = 4), c(1,1,2,3,4,3)) +}) + + +test_that("nswitch-0019.014", { + expect_identical(nswitch(x4, 0+0i, 0, 1+0i, 1, 2+0i, 2, default = 3), c(0,0,1,2,3,2)) +}) + + +test_that("nswitch-0019.015", { + expect_identical(nswitch(x5, "0", 0, "1", 1, "2", 2, default = 3), c(0,0,1,2,3,2)) +}) + + +test_that("nswitch-0019.016", { + expect_identical(nswitch(x1, 0L, 1+0i, 1L, 2+0i, 2L, 3+0i, default = 4+0i), c(1+0i,1+0i,2+0i,3+0i,4+0i,3+0i)) +}) + + +test_that("nswitch-0019.017", { + expect_identical(nswitch(x2, TRUE, 1+0i, FALSE, 2+0i, default = 0+0i), c(2+0i,2+0i,1+0i,1+0i,1+0i,1+0i)) +}) + + +test_that("nswitch-0019.018", { + expect_identical(nswitch(x3, 0, 1+0i, 1, 2+0i, 2, 3+0i, default = 4+0i), c(1+0i,1+0i,2+0i,3+0i,4+0i,3+0i)) +}) + + +test_that("nswitch-0019.019", { + expect_identical(nswitch(x4, 0+0i, 0+0i, 1+0i, 1+0i, 2+0i, 2+0i, default = 3+0i), c(0+0i,0+0i,1+0i,2+0i,3+0i,2+0i)) +}) + + +test_that("nswitch-0019.020", { + expect_identical(nswitch(x5, "0", 0+0i, "1", 1+0i, "2", 2+0i, default = 3+0i), c(0+0i,0+0i,1+0i,2+0i,3+0i,2+0i)) +}) + + +test_that("nswitch-0019.021", { + expect_identical(nswitch(x1, 0L, "1+0i", 1L, "2+0i", 2L, "3+0i", default = "4+0i"), c("1+0i","1+0i","2+0i","3+0i","4+0i","3+0i")) +}) + + +test_that("nswitch-0019.022", { + expect_identical(nswitch(x2, TRUE, "1+0i", FALSE, "2+0i", default = "0+0i"), c("2+0i","2+0i","1+0i","1+0i","1+0i","1+0i")) +}) + + +test_that("nswitch-0019.023", { + expect_identical(nswitch(x3, 0, "1+0i", 1, "2+0i", 2, "3+0i", default = "4+0i"), c("1+0i","1+0i","2+0i","3+0i","4+0i","3+0i")) +}) + + +test_that("nswitch-0019.024", { + expect_identical(nswitch(x4, 0+0i, "0+0i", 1+0i, "1+0i", 2+0i, "2+0i", default = "3+0i"), c("0+0i","0+0i","1+0i","2+0i","3+0i","2+0i")) +}) + + +test_that("nswitch-0019.025", { + expect_identical(nswitch(x5, "0", "0+0i", "1", "1+0i", "2", "2+0i", default = "3+0i"), c("0+0i","0+0i","1+0i","2+0i","3+0i","2+0i")) +}) + + +test_that("nswitch-0019.026", { + expect_error(nswitch(x1, 0L, FALSE, 1L, TRUE, 2L, TRUE, checkEnc = 2), regexp = "Argument 'checkEnc' must be TRUE or FALSE and length 1.", fixed = TRUE) +}) + + +test_that("nswitch-0019.027", { + expect_error(nswitch(x1, 0L, FALSE, 1L, TRUE, 2L), regexp = "Received 5 inputs; please supply an even number of arguments in ... consisting of target value, resulting output pairs (in that order). Note that argument 'default' must be named explicitly (e.g.: default=0)", fixed = TRUE) +}) + + +test_that("nswitch-0019.028", { + expect_error(nswitch(x1, 0L, FALSE, 1L, TRUE, 2L, TRUE, default = s1), regexp = "S4 class objects for argument 'na' are not supported.", fixed = TRUE) +}) + + +test_that("nswitch-0019.029", { + expect_error(nswitch(x1, 0L, FALSE, 1L, TRUE, 2L, TRUE, default = c(0L,1L)), regexp = "Length of 'default' must either be 1 or length of 'x'.", fixed = TRUE) +}) + + +test_that("nswitch-0019.030", { + expect_error(nswitch(x1, 0L, FALSE, 1L, TRUE, 2L, TRUE, default = 1), regexp = "Resulting value is of type logical but 'default' is of type double. Please make sure that both arguments have the same type.", fixed = TRUE) +}) + + +test_that("nswitch-0019.031", { + expect_error(nswitch(s1, 0L, FALSE, 1L, TRUE, 2L, TRUE), regexp = "S4 class objects for argument 'x' are not supported.", fixed = TRUE) +}) + + +test_that("nswitch-0019.032", { + expect_identical(nswitch(x6, list(0L), FALSE, list(1L), TRUE, list(2L), TRUE, default = FALSE), c(FALSE,FALSE,TRUE,TRUE,FALSE,TRUE)) +}) + + +test_that("nswitch-0019.033", { + expect_identical(nswitch(x6, list(0L), 0L, list(1L), 1L, list(2L), 2L, default = 3L), c(0L,0L,1L,2L,3L,2L)) +}) + + +test_that("nswitch-0019.034", { + expect_identical(nswitch(x6, list(0L), 0, list(1L), 1, list(2L), 2, default = 3), c(0,0,1,2,3,2)) +}) + + +test_that("nswitch-0019.035", { + expect_identical(nswitch(x6, list(0L), 0+0i, list(1L), 1+0i, list(2L), 2+0i, default = 3+0i), c(0+0i,0+0i,1+0i,2+0i,3+0i,2+0i)) +}) + + +test_that("nswitch-0019.036", { + expect_identical(nswitch(x6, list(0L), "0", list(1L), "1", list(2L), "2", default = "3"), c("0","0","1","2","3","2")) +}) + + +test_that("nswitch-0019.037", { + expect_error(nswitch(x6, 0L, list("0"), 1L, list("1"), 2L, list("2"), default = list("3")), regexp = "Type of 'x' and 'values' are different. Please make sure they are the same.", fixed = TRUE) +}) + + +test_that("nswitch-0019.038", { + expect_identical(nswitch(x6, list(0L), list("0"), list(1L), list("1"), list(2L), list("2"), default = list("3")), list("0","0","1","2","3","2")) +}) + + +test_that("nswitch-0019.039", { + expect_identical(nswitch(x1, 0L, list("0"), 1L, list("1"), 2L, list("2"), default = list("3")), list("0","0","1","2","3","2")) +}) + + +test_that("nswitch-0019.040", { + expect_identical(nswitch(x2, TRUE, list("0"), FALSE, list("1"), default = list("3")), list("1","1","0","0","0","0")) +}) + + +test_that("nswitch-0019.041", { + expect_identical(nswitch(x3, 0, list("0"), 1, list("1"), 2, list("2"), default = list("3")), list("0","0","1","2","3","2")) +}) + + +test_that("nswitch-0019.042", { + expect_identical(nswitch(x4, 0+0i, list("0"), 1+0i, list("1"), 2+0i, list("2"), default = list("3")), list("0","0","1","2","3","2")) +}) + + +test_that("nswitch-0019.043", { + expect_identical(nswitch(x5, "0", list("0"), "1", list("1"), "2", list("2"), default = list("3")), list("0","0","1","2","3","2")) +}) + + +test_that("nswitch-0019.044", { + expect_error(nswitch(x1, 0L, as.raw("00"), 1L, as.raw("01"), 2L, as.raw("02"), default = as.raw("03")), regexp = "Type raw is not supported for argument 'outputs'", fixed = TRUE) +}) + + +test_that("nswitch-0019.045", { + expect_error(nswitch(x1, 0L, 1, 1L, 2, 2L, 3, default = as.Date("2020-01-01")), regexp = "Resulting value has different class than 'default'. Please make sure that both arguments have the same class.", fixed = TRUE) +}) + + +test_that("nswitch-0019.046", { + expect_error(nswitch(as.raw(x1), as.raw(0L), 1, as.raw(1L), 2, as.raw(2L), 3, default = 4), regexp = "Type raw is not supported for argument 'x'.", fixed = TRUE) +}) + + +test_that("nswitch-0019.047", { + expect_error(nswitch(as.raw(x1), as.raw(0L), 1L, as.raw(1L), 2L, as.raw(2L), 3L, default = 4L), regexp = "Type raw is not supported for argument 'x'.", fixed = TRUE) +}) + + +test_that("nswitch-0019.048", { + expect_error(nswitch(as.raw(x1), as.raw(0L), 1+0i, as.raw(1L), 2+0i, as.raw(2L), 3+0i, default = 4+0i), regexp = "Type raw is not supported for argument 'x'.", fixed = TRUE) +}) + + +test_that("nswitch-0019.049", { + expect_error(nswitch(as.raw(x1), as.raw(0L), "1", as.raw(1L), "2", as.raw(2L), "3", default = "4"), regexp = "Type raw is not supported for argument 'x'.", fixed = TRUE) +}) + + +test_that("nswitch-0019.050", { + expect_error(nswitch(as.raw(x1), as.raw(0L), list(1), as.raw(1L), list(2), as.raw(2L), list(3), default = list(4)), regexp = "Type raw is not supported for argument 'x'.", fixed = TRUE) +}) + + +test_that("nswitch-0019.051", { + expect_error(nswitch(as.raw(x1), as.raw(0L), TRUE, as.raw(1L), FALSE), regexp = "Type raw is not supported for argument 'x'.", fixed = TRUE) +}) + + +test_that("nswitch-0019.052", { + expect_error(nswitch(x1, 0L, as.factor(1L), default = as.factor(4L)), regexp = "Resulting value and 'default' are both type factor but their levels are different.", fixed = TRUE) +}) + + +test_that("nswitch-0019.053", { + expect_error(nswitch(x1, 0L, as.factor(1L),1L, as.factor(2L), default = as.factor(1L)), regexp = "Items 2 and 4 of '...' are both factor but their levels are different.", fixed = TRUE) +}) + + +test_that("nswitch-0019.054", { + expect_error(nswitch(x1, 0L, 1, 1L, as.Date("2020-01-01"), default = 2), regexp = "Items 2 and 4 of '...' must have same class.", fixed = TRUE) +}) + + +test_that("nswitch-0019.055", { + expect_error(nswitch(x1, 0L, 1L, 1L, s1), regexp = "S4 class objects for argument '...' (item 2) are not supported.", fixed = TRUE) +}) + + +test_that("nswitch-0019.056", { + expect_error(nswitch(x1, 0L, 1L, 1L, c(2L,3L)), regexp = "Length of item 4 of '...' is different than 1 and length of 'x'. Please make sure that all items of 'output' have length 1 or length of 'x'(6).", fixed = TRUE) +}) + + +test_that("nswitch-0019.057", { + expect_error(nswitch(x1, 0L, 1L, 1L, 2, 2L, 3L), regexp = "Item 2 and 4 of '...' are not of the same type.", fixed = TRUE) +}) + + +test_that("nswitch-0019.058", { + expect_error(nswitch(x1, 0L, 1L, 1, 2L, 2L, 3L), regexp = "Item 1 and 3 of '...' are not of the same type.", fixed = TRUE) +}) + + +test_that("nswitch-0019.059", { + expect_error(nswitch(x1, c(0L,1L), 1L, 1L, 2L, 2L, 3L), regexp = "Length of item 1 of '...' is different than 1. Please make sure it has length 1.", fixed = TRUE) +}) + + +test_that("nswitch-0019.060", { + expect_identical(nswitch(c(enc1,enc2),enc1,1), c(1,1)) +}) + + +test_that("nswitch-0019.061", { + expect_identical(nswitch(c(enc1,enc1),enc1,1), c(1,1)) +}) + + +test_that("nswitch-0019.062", { + expect_identical(nswitch(c(enc2,enc2),enc2,1), c(1,1)) +}) + + +test_that("nswitch-0019.063", { + expect_identical(nswitch(c(enc1,enc2),enc2,1), c(1,1)) +}) + + +test_that("nswitch-0019.064", { + expect_identical(nswitch(c(enc1,enc1),enc2,1), c(1,1)) +}) + + +test_that("nswitch-0019.065", { + expect_identical(nswitch(rep(1:4, each = 2), 1L, 1:8, 2L, 11:18, 3L, 21:28, 4L, 31:38), vswitch(x = rep(1:4, each = 2), values = c(1L,2L,3L,4L), outputs = list(1:8,11:18,21:28,31:38))) +}) + + +test_that("nswitch-0019.066", { + expect_identical(nswitch(rep(1:4, each = 2), 1L, as.numeric(1:8), 2L, as.numeric(11:18), 3L, as.numeric(21:28), 4L, as.numeric(31:38)), vswitch(x = rep(1:4, each = 2), values = c(1L,2L,3L,4L), outputs = list(as.numeric(1:8),as.numeric(11:18),as.numeric(21:28),as.numeric(31:38)))) +}) + + +test_that("nswitch-0019.067", { + expect_identical(nswitch(rep(1:4, each = 2), 1L, as.character(1:8), 2L, as.character(11:18), 3L, as.character(21:28), 4L, as.character(31:38)), vswitch(x = rep(1:4, each = 2), values = c(1L,2L,3L,4L), outputs = list(as.character(1:8),as.character(11:18),as.character(21:28),as.character(31:38)))) +}) + + +test_that("nswitch-0019.068", { + expect_identical(nswitch(rep(as.numeric(1:4), each = 2), 1, 1:8, 2, 11:18, 3, 21:28, 4, 31:38), vswitch(x = rep(as.numeric(1:4), each = 2), values = c(1,2,3,4), outputs = list(1:8,11:18,21:28,31:38))) +}) + + +test_that("nswitch-0019.069", { + expect_identical(nswitch(rep(as.numeric(1:4), each = 2), 1, as.numeric(1:8), 2, as.numeric(11:18), 3, as.numeric(21:28), 4, as.numeric(31:38)), vswitch(x = rep(as.numeric(1:4), each = 2), values = c(1,2,3,4), outputs = list(as.numeric(1:8),as.numeric(11:18),as.numeric(21:28),as.numeric(31:38)))) +}) + + +test_that("nswitch-0019.070", { + expect_identical(nswitch(rep(as.numeric(1:4), each = 2), 1, as.character(1:8), 2, as.character(11:18), 3, as.character(21:28), 4, as.character(31:38)), vswitch(x = rep(as.numeric(1:4), each = 2), values = c(1,2,3,4), outputs = list(as.character(1:8),as.character(11:18),as.character(21:28),as.character(31:38)))) +}) +