Nothing
tests/test_kit.R
In kit: Data Manipulation Functions Implemented in C
# --------------------------------------------------------------------------------------------------
# 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
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)
# --------------------------------------------------------------------------------------------------
# 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 = shareData(mtcars,"share1")
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)
# --------------------------------------------------------------------------------------------------
# END
# --------------------------------------------------------------------------------------------------
Try the kit package in your browser
Any scripts or data that you put into this service are public.
kit documentation built on June 22, 2024, 10:44 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
# --------------------------------------------------------------------------------------------------
# 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
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)
# --------------------------------------------------------------------------------------------------
# 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 = shareData(mtcars,"share1")
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)
# --------------------------------------------------------------------------------------------------
# END
# --------------------------------------------------------------------------------------------------
Try the kit package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.