BBmisc/0000755000176200001440000000000012464143411011411 5ustar liggesusersBBmisc/tests/0000755000176200001440000000000012411032027012543 5ustar liggesusersBBmisc/tests/run-all.R0000644000176200001440000000004712411032027014241 0ustar liggesuserslibrary(testthat) test_check("BBmisc") BBmisc/tests/testthat/0000755000176200001440000000000012464124630014415 5ustar liggesusersBBmisc/tests/testthat/test_seq.R0000644000176200001440000000021412411032027016352 0ustar liggesuserscontext("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.R0000644000176200001440000000363112411032027023314 0ustar liggesuserscontext("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.R0000644000176200001440000000046212411032027020146 0ustar liggesuserscontext("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.R0000644000176200001440000000457112411032027017364 0ustar liggesusers 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.R0000644000176200001440000000033212411032027016347 0ustar liggesuserscontext("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.R0000644000176200001440000000634312411032027017302 0ustar liggesuserscontext("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.R0000644000176200001440000000023412411032027017042 0ustar liggesuserscontext("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.R0000644000176200001440000000055312411032027017074 0ustar liggesuserscontext("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.R0000644000176200001440000000023412411032027016752 0ustar liggesuserscontext("isFALSE") test_that("isFALSE", { expect_equal(isFALSE(FALSE), TRUE) expect_equal(isFALSE(TRUE), FALSE) expect_equal(isFALSE(0), FALSE) }) BBmisc/tests/testthat/test_getUnixTime.R0000644000176200001440000000020612411032027020025 0ustar liggesuserscontext("getUnixTime") test_that("getUnixTime", { x = getUnixTime() expect_true(is.integer(x) && length(x) == 1 && !is.na(x)) }) BBmisc/tests/testthat/test_filterNull.R0000644000176200001440000000031112411032027017700 0ustar liggesuserscontext("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.R0000644000176200001440000000050612411032027017325 0ustar liggesusers 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.R0000644000176200001440000000127112411032027017667 0ustar liggesuserscontext("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.R0000644000176200001440000000165112411032027021617 0ustar liggesuserscontext("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.R0000644000176200001440000000175012411032027020326 0ustar liggesuserscontext("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.R0000644000176200001440000000024512411032027017370 0ustar liggesuserscontext("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.R0000644000176200001440000000037512411032027017420 0ustar liggesuserscontext("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.R0000644000176200001440000000157712411032027017510 0ustar liggesuserscontext("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.R0000644000176200001440000000137612411032027020055 0ustar liggesuserscontext("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.R0000644000176200001440000000027512411032027021300 0ustar liggesuserscontext("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.R0000644000176200001440000000035612411032027016543 0ustar liggesuserscontext("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.R0000644000176200001440000000216412411032027017542 0ustar liggesuserscontext("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.R0000644000176200001440000000025612411032027016733 0ustar liggesuserscontext("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.R0000644000176200001440000000070612411032027017230 0ustar liggesuserscontext("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.R0000644000176200001440000000143612411032027017073 0ustar liggesuserscontext("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.R0000644000176200001440000000466412464124630017611 0ustar liggesuserscontext("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)) y[, 5L] = iris$Specis # 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.R0000644000176200001440000000034712411032027020250 0ustar liggesuserscontext("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.R0000644000176200001440000000055212411032027020704 0ustar liggesuserscontext("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.R0000644000176200001440000000046512411032027020027 0ustar liggesuserscontext("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.R0000644000176200001440000000021412411032027017406 0ustar liggesuserscontext("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.R0000644000176200001440000000043112411032027017631 0ustar liggesuserscontext("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.R0000644000176200001440000000233112411032027017504 0ustar liggesuserscontext("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.R0000644000176200001440000000061212454774476020770 0ustar liggesuserscontext("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.R0000644000176200001440000000227112411032027020656 0ustar liggesuserscontext("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_output(bar$set(i), "^$") } options(BBmisc.ProgressBar.style = "text", BBmisc.ProgressBar.width = 30) cat("\n") bar = makeProgressBar(max=5) for(i in 0:5) { bar$set(i) } options(BBmisc.ProgressBar.style = old.style, BBmisc.ProgressBar.width = old.width) }) BBmisc/tests/testthat/test_checkListElementClass.R0000644000176200001440000000051712411032027022001 0ustar liggesuserscontext("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.R0000644000176200001440000000360312411032027021261 0ustar liggesuserscontext("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.R0000644000176200001440000000251712411032027017201 0ustar liggesuserscontext("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.R0000644000176200001440000000015212411032027017533 0ustar liggesuserscontext("collapsef") test_that("collapsef", { expect_equal(collapsef("%s=%s", 1:2, 3:4), "1=3,2=4") }) BBmisc/tests/testthat/test_setClasses.R0000644000176200001440000000035412411032027017700 0ustar liggesuserscontext("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.R0000644000176200001440000000121412411032027017653 0ustar liggesuserscontext("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.R0000644000176200001440000000042012411032027020466 0ustar liggesuserscontext("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.R0000644000176200001440000000035412411032027017230 0ustar liggesuserscontext("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.R0000644000176200001440000000031212411032027017572 0ustar liggesuserscontext("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.R0000644000176200001440000000447412411032027020556 0ustar liggesuserscontext("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.R0000644000176200001440000000032212411032027017542 0ustar liggesuserscontext("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.R0000644000176200001440000000056712411032027017713 0ustar liggesuserscontext("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.R0000644000176200001440000000141412411032027017134 0ustar liggesuserscontext("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.R0000644000176200001440000000261612411032027021764 0ustar liggesuserscontext("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.R0000644000176200001440000000110412411032027020076 0ustar liggesusers context("suppressAll") test_that("suppressAll", { expect_equal(suppressAll(123), 123) expect_true(prints_text("123")({print(123);0})$passed) expect_false(prints_text("123")(suppressAll({print(123);0}))$passed) #todo: do later when testhat is fixed expect_true(gives_warning("123")({warning(123);0})$passed) #expect_false(gives_warning("123")(suppressAll({warning(123);0}))$passed) #todo: do later when testhat is fixed expect_true(shows_message("123")({message(123);0})$passed) #expect_false(shows_message("123")(suppressAll({message(123);0}))$passed) }) BBmisc/tests/testthat/test_getOperatingSystem.R0000644000176200001440000000047012411032027021423 0ustar liggesuserscontext("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.R0000644000176200001440000000031212411032027021210 0ustar liggesuserscontext("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.R0000644000176200001440000000255312411032027020254 0ustar liggesuserscontext("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.R0000644000176200001440000000267312411032027017566 0ustar liggesuserscontext("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.R0000755000176200001440000000261712411032027016706 0ustar liggesuserscontext("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.R0000644000176200001440000000454212411032027021135 0ustar liggesuserscontext("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.R0000644000176200001440000000243212411032027020564 0ustar liggesuserscontext("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.R0000644000176200001440000000061212411032027017354 0ustar liggesuserscontext("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.R0000644000176200001440000000224612464124630020716 0ustar liggesuserscontext("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()) }) BBmisc/tests/testthat/test_hasAttributes.R0000644000176200001440000000052212411032027020406 0ustar liggesuserscontext("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.R0000644000176200001440000000053012411032027017503 0ustar liggesuserscontext("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.R0000644000176200001440000000166712423473152020702 0ustar liggesuserscontext("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.R0000644000176200001440000000075012423473152017552 0ustar liggesuserscontext("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.R0000644000176200001440000000045512411032027021503 0ustar liggesuserscontext("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.R0000644000176200001440000000016712411032027017356 0ustar liggesuserscontext("asQuoted") test_that("asQuoted", { e1 = asQuoted("x == 3") e2 = quote(x == 3) expect_equal(e1, e2) }) BBmisc/tests/testthat/test_which.first.last.R0000644000176200001440000000153712411032027020765 0ustar liggesuserscontext("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.R0000644000176200001440000000073212424414333017355 0ustar liggesuserscontext("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.R0000644000176200001440000000052412411032027017112 0ustar liggesuserscontext("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.R0000644000176200001440000000324712411032027020010 0ustar liggesuserscontext("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.R0000644000176200001440000000113712411032027017060 0ustar liggesuserscontext("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.R0000644000176200001440000000060312411032027020177 0ustar liggesuserscontext("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.R0000644000176200001440000000117512411032027020255 0ustar liggesuserscontext("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.R0000644000176200001440000000045612411032027020520 0ustar liggesuserscontext("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.R0000644000176200001440000000122712454774476017560 0ustar liggesuserscontext("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.R0000644000176200001440000000147712423473152017207 0ustar liggesuserscontext("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.R0000644000176200001440000000211412411032027021631 0ustar liggesuserscontext("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.R0000644000176200001440000000055512411032027021304 0ustar liggesuserscontext("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.R0000644000176200001440000000105112411032027017566 0ustar liggesuserscontext("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/0000755000176200001440000000000012464140610012176 5ustar liggesusersBBmisc/src/which_first.c0000644000176200001440000000262412464140611014660 0ustar liggesusers#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.h0000644000176200001440000000022212464140611013670 0ustar liggesusers#ifndef BBMISC_ITOSTR_H_ #define BBMISC_ITOSTR_H_ #include #include #include SEXP itostr(SEXP, SEXP); #endif BBmisc/src/macros.h0000644000176200001440000000053212464140611013634 0ustar liggesusers#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.h0000644000176200001440000000041312464140611015711 0ustar liggesusers#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.c0000644000176200001440000000202012464140611015700 0ustar liggesusers#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.h0000644000176200001440000000041312464140611014563 0ustar liggesusers#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.h0000644000176200001440000000030212464140611014654 0ustar liggesusers#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.c0000644000176200001440000000126412464140611013672 0ustar liggesusers#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.c0000644000176200001440000000312512464140611014561 0ustar liggesusers#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/NAMESPACE0000644000176200001440000000511712454774476012660 0ustar liggesusers# Generated by roxygen2 (4.1.0): 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(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) useDynLib(BBmisc,c_getMaxIndex) useDynLib(BBmisc,c_getMaxIndexOfCols) useDynLib(BBmisc,c_getMaxIndexOfRows) BBmisc/NEWS0000644000176200001440000001023112464140567012116 0ustar liggesusersBBmisc_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/0000755000176200001440000000000012464124630011614 5ustar liggesusersBBmisc/R/getMaxIndex.R0000644000176200001440000000206612411032027014146 0ustar liggesusers#' 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.R0000644000176200001440000000346512454774476013726 0ustar liggesusers#' 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.R0000644000176200001440000000155112411032027013532 0ustar liggesusers#' 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.R0000644000176200001440000000117612411032027013533 0ustar liggesusers#' 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.R0000644000176200001440000000060412411032027014404 0ustar liggesusers#' 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.R0000644000176200001440000000112612411032027013645 0ustar liggesusers#' 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.R0000644000176200001440000000103212411032027012511 0ustar liggesusers#' 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.R0000644000176200001440000000136112411032027013504 0ustar liggesusers#' 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.R0000644000176200001440000000107712411032027013471 0ustar liggesusers#' 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.R0000644000176200001440000000036012411032027013552 0ustar liggesusers#' 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.R0000644000176200001440000000142612411032027016141 0ustar liggesusers#' 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.R0000644000176200001440000000407612411032027014607 0ustar liggesusers#' 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.R0000644000176200001440000000074712411032027014642 0ustar liggesusers#' 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.R0000644000176200001440000001140312411032027013433 0ustar liggesusers#' 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.R0000644000176200001440000000310412460421726012740 0ustar liggesusers#' 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.R0000644000176200001440000000023712442613520013053 0ustar liggesusers#' Pause in interactive mode and continue on . #' @export pause = function() { if (interactive()) readline("Pause. Press to continue.") } BBmisc/R/makeDataFrame.R0000644000176200001440000000443212411032027014412 0ustar liggesusers#' 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.R0000644000176200001440000000355712411032027016131 0ustar liggesusers#' @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.R0000644000176200001440000000253212411032027014210 0ustar liggesusers#' 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.R0000644000176200001440000000065712411032027015052 0ustar liggesusers#' 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.R0000644000176200001440000000173312411032027013651 0ustar liggesusers#' 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.R0000644000176200001440000000323112454774476015130 0ustar liggesusers#' @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.R0000644000176200001440000001426412415511024015026 0ustar liggesusers#' @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.R0000644000176200001440000000200412411032027013725 0ustar liggesusers#' 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.R0000644000176200001440000000144112411032027013060 0ustar liggesusers#' 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.R0000644000176200001440000000462112411032027015422 0ustar liggesusers#' 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.R0000644000176200001440000000055512411032027014000 0ustar liggesusers #' 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.R0000644000176200001440000000227612411032027013706 0ustar liggesusers#' 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.R0000644000176200001440000000037612411032027013374 0ustar liggesusers#' 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.R0000644000176200001440000000131412411032027016034 0ustar liggesusers#' 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.R0000644000176200001440000000154012411032027014043 0ustar liggesusers#' 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.R0000644000176200001440000000101112411032027012670 0ustar liggesusers#' 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.R0000644000176200001440000000046612411032027013713 0ustar liggesusers#' 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.R0000644000176200001440000000157412411032027015763 0ustar liggesusers# 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.R0000644000176200001440000000146112411032027013114 0ustar liggesusers#' 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.R0000644000176200001440000000156012411032027013233 0ustar liggesusers#' 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.R0000644000176200001440000000033712411032027013116 0ustar liggesusers#' 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.R0000644000176200001440000000144012411032027013250 0ustar liggesusers#' 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.R0000644000176200001440000000126112411032027013203 0ustar liggesusers#' 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.R0000644000176200001440000000044612411032027015643 0ustar liggesusers#' 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.R0000644000176200001440000000314112411032027013273 0ustar liggesusers#' 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.R0000644000176200001440000000376012411032027014471 0ustar liggesusers#' 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.R0000644000176200001440000000136012411032027014155 0ustar liggesusers#' 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.R0000644000176200001440000000270312411032027015017 0ustar liggesusers#' 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.R0000644000176200001440000000236012411032027014412 0ustar liggesusers#' 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.R0000644000176200001440000000207712423473152013344 0ustar liggesusers#' 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.R0000644000176200001440000000222712411032027013520 0ustar liggesusers#' 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.R0000644000176200001440000000066012442613520013530 0ustar liggesusers#' 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.R0000644000176200001440000000076712411032027013515 0ustar liggesusers#' 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.R0000644000176200001440000000125612411032027012646 0ustar liggesusers#' 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.R0000644000176200001440000000136612411032027013523 0ustar liggesusers#' 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.R0000644000176200001440000000244712411032027013225 0ustar liggesusers#' 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.R0000644000176200001440000000245312411032027013244 0ustar liggesusers#' 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.R0000644000176200001440000000215012411032027014013 0ustar liggesusers#' 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.R0000644000176200001440000000454412411032027013725 0ustar liggesusers#' 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.R0000644000176200001440000000434012411032027013335 0ustar liggesusers#' 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.R0000644000176200001440000000055612411032027014346 0ustar liggesusers#' 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.R0000644000176200001440000000117112411032027014746 0ustar liggesusers#' 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.R0000644000176200001440000000044312411032027015355 0ustar liggesusers#' 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.R0000644000176200001440000000046312442613520014050 0ustar liggesusers#' 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.R0000644000176200001440000000114512411032027014243 0ustar liggesusers#' 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.R0000644000176200001440000000113412411032027013364 0ustar liggesusers#' 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.R0000644000176200001440000000274712411032027014735 0ustar liggesusers#' 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.R0000644000176200001440000000062212411032027013675 0ustar liggesusers#' 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.R0000644000176200001440000000404612411032027017455 0ustar liggesusers#' 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.R0000644000176200001440000000043512411032027012513 0ustar liggesusers#' 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.R0000644000176200001440000000556712464124630015067 0ustar liggesusers#' @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 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. #' Same length as \code{packs}. #' @export #' @examples #' requirePackages(c("BBmisc", "base"), why = "BBmisc example") requirePackages = function(packs, why = "", stop = TRUE, suppress.warnings = FALSE, default.method = "attach") { assertCharacter(packs, any.missing = FALSE) assertString(why) 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) } return(packs.ok) } BBmisc/R/isSuperset.R0000644000176200001440000000101612411032027014071 0ustar liggesusers#' 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.R0000644000176200001440000000103312411032027013507 0ustar liggesusers#' 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.R0000644000176200001440000000740112464124630013741 0ustar liggesusers#' @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}. #' 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 = 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.R0000644000176200001440000000064512411032027013743 0ustar liggesusers#' 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.R0000644000176200001440000000100412411032027014646 0ustar liggesusers#' 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.R0000644000176200001440000000027412411032027014050 0ustar liggesusers#' 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.R0000644000176200001440000000211212411032027015556 0ustar liggesusers#' 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/collapse.R0000644000176200001440000000071212411032027013527 0ustar liggesusers#' 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.R0000644000176200001440000000071612411032027014553 0ustar liggesusers#' 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.R0000644000176200001440000000523412411032027013041 0ustar liggesusers#' 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.R0000644000176200001440000000140012411032027014114 0ustar liggesusers#' 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.R0000644000176200001440000000502112411032027015752 0ustar liggesusers#' 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) assertDirectory(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.R0000644000176200001440000000143312411032027012474 0ustar liggesusers#' 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.R0000644000176200001440000000117212411032027014163 0ustar liggesusers#' 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.R0000644000176200001440000000274612411032027016004 0ustar liggesusers#' 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.R0000644000176200001440000000160612411032027013543 0ustar liggesusers#' 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.R0000644000176200001440000000504712411032027014713 0ustar liggesusers#' 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.R0000644000176200001440000000267212460421726012770 0ustar liggesusers#' 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.R0000644000176200001440000000145612411032027013644 0ustar liggesusers#' 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.R0000644000176200001440000000100212411032027013542 0ustar liggesusers#' 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.R0000644000176200001440000000074312411032027014746 0ustar liggesusers#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.R0000644000176200001440000000053412411032027012564 0ustar liggesusers#' @import stats #' @import checkmate .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.R0000644000176200001440000000054312411032027013072 0ustar liggesusers#' 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.R0000644000176200001440000000027012411032027014166 0ustar liggesusers#' 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.R0000644000176200001440000000165512411032027013704 0ustar liggesusers#' 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.R0000644000176200001440000000074512411032027015442 0ustar liggesusers#' 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/MD50000644000176200001440000003611012464143411011722 0ustar liggesusers32da797cf18fd34320eb67d152063904 *DESCRIPTION 330636d79c11091bab36ca52503f6485 *LICENSE f113ac5fb3fd6cf3ab8c0a1c5c592347 *NAMESPACE 9b73739c6c5d6833dd1352a1225dd1f1 *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 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 2d317d929520e125ee95fcf44ab7e197 *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 1981921cceff4a0ff28e0675944e1872 *R/normalize.R de8e6cb465cdd3dd19321cf6ac213d2b *R/optimizeSubInts.R 599ace969590b37f3c2c88b14c57d762 *R/pause.R b6fd8274f38b9b99c0a742154598717a *R/printStrToChar.R 92bfd135c7de27f135e7823996aff04d *R/printToChar.R 971a824767489aa432bf9ca2e4f60e88 *R/rangeVal.R 530ad9caca77e8c1239b8339e4671d75 *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 a73f9363385ed6983c28bbd4cdaf5d30 *R/zzz.R 7d9630f2dc37f2231c41816527f84a59 *R/zzz_deprecated.R 311c1d46091f54695a3e2f6c8a478962 *man/addClasses.Rd cb31c7542012ad25ffb500b50d19aff7 *man/argsAsNamedList.Rd 9290b8bda4d6dad0aa60feea30d099f5 *man/asMatrixCols.Rd 7aff42f0af5305e1991583e387143649 *man/asQuoted.Rd 85b44e48ff392875334edf177c871683 *man/binPack.Rd f4da529997d18a6fbbc2e649a07375cc *man/btwn.Rd e289a629ff8d7adff04c9572a852d7e2 *man/cFactor.Rd 97677b65c2867855400ea22cd90a249e *man/catf.Rd 33639a0e40244405eb1e1d8aa66b58d6 *man/checkArg.Rd 9fc79e99ceee4c479fc1c78673d0cac7 *man/checkListElementClass.Rd ea4e20cc36c5a4b3af0927e8404958de *man/chunk.Rd 089a716b2bfa370e6c8a1481a2b7b92a *man/clipString.Rd e8b253a7a0379fcb88f335039545c07b *man/coalesce.Rd 2ef40c6d54ff91d0ef76eef041529f8b *man/collapse.Rd c24ea5c915646f2fa9eb478e28a0ada6 *man/collapsef.Rd 72fcac961799a8ad5309842e4820e451 *man/computeMode.Rd 78bb89b3cb25f7fc7858fdbdf35766c0 *man/convertDataFrameCols.Rd aa808e9d35c1966acc25d2601b5aff9b *man/convertInteger.Rd 63841076ee6bc399a2a1831b769f7a96 *man/convertIntegers.Rd 18fe95b1a645a3dcded7f7f209dbf691 *man/convertListOfRowsToDataFrame.Rd d02a0156833c6d0df65ccb0854b31ea6 *man/convertMatrixType.Rd d411a44fe45c7111941a1521258f7550 *man/convertRowsToList.Rd d2b65b14b2f6285d8543bed1f444ae80 *man/convertToShortString.Rd 5d32b973d9726603b9679a3f306e10be *man/dapply.Rd 60ebb26aea2d0590e7b0d32dc480bed9 *man/deprecated.Rd db6d44e3288bd32ab0dbe581c4d8105d *man/do.call2.Rd ed61de252523258eabbe45995c61849f *man/dropNamed.Rd 7e2e297691cc72f69ac99ee9b4bbd6a6 *man/ensureVector.Rd 2de2ecb7103206ad7e42891921799c53 *man/explode.Rd 88ce89eddfe98e3ca761b9f4725c3180 *man/extractSubList.Rd cc274052f5ed4291d2541405918c5100 *man/filterNull.Rd cacb31e47c371db9f18862854b78aa0b *man/getAttributeNames.Rd 819c284f97adef373ef8a9448bb654ec *man/getClass1.Rd 1cb6bf4f71b10705bad1b7e8f58a8d53 *man/getFirst.Rd 3eb0458a96f50e329917a148d0de46b7 *man/getMaxIndex.Rd 29dc7e7764c841f71709298dfe2b531c *man/getMaxIndexOfRows.Rd eca872377a4ac2a2831cbca4258b8cd6 *man/getOperatingSystem.Rd 3bbd1c5b11372048dd8a0e24e1650860 *man/getRelativePath.Rd 3ee538df75ada2cabc2ac86781f7b55f *man/getUnixTime.Rd f40c6b943ebf4d42893e046aee76ad80 *man/getUsedFactorLevels.Rd bfdf5b25e2d6f30dc9abb30014f54bd7 *man/hasAttributes.Rd 86afad0e72f6ccdf105b2fbcc8f5b045 *man/insert.Rd 7545044a18ac73e60ff3d6a0aa5e1a92 *man/is.error.Rd c584b45d3069a03027e2a59c7382aeff *man/isDirectory.Rd 020d28241de46265bd1e995a1d3adb0a *man/isEmptyDirectory.Rd 87d8e62f93aa861899d6b9c6502e12a7 *man/isExpensiveExampleOk.Rd 127be8b9aaceec463fac14b7c9ec0824 *man/isFALSE.Rd c2b625895a8095e730fc1081cd6c2fef *man/isProperlyNamed.Rd a0bea4b8ad6dcd7a4d13eefc0f662b34 *man/isScalarNA.Rd 72870786b9251a25e88ba614690e8a6a *man/isScalarValue.Rd 737fde4d032dbaaa13b095be1909d502 *man/isSubset.Rd f6d85bdfaa8479087ef2cf15208cda37 *man/isSuperset.Rd 351d9ace3ea32239e8f119572d41668f *man/isValidName.Rd b602e79beb7f72f8fa8948e1cd2c1dbc *man/itostr.Rd 439e00acb6ae1d32d21c601ee99a45a9 *man/lib.Rd a7d3589240841e6e4a5f9cfc036140f8 *man/load2.Rd 4bfdf5c01c6dee428fb9d73f6e3d50c6 *man/lsort.Rd 98ff8e375341b7147014d055eca8b922 *man/makeDataFrame.Rd 7b8bf92698b4df361c78d373f453339f *man/makeFileCache.Rd 17edee8eca28b26f6a3df87a16d64608 *man/makeProgressBar.Rd 003256319a1316965a5a432d3e83e5b6 *man/makeS3Obj.Rd 50e4fcbb5c203f938ee7e11493429f5b *man/makeSimpleFileLogger.Rd d920e146e4f827eeea4fa570be07e4bb *man/mapValues.Rd e250669ed4fcecd86be2c470dc6a235a *man/messagef.Rd 794a0e59ccb48fa3846edd36f6f303b8 *man/namedList.Rd 13b5891dda2a718c9e89c833ff214954 *man/names2.Rd d4aa467237e96c8e5c77255b62f760ef *man/nin.Rd 4272f6956d88f8c99491adba5cdf217b *man/normalize.Rd 02939693a615af6208d4c8872d2ca2c1 *man/optimizeSubInts.Rd abd649b9fd46329e0b5509dac81997f7 *man/pause.Rd b1a6bd579bd98589e44c80ec986a6514 *man/printStrToChar.Rd 536712af63347124340c15fb52f031ae *man/printToChar.Rd ac01096237fc82e4dad79729d4456f26 *man/rangeVal.Rd 7ef76e203c5f1dd3440f60ad184730fa *man/requirePackages.Rd b853d15ab061b936f1468f381b2b92cd *man/rowLapply.Rd e8af69b22337ef4246d0121601670682 *man/save2.Rd 680d7e79936a1c2436ef89cc1de8661a *man/seq_row.Rd b167d0b360aca6efcc35c6d6aec00a61 *man/setAttribute.Rd 5aa7693969fccebce7098fb6d77038f7 *man/setClasses.Rd cb9f6c66e9122f685d76b05ea38c4587 *man/setRowNames.Rd d17e191f55f67f476dc1fc14e84b06e9 *man/setValue.Rd ed301df135087a37880b789c27463486 *man/sortByCol.Rd 0ee4773cc7685fb407c52c5eafc32c99 *man/splitPath.Rd ff196279c0ac6ec6b18ad10b50d15859 *man/splitTime.Rd cd4cb1f656eac0246209cfc7f78fc5bd *man/stopf.Rd 785d98f728c0bb95f296622a6e71c273 *man/strrepeat.Rd affd20f19185e16615129e1b25916d50 *man/suppressAll.Rd 07ca6850757ff9b0f667285e0fe1bb85 *man/symdiff.Rd 0ad2acc6343c3df336f1f251cf8517ae *man/system3.Rd 30893072dfa73eb11cf0ee755d17c9cd *man/toRangeStr.Rd cebd005c9af3b68be358e0abb4f9415a *man/vlapply.Rd 3d308a6c753e233ff16875b8ab01db50 *man/warningf.Rd be9f1099dd52242ce8f4024c62e1b20c *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 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 13cb2963b24e80aab60fd6539523f29c *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 d012b2520aa8724b5b71cf24f5246645 *tests/testthat/test_normalize.R 98a1a85a55a68773c748dab8f4f0ad40 *tests/testthat/test_optimizeSubInts.R 4ec4fcdd19c7734b29a9107d85c8f4fe *tests/testthat/test_printStrToChar.R edc7badddfe9bd1c8fe1fb0a77901d16 *tests/testthat/test_printToChar.R a2e08537878a42840f3e3720ca454dc7 *tests/testthat/test_printf.R 1442290f39895a964fd1972ed35f7611 *tests/testthat/test_rangeVal.R 7865fd48479669586d3b7cb0ddab102a *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 52dca80f449488ef39061dab9bd30310 *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/DESCRIPTION0000644000176200001440000000223112464143411013115 0ustar liggesusersPackage: 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")) URL: https://github.com/berndbischl/BBmisc BugReports: https://github.com/berndbischl/BBmisc/issues License: BSD_3_clause + file LICENSE Encoding: UTF-8 Imports: stats, checkmate Suggests: testthat, microbenchmark, codetools LazyData: yes ByteCompile: yes Version: 1.9 Packaged: 2015-02-03 12:39:37 UTC; bischl Author: Bernd Bischl [aut, cre], Michel Lang [aut], Jakob Bossek [aut], Daniel Horn [aut], Jakob Richter [aut] Maintainer: Bernd Bischl NeedsCompilation: yes Repository: CRAN Date/Publication: 2015-02-03 14:03:05 BBmisc/man/0000755000176200001440000000000012464124630012166 5ustar liggesusersBBmisc/man/dropNamed.Rd0000644000176200001440000000136012454774476014410 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000102512454774476014506 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000152212454774476016334 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000234512454774476015653 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000076712454774476016220 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000304212454774476015456 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000126212454774476016711 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000104312454774476014265 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000076312454774476015622 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000125212454774476013414 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000061612454774476014143 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000077512454774476014302 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000077312454774476016135 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000063112454774476013642 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000154412454774476014720 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000130112454774476014572 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000134712454774476014030 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000127512454774476014700 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000143512454774476014732 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000064712454774476016420 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000177012454774476016552 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000062612454774476014463 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000071412454774476014612 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000124512454774476015142 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000142412454774476013665 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000172112454774476014047 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000370712464124630015577 0ustar liggesusers% Generated by roxygen2 (4.1.0): do not edit by hand % Please edit documentation in R/requirePackages.R \name{requirePackages} \alias{requirePackages} \title{Require some packages.} \usage{ requirePackages(packs, 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{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. 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.Rd0000644000176200001440000000077512454774476016027 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000107112454774476014263 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000104112454774476014232 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000124012454774476015655 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000210512454774476013476 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000237312454774476015166 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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/getRelativePath.Rd0000644000176200001440000000153312454774476015571 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000117212454774476014450 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000044612454774476014745 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000057512454774476013272 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000246212454774476015241 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000041212454774476013611 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000076312454774476014455 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000200612454774476014756 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000071312454774476015000 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000222212454774476013515 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000056512454774476013673 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000111512454774476014240 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000175512454774476014176 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000143712454774476016614 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000265012454774476014437 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000111012454774476014130 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000175312454774476014103 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000103312454774476015153 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000230312454774476016667 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000140212454774476014000 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000300112454774476013601 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000226312454774476016531 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000112212454774476013241 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000065712454774476014265 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000047712454774476014627 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000115512454774476015477 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000113312454774476014415 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000061712454774476014331 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000137412454774476013775 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000367512464124630014470 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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}. 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.Rd0000644000176200001440000000131712454774476014314 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000125112454774476013631 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000265212454774476014475 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000164512454774476015171 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000104212454774476014276 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000142012454774476014612 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000112612454774476014734 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000127612454774476014425 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000100212454774476015511 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000105612454774476015016 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000146212454774476014454 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000066112454774476014271 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000101512454774476014252 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000674712454774476015604 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000107712454774476014163 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000520112454774476014204 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000103112454774476014053 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000231212454774476014104 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000123412454774476014645 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000243712454774476016177 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000112612454774476015321 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000141512454774476015111 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000121612454774476014300 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000113612454774476014747 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000115012454774476015422 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000302412454774476016053 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000141012454774476014563 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000120312454774476013445 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000241212454774476020222 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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.Rd0000644000176200001440000000077012454774476014551 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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/LICENSE0000644000176200001440000000016012411032027012403 0ustar liggesusersYEAR: 2013-2014 COPYRIGHT HOLDER: Bernd Bischl, Michel Lang, Olaf Mersmann ORGANIZATION: TU Dortmund University