context('parameter validation')
describe('numeric validation', {
lapply(paste0('validate_', NUMERIC_VARS), function(fn) {
test_that(paste0('It allows positive numeric numbers to go through ', fn), {
value <- 4.2
expect_equal(do.call(fn, list(value)), value)
})
})
lapply(paste0('validate_', NUMERIC_VARS), function(fn) {
test_that(paste0('It does not allow negative numbers to go through ', fn), {
BAD_VALUES <- list(-42, 0, c(1, 2, 3), 'hello', function(x) {x}, TRUE, NA)
lapply(BAD_VALUES, function(value) {
expect_error(do.call(fn, list(value)), 'must be a positive numeric')
})
})
})
})
describe('max iterations', {
test_that('Max iterations is a positive integer', {
expect_equal(validate_max_iterations(5), 5)
expect_error(validate_max_iterations(0), 'must be a positive numeric')
expect_error(validate_max_iterations(4.2), 'must be a positive integer')
})
})
describe('num hidden', {
test_that('Positive cases are validated', {
GOOD <- list(1, c(1, 2, 3))
lapply(GOOD, function(value) {
expect_equal((value), value)
})
})
test_that('Negative cases throw an error', {
GOOD <- list('hello', c(1.5, 2, 3), function(x) {x}, TRUE, 0, NA)
lapply(GOOD, function(value) {
expect_error((value), 'must be an integer vector, specifying number of neurons in each hidden layer')
})
})
})
describe('rescaling', {
test_that('Rescale defaults to FALSE but can be TRUE', {
expect_equal(validate_rescale(TRUE), TRUE)
lapply(c(1, NA, FALSE, c(1,2), function(x) {x}, 'hello'), function(value) {
expect_equal(validate_rescale(value), FALSE)
})
})
describe('rescaling offset must be a positive numeric', {
BAD_VALUES <- list(-1, c(1, 2), FALSE, 'hello', function(x) {x})
test_that('when rescale is false return value is NULL', {
lapply(BAD_VALUES, function(value) {
expect_null(validate_rescaling_offset(value, FALSE))
})
expect_null(validate_rescaling_offset(0.5, FALSE))
})
test_that('when rescale is false return value is NULL', {
lapply(BAD_VALUES, function(value) {
expect_error(validate_rescaling_offset(value, TRUE), 'must be a positive numeric')
})
expect_equal(validate_rescaling_offset(0.5, TRUE), 0.5)
})
})
})
describe('activation', {
describe('non-character and non-function', {
BAD_VALUES <- list(-1, c(1, 2), FALSE, NULL)
lapply(BAD_VALUES, function(value) {
test_that(paste0('Gives a descriptive error message for ', capture.output(print(value))), {
expect_error(validate_activation(value, value), 'Must be either a function or one of predefined activations')
})
})
})
describe('character', {
test_that('positive cases', {
lapply(names(ACTIVATION_FUNCTIONS), function(nm) {
expect_equal(validate_activation(nm, TRUE), ACTIVATION_FUNCTIONS[[nm]])
})
})
test_that('for a weird name you\'ll get an error', {
expect_error(validate_activation('hello', TRUE), 'No such activation function found. Please select from')
})
})
describe('function', {
test_that('works for two supplied functions', {
funcs <- list(activation = function(x) { x }, d_activation = function(x) { 1 })
expect_equal(do.call(validate_activation, funcs), funcs)
})
test_that('you need to supply d_activation too', {
expect_error(validate_activation(function(x) { x }, TRUE), 'd_activation must be a function')
})
})
})
describe('optim method', {
test_that('returns an error on unknown methods', {
expect_error(validate_optim_method('hello'), 'should be one of')
})
test_that('correctly validates a good method', {
value <- OPTIM_METHODS[1L]
expect_equal(validate_optim_method(value), value)
})
})
describe('train matrix', {
test_that('non-matrix and non data.frame returns an error', {
BAD_VALUES <- list(-1, c(1, 2), FALSE, NULL, function(x) { x }, 'hello')
lapply(BAD_VALUES, function(value) {
expect_error(validate_train_matrix(value), 'Provided datasets for test and training must be either numeric data frames or matrixes')
})
})
describe('matrix', {
test_that('good matrix', {
value <- matrix(0, nrow = 4, ncol = 5)
expect_equal(validate_train_matrix(value), value)
})
test_that('bad matrix', {
expect_error(validate_train_matrix(matrix('hello', nrow = 4, ncol = 5)), 'Provided datasets must be numeric matrixes')
})
})
describe('data.frame', {
test_that('good df', {
value <- data.frame(a = 1:10, b = rep(4.2, 10))
expect_equal(validate_train_matrix(value), as.matrix(value))
})
test_that('bad df', {
expect_error(validate_train_matrix(data.frame(a = 1, b = 'hello')), 'Provided data.frame must contain only numeric columns')
})
})
})
describe('test matrix', {
test_that('test matrix can be a matrix', {
value <- matrix(0, nrow = 4, ncol = 5)
expect_equal(validate_test_matrix(value), value)
})
test_that('test matrix can be a data.frame', {
value <- data.frame(a = 1:10, b = rep(4.2, 10))
expect_equal(validate_test_matrix(value), as.matrix(value))
})
test_that('test matrix can also be NULL', {
expect_equal(validate_test_matrix(NULL), NULL)
})
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.