tests/test-gadgetformulae.R

In bthe/rgadget: Tools to Create and Maintain Gadget Models

library(Rgadget)
library(unittest, quietly = TRUE)

ver_string <- paste("; Generated by Rgadget", utils::packageVersion("Rgadget"))

cmp_str <- function(exp, expected_str) {
    ut_cmp_identical(utils::capture.output(str(exp)), expected_str)
}

# Write string into temporary directory and read it back again as a gadget file
read.gadget.string <- function(..., dir = tempdir(), file_type = "generic") {
    writeLines(c(...), con = file.path(dir, "wibble"))
    read.gadget.file(dir, "wibble", file_type = file_type)
}

ok_group("parse.gadget.formulae", {
    ok(cmp_str(
        parse.gadget.formulae("2"),
        " num 2"), "Constants will parse")

    ok(cmp_str(
        parse.gadget.formulae("(+ 2 (log (- #moo 1)))"),
        " language 2 + log(moo - 1)"), "Parsed deeply nested functions")

    ok(cmp_str(
        parse.gadget.formulae("(+ (2) (log (- (#moo) 1)))"),
        " language 2 + log(moo - 1)"), "Bracketed constants are fine")

    # NB: quote(10 + (potato - 12)) is not identical to call("+", 10, call("-", quote(potato), 12)))
    # Depending on version of R the brackets are explicit in the first version
    # Which is more correct I'm not sure currently, but identical notices the difference
    ok(ut_cmp_identical(
        parse.gadget.formulae("(+ 10 (- #potato 12))"),
        call("+", 10, call("-", quote(potato), 12))), "We don't (yet) add explicit bracket functions to parse tree")
})

ok_group("to.gadget.formulae", {
    ok(ut_cmp_identical(
        to.gadget.formulae(quote(2 + log(moo - 1))),
        "(+ 2 (log (- #moo 1)))"), "Can generate from quoted expressions")
    ok(ut_cmp_identical(
        to.gadget.formulae(parse.gadget.formulae("(+ (2) (log (- (#moo) 1)))")),
        "(+ 2 (log (- #moo 1)))"), "Can generate from the output of parse.gadget.formulae")

    ok(ut_cmp_identical(
        to.gadget.formulae(quote(4 + (2 - 8))),
        "(+ 4 (- 2 8))"), "We ignore R's explicit bracket function")

    ok(ut_cmp_identical(
        to.gadget.formulae(~ 2 + (wibble * 2)),
        "(+ 2 (* #wibble 2))"), "Can generate from formulae")
    ok(ut_cmp_identical(
        to.gadget.formulae(y ~ 4 + (wibble * 4)),
        "(+ 4 (* #wibble 4))"), "Any LHS is ignored")
})

ok_group("sub.gadget.formulae", {
    path <- tempdir()

    ok(cmp_str(
        sub.gadget.formulae(quote(2 + log(moo)), list()),
        " language 2 + log(moo)"), "No substitutions")
    ok(cmp_str(
        sub.gadget.formulae(quote(2 + moo), list(frank = 3)),
        " language 2 + moo"), "No substitutions with correct name")
    ok(cmp_str(
        sub.gadget.formulae(quote(2 + log(moo) + oink), list(moo = 8, oink = quote(log(5)))),
        " language 2 + log(8) + log(5)"), "Can substitute values and strings")
    ok(cmp_str(
        sub.gadget.formulae(quote(2 + log(moo) + oink), list(moo = "(+ #baa #neigh)")),
        " language 2 + log(baa + neigh) + oink"), "Character strings are assumed to be gadget formulae")
    ok(cmp_str(
        sub.gadget.formulae(quote(2 + log(moo) + oink), list(moo = "(+ #baa #neigh)")),
        " language 2 + log(baa + neigh) + oink"), "Character strings are assumed to be gadget formulae")

    tv <- read.gadget.string(
        ver_string,
        "annualgrowth",
        "data",
        "; year	step	value",
        "1995	1	#grow1995",
        "1996	1	#grow1996",
        "1997	1	#grow1997",
        "1998	1	#grow1998",
        "1999	1	#grow1999",
        "2000	1	#grow2000",
        dir = path,
        file_type = "timevariable")
    ok(ut_cmp_error(
        sub.gadget.formulae(quote(log(moo) + oink), list(moo = tv)),
        "Specify year"), "Need year before timevariables are useful")
    ok(ut_cmp_error(
        sub.gadget.formulae(quote(log(moo) + oink), list(moo = tv), year = 1995),
        "Specify step"), "Need step before timevariables are useful")
    ok(ut_cmp_error(
        sub.gadget.formulae(quote(log(moo) + oink), list(moo = tv), year = 1995, step = 99),
        "No value for moo"), "Outside timevariable range is an error")
    ok(cmp_str(
        sub.gadget.formulae(quote(log(moo) + oink), list(moo = tv), year = 1995, step = 1),
        " language log(grow1995) + oink"), "Replaced variable name")
})