Nothing
context("hash")
library(magrittr)
library(testthat)
##
# Helper to test whether two functions are the same
#
expect_list_equal <- function (given, expected) {
given %>% length() %>% expect_equal(length(expected), label=paste(expected, " length equals ", given))
mapply(identical, names(expected), names(given)) %>% all() %>% expect_true(label=paste(names(expected), " equals ", names(given)))
mapply(identical, expected, given) %>% all() %>% expect_true(label=paste(expected, " equals ", given))
}
##
# Helper to test that we get the expected default arguments for a function
#
test_that_defaultArgs_expected <- function (fn.test, result.expected) {
# get functions default arguments
fn.test %>% formals() %>% defaultArgs() %>%
# check we get the expected results
expect_list_equal(result.expected)
}
test_that("
Given a list,
When I ask for the first n of a list
Then I get the first n of a list", {
values <- list(1,2,3,4,5)
expect_list_equal(list(1,2,3), first.n(values, 3))
expect_list_equal(list(1,2,3), values %<n>% 3)
})
test_that("
Given some arguments,
When I ask which have not been named,
Then I get a list the missing names in the order they appear in the argument list", {
test.fn <- function (a, b=10, c=10) NULL
expect_list_equal(
unused.formals(formals(test.fn), list(10, 10, 10)),
list("a", "b", "c"))
expect_list_equal(
unused.formals(formals(test.fn), list(a=10, 10, 10)),
list("b", "c"))
expect_list_equal(
unused.formals(formals(test.fn), list(10, 10, c=10)),
list("a", "b"))
expect_list_equal(
unused.formals(formals(test.fn), list(10, a=10, 10)),
list("b", "c"))
expect_list_equal(
unused.formals(formals(test.fn), list(b=10, a=10, c=10)),
list())
})
test_that("
Given a set of arguments with or without names,
When I ask for their names,
Then I get the full list of argument names in the order they appear", {
test.fn <- function (a, b=10, c=10, d, e) NULL
expect_list_equal(
all.names(formals(test.fn), list(10, 10, 10, 10, 10)),
list("a", "b", "c", "d", "e"))
expect_list_equal(
all.names(formals(test.fn), list(a=10, 10, c=10, 10, 10)),
list("a", "b", "c", "d", "e"))
expect_list_equal(
all.names(formals(test.fn), list(a=10, b=10, c=10, d=10, e=10)),
list("a", "b", "c", "d", "e"))
expect_list_equal(
all.names(formals(test.fn), list(b=10, 10, d=10, 10, 10)),
list("b", "a", "d", "c", "e"))
})
test_that("
Given a function,
When I ask for the default values,
Then I get them", {
# no default values
test_that_defaultArgs_expected(
function (value) NULL,
alist()
)
# only default values
test_that_defaultArgs_expected(
function (def.value1 = "text", def.value2 = 10, def.value3 = list()) NULL,
alist(def.value1 = "text", def.value2 = 10, def.value3 = list())
)
# mixed default and non-default values
test_that_defaultArgs_expected(
function (value1, def.value1 = 10, value2, value3, def.value2 = 20) NULL,
alist(def.value1 = 10, def.value2 = 20)
)
# NULL, NA or empty default values
test_that_defaultArgs_expected(
function (def.value1 = NULL, def.value2 = "", def.value3 = NA) NULL,
alist(def.value1 = NULL, def.value2 = "", def.value3 = NA)
)
# with elipse
test_that_defaultArgs_expected(
function (def.value1 = 10, ...) NULL,
alist(def.value1 = 10)
)
# varible reference
myValue <- "PEFW"
test_that_defaultArgs_expected(
function (def.value1 = myValue) NULL,
alist(def.value1 = myValue)
)
})
test_that("
Given a list of default arguments,
When I inspect them against the provided arguments,
Then I will get the unset default values", {
alist(y=20, z=20) %>%
unset.defaultArgs(alist(10, x=10, y=10)) %>%
expect_list_equal(list(z=20))
})
test_that("
Given a function and a call,
When I ask for the function call,
Then the arguments are fully named correctly", {
test.fn <- function (a, b=10, c=10, d) NULL
test.call1 <- call("test.fn", 20, b=30)
test.call2 <- call("test.fn", 20, b=30, c=10)
test.call3 <- call("test.fn", b=30, a=20)
test.call4 <- call("test.fn", 20, 30)
test.call5 <- call("test.fn", 20, 30, a=10, 40)
with (functionCall(test.fn, test.call1), expect_list_equal(args, list(a=20, b=30)))
with (functionCall(test.fn, test.call2), expect_list_equal(args, list(a=20, b=30, c=10)))
with (functionCall(test.fn, test.call3), expect_list_equal(args, list(b=30, a=20)))
with (functionCall(test.fn, test.call4), expect_list_equal(args, list(a=20, b=30)))
with (functionCall(test.fn, test.call5), expect_list_equal(args, list(b=20, c=30, a=10, d=40)))
})
test_that("
Given a function,
When I ask for the function call,
Then I get the arguments fully named
And the function
And the calling name", {
test.fn <- function (a, b=10, c=10, d) functionCall()
expect_equal(test.fn(20, 10)$f, test.fn)
expect_list_equal(test.fn(20, b=30)$args, list(a=20, b=30))
with (test.fn(20, b=30, c=10), expect_list_equal(args, list(a=20, b=30, c=10)))
with (test.fn(b=30, a=20), expect_list_equal(args, list(b=30, a=20)))
with (test.fn(20, 30), expect_list_equal(args, list(a=20, b=30)))
with (test.fn(20, 30, a=10, 40), expect_list_equal(args, list(b=20, c=30, a=10, d=40)))
test.fn.elip <- function (a, b=10, ...) functionCall()
with (test.fn.elip(20, b=30), expect_list_equal(args, list(a=20, b=30)))
with (test.fn.elip(20, b=30, c=10), expect_list_equal(args, list(a=20, b=30, c=10)))
with (test.fn.elip(b=30, a=20), expect_list_equal(args, list(b=30, a=20)))
with (test.fn.elip(20, 30), expect_list_equal(args, list(a=20, b=30)))
with (test.fn.elip(20, a=10, 30, 40), expect_list_equal(args, list(b=20, a=10, mf.na=30, mf.na=40)))
with (test.fn.elip(10, 20, 30, 40), expect_list_equal(args, list(a=10, b=20, mf.na=30, mf.na=40)))
with (test.fn.elip(10, 20, c=30, d=40), expect_list_equal(args, list(a=10, b=20, c=30, d=40)))
with (test.fn.elip(10, 20, 30, d=40), expect_list_equal(args, list(a=10, b=20, mf.na=30, d=40)))
})
test_that("
Given a function with mandatory and non-mandatory arguments,
When I hash the function call with the same argurment values in different order,
Then the result is always identical", {
test.fn <- function (a, b=10, c=10) NULL
test.call1 <- call("test.fn", 20, b=30)
test.call2 <- call("test.fn", 20, b=30, c=10)
test.call3 <- call("test.fn", b=30, a=20)
test.call4 <- call("test.fn", 20, 30)
test.call5 <- call("test.fn", 20, 30, 10)
hash1 <- functionCall(test.fn, test.call1) %>% hash()
hash2 <- functionCall(test.fn, test.call1) %>% hash()
hash3 <- functionCall(test.fn, test.call2) %>% hash()
hash4 <- functionCall(test.fn, test.call3) %>% hash()
hash5 <- functionCall(test.fn, test.call4) %>% hash()
hash6 <- functionCall(test.fn, test.call5) %>% hash()
expect_equal(hash1, hash2)
expect_equal(hash1, hash3)
expect_equal(hash1, hash4)
expect_equal(hash1, hash5)
expect_equal(hash1, hash6)
})
all_this <- function(this, values)
if (length(values) <= 1) TRUE else
values[2:length(values)] %>% sapply(this, y = values[[1]]) %>% all() && all_this(this, values[2:length(values)])
all_different <- function(values) all_this(`!=`, values)
all_same <- function (values) all_this(`==`, values)
test_that("
Given a function with mandatory and non-mandatory arguments,
When I hash the function call with different argument values,
Then the results are all different", {
test.fn <- function (a, b=10, c=10) NULL
list(
call("test.fn", 20, b=30),
call("test.fn", 20, b=30, c=5),
call("test.fn", b=30, a=10),
call("test.fn", 20, 10),
call("test.fn", 25, 30, 10)) %>%
lapply(function (call) functionCall(test.fn, call) %>% hash()) %>%
all_different() %>% expect_true()
})
test_that("
Given a function with mandatory and non-mandatory arguments,
When I hash the function call with varibale argument values,
Then the results reflect the changes to the value", {
test.fn <- function (a, b=10, c=10) NULL
alpha <- 20
hash1 <- functionCall(test.fn, call("test.fn", alpha)) %>% hash()
alpha <-10
hash2 <- functionCall(test.fn, call("test.fn", alpha)) %>% hash()
alpha <- 20
hash3 <- functionCall(test.fn, call("test.fn", alpha)) %>% hash()
expect_false(hash1 == hash2)
expect_true(hash1 == hash3)
})
test_that("Given a function with elipse,
When I hash the function call
Then the hash is equivalent for additional arguments of the same names and order
And the has is different when the additional arguments are in a different order or have a different name
", {
test.fn <- function (a, b=10, ...) NULL
list(
call("test.fn", 10, 20, 30, d=40, 50),
call("test.fn", a=10, b=20, 30, d=40, 50),
call("test.fn", b=20, a=10, 30, d=40, 50),
call("test.fn", b=20, a=10, d=40, 30, 50)
) %>%
lapply(function (call) functionCall(test.fn, call) %>% hash()) %>%
all_same() %>% expect_true();
values <- list(
call("test.fn", 10, 20, 30, d=40, 50),
call("test.fn", 10, 20, d=30, 40, 50),
call("test.fn", 10, 20, f=30, 40, 50),
call("test.fn", 10, 20, 50, 40, 30)
) %>%
lapply(function (call) functionCall(test.fn, call) %>% hash())
all_different(values) %>% expect_true(label = paste(values, " are all different"))
})
test_that("
Given a function,
When I evaluate it using do.call,
Then I get the same hash from the function call as I would if I invoked the function normally", {
test.fn <- function (a, b=10) functionCall() %>% hash()
expect_equal(
do.call(test.fn, list(10, b=20)),
test.fn(10, 20)
)
expect_equal(
do.call(test.fn, list(b=10, a=20)),
test.fn(20, b=10)
)
})
test_that("
Given a function that takes a function as a parameter,
When I hash the function call,
Then anonumous functions that are identical in body to function varibles produce the same hash values", {
test.add <- function (x) x+1
test.subtract <- function (x) x-1
test.fn <- function (f, x=10) f(x)
value <- 10
list(
call("test.fn", test.add),
call("test.fn", test.add, 10),
call("test.fn", test.add, value),
call("test.fn", function (x) x+1, 10)) %>%
lapply(function (call) functionCall(test.fn, call) %>% hash()) %>%
all_same() %>% expect_true()
list(
call("test.fn", test.add, 20),
call("test.fn", test.add, 10),
call("test.fn", test.subtract, 20),
call("test.fn", function (x) x+1, 30)) %>%
lapply(function (call) functionCall(test.fn, call) %>% hash()) %>%
all_different() %>% expect_true()
})
test_that("
Given a function call that has no arguments,
When I hash the function call,
Then I get a hash value", {
test.fn <- function () 10
expect_true(!is.null(functionCall(test.fn, call("test.fn")) %>% hash()))
})
test_that("
Given a function,
When I hash the function,
Then I get consistent results", {
fn_hash <- (function (value) value) %>% hash()
(function (another_value) value) %>% hash() %>% `==`(fn_hash) %>% expect_false()
(function (value = 10) value) %>% hash() %>% `==`(fn_hash) %>% expect_false()
(function (value) print(value)) %>% hash() %>% `==`(fn_hash) %>% expect_false()
(function (value) value) %>% hash() %>% `==`(fn_hash) %>% expect_true()
})
test_that("
Given a list that contains different types of arguments
When I hash the list,
Then I get consistent results", {
sl_hash <- list("a", 1, TRUE, 3.142) %>% hash()
sn_hash <- list(a = "a", b = 1, c = TRUE, d = 3.142) %>% hash()
list("a", 1, TRUE, 3.142) %>% hash() %>% `==`(sl_hash) %>% expect_true()
list("a", TRUE, 1, 3.142) %>% hash() %>% `==`(sl_hash) %>% expect_false()
list("a", TRUE, 1) %>% hash() %>% `==`(sl_hash) %>% expect_false()
list("b", 2, FALSE, 3.12) %>% hash() %>% `==`(sl_hash) %>% expect_false()
list("a", 1, TRUE, 3.14) %>% hash() %>% `==`(sl_hash) %>% expect_false()
expect_false(sl_hash == sn_hash)
list(a = "a", b = 1, c = TRUE, d = 3.142) %>% hash() %>% `==`(sn_hash) %>% expect_true()
list(b = 1, a = "a", c = TRUE, d = 3.142) %>% hash() %>% `==`(sn_hash) %>% expect_true()
list(z = "a", b = 1, c = TRUE, d = 3.142) %>% hash() %>% `==`(sn_hash) %>% expect_false()
list(a = "a", b = 1, c = TRUE, d = 3.1) %>% hash() %>% `==`(sn_hash) %>% expect_false()
list(z = 1, a = "a", c = TRUE, d = 3.142) %>% hash() %>% `==`(sn_hash) %>% expect_false()
one <- 1
two <- 2
too <- 2
value <- 3
vl_hash <- list(a=one, b=two, value) %>% hash()
list(a=one, b=two, value) %>% hash() %>% `==`(vl_hash) %>% expect_true()
list(a=1, b=2, 3) %>% hash() %>% `==`(vl_hash) %>% expect_true()
list(a=one, b=too, 3) %>% hash() %>% `==`(vl_hash) %>% expect_true()
one <- 2;
list(a=one, b=two, value) %>% hash() %>% `==`(vl_hash) %>% expect_false()
f <- function (value) value
expect_equal(
list((function (value) value)) %>% hash(),
list(f) %>% hash())
})
# TODO Note: what do we do about closures? could we use variables used within the closure to create the hash?
# TODO Note: anonymouse functions can't be hashed atm!
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.