BBmisc/0000755000175100001440000000000012741102356011430 5ustar hornikusersBBmisc/tests/0000755000175100001440000000000012644315506012577 5ustar hornikusersBBmisc/tests/run-all.R0000644000175100001440000000004712644315506014275 0ustar hornikuserslibrary(testthat) test_check("BBmisc") BBmisc/tests/testthat/0000755000175100001440000000000012741012415014426 5ustar hornikusersBBmisc/tests/testthat/test_seq.R0000644000175100001440000000021412644315506016406 0ustar hornikuserscontext("seq") test_that("seq", { expect_equal(seq_row(iris), seq_len(nrow(iris))) expect_equal(seq_col(iris), seq_len(ncol(iris))) }) BBmisc/tests/testthat/test_convertListOfRowsToDataFrame.R0000644000175100001440000000363112644315506023350 0ustar hornikuserscontext("convertListOfRowstoDataFrame") test_that("convertListOfRowstoDataFrame", { df1 = convertListOfRowsToDataFrame(list(list(x = 1, y = "a"), list(x = 2, y = "b")), strings.as.factors = FALSE) df2 = data.frame(x = 1:2, y = c("a", "b"), stringsAsFactors = FALSE) expect_equal(df1, df2) df1 = convertListOfRowsToDataFrame(list(c(x = "1", y = "a"), list(x = "2", y = "b")), strings.as.factors = FALSE) df2 = data.frame(x=c("1", "2"), y=c("a", "b"), stringsAsFactors = FALSE) expect_equal(df1, df2) df1 = convertListOfRowsToDataFrame(list(c("1", "a"), c("2", "b")), strings.as.factors = FALSE, col.names=c("x", "y")) df2 = data.frame(x=c("1", "2"), y=c("a", "b"), stringsAsFactors = FALSE) expect_equal(df1, df2) df1 = convertListOfRowsToDataFrame(list(list(a = 1, b = 1), list(b = 12))) df2 = convertListOfRowsToDataFrame(list(c(a = 1, b = 1), c(b = 12))) expect_equal(df1, df2) # names df1 = convertListOfRowsToDataFrame(list(list(x = 1, y = "a"), list(x = 2, y = "b")), strings.as.factors = FALSE, row.names = c("r1", "r2")) df2 = setRowNames(data.frame(x = 1:2, y = c("a", "b"), stringsAsFactors = FALSE), c("r1", "r2")) expect_equal(df1, df2) df1 = convertListOfRowsToDataFrame(list(list(x = 1, y = "a"), list(x = 2, y = "b")), strings.as.factors = FALSE, row.names = 1:2) df2 = setRowNames(data.frame(x = 1:2, y = c("a", "b"), stringsAsFactors = FALSE), 1:2) expect_equal(df1, df2) df1 = convertListOfRowsToDataFrame(list(list(x = 1, y = "a"), list(x = 2, y = "b")), strings.as.factors = FALSE, col.names = c("c1", "c2")) df2 = data.frame(c1 = 1:2, c2 = c("a", "b"), stringsAsFactors = FALSE) expect_equal(df1, df2) df1 = convertListOfRowsToDataFrame(list(list(x = 1, y = "a"), list(x = 2, y = "b")), strings.as.factors = FALSE, col.names = 1:2) df2 = setColNames(data.frame(1:2, c("a", "b"), stringsAsFactors = FALSE), 1:2) expect_equal(df1, df2) }) BBmisc/tests/testthat/test_isValidNames.R0000644000175100001440000000046212644315506020202 0ustar hornikuserscontext("isValidName") test_that("isValidName", { expect_true(isValidName("a")) expect_true(all(isValidName(c("a", "b")))) expect_equal(isValidName(c("a", "a")), c(TRUE, FALSE)) expect_true(all(isValidName(c("a", "a"), unique=FALSE))) expect_equal(isValidName(c("x", "..1")), c(TRUE, FALSE)) }) BBmisc/tests/testthat/test_asMatrix.R0000644000175100001440000000457112644315506017420 0ustar hornikusers context("asMatrix") test_that("asMatrix", { # empty expect_equal( asMatrixCols(list()), matrix(0, nrow = 0L, ncol = 0L) ) expect_equal( asMatrixRows(list()), matrix(0, nrow = 0L, ncol = 0L) ) # normal expect_equal( asMatrixCols(list(c(1, 2), c(3, 3), c(4, 4))), matrix(c(1, 2, 3, 3, 4, 4), nrow = 2, ncol = 3, byrow = FALSE) ) expect_equal( asMatrixRows(list(c(1, 2), c(3, 3), c(4, 4))), matrix(c(1, 2, 3, 3, 4, 4), nrow = 3, ncol = 2, byrow = TRUE) ) # names expect_equal( asMatrixCols(list(a = c(1, 2), b = c(3, 3), c = c(4, 4))), setColNames(matrix(c(1, 2, 3, 3, 4, 4), nrow = 2, ncol = 3, byrow = FALSE), c("a", "b", "c")) ) expect_equal( asMatrixRows(list(a = c(1, 2), b = c(3, 3), c = c(4, 4))), setRowNames(matrix(c(1, 2, 3, 3, 4, 4), nrow = 3, ncol = 2, byrow = TRUE), c("a", "b", "c")) ) expect_equal( asMatrixRows(list(a = c(x = 1, y = 2), b = c(3, 3), c = c(4, 4))), setColNames(setRowNames(matrix(c(1, 2, 3, 3, 4, 4), nrow = 3, ncol = 2, byrow = TRUE), c("a", "b", "c")), c("x", "y")) ) # manually define rownames expect_equal( asMatrixCols(list(a = c(1, 2), b = c(3, 3), c = c(4, 4)), row.names = c("xx", "yy")), setColNames( setRowNames(matrix(c(1, 2, 3, 3, 4, 4), nrow = 2, ncol = 3, byrow = FALSE), c("xx", "yy")), c("a", "b", "c")) ) # manually define rownames, but use ints expect_equal( asMatrixCols(list(a = c(1, 2), b = c(3, 3), c = c(4, 4)), row.names = 1:2), setColNames( setRowNames(matrix(c(1, 2, 3, 3, 4, 4), nrow = 2, ncol = 3, byrow = FALSE), 1:2), c("a", "b", "c")) ) # manually define colnames expect_equal( asMatrixCols(list(a = c(1, 2), b = c(3, 3), c = c(4, 4)), col.names = c("xx", "yy", "zz")), setColNames( matrix(c(1, 2, 3, 3, 4, 4), nrow = 2, ncol = 3, byrow = FALSE), c("xx", "yy", "zz")) ) expect_equal( asMatrixRows(list(a = c(1, 2), b = c(3, 3), c = c(4, 4)), col.names = c("xx", "yy")), setRowNames( setColNames( matrix(c(1, 2, 3, 3, 4, 4), nrow = 3, ncol = 2, byrow = TRUE), c("xx", "yy") ), c("a", "b", "c") ) ) # manually define colnames, but use ints expect_equal( asMatrixCols(list(a = c(1, 2), b = c(3, 3), c = c(4, 4)), col.names = 1:3), setColNames( matrix(c(1, 2, 3, 3, 4, 4), nrow = 2, ncol = 3, byrow = FALSE), 1:3) ) }) BBmisc/tests/testthat/test_nin.R0000644000175100001440000000033212644315506016403 0ustar hornikuserscontext("nin") test_that("nin", { expect_true(1 %nin% 2:3) expect_false(1 %nin% 1) expect_false(1 %nin% c(NA, 1)) expect_true(1 %nin% c(NA, 2)) expect_false(NA %nin% c(NA, 1)) expect_true(NA %nin% 1:2) }) BBmisc/tests/testthat/test_checkArg.R0000644000175100001440000000634312644315506017336 0ustar hornikuserscontext("argument check") test_that("checkArg", { f = function(x) checkArg(x, cl="integer", len=1) f(1L) expect_error(f(1)) expect_error(f(1:2)) f = function(x) checkArg(x, cl="integer", min.len=2) f(1:2) expect_error(f(1L)) f = function(x) checkArg(x, cl="integer", max.len=2) f(1:2) expect_error(f(1:3)) f = function(x) checkArg(x, cl="integer", len=2, na.ok=FALSE) f(1:2) expect_error(f(c(3L, NA))) f = function(x) checkArg(x, cl="numeric", lower=2) f(4:6) expect_error(f(1:3)) f = function(x) checkArg(x, cl="numeric", upper=2) f(1) expect_error(f(3), "less than or equal 2") f = function(x) checkArg(x, cl="numeric", lower=1, upper=2) f(1); f(1.5); f(2) expect_error(f(0), "greater than or equal 1") expect_error(f(3), "less than or equal 2") f = function(x) checkArg(x, cl="numeric", lower=1, upper=5) f(1:5) expect_error(f(0:5), "greater than or equal 1") expect_error(f(1:6), "less than or equal 5") f = function(x) checkArg(x, formals=c("foo", "bar")) f(function(foo, bar) 1) f(function(foo, bar, bla) 1) expect_error(f(1), "must be of class function not: numeric") expect_error(f(function(blubb) 1), "must have first formal args") expect_error(f(function(foo) 1), "must have first formal args") checkArg(1, "vector") checkArg(1L, "vector") checkArg(TRUE, "vector") checkArg("a", "vector") checkArg(list(), "vector") checkArg(list(1), "vector") }) test_that("checkArg with choices", { f = function(x) checkArg(x, choices=c("a", "b")) f("a") f("b") expect_error(f(c("a", "b")), "must be") expect_error(f(1), "must be") expect_error(f(NULL), "must be") expect_error(f(NA)) f = function(x) checkArg(x, choices=list(NULL, 1L, data.frame())) f(1L) f(NULL) f(data.frame()) expect_error(f(1), "must be") expect_error(f(list(1)), "must be") }) test_that("checkArg with subset", { f = function(x) checkArg(x, subset=c("a", "b")) f("a") f("b") f(c("a", "b")) f(character(0)) expect_error(f(1), "must be") expect_error(f(NA), "must be") f = function(x) checkArg(x, subset=list(NULL, 1L, data.frame())) f(1L) f(NULL) f(data.frame()) f(list(NULL, data.frame())) expect_error(f(1), "must be") expect_error(f(list(1)), "must be") }) test_that("checkArg with missing arg", { f = function(x) checkArg(x, "numeric") expect_error(f(), "Argument x must not be missing!") }) # FIXME no idea why this does not run in "CMD check" if (interactive()) { test_that("checkArg with classes / s3 and s4", { x = 1 class(x) = c("foo2", "foo1") checkArg(x, "foo1") checkArg(x, "foo1", s4=FALSE) checkArg(x, "foo1", s4=TRUE) checkArg(x, "foo2") checkArg(x, "foo2", s4=FALSE) checkArg(x, "foo2", s4=TRUE) mys41 = setClass("mys41", representation(x="numeric")) mys42 = setClass("mys42", contains="mys41", representation(y="numeric")) obj1 = mys41(x=3) obj2 = mys42(x=3, y=4) checkArg(obj1, "mys41", s4=TRUE) checkArg(obj2, "mys41", s4=TRUE) checkArg(obj2, "mys42", s4=TRUE) }) } test_that("checkArg with multiple classes", { checkArg(1, c("numeric", "list")) checkArg(1, c("numeric", "foo")) checkArg(1L, c("integer", "list")) checkArg(1L, c("integer", "foo")) checkArg(1L, c("numeric", "list")) checkArg(1L, c("numeric", "foo")) }) BBmisc/tests/testthat/test_factor.R0000644000175100001440000000023412644315506017076 0ustar hornikuserscontext("factor") test_that("combine", { x = factor(c("a", "b")) y = factor(c("b", "c")) expect_equal(cFactor(x,y), factor(c("a", "b", "b", "c"))) })BBmisc/tests/testthat/test_insert.R0000644000175100001440000000055312644315506017130 0ustar hornikuserscontext("insert") test_that("insert", { # list xs1 = list(a=1, b=2) expect_equal(insert(xs1, list(a=99, c=5)), list(a=99, b=2, c=5)) expect_equal(insert(xs1, list(a=list(99), c=5)), list(a=list(99), b=2, c=5)) # vector xs1 = c(a=1, b=2) expect_equal(insert(xs1, c(a=99, c=5)), c(a=99, b=2, c=5)) expect_equal(insert(xs1, c()), xs1) }) BBmisc/tests/testthat/test_isFALSE.R0000644000175100001440000000023412644315506017006 0ustar hornikuserscontext("isFALSE") test_that("isFALSE", { expect_equal(isFALSE(FALSE), TRUE) expect_equal(isFALSE(TRUE), FALSE) expect_equal(isFALSE(0), FALSE) }) BBmisc/tests/testthat/test_getUnixTime.R0000644000175100001440000000020612644315506020061 0ustar hornikuserscontext("getUnixTime") test_that("getUnixTime", { x = getUnixTime() expect_true(is.integer(x) && length(x) == 1 && !is.na(x)) }) BBmisc/tests/testthat/test_filterNull.R0000644000175100001440000000031112644315506017734 0ustar hornikuserscontext("filterNull") test_that("filterNull", { li = list(1, 2, NULL, 3) expect_equal(filterNull(li), list(1, 2, 3)) expect_equal(filterNull(list()), list()) expect_error(filterNull(iris)) }) BBmisc/tests/testthat/test_rangeVal.R0000644000175100001440000000050612644315506017361 0ustar hornikusers context("rangeVal") test_that("rangeVal", { expect_equal(rangeVal(c(1, 5)), 4) expect_equal(rangeVal(1), 0) expect_equal(rangeVal(1:3), 2) # NAs expect_equal(rangeVal(c(1, 2, NA)), NA_real_) expect_equal(rangeVal(c(1, 2, NA), na.rm = TRUE), 1) expect_equal(rangeVal(c(NA_real_), na.rm = TRUE), NA_real_) }) BBmisc/tests/testthat/test_load2_save2.R0000644000175100001440000000127112644315506017723 0ustar hornikuserscontext("load2") test_that("load2", { fd = tempdir() fn = file.path(fd, "foo.RData") save2(file=fn, x=1) expect_equal(load2(fn), 1) expect_equal(load2(fn, parts="x"), 1) z = list(x=1) expect_equal(load2(fn, simplify=FALSE), z) expect_error(load2(fn, parts="y"), "does not contain: y") ee = new.env() load2(fn, envir=ee) expect_equal(ee$x, 1) fn2 = file.path(fd, "xxx.RData") expect_error(expect_warning(load2(fn2))) expect_equal(load2(fn2, impute = NA), NA) save2(file=fn, x=1, y=2) z = list(x=1, y=2) expect_equal(load2(fn), z) expect_equal(load2(fn, parts=c("x", "y")), z) expect_equal(load2(fn, parts="x"), 1) expect_equal(load2(fn, parts="y"), 2) }) BBmisc/tests/testthat/test_makeSimpleFileLogger.R0000644000175100001440000000165112644315506021653 0ustar hornikuserscontext("makeSimpleFileLogger") test_that("makeSimpleFileLogger", { fn = tempfile() logger = makeSimpleFileLogger(fn) expect_identical(class(logger), "SimpleFileLogger") expect_equal(logger$getSize(), 0) msg1 = "xxx111xxx" logger$log(msg1) expect_true(grepl(msg1, readLines(fn))) expect_identical(msg1, logger$getMessages(1)) expect_equal(logger$getSize(), 1) expect_true(file.exists(fn)) logger$clear() expect_false(file.exists(fn)) }) test_that("message order", { fn = tempfile() msg1 = "xxx111xxx" msg2 = "xxx222xxx" for (keep in c(0, 10)) { logger = makeSimpleFileLogger(fn) logger$log(msg1) logger$log(msg2) expect_identical(grepl("xxx[0-9]+xxx$", readLines(fn)), c(TRUE, TRUE)) expect_identical(grepl("^xxx[0-9]+xxx$", logger$getMessages(2)), c(TRUE, TRUE)) expect_identical(logger$getMessages(1), msg2) expect_identical(logger$getMessages(2), c(msg2, msg1)) } }) BBmisc/tests/testthat/test_isScalarValue.R0000644000175100001440000000175012644315506020362 0ustar hornikuserscontext("isScalarValue") test_that("isScalarValue", { expect_true(isScalarValue(1)) expect_true(isScalarValue(1L)) expect_true(isScalarValue("a")) expect_true(isScalarValue(factor("a"))) expect_true(isScalarValue(as.complex(1))) expect_true(isScalarValue(NA)) expect_true(isScalarNumeric(1)) expect_true(isScalarInteger(1L)) expect_true(isScalarCharacter("a")) expect_true(isScalarFactor(factor("a"))) expect_true(isScalarComplex(as.complex(1))) expect_true(isScalarLogical(NA)) expect_false(isScalarComplex(1L)) expect_false(isScalarInteger(1)) expect_false(isScalarFactor("a")) expect_false(isScalarCharacter(factor("a"))) expect_false(isScalarNumeric(as.complex(1))) expect_false(isScalarInteger(NA)) expect_false(isScalarValue(NULL)) expect_false(isScalarValue(iris)) expect_false(isScalarValue(1:2)) expect_false(isScalarValue(list(1))) expect_true(isScalarValue(NULL, null.ok=TRUE)) expect_false(isScalarValue(NULL, na.ok=FALSE)) }) BBmisc/tests/testthat/test_collapse.R0000644000175100001440000000024512644315506017424 0ustar hornikuserscontext("collapse") test_that("collapse", { expect_equal(collapse(1), "1") expect_equal(collapse(1:2), "1,2") expect_equal(collapse(c("a", "22")), "a,22") }) BBmisc/tests/testthat/test_getClass1.R0000644000175100001440000000037512644315506017454 0ustar hornikuserscontext("getClass1") test_that("getClass1", { expect_equal(getClass1(iris), "data.frame") expect_equal(getClass1(1), "numeric") expect_equal(getClass1(NULL), "NULL") x = makeS3Obj(c("C1", "C2"), foo = 2) expect_equal(getClass1(x), "C1") }) BBmisc/tests/testthat/test_dropNamed.R0000644000175100001440000000157712644315506017544 0ustar hornikuserscontext("dropNamed") test_that("dropNamed", { x = matrix(1:4, 2, 2) colnames(x) = c("a", "b") y = dropNamed(x, character(0)) expect_equal(y, x) y = dropNamed(x, c("a")) expect_equal(y, x[, "b", drop=FALSE]) y = dropNamed(x, c("a", "b")) expect_equal(y, x[, character(0)]) x = as.data.frame(x) y = dropNamed(x, character(0)) expect_equal(y, x) y = dropNamed(x, c("a")) expect_equal(y, x[, "b", drop=FALSE]) y = dropNamed(x, c("a", "b")) expect_equal(y, x[, character(0)]) x = list(a=1, b=2) y = dropNamed(x, character(0)) expect_equal(y, x) y = dropNamed(x, c("a")) expect_equal(y, x["b"]) y = dropNamed(x, c("a", "b")) expect_equal(y, x[character(0)]) x = c(a=1, b=2) y = dropNamed(x, character(0)) expect_equal(y, x) y = dropNamed(x, c("a")) expect_equal(y, x["b"]) y = dropNamed(x, c("a", "b")) expect_equal(y, x[character(0)]) }) BBmisc/tests/testthat/test_computeMode.R0000644000175100001440000000137612741010033020072 0ustar hornikuserscontext("computeMode") test_that("computeMode", { # factor expect_equal(computeMode(as.factor(c(1:2, 2L, 2L))), "2") #character expect_equal(computeMode(c("1","2","3"), ties.method="last"), "3") # numeric expect_equal(computeMode(c(1,1,2,3)), 1) # integer expect_equal(computeMode(c(1:2, 2L, 2L), ties.method="first"), 2L) expect_equal(computeMode(c(1:2, 2L, 2L), ties.method="random"), 2L) expect_equal(computeMode(c(1:2, 2L, 2L), ties.method="last"), 2L) # logical expect_equal(computeMode(c(TRUE, FALSE, FALSE)), FALSE) expect_equal(computeMode(c(TRUE, TRUE, FALSE)), TRUE) # na.rm expect_equal(computeMode(c(1,1,2,3, NA, NA, NA), na.rm=FALSE), as.numeric(NA)) expect_equal(computeMode(c(1,1,2,3, NA, NA, NA), na.rm=TRUE), 1) }) BBmisc/tests/testthat/test_convertMatrixType.R0000644000175100001440000000027512644315506021334 0ustar hornikuserscontext("convertMatrixType") test_that("convertMatrixType", { a1 = matrix(1:4, 2L, 2L) a2 = matrix(as.character(1:4), 2L, 2L) expect_equal(convertMatrixType(a1, "character"), a2) }) BBmisc/tests/testthat/test_btwn.R0000644000175100001440000000035612644315506016577 0ustar hornikuserscontext("btwn") test_that("btwn", { y = c(-1L,5L,Inf) expect_equal(1L:3L %btwn% y, c(TRUE, TRUE, TRUE)) expect_equal(-2L:-1L %btwn% y, c(FALSE,TRUE)) y = 5L expect_equal(5L %btwn% y, TRUE) expect_equal(1L %btwn% y, FALSE) }) BBmisc/tests/testthat/test_splitTime.R0000644000175100001440000000216412644315506017576 0ustar hornikuserscontext("splitTime") test_that("splitTime", { expect_equal(splitTime(0, "years"), c(years=0, days=0, hours=0, minutes=0, seconds=0)) expect_equal(splitTime(0, "days"), c(years=NA, days=0, hours=0, minutes=0, seconds=0)) expect_equal(splitTime(0, "hours"), c(years=NA, days=NA, hours=0, minutes=0, seconds=0)) expect_equal(splitTime(0, "minutes"), c(years=NA, days=NA, hours=NA, minutes=0, seconds=0)) expect_equal(splitTime(0, "seconds"), c(years=NA, days=NA, hours=NA, minutes=NA, seconds=0)) seconds = 2 * 365 * 24 * 60 * 60 expect_equal(splitTime(seconds, "years"), c(years=2, days=0, hours=0, minutes=0, seconds=0)) expect_equal(splitTime(seconds, "days"), c(years=NA, days=2 * 365, hours=0, minutes=0, seconds=0)) expect_equal(splitTime(seconds, "hours"), c(years=NA, days=NA, hours=2 * 365 * 24, minutes=0, seconds=0)) expect_equal(splitTime(seconds, "minutes"), c(years=NA, days=NA, hours=NA, minutes=2 * 365 * 24 * 60, seconds=0)) expect_equal(splitTime(seconds, "seconds"), c(years=NA, days=NA, hours=NA, minutes=NA, seconds=seconds)) expect_true(is.integer(splitTime(100000, "minutes"))) }) BBmisc/tests/testthat/test_lsort.R0000644000175100001440000000025612644315506016767 0ustar hornikuserscontext("lsort") test_that("lsort", { expect_equal(lsort(c("c", "a", "b")), c("a", "b", "c")) expect_equal(lsort( c("a", "ä", "ö", "o")), c("a", "o", "ä", "ö")) }) BBmisc/tests/testthat/test_explode.R0000644000175100001440000000070612644315506017264 0ustar hornikuserscontext("explode") test_that("explode", { x = "R is a nice programming language" substrings = c("R", "is", "a", "nice", "programming", "language") sep = " " # split string exploded = explode(x, sep = sep) expect_equal(length(exploded), 6) for (i in 1:length(substrings)) { expect_equal(substrings[i], exploded[[i]]) } # now glue the substrings together collapsed = collapse(exploded, sep = sep) expect_equal(collapsed, x) }) BBmisc/tests/testthat/test_printf.R0000644000175100001440000000143512741010551017114 0ustar hornikuserscontext("print*f variants") test_that("messagef", { expect_message(messagef("xxx%ixxx", 123), "xxx123xxx") }) test_that("catf", { expect_output(catf("xxx%ixxx", 123), "xxx123xxx") }) test_that("catf into file", { fn = tempfile() catf("xxx%ixxx", 123, file=fn) s = readLines(fn) expect_equal(s, "xxx123xxx") unlink(fn) }) test_that("warningf", { expect_warning(warningf("xxx%ixxx", 123), "xxx123xxx") f = function() warningf("123") # "Warning: " not caught by gives_warning expect_warning(f(), "123") }) test_that("stopf", { expect_error(stopf("xxx%ixxx", 123), "xxx123xxx") f = function() stopf("123") # because try is called in throws_error # (and prints a bit differently of course!!!!) # we get an extra space before the : expect_error(f(), "123") }) BBmisc/tests/testthat/test_normalize.R0000644000175100001440000000470212644315506017624 0ustar hornikuserscontext("normalize") test_that("normalize", { # vector x = runif(20) y = normalize(x, method = "range") expect_is(y, "numeric") expect_equal(range(y), c(0, 1)) y = normalize(x, method = "range", range = c(-4, 2)) expect_is(y, "numeric") expect_equal(range(y), c(-4, 2)) y = normalize(x, method = "center") expect_is(y, "numeric") expect_equal(mean(y), 0) y = normalize(x, method = "standardize") expect_is(y, "numeric") expect_equal(mean(y), 0) expect_equal(sd(y), 1) # matrix x = matrix(runif(100), nrow = 5) y = normalize(x, margin = 1L) expect_is(y, "matrix") apply(y, 1, function(v) expect_equal(mean(v), 0)) apply(y, 1, function(v) expect_equal(sd(v), 1)) y = normalize(x, margin = 2L) apply(y, 2, function(v) expect_equal(mean(v), 0)) apply(y, 2, function(v) expect_equal(sd(v), 1)) # data.frame y = normalize(iris, method = "range", range = c(3, 4)) expect_is(y, "data.frame") for (i in 1:4) expect_equal(range(y[, i]), c(3, 4)) expect_equal(y[, 5L], iris$Species) # constant vectors x = rep(1, 10) y = normalize(x, method = "center", on.constant = "quiet") expect_is(y, "numeric") expect_equal(y, x - x) y = normalize(x, method = "scale", on.constant = "quiet") expect_is(y, "numeric") expect_equal(y, x) y = normalize(x, method = "standardize", on.constant = "quiet") expect_is(y, "numeric") expect_equal(y, x - x) y = normalize(x, method = "range", on.constant = "quiet", range = c(-3, 2)) expect_is(y, "numeric") expect_equal(y, rep(-0.5, 10)) expect_error(normalize(x, method = "center", on.constant = "stop")) expect_error(normalize(x, method = "scale", on.constant = "stop")) expect_error(normalize(x, method = "standardize", on.constant = "stop")) expect_error(normalize(x, method = "range", on.constant = "stop")) expect_warning(normalize(x, method = "center", on.constant = "warn")) expect_warning(normalize(x, method = "scale", on.constant = "warn")) expect_warning(normalize(x, method = "standardize", on.constant = "warn")) expect_warning(normalize(x, method = "range", on.constant = "warn")) }) test_that("normalize works with NAs", { # vector x = c(1, 2, NA) y = normalize(x, method = "range") expect_equal(y, c(0, 1, NA)) y = normalize(x, method = "center") expect_equal(y, c(-0.5, 0.5, NA)) # matrix x = matrix(c(1, 2, 1, NA), nrow = 2L) y = normalize(x, margin = 2L, method = "range") expect_equal(y, matrix(c(0, 1, 0.5, NA), nrow = 2L)) }) BBmisc/tests/testthat/test_setAttribute.R0000644000175100001440000000034712644315506020304 0ustar hornikuserscontext("setAttribute") test_that("setAttribute", { x = 1:9 x = setAttribute(x, "foo", "bar") x = setAttribute(x, "dim", c(3,3)) expect_equal(attr(x, "foo"), "bar") expect_equal(nrow(x), 3) expect_equal(ncol(x), 3) }) BBmisc/tests/testthat/test_isProperlyNamed.R0000644000175100001440000000055212644315506020740 0ustar hornikuserscontext("isProperlyNamed") test_that("isProperlyNamed", { expect_true(isProperlyNamed(list())) expect_true(isProperlyNamed(list(x=1))) expect_true(isProperlyNamed(list(x=1, y=2))) expect_true(!isProperlyNamed(list(1,2))) xs = list(1,2) names(xs)[1] = "a" expect_true(!isProperlyNamed(xs)) names(xs)[2] = "b" expect_true(isProperlyNamed(xs)) })BBmisc/tests/testthat/test_printToChar.R0000644000175100001440000000046512644315506020063 0ustar hornikuserscontext("printToChar") test_that("printToChar", { if (!interactive()) { z = list() class(z) = "foo" print.foo <<- function(x, ...) catf("bar") s = printToChar(z) expect_equal(s, "bar") print.foo <<- function(x, ...) catf("bar\nblubb") s = printToChar(z) expect_equal(s, "bar\nblubb") } })BBmisc/tests/testthat/test_is_error.R0000644000175100001440000000021412644315506017442 0ustar hornikuserscontext("is.error") test_that("is.error", { expect_true(is.error(try(stop("foo"), silent=TRUE))) expect_false(is.error(try("foo"))) }) BBmisc/tests/testthat/test_addClasses.R0000644000175100001440000000043112644315506017665 0ustar hornikuserscontext("addClasses") test_that("addClasses", { x = list(a=1) x = addClasses(x, "foo1") expect_equal(x, structure(list(a=1), class=c("foo1", "list"))) x = addClasses(x, c("foo2", "foo3")) expect_equal(x, structure(list(a=1), class=c("foo2", "foo3", "foo1", "list"))) }) BBmisc/tests/testthat/test_sortByCol.R0000644000175100001440000000233112644315506017540 0ustar hornikuserscontext("sortByCol") test_that("sortByCol", { d1 = setRowNames(data.frame(x = c(2, 3, 1), y = c("a", "c", "b")), c("1", "2", "3")) d2 = sortByCol(d1, "x") d3 = setRowNames(data.frame(x = c(1, 2, 3), y = c("b", "a", "c")), c(3, 1, 2)) expect_equal(d2, d3) d2 = sortByCol(d1, "x", asc = FALSE) d3 = setRowNames(data.frame(x = c(3, 2, 1), y = c("c", "a", "b")), c(2, 1, 3)) expect_equal(d2, d3) d2 = sortByCol(d1, c("x", "y")) d3 = setRowNames(data.frame(x = c(1, 2, 3), y = c("b", "a", "c")), c(3, 1, 2)) expect_equal(d2, d3) d2 = sortByCol(d1, "y") d3 = setRowNames(data.frame(x = c(2, 1, 3), y = c("a", "b", "c")), c(1, 3, 2)) expect_equal(d2, d3) # real tie breaker d1 = data.frame(x = c(2, 2, 1), y = c("a", "b", "c")) d2 = sortByCol(d1, c("x", "y")) d3 = data.frame(x = c(1, 2, 2), y = c("c", "a", "b")) expect_equal(d2, d3, check.attributes = FALSE) d2 = sortByCol(d1, c("x", "y"), asc = c(TRUE, FALSE)) d3 = data.frame(x = c(1, 2, 2), y = c("c", "b", "a")) expect_equal(d2, d3, check.attributes = FALSE) # one col d1 = setRowNames(data.frame(x = c(1, 2)), c(1, 2)) d2 = sortByCol(d1, "x", asc = FALSE) d3 = setRowNames(data.frame(x = c(2, 1)), c(2, 1)) expect_equal(d2, d3) }) BBmisc/tests/testthat/test_optimizeSubInts.R0000644000175100001440000000061212644315506020770 0ustar hornikuserscontext("optimizeSubInts") test_that("optimizeSubInts", { f = function(x) sin(x) * x z = optimizeSubInts(f, interval = c(0, 50), nsub = 200L) fopt = f(pi * 3 / 2 + 14 * pi) expect_true(abs(fopt - z$objective) < 1e-1) # test with nsub = 1, had a bug here f = function(x) sum(x^2) z = optimizeSubInts(f, interval = c(-10, 10), nsub = 1) expect_true(abs(z$minimum) < 1e-5) }) BBmisc/tests/testthat/test_makeProgressBar.R0000644000175100001440000000231112741010551020673 0ustar hornikuserscontext("makeProgressBar") test_that("makeProgressBar", { cat("\n") bar = makeProgressBar() for(i in 0:100) { bar$set(i) Sys.sleep(0.01) } bar = makeProgressBar(min=10, max=50, label="foo") for(i in 11:50) { bar$set(i) Sys.sleep(0.01) } bar = makeProgressBar(min=0.1, max=0.2) for(i in seq(0.1, 0.2, length.out=5)) { bar$set(i) Sys.sleep(0.1) } bar$set(0.2) bar$set(0.2) bar = makeProgressBar(max=10^6, label=" ") for(i in 10^seq(1:6)) { bar$set(i, msg=sprintf("%i", i)) Sys.sleep(0.1) } bar = makeProgressBar(min=0, max=0) bar$set(0) bar = makeProgressBar(min=0, max=0) bar$inc(0) }) test_that("makeProgressBar global options", { old.style = getOption("BBmisc.ProgressBar.style") old.width = getOption("BBmisc.ProgressBar.width") options(BBmisc.ProgressBar.style = "off") cat("\n") bar = makeProgressBar(max=5) for(i in 0:5) { expect_silent(bar$set(i)) } options(BBmisc.ProgressBar.style = "text", BBmisc.ProgressBar.width = 30) cat("\n") bar = makeProgressBar(max=5) for(i in 0:5) { expect_output(print(bar$set(i))) } options(BBmisc.ProgressBar.style = old.style, BBmisc.ProgressBar.width = old.width) }) BBmisc/tests/testthat/test_capitalizeStrings.R0000644000175100001440000000123212644315506021316 0ustar hornikuserscontext("capitalizeStrings") test_that("capitalizeStrings", { testString = c("the taIl", "wags The dOg", "That Looks fuNny!") expect_equal(capitalizeStrings(testString) , c("The taIl", "Wags The dOg", "That Looks fuNny!")) expect_equal(capitalizeStrings(testString, all.words = TRUE) , c("The TaIl", "Wags The DOg", "That Looks FuNny!")) expect_equal(capitalizeStrings(testString, all.words = TRUE, lower.back = TRUE) , c("The Tail", "Wags The Dog", "That Looks Funny!")) expect_equal(capitalizeStrings(testString, lower.back = TRUE) , c("The tail", "Wags the dog", "That looks funny!")) }) BBmisc/tests/testthat/test_checkListElementClass.R0000644000175100001440000000051712644315506022035 0ustar hornikuserscontext("checkListElementClass") test_that("checkListElementClass", { checkListElementClass(list(1, 5), cl="numeric") expect_error(checkListElementClass(list(1, "a"), cl="numeric"), "numeric") xs = list("a", "b") checkListElementClass(xs, "character") expect_error(checkListElementClass(xs, "integer"), "character") }) BBmisc/tests/testthat/test_convertRowsToList.R0000644000175100001440000000360312644315506021315 0ustar hornikuserscontext("convertRowsToList") test_that("convertRowsToList", { expect_equal( convertRowsToList(matrix(1:4, 2, byrow=TRUE), as.vector = TRUE), list(c(1, 2), c(3, 4)) ) expect_equal( convertRowsToList(matrix(1:4, 2, byrow=TRUE), as.vector = FALSE), list(list(1, 2), list(3, 4)) ) expect_equal( convertRowsToList(setColNames(matrix(1:4, 2, byrow = TRUE), c("a", "b")), name.vector = TRUE, as.vector = FALSE), list(list(a=1, b=2), list(a=3, b=4)) ) expect_equal( convertRowsToList(setColNames(matrix(1:4, 2, byrow = TRUE), c("a", "b")), name.list = FALSE, as.vector = FALSE), list(list(1, 2), list(3, 4)) ) levs = c("a", "b") expect_equal( convertRowsToList(data.frame(a = 1:2, b = factor(c("a", "b"))), name.list = FALSE, factors.as.char = TRUE), list(list(1, "a"), list(2, "b")) ) expect_equal( convertRowsToList(setRowNames(data.frame(a = 1:2, b = factor(c("a", "b"))), c("x", "y")), name.list = TRUE, name.vector = TRUE, factors.as.char = FALSE), list(x = list(a = 1, b = factor("a", levels = levs)), y = list(a = 2, b = factor("b", levels = levs))) ) }) test_that("convertColsToList", { expect_equal( convertColsToList(matrix(1:4, 2, byrow = FALSE), as.vector = TRUE), list(c(1, 2), c(3, 4)) ) expect_equal( convertColsToList(matrix(1:4, 2, byrow = FALSE), as.vector = FALSE), list(list(1, 2), list(3, 4)) ) expect_equal( convertColsToList(setRowNames(matrix(1:4, 2, byrow = FALSE), c("a", "b")), name.vector = TRUE, as.vector = FALSE), list(list(a = 1, b = 2), list(a = 3, b = 4)) ) }) test_that("convertColsToList works with data.frame", { d1 = iris x1 = as.list(d1) expect_equal(convertColsToList(d1, factors.as.char = FALSE), x1) d2 = d1; d2$Species = as.character(d2$Species); x2 = as.list(d2) expect_equal(convertColsToList(d1, factors.as.char = TRUE), x2) }) BBmisc/tests/testthat/test_system3.R0000644000175100001440000000251712644315506017235 0ustar hornikuserscontext("system3") if (interactive()) { test_that("system3", { d = tempfile() dir.create(d) fn = file.path(d, "foo.bar") file.create(fn) # no error res = system3("ls", d) expect_equal(res, list(exit.code=0L, output=as.character(NA))) res = system3("ls", d, stdout=TRUE, stderr=TRUE) expect_equal(res, list(exit.code=0L, output="foo.bar")) # wrong command res = system3("xxx", stop.on.exit.code=FALSE) expect_equal(res, list(exit.code=127L, output=as.character(NA))) expect_error(system3("xxx", stop.on.exit.code=TRUE), "Command: xxx ; exit code: 127; output: NA") # exit code res = system3("ls", "xxx", stop.on.exit.code=FALSE) expect_equal(res, list(exit.code=2L, output=as.character(NA))) res = system3("ls", "xxx", stdout=TRUE, stderr=TRUE, stop.on.exit.code=FALSE) msg = "ls: cannot access xxx: No such file or directory" expect_equal(res$exit.code, 2L) expect_true(grep("ls:", res$output) == 1) expect_true(grep("xxx", res$output) == 1) expect_error(system3("ls", "xxx", stdout=TRUE, stderr=TRUE, stop.on.exit.code=TRUE), "Command: ls xxx; exit code: 2; output: ls:") expect_error(system3("ls", "xxx", stdout=TRUE, stderr=TRUE, stop.on.exit.code=TRUE), "xxx") expect_error(system3("ls", c("1", "2"), stdout=TRUE, stderr=TRUE, stop.on.exit.code=TRUE), "Command: ls") }) } BBmisc/tests/testthat/test_collapsef.R0000644000175100001440000000015212644315506017567 0ustar hornikuserscontext("collapsef") test_that("collapsef", { expect_equal(collapsef("%s=%s", 1:2, 3:4), "1=3,2=4") }) BBmisc/tests/testthat/test_setClasses.R0000644000175100001440000000035412644315506017734 0ustar hornikuserscontext("setClasses") test_that("setClasses", { x = list(a=1) expect_equal(setClasses(x, "foo"), structure(list(a=1), class="foo")) expect_equal(setClasses(x, c("foo1", "foo2")), structure(list(a=1), class=c("foo1", "foo2"))) }) BBmisc/tests/testthat/test_toRangeStr.R0000644000175100001440000000121412644315506017707 0ustar hornikuserscontext("toRangeStr") expect_range = function(x, str, ...) { expect_equal(toRangeStr(x, ...), str) expect_equal(toRangeStr(sample(x), ...), str) expect_equal(toRangeStr(sample(c(x, x)), ...), str) expect_equal(toRangeStr(sample(c(x, x)), ...), str) } test_that("continuous ranges", { x = c(1, 2, 3, 4, 5, 6) expect_range(x, "1 - 6") expect_range(x, "1_6", range.sep="_") }) test_that("single number", { x = 1 expect_range(x, "1") }) test_that("negative numbers", { x = -2:4 expect_range(x, "-2 - 4") }) test_that("noncontinuous ranges", { x = c(-5, -4, -2, 0, 2, 3, 4, 7) expect_range(x, "-5 - -4, -2, 0, 2 - 4, 7") }) BBmisc/tests/testthat/test_setRowColNames.R0000644000175100001440000000042012644315506020522 0ustar hornikuserscontext("setRowColNames") test_that("setRowColNames", { x = y = matrix(1:4, 2, 2) rownames(y) = c("a", "b") expect_equal(setRowNames(x, c("a", "b")), y) colnames(y) = c("c", "d") expect_equal(setColNames(setRowNames(x, c("a", "b")), c("c", "d")), y) }) BBmisc/tests/testthat/test_symdiff.R0000644000175100001440000000035412644315506017264 0ustar hornikuserscontext("symdiff") test_that("symdiff", { expect_equal(symdiff(c(1, 2), 1), 2) expect_equal(symdiff(c(1, 2), numeric(0)), c(1, 2)) expect_equal(symdiff("a", "b"), c("a", "b")) expect_equal(symdiff("a", "a"), character(0)) }) BBmisc/tests/testthat/test_strrepeat.R0000644000175100001440000000031212644315506017626 0ustar hornikuserscontext("strrepeat") test_that("strrepeat", { expect_identical(strrepeat("x", 3), "xxx") expect_identical(strrepeat("x", 3, "y"), "xyxyx") expect_identical(strrepeat(c("x", "y"), 2), "xyxy") }) BBmisc/tests/testthat/test_extractSubList.R0000644000175100001440000000447412644315506020612 0ustar hornikuserscontext("extractSubList") test_that("extractSubList", { xs = list( a = list(x = 1, y = "foo", z = matrix(1,1,1)), b = list(x = 2L, y = "bar", z = matrix(2,2,2)) ) expect_equal(extractSubList(xs, "x"), c(a = 1, b = 2)) expect_equal(extractSubList(xs, "y"), c(a = "foo", b = "bar")) expect_equal(extractSubList(xs, "z"), list(a = matrix(1,1,1), b = matrix(2,2,2))) expect_equal(extractSubList(xs, "x", use.names = FALSE), c(1, 2)) expect_equal(extractSubList(xs, "y", use.names = FALSE), c("foo", "bar")) expect_equal(extractSubList(xs, "z", use.names = FALSE), list(matrix(1,1,1), matrix(2,2,2))) expect_equal(extractSubList(list(), "x"), list()) expect_equal(extractSubList(list(), "x", element.value = numeric(1)), numeric(0)) expect_equal(extractSubList(list(), "y", element.value = character(1)), character(0)) expect_equal(extractSubList(xs, "x", element.value = numeric(1)), c(a = 1, b = 2)) expect_equal(extractSubList(xs, "y", element.value = character(1)), c(a = "foo", b = "bar")) xs = list( list(x = 1, y = "foo", z = matrix(1,1,1)), list(x = 2L, y = "bar", z = matrix(2,2,2)) ) expect_equal(extractSubList(xs, "y", use.names = TRUE), c("foo", "bar")) expect_equal(extractSubList(xs, "y", use.names = FALSE), c("foo", "bar")) expect_equal( extractSubList(list(list(a = 1:2), list(a = 3:4)), "a", simplify = "rows"), matrix(1:4, nrow = 2L, ncol = 2L, byrow = TRUE) ) expect_equal( extractSubList(list(list(a = 1), list(a = 2)), "a", simplify = "rows"), matrix(1:2, nrow = 2L, ncol = 1) ) }) test_that("extractSubList works with repeated indexing", { xs = list( a = list(v = list(x = 1), w = list(y = "foo")), b = list(v = list(x = 2), w = list(y = "bar")) ) expect_equal(extractSubList(xs, c("v", "x")), c(a = 1, b = 2)) expect_equal(extractSubList(xs, c("w", "y")), c(a = "foo", b = "bar")) expect_equal(extractSubList(xs, c("v", "x"), element.value = numeric(1)), c(a = 1, b = 2)) expect_equal(extractSubList(xs, c("w", "y"), element.value = character(1)), c(a = "foo", b = "bar")) expect_equal(extractSubList(xs, c("v", "x"), simplify = "rows", use.names = FALSE), matrix(c(1, 2), nrow = 2)) expect_equal(extractSubList(xs, c("v", "x"), simplify = "cols", use.names = TRUE), setColNames(matrix(c(1, 2), nrow = 1), c("a", "b"))) }) BBmisc/tests/testthat/test_isScalarNA.R0000644000175100001440000000032212644315506017576 0ustar hornikuserscontext("isScalarNA") test_that("isScalarNA", { expect_true(isScalarNA(NA)) expect_false(isScalarNA(1)) expect_false(isScalarNA(iris)) expect_false(isScalarNA(NULL)) expect_false(isScalarNA("NA")) })BBmisc/tests/testthat/test_clipString.R0000644000175100001440000000056712644315506017747 0ustar hornikuserscontext("clipString") test_that("clipString", { expect_equal(clipString("abcdef", 7), "abcdef") expect_equal(clipString("abcdef", 6), "abcdef") expect_equal(clipString("abcdef", 5), "ab...") expect_error(clipString("abcdef", 2)) expect_equal(clipString(NA_character_, 5), NA_character_) expect_equal(clipString(c("aaaaa", NA, "aa"), 4), c("a...", NA, "aa")) }) BBmisc/tests/testthat/test_binPack.R0000644000175100001440000000141412644315506017170 0ustar hornikuserscontext("binPack") test_that("binPack", { x = 1:10 res = binPack(x, 11L) sums = sapply(split(x, res), sum) expect_true(is.integer(res)) expect_equal(sums, setNames(rep(11L, 5L), 1:5)) expect_true(all(sums <= 11L)) x = sample(seq(from=0, to=1, by=0.01)) res = binPack(x, 1) sums = sapply(split(x, res), sum) expect_true(is.integer(res)) expect_true(all(head(sums, 50) == 1)) x = runif(20) res = binPack(x, 1) sums = sapply(split(x, res), sum) expect_true(is.integer(res)) expect_true(all(sums < 1)) x = runif(5) res = binPack(x, Inf) expect_true(is.integer(res)) expect_true(length(res) == 5 && all(as.numeric(res) == 1)) expect_error(binPack(c(-5, 3))) expect_error(binPack(c(1, 100), 10)) expect_error(binPack(c(1, Inf), 1)) }) BBmisc/tests/testthat/test_convertToShortString.R0000644000175100001440000000261612644315506022020 0ustar hornikuserscontext("convertToShortString") test_that("convertToShortString", { expect_equal(convertToShortString(1L), "1") expect_equal(convertToShortString(1.0), "1") expect_equal(convertToShortString(1.23), "1.23") expect_equal(convertToShortString(numeric(0)), "numeric(0)") expect_equal(convertToShortString(factor(c())), "factor(0)") expect_equal(convertToShortString(iris), "") expect_equal(convertToShortString(list(a=1, 45)), "a=1, =45") expect_equal(convertToShortString(list(a=1, b=list(x=3))), "a=1, b=") expect_equal(convertToShortString(list(a=1, b=iris)), "a=1, b=") expect_equal(convertToShortString(list()), "") expect_equal(convertToShortString(list(a=1)), "a=1") expect_equal(convertToShortString(list(a=1:2)), "a=1,2") expect_equal(convertToShortString(list(a=1:20)), "a=1,2,3,4,5,6,...") expect_equal(convertToShortString(list(a=1, 2, b=3)), "a=1, =2, b=3") expect_equal(convertToShortString(list(a=1, 2, b=data.frame())), "a=1, =2, b=") expect_equal(convertToShortString(list(a=identity, b=new.env())), "a=, b=") expect_equal(convertToShortString(list(a=1, b=3.2)), "a=1, b=3.2") expect_equal(convertToShortString(list(a=1, b=3.223), num.format="%.2f"), "a=1.00, b=3.22") expect_equal(convertToShortString(list(a=1L, b=3.223), num.format="%.2f"), "a=1, b=3.22") }) BBmisc/tests/testthat/test_suppressAll.R0000644000175100001440000000053112741010551020123 0ustar hornikusers context("suppressAll") test_that("suppressAll", { expect_equal(suppressAll(123), 123) expect_output({print(123);0}, "123") expect_silent(suppressAll({print(123);0})) expect_warning(warning(123), "123") expect_silent(suppressAll({warning(123);0})) expect_message(message(123), "123") expect_silent(suppressAll(message(123))) }) BBmisc/tests/testthat/test_getOperatingSystem.R0000644000175100001440000000047012644315506021457 0ustar hornikuserscontext("getOperatingSystem") test_that("getOperatingSystem", { x = getOperatingSystem() expect_true(is.character(x) && length(x) == 1 && nchar(x) > 0) x = isWindows() expect_true(is.logical(x) && length(x) == 1 && !is.na(x)) x = isUnix() expect_true(is.logical(x) && length(x) == 1 && !is.na(x)) })BBmisc/tests/testthat/test_getAttributeNames.R0000644000175100001440000000031212644315506021244 0ustar hornikuserscontext("getAttributeNames") test_that("getAttributeNames", { x = 1:10 expect_true(is.null(getAttributeNames(x))) attr(x, "size") = length(x) expect_equal(getAttributeNames(x), c("size")) }) BBmisc/tests/testthat/test_makeDataFrame.R0000644000175100001440000000255312644315506020310 0ustar hornikuserscontext("makeDataFrame") test_that("makeDataFrame", { df1 = makeDataFrame(0, 0) df2 = data.frame() expect_equal(df1, df2) df1 = makeDataFrame(3, 0) df2 = data.frame(matrix(nrow = 3, ncol = 0)) expect_equal(df1, df2) df1 = makeDataFrame(0, 2, "character") df2 = data.frame(setColNames(matrix("a", nrow = 0, ncol = 2), c("V1", "V2")), stringsAsFactors = FALSE) expect_equal(df1, df2) df1 = makeDataFrame(3, 1, "integer") df2 = data.frame(V1 = integer(3)) expect_equal(df1, df2) df1 = makeDataFrame(3, 2, "integer") df2 = as.data.frame(matrix(0L, 3, 2)) expect_equal(df1, df2) df1 = makeDataFrame(3, 2, init = "bb") df2 = as.data.frame(matrix("bb", 3, 2), stringsAsFactors = FALSE) expect_equal(df1, df2) df1 = makeDataFrame(3, 2, c("numeric", "integer")) df2 = data.frame(V1 = numeric(3), V2 = integer(3), stringsAsFactors = FALSE) expect_equal(df1, df2) # names df1 = makeDataFrame(1, 2, "integer", row.names = c("r1"), col.names = c("c1", "c2")) df2 = setRowNames(data.frame(c1 = 0, c2 = 0), "r1") expect_equal(df1, df2) df1 = makeDataFrame(1, 2, "integer", row.names = 1L, col.names = c("c1", "c2")) df2 = setRowNames(data.frame(c1 = 0, c2 = 0), 1L) expect_equal(df1, df2) df1 = makeDataFrame(1, 2, "integer", row.names = NULL, col.names = 1:2) df2 = setColNames(data.frame(c1 = 0, c2 = 0), 1:2) expect_equal(df1, df2) }) BBmisc/tests/testthat/test_rowLapply.R0000644000175100001440000000267312644315506017622 0ustar hornikuserscontext("rowLapply / rowSapply") test_that("rowLapply", { df = data.frame(a = 1:10, b = 10:1) expect_true(all(rowLapply(df, length, unlist = TRUE) == 2)) expect_true(all(rowLapply(df, sum, unlist = TRUE) == 11)) expect_true(all(unlist(rowLapply(df, Negate(is.list), unlist = TRUE)))) expect_true(all(unlist(rowLapply(df, is.list)))) fun = function(x, y) sum(c(unlist(x), y)) expect_equal(rowLapply(df[, 1L, drop = FALSE], fun, y = 1), as.list(2:11)) }) test_that("rowSapply", { df = data.frame(a = 1:10, b = 10:1) rownames(df) = letters[1:10] y1 = rep(2, nrow(df)) y2 = setNames(y1, rownames(df)) expect_equal(rowSapply(df, length, simplify = TRUE, use.names = FALSE), y1) expect_equal(rowSapply(df, length, simplify = TRUE, use.names = TRUE), y2) expect_equal(rowSapply(df, length, simplify = FALSE, use.names = FALSE), as.list(y1)) expect_equal(rowSapply(df, length, simplify = FALSE, use.names = TRUE), as.list(y2)) x1 = rowSapply(df, unlist, simplify = TRUE, use.names = TRUE) x2 = sapply(1:nrow(df), function(i) unlist(df[i,]), simplify = TRUE, USE.NAMES = FALSE) rownames(x2) = NULL; colnames(x2) = rownames(df) expect_equal(x1, x2) x1 = rowSapply(df, unlist, simplify = "rows", use.names = FALSE) x2 = as.matrix(data.frame(a = 1:10, b = 10:1)) expect_equal(x1, x2) x1 = rowSapply(data.frame(a = 1:2), function(r) r$a, simplify = "rows", use.names = FALSE) x2 = matrix(1:2, nrow = 2) expect_equal(x1, x2) }) BBmisc/tests/testthat/test_chunk.R0000755000175100001440000000261712644315506016742 0ustar hornikuserscontext("chunk") test_that("chunk", { # normal chunk.size x = 1:9 ch = chunk(x, chunk.size=3) expect_equal(ch, list(1:3, 4:6, 7:9)) # normal n.chunks x = 1:9 ch = chunk(x, n.chunks=3) expect_equal(ch, list(1:3, 4:6, 7:9)) # chunk.size uneven x = 1:10 ch = chunk(x, chunk.size=3) expect_equal(ch, list(1:3, 4:6, 7:8, 9:10)) # n.chunks uneven ch = chunk(1:9, n.chunks=4) expect_equal(length(ch), 4) x = letters[1:10] ch = chunk(x, n.chunks = 2) expect_equal(ch, list(letters[1:5], letters[6:10])) # errors x = letters[1:10] expect_error(chunk(x, chunk.size=1, n.chunks=3)) expect_error(chunk(x, chunk.size=1:2)) expect_error(chunk(x, n.chunks=list())) x = as.list(letters[1:10]) ch = chunk(x, chunk.size=5) expect_equal(ch, list(as.list(letters[1:5]), as.list(letters[6:10]))) x = letters ch = chunk(x, chunk.size=4, shuffle=TRUE) expect_equal(sort(letters), sort(unlist(ch))) expect_true(all(sapply(ch, length) %in% c(3, 4))) # test that smaller levels get chosen randomly x = 1:5 counts = sapply(1:100, function(i) { ch = chunk(x, chunk.size=3, shuffle=TRUE) sapply(ch, length) == 2 }) counts = rowSums(counts) expect_true(all(counts > 30)) # test proportions x = 1:10 ch = chunk(x, props = c(3, 7)) expect_equal(sapply(ch, length), c(3, 7)) expect_equal(unlist(ch), x) expect_true(length(chunk(x, props=1)) == 1L) }) BBmisc/tests/testthat/test_getMaxColRowIndex.R0000644000175100001440000000454212644315506021171 0ustar hornikuserscontext("getMaxIndexOfRows") test_that("getMaxIndexOfRows", { a = matrix(1:6, nrow=2) expect_equal(getMaxIndexOfRows(a), c(3L, 3L)) a = matrix(6:1, nrow=2) expect_equal(getMaxIndexOfRows(a), c(1L, 1L)) a = rbind(c(1, 999), c(-1, -5)) expect_equal(getMaxIndexOfRows(a), c(2L, 1L)) a = matrix(rnorm(50*10), nrow=50) expect_equal(getMaxIndexOfRows(a), apply(a, 1, which.max)) }) test_that("getMaxIndexOfCols", { a = matrix(1:6, nrow=2) expect_equal(getMaxIndexOfCols(a), c(2L, 2L, 2L)) a = matrix(6:1, nrow=2) expect_equal(getMaxIndexOfCols(a), c(1L, 1L, 1L)) a = rbind(c(1, 999), c(-1, -5)) expect_equal(getMaxIndexOfCols(a), c(1L, 1L)) a = matrix(rnorm(50*10), nrow=50) expect_equal(getMaxIndexOfCols(a), apply(a, 2, which.max)) }) test_that("normal", { expect_equal(getMaxIndexOfRows(diag(10)), 1:10) n = 100 perm = sample(n) D = diag(n) expect_equal(getMaxIndexOfRows(D[perm, ]), (1:n)[perm]) }) test_that("NA values", { n = 300 m = matrix(runif(n), ncol=3) mm = m mm[, 2] = NA expect_equal(getMaxIndexOfRows(mm), rep(NA_integer_, n/3)) a = matrix(c(1, NA, 2, 3, NA, NA), nrow=3, byrow=TRUE) expect_equal(getMaxIndexOfRows(a, na.rm=FALSE), c(NA, 2L, NA)) expect_equal(getMaxIndexOfRows(a, na.rm=TRUE), c(1L, 2L, -1)) }) test_that("infinite values", { n = 300 m = matrix(runif(n), ncol=3) m[, 2] = Inf expect_equal(getMaxIndexOfRows(m), rep(2L, 100L)) }) test_that("max.col oddity", { expect_equal(getMaxIndexOfRows(cbind(1:10, 2:11, -Inf)), rep(2, 10)) expect_equal(getMaxIndexOfRows(cbind(-1e9 * 1:10, 1:10, 2:11)), rep(3, 10)) }) test_that("ties", { a = matrix(c(1, 1, 2, 2), nrow=2, byrow=TRUE) expect_equal(getMaxIndexOfRows(a, ties.method="first"), c(1L, 1L)) expect_equal(getMaxIndexOfRows(a, ties.method="last"), c(2L, 2L)) a = matrix(c(2, 1, 2, 2, 2, 1), nrow=2, byrow=TRUE) expect_equal(getMaxIndexOfRows(a, ties.method="first"), c(1L, 1L)) expect_equal(getMaxIndexOfRows(a, ties.method="last"), c(3L, 2L)) a = matrix(c(1, 1, 2, 2), nrow=2, byrow=TRUE) expect_equal(getMaxIndexOfCols(a, ties.method="first"), c(2L, 2L)) expect_equal(getMaxIndexOfCols(a, ties.method="last"), c(2L, 2L)) a = matrix(c(2, 1, 2, 2, 2, 1), nrow=2, byrow=TRUE) expect_equal(getMaxIndexOfCols(a, ties.method="first"), c(1L, 2L, 1L)) expect_equal(getMaxIndexOfCols(a, ties.method="last"), c(2L, 2L, 1L)) }) BBmisc/tests/testthat/test_convertInteger.R0000644000175100001440000000243212644315506020620 0ustar hornikuserscontext("convert ints") test_that("convertInteger", { expect_true(identical(convertInteger(1), 1L)) expect_true(identical(convertInteger(1L), 1L)) expect_true(identical(convertInteger(c(1,4)), c(1, 4))) expect_true(identical(convertInteger("a"), "a")) expect_true(identical(convertInteger(NA), as.integer(NA))) expect_true(identical(convertInteger(as.integer(NA)), as.integer(NA))) expect_true(identical(convertInteger(as.numeric(NA)), as.integer(NA))) expect_true(identical(convertInteger(c(1, NA)), c(1, NA))) }) test_that("convertIntegers", { expect_true(identical(convertIntegers(1), 1L)) expect_true(identical(convertIntegers(1L), 1L)) expect_true(identical(convertIntegers(c(1,4)), c(1L, 4L))) expect_true(identical(convertIntegers("a"), "a")) expect_true(identical(convertIntegers(NA), as.integer(NA))) expect_true(identical(convertIntegers(c(NA, NA)), as.integer(c(NA, NA)))) expect_true(identical(convertIntegers(as.integer(c(NA, NA))), as.integer(c(NA, NA)))) expect_true(identical(convertIntegers(as.numeric(c(NA, NA))), as.integer(c(NA, NA)))) expect_true(identical(convertIntegers(c(1, NA)), as.integer(c(1, NA)))) expect_true(identical(convertIntegers(c()), integer())) expect_true(identical(convertIntegers(c(x = 1, y = 4)), c(x = 1L, y = 4L))) }) BBmisc/tests/testthat/test_setValue.R0000644000175100001440000000061212644315506017410 0ustar hornikuserscontext("setValue") test_that("setValue", { xs1 = list(a=1, b=2) expect_equal(setValue(xs1, "b", 3), list(a=1, b=3)) expect_equal(setValue(xs1, "b", NULL), list(a=1, b=NULL)) expect_equal(setValue(xs1, "c", 3), list(a=1, b=2, c=3)) expect_equal(setValue(xs1, c("a","b"), as.list(4:5)), list(a=4, b=5)) expect_equal(setValue(xs1, c("b","c"), as.list(4:5)), list(a=1, b=4, c=5)) }) BBmisc/tests/testthat/test_requirePackages.R0000644000175100001440000000326112644315506020736 0ustar hornikuserscontext("requirePackages") test_that("requirePackages", { expect_equal(requirePackages("base"), c(base=TRUE)) expect_equal(requirePackages("xxx", stop = FALSE, suppress.warnings = TRUE), c(xxx=FALSE)) expect_error(requirePackages("xxx", suppress.warnings=TRUE), "Please install the following packages: xxx") expect_equal(requirePackages(c("xxx", "base"), stop=FALSE, suppress.warnings=TRUE), c(xxx=FALSE, base=TRUE)) expect_equal(requirePackages(c("base", "xxx"), stop=FALSE, suppress.warnings=TRUE), c(base=TRUE, xxx=FALSE)) expect_error(requirePackages(c("base", "xxx"), suppress.warnings=TRUE), "Please install the following packages: xxx") expect_error(requirePackages(c("base", "xxx"), why="test", suppress.warnings=TRUE), "For test please install the following packages: xxx") # test loading vs. attaching using the codetools package expect_equal(requirePackages("codetools", default.method = "load"), c(codetools=TRUE)) expect_true("codetools" %in% loadedNamespaces()) expect_false("package:codetools" %in% search()) expect_equal(requirePackages("!codetools", default.method = "load"), c(codetools=TRUE)) expect_true("package:codetools" %in% search()) }) test_that("requirePackages with min.versions", { expect_equal(requirePackages("base", min.versions = "0.1"), c(base=TRUE)) expect_equal(requirePackages("base", min.versions = c(base="0.1")), c(base=TRUE)) expect_equal(requirePackages(c("base", "stats")), c(base=TRUE, stats = TRUE)) expect_equal(requirePackages(c("base", "stats"), min.versions = c(base = "100"), stop = FALSE), c(base=FALSE, stats = TRUE)) expect_error(requirePackages(c("base", "stats"), min.versions = c(stats = "100")), "stats >= 100") }) BBmisc/tests/testthat/test_hasAttributes.R0000644000175100001440000000052212644315506020442 0ustar hornikuserscontext("hasAttributes") test_that("hasAttributes", { x = 1:10 attribute.names = c("size", "importance") expect_false(hasAttributes(x, attribute.names)) attr(x, "size") = length(x) expect_false(hasAttributes(x, attribute.names)) attr(x, "importance") = "very important" expect_true(hasAttributes(x, attribute.names)) }) BBmisc/tests/testthat/test_namedList.R0000644000175100001440000000053012644315506017537 0ustar hornikuserscontext("namedList") test_that("namedList", { expect_equal(namedList(), vector("list", 0)) expect_equal(namedList("a"), list(a=NULL)) expect_equal(namedList(c("a", "b")), list(a=NULL, b=NULL)) expect_equal(namedList(c("a", "b"), 1), list(a=1, b=1)) f = function(x) x^2 expect_equal(namedList(c("a", "b"), f(2)), list(a=4, b=4)) }) BBmisc/tests/testthat/test_getRelativePath.R0000644000175100001440000000166712644315506020723 0ustar hornikuserscontext("getRelativePath") test_that("getRelativePath", { base = tempfile("") a = file.path(base, "foo") b = file.path(base, "bar") c = file.path(base, "bar", "foobar") lapply(c(a, b, c), dir.create, recursive = TRUE) expect_equal(getRelativePath(a, from = base), "foo") expect_equal(getRelativePath(b, from = base), "bar") expect_equal(getRelativePath(base, from = a), "..") expect_equal(getRelativePath(base, from = b), "..") expect_equal(getRelativePath(a, from = b), file.path("..", "foo")) expect_equal(getRelativePath(b, from = a), file.path("..", "bar")) expect_equal(getRelativePath(base, from = c), file.path("..", "..")) expect_equal(getRelativePath(c, from = base), file.path("bar", "foobar")) expect_equal(getRelativePath(c, from = a), file.path("..", "bar", "foobar")) if (!isWindows()) expect_equal(getRelativePath("/", from = a), do.call(file.path, as.list(rep("..", length(splitPath(a)$path))))) }) BBmisc/tests/testthat/test_splitPath.R0000644000175100001440000000075012644315506017573 0ustar hornikuserscontext("splitPath") test_that("splitPath", { p = tempfile() res = splitPath(p) expect_true(is.list(res)) expect_equal(names(res), c("drive", "path")) expect_true(length(res$drive) == as.integer(isWindows())) expect_true(is.character(res$path)) expect_true(length(res$path) >= 1L) p = c("tmp", "foo", "", "bar") res = splitPath(collapse(p, "/")) expect_equal(tail(res$path, 3), p[-3]) res = splitPath(collapse(p, "\\")) expect_equal(tail(res$path, 3), p[-3]) }) BBmisc/tests/testthat/test_getUsedFactorLevels.R0000644000175100001440000000045512644315506021537 0ustar hornikuserscontext("getUsedFactorLevels") test_that("getUsedFactorLevels", { used.levels = letters[1:3] all.levels = letters x = factor(x = used.levels, levels = all.levels) expect_equal(sort(getUsedFactorLevels(x)), used.levels) x = factor(x = used.levels) expect_equal(used.levels, levels(x)) }) BBmisc/tests/testthat/test_asQuoted.R0000644000175100001440000000016712644315506017412 0ustar hornikuserscontext("asQuoted") test_that("asQuoted", { e1 = asQuoted("x == 3") e2 = quote(x == 3) expect_equal(e1, e2) }) BBmisc/tests/testthat/test_which.first.last.R0000644000175100001440000000153712644315506021021 0ustar hornikuserscontext("which.first / which.last") test_that("which.first / which.last", { x = c(FALSE, TRUE, FALSE, TRUE) expect_equal(which.first(x), 2L) expect_equal(which.last(x), 4L) x = setNames(x, head(letters, length(x))) expect_equal(which.first(x), setNames(2L, "b")) expect_equal(which.last(x), setNames(4L, "d")) expect_equal(which.first(x, use.names=FALSE), 2L) expect_equal(which.last(x, use.names=FALSE), 4L) x = c(NA, TRUE, NA, TRUE, NA) expect_equal(which.first(x), 2L) expect_equal(which.last(x), 4L) x = logical(0L) expect_equal(which.first(x), integer(0L)) expect_equal(which.last(x), integer(0L)) expect_equal(which.first(x, use.names=FALSE), integer(0L)) expect_equal(which.last(x, use.names=FALSE), integer(0L)) x = c(NA, NA) expect_equal(which.first(x), integer(0L)) expect_equal(which.last(x), integer(0L)) }) BBmisc/tests/testthat/test_coalesce.R0000644000175100001440000000073212644315506017401 0ustar hornikuserscontext("coalesce") test_that("coalesce", { expect_identical(coalesce(NULL), NULL) expect_identical(coalesce(1, NULL), 1) expect_identical(coalesce(NULL, 1), 1) f = function(a, b, c) coalesce(a,b,c) expect_identical(f(b = NULL, c = 1), 1) }) test_that("coalesce works with functions", { ff = function(x) 123 expect_identical(coalesce(NULL, ff), ff) # FIXME: this is a problem in R / missing. see issue 48 #expect_identical(coalesce(NULL, min), min) }) BBmisc/tests/testthat/test_itostr.R0000644000175100001440000000052412644315506017146 0ustar hornikuserscontext("itostr") test_that("itostr", { x = 0:200 base = c(2, 10, 16, 24, 32, 36) for (b in base) { res = itostr(x, b) expect_true(is.character(res)) expect_true(length(x) == length(res)) expect_equal(strtoi(res, b), x) } expect_error(itostr(1, 0)) expect_error(itostr(1, 1)) expect_error(itostr(-1, 2)) }) BBmisc/tests/testthat/test_getMaxIndex.R0000644000175100001440000000324712644315506020044 0ustar hornikuserscontext("getMaxIndex") test_that("getMaxIndex", { expect_equal(getMaxIndex(c(1, 9)), 2L) expect_equal(getMaxIndex(c(9, 1)), 1L) expect_equal(getMaxIndex(c(-9, -1)), 2L) expect_equal(getMaxIndex(c(-9, 1)), 2L) expect_equal(getMaxIndex(c(1, Inf, 9)), 2L) expect_equal(getMaxIndex(c(1, NA, 9)), NA_integer_) expect_equal(getMaxIndex(c(1, NaN, 9)), NA_integer_) expect_equal(getMaxIndex(c(1, NA, 9), na.rm=TRUE), 3L) expect_equal(getMaxIndex(c(1, NaN, 9), na.rm=TRUE), 3L) expect_equal(getMaxIndex(numeric(0)), integer(0)) expect_equal(getMaxIndex(c()), integer(0)) expect_equal(getMaxIndex(c(NA, NaN), na.rm=TRUE), integer(0)) }) test_that("getMinIndex", { expect_equal(getMinIndex(c(1, 9)), 1L) expect_equal(getMinIndex(c(9, 1)), 2L) expect_equal(getMinIndex(c(-9, -1)), 1L) expect_equal(getMinIndex(c(-9, 1)), 1L) expect_equal(getMinIndex(c(1, Inf, 9)), 1L) expect_equal(getMinIndex(c(1, NA, 9)), NA_integer_) expect_equal(getMinIndex(c(1, NaN, 9)), NA_integer_) expect_equal(getMinIndex(c(1, NA, 9), na.rm=TRUE), 1L) expect_equal(getMinIndex(c(1, NaN, 9), na.rm=TRUE), 1L) expect_equal(getMinIndex(numeric(0)), integer(0)) expect_equal(getMinIndex(c()), integer(0)) expect_equal(getMinIndex(c(NA, NaN), na.rm=TRUE), integer(0)) }) test_that("ties", { expect_equal(getMaxIndex(c(1, 9, 9), ties.method="first"), 2L) expect_equal(getMaxIndex(c(1, 9, 9), ties.method="last"), 3L) expect_equal(getMaxIndex(3, ties.method="first"), 1L) expect_equal(getMaxIndex(3, ties.method="last"), 1L) expect_equal(getMaxIndex(c(9, 1, 9, 9), ties.method="first"), 1L) expect_equal(getMaxIndex(c(9, 1, 9, 9), ties.method="last"), 4L) })BBmisc/tests/testthat/test_dapply.R0000644000175100001440000000113712644315506017114 0ustar hornikuserscontext("dapply") test_that("dapply", { d = dapply(1:3, function(x) rep(x, 2)) expect_is(d, "data.frame") expect_equal(dim(d), c(2L, 3L)) expect_equal(colnames(d), c("Var.1", "Var.2", "Var.3")) d = dapply(1:2, function(x) x, col.names=c("a", "b")) expect_is(d, "data.frame") expect_equal(dim(d), c(1L, 2L)) expect_equal(colnames(d), c("a", "b")) d1 = dapply(iris, computeMode) d2 = dapply(iris, computeMode, col.names=letters[1:5]) expect_equal(dim(d1), c(1L, 5L)) expect_equal(dim(d2), c(1L, 5L)) expect_equal(names(d1), names(iris)) expect_equal(names(d2), letters[1:5]) }) BBmisc/tests/testthat/test_getFirstLast.R0000644000175100001440000000060312644315506020233 0ustar hornikuserscontext("getFirstLast") test_that("getFirstLast", { expect_equal(getFirst(1:3), 1L) expect_equal(getLast(1:3), 3L) expect_equal(getFirst(list(iris, 1)), iris) expect_equal(getLast(list(iris, 1)), 1) expect_equal(getFirst(c(a=1, 2)), 1) expect_equal(names(getFirst(c(a=1, 2))), NULL) expect_equal(getLast(c(a=1, 2)), 2) expect_equal(names(getLast(c(a=1, 2))), NULL) }) BBmisc/tests/testthat/test_ensureVector.R0000644000175100001440000000117512644315506020311 0ustar hornikuserscontext("ensureVector") test_that("ensureVector", { expect_equal(ensureVector("a", n = 2L), c("a", "a")) expect_equal(ensureVector("a", n = 2L, cl = "integer"), "a") expect_equal(ensureVector(1, n = 1), c(1)) expect_equal(ensureVector(c("a", "b"), n = 10L), c("a", "b")) expect_equal(ensureVector(iris, n = 1L), list(iris)) expect_equal(ensureVector(iris, n = 2L, cl = "matrix"), iris) expect_equal(ensureVector(iris, n = 2L, cl = "data.frame"), list(iris, iris)) expect_equal(ensureVector(iris, n = 2L), list(iris, iris)) expect_equal(ensureVector(iris, n = 2L, names = c("a", "b")), list(a = iris, b = iris)) }) BBmisc/tests/testthat/test_printStrToChar.R0000644000175100001440000000045612644315506020554 0ustar hornikuserscontext("printStrToChar") test_that("printStrToChar", { x = 1L s = printStrToChar(x, collapse=NULL) expect_equal(s, " int 1") s = printStrToChar(iris, collapse=NULL) expect_true(is.character(s) && length(s) == 6) s = printStrToChar(iris) expect_true(is.character(s) && length(s) == 1) })BBmisc/tests/testthat/test_mapValues.R0000644000175100001440000000122712644315506017560 0ustar hornikuserscontext("mapValues") test_that("mapValues", { expect_equal(mapValues(1:3, 2, 3), c(1, 3, 3)) expect_equal(mapValues(letters[1:5], letters[1:5], rev(letters[1:5])), rev(letters[1:5])) expect_equal(mapValues(factor(c("a", "b", "c")), "b", "zzz"), factor(c("a", "zzz", "c"), levels = c("a", "zzz", "c"))) expect_equal(mapValues(c("aab", "aba", "baa"), "aa", "zz", regex = TRUE), c("zzb", "aba", "bzz")) expect_equal(mapValues(c("aab", "aba", "baa"), "^aa.+", "zz", regex = TRUE), c("zz", "aba", "baa")) expect_error(mapValues(iris, 1, 1), "atomic") expect_error(mapValues(1:10, 1:2, 1), "length") expect_error(mapValues(1:10, 1, 1:2), "length") }) BBmisc/tests/testthat/test_do.call2.R0000644000175100001440000000147712644315506017230 0ustar hornikuserscontext("do.call2") test_that("do.call2", { f = function(...) list(...) expect_equal(do.call2("f", a=1, b=2), list(a=1, b=2)) expect_equal(do.call2("f", .args=list(a=1, b=2)), list(a=1, b=2)) expect_equal(do.call2("f", a=1, .args=list(b=2)), list(a=1, b=2)) df = iris expect_equal(do.call2("f", df), list(df)) expect_equal(do.call2("f", .args = list(df)), list(df)) f = function(x, data) data[[x]] expect_equal(do.call2("f", "Species", data=iris), iris$Species) expect_equal(do.call2("f", "Species", iris), iris$Species) expect_equal(do.call2("f", data = iris, "Species"), iris$Species) expect_equal(do.call2("f", "Species", .args = list(data = iris)), iris$Species) expect_equal(do.call2("f", data = iris, .args = list(x = "Species")), iris$Species) expect_error(do.call2(mean, 1:10), "string") }) BBmisc/tests/testthat/test_convertDataFrameCols.R0000644000175100001440000000211412644315506021665 0ustar hornikuserscontext("convertDataFrameCols") test_that("convertDataFrameCols", { df = data.frame(x=1:2, y=c("a", "b"), z=factor(c("x", "y")), stringsAsFactors=FALSE) df2 = convertDataFrameCols(df, chars.as.factor=TRUE) expect_true(is.numeric(df2$x)) expect_true(is.factor(df2$y)) expect_true(is.factor(df2$z)) expect_equal(df$x, df2$x) expect_equal(df$y, as.character(df2$y)) expect_equal(df$z, df2$z) df2 = convertDataFrameCols(df, factors.as.char=TRUE) expect_true(is.numeric(df2$x)) expect_true(is.character(df2$y)) expect_true(is.character(df2$z)) expect_equal(df$x, df2$x) expect_equal(df$y, df2$y) expect_equal(as.character(df$z), df2$z) df2 = convertDataFrameCols(df, ints.as.num=TRUE) expect_true(is.double(df2$x)) expect_true(is.character(df2$y)) expect_true(is.factor(df2$z)) expect_equal(df$x, df2$x) expect_equal(df$y, df2$y) expect_equal(df$z, df2$z) df2 = convertDataFrameCols(df, chars.as.factor=TRUE, factors.as.char=TRUE, ints.as.num=TRUE) expect_true(is.double(df2$x)) expect_true(is.factor(df2$y)) expect_true(is.character(df2$z)) }) BBmisc/tests/testthat/test_is.subsetsuperset.R0000644000175100001440000000055512644315506021340 0ustar hornikuserscontext("isSubset (and isSuperset)") test_that("isSubset/isSuperset", { x = 1:10 y = 1:11 expect_true(isSubset(x, y)) expect_false(isSubset(y, x)) expect_true(isSubset(x, y, strict = TRUE)) x = y expect_true(isSubset(x, y)) expect_false(isSubset(x, y, strict = TRUE)) expect_true(isSubset(y, x)) expect_false(isSubset(y, x, strict = TRUE)) }) BBmisc/tests/testthat/test_directory.R0000644000175100001440000000105112644315506017622 0ustar hornikuserscontext("directory functions") test_that("isDirectory", { expect_true(isDirectory(".")) expect_identical(isDirectory(".", ".."), c(TRUE, TRUE)) expect_false(isDirectory("foofoo")) expect_identical(isDirectory(".", "foofoo"), c(TRUE, FALSE)) }) test_that("isEmptyDirectory", { expect_false(isEmptyDirectory(".")) td = tempfile() dir.create(td) expect_true(isEmptyDirectory(td)) expect_identical(isEmptyDirectory(td, ".."), c(TRUE, FALSE)) expect_false(isEmptyDirectory("foofoo")) expect_false(isEmptyDirectory(tempfile())) }) BBmisc/src/0000755000175100001440000000000012741012415012213 5ustar hornikusersBBmisc/src/which_first.c0000644000175100001440000000262412741012415014674 0ustar hornikusers#include "which_first.h" static inline SEXP named_return(R_len_t ind, SEXP names) { if (isNull(names)) return ScalarInteger(ind + 1); SEXP res; PROTECT(res = ScalarInteger(ind + 1)); SET_NAMES(res, ScalarString(STRING_ELT(names, ind))); UNPROTECT(1); return res; } SEXP c_which_first(SEXP x, SEXP use_names) { if (!isLogical(x)) error("Argument 'x' must be logical"); if (!isLogical(use_names) || length(use_names) != 1) error("Argument 'use.names' must be a flag"); const R_len_t n = length(x); int *xp = LOGICAL(x); for (R_len_t i = 0; i < n; i++) { if (xp[i] != NA_LOGICAL && xp[i]) { if (LOGICAL(use_names)[0]) return named_return(i, GET_NAMES(x)); else return ScalarInteger(i+1); } } return allocVector(INTSXP, 0); } SEXP c_which_last(SEXP x, SEXP use_names) { if (!isLogical(x)) error("Argument 'x' must be logical"); if (!isLogical(use_names) || length(use_names) != 1) error("Argument 'use.names' must be a flag"); int *xp = LOGICAL(x); for (R_len_t i = length(x) - 1; i >= 0; i--) { if (xp[i] != NA_LOGICAL && xp[i]) { if (LOGICAL(use_names)[0]) return named_return(i, GET_NAMES(x)); else return ScalarInteger(i+1); } } return allocVector(INTSXP, 0); } BBmisc/src/itostr.h0000644000175100001440000000022212741012415013704 0ustar hornikusers#ifndef BBMISC_ITOSTR_H_ #define BBMISC_ITOSTR_H_ #include #include #include SEXP itostr(SEXP, SEXP); #endif BBmisc/src/macros.h0000644000175100001440000000053212741012415013650 0ustar hornikusers#ifndef FOO_MACROS_H #define FOO_MACROS_H #include #include #include #define UNPACK_REAL_VECTOR(S, D, N) \ double *D = REAL(S); \ const R_len_t N = length(S); #define UNPACK_REAL_MATRIX(S, D, N, K) \ double *D = REAL(S); \ const R_len_t N = nrows(S); \ const R_len_t K = ncols(S); #endif BBmisc/src/getMaxColRowIndex.h0000644000175100001440000000041312741012415015725 0ustar hornikusers#ifndef GETMAXCOLROWINDEX_H #define GETMAXCOLROWINDEX_H #include #include #include SEXP c_getMaxIndexOfRows(SEXP s_x, SEXP s_ties_method, SEXP s_na_rm); SEXP c_getMaxIndexOfCols(SEXP s_x, SEXP s_ties_method, SEXP s_na_rm); #endif BBmisc/src/getMaxColRowIndex.c0000644000175100001440000000202012741012415015714 0ustar hornikusers#include "getMaxColRowIndex.h" #include "getMaxIndex.h" #include "macros.h" SEXP c_getMaxIndexOfRows(SEXP s_x, SEXP s_ties_method, SEXP s_na_rm) { int ties_method = asInteger(s_ties_method); Rboolean na_rm = asLogical(s_na_rm); UNPACK_REAL_MATRIX(s_x, x, nrow_x, ncol_x); SEXP s_ret = PROTECT(allocVector(INTSXP, nrow_x)); int* ret = INTEGER(s_ret); GetRNGstate(); for (R_len_t i = 0; i < nrow_x; i++) { ret[i] = get_max_index(x + i, ncol_x, nrow_x, ties_method, na_rm); } PutRNGstate(); UNPROTECT(1); /* s_ret */ return s_ret; } SEXP c_getMaxIndexOfCols(SEXP s_x, SEXP s_ties_method, SEXP s_na_rm) { int ties_method = asInteger(s_ties_method); Rboolean na_rm = asInteger(s_na_rm); UNPACK_REAL_MATRIX(s_x, x, nrow_x, ncol_x); SEXP s_ret = PROTECT(allocVector(INTSXP, ncol_x)); int* ret = INTEGER(s_ret); GetRNGstate(); for (R_len_t i = 0; i < ncol_x; ++i) { ret[i] = get_max_index(x + i*nrow_x, nrow_x, 1, ties_method, na_rm); } PutRNGstate(); UNPROTECT(1); /* s_ret */ return s_ret; } BBmisc/src/getMaxIndex.h0000644000175100001440000000041312741012415014577 0ustar hornikusers#ifndef GETMAXINDEX_H #define GETMAXINDEX_H #include #include #include int get_max_index(double *x, R_len_t n, R_len_t step, int ties_method, Rboolean na_rm); SEXP c_getMaxIndex(SEXP s_x, SEXP s_ties_method, SEXP s_na_rm); #endif BBmisc/src/which_first.h0000644000175100001440000000030212741012415014670 0ustar hornikusers#ifndef BBMISC_WHICH_FIRST_H_ #define BBMISC_WHICH_FIRST_H_ #include #include #include SEXP c_which_first(SEXP, SEXP); SEXP c_which_last(SEXP, SEXP); #endif BBmisc/src/itostr.c0000644000175100001440000000126412741012415013706 0ustar hornikusers#include #include #include "itostr.h" static const char base36[37] = "0123456789abcdefghijklmnopqrstuvwxyz"; SEXP itostr (SEXP x, SEXP base) { const R_len_t n = length(x); const R_len_t b = INTEGER(base)[0]; SEXP res = PROTECT(allocVector(STRSXP, n)); const R_len_t buflen = ceil(log(exp2(64) / log(b))); char buffer[buflen + 1]; buffer[buflen] = '\0'; for (R_len_t i = 0; i < n; i++) { R_len_t offset = buflen; int xi = INTEGER(x)[i]; do { buffer[--offset] = base36[xi % b]; } while (xi /= b); SET_STRING_ELT(res, i, mkChar(&buffer[offset])); } UNPROTECT(1); return res; } BBmisc/src/getMaxIndex.c0000644000175100001440000000312512741012415014575 0ustar hornikusers#include "getMaxIndex.h" #include "macros.h" /* Get index of maximal element of double array x (1-based). Allows to only consider a subset of elements, separated by regular gaps. If NANs or NAs are encountered x : double pointer to data n : length of x stride : step size to walk thru x return : Index of maximal element (1-based) or -1 if we did not find a maximal elemnt (empty vector or only removed NAs) */ int get_max_index(double *x, R_len_t n, R_len_t step, int ties_method, Rboolean na_rm) { R_len_t i; int max_index = -2; int number_of_ties = 0; double max_value = -DBL_MAX, current_value; for (i = 0; i < n; ++i) { current_value = x[i*step]; if (!na_rm && ISNAN(current_value)) return NA_INTEGER; if (current_value > max_value) { number_of_ties = 1; max_value = current_value; max_index = i; } else if (current_value == max_value) { if (ties_method == 1) { ++number_of_ties; if (number_of_ties * unif_rand() < 1.0) max_index = i; } else if (ties_method == 3) { max_index = i; } } } /* make index 1-based */ return max_index + 1; } SEXP c_getMaxIndex(SEXP s_x, SEXP s_ties_method, SEXP s_na_rm) { if (length(s_x) == 0) return NEW_INTEGER(0); int ties_method = asInteger(s_ties_method); Rboolean na_rm = asInteger(s_na_rm); UNPACK_REAL_VECTOR(s_x, x, len_x); GetRNGstate(); int index = get_max_index(x, len_x, 1, ties_method, na_rm); PutRNGstate(); if (index == -1) return NEW_INTEGER(0); else return ScalarInteger(index); } BBmisc/NAMESPACE0000644000175100001440000000520612741010551012645 0ustar hornikusers# Generated by roxygen2: do not edit by hand S3method(normalize,data.frame) S3method(normalize,matrix) S3method(normalize,numeric) export("%btwn%") export("%nin%") export(addClasses) export(argsAsNamedList) export(asMatrixCols) export(asMatrixRows) export(asQuoted) export(binPack) export(cFactor) export(capitalizeStrings) export(catf) export(checkArg) export(checkListElementClass) export(chunk) export(clipString) export(coalesce) export(collapse) export(collapsef) export(computeMode) export(convertColsToList) export(convertDataFrameCols) export(convertDfCols) export(convertInteger) export(convertIntegers) export(convertListOfRowsToDataFrame) export(convertMatrixType) export(convertRowsToList) export(convertToShortString) export(dapply) export(do.call2) export(dropNamed) export(ensureVector) export(explode) export(extractSubList) export(filterNull) export(getAttributeNames) export(getClass1) export(getFirst) export(getLast) export(getMaxIndex) export(getMaxIndexOfCols) export(getMaxIndexOfRows) export(getMinIndex) export(getMinIndexOfCols) export(getMinIndexOfRows) export(getOperatingSystem) export(getRelativePath) export(getUnixTime) export(getUsedFactorLevels) export(hasAttributes) export(insert) export(is.error) export(isDarwin) export(isDirectory) export(isEmptyDirectory) export(isExpensiveExampleOk) export(isFALSE) export(isLinux) export(isProperlyNamed) export(isScalarCharacter) export(isScalarComplex) export(isScalarFactor) export(isScalarInteger) export(isScalarLogical) export(isScalarNA) export(isScalarNumeric) export(isScalarValue) export(isSubset) export(isSuperset) export(isUnix) export(isValidName) export(isWindows) export(itostr) export(lib) export(listToShortString) export(load2) export(lsort) export(makeDataFrame) export(makeFileCache) export(makeProgressBar) export(makeS3Obj) export(makeSimpleFileLogger) export(mapValues) export(messagef) export(namedList) export(names2) export(normalize) export(optimizeSubInts) export(pause) export(printStrToChar) export(printToChar) export(rangeVal) export(requirePackages) export(rowLapply) export(rowSapply) export(save2) export(seq_col) export(seq_row) export(setAttribute) export(setClasses) export(setColNames) export(setRowNames) export(setValue) export(sortByCol) export(splitPath) export(splitTime) export(stopf) export(strrepeat) export(suppressAll) export(symdiff) export(system3) export(toRangeStr) export(vcapply) export(viapply) export(vlapply) export(vnapply) export(warningf) export(which.first) export(which.last) import(checkmate) import(stats) import(utils) importFrom(methods,is) useDynLib(BBmisc,c_getMaxIndex) useDynLib(BBmisc,c_getMaxIndexOfCols) useDynLib(BBmisc,c_getMaxIndexOfRows) BBmisc/NEWS0000644000175100001440000001033012644315506012131 0ustar hornikusersBBmisc_1.10: - New argument min.versions for requirePackages BBmisc_1.9: 2015-02-03 - New argument .newline for messagef - requirePackages can now dispatch to requireNamespace and has argument default.method. - normalize now also handles NAs - new functions -- mapValues BBmisc_1.8: 2014-10-30 - Options for the ProgressBar can now be directly passed to the constructor. - Fixed smaller bugs in normalize - new functions -- itostr -- getRelativePath -- splitPath -- do.call2 BBmisc_1.7: 21-Jun-2014 - extractSubList allows for repeated indexing - new functions: -- asQuoted -- collapsef -- ensureVector -- explode -- getAttributeNames -- getClass1 -- getUsedFactorLevels -- hasAttributes -- isSubset, isSuperset -- makeFileCache -- normalize -- setValue -- optimizeSubInts BBmisc_1.6: 23-Apr-2014 - the ProgressBar now outputs to stderr by default. But the stream can be configured. - improve handling of result names (row.names and col.names) in some functions a bit - convertRowsToList now converts matrices into list of vector by default (see new arg "as.vector") - rename first, last to which.first, which.last - improved extractSubList and rowSapply a bit, simplification to matrix can be stated in a more readable way. - new functions: -- operator %btwn%. -- convertListOfRowsToDataFrame -- convertMatrixType -- convertColsToList -- v*apply type of functions -- dapply -- rangeVal -- getFirst, getLast -- symdiff -- asMatrixCols, asMatrixRows -- isScalar family of helper functions -- sortByCol BBmisc_1.5: 25-Jan-2014 - removed stringsAsFactors, use convertDataFrameCols - removed convertDfCols, use convertDataFrameCols - removed listToShortString, use convertToShortString - new functions: -- dropNamed -- first, last -- binPack -- isValidName BBmisc_1.4: 06-Nov-2013 - renamed convertDfCols to convertDataFrameCols - deprecated listToShortString, use convertToShortString - deprecated stringsAsFactors, use convertDataFrameCols - chunk distributes size of chunks in a better way - new functions: -- makeS3Obj -- getMaxIndex, getMinIndex -- getMaxIndexOfRows, getMinIndexOfRows, getMaxIndexOfCols, getMinIndexOfCols -- toRangeStr -- getOperatingSystem, isWindows, isUnix, isLinux, isDarwin -- clipString -- getUnixTime -- isScalarValue -- makeDataFrame -- convertToShortString -- convertRowsToList BBmisc_1.3-64: 20-Aug-2013 - removed parallelMap et al., this is now hosted in an extra package at: https://github.com/berndbischl/parallelMap - bugfix for checkArg, lower/upper only checked first element - exta argument "missing.val" for names2 - extra argument "logicals.as.factor" for convertDFCols - some speed improvements for convertDFCols and notin - is.error also works now for objects of class "error" and not only "try-error" - new functions: -- isDirectory -- rowLapply, rowSapply -- setAttribute -- seq_row, seq_col -- strrepeat -- makeSimpleFileLogger -- isScalarNA -- pause -- printStrToChar BBmisc_1.2-200: 02-May-2013 - checkArg can now test whether arg is one of multiple classes (OR disjunctive) - bug fix: cpus setting was not properly respected in multicore mode - bug fix: warnings where not turned into errors with warningf and option(warn=2) - some minor bug fixes - parallelMap: switched multicore mode to package parallel - new functions -- lib -- argsAsNamedList -- names2 -- convertDfCols BBmisc_1.1-166: 16-Nov-2012 - some small fixes and added arguments - new functions: -- setRowNames, setColNames -- setClasses, addClasses -- isFALSE -- lsort -- computeMode BBmisc_1.1-132: 04-Jul-2012 - removed regmatches dependency BBmisc_1.1-125: 10-May-2012 - removed stringr dependency - new interface for ProgressBar and more therefore more functionality - some global options for progressbar behaviour - options immediate and warning.length for warningf - checkListElementClass now first checks that argument is a list - nin (notin) operator - parallelMap function, can delegate to multicore or snowfall - stringsAsFactors - system3 - load2 BBmisc_1.0-77: 17-Mar-2012 - removed calls to .Internal - more examples - fixed a bug in checkArg - makeProgressbar: new option 'inc' to increment - stopf: new option warning.length - more options for requirePackages - new functions: chunk, isExpensiveExampleOk BBmisc_1.0-58: 05-Jan-2012 - First submit to CRAN. BBmisc/R/0000755000175100001440000000000012741010551011624 5ustar hornikusersBBmisc/R/getMaxIndex.R0000644000175100001440000000206612644315506014202 0ustar hornikusers#' Return index of maximal/minimal element in numerical vector. #' #' If \code{x} is empty or only contains NAs which are to be removed, #' -1 is returned. #' #' @param x [\code{numeric}]\cr #' Input vector. #' @param ties.method [\code{character(1)}]\cr #' How should ties be handled? #' Possible are: \dQuote{random}, \dQuote{first}, \dQuote{last}. #' Default is \dQuote{random}. #' @param na.rm [\code{logical(1)}]\cr #' If \code{FALSE}, NA is returned if an NA is encountered in \code{x}. #' If \code{TRUE}, NAs are disregarded. #' Default is \code{FALSE} #' @return [\code{integer(1)}]. #' @export #' @useDynLib BBmisc c_getMaxIndex getMaxIndex = function(x, ties.method = "random", na.rm = FALSE) { ties.method = switch(ties.method, random = 1L, first = 2L, last = 3L, stop("Unknown ties method")) assertFlag(na.rm) .Call(c_getMaxIndex, as.numeric(x), ties.method, na.rm) } #' @export #' @rdname getMaxIndex getMinIndex = function(x, ties.method = "random", na.rm = FALSE) { getMaxIndex(-as.numeric(x), ties.method, na.rm) } BBmisc/R/mapValues.R0000644000175100001440000000346512644315506013726 0ustar hornikusers#' Replace values in atomic vectors #' #' @details #' Replaces values specified in \code{from} with values in \code{to}. #' Regular expression matching can be enabled which calls \code{\link[base]{gsub}} iteratively #' on \code{x} to replace all patterns in \code{from} with replacements in \code{to}. #' #' @param x [\code{atomic}]\cr #' Atomic vector. If \code{x} is a factor, all replacements work on the levels. #' @param from [\code{atomic}]\cr #' Atomic vector with values to replace, same length as \code{to}. #' @param to [\code{atomic}]\cr #' Atomic vector with replacements, same length as \code{from}. #' @param regex [\code{logical}]\cr #' Use regular expression matching? Default is \code{FALSE}. #' @param ignore.case [\code{logical}]\cr #' Argument passed to \code{\link[base]{gsub}}. #' @param perl [\code{logical}]\cr #' Argument passed to \code{\link[base]{gsub}}. #' @param fixed [\code{logical}]\cr #' Argument passed to \code{\link[base]{gsub}}. #' @return [\code{atomic}]. #' @export #' @examples #' # replace integers #' x = 1:5 #' mapValues(x, c(2, 3), c(99, 100)) #' #' # replace factor levels using regex matching #' x = factor(c("aab", "aba", "baa")) #' mapValues(x, "a.a", "zzz", regex = TRUE) mapValues = function(x, from, to, regex = FALSE, ignore.case = FALSE, perl = FALSE, fixed = FALSE) { assertAtomic(x) assertAtomic(from) assertAtomic(to, len = length(from)) assertFlag(regex) map = function(x, from, to) { if (regex) { for (i in seq_along(from)) x = gsub(from[i], to[i], x, ignore.case = ignore.case, perl = perl, fixed = fixed) } else { m = match(x, from, nomatch = NA_integer_) found = !is.na(m) x[found] = to[m[found]] } return(x) } if (is.factor(x)) { levels(x) = map(levels(x), from, to) return(x) } return(map(x, from, to)) } BBmisc/R/FileCache.R0000644000175100001440000000155112644315506013566 0ustar hornikusers#' A caching wrapper around load2. #' #' This closure returns a wrapper around \code{\link{load2}} which per #' default caches loaded objects and returns the cached version #' in subsequent calls. #' #' @param use.cache [\code{logical(1)}]\cr #' Enable the cache? #' Default is \code{TRUE}. #' @return [\code{function()}] with argument \code{slot} #' (name of the slot to cache the object in, default is \dQuote{default}). #' All other arguments are passed down to \code{\link{load2}}. #' @export makeFileCache = function(use.cache = TRUE) { assertFlag(use.cache) .cache = list() function(file, slot = "default", ...) { if (use.cache) { if (is.null(.cache[[slot]]) || .cache[[slot]]$file != file) .cache[[slot]] = list(file = file, obj = load2(file = file, ...)) return(.cache[[slot]]$obj) } return(load2(file = file, ...)) } } BBmisc/R/isSubset.R0000644000175100001440000000117612644315506013567 0ustar hornikusers#' Check subset relation on two vectors. #' #' @param x [\code{vector}]\cr #' Source vector. #' @param y [\code{vector}]\cr #' Vector of the same mode as \code{x}. #' @param strict [\code{logical(1)}]\cr #' Checks for strict/proper subset relation. #' @return [\code{logical(1)}] #' \code{TRUE} if each element of \code{x} is also contained in \code{y}, i. e., #' if \code{x} is a subset of \code{y} and \code{FALSE} otherwise. #' @export isSubset = function(x, y, strict = FALSE) { assertFlag(strict) if (length(x) == 0L) return(TRUE) res = all(x %in% y) if (strict) res = res & !isSubset(y, x) return(res) } BBmisc/R/setAttribute.R0000644000175100001440000000060412644315506014440 0ustar hornikusers#' A wrapper for \code{attr(x, which) = y}. #' #' @param x [any]\cr #' Your object. #' @param which [\code{character(1)}]\cr #' Name of the attribute to set #' @param value [\code{ANY}]\cr #' Value for the attribute. #' @return Changed object \code{x}. #' @export #' @examples #' setAttribute(list(), "foo", 1) setAttribute = function(x, which, value) { attr(x, which) = value x } BBmisc/R/namedList.R0000644000175100001440000000112612644315506013701 0ustar hornikusers#' Create named list, possibly initialized with a certain element. #' #' @param names [\code{character}]\cr #' Names of elements. #' @param init [valid R expression]\cr #' If given all list elements are initialized to this, otherwise #' \code{NULL} is used. #' @return [\code{list}]. #' @export #' @examples #' namedList(c("a", "b")) #' namedList(c("a", "b"), init = 1) namedList = function(names, init) { if (missing(names)) return(list()) n = length(names) if (missing(init)) xs = vector("list", n) else xs = replicate(n, init, simplify = FALSE) setNames(xs, names) } BBmisc/R/seq.R0000644000175100001440000000103212644315506012545 0ustar hornikusers#' Generate sequences along rows or cols. #' #' A simple convenience wrapper around \code{\link[base]{seq_len}}. #' #' @param x [\code{data.frame} | \code{matrix}]\cr #' Data frame, matrix or any object which supports \code{\link[base]{nrow}} #' or \code{\link[base]{ncol}}, respectively. #' @return Vector of type [\code{integer}]. #' @export #' @examples #' data(iris) #' seq_row(iris) #' seq_col(iris) seq_row = function(x) { seq_len(nrow(x)) } #' @export seq_col #' @rdname seq_row seq_col = function(x) { seq_len(ncol(x)) } BBmisc/R/coalesce.R0000644000175100001440000000136112644315506013540 0ustar hornikusers#' Returns first non-missing, non-null argument. #' #' Returns first non-missing, non-null argument, otherwise #' \code{NULL}. #' #' @param ... [any]\cr #' Arguments. #' @return [any]. #' @export #' @examples #' f = function(x,y) { #' print(coalesce(NULL, x, y)) #' } #' f(y = 3) coalesce = function(...) { dots = match.call(expand.dots = FALSE)$... for (arg in dots) { is_missing = if (is.symbol(arg)) { eval(substitute(missing(symbol), list(symbol = arg)), envir = parent.frame()) } else { FALSE } if (!is_missing) { value = tryCatch(eval(arg, envir = parent.frame()), error = function(...) NULL) if (!is.null(value)) { return(value) } } } NULL } BBmisc/R/rangeVal.R0000644000175100001440000000107712644315506013525 0ustar hornikusers#' Calculate range statistic. #' #' A simple wrapper for \code{diff(range(x))}, so \code{max(x) - min(x)}. #' #' @param x [\code{numeric}]\cr #' The vector. #' @param na.rm [\code{logical(1)}]\cr #' If \code{FALSE}, NA is returned if an NA is encountered in \code{x}. #' If \code{TRUE}, NAs are disregarded. #' Default is \code{FALSE} #' @return [\code{numeric(1)}]. #' @export rangeVal = function(x, na.rm = FALSE) { assertNumeric(x, min.len = 1L, any.missing = TRUE) assertFlag(na.rm) if (allMissing(x)) return(NA_real_) diff(range(x, na.rm = na.rm)) } BBmisc/R/getClass1.R0000644000175100001440000000036012644315506013606 0ustar hornikusers#' Wrapper for \code{class(x)[1]}. #' #' @param x [any]\cr #' Input object. #' @return [\code{character(1)}]. #' @note \code{getClass} is a function in \code{methods}. Do not confuse. #' @export getClass1 = function(x) { class(x)[1L] } BBmisc/R/checkListElementClass.R0000644000175100001440000000142612644315506016175 0ustar hornikusers#' Check that a list contains only elements of a required type. #' #' Check that argument is a list and contains only elements of a required type. #' Throws exception if check is not passed. #' Note that argument is evaluated when checked. #' #' @param xs [\code{list}]\cr #' Argument. #' @param cl [\code{character(1)}]\cr #' Class that elements must have. Checked with \code{is}. #' @return Nothing. #' @export #' @examples #' xs = as.list(1:3) #' checkListElementClass(xs, "numeric") checkListElementClass = function(xs, cl) { assertList(xs) s = deparse(substitute(xs)) lapply(seq_along(xs), function(i) { x = xs[[i]] if(!(is(x, cl))) stop("List ", s, " has element of wrong type ", class(x)[1L], " at position ", i, ". Should be: ", cl) }) invisible(NULL) } BBmisc/R/getMaxColIndex.R0000644000175100001440000000407612644315506014643 0ustar hornikusers#' Find row- or columnwise the index of the maximal / minimal element in a matrix. #' #' \code{getMaxIndexOfRows} returns the index of the maximal element of each row. #' \code{getMinIndexOfRows} returns the index of the minimal element of each row. #' \code{getMaxIndexOfCols} returns the index of the maximal element of each col. #' \code{getMinIndexOfCols} returns the index of the minimal element of each col. #' If a corresponding vector (row or col) is empty, possibly after NA removal, -1 is returned #' as index. #' #' @param x [\code{matrix(n,m)}] \cr #' Numerical input matrix. #' @param ties.method [\code{character(1)}]\cr #' How should ties be handled? #' Possible are: \dQuote{random}, \dQuote{first}, \dQuote{last}. #' Default is \dQuote{random}. #' @param na.rm [\code{logical(1)}]\cr #' If \code{FALSE}, NA is returned if an NA is encountered in \code{x}. #' If \code{TRUE}, NAs are disregarded. #' Default is \code{FALSE} #' @return [\code{integer(n)}]. #' @export #' @useDynLib BBmisc c_getMaxIndexOfRows c_getMaxIndexOfCols #' @examples #' x = matrix(runif(5 * 3), ncol = 3) #' print(x) #' print(getMaxIndexOfRows(x)) #' print(getMinIndexOfRows(x)) getMaxIndexOfRows = function(x, ties.method = "random", na.rm = FALSE) { mode(x) = "numeric" ties.method = switch(ties.method, random = 1L, first = 2L, last = 3L, stop("Unknown ties method")) assertFlag(na.rm) .Call(c_getMaxIndexOfRows, x, ties.method, na.rm) } #' @export #' @rdname getMaxIndexOfRows getMinIndexOfRows = function(x, ties.method = "random", na.rm = FALSE) { getMaxIndexOfRows(-x, ties.method, na.rm) } #' @export #' @rdname getMaxIndexOfRows getMaxIndexOfCols = function(x, ties.method = "random", na.rm = FALSE) { mode(x) = "numeric" ties.method = switch(ties.method, random = 1L, first = 2L, last = 3L, stop("Unknown ties method")) .Call(c_getMaxIndexOfCols, x, ties.method, na.rm) } #' @export #' @rdname getMaxIndexOfRows getMinIndexOfCols = function(x, ties.method = "random", na.rm = FALSE) { getMaxIndexOfCols(-x, ties.method, na.rm) } BBmisc/R/setRowColNames.R0000644000175100001440000000074712644315506014676 0ustar hornikusers#' Wrapper for \code{rownames(x) = y}, \code{colnames(x) = y}. #' #' @param x [\code{matrix} | \code{data.frame}]\cr #' Matrix or data.frame. #' @param names [\code{character}]\cr #' New names for rows / columns. #' @return Changed object \code{x}. #' @export #' @examples #' setColNames(matrix(1:4, 2, 2), c("a", "b")) setRowNames = function(x, names) { rownames(x) = names x } #' @rdname setRowNames #' @export setColNames = function(x, names) { colnames(x) = names x } BBmisc/R/checkArg.R0000644000175100001440000001140312644315506013467 0ustar hornikusers#' Check for a function argument. #' #' Throws exception if checks are not passed. #' Note that argument is evaluated when checked. #' #' @param x [any]\cr #' Argument. #' @param cl [\code{character}]\cr #' Class that argument must \dQuote{inherit} from. #' If multiple classes are given, \code{x} must \dQuote{inherit} from at least one of these. #' See also argument \code{s4}. #' @param s4 [\code{logical(1)}]\cr #' If \code{TRUE}, use \code{is} for checking class \code{cl}, otherwise use \code{\link{inherits}}, which #' implies that only S3 classes are correctly checked. This is done for speed reasons #' as calling \code{\link{is}} is pretty slow. #' Default is \code{FALSE}. #' @param len [\code{integer(1)}]\cr #' Length that argument must have. #' Not checked if not passed, which is the default. #' @param min.len [\code{integer(1)}]\cr #' Minimal length that argument must have. #' Not checked if not passed, which is the default. #' @param max.len [\code{integer(1)}]\cr #' Maximal length that argument must have. #' Not checked if not passed, which is the default. #' @param choices [any]\cr #' Discrete number of choices, expressed by a vector of R objects. #' If passed, argument must be identical to one of these and nothing else is checked. #' @param subset [any]\cr #' Discrete number of choices, expressed by a vector of R objects. #' If passed, argument must be identical to a subset of these and nothing else is checked. #' @param lower [\code{numeric(1)}]\cr #' Lower bound for numeric vector arguments. #' Default is \code{NA}, which means not required. #' @param upper [\code{numeric(1)}]\cr #' Upper bound for numeric vector arguments. #' Default is \code{NA}, which means not required. #' @param na.ok [\code{logical(1)}]\cr #' Is it ok if a vector argument contains NAs? #' Default is \code{TRUE}. #' @param formals [\code{character}]\cr #' If this is passed, \code{x} must be a function. #' It is then checked that \code{formals} are the names of the #' (first) formal arguments in the signature of \code{x}. #' Meaning \code{checkArg(function(a, b), formals = "a")} is ok. #' Default is missing. #' @return Nothing. #' @export #' @examples #' x = 1L #' checkArg(x, "integer", len = 1, na.ok = FALSE, upper = 3L) #' x = as.integer(NA) #' checkArg(x, "integer", len = 1, na.ok = TRUE) #' x = c("foo", "bar") #' checkArg(x, "character") #' x = "foo" #' checkArg(x, choices = c("foo", "bar")) #' x = c("foo", "bar") #' checkArg(x, subset = c("foo", "bar")) #' fun = function(foo, bar) #' checkArg(fun, formals = c("foo", "bar")) checkArg = function(x, cl, s4 = FALSE, len, min.len, max.len, choices, subset, lower = NA, upper = NA, na.ok = TRUE, formals) { s = deparse(substitute(x)) if (missing(x)) stop("Argument ", s, " must not be missing!") cl2 = class(x)[1] len2 = length(x) matchEl = function(x, xs) any(sapply(xs, function(y) identical(y, x))) # choices must be done first if (!missing(choices)) { if (!matchEl(x, choices)) stop("Argument ", s, " must be any of: ", collapse(choices), "!") } else if (!missing(subset)) { if (!all(sapply(x, matchEl, xs = subset))) stop("Argument ", s, " must be subset of: ", collapse(subset), "!") } else if (!missing(formals)) { if (!is.function(x)) stop("Argument ", s, " must be of class ", "function", " not: ", cl2, "!") fs = names(formals(x)) if (length(fs) < length(formals) || !all(formals == fs[seq_along(formals)])) stop("Argument function must have first formal args: ", paste(formals, collapse = ","), "!") } else { mycheck = function(x, cc) if(identical(cc, "numeric")) is.numeric(x) else if(identical(cc, "integer")) is.integer(x) else if(identical(cc, "vector")) is.vector(x) else if (!s4) inherits(x, cc) else if (s4) is(x, cc) if (!any(sapply(cl, mycheck, x = x))) stop("Argument ", s, " must be of class ", collapse(cl, " OR "), ", not: ", cl2, "!") if (!missing(len) && len2 != len) stop("Argument ", s, " must be of length ", len, " not: ", len2, "!") if (!missing(min.len) && len2 < min.len) stop("Argument ", s, " must be at least of length ", min.len, " not: ", len2, "!") if (!missing(max.len) && len2 > max.len) stop("Argument ", s, " must be at most of length ", max.len, " not: ", len2, "!") if (!na.ok && any(is.na(x))) stop("Argument ", s, " must not contain any NAs!") if (is.numeric(x) && !is.na(lower) && ((is.na(x) && !na.ok) || (!is.na(x) && any(x < lower)))) stop("Argument ", s, " must be greater than or equal ", lower, "!") if (is.numeric(x) && !is.na(upper) && ((is.na(x) && !na.ok) || (!is.na(x) && any(x > upper)))) stop("Argument ", s, " must be less than or equal ", upper, "!") } } BBmisc/R/load2.R0000644000175100001440000000310412644315506012760 0ustar hornikusers#' Load RData file and return objects in it. #' #' @param file [\code{character(1)}]\cr #' File to load. #' @param parts [\code{character}]\cr #' Elements in file to load. #' Default is all. #' @param simplify [\code{logical(1)}]\cr #' If \code{TRUE}, a list is only returned if \code{parts} and the file contain both more #' than 1 element, otherwise the element is directly returned. #' Default is \code{TRUE}. #' @param envir [\code{environment(1)}]\cr #' Assign objects to this environment. #' Default is not to assign. #' @param impute [\code{ANY}]\cr #' If \code{file} does not exists, return \code{impute} instead. #' Default is missing which will result in an exception if \code{file} is not found. #' @return Either a single object or a list. #' @export #' @examples #' fn = tempfile() #' save2(file = fn, a = 1, b = 2, c = 3) #' load2(fn, parts = "a") #' load2(fn, parts = c("a", "c")) load2 = function(file, parts, simplify = TRUE, envir, impute) { assertFlag(simplify) ee = new.env() if (!missing(impute) && !file.exists(file)) return(impute) load(file, envir = ee) ns = ls(ee, all.names = TRUE) if (!missing(parts)) { assertCharacter(parts, any.missing = FALSE) d = setdiff(parts, ns) if (length(d) > 0L) stopf("File %s does not contain: %s", file, collapse(d)) } else { parts = ns } if (!missing(envir)) { lapply(ns, function(x) assign(x, ee[[x]], envir = envir)) } if (simplify) { if (length(ns) == 1L) return(ee[[ns]]) if (length(parts) == 1L) return(ee[[parts]]) } mget(parts, envir = ee) } BBmisc/R/pause.R0000644000175100001440000000023712644315506013100 0ustar hornikusers#' Pause in interactive mode and continue on . #' @export pause = function() { if (interactive()) readline("Pause. Press to continue.") } BBmisc/R/makeDataFrame.R0000644000175100001440000000443212644315506014446 0ustar hornikusers#' Initialize data.frame in a convenient way. #' #' @param nrow [\code{integer(1)}]\cr #' Nubmer of rows. #' @param ncol [\code{integer(1)}]\cr #' Number of columns. #' @param col.types [\code{character(ncol)} | \code{character(1)}]\cr #' Data types of columns. #' If you only pass one type, it will be replicated. #' Supported are all atomic modes also supported by #' \code{\link[base]{vector}}, i.e. all common data frame types except factors. #' @param init [any]\cr #' Scalar object to initialize all elements of the data.frame. #' You do not need to specify \code{col.types} if you pass this. #' @param row.names [\code{character} | \code{integer} | \code{NULL}]\cr #' Row names. #' Default is \code{NULL}. #' @param col.names [\code{character} | \code{integer}]\cr #' Column names. #' Default is \dQuote{V1}, \dQuote{V2}, and so on. #' @export #' @examples #' print(makeDataFrame(3, 2, init = 7)) #' print(makeDataFrame(3, 2, "logical")) #' print(makeDataFrame(3, 2, c("logical", "numeric"))) makeDataFrame = function(nrow, ncol, col.types, init, row.names = NULL, col.names = sprintf("V%i", seq_len(ncol))) { nrow = asCount(nrow) ncol = asCount(ncol) if (!missing(col.types)) assertCharacter(col.types, min.len = 1L, any.missing = FALSE) if (!missing(init)) { if(!isScalarValue(init)) stop("'init' must be a scalar value!") if (!missing(col.types)) { if (length(col.types) > 1L) stop("If 'init' is given, length of col.types must be 1!") if (identical(class(init)[1L], "col.types")) stop("Class of 'init' must match given column type!") } } if (!missing(col.types) && length(col.types) == 1L) col.types = rep.int(col.types, ncol) if (!is.null(row.names)) assert(checkIntegerish(row.names, len = nrow), checkCharacter(row.names, len = nrow)) assert(checkIntegerish(col.names, len = ncol), checkCharacter(col.names, len = ncol)) if (nrow == 0L && ncol == 0L) df = data.frame() else if (ncol == 0L) df = data.frame(matrix(nrow = nrow, ncol = 0)) else if (missing(init)) df = lapply(col.types, vector, length = nrow) else df = replicate(ncol, rep.int(init, nrow), simplify = FALSE) df = as.data.frame(df, stringsAsFactors = FALSE) rownames(df) = row.names colnames(df) = col.names return(df) } BBmisc/R/convertToShortString.R0000644000175100001440000000355712644315506016165 0ustar hornikusers#' @title Converts any R object to a descriptive string so it can be used in messages. #' #' @description #' Atomics: If of length 0 or 1, they are basically printed as they are. #' Numerics are formated with \code{num.format}. #' If of length greater than 1, they are collapsed witd \dQuote{,} and clipped. #' so they do not become excessively long. #' #' All others: Currently, only their class is simply printed #' like \dQuote{}. #' #' Lists: The mechanism above is applied (non-recursively) to their elements. #' The result looks like this: #' \dQuote{a = 1, = 2, b = , c = }. #' #' @param x [any]\cr #' The object. #' @param num.format [\code{character(1)}]\cr #' Used to format numerical scalars via \code{\link{sprintf}}. #' Default is \dQuote{\%.4g}. #' @param clip.len [\code{integer(1)}]\cr #' Used clip atomic vectors via \code{\link{clipString}}. #' Default is 15. #' @return [\code{character(1)}]. #' @export #' @examples #' convertToShortString(list(a = 1, b = NULL, "foo", c = 1:10)) convertToShortString = function(x, num.format = "%.4g", clip.len = 15L) { # convert non-list object to string convObj = function(x) { if (is.null(x)) return("NULL") if (is.atomic(x)) { if (length(x) == 0L) { sprintf("%s(0)", getClass1(x)) } else if (length(x) == 1L) { if (is.double(x)) sprintf(num.format, x) else collapse(x) } else { clipString(collapse(sapply(x, convertToShortString), ","), clip.len) } } else { paste("<", getClass1(x), ">", sep = "") } } # handle only lists and not any derived data types if (getClass1(x) == "list") { if (length(x) == 0L) return("") ns = names2(x, missing.val = "") ss = lapply(x, convObj) collapse(paste(ns, "=", ss, sep = ""), ", ") } else { convObj(x) } } BBmisc/R/computeMode.R0000644000175100001440000000253212644315506014244 0ustar hornikusers#' Compute statistical mode of a vector (value that occurs most frequently). #' #' Works for integer, numeric, factor and character vectors. #' The implementation is currently not extremely efficient. #' #' @param x [\code{vector}]\cr #' Factor, character, integer, numeric or logical vector. #' @param na.rm [\code{logical(1)}]\cr #' If \code{TRUE}, missing values in the data removed. #' if \code{FALSE}, they are used as a separate level and this level could therefore #' be returned as the most frequent one. #' Default is \code{TRUE}. #' @param ties.method [\code{character(1)}]\cr #' \dQuote{first}, \dQuote{random}, \dQuote{last}: Decide which value to take in case of ties. #' Default is \dQuote{random}. #' @return Modal value of length 1, data type depends on data type of \code{x}. #' @export #' @examples #' computeMode(c(1,2,3,3)) computeMode = function(x, ties.method = "random", na.rm = TRUE) { assertAtomicVector(x) assertChoice(ties.method, c("first", "random", "last")) assertFlag(na.rm) #FIXME: no arg checks for speed currently tab = table(x, useNA = ifelse(na.rm, "no", "ifany")) y = max(tab) mod = names(tab)[tab == y] if (!is.factor(x)) mode(mod) = mode(x) if (length(mod) > 1L) switch(ties.method, first = mod[1L], random = sample(mod, 1L), last = mod[length(mod)] ) else mod } BBmisc/R/isProperlyNamed.R0000644000175100001440000000065712644315506015106 0ustar hornikusers#' Are all elements of a list / vector uniquely named? #' #' \code{NA} or \dQuote{} are not allowed as names. #' #' @param x [\code{vector}]\cr #' The vector or list. #' @return [\code{logical(1)}]. #' @export #' @examples #' isProperlyNamed(list(1)) #' isProperlyNamed(list(a = 1)) #' isProperlyNamed(list(a = 1, 2)) isProperlyNamed = function(x) { ns = names2(x) length(x) == 0L || !(any(is.na(ns)) || anyDuplicated(ns)) } BBmisc/R/sortByCol.R0000644000175100001440000000173312644315506013705 0ustar hornikusers#' Sort the rows of a data.frame according to one or more columns. #' #' @param x [\code{data.frame}]\cr #' Data.frame to sort. #' @param col [\code{character}]\cr #' One or more column names to sort \code{x} by. #' In order of preference. #' @param asc [\code{logical}]\cr #' Sort ascending (or descending)? #' One value per entry of \code{col}. #' If a scalar logical is passed, it is replicated. #' Default is \code{TRUE}. #' @return [\code{data.frame}]. #' @export sortByCol = function(x, col, asc = TRUE) { assertDataFrame(x) assertSubset(col, colnames(x)) m = length(col) assertLogical(asc, min.len = 1L, any.missing = FALSE) if (length(asc) == 1L) asc = rep(asc, m) asc = ifelse(asc, 1, -1) args = as.list(x[, col, drop = FALSE]) # convert col to orderable numeric and multiply with factor args = Map(function(a, b) xtfrm(a) * b, args, asc) # now order the numerics and permute df o = do.call(order, args) return(x[o, , drop = FALSE]) } BBmisc/R/optimizeSubInts.R0000644000175100001440000000323112644315506015130 0ustar hornikusers#' @title Naive multi-start version of \code{\link{optimize}} for global optimization. #' #' @description #' The univariate \code{\link{optimize}} can stop at arbitrarily bad points when #' \code{f} is not unimodal. This functions mitigates this effect in a very naive way: #' \code{interval} is subdivided into \code{nsub} equally sized subintervals, #' \code{\link{optimize}} is run on all of them (and on the original big interval) and #' the best obtained point is returned. #' #' @param f See \code{\link{optimize}}. #' @param interval See \code{\link{optimize}}. #' @param ... See \code{\link{optimize}}. #' @param lower See \code{\link{optimize}}. #' @param upper See \code{\link{optimize}}. #' @param maximum See \code{\link{optimize}}. #' @param tol See \code{\link{optimize}}. #' @param nsub [\code{integer(1)}]\cr #' Number of subintervals. A value of 1 implies normal \code{\link{optimize}} behavior. #' Default is 50L. #' @return See \code{\link{optimize}}. #' @export optimizeSubInts = function(f, interval, ..., lower = min(interval), upper = max(interval), maximum = FALSE, tol = .Machine$double.eps^0.25, nsub = 50L) { nsub = asCount(nsub, positive = TRUE) interval = c(lower, upper) # run on normal interval best = optimize(f = f, interval = interval, maximum = maximum, tol = tol) # run on smaller partitions if (nsub > 1L) { mult = ifelse(maximum, -1, 1) grid = seq(lower, upper, length.out = nsub - 1L) for (j in seq_len(length(grid)-1L)) { res = optimize(f = f, interval = c(grid[j], grid[j+1L]), maximum = maximum, tol = tol) if (mult * res$objective < mult * best$objective) best = res } } return(best) } BBmisc/R/makeProgressBar.R0000644000175100001440000001426412644315506015057 0ustar hornikusers#' @title Create a progress bar with estimated time. #' #' @description #' Create a progress bar function that displays the estimated time till #' completion and optional messages. Call the returned functions \code{set} or #' \code{inc} during a loop to change the display. #' Note that you are not allowed to decrease the value of the bar. #' If you call these function without setting any of the arguments #' the bar is simply redrawn with the current value. #' For errorhandling use \code{error} and have a look at the example below. #' #' You can globally change the behavior of all bars by setting the option #' \code{options(BBmisc.ProgressBar.style)} either to \dQuote{text} (the default) #' or \dQuote{off}, which display no bars at all. #' #' You can globally change the width of all bars by setting the option #' \code{options(BBmisc.ProgressBar.width)}. By default this is \code{getOption("width")}. #' #' You can globally set the stream where the output of the bar is directed by setting the option #' \code{options(BBmisc.ProgressBar.stream)} either to \dQuote{stderr} (the default) #' or \dQuote{stdout}. Note that using the latter will result in the bar being shown in #' reports generated by Sweave or knitr, what you probably do not want. #' #' @param min [\code{numeric(1)}]\cr #' Minimum value, default is 0. #' @param max [\code{numeric(1)}]\cr #' Maximum value, default is 100. #' @param label [\code{character(1)}]\cr #' Label shown in front of the progress bar. #' Note that if you later set \code{msg} in the progress bar function, #' the message will be left-padded to the length of this label, therefore #' it should be at least as long as the longest message you want to display. #' Default is \dQuote{}. #' @param char [\code{character(1)}]\cr #' A single character used to display progress in the bar. #' Default is \sQuote{+}. #' @param style [\code{character(1)}]\cr #' Style of the progress bar. Default is set via options (see details). #' @param width [\code{integer(1)}]\cr #' Width of the progress bar. Default is set via options (see details). #' @param stream [\code{character(1)}]\cr #' Stream to use. Default is set via options (see details). #' @return [\code{\link{ProgressBar}}]. A list with following functions: #' \item{set [\code{function(value, msg = label)}]}{Set the bar to a value and possibly display a message instead of the label.} #' \item{inc [\code{function(value, msg = label)}]}{Increase the bar and possibly display a message instead of the label.} #' \item{kill [\code{function(clear = FALSE)}]}{Kill the bar so it cannot be used anymore. Cursor is moved to new line. You can also erase its display.} #' \item{error [\code{function(e)}]}{Useful in \code{tryCatch} to properly display error messages below the bar. See the example.} #' @export #' @aliases ProgressBar #' @examples #' bar = makeProgressBar(max = 5, label = "test-bar") #' for (i in 0:5) { #' bar$set(i) #' Sys.sleep(0.2) #' } #' bar = makeProgressBar(max = 5, label = "test-bar") #' for (i in 1:5) { #' bar$inc(1) #' Sys.sleep(0.2) #' } #' # display errors properly (in next line) #' \dontrun{ #' f = function(i) if (i>2) stop("foo") #' bar = makeProgressBar(max = 5, label = "test-bar") #' for (i in 1:5) { #' tryCatch ({ #' f(i) #' bar$set(i) #' }, error = bar$error) #' } #' } makeProgressBar = function(min = 0, max = 100, label = "", char = "+", style = getOption("BBmisc.ProgressBar.style", "text"), width = getOption("BBmisc.ProgressBar.width", getOption("width")), stream = getOption("BBmisc.ProgressBar.stream", "stderr")) { assertNumber(min) assertNumber(max) assertString(label) assertChoice(style, c("text", "off")) assertInt(width, lower = 30L) assertChoice(stream, c("stderr", "stdout")) if (style == "off") return(structure(list( set = function(value, msg = label) invisible(NULL), inc = function(inc, msg = label) invisible(NULL), kill = function(clear = FALSE) invisible(NULL), error = function(e) stop(e) ), class = "ProgressBar")) mycat = if (stream == "stdout") function(...) cat(...) else function(...) cat(..., file = stderr()) ## label |................................| xxx% (hh:mm:ss) label.width = nchar(label) bar.width = width - label.width - 21L bar = rep(" ", bar.width) start.time = as.integer(Sys.time()) delta = max - min kill.line = "\r" killed = FALSE cur.value = min draw = function(value, inc, msg) { if (!missing(value) && !missing(inc)) stop("You must not set value and inc!") else if (!missing(value)) assertNumber(value, lower = max(min, cur.value), upper = max) else if (!missing(inc)) { assertNumber(inc, lower = 0, upper = max - cur.value) value = cur.value + inc } else { value = cur.value } if (!killed) { # special case for min == max, weird "empty" bar, but might happen... if (value == max) rate = 1 else rate = (value - min) / delta bin = round(rate * bar.width) bar[seq(bin)] <<- char delta.time = as.integer(Sys.time()) - start.time if (value == min) rest.time = 0 else rest.time = (max - value) * (delta.time / (value - min)) rest.time = splitTime(rest.time, "hours") # as a precaution, so we can _always_ print in the progress bar cat if (rest.time["hours"] > 99) rest.time[] = 99 mycat(kill.line) msg = sprintf(sprintf("%%%is", label.width), msg) mycat(sprintf("%s |%s| %3i%% (%02i:%02i:%02i)", msg, collapse(bar, sep = ""), round(rate*100), rest.time["hours"], rest.time["minutes"], rest.time["seconds"])) if (value == max) kill() flush.console() } cur.value <<- value } clear = function(newline = TRUE) { mycat(kill.line) mycat(rep(" ", width)) if (newline) mycat("\n") } kill = function(clear = FALSE) { if (clear) clear(newline = TRUE) else mycat("\n") killed <<- TRUE } makeS3Obj("ProgressBar", set = function(value, msg = label) draw(value = value, msg = msg), inc = function(inc, msg = label) draw(inc = inc, msg = msg), kill = kill, error = function(e) { kill(clear = FALSE) stop(e) } ) } BBmisc/R/directory.R0000644000175100001440000000200412644315506013761 0ustar hornikusers#' Is one / are several files a directory? #' #' If a file does not exist, \code{FALSE} is returned. #' #' @param ... [\code{character(1)}]\cr #' File names, all strings. #' @return [\code{logical}]. #' @export #' @examples #' print(isDirectory(tempdir())) #' print(isDirectory(tempfile())) isDirectory = function(...) { paths = c(...) if (.Platform$OS.type == "windows" && getRversion() < "3.0.2") paths = sub("^([[:alpha:]]:)[/\\]*$", "\\1//", paths) x = file.info(paths)$isdir !is.na(x) & x } #' Is one / are several directories empty? #' #' If file does not exist or is not a directory, \code{FALSE} is returned. #' #' @param ... [\code{character(1)}]\cr #' Directory names, all strings. #' @return [\code{logical}]. #' @export #' @examples #' print(isEmptyDirectory(tempdir())) #' print(isEmptyDirectory(tempfile())) isEmptyDirectory = function(...) { vapply(list(...), FUN.VALUE = TRUE, FUN = function(x) { isDirectory(x) && length(list.files(x, all.files = TRUE, include.dirs = TRUE)) == 2L }) } BBmisc/R/stopf.R0000644000175100001440000000144112644315506013114 0ustar hornikusers#' Wrapper for stop and sprintf. #' #' A wrapper for \code{\link{stop}} with \code{\link{sprintf}} applied to the arguments. #' Notable difference is that error messages are not truncated to 1000 characters #' by default. #' #' @param ... [any]\cr #' See \code{\link{sprintf}}. #' @param warning.length [\code{integer(1)}]\cr #' Number of chars after which the error message #' gets truncated, see ?options. #' Default is 8170. #' @return Nothing. #' @export #' @examples #' err = "an error." #' try(stopf("This is %s", err)) stopf = function(..., warning.length = 8170L) { msg = sprintf(...) obj = simpleError(msg, call = sys.call(sys.parent())) old.opt = getOption("warning.length") on.exit(options(warning.length = old.opt)) options(warning.length = warning.length) stop(obj) } BBmisc/R/convertRowsToList.R0000644000175100001440000000462112644315506015456 0ustar hornikusers#' Convert rows (columns) of data.frame or matrix to lists. #' #' For each row, one list/vector is constructed, each entry of #' the row becomes a list/vector element. #' #' @param x [\code{matrix} | \code{data.frame}]\cr #' Object to convert. #' @param name.list [\code{logical(1)}]\cr #' Name resulting list with names of rows (cols) of \code{x}? #' Default is \code{FALSE}. #' @param name.vector [\code{logical(1)}]\cr #' Name vector elements in resulting list with names of cols (rows) of \code{x}? #' Default is \code{FALSE}. #' @param factors.as.char [\code{logical(1)}]\cr #' If \code{x} is a data.frame, convert factor columns to #' string elements in the resulting lists? #' Default is \code{TRUE}. #' @param as.vector [\code{logical(1)}]\cr #' If \code{x} is a matrix, store rows as vectors in the resulting list - or otherwise as lists? #' Default is \code{TRUE}. #' @return [\code{list} of lists or vectors]. #' @export convertRowsToList = function(x, name.list = TRUE, name.vector = FALSE, factors.as.char = TRUE, as.vector = TRUE) { assert(checkMatrix(x), checkDataFrame(x)) assertFlag(name.list) assertFlag(name.vector) assertFlag(factors.as.char) assertFlag(as.vector) ns.list = if (name.list) rownames(x) else NULL ns.vector = if (name.vector) colnames(x) else NULL if (is.matrix(x)) { if (as.vector) res = lapply(seq_row(x), function(i) setNames(x[i, ], ns.vector)) else res = lapply(seq_row(x), function(i) setNames(as.list(x[i, ]), ns.vector)) } else if (is.data.frame(x)) { if (factors.as.char) x = convertDataFrameCols(x, factors.as.char = TRUE) res = rowLapply(x, function(row) setNames(as.list(row), ns.vector)) } setNames(res, ns.list) } #' @rdname convertRowsToList #' @export convertColsToList = function(x, name.list = FALSE, name.vector= FALSE, factors.as.char = TRUE, as.vector = TRUE) { # we need a special case for df and can ignore as.vector in it if (is.data.frame(x)) { if (factors.as.char) x = convertDataFrameCols(x, factors.as.char = TRUE) y = as.list(x) if (name.vector) { ns.vector = if (name.vector) colnames(x) else NULL y = lapply(y, function(z) setNames(z, ns.vector)) } colnames(y) = if (name.list) colnames(x) else NULL return(y) } convertRowsToList(t(x), name.list = name.list, name.vector = name.vector, factors.as.char = factors.as.char, as.vector = as.vector) } BBmisc/R/addClasses.R0000644000175100001440000000055512644315506014034 0ustar hornikusers #' A wrapper to add to the class attribute. #' #' @param x [any]\cr #' Your object. #' @param classes [\code{character}]\cr #' Classes to add. Will be added in front (specialization). #' @return Changed object \code{x}. #' @export #' @examples #' addClasses(list(), c("foo1", "foo2")) addClasses = function(x, classes) { class(x) = c(classes, class(x)) x } BBmisc/R/splitTime.R0000644000175100001440000000227612644315506013742 0ustar hornikusers#' Split seconds into handy chunks of time. #' #' Note that a year is simply defined as exactly 365 days. #' #' @param seconds [\code{numeric(1)}]\cr #' Number of seconds. If not an integer, it is rounded down. #' @param unit [\code{character(1)}]\cr #' Largest unit to split seconds into. #' Must be one of: \code{c("years", "days", "hours", "minutes", "seconds")}. #' Default is \dQuote{years}. #' @return [\code{numeric(5)}]. A named vector containing the #' \dQuote{years}, \dQuote{days}, \dQuote{hours}, \dQuote{minutes} #' and \dQuote{seconds}. Units larger than the given \code{unit} are #' \code{NA}. #' @export #' @examples #' splitTime(1000) splitTime = function(seconds, unit = "years") { assertNumber(seconds) assertChoice(unit, c("years", "days", "hours", "minutes", "seconds")) divider = c(31536000L, 86400L, 3600L, 60L, 1L) res = setNames(rep.int(NA_integer_, 5L), c("years", "days", "hours", "minutes", "seconds")) start = which(names(res) == unit) for (i in start:length(divider)) { res[i] = seconds %/% divider[i] seconds = seconds - res[i] * divider[i] } ## Make sure all values are integral and do _not_ strip names: viapply(res, as.integer) } BBmisc/R/symdiff.R0000644000175100001440000000037612644315506013430 0ustar hornikusers#' Calculates symmetric set difference between two sets. #' #' @param x [\code{vector}]\cr #' Set 1. #' @param y [\code{vector}]\cr #' Set 2. #' @return [\code{vector}]. #' @export symdiff = function(x, y) { setdiff(union(x, y), intersect(x, y)) } BBmisc/R/isExpensiveExampleOk.R0000644000175100001440000000131412644315506016070 0ustar hornikusers#' Conditional checking for expensive examples. #' #' Queries environment variable \dQuote{R_EXPENSIVE_EXAMPLE_OK}. #' Returns \code{TRUE} iff set exactly to \dQuote{TRUE}. #' This allows conditional checking of expensive examples in packages #' via R CMD CHECK, so they are not run on CRAN, but at least #' on your local computer. #' A better option than \dQuote{dont_run} in many cases, where such examples #' are not checked at all. #' #' @return [\code{logical(1)}]. #' @export #' @examples #' # extremely costly random number generation, that we dont want checked on CRAN #' if (isExpensiveExampleOk()) { #' runif(1) #' } isExpensiveExampleOk = function() { Sys.getenv("R_EXPENSIVE_EXAMPLE_OK") == "TRUE" } BBmisc/R/clipString.R0000644000175100001440000000154012644315506014077 0ustar hornikusers#' Shortens strings to a given length. #' #' @param x [\code{character}]\cr #' Vector of strings. #' @param len [\code{integer(1)}]\cr #' Absolute length the string should be clipped to, including \code{tail}. #' Note that you cannot clip to a shorter length than \code{tail}. #' @param tail [\code{character(1)}]\cr #' If the string has to be shortened at least 1 character, the final characters will be \code{tail}. #' Default is \dQuote{...}. #' @return [\code{character(1)}]. #' @export #' @examples #' print(clipString("abcdef", 10)) #' print(clipString("abcdef", 5)) clipString = function(x, len, tail = "...") { assertCharacter(x, any.missing = TRUE) len = asInteger(len, len = 1L, lower = nchar(tail)) assertString(tail) ind = (!is.na(x) & nchar(x) > len) replace(x, ind, paste(substr(x[ind], 1L, len - nchar(tail)), tail, sep = "")) } BBmisc/R/btwn.R0000644000175100001440000000101112644315506012724 0ustar hornikusers#' Check if some values are covered by the range of the values in a second vector. #' #' @param x [\code{numeric(n)}]\cr #' Value(s) that should be within the range of \code{y}. #' @param y [\code{numeric}]\cr #' Numeric vector which defines the range. #' @return [\code{logical(n)}]. For each value in \code{x}: Is it in the range of \code{y}? #' @usage x \%btwn\% y #' @rdname btwn #' @examples #' x = 3 #' y = c(-1,2,5) #' x %btwn% y #' @export `%btwn%` = function(x, y) { r = range(y) x <= r[2] & x >= r[1] } BBmisc/R/isScalarNA.R0000644000175100001440000000046612644315506013747 0ustar hornikusers#' Checks whether an object is a scalar NA value. #' #' Checks whether object is from \code{(NA, NA_integer, NA_real_, NA_character_, NA_complex_)}. #' @param x [any]\cr #' Object to check. #' @return [\code{logical(1)}]. #' @export isScalarNA = function(x) { is.atomic(x) && length(x) == 1L && is.na(x) } BBmisc/R/matchDataFrameSubset.R0000644000175100001440000000157412644315506016017 0ustar hornikusers# FIXME: not used anywhere? matchDataFrameSubset = function(df, ss, factors.as.chars = TRUE) { checkArg(df, c("list", "data.frame")) checkArg(ss, c("list", "data.frame")) if (!isProperlyNamed(df)) stop("'df' is not proberbly named") if (!isProperlyNamed(ss)) stop("'ss' is not proberbly named") if (any(names(ss) %nin% names(df))) stop("Names of 'ss' not found in 'df'") if (is.list(df)) df = as.data.frame(df, stringsAsFactors = FALSE) if (is.list(ss)) ss = as.data.frame(ss, stringsAsFactors = FALSE) df = subset(df, select = names(ss)) if (factors.as.chars) { df = convertDataFrameCols(df, factors.as.char = TRUE) ss = convertDataFrameCols(ss, factors.as.char = TRUE) } conv = function(x) rawToChar(serialize(x, connection = NULL, ascii = TRUE)) match(rowSapply(ss, conv, use.names = FALSE), rowSapply(df, conv, use.names = FALSE)) } BBmisc/R/names2.R0000644000175100001440000000146112644315506013150 0ustar hornikusers#' Replacement for names which always returns a vector. #' #' A simple wrapper for \code{\link[base]{names}}. #' Returns a vector even if no names attribute is set. #' Values \code{NA} and \code{""} are treated as missing and #' replaced with the value provided in \code{missing.val}. #' #' @param x [\code{ANY}]\cr #' Object, probably named. #' @param missing.val [\code{ANY}]\cr #' Value to set for missing names. Default is \code{NA_character_}. #' @return [\code{character}]: vector of the same length as \code{x}. #' @export #' @examples #' x = 1:3 #' names(x) #' names2(x) #' names(x[1:2]) = letters[1:2] #' names(x) #' names2(x) names2 = function(x, missing.val = NA_character_) { n = names(x) if (is.null(n)) return(rep.int(missing.val, length(x))) replace(n, is.na(n) | n == "", missing.val) } BBmisc/R/insert.R0000644000175100001440000000156012644315506013267 0ustar hornikusers#' Insert elements from one list/vector into another list/vector. #' #' Inserts elements from \code{xs2} into \code{xs1} by name, #' overwriting elements of equal names. #' #' @param xs1 [\code{list}]\cr #' First list/vector. #' @param xs2 [\code{list}]\cr #' Second vector/list. Must be fully and uniquely named. #' @param elements [\code{character}]\cr #' Elements from \code{xs2} to insert into \code{xs1}. #' Default is all. #' @return \code{x1} with replaced elements from \code{x2}. #' @export #' @examples #' xs1 = list(a = 1, b = 2) #' xs2 = list(b = 1, c = 4) #' insert(xs1, xs2) #' insert(xs1, xs2, elements = "c") insert = function(xs1, xs2, elements) { if (length(xs2) > 0L) { if (missing(elements)) { xs1[names(xs2)] = xs2 } else { elements = intersect(elements, names(xs2)) xs1[elements] = xs2[elements] } } return(xs1) } BBmisc/R/isFALSE.R0000644000175100001440000000033712644315506013152 0ustar hornikusers#' A wrapper for \code{identical(x, FALSE)}. #' #' @param x [any]\cr #' Your object. #' @return [\code{logical(1)}]. #' @export #' @examples #' isFALSE(0) #' isFALSE(FALSE) isFALSE = function(x) { identical(x, FALSE) } BBmisc/R/itostr.R0000644000175100001440000000144012644315506013304 0ustar hornikusers#' Convert Integers to Strings #' #' This is the counterpart of \code{\link[base]{strtoi}}. #' For a base greater than \sQuote{10}, letters \sQuote{a} to \sQuote{z} #' are used to represent \sQuote{10} to \sQuote{35}. #' #' @param x [\code{integer}]\cr #' Vector of integers to convert. #' @param base [\code{integer(1)}]\cr #' Base for conversion. Values between 2 and 36 (inclusive) are allowed. #' @return \code{character(length(x))}. #' @export #' @examples #' # binary representation of the first 10 natural numbers #' itostr(1:10, 2) #' #' # base36 encoding of a large number #' itostr(1e7, 36) itostr = function(x, base = 10L) { x = asInteger(x, any.missing = FALSE, lower = 0L) base = asInt(base, na.ok = FALSE, lower = 2L, upper = 36L) .Call("itostr", x, base, PACKAGE = "BBmisc") } BBmisc/R/factor.R0000644000175100001440000000126112644315506013237 0ustar hornikusers#' Combine multiple factors and return a factor. #' #' Note that function does not inherit from \code{\link{c}} to not change R semantics behind your back when this #' package is loaded. #' #' @param ... [\code{factor}]\cr #' The factors. #' @return [\code{factor}]. #' @export #' @examples #' f1 = factor(c("a", "b")) #' f2 = factor(c("b", "c")) #' print(c(f1, f2)) #' print(cFactor(f1, f2)) cFactor = function(...) { args = lapply(list(...), as.factor) newlevels = sort(unique(unlist(lapply(args, levels)))) ans = unlist(lapply(args, function(x) { m = match(levels(x), newlevels) m[as.integer(x)] })) levels(ans) = newlevels setClasses(ans, "factor") } BBmisc/R/getUsedFactorLevels.R0000644000175100001440000000044612644315506015677 0ustar hornikusers#' Determines used factor levels. #' #' Determines the factor levels of a factor type vector #' that are actually occuring in it. #' #' @param x [\code{factor}]\cr #' The factor. #' @return [\code{character}] #' @export getUsedFactorLevels = function(x) { intersect(levels(x), unique(x)) } BBmisc/R/binPack.R0000644000175100001440000000314112644315506013327 0ustar hornikusers#' Simple bin packing. #' #' Maps numeric items in \code{x} into groups with sum #' less or equal than \code{capacity}. #' A very simple greedy algorithm is used, which is not really optimized #' for speed. This is a convenience function for smaller vectors, not #' a competetive solver for the real binbacking problem. #' If an element of \code{x} exceeds \code{capacity}, an error #' is thrown. #' #' @param x [\code{numeric}]\cr #' Numeric vector of elements to group. #' @param capacity [\code{numeric(1)}]\cr #' Maximum capacity of each bin, i.e., elements will be grouped #' so their sum does not exceed this limit. #' @return [\code{integer}]. Integer with values \dQuote{1} to \dQuote{n.bins} #' indicating bin membership. #' @export #' @examples #' x = 1:10 #' bp = binPack(x, 11) #' xs = split(x, bp) #' print(xs) #' print(sapply(xs, sum)) binPack = function(x, capacity) { assertNumeric(x, min.len = 1L, lower = 0, any.missing = FALSE) assertNumber(capacity) too.big = which.first(x > capacity, use.names = FALSE) if (length(too.big)) stopf("Capacity not sufficient. Item %i (x=%f) does not fit", too.big, x[too.big]) if (any(is.infinite(x))) stop("Infinite elements found in 'x'") ord = order(x, decreasing = TRUE) grp = integer(length(x)) sums = vector(typeof(x), 1L) bin.count = 1L for(j in ord) { new.sums = sums + x[j] pos = which.first(new.sums <= capacity, use.names = FALSE) if (length(pos)) { grp[j] = pos sums[pos] = new.sums[pos] } else { bin.count = bin.count + 1L grp[j] = bin.count sums[bin.count] = x[j] } } grp } BBmisc/R/isScalarValue.R0000644000175100001440000000376012644315506014525 0ustar hornikusers#' Is given argument an atomic vector or factor of length 1? #' #' More specific functions for scalars of a given type exist, too. #' #' @param x [any]\cr #' Argument. #' @param na.ok [\code{logical(1)}]\cr #' Is \code{NA} considered a scalar? #' Default is \code{TRUE}. #' @param null.ok [\code{logical(1)}]\cr #' Is \code{NULL} considered a scalar? #' Default is \code{FALSE}. #' @param type [\code{character(1)}]\cr #' Allows to restrict to specific type, e.g., \dQuote{numeric}? #' But instead of this argument you might want to consider using \code{isScalar}. #' Default is \dQuote{atomic}, so no special restriction. #' @return [\code{logical(1)}]. #' @export isScalarValue = function(x, na.ok = TRUE, null.ok = FALSE, type = "atomic") { if (is.null(x)) return(null.ok) # not really cool switch, but maybe fastest option istype = switch(type, "atomic" = is.atomic, "logical" = is.logical, "numeric" = is.numeric, "integer" = is.integer, "complex" = is.complex, "chararacter" = is.character, "factor" = is.factor ) istype(x) && length(x) == 1L && (na.ok || !is.na(x)) } #' @rdname isScalarValue #' @export isScalarLogical = function(x, na.ok = TRUE, null.ok = FALSE) { isScalarValue(x, na.ok, null.ok, "logical") } #' @rdname isScalarValue #' @export isScalarNumeric = function(x, na.ok = TRUE, null.ok = FALSE) { isScalarValue(x, na.ok, null.ok, "numeric") } #' @rdname isScalarValue #' @export isScalarInteger = function(x, na.ok = TRUE, null.ok = FALSE) { isScalarValue(x, na.ok, null.ok, "integer") } #' @rdname isScalarValue #' @export isScalarComplex = function(x, na.ok = TRUE, null.ok = FALSE) { isScalarValue(x, na.ok, null.ok, "complex") } #' @rdname isScalarValue #' @export isScalarCharacter = function(x, na.ok = TRUE, null.ok = FALSE) { isScalarValue(x, na.ok, null.ok, "chararacter") } #' @rdname isScalarValue #' @export isScalarFactor = function(x, na.ok = TRUE, null.ok = FALSE) { isScalarValue(x, na.ok, null.ok, "factor") } BBmisc/R/which.first.R0000644000175100001440000000136012644315506014211 0ustar hornikusers#' Find the index of first/last \code{TRUE} value in a logical vector. #' #' @param x [\code{logical}]\cr #' Logical vector. #' @param use.names [\code{logical(1)}]\cr #' If \code{TRUE} and \code{x} is named, the result is also #' named. #' @return [\code{integer(1)} | \code{integer(0)}]. #' Returns the index of the first/last \code{TRUE} value in \code{x} or #' an empty integer vector if none is found. #' @export #' @examples #' which.first(c(FALSE, TRUE)) #' which.last(c(FALSE, FALSE)) which.first = function(x, use.names = TRUE) { .Call("c_which_first", x, use.names, PACKAGE = "BBmisc") } #' @rdname which.first #' @export which.last = function(x, use.names = TRUE) { .Call("c_which_last", x, use.names, PACKAGE = "BBmisc") } BBmisc/R/getRelativePath.R0000644000175100001440000000270312644315506015053 0ustar hornikusers#' Construct a path relative to another #' #' Constructs a relative path from path \code{from} to path \code{to}. #' If this is not possible (i.e. different drive letters on windows systems), #' \code{NA} is returned. #' #' @param to [\code{character(1)}]\cr #' Where the relative path should point to. #' @param from [\code{character(1)}]\cr #' From which part to start. #' Default is \code{\link[base]{getwd}}. #' @param ignore.case [\code{logical(1)}]\cr #' Should path comparisons be made case insensitve? #' Default is \code{TRUE} on Windows systems and \code{FALSE} on other systems. #' @return [character(1)]: A relative path. #' @export getRelativePath = function(to, from = getwd(), ignore.case = isWindows()) { numberCommonParts = function(p1, p2) { for (i in seq_len(min(length(p1), length(p2)))) { if (p1[i] != p2[i]) return(i - 1L) } return(if (is.null(i)) 0L else i) } from = splitPath(from) to = splitPath(to) assertFlag(ignore.case) if (length(from$drive) != length(to$drive)) return(NA_character_) if (length(from$drive) > 0L && length(to$drive) > 0L && from$drive != to$drive) return(NA_character_) if (ignore.case) i = numberCommonParts(tolower(from$path), tolower(to$path)) else i = numberCommonParts(from$path, to$path) res = c(rep.int("..", length(from$path) - i), tail(to$path, ifelse(i == 0L, Inf, -i))) if (length(res) == 0L) res = "." collapse(res, .Platform$file.sep) } BBmisc/R/ensureVector.R0000644000175100001440000000236012644315506014446 0ustar hornikusers#' Blow up single scalars / objects to vectors / list by replication. #' #' Useful for standard argument conversion where a user can input a single #' element, but this has to be replicated now n times for a resulting vector or list. #' #' @param x [any]\cr #' Input element. #' @param n [\code{integer}]\cr #' Desired length. #' @param cl [\code{character(1)}*]\cr #' Only do the operation if \code{x} inherits from this class, otherwise simply let x pass. #' Default is \code{NULL} which means to always do the operation. #' @param names [\code{character}*] \cr #' Names for result. #' Default is \code{NULL}, which means no names. #' @return Ether a vector or list of length \code{n} with replicated \code{x} or \code{x} unchanged.. #' @export ensureVector = function(x, n, cl = NULL, names = NULL) { n = convertInteger(n) assertCount(n) doit = isScalarValue(x) || !is.atomic(x) if (!is.null(cl)) { assertString(cl) doit = doit && inherits(x, cl) } if (doit) { if (isScalarValue(x)) xs = rep(x, n) else xs = replicate(n, x, simplify = FALSE) if (!is.null(names)) { assertCharacter(names, len = n, any.missing = FALSE) names(xs) = names } return(xs) } else { return(x) } } BBmisc/R/do.call2.R0000644000175100001440000000207712644315506013365 0ustar hornikusers#' Execute a function call similar to \code{do.call}. #' #' This function is supposed to be a replacement for \code{\link[base]{do.call}} in situations #' where you need to pass big R objects. #' Unlike \code{\link[base]{do.call}}, this function allows to pass objects via \code{...} #' to avoid a copy. #' #' @param fun [\code{character(1)}]\cr #' Name of the function to call. #' @param ... [any]\cr #' Arguments to \code{fun}. Best practice is to specify them in a \code{key = value} syntax. #' @param .args [\code{list}]\cr #' Arguments to \code{fun} as a (named) list. Will be passed after arguments in \code{...}. #' Default is \code{list()}. #' @return Return value of \code{fun}. #' @export #' @examples \dontrun{ #' library(microbenchmark) #' x = 1:1e7 #' microbenchmark(do.call(head, list(x, n = 1)), do.call2("head", x, n = 1)) #' } do.call2 = function(fun, ..., .args = list()) { assertString(fun) ddd = match.call(expand.dots = FALSE)$... expr = as.call(c(list(as.name(fun)), ddd, lapply(substitute(.args)[-1L], identity))) eval.parent(expr, n = 1L) } BBmisc/R/asMatrix.R0000644000175100001440000000222712644315506013554 0ustar hornikusers#' Extracts a named element from a list of lists. #' #' @param xs [\code{list}]\cr #' A list of vectors of the same length. #' @param row.names [\code{character} | \code{integer} | \code{NULL}]\cr #' Row names of result. #' Default is to take the names of the elements of \code{xs}. #' @param col.names [\code{character} | \code{integer} | \code{NULL}]\cr #' Column names of result. #' Default is to take the names of the elements of \code{xs}. #' @return [\code{matrix}]. #' @export asMatrixCols = function(xs, row.names, col.names) { assertList(xs) n = length(xs) if (n == 0L) return(matrix(0, nrow = 0L, ncol = 0L)) assertList(xs, types = "vector") m = unique(viapply(xs, length)) if (length(m) != 1L) stopf("Vectors must all be of the same length!") if (missing(row.names)) { row.names = names(xs[[1L]]) } if (missing(col.names)) { col.names = names(xs) } xs = unlist(xs) dim(xs) = c(m, n) rownames(xs) = row.names colnames(xs) = col.names return(xs) } #' @rdname asMatrixCols #' @export asMatrixRows = function(xs, row.names, col.names) { t(asMatrixCols(xs, row.names = col.names, col.names = row.names)) } BBmisc/R/messagef.R0000644000175100001440000000066012644315506013555 0ustar hornikusers#' Wrapper for message and sprintf. #' #' A simple wrapper for \code{message(sprintf(...))}. #' #' @param ... [any]\cr #' See \code{\link{sprintf}}. #' @param .newline [logical(1)]\cr #' Add a newline to the message. Default is \code{TRUE}. #' @return Nothing. #' @export #' @examples #' msg = "a message" #' warningf("this is %s", msg) messagef = function(..., .newline = TRUE) { message(sprintf(...), appendLF = .newline) } BBmisc/R/makeS3Obj.R0000644000175100001440000000076712644315506013551 0ustar hornikusers#' Simple constructor for S3 objects based on lists. #' #' Simple wrapper for \code{as.list} and \code{\link{setClasses}}. #' #' @param classes [\code{character}]\cr #' Class(es) for constructed object. #' @param ... [any]\cr #' Key-value pairs for class members. #' @return Object. #' @export #' @examples #' makeS3Obj("car", speed = 100, color = "red") makeS3Obj = function(classes, ...) { assertCharacter(classes, min.len = 1L, any.missing = FALSE) setClasses(list(...), classes = classes) } BBmisc/R/catf.R0000644000175100001440000000125612644315506012702 0ustar hornikusers#' Wrapper for cat and sprintf. #' #' A simple wrapper for \code{cat(sprintf(...))}. #' #' @param ... [any]\cr #' See \code{\link{sprintf}}. #' @param file [\code{character(1)}]\cr #' See \code{\link{cat}}. #' Default is \dQuote{}. #' @param append [\code{logical(1)}]\cr #' See \code{\link{cat}}. #' Default is \code{FALSE}. #' @param newline [\code{logical(1)}]\cr #' Append newline at the end? #' Default is \code{TRUE}. #' @return Nothing. #' @export #' @examples #' msg = "a message." #' catf("This is %s", msg) catf = function(..., file = "", append = FALSE, newline = TRUE) { cat(sprintf(...), ifelse(newline, "\n", ""), sep = "", file = file, append = append) } BBmisc/R/setValue.R0000644000175100001440000000136612644315506013557 0ustar hornikusers#' Set a list element to a new value. #' #' This wrapper supports setting elements to \code{NULL}. #' #' @param obj [\code{list}]\cr #' @param index [\code{character} | \code{integer}]\cr #' Index or indices where to insert the new values. #' @param newval [any]\cr #' Inserted elements(s). #' Has to be a list if \code{index} is a vector. #' @return [\code{list}] #' @export setValue = function(obj, index, newval) { assertList(obj) assert(checkCharacter(index, any.missing = FALSE), checkIntegerish(index, any.missing = FALSE)) if (length(index) == 1L) { if (is.null(newval)) obj[index] = list(NULL) else obj[index] = newval } else { assertList(newval, len = length(index)) obj[index] = newval } return(obj) } BBmisc/R/dapply.R0000644000175100001440000000244712644315506013261 0ustar hornikusers#' Call \code{lapply} on an object and return a data.frame. #' #' Applies a function \code{fun} on each element of input \code{x} #' and combines the results as \code{data.frame} columns. #' The results will get replicated to have equal length #' if necessary and possible. #' #' @param x [\code{data.frame}]\cr #' Data frame. #' @param fun [\code{function}]\cr #' The function to apply. #' @param ... [any]\cr #' Further arguments passed down to \code{fun}. #' @param col.names [\code{character(1)}]\cr #' Column names for result. #' Default are the names of \code{x}. #' @export #' @return [\code{data.frame}]. dapply = function(x, fun, ..., col.names) { assertFunction(fun) x = lapply(x, fun, ...) if (missing(col.names)) { ns = names2(x) missing = which(is.na(ns)) if (length(missing)) names(x) = replace(ns, missing, paste0("Var.", missing)) } else { assertCharacter(col.names, len = length(x), any.missing = FALSE) names(x) = col.names } n = unique(viapply(x, length)) if (length(n) > 1L) { max.n = max(n) if (any(max.n %% n)) stop("Arguments imply differing number of rows: ", collapse(n, ", ")) x = lapply(x, rep_len, length.out = max.n) n = max.n } attr(x, "row.names") = seq_len(n) attr(x, "class") = "data.frame" return(x) } BBmisc/R/vapply.R0000644000175100001440000000245312644315506013300 0ustar hornikusers#' Apply a function with a predefined return value #' #' @description #' These are just wrappers around \code{\link[base]{vapply}} with #' argument \code{FUN.VALUE} set. #' The function is expected to return a single \code{logical}, \code{integer}, #' \code{numeric} or \code{character} value, depending on the second letter #' of the function name. #' #' @param x [\code{vector} or \code{list}]\cr #' Object to apply function on. #' @param fun [\code{function}]\cr #' Function to apply on each element of \code{x}. #' @param ... [\code{ANY}]\cr #' Additional arguments for \code{fun}. #' @param use.names [\code{logical(1)}]\cr #' Should result be named? #' Default is \code{TRUE}. #' @export vlapply = function(x, fun, ..., use.names = TRUE) { vapply(X = x, FUN = fun, ..., FUN.VALUE = NA, USE.NAMES = use.names) } #' @rdname vlapply #' @export viapply = function(x, fun, ..., use.names = TRUE) { vapply(X = x, FUN = fun, ..., FUN.VALUE = NA_integer_, USE.NAMES = use.names) } #' @rdname vlapply #' @export vnapply = function(x, fun, ..., use.names = TRUE) { vapply(X = x, FUN = fun, ..., FUN.VALUE = NA_real_, USE.NAMES = use.names) } #' @rdname vlapply #' @export vcapply = function(x, fun, ..., use.names = TRUE) { vapply(X = x, FUN = fun, ..., FUN.VALUE = NA_character_, USE.NAMES = use.names) } BBmisc/R/toRangeStr.R0000644000175100001440000000215012644315506014047 0ustar hornikusers#' Convert a numerical vector into a range string. #' #' @param x [\code{integer}]\cr #' Vector to convert into a range string. #' @param range.sep [\code{character(1)}]\cr #' Separator between the first and last element of a range of consecutive #' elements in \code{x}. #' Default is \dQuote{ - }. #' @param block.sep [\code{character(1)}]\cr #' Separator between non consecutive elements of \code{x} or ranges. #' Default is \dQuote{, }. #' @return [\code{character(1)}] #' @examples #' x = sample(1:10, 7) #' toRangeStr(x) #' @export toRangeStr = function(x, range.sep = " - ", block.sep = ", ") { if (testIntegerish(x)) x = as.integer(x) else assertNumeric(x, any.missing = FALSE) assertString(range.sep) assertString(block.sep) findRange = function(x) seq_len(max(which(x == x[1L] + 0:(length(x)-1L)))) x = sort(unique(x)) x = unname(split(x, c(0L, cumsum(diff(x) > 1L)))) combine = function(x) if (length(x) == 1L) as.character(x) else sprintf("%i%s%i", x[1L], range.sep, x[length(x)]) collapse(vapply(x, combine, character(1L), USE.NAMES = FALSE), block.sep) } BBmisc/R/rowLapply.R0000644000175100001440000000454412644315506013761 0ustar hornikusers#' Apply function to rows of a data frame. #' #' Just like an \code{\link[base]{lapply}} on data frames, #' but on the rows. #' #' @param df [\code{data.frame}]\cr #' Data frame. #' @param fun [\code{function}]\cr #' Function to apply. Rows are passed as list or vector, #' depending on argument \code{unlist}, as first argument. #' @param ... [\code{ANY}]\cr #' Additional arguments for \code{fun}. #' @param unlist [\code{logical(1)}]\cr #' Unlist the row? Note that automatic conversion may be triggered for #' lists of mixed data types #' Default is \code{FALSE}. #' @param simplify [\code{logical(1)} | character(1)]\cr #' Should the result be simplified? #' See \code{\link{sapply}}. #' If \dQuote{cols}, we expect the call results to be vectors of the same length and they are #' arranged as the columns of the resulting matrix. #' If \dQuote{rows}, likewise, but rows of the resulting matrix. #' Default is \code{TRUE}. #' @param use.names [\code{logical(1)}]\cr #' Should result be named by the row names of \code{df}? #' Default is \code{TRUE}. #' @return [\code{list} or simplified object]. Length is \code{nrow(df)}. #' @export #' @examples #' rowLapply(iris, function(x) x$Sepal.Length + x$Sepal.Width) rowLapply = function(df, fun, ..., unlist = FALSE) { assertDataFrame(df) fun = match.fun(fun) assertFlag(unlist) if (unlist) { .wrap = function(.i, .df, .fun, ...) .fun(unlist(.df[.i, , drop = FALSE], recursive = FALSE, use.names = TRUE), ...) } else { .wrap = function(.i, .df, .fun, ...) .fun(as.list(.df[.i, , drop = FALSE]), ...) } lapply(seq_row(df), .wrap, .fun = fun, .df = df, ...) } #' @export #' @rdname rowLapply rowSapply = function(df, fun, ..., unlist = FALSE, simplify = TRUE, use.names = TRUE) { assert(checkFlag(simplify), checkChoice(simplify, c("cols", "rows"))) assertFlag(use.names) ys = rowLapply(df, fun, ..., unlist = unlist) # simplify result if (length(ys) > 0L) { if (isTRUE(simplify)) { ys = simplify2array(ys) } else if (simplify == "rows") { ys = asMatrixRows(ys) } else if (simplify == "cols") { ys = asMatrixCols(ys) } } # set names if (use.names) { if (is.matrix(ys)) { colnames(ys) = rownames(df) rownames(ys) = NULL } else { names(ys) = rownames(df) } } else { names(ys) = NULL } return(ys) } BBmisc/R/system3.R0000644000175100001440000000434012644315506013371 0ustar hornikusers#' Wrapper for system2 with better return type and errorhandling. #' #' Wrapper for \code{\link{system2}} with better return type and errorhandling. #' #' @param command See \code{\link{system2}}. #' @param args See \code{\link{system2}}. #' @param stdout See \code{\link{system2}}. #' @param stderr See \code{\link{system2}}. #' @param wait See \code{\link{system2}}. #' @param ... Further arguments passed to \code{\link{system2}}. #' @param stop.on.exit.code [\code{logical(1)}]\cr #' Should an exception be thrown if an exit code greater 0 is generated? #' Can only be used if \code{wait} is \code{TRUE}. #' Default is \code{wait}. #' @return [\code{list}]. #' \item{exit.code [integer(1)]}{Exit code of command. Given if wait is \code{TRUE}, otherwise \code{NA}. 0L means success. 127L means command was not found} #' \item{output [character]}{Output of command on streams. Only given is \code{stdout} or \code{stderr} was set to \code{TRUE}, otherwise \code{NA}.} #' @export system3 = function(command, args = character(0L), stdout = "", stderr = "", wait = TRUE, ..., stop.on.exit.code = wait) { if (stop.on.exit.code && !wait) stopf("stop.on.exit.code is TRUE but wait is FALSE!") output = NA_character_ if (isTRUE(stdout) || isTRUE(stderr)) { wait = TRUE # here we wait anyway and output of cmd is returned ec = 0L suppressWarnings({ withCallingHandlers({ op = system2(command = command, args = args, stdout = stdout, stderr = stderr, wait = wait, ...) }, warning = function(w) { g = gregexpr("\\d+", w$message)[[1L]] start = tail(g, 1L) len = tail(attr(g, "match.length"), 1L) ec <<- as.integer(substr(w$message, start, start + len - 1L)) }) }) } else { ec = system2(command = command, args = args, stdout = stdout, stderr = stderr, wait = wait, ...) } if (wait) { if (isTRUE(stdout) || isTRUE(stderr)) output = op } if (stop.on.exit.code && ec > 0L) { args = collapse(args, " ") if (length(output) == 0L) output = "" else output = collapse(output, "\n") stopf("Command: %s %s; exit code: %i; output: %s", command, args, ec, output) } list(exit.code = ec, output = output) } BBmisc/R/getFirstLast.R0000644000175100001440000000055612644315506014402 0ustar hornikusers#' Get the first/last element of a list/vector. #' #' @param x [\code{list} | \code{vector}]\cr #' The list or vector. #' @return Selected element. The element name is dropped. #' @export getFirst = function(x) { assertVector(x, min.len = 1L) x[[1L]] } #' @rdname getFirst #' @export getLast = function(x) { assertVector(x, min.len = 1L) x[[length(x)]] } BBmisc/R/argsAsNamedList.R0000644000175100001440000000117112644315506015002 0ustar hornikusers#' Parses \code{...} arguments to a named list. #' #' The deparsed name will be used for arguments with missing names. #' Missing names will be set to \code{NA}. #' #' @param ... #' Arbitrary number of objects. #' @return [\code{list}]: Named list with objects. #' @export #' @examples #' z = 3 #' argsAsNamedList(x = 1, y = 2, z) argsAsNamedList = function(...) { args = list(...) ns = names2(args) ns.missing = is.na(ns) if (any(ns.missing)) { ns.sub = as.character(substitute(deparse(...)))[-1L] ns[ns.missing] = ns.sub[ns.missing] } setNames(args, replace(ns, ns %in% c("NA", "NULL", ""), NA_character_)) } BBmisc/R/getAttributeNames.R0000644000175100001440000000044312644315506015411 0ustar hornikusers#' Helper function for determining the vector of attribute names #' of a given object. #' #' @param obj [any]\cr #' Source object. #' @return [\code{character}] #' Vector of attribute names for the source object. #' @export getAttributeNames = function(obj) { names(attributes(obj)) } BBmisc/R/setClasses.R0000644000175100001440000000046312644315506014075 0ustar hornikusers#' A wrapper for \code{class(x) = classes}. #' #' @param x [any]\cr #' Your object. #' @param classes [\code{character}]\cr #' New classes. #' @return Changed object \code{x}. #' @export #' @examples #' setClasses(list(), c("foo1", "foo2")) setClasses = function(x, classes) { class(x) = classes x } BBmisc/R/suppressAll.R0000644000175100001440000000114512644315506014277 0ustar hornikusers#' Suppresses all output except for errors. #' #' Evaluates an expression and suppresses all output except for errors, #' meaning: prints, messages, warnings and package startup messages. #' #' @param expr [valid R expression]\cr #' Expression. #' @return Return value of expression invisibly. #' @export #' @examples #' suppressAll({ #' print("foo") #' message("foo") #' warning("foo") #' }) suppressAll = function(expr) { capture.output({ z = suppressWarnings( suppressMessages( suppressPackageStartupMessages(force(expr)) ) ) }) invisible(z) } BBmisc/R/explode.R0000644000175100001440000000113412644315506013420 0ustar hornikusers#' Split up a string into substrings. #' #' Split up a string into substrings according to a seperator. #' #' @param x [\code{character}]\cr #' Source string. #' @param sep [\code{character}]\cr #' Seperator whcih is used to split \code{x} into substrings. #' Default is \dQuote{ }. #' @return [\code{vector}] #' Vector of substrings. #' @export #' @examples #' explode("foo bar") #' explode("comma,seperated,values", sep = ",") explode = function(x, sep = " ") { assertString(x) assertString(sep) #FIXME: why perl? x.exploded = strsplit(x, sep, perl = TRUE) return(x.exploded[[1L]]) } BBmisc/R/convertInteger.R0000644000175100001440000000274712644315506014771 0ustar hornikusers#' Conversion for single integer. #' #' Convert single numeric to integer only if the numeric represents a single integer, #' e.g. 1 to 1L. #' Otherwise the argument is returned unchanged. #' #' @param x [any]\cr #' Argument. #' @return Either a single integer if conversion was done or \code{x} unchanged. #' @export #' @examples #' str(convertInteger(1.0)) #' str(convertInteger(1.3)) #' str(convertInteger(c(1.0, 2.0))) #' str(convertInteger("foo")) convertInteger = function(x) { if (is.integer(x) || length(x) != 1L) return(x) if (is.na(x)) return(as.integer(x)) if (is.numeric(x)) { xi = as.integer(x) if (isTRUE(all.equal(x, xi))) return(xi) } return(x) } #' Conversion for integer vector. #' #' Convert numeric vector to integer vector if the numeric vector fully represents #' an integer vector, #' e.g. \code{c(1, 5)} to \code{c(1L, 5L)}. #' Otherwise the argument is returned unchanged. #' #' @param x [any]\cr #' Argument. #' @return Either an integer vector if conversion was done or \code{x} unchanged. #' @export #' @examples #' str(convertIntegers(1.0)) #' str(convertIntegers(1.3)) #' str(convertIntegers(c(1.0, 2.0))) #' str(convertIntegers("foo")) convertIntegers = function(x) { if (is.integer(x)) return(x) if (length(x) == 0L || (is.atomic(x) && all(is.na(x)))) return(as.integer(x)) if (is.numeric(x)) { xi = as.integer(x) if (isTRUE(all.equal(x, xi, check.names = FALSE))) return(setNames(xi, names(x))) } return(x) } BBmisc/R/collapsef.R0000644000175100001440000000062212644315506013731 0ustar hornikusers#' Collapse vector to string. #' #' A simple wrapper for \code{collapse(sprintf, ...)}. #' #' Useful for vectorized call to \code{\link{sprintf}}. #' #' @param ... [any]\cr #' See \code{\link{sprintf}}. #' @param sep [\code{character(1)}]\cr #' See \code{\link{collapse}}. #' @return [\code{character(1)}]. #' @export collapsef = function(..., sep = ",") { paste0(sprintf(...), collapse = sep) } BBmisc/R/convertListOfRowsToDataFrame.R0000644000175100001440000000404612644315506017511 0ustar hornikusers#' Convert a list of row-vectors of equal structure to a data.frame. #' #' Elements are arranged in columns according to their name in each #' element of \code{rows}. Missing values are filled using NAs. #' #' @param rows [\code{list}]\cr #' List of rows. Each row is a list or vector of the same structure. #' That means all rows must have the same length and all corresponding elements must have the #' same class. #' @param strings.as.factors [\code{logical(1)}]\cr #' Convert character columns to factors? #' Default is \code{default.stringsAsFactors()}. #' @param row.names [\code{character} | \code{integer} | \code{NULL}]\cr #' Row names for result. #' By default the names of the list \code{rows} are taken. #' @param col.names [\code{character} | \code{integer}]\cr #' Column names for result. #' By default the names of an element of \code{rows} are taken. #' @return [\code{data.frame}]. #' @export #' @examples #' convertListOfRowsToDataFrame(list(list(x = 1, y = "a"), list(x = 2, y = "b"))) convertListOfRowsToDataFrame = function(rows, strings.as.factors = default.stringsAsFactors(), row.names, col.names) { assertList(rows) assertList(rows, types = "vector") if (!length(rows)) return(makeDataFrame(0L, 0L)) assertFlag(strings.as.factors) if (missing(row.names)) row.names = names(rows) # make names rows = lapply(rows, function(x) setNames(x, make.names(names2(x, ""), unique = TRUE))) cols = unique(unlist(lapply(rows, names2))) if (anyMissing(cols)) stop("All row elements must be named") if (!length(cols)) return(makeDataFrame(length(rows), 0L)) extract = function(cn) { tmp = lapply(rows, function(x) if (is.list(x)) x[[cn]] else unname(x[cn])) if (any(viapply(tmp, length) > 1L)) stop("Rows may only contain a single value per name") simplify2array(replace(tmp, vlapply(tmp, is.null), NA)) } d = data.frame(setNames(lapply(cols, extract), cols), row.names = row.names, stringsAsFactors = strings.as.factors) if (!missing(col.names)) colnames(d) = col.names return(d) } BBmisc/R/nin.R0000644000175100001440000000043512644315506012547 0ustar hornikusers#' Simply a negated \code{in} operator. #' #' @param x [\code{vector}]\cr #' Values that should not be in \code{y}. #' @param y [\code{vector}]\cr #' Values to match against. #' @usage x \%nin\% y #' @rdname nin #' @export `%nin%` = function(x, y) { !match(x, y, nomatch = 0L) } BBmisc/R/requirePackages.R0000644000175100001440000001024712644315506015100 0ustar hornikusers#' @title Require some packages. #' #' @description #' Packages are loaded either via \code{\link{requireNamespace}} or \code{\link{require}}. #' #' If some packages could not be loaded and \code{stop} is \code{TRUE} #' the following exception is thrown: #' \dQuote{For please install the following packages: }. #' If \code{why} is \code{NULL} the message is: #' \dQuote{Please install the following packages: }. #' #' @param packs [\code{character}]\cr #' Names of packages. #' If a package name is prefixed with \dQuote{!}, it will be attached using \code{\link[base]{require}}. #' If a package name is prefixed with \dQuote{_}, its namespace will be loaded using \code{\link[base]{requireNamespace}}. #' If there is no prefix, argument \code{default.method} determines how to deal with package loading. #' @param min.versions [\code{character}]\cr #' A char vector specifying required minimal version numbers for a subset of packages in \code{packs}. #' Must be named and all names must be in \code{packs}. #' The only exception is when \code{packs} is only a single string, then you are allowed to pass #' an unnamed version string here. #' Default is \code{NULL}, meaning no special version requirements #' @param why [\code{character(1)}]\cr #' Short string explaining why packages are required. #' Default is an empty string. #' @param stop [\code{logical(1)}]\cr #' Should an exception be thrown for missing packages? #' Default is \code{TRUE}. #' @param suppress.warnings [\code{logical(1)}]\cr #' Should warnings be supressed while requiring? #' Default is \code{FALSE}. #' @param default.method [\code{character(1)}]\cr #' If the packages are not explicitly prefixed with \dQuote{!} or \dQuote{_}, #' this arguments determines the default. Possible values are \dQuote{attach} and #' \dQuote{load}. #' Note that the default is \dQuote{attach}, but this might/will change in a future version, so #' please make sure to always explicitly set this. #' @return [\code{logical}]. Named logical vector describing which packages could be loaded (with required version). #' Same length as \code{packs}. #' @export #' @examples #' requirePackages(c("BBmisc", "base"), why = "BBmisc example") requirePackages = function(packs, min.versions = NULL, why = "", stop = TRUE, suppress.warnings = FALSE, default.method = "attach") { assertCharacter(packs, any.missing = FALSE) if (!is.null(min.versions)) { assertCharacter(min.versions) if (length(packs) == 1L && length(min.versions) == 1L && is.null(names(min.versions))) names(min.versions) = packs else assertSubset(names(min.versions), packs) } assertFlag(stop) assertFlag(suppress.warnings) assertChoice(default.method, choices = c("load", "attach")) char = substr(packs, 1L, 1L) force.attach = (char == "!") force.load = (char == "_") ns.only = if (default.method == "load") !force.attach else force.load packs = substr(packs, 1L + (force.load | force.attach), nchar(packs)) suppressor = if (suppress.warnings) suppressWarnings else identity packs.ok = unlist(Map(function(pack, ns.only) { if (ns.only) { suppressor(requireNamespace(pack, quietly = TRUE)) } else { suppressor(require(pack, character.only = TRUE)) } }, pack = packs, ns.only = ns.only)) if (stop && !all(packs.ok)) { ps = collapse(packs[!packs.ok]) if (nzchar(why)) stopf("For %s please install the following packages: %s", why, ps) else stopf("Please install the following packages: %s", ps) } if (!is.null(min.versions)) { packs.wrong.version = character(0L) for (j in seq_along(min.versions)) { pn = names(min.versions)[j] mv = min.versions[j] if (packageVersion(pn) < mv) { packs.ok[pn] = FALSE packs.wrong.version = c(packs.wrong.version, sprintf("%s >= %s", pn, mv)) } } if (stop && length(packs.wrong.version) > 0L) { ps = collapse(packs.wrong.version) if (nzchar(why)) stopf("For %s the package version requirements are not fulfilled: %s", why, ps) else stopf("The package version requirements are not fulfilled: %s", ps) } } return(packs.ok) } BBmisc/R/isSuperset.R0000644000175100001440000000101612644315506014125 0ustar hornikusers#' Check superset relation on two vectors. #' #' @param x [\code{vector}]\cr #' Source vector. #' @param y [\code{vector}]\cr #' Vector of the same mode as \code{x}. #' @param strict [\code{logical(1)}]\cr #' Checks for strict/proper superset relation. #' @return [\code{logical(1)}] #' \code{TRUE} if each element of \code{y} is also contained in \code{x}, i. e., #' if \code{y} is a subset of \code{x} and \code{FALSE} otherwise. #' @export isSuperset = function(x, y, strict = FALSE) { isSubset(y, x, strict) } BBmisc/R/asQuoted.R0000644000175100001440000000103312644315506013543 0ustar hornikusers#' Converts a string into a quoted expression. #' #' Works the same as if you would have entered the expression and called #' \code{\link{quote}} on it. #' #' @param s [\code{character(1)}]\cr #' Expression as string. #' @param env [\code{numeric(1)}]\cr #' Environment for expression. #' Default is \code{parent.frame()} #' @return Quoted expression. #' @export #' @examples #' asQuoted("x == 3") asQuoted = function(s, env = parent.frame()) { assertString(s) structure(parse(text = s)[1L], env = env, class = "quoted")[[1L]] } BBmisc/R/normalize.R0000644000175100001440000000771212644315506013770 0ustar hornikusers#' @title Normalizes numeric data to a given scale. #' #' @description #' Currently implemented for numeric vectors, numeric matrices and data.frame. #' For matrixes one can operate on rows or columns #' For data.frames, only the numeric columns are touched, all others are left unchanged. #' For constant vectors / rows / columns most methods fail, special behaviour for this #' case is implemented. #' #' The method also handles NAs in in \code{x} and leaves them untouched. #' #' @param x [\code{numeric} | \code{matrix} | \code{data.frame}]\cr #' Input vector. #' @param method [\code{character(1)}]\cr #' Normalizing method. Available are:\cr #' \dQuote{center}: Subtract mean.\cr #' \dQuote{scale}: Divide by standard deviation.\cr #' \dQuote{standardize}: Center and scale.\cr #' \dQuote{range}: Scale to a given range.\cr #' @param range [\code{numeric(2)}]\cr #' Range for method \dQuote{range}. #' The first value represents the replacement for the min value, the second is the substitute for the max value. #' So it is possible to reverse the order by giving \code{range = c(1,0)}. #' Default is \code{c(0,1)}. #' @param margin [\code{integer(1)}]\cr #' 1 = rows, 2 = cols. #' Same is in \code{\link{apply}} #' Default is 1. #' @param on.constant [\code{character(1)}]\cr #' How should constant vectors be treated? Only used, of \dQuote{method != center}, #' since this methods does not fail for constant vectors. Possible actions are:\cr #' \dQuote{quiet}: Depending on the method, treat them quietly:\cr #' \dQuote{scale}: No division by standard deviation is done, input values. #' will be returned untouched.\cr #' \dQuote{standardize}: Only the mean is subtracted, no division is done.\cr #' \dQuote{range}: All values are mapped to the mean of the given range.\cr #' \dQuote{warn}: Same behaviour as \dQuote{quiet}, but print a warning message.\cr #' \dQuote{stop}: Stop with an error.\cr #' @return [\code{numeric} | \code{matrix} | \code{data.frame}]. #' @seealso \code{\link{scale}} #' @export normalize = function(x, method = "standardize", range = c(0, 1), margin = 1L, on.constant = "quiet") { assertChoice(method, c("range", "standardize", "center", "scale")) assertNumeric(range, len = 2L, any.missing = FALSE) assertChoice(on.constant, c("quiet", "warn", "stop")) UseMethod("normalize") } #' @export normalize.numeric = function(x, method = "standardize", range = c(0, 1), margin = 1L, on.constant = "quiet") { y = normalize2(x, method, range, on.constant = on.constant) # scale call below returns matrices if (is.matrix(y)) y = y[,1L] return(y) } #' @export normalize.matrix = function(x, method = "standardize", range = c(0, 1), margin = 1L, on.constant = "quiet") { x = apply(x, margin, normalize2, method = method, range = range, on.constant = on.constant) if (margin == 1L) x = t(x) return(x) } #' @export normalize.data.frame = function(x, method = "standardize", range = c(0, 1), margin = 1L, on.constant = "quiet") { isnum = sapply(x, is.numeric) if (any(isnum)) x[, isnum] = as.data.frame(lapply(x[, isnum, drop = FALSE], normalize2, method = method, range = range, on.constant = on.constant)) return(x) } normalize2 = function(x, method, range, on.constant) { # is x a constant vector? if (length(unique(x[!is.na(x)])) == 1L) { switch(on.constant, warn = warning("Constant vector in normalization."), stop = stop("Constant vector in normalization.")) switch(method, center = scale(x, center = TRUE, scale = FALSE), range = ifelse(is.na(x), NA, mean(range)), standardize = scale(x, center = TRUE, scale = FALSE), scale = x ) } else { switch(method, range = (x - min(x, na.rm = TRUE)) / diff(range(x, na.rm = TRUE)) * diff(range) + range[1L], standardize = scale(x, center = TRUE, scale = TRUE), center = scale(x, center = TRUE, scale = FALSE), scale = scale(x, center = FALSE, scale = sd(x, na.rm = TRUE)) ) } } BBmisc/R/strrepeat.R0000644000175100001440000000064512644315506013777 0ustar hornikusers#' Repeat and join a string #' #' @param x [character]\cr #' Vector of characters. #' @param n [\code{integer(1)}]\cr #' Times the vector \code{x} is repeated. #' @param sep [\code{character(1)}]\cr #' Separator to use to collapse the vector of characters. #' @return \code{character(1)}. #' @export #' @examples #' strrepeat("x", 3) strrepeat = function(x, n, sep = "") { paste0(rep.int(x, n), collapse = sep) } BBmisc/R/printStrToChar.R0000644000175100001440000000100412644315506014702 0ustar hornikusers#' Print \code{str(x)} of an object to a string / character vector. #' #' @param x [any]\cr #' Object to print #' @param collapse [\code{character(1)}]\cr #' Used to collapse multiple lines. #' \code{NULL} means no collapsing, vector is returned. #' Default is \dQuote{\\n}. #' @return [\code{character}]. #' @export #' @examples #' printStrToChar(iris) printStrToChar = function(x, collapse = "\n") { d = printToChar(str(x), collapse = NULL) # remove NULL from str collapse(d[-length(d)], collapse) } BBmisc/R/filterNull.R0000644000175100001440000000027412644315506014104 0ustar hornikusers#' Filter a list for NULL values #' #' @param li [\code{list}]\cr #' List. #' @return [\code{list}]. #' @export filterNull = function(li) { assertList(li) li[!vlapply(li, is.null)] } BBmisc/R/getOperatingSystem.R0000644000175100001440000000211212644315506015612 0ustar hornikusers#' Functions to determine the operating system. #' #' \itemize{ #' \item{getOperatingSystem}{Simple wrapper for \code{.Platform$OS.type}, returns \code{character(1)}.} #' \item{isUnix}{Predicate for OS string, returns \code{logical(1)}. Currently this would include Unix, Linux and Mac flavours.} #' \item{isLinux}{Predicate for sysname string, returns \code{logical(1)}.} #' \item{isDarwin}{Predicate for sysname string, returns \code{logical(1)}.} #' \item{isWindows}{Predicate for OS string, returns \code{logical(1)}.} #' } #' #' @return See above. #' @export getOperatingSystem = function() { .Platform$OS.type } #' @rdname getOperatingSystem #' @export isWindows = function() { .Platform$OS.type == "windows" } #' @rdname getOperatingSystem #' @export isUnix = function() { .Platform$OS.type == "unix" } #' @rdname getOperatingSystem #' @export isLinux = function() { isUnix() && grepl("linux", Sys.info()["sysname"], ignore.case = TRUE) } #' @rdname getOperatingSystem #' @export isDarwin = function() { isUnix() && grepl("darwin", Sys.info()["sysname"], ignore.case = TRUE) } BBmisc/R/capitalizeStrings.R0000644000175100001440000000301212644315506015454 0ustar hornikusers#' @title Capitalize strings in a vector #' #' @description #' Capitalise first word or all words of a character vector. #' Lower back of vector element or word, respectively. #' #' @param x [\code{character(n)}]\cr #' Vector of character elements to capitalize. #' @param all.words [\code{logical(1)}]\cr #' If \code{TRUE} all words of each vector element are capitalized. #' \code{FALSE} capitalizes the first word of each vector element. #' @param lower.back [\code{logical(1)}]\cr #' \code{TRUE} lowers the back of each word or vector element (depends on \code{all.words}). #' @return Capitalized vector: [\code{character(n)}]. #' @export #' @examples #' capitalizeStrings(c("the taIl", "wags The dOg", "That looks fuNny!")) #' capitalizeStrings(c("the taIl", "wags The dOg", "That looks fuNny!") #' , all.words = TRUE, lower.back = TRUE) capitalizeStrings = function(x, all.words = FALSE, lower.back = FALSE) { assertCharacter(x) assertLogical(all.words, any.missing = FALSE, len = 1L) assertLogical(lower.back, any.missing = FALSE, len = 1L) if (all.words) { pattern = "([[:alnum:]])([[:alnum:]]*)" replacement = "\\U\\1" if (lower.back) { replacement = paste0(replacement, "\\L\\2") } else { replacement = paste0(replacement, "\\E\\2") } } else { pattern = "^([[:alnum:]])" replacement = "\\U\\1" if (lower.back) { pattern = paste0(pattern, "(.*)") replacement = paste0(replacement, "\\L\\2") } } return(gsub(pattern, replacement, x, perl = TRUE)) } BBmisc/R/collapse.R0000644000175100001440000000071212644315506013563 0ustar hornikusers#' Collapse vector to string. #' #' A simple wrapper for \code{paste(x, collapse)}. #' #' @param x [\code{vector}]\cr #' Vector to collapse. #' @param sep [\code{character(1)}]\cr #' Passed to \code{collapse} in \code{\link{paste}}. #' Default is \dQuote{,}. #' @return [\code{character(1)}]. #' @export #' @examples #' collapse(c("foo", "bar")) #' collapse(c("foo", "bar"), sep = ";") collapse = function(x, sep = ",") { paste0(x, collapse = sep) } BBmisc/R/hasAttributes.R0000644000175100001440000000071612644315506014607 0ustar hornikusers#' Check if given object has certain attributes. #' #' @param obj [mixed]\cr #' Arbitrary R object. #' @param attribute.names [\code{character}]\cr #' Vector of strings, i.e., attribute names. #' @return [\code{logical(1)}] #' \code{TRUE} if object \code{x} contains all attributes from \code{attributeNames} #' and \code{FALSE} otherwise. #' @export hasAttributes = function(obj, attribute.names) { isSubset(attribute.names, getAttributeNames(obj)) } BBmisc/R/chunk.R0000644000175100001440000000523412644315506013075 0ustar hornikusers#' Chunk elements of vectors into blocks of nearly equal size. #' #' In case of shuffling and vectors that cannot be chunked evenly, #' it is chosen randomly which levels / chunks will receive 1 element less. #' If you do not shuffle, always the last chunks will receive 1 element less. #' #' @param x [ANY]\cr #' Vector, list or other type supported by \code{\link[base]{split}}. #' @param chunk.size [\code{integer(1)}]\cr #' Requested number of elements in each chunk. #' Cannot be used in combination with \code{n.chunks} or \code{props}. #' If \code{x} cannot be evenly chunked, some chunks will have less elements. #' @param n.chunks [\code{integer(1)}]\cr #' Requested number of chunks. #' If more chunks than elements in \code{x} are requested, empty chunks are #' dropped. #' Can not be used in combination with \code{chunks.size} or \code{props}. #' @param props [\code{numeric}]\cr #' Vector of proportions for chunk sizes. #' Empty chunks may occur, depending on the length of \code{x} and the given #' proportions. #' Cannot be used in combination with \code{chunks.size} or \code{n.chunks}. #' @param shuffle [\code{logical(1)}]\cr #' Shuffle \code{x}? #' Default is \code{FALSE}. #' @return [unnamed \code{list}] of chunks. #' @export #' @examples #' xs = 1:10 #' chunk(xs, chunk.size = 3) #' chunk(xs, n.chunks = 2) #' chunk(xs, n.chunks = 2, shuffle = TRUE) #' chunk(xs, props = c(7, 3)) chunk = function(x, chunk.size, n.chunks, props, shuffle = FALSE) { assertFlag(shuffle) method = c("chunk.size", "n.chunks", "props") method = method[!c(missing(chunk.size), missing(n.chunks), missing(props))] if (length(method) != 1L) stop("You must provide exactly one of 'chunk.size', 'n.chunks' or 'props'") nx = length(x) ch = switch(method, chunk.size = { chunk.size = convertInteger(chunk.size) assertCount(chunk.size, positive = TRUE) getNChunks(nx, nx %/% chunk.size + (nx %% chunk.size > 0L), shuffle) }, n.chunks = { n.chunks = convertInteger(n.chunks) assertCount(n.chunks, positive = TRUE) getNChunks(nx, n.chunks, shuffle) }, props = { assertNumeric(props, min.len = 1L, any.missing = FALSE, lower = 0) props = props / sum(props) ch = factor(rep.int(seq_along(props), round(props * nx, digits = 0L)), levels = seq_along(props)) if (shuffle) sample(ch) else ch }) unname(split(x, ch)) } getNChunks = function(nx, n.chunks, shuffle) { n.chunks = min(n.chunks, nx) if (shuffle) { c(sample(seq(0L, (nx %/% n.chunks) * n.chunks - 1L) %% n.chunks), sample(n.chunks, nx %% n.chunks) - 1L) } else { sort(seq.int(0L, nx - 1L) %% n.chunks) } } BBmisc/R/isValidName.R0000644000175100001440000000140012644315506014150 0ustar hornikusers#' Can some strings be used for column or list element names without problems? #' #' @param x [\code{character}]\cr #' Character vector to check. #' @param unique [\code{logical(1)}]\cr #' Should the names be unique? #' Default is \code{TRUE}. #' @return [\code{logical}]. One Boolean entry for each string in \code{x}. #' If the entries are not unique and \code{unique} is enabled, the first duplicate will #' be \code{FALSE}. #' @export isValidName = function(x, unique = TRUE) { if (!is.character(x)) x = as.character(x) # check that make.names does not change the string (otherwise it would be invalid), # names are unique (for e.g. colnames) and stuff like ..1 is disallowed x == make.names(x, isTRUE(unique)) & !grepl("^\\.\\.[0-9]$", x) } BBmisc/R/makeSimpleFileLogger.R0000644000175100001440000000502712741010551016002 0ustar hornikusers#' Simple logger which outputs to a file. #' #' Creates a simple file logger closure to log to a file, including time stamps. #' An optional buffer holds the last few log messages. #' #' @param logfile [\code{character(1)}]\cr #' File to log to. #' @param touch [\code{logical(1)}]\cr #' Should the file be created before the first log message? #' Default is \code{FALSE}. #' @param keep [\code{integer(1)}]\cr #' Number of log messages to keep in memory for quick access. #' Default is \code{10}. #' @return [\code{\link{SimpleFileLogger}}]. A list with following functions: #' \item{log [\code{function(msg)}]}{Send log message.} #' \item{getMessages [\code{function(n)}]}{Get last \code{n} log messages.} #' \item{clear [\code{function()}]}{Resets logger and deletes log file.} #' \item{getSize [\code{function()}]}{Returns the number of logs written.} #' \item{getLogfile [\code{function()}]}{Returns the full file name logs are written to.} #' @export #' @aliases SimpleFileLogger makeSimpleFileLogger = function(logfile, touch = FALSE, keep = 10L) { assertString(logfile) assertFlag(touch) keep = asCount(keep) assertDirectoryExists(dirname(logfile), "w") if (touch && !file.create(logfile)) stopf("Could not create file '%s'", logfile) if (keep) buffer = circularBuffer("character", keep) n.lines = 0L makeS3Obj("SimpleFileLogger", log = function(msg) { if (keep) buffer$push(msg) if (!touch && n.lines == 0L && !file.create(logfile)) stopf("Could not create file '%s'", logfile) catf("<%s> %s", as.character(Sys.time()), msg, file = logfile, append = TRUE, newline = TRUE) n.lines <<- n.lines + 1L }, getMessages = function(n) { if (!keep || n > keep) return(sub("^<.+> (.*)", "\\1", tail(readLines(logfile), n))) buffer$get(n) }, clear = function() { if (keep) buffer$clear() n.lines <<- 0L file.remove(logfile) }, getSize = function() { n.lines }, getLogfile = function() { logfile } ) } circularBuffer = function(type, capacity) { st = vector(type, capacity) stored = 0L pos = 0L list( push = function(x) { pos <<- pos %% capacity + 1L stored <<- min(capacity, stored + 1L) st[[pos]] <<- x }, get = function(n = 1L) { head(st[rev((seq_len(stored) + pos - 1L) %% stored + 1L)], n) }, stored = function() { stored }, clear = function() { st <<- vector(type, capacity) stored <<- 0 pos <<- 0 } ) } BBmisc/R/lib.R0000644000175100001440000000143312644315506012530 0ustar hornikusers#' A wrapper for \code{library}. #' #' Tries to load packages. If the packages are not found, they will be installed from #' the default repository. This function is intended for use in interactive sessions #' and should not be used by other packages. #' #' @param ... [any]\cr #' Package names. #' @return [\code{logical}]: Named logical vector determining the success #' of package load. #' @export #' @examples \dontrun{ #' lib("BBmisc", "MASS", "rpart") #' } lib = function(...) { getLib = function(pkg) { ok = suppressWarnings(require(pkg, character.only = TRUE)) if (!ok && !is.error(try(install.packages(pkg)))) { ok = require(pkg, character.only = TRUE) } ok } pkgs = unique(c(...)) assertCharacter(pkgs, any.missing = FALSE) vlapply(pkgs, getLib) } BBmisc/R/printToChar.R0000644000175100001440000000117212644315506014217 0ustar hornikusers#' Prints object to a string / character vector. #' #' @param x [any]\cr #' Object to print #' @param collapse [\code{character(1)}]\cr #' Used to collapse multiple lines. #' \code{NULL} means no collapsing, vector is returned. #' Default is \dQuote{\\n}. #' @return [\code{character}]. #' @export #' @examples #' x = data.frame(a = 1:2, b = 3:4) #' str(printToChar(x)) printToChar = function(x, collapse = "\n") { rval = NULL con = textConnection("rval", "w", local = TRUE) sink(con) on.exit({ sink() close(con) }) print(x) if (!is.null(collapse)) paste(rval, collapse = collapse) else rval } BBmisc/R/convertDataFrameCols.R0000644000175100001440000000274612644315506016040 0ustar hornikusers#' Converts columns in a data frame to characters, factors or numerics. #' #' @param df [\code{data.frame}]\cr #' Data frame. #' @param chars.as.factor [\code{logical(1)}]\cr #' Should characters be converted to factors? #' Default is \code{FALSE}. #' @param factors.as.char [\code{logical(1)}]\cr #' Should characters be converted to factors? #' Default is \code{FALSE}. #' @param ints.as.num [\code{logical(1)}]\cr #' Should integers be converted to numerics? #' Default is \code{FALSE}. #' @param logicals.as.factor [\code{logical(1)}]\cr #' Should logicals be converted to factors? #' Default is \code{FALSE}. #' @export #' @return [\code{data.frame}]. convertDataFrameCols = function(df, chars.as.factor = FALSE, factors.as.char = FALSE, ints.as.num = FALSE, logicals.as.factor = FALSE) { assertDataFrame(df) assertFlag(chars.as.factor) assertFlag(factors.as.char) assertFlag(ints.as.num) assertFlag(logicals.as.factor) df = x = as.list(df) if (chars.as.factor) { i = vlapply(df, is.character) if (any(i)) x[i] = lapply(x[i], factor) } if (factors.as.char) { i = vlapply(df, is.factor) if (any(i)) x[i] = lapply(x[i], as.character) } if (ints.as.num) { i = vlapply(df, is.integer) if (any(i)) x[i] = lapply(x[i], as.double) } if (logicals.as.factor) { i = vlapply(df, is.logical) if (any(i)) x[i] = lapply(x[i], factor, levels = c("TRUE", "FALSE")) } as.data.frame(x, stringsAsFactors = FALSE) } BBmisc/R/warningf.R0000644000175100001440000000160612644315506013577 0ustar hornikusers#' Wrapper for warning and sprintf. #' #' A wrapper for \code{\link{warning}} with \code{\link{sprintf}} applied to the arguments. #' #' @param ... [any]\cr #' See \code{\link{sprintf}}. #' @param immediate [\code{logical(1)}]\cr #' See \code{\link{warning}}. #' Default is \code{TRUE}. #' @param warning.length [\code{integer(1)}]\cr #' Number of chars after which the warning message #' gets truncated, see ?options. #' Default is 8170. #' @return Nothing. #' @export #' @examples #' msg = "a warning" #' warningf("this is %s", msg) warningf = function(..., immediate = TRUE, warning.length = 8170L) { msg = sprintf(...) if (immediate) { old = getOption("warn") # dont change warn setting if it is 2 (= error) if (old <= 0L) { on.exit(options(warn = old)) options(warn = 1L) } } obj = simpleWarning(msg, call = sys.call(sys.parent())) warning(obj) } BBmisc/R/extractSubList.R0000644000175100001440000000504712644315506014747 0ustar hornikusers#' Extracts a named element from a list of lists. #' #' @param xs [\code{list}]\cr #' A list of named lists. #' @param element [\code{character}]\cr #' Name of element(s) to extract from the list elements of \code{xs}. #' What happens is this: \code{x$el1$el2....}. #' @param element.value [any]\cr #' If given, \code{\link{vapply}} is used and this argument is passed to \code{FUN.VALUE}. #' Note that even for repeated indexing (if length(element) > 1) you only #' pass one value here which refers to the data type of the final result. #' @param simplify [\code{logical(1)} | character(1)]\cr #' If \code{FALSE} \code{\link{lapply}} is used, otherwise \code{\link{sapply}}. #' If \dQuote{cols}, we expect the elements to be vectors of the same length and they are #' arranged as the columns of the resulting matrix. #' If \dQuote{rows}, likewise, but rows of the resulting matrix. #' Default is \code{TRUE}. #' @param use.names [\code{logical(1)}]\cr #' If \code{TRUE} and \code{xs} is named, the result is named as \code{xs}, #' otherwise the result is unnamed. #' Default is \code{TRUE}. #' @return [\code{list} | simplified \code{vector} | \code{matrix}]. See above. #' @export #' @examples #' xs = list(list(a = 1, b = 2), list(a = 5, b = 7)) #' extractSubList(xs, "a") #' extractSubList(xs, "a", simplify = FALSE) extractSubList = function(xs, element, element.value, simplify = TRUE, use.names = TRUE) { assertList(xs) assert(checkFlag(simplify), checkChoice(simplify, c("cols", "rows"))) assertFlag(use.names) # we save some time here if we only do the for loop in the complicated case # the whole function is still not very nice due to the loop # extractSubList should be C code anyway i guess.... doindex = if (length(element) == 1L) { function(x) x[[element]] } else { function(x) { for (el in element) x = x[[el]] return(x) } } if (!missing(element.value)) { ys = vapply(xs, doindex, FUN.VALUE = element.value) } else if (isTRUE(simplify)) { ys = sapply(xs, doindex, USE.NAMES = use.names) } else { ys = lapply(xs, doindex) if (simplify == "rows") ys = asMatrixRows(ys) else if (simplify == "cols") ys = asMatrixCols(ys) } ns = names(xs) if (use.names && !is.null(ns)) { if (isTRUE(simplify)) names(ys) = ns else if (simplify == "rows") rownames(ys) = ns else if (simplify == "cols") colnames(ys) = ns } else { if (simplify %in% c("rows", "rows")) dimnames(ys) = NULL else names(ys) = NULL } return(ys) } BBmisc/R/save2.R0000644000175100001440000000267212644315506013010 0ustar hornikusers#' Save multiple objects to a file. #' #' A simple wrapper for \code{\link[base]{save}}. Understands key = value syntax to save #' objects using arbitrary variable names. All options of \code{\link[base]{save}}, #' except \code{list} and \code{envir}, are available and passed to #' \code{\link[base]{save}}. #' #' @param file #' File to save. #' @param ... [\code{any}]\cr #' Will be converted to an environment and then passed to \code{\link[base]{save}}. #' @param ascii #' See help of \code{\link[base]{save}}. #' @param version #' See help of \code{\link[base]{save}}. #' @param compress #' See help of \code{\link[base]{save}}. #' @param compression_level #' See help of \code{\link[base]{save}}. #' @param eval.promises #' See help of \code{\link[base]{save}}. #' @param precheck #' See help of \code{\link[base]{save}}. #' @return See help of \code{\link[base]{save}}. #' @export #' @examples #' x = 1 #' save2(y = x, file = tempfile()) save2 = function(file, ..., ascii = FALSE, version = NULL, compress = !ascii, compression_level, eval.promises = TRUE, precheck = TRUE) { args = tryCatch(as.environment(argsAsNamedList(...)), error = function(e) stopf("Unable to convert to environment (%s)", as.character(e))) save(list = ls(args, all.names = TRUE), envir = args, file = file, ascii = ascii, version = version, compress = compress, compression_level = compression_level, eval.promises = eval.promises, precheck = precheck) } BBmisc/R/dropNamed.R0000644000175100001440000000145612644315506013700 0ustar hornikusers#' Drop named elements of an object. #' #' @param x [any]\cr #' Object to drop named elements from. #' For a matrix or a data frames this function drops named columns via #' the second argument of the binary index operator \code{[,]}. #' Otherwise, the unary index operator \code{[]} is used for dropping. #' @param drop [\code{character}]\cr #' Names of elements to drop. #' @return Subset of object of same type as \code{x}. The object is not simplified, #' i.e, no dimensions are dropped as \code{[,,drop = FALSE]} is used. #' @export dropNamed = function(x, drop = character(0L)) { assertCharacter(drop, any.missing = FALSE) if (length(drop) == 0L) return(x) if (is.matrix(x) || is.data.frame(x)) x[, setdiff(colnames(x), drop), drop = FALSE] else x[setdiff(names(x), drop)] } BBmisc/R/is_error.R0000644000175100001440000000100212644315506013576 0ustar hornikusers#' Is return value of try an exception? #' #' Checks if an object is of class \dQuote{try-error} or #' \dQuote{error}. #' #' @param x [any]\cr #' Any object, usually the return value of \code{\link[base]{try}}, #' \code{\link[base]{tryCatch}}, or a function which may return a #' \code{\link[base]{simpleError}}. #' @return [\code{logical(1)}]. #' @export #' @examples #' x = try(stop("foo")) #' print(is.error(x)) #' x = 1 #' print(is.error(x)) is.error = function(x) { inherits(x, c("try-error", "error")) } BBmisc/R/zzz_deprecated.R0000644000175100001440000000074312644315506015002 0ustar hornikusers#FIXME: remove #' Deprecated function. Do not use! #' #' @param df No text #' @param chars.as.factor No text #' @param factors.as.char No text #' @param ints.as.num No text #' @param logicals.as.factor No text #' @param x No text #' @param num.format No text #' @param clip.len No text #' #' @name deprecated #' @rdname deprecated NULL #' @export #' @rdname deprecated convertDfCols = convertDataFrameCols #' @export #' @rdname deprecated listToShortString = convertToShortString BBmisc/R/zzz.R0000644000175100001440000000060712741010551012607 0ustar hornikusers#' @import stats #' @import checkmate #' @import utils #' @importFrom methods is .onLoad = function(libname, pkgname) { options(BBmisc.ProgressBar.stream = getOption("BBmisc.ProgressBar.stream", "stderr")) options(BBmisc.ProgressBar.style = getOption("BBmisc.ProgressBar.style", "text")) options(BBmisc.ProgressBar.width = getOption("BBmisc.ProgressBar.width", getOption("width"))) } BBmisc/R/lsort.R0000644000175100001440000000054312644315506013126 0ustar hornikusers#' A wrapper for \code{\link{sort}} to sort using the \dQuote{C} collating rules. #' #' @param ... #' Options passed to sort. #' @return See \code{\link{sort}}. #' @export lsort = function(...) { cur = Sys.getlocale("LC_COLLATE") if (cur != "C") { Sys.setlocale("LC_COLLATE", "C") on.exit(Sys.setlocale("LC_COLLATE", cur)) } sort(...) } BBmisc/R/getUnixTime.R0000644000175100001440000000027012644315506014222 0ustar hornikusers#' Current time in seconds. #' #' Simple wrapper for \code{as.integer(Sys.time())}. #' #' @return [\code{integer(1)}]. #' @export getUnixTime = function() { as.integer(Sys.time()) } BBmisc/R/splitPath.R0000644000175100001440000000165512644315506013740 0ustar hornikusers#' Split a path into components #' #' The first normalized path is split on forward and backward slashes and its components returned as #' character vector. The drive or network home are extracted separately on windows systems and #' empty on all other systems. #' #' @param path [\code{character(1)}]\cr #' Path to split as string #' @return \code{named list}: List with components \dQuote{drive} (\code{character(1)} #' and \dQuote{path} (\code{character(n)}. #' @export splitPath = function(path) { assertString(path) path = normalizePath(path, mustWork = FALSE) if (isWindows()) { pattern = "^([[:alpha:]]:)|(\\\\[[:alnum:]]+)" m = regexpr(pattern, path) if (length(m) == 1L && m == -1L) stop("Error extracting the drive letter") drive = regmatches(path, m) regmatches(path, m) = "" } else { drive = character(0L) } list(drive = drive, path = Filter(nzchar, strsplit(path, "[/\\]+")[[1L]])) } BBmisc/R/convertMatrixType.R0000644000175100001440000000074512644315506015476 0ustar hornikusers#' Converts storage type of a matrix. #' #' Works by setting \code{\link{mode}}. #' #' @param x [\code{matrix}]\cr. #' Matrix to convert. #' @param type [\code{character(1)}]\cr #' New storage type. #' @return [\code{matrix}]. #' @note \code{as.mytype} drops dimension when used on a matrix. #' @export convertMatrixType = function(x, type) { assertMatrix(x) assertChoice(type, c("integer", "numeric", "complex", "character", "logical")) storage.mode(x) = type return(x) } BBmisc/MD50000644000175100001440000003640512741102356011750 0ustar hornikusers7f04456c01086283ae78d2a9229ee413 *DESCRIPTION 7386455b2e450986702039704e0fb450 *LICENSE ccf9ccf74832d34a66cdd556bd6c1fdd *NAMESPACE cc5be62c141bb87446789fc76e82405a *NEWS c95ee93ae6e1cc3d139e16f1a1c485f9 *R/FileCache.R 37649421ad19b638a665553cd24b0745 *R/addClasses.R a19fab5e53b23926efcf64953f49bf40 *R/argsAsNamedList.R 3d8824dab593e1f1647d850e94cc1cc5 *R/asMatrix.R 05e6ba9ccfb6be15b97ed2cdfd97d9a4 *R/asQuoted.R 102a6bb72d8210fb80b45f4515c01cc3 *R/binPack.R 88faf131b900a83f9c0c85620488b786 *R/btwn.R 56df88099f262e40fd104594a2c7731f *R/capitalizeStrings.R 40a799be55e2562f2b188eeb2cd63ff2 *R/catf.R 953550836992d4cd19b1661c8c74bb03 *R/checkArg.R 607b3b87c142d997f15f1d34eb96c0bb *R/checkListElementClass.R a7c0552b6aa7d2c1691d82cff4485376 *R/chunk.R 48f916754d922673ab8f2ec2918109d9 *R/clipString.R 956e3cfd733539748a02c213def678e2 *R/coalesce.R 6474806e25c753e2e6d38ed2e2b83cd0 *R/collapse.R f19ea97de980e17af2cfdd33eb572801 *R/collapsef.R d796fa44ef59e09f21731b72287ed143 *R/computeMode.R 6182369f5487ee733e9ddb638adcb064 *R/convertDataFrameCols.R 3127c59099d3f0831d425831e0a017bb *R/convertInteger.R 2dc25130974b33de32138bfae346c6fa *R/convertListOfRowsToDataFrame.R 25cbea8b92cd9c71359abe1de6aba3e3 *R/convertMatrixType.R 0aa7f94d326d17433e3ca503881f5bf4 *R/convertRowsToList.R a768bf8674db3d5d83d5c5a26c83f4c8 *R/convertToShortString.R a248fcb5e54b59f424197c693ed75253 *R/dapply.R dfb0e871e12fc0492300a86736ccdcf4 *R/directory.R a92a461f1665ac3fe620d1f4e9066662 *R/do.call2.R d15bb0426abfc93d43a20f5b8d8b543c *R/dropNamed.R 49cd376e7333baa103869d9655b6ec20 *R/ensureVector.R ec76a08226506c0a516855fc2fc298b6 *R/explode.R e9fcae1462308da4ad61b4acc4d0aa5f *R/extractSubList.R 96f106167198d3d08d87cfb050eaf48e *R/factor.R ed1f7d50dc0893c6e1973f34e344ce5f *R/filterNull.R 7391eef2300a2da2c6c5e2178b1f9b10 *R/getAttributeNames.R 263e6489983e592d783815becbd3912c *R/getClass1.R a8a2859a4953fcbfefcbdeae4d1cb345 *R/getFirstLast.R bd60735efe4a46064ca0276fc44830ff *R/getMaxColIndex.R 58010b87a6888d602cc01980b04bf411 *R/getMaxIndex.R e3a5d3c9ed3fa73f1fea676c8c128c44 *R/getOperatingSystem.R be6b3175d3a59a13cec139f078340cc5 *R/getRelativePath.R 9e51abee4abe6e78930245bc9c4b1aaa *R/getUnixTime.R eda7e9ed2c68a2d7f218da52ca03f1c9 *R/getUsedFactorLevels.R a0f5b1a871b4deb857a25a12d25ef9af *R/hasAttributes.R 9af311fcfd2688804b59409284c4a51f *R/insert.R ff164b48892cf737901f89f2506176d2 *R/isExpensiveExampleOk.R bf3ade174d8e61f3594cf62d21c71ee2 *R/isFALSE.R fce55c76d787eedb831731d220ca694c *R/isProperlyNamed.R 253fcbcdec66ca00e46c93a15137f8d9 *R/isScalarNA.R 4f4b24c1a3df9bf0b590444d5110cf65 *R/isScalarValue.R acd3b0539bf5f9c534fefad0e353c951 *R/isSubset.R 5e3211824cff133ea45daa09695ec7d6 *R/isSuperset.R c84c482db819d69e975c317b069ed33f *R/isValidName.R 689de2012cdfb03cf98fa827f43b598f *R/is_error.R 630d0db83c085c1e106da9f5158660ab *R/itostr.R b1889a315d4c67abf957656bafc4edfb *R/lib.R 0f7bf8cb1feaad3dc90a34268e79ae9f *R/load2.R 64959e639392429ee334776b490b6c41 *R/lsort.R 692df0b72f047ddc3c9de85af99acb0e *R/makeDataFrame.R ca0e4b8b642961b4d3d095fd5e9037c6 *R/makeProgressBar.R 3005179353ae8a3fe527e2f4d4e4c5a3 *R/makeS3Obj.R e4c87c84ca1820b2645dd8ba1447bcf6 *R/makeSimpleFileLogger.R f4549d2b6ab7380fae0734c9ca4e72f5 *R/mapValues.R a08101a5130a04405545295a434f234f *R/matchDataFrameSubset.R 1d93558247bae14825e63544d8567985 *R/messagef.R bbea4b5fddb93dab9e4d7ccd467fbef6 *R/namedList.R d7a212dac2515883b8b947f3139e7fcd *R/names2.R a75f48f5cc0bff7e3774951c276ee775 *R/nin.R ef042ba4a544e8dee75edea118113ee1 *R/normalize.R de8e6cb465cdd3dd19321cf6ac213d2b *R/optimizeSubInts.R 599ace969590b37f3c2c88b14c57d762 *R/pause.R b6fd8274f38b9b99c0a742154598717a *R/printStrToChar.R 92bfd135c7de27f135e7823996aff04d *R/printToChar.R 971a824767489aa432bf9ca2e4f60e88 *R/rangeVal.R 712c07327f88989c242a613868182f8b *R/requirePackages.R df031beadf86dfad62057678370d79e6 *R/rowLapply.R 61b3f7eb6ba48b339e4804f187fd0e0a *R/save2.R 9d0fa892ba445da469e2435b5d5179f0 *R/seq.R 6b347cefb473fea607bf9af5be420ae0 *R/setAttribute.R 2acffcac7efdd8e66123845d7f8c5561 *R/setClasses.R 0b7ef0cf6e2e01f86d415466f20694a7 *R/setRowColNames.R 22f9f125514f88a63042233ccfa1d19d *R/setValue.R d61551ae970e45f78f8169b719228053 *R/sortByCol.R d42215dccfaba5b1d30b11d772c64c69 *R/splitPath.R ceb0f1641b1efe0528c6bba833096ded *R/splitTime.R a3fba36734928b83ac39e5e5ae093c3c *R/stopf.R d5ebd95cd601d2249b07774e7ff1248b *R/strrepeat.R 18366c8a042dd38325703588bd0918f3 *R/suppressAll.R 75d4e5b8748b3aa4b47ae024bc8e2d5c *R/symdiff.R 16a78f0352852bc51d2beb9780a8d299 *R/system3.R 8fe792f0f54874f8607bc63dd740c9f7 *R/toRangeStr.R 8e123e02d9fe45608f598d7e3fac94a9 *R/vapply.R 66e3373494a99d89cf6dacad42149edb *R/warningf.R 1fe4c8b9e67056c6b1787a4e5d320dba *R/which.first.R 9db98a4c3deb05ca23f6139604c794e7 *R/zzz.R 7d9630f2dc37f2231c41816527f84a59 *R/zzz_deprecated.R 6c28e23a9ee33395fb45fc19114cb26e *man/addClasses.Rd 85cf6c5b5efcabe05cc8260c1460245f *man/argsAsNamedList.Rd 7be55e4c70ef62a0cda1757e06eaf467 *man/asMatrixCols.Rd 16349c85ef00afcd0ad77736c2077f5a *man/asQuoted.Rd 7b4571d7c1d82da7ec431613cce6850f *man/binPack.Rd fdca94ba02a32deca58ad35251456133 *man/btwn.Rd 976ed6fc3fad483006b818710dd45286 *man/cFactor.Rd 6ed86f1c9e66d0940d7151d492118dd9 *man/capitalizeStrings.Rd ed3d33f51d96103c2ec07f2574bad2a9 *man/catf.Rd 8b5ca1458a0326e6252d74dd1a0c254b *man/checkArg.Rd 355651c0810deac8da4a623247268107 *man/checkListElementClass.Rd ed1d51f496879bb54c564b7654182c87 *man/chunk.Rd fd3921e0da60adc117341d1094f588f9 *man/clipString.Rd ecd1ccb7fd6e4ba6f00fbd3ab891789c *man/coalesce.Rd 6f2baa7edbc662353bb9c3213123141d *man/collapse.Rd b558e5ac90f6d7d1406b13f3138ffb76 *man/collapsef.Rd 621e69a40369c775d1c6e5ef7f44de48 *man/computeMode.Rd f8d7492cf45ea2c39432171c43116dff *man/convertDataFrameCols.Rd 2708b65e90936066674d398bce7e829c *man/convertInteger.Rd b61a0cc0163e8716dfb390635049dda4 *man/convertIntegers.Rd c0f1a10fc0b9810c5957008b1515042b *man/convertListOfRowsToDataFrame.Rd 707ebae4c6576b07a5b82bf6dcf5fdf0 *man/convertMatrixType.Rd 92378bffb4926f0cdf0b85ca75e06c81 *man/convertRowsToList.Rd a8692024ce85cbe225ac3ee00836552c *man/convertToShortString.Rd 99084a0e97a9a2469bc770e22707a809 *man/dapply.Rd cc24024f295ef352113c19230f93d04d *man/deprecated.Rd 964684cd29306a03770f99737063b844 *man/do.call2.Rd 0bd727a23a077c1ed3a578dec7fd6f72 *man/dropNamed.Rd 6800348de281bca9f6eb9946bbb6bf30 *man/ensureVector.Rd 1b61610ad6fe1975e02cb50b6b162884 *man/explode.Rd 3357bef2ea30da934391546454f187f4 *man/extractSubList.Rd 2aafaf931dd6640c7700694c53b8bdc1 *man/filterNull.Rd 803459a58003642e781eea8ac798440c *man/getAttributeNames.Rd e1e6a2023c12bc332a3c9a0a64c6801c *man/getClass1.Rd e4b68b19f5b651cdd80946a4d12c1086 *man/getFirst.Rd e1424b0e53724d037142c00e791004b3 *man/getMaxIndex.Rd b90f6d3e901454606780b4c1d023f280 *man/getMaxIndexOfRows.Rd e8954aa148674246b103f64dca2ced64 *man/getOperatingSystem.Rd 1709f1853a8e4931e6c6b97be6f71e52 *man/getRelativePath.Rd 6b0664caf017c404b98bdd879ce20a5b *man/getUnixTime.Rd 91eb85f9216d302e0a387317c9eddda4 *man/getUsedFactorLevels.Rd 1ea0bdf0839cd36584c1190edfcf3288 *man/hasAttributes.Rd 51f57f27f947986f3c93481a6368c2fb *man/insert.Rd 2bcbb0fdbeac918c13dcaaf810644dff *man/is.error.Rd f61d595ea61102ed6a00fc633edd6f40 *man/isDirectory.Rd 1d865e2ffd8740adeacc3c6c965d0d2a *man/isEmptyDirectory.Rd 81ee17e9f37134d13c746a440131e910 *man/isExpensiveExampleOk.Rd 8f6cecb20c7400a2d8528fb061608004 *man/isFALSE.Rd 365a676e6689dff611d4e7a010c881fe *man/isProperlyNamed.Rd a181bd667a7fc0823633ea38700d2f6c *man/isScalarNA.Rd 2967b168252db866c2fb1c88f1beea2a *man/isScalarValue.Rd 3b054825c728efd77102723073a104b5 *man/isSubset.Rd 2b72056638119c0e39b2a40d539097f8 *man/isSuperset.Rd 0ea08880a8e1f689adbf7949822de67a *man/isValidName.Rd 90651aa0abd758e0719876345578989b *man/itostr.Rd 0e2258daf21d6742bff3fad2301e7393 *man/lib.Rd f0e3591c35a727e1f7124749f0e1c223 *man/load2.Rd d666f370595b8201acabe915284e9a16 *man/lsort.Rd 7fefd75e404e58eaccd3d6ba1948ebf4 *man/makeDataFrame.Rd 6384cbfc1f740aec555280a9e86135bb *man/makeFileCache.Rd a7757aca00e5a02f9ab16dce645824b4 *man/makeProgressBar.Rd 03e65bca043ff0713d9ff022190eda08 *man/makeS3Obj.Rd 395ac5de54a241f43f40fa3d2b5999a0 *man/makeSimpleFileLogger.Rd d1b6375176f615d5b5aa4215bda759e6 *man/mapValues.Rd 0a46b540e78515f5a77653a62829f9ff *man/messagef.Rd a60bf8dbf615aaf0c6fb8a9f2f2c989f *man/namedList.Rd ecbd929d52368597f0c8c49ad10b77e6 *man/names2.Rd fbf72ffa7e7762bdae07c4b50006414d *man/nin.Rd 0a6c7cc987466c8c734428b493d7fb7e *man/normalize.Rd ea2836d3125adcc379acb0d265dcfd43 *man/optimizeSubInts.Rd 1551f867d369e1aedbc1e7ace9644ea1 *man/pause.Rd 837250e6548dd68ea6b70cacc14fec50 *man/printStrToChar.Rd db2e6fd69ea5a80b32776c6cc090482e *man/printToChar.Rd 67fb568acdd5918ab7c50461560fce79 *man/rangeVal.Rd 94142554a8388dc5c436def74e2bc979 *man/requirePackages.Rd ac6cc5e47f488c9a782179a31d2dad7e *man/rowLapply.Rd 9b4c4e14d420bf43da63a51cec671da5 *man/save2.Rd 28157848c96897deeada64e8128e8a35 *man/seq_row.Rd 06eb68e6d21da37f3a59df09bc288c77 *man/setAttribute.Rd 6b8930c78376d505b801b31016c87c54 *man/setClasses.Rd fd408b34c1a43915b3c2ba078f267548 *man/setRowNames.Rd 5a67e663dc42593c5f08ffab26cf855e *man/setValue.Rd b136b58c5445ecf67535a675f58f2f5f *man/sortByCol.Rd d1f1611fb69f21ee73edc10cd5fb7888 *man/splitPath.Rd 578271e955afaf5c48336b919f16d49d *man/splitTime.Rd 3641096790c2e1d1b2e1ac335b15138f *man/stopf.Rd 54042026ba220e537fbfdd7d3069b830 *man/strrepeat.Rd 74d6178ea98ca0d0c9f0f8ea1033375a *man/suppressAll.Rd 61acd2fd22e2d27749bd9e3e8e33a409 *man/symdiff.Rd 35d6ba8cfd84456e13db37ce9fa3f8fc *man/system3.Rd f698231892cc5a45ef5174fad55c80db *man/toRangeStr.Rd 64b79c04a4b213bfe5279f1ea39afb2b *man/vlapply.Rd 0949e18ab83d7d8cb3759de70b668f3b *man/warningf.Rd 7afbd12247784c4fb6fbbc39e5795876 *man/which.first.Rd 35b942e80b674462ff4f0c26c0c26d7d *src/getMaxColRowIndex.c 12c0f6eb710ca0bc0b6e4353030258b4 *src/getMaxColRowIndex.h 872c1ed132a63360b520d7edcb241d61 *src/getMaxIndex.c e41e18c0f5bfc66b2ce50da59cb0919c *src/getMaxIndex.h 83957d4a67abf8f6b3f399b2d3c96cc1 *src/itostr.c 845d1f74188f0aefe4bab9ec2e0efc3f *src/itostr.h 6afff632678c787e398d5b43e72241ed *src/macros.h c5564af214c7943d5b311033a6dc38e0 *src/which_first.c e87b78c885283187d6d8ca3af40c600e *src/which_first.h 9e8b5bb9c6dc523818d261be802032f5 *tests/run-all.R 5989b96cdbdb24092fe473cb0ad9ccb4 *tests/testthat/test_addClasses.R f6050a65c56c2cc62d111a7cfcfb1e6e *tests/testthat/test_asMatrix.R a2ff4b32481c669f4900f19d7d0ed188 *tests/testthat/test_asQuoted.R 2c789b11011b47f62e1831d197e42c04 *tests/testthat/test_binPack.R ce628478a7d2d2a75dd8d10ce5ab187b *tests/testthat/test_btwn.R 0de7d7a0a6771c56db69b4c69e94b390 *tests/testthat/test_capitalizeStrings.R f23335296ae8ad3ed18b01fdbbafee33 *tests/testthat/test_checkArg.R 2889c8b5c4cff66c5a31b953545c2d86 *tests/testthat/test_checkListElementClass.R 01e02d684c7188d63a7fc7fccc5220c4 *tests/testthat/test_chunk.R e336b47dfd43383a09d279b77e4f96c3 *tests/testthat/test_clipString.R 665c15097eb4ccf5a456aef168804f6a *tests/testthat/test_coalesce.R 6cc17f7528f6efdb407230a8c097631a *tests/testthat/test_collapse.R 091934d63a45e3bcf62836821baa462b *tests/testthat/test_collapsef.R dd9dc2ccdece4005ed5358ced398cf13 *tests/testthat/test_computeMode.R 7448827f4c9fabbae92a5864d18f2ac9 *tests/testthat/test_convertDataFrameCols.R 66258ce1820608dcd2e5616b00e8aad0 *tests/testthat/test_convertInteger.R 77fdfcaf7252093ae760539337f479fa *tests/testthat/test_convertListOfRowsToDataFrame.R 330977ab6ed531b93bdad0fcbd8a6533 *tests/testthat/test_convertMatrixType.R 02bc23580f983e1a98ee7dad92c081fe *tests/testthat/test_convertRowsToList.R 8422c8f8a2f573c6e361c84e5e5dd61b *tests/testthat/test_convertToShortString.R c8ca5f9dc69b06b88f920dad74143ff3 *tests/testthat/test_dapply.R 2730cd895f1362a22eb2c38fc71a2b66 *tests/testthat/test_directory.R ee1696434054a3b1c40ae3ba2b2af9be *tests/testthat/test_do.call2.R e8bf0877b50ec0059a0aefb098f1791f *tests/testthat/test_dropNamed.R c833f182f3f91bd22b2fc718b664d138 *tests/testthat/test_ensureVector.R 1733a18def47e4f99263c0ec22a05ae9 *tests/testthat/test_explode.R 8399154accb6dffa48c7d06c1e69f9ae *tests/testthat/test_extractSubList.R 5db66dab33cc917d87ccdd03ba721c42 *tests/testthat/test_factor.R d457e05b43fd367fcebcfdd08eeafa7c *tests/testthat/test_filterNull.R 464fbd86c7dfddf98ded924e4ee74bd4 *tests/testthat/test_getAttributeNames.R 729762bd8e29cb1f33e538d13ca899f4 *tests/testthat/test_getClass1.R 38e58da0e7a723f99dbba1fbd6120143 *tests/testthat/test_getFirstLast.R 9d2ca5a6feeaef8f88698c61995808d8 *tests/testthat/test_getMaxColRowIndex.R 03ab4c90b42903b9c9d6500384249457 *tests/testthat/test_getMaxIndex.R 6a30e242cbbd9a6b5c1eada247875f8d *tests/testthat/test_getOperatingSystem.R 6f3259098fab9dfee2e8827ea4d54a30 *tests/testthat/test_getRelativePath.R 511082684bfa9447f2ffabe4c5ebd25d *tests/testthat/test_getUnixTime.R 64ce851c25c608ec23c06cb7084ad782 *tests/testthat/test_getUsedFactorLevels.R 89a0524f502cef22d19ce309b13dbdc0 *tests/testthat/test_hasAttributes.R 967cd4e4bc9499b37fa142d0e30a76fb *tests/testthat/test_insert.R ce0f8715ef6d8850ed9d1a393df860e4 *tests/testthat/test_is.subsetsuperset.R 24b2b476478d1bba9b4dcd42aea56702 *tests/testthat/test_isFALSE.R e682af1a73915859b114dac0648619f7 *tests/testthat/test_isProperlyNamed.R fc209c118a8f0f682599c0c41705b1e5 *tests/testthat/test_isScalarNA.R 96814042a3ab82df5e6294b2d1ae775c *tests/testthat/test_isScalarValue.R b9d87c2e03b710fb0340d7325bda8bb2 *tests/testthat/test_isValidNames.R 1dd894fc227ccd3e6b0f233963d44c3c *tests/testthat/test_is_error.R 86fd8371f6dec17d19b88de3c8c0e36f *tests/testthat/test_itostr.R 8663a10c1f2e1e8123a0ef80a7d4824a *tests/testthat/test_load2_save2.R 0e694eb0d74663edd84258450e4dee18 *tests/testthat/test_lsort.R b1ab421f949e43a571b3b65acd96d1b2 *tests/testthat/test_makeDataFrame.R 1bb67fc1ef119c4e78324bfafe1de1b5 *tests/testthat/test_makeProgressBar.R 470defa91aab0e97dbccbd931924047c *tests/testthat/test_makeSimpleFileLogger.R 2181619d625795bb64ba88ce2b84de2d *tests/testthat/test_mapValues.R 1130be95adf737b30a0c4c783648e973 *tests/testthat/test_namedList.R d06ec9a9e27677e23f8a9d8fd030748e *tests/testthat/test_nin.R d937f2e0f11346490140f08998bcbff1 *tests/testthat/test_normalize.R 98a1a85a55a68773c748dab8f4f0ad40 *tests/testthat/test_optimizeSubInts.R 4ec4fcdd19c7734b29a9107d85c8f4fe *tests/testthat/test_printStrToChar.R edc7badddfe9bd1c8fe1fb0a77901d16 *tests/testthat/test_printToChar.R 77530a85391710d9f2eedd2d9fc87e4c *tests/testthat/test_printf.R 1442290f39895a964fd1972ed35f7611 *tests/testthat/test_rangeVal.R 51c5c9322504cfec1c30a37457349912 *tests/testthat/test_requirePackages.R c793db23c505860557e166330b21d7ab *tests/testthat/test_rowLapply.R 296998c0e7d9d6cb8ab0dc4c8c8c4b05 *tests/testthat/test_seq.R e6ee1c9a73b327cf0719d69d01ee0afe *tests/testthat/test_setAttribute.R 52f2657e8983aac7febfa8db35908ab0 *tests/testthat/test_setClasses.R 4edc08a44f11533fc89463b7dbc18e41 *tests/testthat/test_setRowColNames.R 7272c751710069de721b9f1b7151730f *tests/testthat/test_setValue.R ed895ae818a488ce37d14fe377ce328b *tests/testthat/test_sortByCol.R 4d6d80bc21cf4aefea95b86e00ae05e3 *tests/testthat/test_splitPath.R b865603ba3d7e6bb224d1cf4a388e0d0 *tests/testthat/test_splitTime.R e9b339c5e397f2b7f8487aacc08d9d47 *tests/testthat/test_strrepeat.R 42901946d8b28526e57dd7cd37b81d7e *tests/testthat/test_suppressAll.R c43ce1a7fe74b064b67a90b8aa1ba77f *tests/testthat/test_symdiff.R f6c99819004299fe7d625f9c49117379 *tests/testthat/test_system3.R c60f155f7f164f9f776a9256f3b99f70 *tests/testthat/test_toRangeStr.R f12081b0ea79bdef678265bffbf6f90c *tests/testthat/test_which.first.last.R BBmisc/DESCRIPTION0000644000175100001440000000246712741102356013147 0ustar hornikusersPackage: BBmisc Title: Miscellaneous Helper Functions for B. Bischl Description: Miscellaneous helper functions for and from B. Bischl and some other guys at TU Dortmund, mainly for package development. Authors@R: c(person("Bernd", "Bischl", email = "bernd_bischl@gmx.net", role = c("aut", "cre")), person("Michel", "Lang", email = "michellang@gmail.com", role = "aut"), person("Jakob", "Bossek", email = "jakob.bossek@tu-dortmund.de", role = "aut"), person("Daniel", "Horn", email = "daniel.horn@tu-dortmund.de", role = "aut"), person("Jakob", "Richter", email = "code@jakob-r.de", role = "aut"), person("Dirk", "Surmann", email = "surmann@statistik.tu-dortmund.de", role = "aut")) URL: https://github.com/berndbischl/BBmisc BugReports: https://github.com/berndbischl/BBmisc/issues License: BSD_3_clause + file LICENSE Encoding: UTF-8 Imports: utils, methods, stats, checkmate (>= 1.8.0) Suggests: testthat, microbenchmark, codetools LazyData: yes ByteCompile: yes Version: 1.10 RoxygenNote: 5.0.1 NeedsCompilation: yes Packaged: 2016-07-11 21:52:13 UTC; bischl Author: Bernd Bischl [aut, cre], Michel Lang [aut], Jakob Bossek [aut], Daniel Horn [aut], Jakob Richter [aut], Dirk Surmann [aut] Maintainer: Bernd Bischl Repository: CRAN Date/Publication: 2016-07-12 07:49:34 BBmisc/man/0000755000175100001440000000000012741010551012176 5ustar hornikusersBBmisc/man/dropNamed.Rd0000644000175100001440000000135012741010551014375 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/dropNamed.R \name{dropNamed} \alias{dropNamed} \title{Drop named elements of an object.} \usage{ dropNamed(x, drop = character(0L)) } \arguments{ \item{x}{[any]\cr Object to drop named elements from. For a matrix or a data frames this function drops named columns via the second argument of the binary index operator \code{[,]}. Otherwise, the unary index operator \code{[]} is used for dropping.} \item{drop}{[\code{character}]\cr Names of elements to drop.} } \value{ Subset of object of same type as \code{x}. The object is not simplified, i.e, no dimensions are dropped as \code{[,,drop = FALSE]} is used. } \description{ Drop named elements of an object. } BBmisc/man/strrepeat.Rd0000644000175100001440000000101512741010551014473 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/strrepeat.R \name{strrepeat} \alias{strrepeat} \title{Repeat and join a string} \usage{ strrepeat(x, n, sep = "") } \arguments{ \item{x}{[character]\cr Vector of characters.} \item{n}{[\code{integer(1)}]\cr Times the vector \code{x} is repeated.} \item{sep}{[\code{character(1)}]\cr Separator to use to collapse the vector of characters.} } \value{ \code{character(1)}. } \description{ Repeat and join a string } \examples{ strrepeat("x", 3) } BBmisc/man/getOperatingSystem.Rd0000644000175100001440000000151212741010551016321 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/getOperatingSystem.R \name{getOperatingSystem} \alias{getOperatingSystem} \alias{isDarwin} \alias{isLinux} \alias{isUnix} \alias{isWindows} \title{Functions to determine the operating system.} \usage{ getOperatingSystem() isWindows() isUnix() isLinux() isDarwin() } \value{ See above. } \description{ \itemize{ \item{getOperatingSystem}{Simple wrapper for \code{.Platform$OS.type}, returns \code{character(1)}.} \item{isUnix}{Predicate for OS string, returns \code{logical(1)}. Currently this would include Unix, Linux and Mac flavours.} \item{isLinux}{Predicate for sysname string, returns \code{logical(1)}.} \item{isDarwin}{Predicate for sysname string, returns \code{logical(1)}.} \item{isWindows}{Predicate for OS string, returns \code{logical(1)}.} } } BBmisc/man/optimizeSubInts.Rd0000644000175100001440000000233512741010551015640 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/optimizeSubInts.R \name{optimizeSubInts} \alias{optimizeSubInts} \title{Naive multi-start version of \code{\link{optimize}} for global optimization.} \usage{ optimizeSubInts(f, interval, ..., lower = min(interval), upper = max(interval), maximum = FALSE, tol = .Machine$double.eps^0.25, nsub = 50L) } \arguments{ \item{f}{See \code{\link{optimize}}.} \item{interval}{See \code{\link{optimize}}.} \item{...}{See \code{\link{optimize}}.} \item{lower}{See \code{\link{optimize}}.} \item{upper}{See \code{\link{optimize}}.} \item{maximum}{See \code{\link{optimize}}.} \item{tol}{See \code{\link{optimize}}.} \item{nsub}{[\code{integer(1)}]\cr Number of subintervals. A value of 1 implies normal \code{\link{optimize}} behavior. Default is 50L.} } \value{ See \code{\link{optimize}}. } \description{ The univariate \code{\link{optimize}} can stop at arbitrarily bad points when \code{f} is not unimodal. This functions mitigates this effect in a very naive way: \code{interval} is subdivided into \code{nsub} equally sized subintervals, \code{\link{optimize}} is run on all of them (and on the original big interval) and the best obtained point is returned. } BBmisc/man/convertMatrixType.Rd0000644000175100001440000000075712741010551016205 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/convertMatrixType.R \name{convertMatrixType} \alias{convertMatrixType} \title{Converts storage type of a matrix.} \usage{ convertMatrixType(x, type) } \arguments{ \item{x}{[\code{matrix}]\cr. Matrix to convert.} \item{type}{[\code{character(1)}]\cr New storage type.} } \value{ [\code{matrix}]. } \description{ Works by setting \code{\link{mode}}. } \note{ \code{as.mytype} drops dimension when used on a matrix. } BBmisc/man/extractSubList.Rd0000644000175100001440000000303212741010551015443 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/extractSubList.R \name{extractSubList} \alias{extractSubList} \title{Extracts a named element from a list of lists.} \usage{ extractSubList(xs, element, element.value, simplify = TRUE, use.names = TRUE) } \arguments{ \item{xs}{[\code{list}]\cr A list of named lists.} \item{element}{[\code{character}]\cr Name of element(s) to extract from the list elements of \code{xs}. What happens is this: \code{x$el1$el2....}.} \item{element.value}{[any]\cr If given, \code{\link{vapply}} is used and this argument is passed to \code{FUN.VALUE}. Note that even for repeated indexing (if length(element) > 1) you only pass one value here which refers to the data type of the final result.} \item{simplify}{[\code{logical(1)} | character(1)]\cr If \code{FALSE} \code{\link{lapply}} is used, otherwise \code{\link{sapply}}. If \dQuote{cols}, we expect the elements to be vectors of the same length and they are arranged as the columns of the resulting matrix. If \dQuote{rows}, likewise, but rows of the resulting matrix. Default is \code{TRUE}.} \item{use.names}{[\code{logical(1)}]\cr If \code{TRUE} and \code{xs} is named, the result is named as \code{xs}, otherwise the result is unnamed. Default is \code{TRUE}.} } \value{ [\code{list} | simplified \code{vector} | \code{matrix}]. See above. } \description{ Extracts a named element from a list of lists. } \examples{ xs = list(list(a = 1, b = 2), list(a = 5, b = 7)) extractSubList(xs, "a") extractSubList(xs, "a", simplify = FALSE) } BBmisc/man/checkListElementClass.Rd0000644000175100001440000000125212741010551016676 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/checkListElementClass.R \name{checkListElementClass} \alias{checkListElementClass} \title{Check that a list contains only elements of a required type.} \usage{ checkListElementClass(xs, cl) } \arguments{ \item{xs}{[\code{list}]\cr Argument.} \item{cl}{[\code{character(1)}]\cr Class that elements must have. Checked with \code{is}.} } \value{ Nothing. } \description{ Check that argument is a list and contains only elements of a required type. Throws exception if check is not passed. Note that argument is evaluated when checked. } \examples{ xs = as.list(1:3) checkListElementClass(xs, "numeric") } BBmisc/man/setValue.Rd0000644000175100001440000000103312741010551014252 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/setValue.R \name{setValue} \alias{setValue} \title{Set a list element to a new value.} \usage{ setValue(obj, index, newval) } \arguments{ \item{obj}{[\code{list}]\cr} \item{index}{[\code{character} | \code{integer}]\cr Index or indices where to insert the new values.} \item{newval}{[any]\cr Inserted elements(s). Has to be a list if \code{index} is a vector.} } \value{ [\code{list}] } \description{ This wrapper supports setting elements to \code{NULL}. } BBmisc/man/isProperlyNamed.Rd0000644000175100001440000000075312741010551015607 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/isProperlyNamed.R \name{isProperlyNamed} \alias{isProperlyNamed} \title{Are all elements of a list / vector uniquely named?} \usage{ isProperlyNamed(x) } \arguments{ \item{x}{[\code{vector}]\cr The vector or list.} } \value{ [\code{logical(1)}]. } \description{ \code{NA} or \dQuote{} are not allowed as names. } \examples{ isProperlyNamed(list(1)) isProperlyNamed(list(a = 1)) isProperlyNamed(list(a = 1, 2)) } BBmisc/man/catf.Rd0000644000175100001440000000124212741010551013401 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/catf.R \name{catf} \alias{catf} \title{Wrapper for cat and sprintf.} \usage{ catf(..., file = "", append = FALSE, newline = TRUE) } \arguments{ \item{...}{[any]\cr See \code{\link{sprintf}}.} \item{file}{[\code{character(1)}]\cr See \code{\link{cat}}. Default is \dQuote{}.} \item{append}{[\code{logical(1)}]\cr See \code{\link{cat}}. Default is \code{FALSE}.} \item{newline}{[\code{logical(1)}]\cr Append newline at the end? Default is \code{TRUE}.} } \value{ Nothing. } \description{ A simple wrapper for \code{cat(sprintf(...))}. } \examples{ msg = "a message." catf("This is \%s", msg) } BBmisc/man/symdiff.Rd0000644000175100001440000000060612741010551014130 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/symdiff.R \name{symdiff} \alias{symdiff} \title{Calculates symmetric set difference between two sets.} \usage{ symdiff(x, y) } \arguments{ \item{x}{[\code{vector}]\cr Set 1.} \item{y}{[\code{vector}]\cr Set 2.} } \value{ [\code{vector}]. } \description{ Calculates symmetric set difference between two sets. } BBmisc/man/messagef.Rd0000644000175100001440000000076512741010551014267 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/messagef.R \name{messagef} \alias{messagef} \title{Wrapper for message and sprintf.} \usage{ messagef(..., .newline = TRUE) } \arguments{ \item{...}{[any]\cr See \code{\link{sprintf}}.} \item{.newline}{[logical(1)]\cr Add a newline to the message. Default is \code{TRUE}.} } \value{ Nothing. } \description{ A simple wrapper for \code{message(sprintf(...))}. } \examples{ msg = "a message" warningf("this is \%s", msg) } BBmisc/man/getAttributeNames.Rd0000644000175100001440000000076312741010551016122 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/getAttributeNames.R \name{getAttributeNames} \alias{getAttributeNames} \title{Helper function for determining the vector of attribute names of a given object.} \usage{ getAttributeNames(obj) } \arguments{ \item{obj}{[any]\cr Source object.} } \value{ [\code{character}] Vector of attribute names for the source object. } \description{ Helper function for determining the vector of attribute names of a given object. } BBmisc/man/lsort.Rd0000644000175100001440000000062112741010551013627 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/lsort.R \name{lsort} \alias{lsort} \title{A wrapper for \code{\link{sort}} to sort using the \dQuote{C} collating rules.} \usage{ lsort(...) } \arguments{ \item{...}{Options passed to sort.} } \value{ See \code{\link{sort}}. } \description{ A wrapper for \code{\link{sort}} to sort using the \dQuote{C} collating rules. } BBmisc/man/getMaxIndex.Rd0000644000175100001440000000153412741010551014705 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/getMaxIndex.R \name{getMaxIndex} \alias{getMaxIndex} \alias{getMinIndex} \title{Return index of maximal/minimal element in numerical vector.} \usage{ getMaxIndex(x, ties.method = "random", na.rm = FALSE) getMinIndex(x, ties.method = "random", na.rm = FALSE) } \arguments{ \item{x}{[\code{numeric}]\cr Input vector.} \item{ties.method}{[\code{character(1)}]\cr How should ties be handled? Possible are: \dQuote{random}, \dQuote{first}, \dQuote{last}. Default is \dQuote{random}.} \item{na.rm}{[\code{logical(1)}]\cr If \code{FALSE}, NA is returned if an NA is encountered in \code{x}. If \code{TRUE}, NAs are disregarded. Default is \code{FALSE}} } \value{ [\code{integer(1)}]. } \description{ If \code{x} is empty or only contains NAs which are to be removed, -1 is returned. } BBmisc/man/deprecated.Rd0000644000175100001440000000127112741010551014566 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/zzz_deprecated.R \name{deprecated} \alias{convertDfCols} \alias{deprecated} \alias{listToShortString} \title{Deprecated function. Do not use!} \usage{ convertDfCols(df, chars.as.factor = FALSE, factors.as.char = FALSE, ints.as.num = FALSE, logicals.as.factor = FALSE) listToShortString(x, num.format = "\%.4g", clip.len = 15L) } \arguments{ \item{df}{No text} \item{chars.as.factor}{No text} \item{factors.as.char}{No text} \item{ints.as.num}{No text} \item{logicals.as.factor}{No text} \item{x}{No text} \item{num.format}{No text} \item{clip.len}{No text} } \description{ Deprecated function. Do not use! } BBmisc/man/itostr.Rd0000644000175100001440000000133712741010551014015 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/itostr.R \name{itostr} \alias{itostr} \title{Convert Integers to Strings} \usage{ itostr(x, base = 10L) } \arguments{ \item{x}{[\code{integer}]\cr Vector of integers to convert.} \item{base}{[\code{integer(1)}]\cr Base for conversion. Values between 2 and 36 (inclusive) are allowed.} } \value{ \code{character(length(x))}. } \description{ This is the counterpart of \code{\link[base]{strtoi}}. For a base greater than \sQuote{10}, letters \sQuote{a} to \sQuote{z} are used to represent \sQuote{10} to \sQuote{35}. } \examples{ # binary representation of the first 10 natural numbers itostr(1:10, 2) # base36 encoding of a large number itostr(1e7, 36) } BBmisc/man/isValidName.Rd0000644000175100001440000000126512741010551014665 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/isValidName.R \name{isValidName} \alias{isValidName} \title{Can some strings be used for column or list element names without problems?} \usage{ isValidName(x, unique = TRUE) } \arguments{ \item{x}{[\code{character}]\cr Character vector to check.} \item{unique}{[\code{logical(1)}]\cr Should the names be unique? Default is \code{TRUE}.} } \value{ [\code{logical}]. One Boolean entry for each string in \code{x}. If the entries are not unique and \code{unique} is enabled, the first duplicate will be \code{FALSE}. } \description{ Can some strings be used for column or list element names without problems? } BBmisc/man/which.first.Rd0000644000175100001440000000142612741010551014720 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/which.first.R \name{which.first} \alias{which.first} \alias{which.last} \title{Find the index of first/last \code{TRUE} value in a logical vector.} \usage{ which.first(x, use.names = TRUE) which.last(x, use.names = TRUE) } \arguments{ \item{x}{[\code{logical}]\cr Logical vector.} \item{use.names}{[\code{logical(1)}]\cr If \code{TRUE} and \code{x} is named, the result is also named.} } \value{ [\code{integer(1)} | \code{integer(0)}]. Returns the index of the first/last \code{TRUE} value in \code{x} or an empty integer vector if none is found. } \description{ Find the index of first/last \code{TRUE} value in a logical vector. } \examples{ which.first(c(FALSE, TRUE)) which.last(c(FALSE, FALSE)) } BBmisc/man/getUsedFactorLevels.Rd0000644000175100001440000000063712741010551016405 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/getUsedFactorLevels.R \name{getUsedFactorLevels} \alias{getUsedFactorLevels} \title{Determines used factor levels.} \usage{ getUsedFactorLevels(x) } \arguments{ \item{x}{[\code{factor}]\cr The factor.} } \value{ [\code{character}] } \description{ Determines the factor levels of a factor type vector that are actually occuring in it. } BBmisc/man/convertDataFrameCols.Rd0000644000175100001440000000176012741010551016537 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/convertDataFrameCols.R \name{convertDataFrameCols} \alias{convertDataFrameCols} \title{Converts columns in a data frame to characters, factors or numerics.} \usage{ convertDataFrameCols(df, chars.as.factor = FALSE, factors.as.char = FALSE, ints.as.num = FALSE, logicals.as.factor = FALSE) } \arguments{ \item{df}{[\code{data.frame}]\cr Data frame.} \item{chars.as.factor}{[\code{logical(1)}]\cr Should characters be converted to factors? Default is \code{FALSE}.} \item{factors.as.char}{[\code{logical(1)}]\cr Should characters be converted to factors? Default is \code{FALSE}.} \item{ints.as.num}{[\code{logical(1)}]\cr Should integers be converted to numerics? Default is \code{FALSE}.} \item{logicals.as.factor}{[\code{logical(1)}]\cr Should logicals be converted to factors? Default is \code{FALSE}.} } \value{ [\code{data.frame}]. } \description{ Converts columns in a data frame to characters, factors or numerics. } BBmisc/man/isScalarNA.Rd0000644000175100001440000000061612741010551014450 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/isScalarNA.R \name{isScalarNA} \alias{isScalarNA} \title{Checks whether an object is a scalar NA value.} \usage{ isScalarNA(x) } \arguments{ \item{x}{[any]\cr Object to check.} } \value{ [\code{logical(1)}]. } \description{ Checks whether object is from \code{(NA, NA_integer, NA_real_, NA_character_, NA_complex_)}. } BBmisc/man/setClasses.Rd0000644000175100001440000000070412741010551014577 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/setClasses.R \name{setClasses} \alias{setClasses} \title{A wrapper for \code{class(x) = classes}.} \usage{ setClasses(x, classes) } \arguments{ \item{x}{[any]\cr Your object.} \item{classes}{[\code{character}]\cr New classes.} } \value{ Changed object \code{x}. } \description{ A wrapper for \code{class(x) = classes}. } \examples{ setClasses(list(), c("foo1", "foo2")) } BBmisc/man/makeFileCache.Rd0000644000175100001440000000123512741010551015127 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/FileCache.R \name{makeFileCache} \alias{makeFileCache} \title{A caching wrapper around load2.} \usage{ makeFileCache(use.cache = TRUE) } \arguments{ \item{use.cache}{[\code{logical(1)}]\cr Enable the cache? Default is \code{TRUE}.} } \value{ [\code{function()}] with argument \code{slot} (name of the slot to cache the object in, default is \dQuote{default}). All other arguments are passed down to \code{\link{load2}}. } \description{ This closure returns a wrapper around \code{\link{load2}} which per default caches loaded objects and returns the cached version in subsequent calls. } BBmisc/man/names2.Rd0000644000175100001440000000141412741010551013652 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/names2.R \name{names2} \alias{names2} \title{Replacement for names which always returns a vector.} \usage{ names2(x, missing.val = NA_character_) } \arguments{ \item{x}{[\code{ANY}]\cr Object, probably named.} \item{missing.val}{[\code{ANY}]\cr Value to set for missing names. Default is \code{NA_character_}.} } \value{ [\code{character}]: vector of the same length as \code{x}. } \description{ A simple wrapper for \code{\link[base]{names}}. Returns a vector even if no names attribute is set. Values \code{NA} and \code{""} are treated as missing and replaced with the value provided in \code{missing.val}. } \examples{ x = 1:3 names(x) names2(x) names(x[1:2]) = letters[1:2] names(x) names2(x) } BBmisc/man/binPack.Rd0000644000175100001440000000171112741010551014034 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/binPack.R \name{binPack} \alias{binPack} \title{Simple bin packing.} \usage{ binPack(x, capacity) } \arguments{ \item{x}{[\code{numeric}]\cr Numeric vector of elements to group.} \item{capacity}{[\code{numeric(1)}]\cr Maximum capacity of each bin, i.e., elements will be grouped so their sum does not exceed this limit.} } \value{ [\code{integer}]. Integer with values \dQuote{1} to \dQuote{n.bins} indicating bin membership. } \description{ Maps numeric items in \code{x} into groups with sum less or equal than \code{capacity}. A very simple greedy algorithm is used, which is not really optimized for speed. This is a convenience function for smaller vectors, not a competetive solver for the real binbacking problem. If an element of \code{x} exceeds \code{capacity}, an error is thrown. } \examples{ x = 1:10 bp = binPack(x, 11) xs = split(x, bp) print(xs) print(sapply(xs, sum)) } BBmisc/man/requirePackages.Rd0000644000175100001440000000455712741010551015613 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/requirePackages.R \name{requirePackages} \alias{requirePackages} \title{Require some packages.} \usage{ requirePackages(packs, min.versions = NULL, why = "", stop = TRUE, suppress.warnings = FALSE, default.method = "attach") } \arguments{ \item{packs}{[\code{character}]\cr Names of packages. If a package name is prefixed with \dQuote{!}, it will be attached using \code{\link[base]{require}}. If a package name is prefixed with \dQuote{_}, its namespace will be loaded using \code{\link[base]{requireNamespace}}. If there is no prefix, argument \code{default.method} determines how to deal with package loading.} \item{min.versions}{[\code{character}]\cr A char vector specifying required minimal version numbers for a subset of packages in \code{packs}. Must be named and all names must be in \code{packs}. The only exception is when \code{packs} is only a single string, then you are allowed to pass an unnamed version string here. Default is \code{NULL}, meaning no special version requirements} \item{why}{[\code{character(1)}]\cr Short string explaining why packages are required. Default is an empty string.} \item{stop}{[\code{logical(1)}]\cr Should an exception be thrown for missing packages? Default is \code{TRUE}.} \item{suppress.warnings}{[\code{logical(1)}]\cr Should warnings be supressed while requiring? Default is \code{FALSE}.} \item{default.method}{[\code{character(1)}]\cr If the packages are not explicitly prefixed with \dQuote{!} or \dQuote{_}, this arguments determines the default. Possible values are \dQuote{attach} and \dQuote{load}. Note that the default is \dQuote{attach}, but this might/will change in a future version, so please make sure to always explicitly set this.} } \value{ [\code{logical}]. Named logical vector describing which packages could be loaded (with required version). Same length as \code{packs}. } \description{ Packages are loaded either via \code{\link{requireNamespace}} or \code{\link{require}}. If some packages could not be loaded and \code{stop} is \code{TRUE} the following exception is thrown: \dQuote{For please install the following packages: }. If \code{why} is \code{NULL} the message is: \dQuote{Please install the following packages: }. } \examples{ requirePackages(c("BBmisc", "base"), why = "BBmisc example") } BBmisc/man/isEmptyDirectory.Rd0000644000175100001440000000076512741010551016014 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/directory.R \name{isEmptyDirectory} \alias{isEmptyDirectory} \title{Is one / are several directories empty?} \usage{ isEmptyDirectory(...) } \arguments{ \item{...}{[\code{character(1)}]\cr Directory names, all strings.} } \value{ [\code{logical}]. } \description{ If file does not exist or is not a directory, \code{FALSE} is returned. } \examples{ print(isEmptyDirectory(tempdir())) print(isEmptyDirectory(tempfile())) } BBmisc/man/asQuoted.Rd0000644000175100001440000000106112741010551014250 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/asQuoted.R \name{asQuoted} \alias{asQuoted} \title{Converts a string into a quoted expression.} \usage{ asQuoted(s, env = parent.frame()) } \arguments{ \item{s}{[\code{character(1)}]\cr Expression as string.} \item{env}{[\code{numeric(1)}]\cr Environment for expression. Default is \code{parent.frame()}} } \value{ Quoted expression. } \description{ Works the same as if you would have entered the expression and called \code{\link{quote}} on it. } \examples{ asQuoted("x == 3") } BBmisc/man/rangeVal.Rd0000644000175100001440000000103112741010551014217 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/rangeVal.R \name{rangeVal} \alias{rangeVal} \title{Calculate range statistic.} \usage{ rangeVal(x, na.rm = FALSE) } \arguments{ \item{x}{[\code{numeric}]\cr The vector.} \item{na.rm}{[\code{logical(1)}]\cr If \code{FALSE}, NA is returned if an NA is encountered in \code{x}. If \code{TRUE}, NAs are disregarded. Default is \code{FALSE}} } \value{ [\code{numeric(1)}]. } \description{ A simple wrapper for \code{diff(range(x))}, so \code{max(x) - min(x)}. } BBmisc/man/convertIntegers.Rd0000644000175100001440000000123012741010551015642 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/convertInteger.R \name{convertIntegers} \alias{convertIntegers} \title{Conversion for integer vector.} \usage{ convertIntegers(x) } \arguments{ \item{x}{[any]\cr Argument.} } \value{ Either an integer vector if conversion was done or \code{x} unchanged. } \description{ Convert numeric vector to integer vector if the numeric vector fully represents an integer vector, e.g. \code{c(1, 5)} to \code{c(1L, 5L)}. Otherwise the argument is returned unchanged. } \examples{ str(convertIntegers(1.0)) str(convertIntegers(1.3)) str(convertIntegers(c(1.0, 2.0))) str(convertIntegers("foo")) } BBmisc/man/load2.Rd0000644000175100001440000000207512741010551013472 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/load2.R \name{load2} \alias{load2} \title{Load RData file and return objects in it.} \usage{ load2(file, parts, simplify = TRUE, envir, impute) } \arguments{ \item{file}{[\code{character(1)}]\cr File to load.} \item{parts}{[\code{character}]\cr Elements in file to load. Default is all.} \item{simplify}{[\code{logical(1)}]\cr If \code{TRUE}, a list is only returned if \code{parts} and the file contain both more than 1 element, otherwise the element is directly returned. Default is \code{TRUE}.} \item{envir}{[\code{environment(1)}]\cr Assign objects to this environment. Default is not to assign.} \item{impute}{[\code{ANY}]\cr If \code{file} does not exists, return \code{impute} instead. Default is missing which will result in an exception if \code{file} is not found.} } \value{ Either a single object or a list. } \description{ Load RData file and return objects in it. } \examples{ fn = tempfile() save2(file = fn, a = 1, b = 2, c = 3) load2(fn, parts = "a") load2(fn, parts = c("a", "c")) } BBmisc/man/makeDataFrame.Rd0000644000175100001440000000236312741010551015153 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/makeDataFrame.R \name{makeDataFrame} \alias{makeDataFrame} \title{Initialize data.frame in a convenient way.} \usage{ makeDataFrame(nrow, ncol, col.types, init, row.names = NULL, col.names = sprintf("V\%i", seq_len(ncol))) } \arguments{ \item{nrow}{[\code{integer(1)}]\cr Nubmer of rows.} \item{ncol}{[\code{integer(1)}]\cr Number of columns.} \item{col.types}{[\code{character(ncol)} | \code{character(1)}]\cr Data types of columns. If you only pass one type, it will be replicated. Supported are all atomic modes also supported by \code{\link[base]{vector}}, i.e. all common data frame types except factors.} \item{init}{[any]\cr Scalar object to initialize all elements of the data.frame. You do not need to specify \code{col.types} if you pass this.} \item{row.names}{[\code{character} | \code{integer} | \code{NULL}]\cr Row names. Default is \code{NULL}.} \item{col.names}{[\code{character} | \code{integer}]\cr Column names. Default is \dQuote{V1}, \dQuote{V2}, and so on.} } \description{ Initialize data.frame in a convenient way. } \examples{ print(makeDataFrame(3, 2, init = 7)) print(makeDataFrame(3, 2, "logical")) print(makeDataFrame(3, 2, c("logical", "numeric"))) } BBmisc/man/capitalizeStrings.Rd0000644000175100001440000000200212741010551016156 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/capitalizeStrings.R \name{capitalizeStrings} \alias{capitalizeStrings} \title{Capitalize strings in a vector} \usage{ capitalizeStrings(x, all.words = FALSE, lower.back = FALSE) } \arguments{ \item{x}{[\code{character(n)}]\cr Vector of character elements to capitalize.} \item{all.words}{[\code{logical(1)}]\cr If \code{TRUE} all words of each vector element are capitalized. \code{FALSE} capitalizes the first word of each vector element.} \item{lower.back}{[\code{logical(1)}]\cr \code{TRUE} lowers the back of each word or vector element (depends on \code{all.words}).} } \value{ Capitalized vector: [\code{character(n)}]. } \description{ Capitalise first word or all words of a character vector. Lower back of vector element or word, respectively. } \examples{ capitalizeStrings(c("the taIl", "wags The dOg", "That looks fuNny!")) capitalizeStrings(c("the taIl", "wags The dOg", "That looks fuNny!") , all.words = TRUE, lower.back = TRUE) } BBmisc/man/getRelativePath.Rd0000644000175100001440000000152312741010551015556 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/getRelativePath.R \name{getRelativePath} \alias{getRelativePath} \title{Construct a path relative to another} \usage{ getRelativePath(to, from = getwd(), ignore.case = isWindows()) } \arguments{ \item{to}{[\code{character(1)}]\cr Where the relative path should point to.} \item{from}{[\code{character(1)}]\cr From which part to start. Default is \code{\link[base]{getwd}}.} \item{ignore.case}{[\code{logical(1)}]\cr Should path comparisons be made case insensitve? Default is \code{TRUE} on Windows systems and \code{FALSE} on other systems.} } \value{ [character(1)]: A relative path. } \description{ Constructs a relative path from path \code{from} to path \code{to}. If this is not possible (i.e. different drive letters on windows systems), \code{NA} is returned. } BBmisc/man/splitPath.Rd0000644000175100001440000000116212741010551014435 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/splitPath.R \name{splitPath} \alias{splitPath} \title{Split a path into components} \usage{ splitPath(path) } \arguments{ \item{path}{[\code{character(1)}]\cr Path to split as string} } \value{ \code{named list}: List with components \dQuote{drive} (\code{character(1)} and \dQuote{path} (\code{character(n)}. } \description{ The first normalized path is split on forward and backward slashes and its components returned as character vector. The drive or network home are extracted separately on windows systems and empty on all other systems. } BBmisc/man/getUnixTime.Rd0000644000175100001440000000043612741010551014732 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/getUnixTime.R \name{getUnixTime} \alias{getUnixTime} \title{Current time in seconds.} \usage{ getUnixTime() } \value{ [\code{integer(1)}]. } \description{ Simple wrapper for \code{as.integer(Sys.time())}. } BBmisc/man/nin.Rd0000644000175100001440000000056512741010551013257 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/nin.R \name{\%nin\%} \alias{\%nin\%} \title{Simply a negated \code{in} operator.} \usage{ x \%nin\% y } \arguments{ \item{x}{[\code{vector}]\cr Values that should not be in \code{y}.} \item{y}{[\code{vector}]\cr Values to match against.} } \description{ Simply a negated \code{in} operator. } BBmisc/man/isScalarValue.Rd0000644000175100001440000000245212741010551015226 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/isScalarValue.R \name{isScalarValue} \alias{isScalarCharacter} \alias{isScalarComplex} \alias{isScalarFactor} \alias{isScalarInteger} \alias{isScalarLogical} \alias{isScalarNumeric} \alias{isScalarValue} \title{Is given argument an atomic vector or factor of length 1?} \usage{ isScalarValue(x, na.ok = TRUE, null.ok = FALSE, type = "atomic") isScalarLogical(x, na.ok = TRUE, null.ok = FALSE) isScalarNumeric(x, na.ok = TRUE, null.ok = FALSE) isScalarInteger(x, na.ok = TRUE, null.ok = FALSE) isScalarComplex(x, na.ok = TRUE, null.ok = FALSE) isScalarCharacter(x, na.ok = TRUE, null.ok = FALSE) isScalarFactor(x, na.ok = TRUE, null.ok = FALSE) } \arguments{ \item{x}{[any]\cr Argument.} \item{na.ok}{[\code{logical(1)}]\cr Is \code{NA} considered a scalar? Default is \code{TRUE}.} \item{null.ok}{[\code{logical(1)}]\cr Is \code{NULL} considered a scalar? Default is \code{FALSE}.} \item{type}{[\code{character(1)}]\cr Allows to restrict to specific type, e.g., \dQuote{numeric}? But instead of this argument you might want to consider using \code{isScalar}. Default is \dQuote{atomic}, so no special restriction.} } \value{ [\code{logical(1)}]. } \description{ More specific functions for scalars of a given type exist, too. } BBmisc/man/pause.Rd0000644000175100001440000000040212741010551013576 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/pause.R \name{pause} \alias{pause} \title{Pause in interactive mode and continue on .} \usage{ pause() } \description{ Pause in interactive mode and continue on . } BBmisc/man/collapsef.Rd0000644000175100001440000000075312741010551014442 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/collapsef.R \name{collapsef} \alias{collapsef} \title{Collapse vector to string.} \usage{ collapsef(..., sep = ",") } \arguments{ \item{...}{[any]\cr See \code{\link{sprintf}}.} \item{sep}{[\code{character(1)}]\cr See \code{\link{collapse}}.} } \value{ [\code{character(1)}]. } \description{ A simple wrapper for \code{collapse(sprintf, ...)}. } \details{ Useful for vectorized call to \code{\link{sprintf}}. } BBmisc/man/computeMode.Rd0000644000175100001440000000177612741010551014761 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/computeMode.R \name{computeMode} \alias{computeMode} \title{Compute statistical mode of a vector (value that occurs most frequently).} \usage{ computeMode(x, ties.method = "random", na.rm = TRUE) } \arguments{ \item{x}{[\code{vector}]\cr Factor, character, integer, numeric or logical vector.} \item{ties.method}{[\code{character(1)}]\cr \dQuote{first}, \dQuote{random}, \dQuote{last}: Decide which value to take in case of ties. Default is \dQuote{random}.} \item{na.rm}{[\code{logical(1)}]\cr If \code{TRUE}, missing values in the data removed. if \code{FALSE}, they are used as a separate level and this level could therefore be returned as the most frequent one. Default is \code{TRUE}.} } \value{ Modal value of length 1, data type depends on data type of \code{x}. } \description{ Works for integer, numeric, factor and character vectors. The implementation is currently not extremely efficient. } \examples{ computeMode(c(1,2,3,3)) } BBmisc/man/isDirectory.Rd0000644000175100001440000000070312741010551014765 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/directory.R \name{isDirectory} \alias{isDirectory} \title{Is one / are several files a directory?} \usage{ isDirectory(...) } \arguments{ \item{...}{[\code{character(1)}]\cr File names, all strings.} } \value{ [\code{logical}]. } \description{ If a file does not exist, \code{FALSE} is returned. } \examples{ print(isDirectory(tempdir())) print(isDirectory(tempfile())) } BBmisc/man/save2.Rd0000644000175100001440000000221212741010551013502 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/save2.R \name{save2} \alias{save2} \title{Save multiple objects to a file.} \usage{ save2(file, ..., ascii = FALSE, version = NULL, compress = !ascii, compression_level, eval.promises = TRUE, precheck = TRUE) } \arguments{ \item{file}{File to save.} \item{...}{[\code{any}]\cr Will be converted to an environment and then passed to \code{\link[base]{save}}.} \item{ascii}{See help of \code{\link[base]{save}}.} \item{version}{See help of \code{\link[base]{save}}.} \item{compress}{See help of \code{\link[base]{save}}.} \item{compression_level}{See help of \code{\link[base]{save}}.} \item{eval.promises}{See help of \code{\link[base]{save}}.} \item{precheck}{See help of \code{\link[base]{save}}.} } \value{ See help of \code{\link[base]{save}}. } \description{ A simple wrapper for \code{\link[base]{save}}. Understands key = value syntax to save objects using arbitrary variable names. All options of \code{\link[base]{save}}, except \code{list} and \code{envir}, are available and passed to \code{\link[base]{save}}. } \examples{ x = 1 save2(y = x, file = tempfile()) } BBmisc/man/isFALSE.Rd0000644000175100001440000000055512741010551013660 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/isFALSE.R \name{isFALSE} \alias{isFALSE} \title{A wrapper for \code{identical(x, FALSE)}.} \usage{ isFALSE(x) } \arguments{ \item{x}{[any]\cr Your object.} } \value{ [\code{logical(1)}]. } \description{ A wrapper for \code{identical(x, FALSE)}. } \examples{ isFALSE(0) isFALSE(FALSE) } BBmisc/man/is.error.Rd0000644000175100001440000000110512741010551014225 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/is_error.R \name{is.error} \alias{is.error} \title{Is return value of try an exception?} \usage{ is.error(x) } \arguments{ \item{x}{[any]\cr Any object, usually the return value of \code{\link[base]{try}}, \code{\link[base]{tryCatch}}, or a function which may return a \code{\link[base]{simpleError}}.} } \value{ [\code{logical(1)}]. } \description{ Checks if an object is of class \dQuote{try-error} or \dQuote{error}. } \examples{ x = try(stop("foo")) print(is.error(x)) x = 1 print(is.error(x)) } BBmisc/man/vlapply.Rd0000644000175100001440000000174512741010551014163 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/vapply.R \name{vlapply} \alias{vcapply} \alias{viapply} \alias{vlapply} \alias{vnapply} \title{Apply a function with a predefined return value} \usage{ vlapply(x, fun, ..., use.names = TRUE) viapply(x, fun, ..., use.names = TRUE) vnapply(x, fun, ..., use.names = TRUE) vcapply(x, fun, ..., use.names = TRUE) } \arguments{ \item{x}{[\code{vector} or \code{list}]\cr Object to apply function on.} \item{fun}{[\code{function}]\cr Function to apply on each element of \code{x}.} \item{...}{[\code{ANY}]\cr Additional arguments for \code{fun}.} \item{use.names}{[\code{logical(1)}]\cr Should result be named? Default is \code{TRUE}.} } \description{ These are just wrappers around \code{\link[base]{vapply}} with argument \code{FUN.VALUE} set. The function is expected to return a single \code{logical}, \code{integer}, \code{numeric} or \code{character} value, depending on the second letter of the function name. } BBmisc/man/isExpensiveExampleOk.Rd0000644000175100001440000000142712741010551016601 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/isExpensiveExampleOk.R \name{isExpensiveExampleOk} \alias{isExpensiveExampleOk} \title{Conditional checking for expensive examples.} \usage{ isExpensiveExampleOk() } \value{ [\code{logical(1)}]. } \description{ Queries environment variable \dQuote{R_EXPENSIVE_EXAMPLE_OK}. Returns \code{TRUE} iff set exactly to \dQuote{TRUE}. This allows conditional checking of expensive examples in packages via R CMD CHECK, so they are not run on CRAN, but at least on your local computer. A better option than \dQuote{dont_run} in many cases, where such examples are not checked at all. } \examples{ # extremely costly random number generation, that we dont want checked on CRAN if (isExpensiveExampleOk()) { runif(1) } } BBmisc/man/mapValues.Rd0000644000175100001440000000264012741010551014424 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/mapValues.R \name{mapValues} \alias{mapValues} \title{Replace values in atomic vectors} \usage{ mapValues(x, from, to, regex = FALSE, ignore.case = FALSE, perl = FALSE, fixed = FALSE) } \arguments{ \item{x}{[\code{atomic}]\cr Atomic vector. If \code{x} is a factor, all replacements work on the levels.} \item{from}{[\code{atomic}]\cr Atomic vector with values to replace, same length as \code{to}.} \item{to}{[\code{atomic}]\cr Atomic vector with replacements, same length as \code{from}.} \item{regex}{[\code{logical}]\cr Use regular expression matching? Default is \code{FALSE}.} \item{ignore.case}{[\code{logical}]\cr Argument passed to \code{\link[base]{gsub}}.} \item{perl}{[\code{logical}]\cr Argument passed to \code{\link[base]{gsub}}.} \item{fixed}{[\code{logical}]\cr Argument passed to \code{\link[base]{gsub}}.} } \value{ [\code{atomic}]. } \description{ Replace values in atomic vectors } \details{ Replaces values specified in \code{from} with values in \code{to}. Regular expression matching can be enabled which calls \code{\link[base]{gsub}} iteratively on \code{x} to replace all patterns in \code{from} with replacements in \code{to}. } \examples{ # replace integers x = 1:5 mapValues(x, c(2, 3), c(99, 100)) # replace factor levels using regex matching x = factor(c("aab", "aba", "baa")) mapValues(x, "a.a", "zzz", regex = TRUE) } BBmisc/man/explode.Rd0000644000175100001440000000110012741010551014115 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/explode.R \name{explode} \alias{explode} \title{Split up a string into substrings.} \usage{ explode(x, sep = " ") } \arguments{ \item{x}{[\code{character}]\cr Source string.} \item{sep}{[\code{character}]\cr Seperator whcih is used to split \code{x} into substrings. Default is \dQuote{ }.} } \value{ [\code{vector}] Vector of substrings. } \description{ Split up a string into substrings according to a seperator. } \examples{ explode("foo bar") explode("comma,seperated,values", sep = ",") } BBmisc/man/do.call2.Rd0000644000175100001440000000174312741010551014070 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/do.call2.R \name{do.call2} \alias{do.call2} \title{Execute a function call similar to \code{do.call}.} \usage{ do.call2(fun, ..., .args = list()) } \arguments{ \item{fun}{[\code{character(1)}]\cr Name of the function to call.} \item{...}{[any]\cr Arguments to \code{fun}. Best practice is to specify them in a \code{key = value} syntax.} \item{.args}{[\code{list}]\cr Arguments to \code{fun} as a (named) list. Will be passed after arguments in \code{...}. Default is \code{list()}.} } \value{ Return value of \code{fun}. } \description{ This function is supposed to be a replacement for \code{\link[base]{do.call}} in situations where you need to pass big R objects. Unlike \code{\link[base]{do.call}}, this function allows to pass objects via \code{...} to avoid a copy. } \examples{ \dontrun{ library(microbenchmark) x = 1:1e7 microbenchmark(do.call(head, list(x, n = 1)), do.call2("head", x, n = 1)) } } BBmisc/man/setAttribute.Rd0000644000175100001440000000102312741010551015140 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/setAttribute.R \name{setAttribute} \alias{setAttribute} \title{A wrapper for \code{attr(x, which) = y}.} \usage{ setAttribute(x, which, value) } \arguments{ \item{x}{[any]\cr Your object.} \item{which}{[\code{character(1)}]\cr Name of the attribute to set} \item{value}{[\code{ANY}]\cr Value for the attribute.} } \value{ Changed object \code{x}. } \description{ A wrapper for \code{attr(x, which) = y}. } \examples{ setAttribute(list(), "foo", 1) } BBmisc/man/convertToShortString.Rd0000644000175100001440000000227312741010551016663 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/convertToShortString.R \name{convertToShortString} \alias{convertToShortString} \title{Converts any R object to a descriptive string so it can be used in messages.} \usage{ convertToShortString(x, num.format = "\%.4g", clip.len = 15L) } \arguments{ \item{x}{[any]\cr The object.} \item{num.format}{[\code{character(1)}]\cr Used to format numerical scalars via \code{\link{sprintf}}. Default is \dQuote{\%.4g}.} \item{clip.len}{[\code{integer(1)}]\cr Used clip atomic vectors via \code{\link{clipString}}. Default is 15.} } \value{ [\code{character(1)}]. } \description{ Atomics: If of length 0 or 1, they are basically printed as they are. Numerics are formated with \code{num.format}. If of length greater than 1, they are collapsed witd \dQuote{,} and clipped. so they do not become excessively long. All others: Currently, only their class is simply printed like \dQuote{}. Lists: The mechanism above is applied (non-recursively) to their elements. The result looks like this: \dQuote{a = 1, = 2, b = , c = }. } \examples{ convertToShortString(list(a = 1, b = NULL, "foo", c = 1:10)) } BBmisc/man/insert.Rd0000644000175100001440000000137212741010551013774 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/insert.R \name{insert} \alias{insert} \title{Insert elements from one list/vector into another list/vector.} \usage{ insert(xs1, xs2, elements) } \arguments{ \item{xs1}{[\code{list}]\cr First list/vector.} \item{xs2}{[\code{list}]\cr Second vector/list. Must be fully and uniquely named.} \item{elements}{[\code{character}]\cr Elements from \code{xs2} to insert into \code{xs1}. Default is all.} } \value{ \code{x1} with replaced elements from \code{x2}. } \description{ Inserts elements from \code{xs2} into \code{xs1} by name, overwriting elements of equal names. } \examples{ xs1 = list(a = 1, b = 2) xs2 = list(b = 1, c = 4) insert(xs1, xs2) insert(xs1, xs2, elements = "c") } BBmisc/man/chunk.Rd0000644000175100001440000000277112741010551013604 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/chunk.R \name{chunk} \alias{chunk} \title{Chunk elements of vectors into blocks of nearly equal size.} \usage{ chunk(x, chunk.size, n.chunks, props, shuffle = FALSE) } \arguments{ \item{x}{[ANY]\cr Vector, list or other type supported by \code{\link[base]{split}}.} \item{chunk.size}{[\code{integer(1)}]\cr Requested number of elements in each chunk. Cannot be used in combination with \code{n.chunks} or \code{props}. If \code{x} cannot be evenly chunked, some chunks will have less elements.} \item{n.chunks}{[\code{integer(1)}]\cr Requested number of chunks. If more chunks than elements in \code{x} are requested, empty chunks are dropped. Can not be used in combination with \code{chunks.size} or \code{props}.} \item{props}{[\code{numeric}]\cr Vector of proportions for chunk sizes. Empty chunks may occur, depending on the length of \code{x} and the given proportions. Cannot be used in combination with \code{chunks.size} or \code{n.chunks}.} \item{shuffle}{[\code{logical(1)}]\cr Shuffle \code{x}? Default is \code{FALSE}.} } \value{ [unnamed \code{list}] of chunks. } \description{ In case of shuffling and vectors that cannot be chunked evenly, it is chosen randomly which levels / chunks will receive 1 element less. If you do not shuffle, always the last chunks will receive 1 element less. } \examples{ xs = 1:10 chunk(xs, chunk.size = 3) chunk(xs, n.chunks = 2) chunk(xs, n.chunks = 2, shuffle = TRUE) chunk(xs, props = c(7, 3)) } BBmisc/man/makeSimpleFileLogger.Rd0000644000175100001440000000225312741010551016516 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/makeSimpleFileLogger.R \name{makeSimpleFileLogger} \alias{SimpleFileLogger} \alias{makeSimpleFileLogger} \title{Simple logger which outputs to a file.} \usage{ makeSimpleFileLogger(logfile, touch = FALSE, keep = 10L) } \arguments{ \item{logfile}{[\code{character(1)}]\cr File to log to.} \item{touch}{[\code{logical(1)}]\cr Should the file be created before the first log message? Default is \code{FALSE}.} \item{keep}{[\code{integer(1)}]\cr Number of log messages to keep in memory for quick access. Default is \code{10}.} } \value{ [\code{\link{SimpleFileLogger}}]. A list with following functions: \item{log [\code{function(msg)}]}{Send log message.} \item{getMessages [\code{function(n)}]}{Get last \code{n} log messages.} \item{clear [\code{function()}]}{Resets logger and deletes log file.} \item{getSize [\code{function()}]}{Returns the number of logs written.} \item{getLogfile [\code{function()}]}{Returns the full file name logs are written to.} } \description{ Creates a simple file logger closure to log to a file, including time stamps. An optional buffer holds the last few log messages. } BBmisc/man/lib.Rd0000644000175100001440000000111212741010551013226 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/lib.R \name{lib} \alias{lib} \title{A wrapper for \code{library}.} \usage{ lib(...) } \arguments{ \item{...}{[any]\cr Package names.} } \value{ [\code{logical}]: Named logical vector determining the success of package load. } \description{ Tries to load packages. If the packages are not found, they will be installed from the default repository. This function is intended for use in interactive sessions and should not be used by other packages. } \examples{ \dontrun{ lib("BBmisc", "MASS", "rpart") } } BBmisc/man/coalesce.Rd0000644000175100001440000000064712741010551014252 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/coalesce.R \name{coalesce} \alias{coalesce} \title{Returns first non-missing, non-null argument.} \usage{ coalesce(...) } \arguments{ \item{...}{[any]\cr Arguments.} } \value{ [any]. } \description{ Returns first non-missing, non-null argument, otherwise \code{NULL}. } \examples{ f = function(x,y) { print(coalesce(NULL, x, y)) } f(y = 3) } BBmisc/man/filterNull.Rd0000644000175100001440000000046712741010551014614 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/filterNull.R \name{filterNull} \alias{filterNull} \title{Filter a list for NULL values} \usage{ filterNull(li) } \arguments{ \item{li}{[\code{list}]\cr List.} } \value{ [\code{list}]. } \description{ Filter a list for NULL values } BBmisc/man/convertInteger.Rd0000644000175100001440000000114512741010551015464 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/convertInteger.R \name{convertInteger} \alias{convertInteger} \title{Conversion for single integer.} \usage{ convertInteger(x) } \arguments{ \item{x}{[any]\cr Argument.} } \value{ Either a single integer if conversion was done or \code{x} unchanged. } \description{ Convert single numeric to integer only if the numeric represents a single integer, e.g. 1 to 1L. Otherwise the argument is returned unchanged. } \examples{ str(convertInteger(1.0)) str(convertInteger(1.3)) str(convertInteger(c(1.0, 2.0))) str(convertInteger("foo")) } BBmisc/man/namedList.Rd0000644000175100001440000000112312741010551014402 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/namedList.R \name{namedList} \alias{namedList} \title{Create named list, possibly initialized with a certain element.} \usage{ namedList(names, init) } \arguments{ \item{names}{[\code{character}]\cr Names of elements.} \item{init}{[valid R expression]\cr If given all list elements are initialized to this, otherwise \code{NULL} is used.} } \value{ [\code{list}]. } \description{ Create named list, possibly initialized with a certain element. } \examples{ namedList(c("a", "b")) namedList(c("a", "b"), init = 1) } BBmisc/man/getClass1.Rd0000644000175100001440000000060712741010551014316 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/getClass1.R \name{getClass1} \alias{getClass1} \title{Wrapper for \code{class(x)[1]}.} \usage{ getClass1(x) } \arguments{ \item{x}{[any]\cr Input object.} } \value{ [\code{character(1)}]. } \description{ Wrapper for \code{class(x)[1]}. } \note{ \code{getClass} is a function in \code{methods}. Do not confuse. } BBmisc/man/dapply.Rd0000644000175100001440000000136412741010551013762 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/dapply.R \name{dapply} \alias{dapply} \title{Call \code{lapply} on an object and return a data.frame.} \usage{ dapply(x, fun, ..., col.names) } \arguments{ \item{x}{[\code{data.frame}]\cr Data frame.} \item{fun}{[\code{function}]\cr The function to apply.} \item{...}{[any]\cr Further arguments passed down to \code{fun}.} \item{col.names}{[\code{character(1)}]\cr Column names for result. Default are the names of \code{x}.} } \value{ [\code{data.frame}]. } \description{ Applies a function \code{fun} on each element of input \code{x} and combines the results as \code{data.frame} columns. The results will get replicated to have equal length if necessary and possible. } BBmisc/man/normalize.Rd0000644000175100001440000000415312741010551014470 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/normalize.R \name{normalize} \alias{normalize} \title{Normalizes numeric data to a given scale.} \usage{ normalize(x, method = "standardize", range = c(0, 1), margin = 1L, on.constant = "quiet") } \arguments{ \item{x}{[\code{numeric} | \code{matrix} | \code{data.frame}]\cr Input vector.} \item{method}{[\code{character(1)}]\cr Normalizing method. Available are:\cr \dQuote{center}: Subtract mean.\cr \dQuote{scale}: Divide by standard deviation.\cr \dQuote{standardize}: Center and scale.\cr \dQuote{range}: Scale to a given range.\cr} \item{range}{[\code{numeric(2)}]\cr Range for method \dQuote{range}. The first value represents the replacement for the min value, the second is the substitute for the max value. So it is possible to reverse the order by giving \code{range = c(1,0)}. Default is \code{c(0,1)}.} \item{margin}{[\code{integer(1)}]\cr 1 = rows, 2 = cols. Same is in \code{\link{apply}} Default is 1.} \item{on.constant}{[\code{character(1)}]\cr How should constant vectors be treated? Only used, of \dQuote{method != center}, since this methods does not fail for constant vectors. Possible actions are:\cr \dQuote{quiet}: Depending on the method, treat them quietly:\cr \dQuote{scale}: No division by standard deviation is done, input values. will be returned untouched.\cr \dQuote{standardize}: Only the mean is subtracted, no division is done.\cr \dQuote{range}: All values are mapped to the mean of the given range.\cr \dQuote{warn}: Same behaviour as \dQuote{quiet}, but print a warning message.\cr \dQuote{stop}: Stop with an error.\cr} } \value{ [\code{numeric} | \code{matrix} | \code{data.frame}]. } \description{ Currently implemented for numeric vectors, numeric matrices and data.frame. For matrixes one can operate on rows or columns For data.frames, only the numeric columns are touched, all others are left unchanged. For constant vectors / rows / columns most methods fail, special behaviour for this case is implemented. The method also handles NAs in in \code{x} and leaves them untouched. } \seealso{ \code{\link{scale}} } BBmisc/man/warningf.Rd0000644000175100001440000000130712741010551014301 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/warningf.R \name{warningf} \alias{warningf} \title{Wrapper for warning and sprintf.} \usage{ warningf(..., immediate = TRUE, warning.length = 8170L) } \arguments{ \item{...}{[any]\cr See \code{\link{sprintf}}.} \item{immediate}{[\code{logical(1)}]\cr See \code{\link{warning}}. Default is \code{TRUE}.} \item{warning.length}{[\code{integer(1)}]\cr Number of chars after which the warning message gets truncated, see ?options. Default is 8170.} } \value{ Nothing. } \description{ A wrapper for \code{\link{warning}} with \code{\link{sprintf}} applied to the arguments. } \examples{ msg = "a warning" warningf("this is \%s", msg) } BBmisc/man/stopf.Rd0000644000175100001440000000124112741010551013616 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/stopf.R \name{stopf} \alias{stopf} \title{Wrapper for stop and sprintf.} \usage{ stopf(..., warning.length = 8170L) } \arguments{ \item{...}{[any]\cr See \code{\link{sprintf}}.} \item{warning.length}{[\code{integer(1)}]\cr Number of chars after which the error message gets truncated, see ?options. Default is 8170.} } \value{ Nothing. } \description{ A wrapper for \code{\link{stop}} with \code{\link{sprintf}} applied to the arguments. Notable difference is that error messages are not truncated to 1000 characters by default. } \examples{ err = "an error." try(stopf("This is \%s", err)) } BBmisc/man/rowLapply.Rd0000644000175100001440000000264312741010551014463 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/rowLapply.R \name{rowLapply} \alias{rowLapply} \alias{rowSapply} \title{Apply function to rows of a data frame.} \usage{ rowLapply(df, fun, ..., unlist = FALSE) rowSapply(df, fun, ..., unlist = FALSE, simplify = TRUE, use.names = TRUE) } \arguments{ \item{df}{[\code{data.frame}]\cr Data frame.} \item{fun}{[\code{function}]\cr Function to apply. Rows are passed as list or vector, depending on argument \code{unlist}, as first argument.} \item{...}{[\code{ANY}]\cr Additional arguments for \code{fun}.} \item{unlist}{[\code{logical(1)}]\cr Unlist the row? Note that automatic conversion may be triggered for lists of mixed data types Default is \code{FALSE}.} \item{simplify}{[\code{logical(1)} | character(1)]\cr Should the result be simplified? See \code{\link{sapply}}. If \dQuote{cols}, we expect the call results to be vectors of the same length and they are arranged as the columns of the resulting matrix. If \dQuote{rows}, likewise, but rows of the resulting matrix. Default is \code{TRUE}.} \item{use.names}{[\code{logical(1)}]\cr Should result be named by the row names of \code{df}? Default is \code{TRUE}.} } \value{ [\code{list} or simplified object]. Length is \code{nrow(df)}. } \description{ Just like an \code{\link[base]{lapply}} on data frames, but on the rows. } \examples{ rowLapply(iris, function(x) x$Sepal.Length + x$Sepal.Width) } BBmisc/man/ensureVector.Rd0000644000175100001440000000163512741010551015156 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/ensureVector.R \name{ensureVector} \alias{ensureVector} \title{Blow up single scalars / objects to vectors / list by replication.} \usage{ ensureVector(x, n, cl = NULL, names = NULL) } \arguments{ \item{x}{[any]\cr Input element.} \item{n}{[\code{integer}]\cr Desired length.} \item{cl}{[\code{character(1)}*]\cr Only do the operation if \code{x} inherits from this class, otherwise simply let x pass. Default is \code{NULL} which means to always do the operation.} \item{names}{[\code{character}*] \cr Names for result. Default is \code{NULL}, which means no names.} } \value{ Ether a vector or list of length \code{n} with replicated \code{x} or \code{x} unchanged.. } \description{ Useful for standard argument conversion where a user can input a single element, but this has to be replicated now n times for a resulting vector or list. } BBmisc/man/collapse.Rd0000644000175100001440000000103212741010551014263 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/collapse.R \name{collapse} \alias{collapse} \title{Collapse vector to string.} \usage{ collapse(x, sep = ",") } \arguments{ \item{x}{[\code{vector}]\cr Vector to collapse.} \item{sep}{[\code{character(1)}]\cr Passed to \code{collapse} in \code{\link{paste}}. Default is \dQuote{,}.} } \value{ [\code{character(1)}]. } \description{ A simple wrapper for \code{paste(x, collapse)}. } \examples{ collapse(c("foo", "bar")) collapse(c("foo", "bar"), sep = ";") } BBmisc/man/clipString.Rd0000644000175100001440000000141012741010551014577 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/clipString.R \name{clipString} \alias{clipString} \title{Shortens strings to a given length.} \usage{ clipString(x, len, tail = "...") } \arguments{ \item{x}{[\code{character}]\cr Vector of strings.} \item{len}{[\code{integer(1)}]\cr Absolute length the string should be clipped to, including \code{tail}. Note that you cannot clip to a shorter length than \code{tail}.} \item{tail}{[\code{character(1)}]\cr If the string has to be shortened at least 1 character, the final characters will be \code{tail}. Default is \dQuote{...}.} } \value{ [\code{character(1)}]. } \description{ Shortens strings to a given length. } \examples{ print(clipString("abcdef", 10)) print(clipString("abcdef", 5)) } BBmisc/man/printToChar.Rd0000644000175100001440000000111612741010551014721 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/printToChar.R \name{printToChar} \alias{printToChar} \title{Prints object to a string / character vector.} \usage{ printToChar(x, collapse = "\\n") } \arguments{ \item{x}{[any]\cr Object to print} \item{collapse}{[\code{character(1)}]\cr Used to collapse multiple lines. \code{NULL} means no collapsing, vector is returned. Default is \dQuote{\\n}.} } \value{ [\code{character}]. } \description{ Prints object to a string / character vector. } \examples{ x = data.frame(a = 1:2, b = 3:4) str(printToChar(x)) } BBmisc/man/sortByCol.Rd0000644000175100001440000000126612741010551014412 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/sortByCol.R \name{sortByCol} \alias{sortByCol} \title{Sort the rows of a data.frame according to one or more columns.} \usage{ sortByCol(x, col, asc = TRUE) } \arguments{ \item{x}{[\code{data.frame}]\cr Data.frame to sort.} \item{col}{[\code{character}]\cr One or more column names to sort \code{x} by. In order of preference.} \item{asc}{[\code{logical}]\cr Sort ascending (or descending)? One value per entry of \code{col}. If a scalar logical is passed, it is replicated. Default is \code{TRUE}.} } \value{ [\code{data.frame}]. } \description{ Sort the rows of a data.frame according to one or more columns. } BBmisc/man/argsAsNamedList.Rd0000644000175100001440000000077212741010551015514 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/argsAsNamedList.R \name{argsAsNamedList} \alias{argsAsNamedList} \title{Parses \code{...} arguments to a named list.} \usage{ argsAsNamedList(...) } \arguments{ \item{...}{Arbitrary number of objects.} } \value{ [\code{list}]: Named list with objects. } \description{ The deparsed name will be used for arguments with missing names. Missing names will be set to \code{NA}. } \examples{ z = 3 argsAsNamedList(x = 1, y = 2, z) } BBmisc/man/suppressAll.Rd0000644000175100001440000000104712741010551015004 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/suppressAll.R \name{suppressAll} \alias{suppressAll} \title{Suppresses all output except for errors.} \usage{ suppressAll(expr) } \arguments{ \item{expr}{[valid R expression]\cr Expression.} } \value{ Return value of expression invisibly. } \description{ Evaluates an expression and suppresses all output except for errors, meaning: prints, messages, warnings and package startup messages. } \examples{ suppressAll({ print("foo") message("foo") warning("foo") }) } BBmisc/man/splitTime.Rd0000644000175100001440000000145212741010551014441 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/splitTime.R \name{splitTime} \alias{splitTime} \title{Split seconds into handy chunks of time.} \usage{ splitTime(seconds, unit = "years") } \arguments{ \item{seconds}{[\code{numeric(1)}]\cr Number of seconds. If not an integer, it is rounded down.} \item{unit}{[\code{character(1)}]\cr Largest unit to split seconds into. Must be one of: \code{c("years", "days", "hours", "minutes", "seconds")}. Default is \dQuote{years}.} } \value{ [\code{numeric(5)}]. A named vector containing the \dQuote{years}, \dQuote{days}, \dQuote{hours}, \dQuote{minutes} and \dQuote{seconds}. Units larger than the given \code{unit} are \code{NA}. } \description{ Note that a year is simply defined as exactly 365 days. } \examples{ splitTime(1000) } BBmisc/man/getFirst.Rd0000644000175100001440000000065112741010551014256 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/getFirstLast.R \name{getFirst} \alias{getFirst} \alias{getLast} \title{Get the first/last element of a list/vector.} \usage{ getFirst(x) getLast(x) } \arguments{ \item{x}{[\code{list} | \code{vector}]\cr The list or vector.} } \value{ Selected element. The element name is dropped. } \description{ Get the first/last element of a list/vector. } BBmisc/man/makeS3Obj.Rd0000644000175100001440000000100512741010551014237 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/makeS3Obj.R \name{makeS3Obj} \alias{makeS3Obj} \title{Simple constructor for S3 objects based on lists.} \usage{ makeS3Obj(classes, ...) } \arguments{ \item{classes}{[\code{character}]\cr Class(es) for constructed object.} \item{...}{[any]\cr Key-value pairs for class members.} } \value{ Object. } \description{ Simple wrapper for \code{as.list} and \code{\link{setClasses}}. } \examples{ makeS3Obj("car", speed = 100, color = "red") } BBmisc/man/makeProgressBar.Rd0000644000175100001440000000673712741010551015571 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/makeProgressBar.R \name{makeProgressBar} \alias{ProgressBar} \alias{makeProgressBar} \title{Create a progress bar with estimated time.} \usage{ makeProgressBar(min = 0, max = 100, label = "", char = "+", style = getOption("BBmisc.ProgressBar.style", "text"), width = getOption("BBmisc.ProgressBar.width", getOption("width")), stream = getOption("BBmisc.ProgressBar.stream", "stderr")) } \arguments{ \item{min}{[\code{numeric(1)}]\cr Minimum value, default is 0.} \item{max}{[\code{numeric(1)}]\cr Maximum value, default is 100.} \item{label}{[\code{character(1)}]\cr Label shown in front of the progress bar. Note that if you later set \code{msg} in the progress bar function, the message will be left-padded to the length of this label, therefore it should be at least as long as the longest message you want to display. Default is \dQuote{}.} \item{char}{[\code{character(1)}]\cr A single character used to display progress in the bar. Default is \sQuote{+}.} \item{style}{[\code{character(1)}]\cr Style of the progress bar. Default is set via options (see details).} \item{width}{[\code{integer(1)}]\cr Width of the progress bar. Default is set via options (see details).} \item{stream}{[\code{character(1)}]\cr Stream to use. Default is set via options (see details).} } \value{ [\code{\link{ProgressBar}}]. A list with following functions: \item{set [\code{function(value, msg = label)}]}{Set the bar to a value and possibly display a message instead of the label.} \item{inc [\code{function(value, msg = label)}]}{Increase the bar and possibly display a message instead of the label.} \item{kill [\code{function(clear = FALSE)}]}{Kill the bar so it cannot be used anymore. Cursor is moved to new line. You can also erase its display.} \item{error [\code{function(e)}]}{Useful in \code{tryCatch} to properly display error messages below the bar. See the example.} } \description{ Create a progress bar function that displays the estimated time till completion and optional messages. Call the returned functions \code{set} or \code{inc} during a loop to change the display. Note that you are not allowed to decrease the value of the bar. If you call these function without setting any of the arguments the bar is simply redrawn with the current value. For errorhandling use \code{error} and have a look at the example below. You can globally change the behavior of all bars by setting the option \code{options(BBmisc.ProgressBar.style)} either to \dQuote{text} (the default) or \dQuote{off}, which display no bars at all. You can globally change the width of all bars by setting the option \code{options(BBmisc.ProgressBar.width)}. By default this is \code{getOption("width")}. You can globally set the stream where the output of the bar is directed by setting the option \code{options(BBmisc.ProgressBar.stream)} either to \dQuote{stderr} (the default) or \dQuote{stdout}. Note that using the latter will result in the bar being shown in reports generated by Sweave or knitr, what you probably do not want. } \examples{ bar = makeProgressBar(max = 5, label = "test-bar") for (i in 0:5) { bar$set(i) Sys.sleep(0.2) } bar = makeProgressBar(max = 5, label = "test-bar") for (i in 1:5) { bar$inc(1) Sys.sleep(0.2) } # display errors properly (in next line) \dontrun{ f = function(i) if (i>2) stop("foo") bar = makeProgressBar(max = 5, label = "test-bar") for (i in 1:5) { tryCatch ({ f(i) bar$set(i) }, error = bar$error) } } } BBmisc/man/seq_row.Rd0000644000175100001440000000106712741010551014150 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/seq.R \name{seq_row} \alias{seq_col} \alias{seq_row} \title{Generate sequences along rows or cols.} \usage{ seq_row(x) seq_col(x) } \arguments{ \item{x}{[\code{data.frame} | \code{matrix}]\cr Data frame, matrix or any object which supports \code{\link[base]{nrow}} or \code{\link[base]{ncol}}, respectively.} } \value{ Vector of type [\code{integer}]. } \description{ A simple convenience wrapper around \code{\link[base]{seq_len}}. } \examples{ data(iris) seq_row(iris) seq_col(iris) } BBmisc/man/checkArg.Rd0000644000175100001440000000517112741010551014200 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/checkArg.R \name{checkArg} \alias{checkArg} \title{Check for a function argument.} \usage{ checkArg(x, cl, s4 = FALSE, len, min.len, max.len, choices, subset, lower = NA, upper = NA, na.ok = TRUE, formals) } \arguments{ \item{x}{[any]\cr Argument.} \item{cl}{[\code{character}]\cr Class that argument must \dQuote{inherit} from. If multiple classes are given, \code{x} must \dQuote{inherit} from at least one of these. See also argument \code{s4}.} \item{s4}{[\code{logical(1)}]\cr If \code{TRUE}, use \code{is} for checking class \code{cl}, otherwise use \code{\link{inherits}}, which implies that only S3 classes are correctly checked. This is done for speed reasons as calling \code{\link{is}} is pretty slow. Default is \code{FALSE}.} \item{len}{[\code{integer(1)}]\cr Length that argument must have. Not checked if not passed, which is the default.} \item{min.len}{[\code{integer(1)}]\cr Minimal length that argument must have. Not checked if not passed, which is the default.} \item{max.len}{[\code{integer(1)}]\cr Maximal length that argument must have. Not checked if not passed, which is the default.} \item{choices}{[any]\cr Discrete number of choices, expressed by a vector of R objects. If passed, argument must be identical to one of these and nothing else is checked.} \item{subset}{[any]\cr Discrete number of choices, expressed by a vector of R objects. If passed, argument must be identical to a subset of these and nothing else is checked.} \item{lower}{[\code{numeric(1)}]\cr Lower bound for numeric vector arguments. Default is \code{NA}, which means not required.} \item{upper}{[\code{numeric(1)}]\cr Upper bound for numeric vector arguments. Default is \code{NA}, which means not required.} \item{na.ok}{[\code{logical(1)}]\cr Is it ok if a vector argument contains NAs? Default is \code{TRUE}.} \item{formals}{[\code{character}]\cr If this is passed, \code{x} must be a function. It is then checked that \code{formals} are the names of the (first) formal arguments in the signature of \code{x}. Meaning \code{checkArg(function(a, b), formals = "a")} is ok. Default is missing.} } \value{ Nothing. } \description{ Throws exception if checks are not passed. Note that argument is evaluated when checked. } \examples{ x = 1L checkArg(x, "integer", len = 1, na.ok = FALSE, upper = 3L) x = as.integer(NA) checkArg(x, "integer", len = 1, na.ok = TRUE) x = c("foo", "bar") checkArg(x, "character") x = "foo" checkArg(x, choices = c("foo", "bar")) x = c("foo", "bar") checkArg(x, subset = c("foo", "bar")) fun = function(foo, bar) checkArg(fun, formals = c("foo", "bar")) } BBmisc/man/cFactor.Rd0000644000175100001440000000102112741010551014040 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/factor.R \name{cFactor} \alias{cFactor} \title{Combine multiple factors and return a factor.} \usage{ cFactor(...) } \arguments{ \item{...}{[\code{factor}]\cr The factors.} } \value{ [\code{factor}]. } \description{ Note that function does not inherit from \code{\link{c}} to not change R semantics behind your back when this package is loaded. } \examples{ f1 = factor(c("a", "b")) f2 = factor(c("b", "c")) print(c(f1, f2)) print(cFactor(f1, f2)) } BBmisc/man/system3.Rd0000644000175100001440000000230212741010551014071 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/system3.R \name{system3} \alias{system3} \title{Wrapper for system2 with better return type and errorhandling.} \usage{ system3(command, args = character(0L), stdout = "", stderr = "", wait = TRUE, ..., stop.on.exit.code = wait) } \arguments{ \item{command}{See \code{\link{system2}}.} \item{args}{See \code{\link{system2}}.} \item{stdout}{See \code{\link{system2}}.} \item{stderr}{See \code{\link{system2}}.} \item{wait}{See \code{\link{system2}}.} \item{...}{Further arguments passed to \code{\link{system2}}.} \item{stop.on.exit.code}{[\code{logical(1)}]\cr Should an exception be thrown if an exit code greater 0 is generated? Can only be used if \code{wait} is \code{TRUE}. Default is \code{wait}.} } \value{ [\code{list}]. \item{exit.code [integer(1)]}{Exit code of command. Given if wait is \code{TRUE}, otherwise \code{NA}. 0L means success. 127L means command was not found} \item{output [character]}{Output of command on streams. Only given is \code{stdout} or \code{stderr} was set to \code{TRUE}, otherwise \code{NA}.} } \description{ Wrapper for \code{\link{system2}} with better return type and errorhandling. } BBmisc/man/isSuperset.Rd0000644000175100001440000000122412741010551014632 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/isSuperset.R \name{isSuperset} \alias{isSuperset} \title{Check superset relation on two vectors.} \usage{ isSuperset(x, y, strict = FALSE) } \arguments{ \item{x}{[\code{vector}]\cr Source vector.} \item{y}{[\code{vector}]\cr Vector of the same mode as \code{x}.} \item{strict}{[\code{logical(1)}]\cr Checks for strict/proper superset relation.} } \value{ [\code{logical(1)}] \code{TRUE} if each element of \code{y} is also contained in \code{x}, i. e., if \code{y} is a subset of \code{x} and \code{FALSE} otherwise. } \description{ Check superset relation on two vectors. } BBmisc/man/convertRowsToList.Rd0000644000175100001440000000242712741010551016164 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/convertRowsToList.R \name{convertRowsToList} \alias{convertColsToList} \alias{convertRowsToList} \title{Convert rows (columns) of data.frame or matrix to lists.} \usage{ convertRowsToList(x, name.list = TRUE, name.vector = FALSE, factors.as.char = TRUE, as.vector = TRUE) convertColsToList(x, name.list = FALSE, name.vector = FALSE, factors.as.char = TRUE, as.vector = TRUE) } \arguments{ \item{x}{[\code{matrix} | \code{data.frame}]\cr Object to convert.} \item{name.list}{[\code{logical(1)}]\cr Name resulting list with names of rows (cols) of \code{x}? Default is \code{FALSE}.} \item{name.vector}{[\code{logical(1)}]\cr Name vector elements in resulting list with names of cols (rows) of \code{x}? Default is \code{FALSE}.} \item{factors.as.char}{[\code{logical(1)}]\cr If \code{x} is a data.frame, convert factor columns to string elements in the resulting lists? Default is \code{TRUE}.} \item{as.vector}{[\code{logical(1)}]\cr If \code{x} is a matrix, store rows as vectors in the resulting list - or otherwise as lists? Default is \code{TRUE}.} } \value{ [\code{list} of lists or vectors]. } \description{ For each row, one list/vector is constructed, each entry of the row becomes a list/vector element. } BBmisc/man/hasAttributes.Rd0000644000175100001440000000111612741010551015306 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/hasAttributes.R \name{hasAttributes} \alias{hasAttributes} \title{Check if given object has certain attributes.} \usage{ hasAttributes(obj, attribute.names) } \arguments{ \item{obj}{[mixed]\cr Arbitrary R object.} \item{attribute.names}{[\code{character}]\cr Vector of strings, i.e., attribute names.} } \value{ [\code{logical(1)}] \code{TRUE} if object \code{x} contains all attributes from \code{attributeNames} and \code{FALSE} otherwise. } \description{ Check if given object has certain attributes. } BBmisc/man/asMatrixCols.Rd0000644000175100001440000000140512741010551015076 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/asMatrix.R \name{asMatrixCols} \alias{asMatrixCols} \alias{asMatrixRows} \title{Extracts a named element from a list of lists.} \usage{ asMatrixCols(xs, row.names, col.names) asMatrixRows(xs, row.names, col.names) } \arguments{ \item{xs}{[\code{list}]\cr A list of vectors of the same length.} \item{row.names}{[\code{character} | \code{integer} | \code{NULL}]\cr Row names of result. Default is to take the names of the elements of \code{xs}.} \item{col.names}{[\code{character} | \code{integer} | \code{NULL}]\cr Column names of result. Default is to take the names of the elements of \code{xs}.} } \value{ [\code{matrix}]. } \description{ Extracts a named element from a list of lists. } BBmisc/man/isSubset.Rd0000644000175100001440000000120612741010551014265 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/isSubset.R \name{isSubset} \alias{isSubset} \title{Check subset relation on two vectors.} \usage{ isSubset(x, y, strict = FALSE) } \arguments{ \item{x}{[\code{vector}]\cr Source vector.} \item{y}{[\code{vector}]\cr Vector of the same mode as \code{x}.} \item{strict}{[\code{logical(1)}]\cr Checks for strict/proper subset relation.} } \value{ [\code{logical(1)}] \code{TRUE} if each element of \code{x} is also contained in \code{y}, i. e., if \code{x} is a subset of \code{y} and \code{FALSE} otherwise. } \description{ Check subset relation on two vectors. } BBmisc/man/setRowNames.Rd0000644000175100001440000000112612741010551014734 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/setRowColNames.R \name{setRowNames} \alias{setColNames} \alias{setRowNames} \title{Wrapper for \code{rownames(x) = y}, \code{colnames(x) = y}.} \usage{ setRowNames(x, names) setColNames(x, names) } \arguments{ \item{x}{[\code{matrix} | \code{data.frame}]\cr Matrix or data.frame.} \item{names}{[\code{character}]\cr New names for rows / columns.} } \value{ Changed object \code{x}. } \description{ Wrapper for \code{rownames(x) = y}, \code{colnames(x) = y}. } \examples{ setColNames(matrix(1:4, 2, 2), c("a", "b")) } BBmisc/man/printStrToChar.Rd0000644000175100001440000000114012741010551015407 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/printStrToChar.R \name{printStrToChar} \alias{printStrToChar} \title{Print \code{str(x)} of an object to a string / character vector.} \usage{ printStrToChar(x, collapse = "\\n") } \arguments{ \item{x}{[any]\cr Object to print} \item{collapse}{[\code{character(1)}]\cr Used to collapse multiple lines. \code{NULL} means no collapsing, vector is returned. Default is \dQuote{\\n}.} } \value{ [\code{character}]. } \description{ Print \code{str(x)} of an object to a string / character vector. } \examples{ printStrToChar(iris) } BBmisc/man/getMaxIndexOfRows.Rd0000644000175100001440000000301412741010551016040 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/getMaxColIndex.R \name{getMaxIndexOfRows} \alias{getMaxIndexOfCols} \alias{getMaxIndexOfRows} \alias{getMinIndexOfCols} \alias{getMinIndexOfRows} \title{Find row- or columnwise the index of the maximal / minimal element in a matrix.} \usage{ getMaxIndexOfRows(x, ties.method = "random", na.rm = FALSE) getMinIndexOfRows(x, ties.method = "random", na.rm = FALSE) getMaxIndexOfCols(x, ties.method = "random", na.rm = FALSE) getMinIndexOfCols(x, ties.method = "random", na.rm = FALSE) } \arguments{ \item{x}{[\code{matrix(n,m)}] \cr Numerical input matrix.} \item{ties.method}{[\code{character(1)}]\cr How should ties be handled? Possible are: \dQuote{random}, \dQuote{first}, \dQuote{last}. Default is \dQuote{random}.} \item{na.rm}{[\code{logical(1)}]\cr If \code{FALSE}, NA is returned if an NA is encountered in \code{x}. If \code{TRUE}, NAs are disregarded. Default is \code{FALSE}} } \value{ [\code{integer(n)}]. } \description{ \code{getMaxIndexOfRows} returns the index of the maximal element of each row. \code{getMinIndexOfRows} returns the index of the minimal element of each row. \code{getMaxIndexOfCols} returns the index of the maximal element of each col. \code{getMinIndexOfCols} returns the index of the minimal element of each col. If a corresponding vector (row or col) is empty, possibly after NA removal, -1 is returned as index. } \examples{ x = matrix(runif(5 * 3), ncol = 3) print(x) print(getMaxIndexOfRows(x)) print(getMinIndexOfRows(x)) } BBmisc/man/toRangeStr.Rd0000644000175100001440000000140012741010551014550 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/toRangeStr.R \name{toRangeStr} \alias{toRangeStr} \title{Convert a numerical vector into a range string.} \usage{ toRangeStr(x, range.sep = " - ", block.sep = ", ") } \arguments{ \item{x}{[\code{integer}]\cr Vector to convert into a range string.} \item{range.sep}{[\code{character(1)}]\cr Separator between the first and last element of a range of consecutive elements in \code{x}. Default is \dQuote{ - }.} \item{block.sep}{[\code{character(1)}]\cr Separator between non consecutive elements of \code{x} or ranges. Default is \dQuote{, }.} } \value{ [\code{character(1)}] } \description{ Convert a numerical vector into a range string. } \examples{ x = sample(1:10, 7) toRangeStr(x) } BBmisc/man/btwn.Rd0000644000175100001440000000117312741010551013441 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/btwn.R \name{\%btwn\%} \alias{\%btwn\%} \title{Check if some values are covered by the range of the values in a second vector.} \usage{ x \%btwn\% y } \arguments{ \item{x}{[\code{numeric(n)}]\cr Value(s) that should be within the range of \code{y}.} \item{y}{[\code{numeric}]\cr Numeric vector which defines the range.} } \value{ [\code{logical(n)}]. For each value in \code{x}: Is it in the range of \code{y}? } \description{ Check if some values are covered by the range of the values in a second vector. } \examples{ x = 3 y = c(-1,2,5) x \%btwn\% y } BBmisc/man/convertListOfRowsToDataFrame.Rd0000644000175100001440000000240212741010551020207 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/convertListOfRowsToDataFrame.R \name{convertListOfRowsToDataFrame} \alias{convertListOfRowsToDataFrame} \title{Convert a list of row-vectors of equal structure to a data.frame.} \usage{ convertListOfRowsToDataFrame(rows, strings.as.factors = default.stringsAsFactors(), row.names, col.names) } \arguments{ \item{rows}{[\code{list}]\cr List of rows. Each row is a list or vector of the same structure. That means all rows must have the same length and all corresponding elements must have the same class.} \item{strings.as.factors}{[\code{logical(1)}]\cr Convert character columns to factors? Default is \code{default.stringsAsFactors()}.} \item{row.names}{[\code{character} | \code{integer} | \code{NULL}]\cr Row names for result. By default the names of the list \code{rows} are taken.} \item{col.names}{[\code{character} | \code{integer}]\cr Column names for result. By default the names of an element of \code{rows} are taken.} } \value{ [\code{data.frame}]. } \description{ Elements are arranged in columns according to their name in each element of \code{rows}. Missing values are filled using NAs. } \examples{ convertListOfRowsToDataFrame(list(list(x = 1, y = "a"), list(x = 2, y = "b"))) } BBmisc/man/addClasses.Rd0000644000175100001440000000076012741010551014536 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/addClasses.R \name{addClasses} \alias{addClasses} \title{A wrapper to add to the class attribute.} \usage{ addClasses(x, classes) } \arguments{ \item{x}{[any]\cr Your object.} \item{classes}{[\code{character}]\cr Classes to add. Will be added in front (specialization).} } \value{ Changed object \code{x}. } \description{ A wrapper to add to the class attribute. } \examples{ addClasses(list(), c("foo1", "foo2")) } BBmisc/LICENSE0000644000175100001440000000016012741012164012427 0ustar hornikusersYEAR: 2013-2016 COPYRIGHT HOLDER: Bernd Bischl, Michel Lang, Olaf Mersmann ORGANIZATION: TU Dortmund University