library(testthat)
# Hype par ----
test_that("hype par general", {
parlist <- list(
par_unif('a', 1, 3),
par_log10('b', 1e-4, 1e2),
par_discretenum('c', c(1,3,10,13,30)),
par_integer('d', 9, 98),
par_ordered('e', letters[5:14]),
par_unordered('f', letters[15:18])
)
# All par should have same standard for these functions
for (pp in parlist) {
expect_true("par_hype" %in% class(pp))
expect_true("R6" %in% class(pp))
expect_error(spp <- pp$generate(runif(100)), NA)
expect_true(all(pp$isvalid(spp)))
expect_error(pp$getseq(10), NA)
expect_error(capture.output(print(pp)), NA)
# getseq
expect_error(ppseq <- pp$getseq(n=30), NA)
expect_true("list" %in% class(ppseq))
expect_equal(c("trans", "raw"), names(ppseq))
expect_true(all(pp$isvalid(ppseq$raw)))
# Check conversion to mopar
expect_error(mopp <- pp$convert_to_mopar(raw_scale = TRUE), NA)
expect_true("mixopt_par" %in% class(mopp))
expect_true("list" %in% class(mopp))
expect_error(mopp <- pp$convert_to_mopar(raw_scale = FALSE), NA)
expect_true("mixopt_par" %in% class(mopp))
expect_true("list" %in% class(mopp))
}
})
test_that("hype par", {
# Create params
# generic
expect_error(p1 <- R6_par_hype$new(), NA)
expect_true("par_hype" %in% class(p1))
# Uniform
expect_error(p1 <- par_unif("a", -1, 1), NA)
expect_true("par_unif" %in% class(p1))
expect_error(capture.output(print(p1)), NA)
# Log scale
expect_error(plog <- par_log10("a", 1e-8, 1), NA)
expect_true("par_log10" %in% class(plog))
expect_error(capture.output(print(plog)), NA)
# Unordered
expect_error(pun <- par_unordered("puno", letters[1:10]), NA)
expect_error(capture.output(print(pun)), NA)
expect_equal(pun$isvalid(c('a','e', 'z')), c(T,T,F))
expect_error(pun <- par_unordered("puno", 13:19), NA)
expect_error(capture.output(print(pun)), NA)
expect_equal(pun$isvalid(18:21), c(T,T,F,F))
# Unordered: logical
expect_error(pun <- par_unordered("puno", c(T, F)), NA)
expect_true(all(pun$isvalid(c(T, F))))
expect_false(pun$isvalid(5))
expect_false(pun$isvalid('a'))
# Ordered
expect_error(por <- par_ordered("puno", letters[3:11]), NA)
expect_error(capture.output(print(por)), NA)
expect_equal(por$isvalid(c('c','d','y','z')), c(T,T,F,F))
expect_error(por <- par_ordered("puno", 4:9), NA)
expect_error(capture.output(print(por)), NA)
expect_equal(por$isvalid(8:11), c(T,T,F,F))
# Discrete num
expect_error(pdn <- par_discretenum("puno", letters))
expect_error(pdn <- par_discretenum("puno", c(1,3,2)))
expect_error(pdn <- par_discretenum("puno", c(.1,1,19)), NA)
expect_error(capture.output(print(pdn)), NA)
expect_equal(pdn$isvalid(c(1,3,13,19)), c(T,F,F,T))
# Integer
expect_error(pi <- par_integer('pint', 4,'c'))
expect_error(pi <- par_integer('pint', 'c', 9))
expect_error(pi <- par_integer('pint', 4:9))
expect_error(pi <- par_integer('pint', 4,14), NA)
expect_error(capture.output(print(pi)), NA)
expect_equal(pi$isvalid(c(8,6,-2,22)), c(T,T,F,F))
})
# Hype basics ----
test_that("hype works", {
# Create params
p1 <- R6_par_hype$new()
expect_true("par_hype" %in% class(p1))
p1 <- par_unif("a", -1, 1)
expect_true("par_unif" %in% class(p1))
plog <- par_log10("a", 1e-8, 1)
expect_true("par_log10" %in% class(plog))
# Create hype
h1 <- hype(eval_func = function(a) {a^2}, p1, n_lhs=3)
# Check basics
expect_true("hype" %in% class(h1))
# expect_equal(nrow(h1$X), 3)
expect_true(is.null(h1$X))
expect_equal(nrow(h1$ffexp$rungrid2()), 3)
expect_equal(length(h1$Z), 0)
expect_error(h1$run_all(), NA)
expect_equal(length(h1$Z), 3)
# Check add EI
expect_error(h1$add_EI(1), NA)
expect_error(h1$add_EI(1), NA)
expect_error(h1$run_all(), NA)
expect_error({h1$run_EI_for_time(1, 1)}, NA)
# Check plots
expect_error(plotorder <- h1$plotorder(), NA)
expect_is(plotorder, 'ggplot')
expect_error(plotX <- h1$plotX(), NA)
expect_is(plotX, 'ggplot')
expect_error(plotplot <- plot(h1), NA)
expect_is(plotplot, 'ggplot')
expect_error(plotXorder <- h1$plotXorder(), NA)
expect_is(plotXorder, 'ggplot')
rm(h1)
})
test_that("2 inputs", {
# Two inputs
expect_error({
h2 <- hype(eval_func = function(a, b) {a^2 - sin(2*pi*b)},
par_unif("a", -1, 1),
par_unif("b", -1,1),
n_lhs=3)
}, NA)
expect_error(h2$run_all(), NA)
expect_error(h2$add_EI(n=3), NA)
expect_error(h2$run_all(), NA)
# Add LHS
expect_error(h2$add_LHS(n=3), NA)
expect_error(h2$run_all(), NA)
# Plot interaction
expect_error(plotint <- h2$plotinteractions(), NA)
expect_is(plotint, 'ggplot')
# Plot pairs
expect_error(plotpairs <- h2$pairs(), NA)
expect_is(plotpairs, 'ggplot')
# Print object
expect_error(printout <- capture.output(print(h2)), NA)
printout <- capture.output(print(h2))
expect_true(is.character(printout), length(printout) >= 1)
# Break if no params
expect_error(hype(eval_func = function(a) {a^2}, n_lhs=3))
# Break if not a param
expect_error(hype(eval_func = function(a) {a^2}, sin, n_lhs=3))
# Break if X0 given as matrix
expect_error(hype(eval_func = function(a) {a^2}, par_unif('a',1,3),
X0=matrix(1:3, ncol=1), n_lhs=3))
# Break if n_lhs not given
expect_error(hype(eval_func = function(a) {a^2}, par_unif('a',1,3)))
})
test_that("4 inputs", {
# 4 inputs --
expect_error({
h2 <- hype(eval_func = function(a, b, c, d) {10*a^2*c -
abs(d)^.3*sin(2*pi*b) -.1*c*d},
par_unif("a", -1, 1),
par_unif("b", -1,1),
par_unif("c", -10,1),
par_unif("d", -100,100),
n_lhs=3)
}, NA)
expect_error(h2$run_all(), NA)
expect_error(h2$add_EI(n=3), NA)
expect_error(h2$run_all(), NA)
# Add LHS
expect_error(h2$add_LHS(n=3), NA)
expect_error(h2$run_all(), NA)
# Plot interactions
expect_error(h2$plotinteractions(), NA)
})
# Hype add data ----
test_that("Hype add data", {
# Test adding in data using add_data
f1 <- function(a, b, c) {-a^2*log(b,10)^2}
n0 <- 10
x0 <- data.frame(a=runif(n0, -1,1),
b=10^runif(n0, -3,4),
c=runif(n0, 1,2))
y0 <- numeric(n0)
for (i in 1:n0) {
y0[i] <- f1(x0$a[i], x0$b[i], x0$c[i])
}
cbind(x0, y0)
# 3 inputs, 2 matter, interaction
expect_error({
x9 <- hype(eval_func = f1,
par_unif("a", -1, 1),
par_log10("b", 10^-3, 10^4),
par_unif("c", 1,2),
n_lhs=6)
x9$run_all()
}, NA)
expect_true(length(x9$Z) == 6)
# x9$plotX()
# debugonce(x9$add_data)
expect_error({
x9$add_data(X=x0, Z=y0)
}, NA)
# x9
# x9$plotX2()
expect_error({
x9$add_EI(1)
x9$run_all()
}, NA)
# x9$plotorder()
# x9$plotX()
# x9$plotinteractions()
# Test adding data when creating object
# Give in X0, but not Z0
expect_error({
r5 <- hype(eval_func = f1,
par_unif("a", -1, 1),
par_log10("b", 10^-3, 10^4),
par_unif("c", 1,2),
X0=x0)
}, NA)
expect_true(length(r5$ffexp$completed_runs) == 10,
is.null(r5$X),
!r5$ffexp$completed_runs)
# r5
# Give in X0 and Z0
expect_error({
r8 <- hype(eval_func = f1,
par_unif("a", -1, 1),
par_log10("b", 10^-3, 10^4),
par_unif("c", 1,2),
X0=x0, Z0=y0)
}, NA)
# r8
# r8$plotX()
# Test changing parameter bounds
n2 <- hype(eval_func = f1,
par_unif("a", -1, 1),
par_log10("b", 10^-3, 10^4),
par_log10("c", 1,100),
n_lhs=6)
n2$run_all()
# n2$plotX()
# n2$parlist
# n2$parlowerraw
# n2$parlowertrans
# n2$parupperraw
# n2$paruppertrans
# expect_equal(n2$parlowerraw, c(-1, .001, 1))
expect_equal(n2$parlowertrans, c(-1, -3, 0))
# expect_equal(n2$parupperraw, c(1, 1e4, 1e2))
expect_equal(n2$paruppertrans, c(1, 4, 2))
n2$change_par_bounds('a', lower=0)
n2$change_par_bounds('b', upper=10^8)
n2$change_par_bounds('c', lower=.1, upper=1e3)
# expect_equal(n2$parlowerraw, c(0, .001, .1))
expect_equal(n2$parlowertrans, c(0, -3, -1))
# expect_equal(n2$parupperraw, c(1, 1e8, 1e3))
expect_equal(n2$paruppertrans, c(1, 8, 3))
# expect_true(n2$)
# n2$parlowerraw
# n2$parlowertrans
# n2$parupperraw
# n2$paruppertrans
# n2$plotX()
expect_error({
hype(eval_func = f1,
par_unif("a", -1, 1),
par_log10("b", 10^-3, 10^4),
par_unif("c", 1,2),
X0=list(a=runif(5)))
})
})
# Discrete params ----
test_that("discrete params", {
# Test discrete par
expect_error({
hp <- hype(
eval_func = function(a, b, c) {
-1e-3*a^2*log(b,10)^2*ifelse(c=='a', 1, 2) + rnorm(length(a),0,1e-1)
},
par_unif("a", 6, 8),
par_log10("b", 1e-8, 1e-2),
par_unordered("c", c('a', 'b')),
n_lhs=21)
}, NA)
expect_true(!hp$par_all_cts)
# plotX doesn't work until something has been evaluated
expect_error(hp$plotX())
expect_error(hp$plotXorder())
expect_error(hp$plotinteractions())
hp$run_all()
expect_equal(length(hp$Z), 21)
expect_error({
hp$plotX(addEIlines = T, addlines = T)
}, NA)
expect_error({
hp$plotXorder()
}, NA)
expect_error({
hp$add_EI(1, model='gaupro')
hp$run_all()
}, NA)
# print('hpZ length is'); print(length(hp$Z))
expect_equal(length(hp$Z), 22)
})
# All param types ----
test_that("hype with all params type", {
# Test all param types
expect_error({
hp <- hype(eval_func = function(a, b, c, d, e, f) {
-1e-3*a^2*log(b,10)^2*ifelse(c=='a', 1, 2) +
e +
.2*f +
rnorm(length(a),0,1e-1)
},
par_unif("a", 6, 8),
par_log10("b", 1e-8, 1e-2),
par_unordered("c", c('a', 'b')),
par_ordered("d", c('a', 'b')),
par_discretenum("e", c(1,3,10)),
par_integer('f', 5, 15),
n_lhs=21)
}, NA)
expect_true(!hp$par_all_cts)
hp$run_all()
expect_equal(length(hp$Z), 21)
expect_error({
hp$plotX(addEIlines = T, addlines = T)
}, NA)
expect_error({
hp$plotXorder()
}, NA)
# Find best_param
expect_error(hppb <- hp$best_params(), NA)
expect_true(is.list(hppb))
expect_true(all(names(hppb) %in% c("unevaluated", "evaluated")))
expect_warning({
hp$add_EI(1, model='gaupro')
hp$run_all()
}, NA)
expect_equal(length(hp$Z), 22)
expect_error({
hp$add_EI(2, model='gaupro')
hp$run_all()
}, NA)
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.