Nothing
context('Utility functions')
test_that('stale_package_check works', {
stale_package_path <- function(path) test_path('stale_package_test_scripts', path)
expect_output(
stale_package_check(stale_package_path('simple.R')),
paste(
c("Functions matched from package stats:",
paste0("\t", toString(sort(c("density", "rnorm")))),
"Functions matched from package tools:",
"\tfile_ext",
"**No exported functions matched from tcltk**"),
collapse = '\n'
),
fixed = TRUE
)
expect_output(
stale_package_check(stale_package_path('use_namespace_call.R')),
'**No exported functions matched from stats**',
fixed = TRUE
)
expect_output(
stale_package_check(stale_package_path('wont_parse.R')),
'Failed to parse R script, please fix syntax errors first',
fixed = TRUE
)
expect_output(
stale_package_check(stale_package_path('no_library.R')),
'No library() or require() calls found',
fixed = TRUE
)
})
test_that('one-line utilities work', {
expect_equal(to.pct(.8, 2L), 80)
expect_equal(to.pct(.8030432, 3L), 80.304)
expect_equal(nx.mlt(3, 5), 5)
expect_equal(nx.mlt(24, 17), 34)
expect_equal(divide(c(1, 4, 8, 9, 11, 2, 2), 3), c(1L, 6L, 11L))
expect_equal(dol.form(1e6), '$1,000,000')
expect_equal(dol.form(1e6, suff='m'), '$1m')
expect_equal(dol.form(-1e6), '-$1,000,000')
expect_equal(dol.form(123.456, dig = 0L), '$123')
expect_equal(dol.form(123, tex = TRUE), '\\$123')
expect_equal(ntostr(1999:2020, 2), sprintf('%02d', c(99, 0:20)))
})
test_that('embed.mat works', {
m = matrix(1:10, 5L, 2L)
expect_equal(embed.mat(m, 6, 3), rbind(cbind(m, 0), 0))
expect_equal(embed.mat(m, M=6, N=3, m=2, n=2), rbind(0, cbind(0, m)))
expect_equal(embed.mat(m, 6, 3, fill = 1), rbind(cbind(m, 1), 1))
expect_error(embed.mat(m, 1, 1), 'Supplied matrix too large for supplied enclosing matrix')
expect_error(embed.mat(m, m=10, n=10), 'Supplied starting position outside supplied enclosing matrix bounds')
})
test_that('set utilities work', {
A = 1:5
B = 3:8
expect_equal(A %u% B, 1:8)
expect_equal(A %\% B, 1:2)
expect_equal(A %^% B, 3:5)
})
# works as long as range(dates) doesn't include leap centuries:
# 1900-03-01 = -25508
# 2100-02-28 = 47540
test_that('quick date utils work', {
dates = .Date(c(-1e4, 0, 365, 730, 1096, 1461, 1e4))
dates_lt = as.POSIXlt(dates)
expect_equal(quick_year(dates), dates_lt$year + 1900L)
expect_equal(quick_yday(dates), dates_lt$yday + 1L)
expect_equal(quick_mday(dates), dates_lt$mday)
})
test_that('get_age works', {
test_df = data.frame(
birth_date = .Date(c(
3285, 3286, 3287, -2559, -2558, -2557, 11124, 11125,
11126, 13590, 13591, 13592, -672, -672, -672
)),
given_date = .Date(c(
16800, 16800, 16800, 16800, 16800, 16800, 29387, 29387,
29387, 13957, 13957, 13957, 16494, 16495, 16496
))
)
expect_equal(
with(test_df, get_age(birth_date, given_date)), c(
37.0027322404372, # will be 366 days until 12/31/16, so fraction is 1/366
37, 36.9972602739726,
53.0027322404372, # ditto here
53, 52.9972602739726, 50.0027397260274, 50,
49.9972602739726, # fraction should be 364/365
1.0027397260274, # 2/29 already passed, only 365 days until 3/19/2009
1, 0.997267759562842,
46.9972602739726, # my judgment: birthday occurs on 3/1 for 2/29 babies, so 364/365 the way there
47, 47.0027322404372
)
)
})
test_that('create_quantiles works', {
expect_equal(create_quantiles(1:10, 4L), factor(rep(1:4, c(3L, 2L, 2L, 3L))))
expect_equal(create_quantiles(1:10, 3L), factor(rep(1:3, c(3L, 3L, 4L))))
expect_error(create_quantiles(rep(1:2, c(100L, 1L)), 2L), error='Overlapping quantiles. Please provide 1 label.')
expect_error(create_quantiles(rep(1:2, c(2L, 1L)), 3L), error='Overlapping quantiles. Please provide 2 labels.')
})
test_that('write_packages works', {
invisible(capture.output(out <- write.packages()))
expect_equal(
names(out), c(
"r_version", "locale", "running", "linear_algebra", "base_packages",
"other_packages", "loaded_via_namespace", "write_package_time"
)
)
expect_equal(out$r_version$version.string, R.version.string)
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.