tests/testthat/test.PartialApplication.R

In BioCro: Modular Crop Growth Simulations

# Makes sure the convenience functions for partial application are functioning
# properly

# TESTING PARTIAL_RUN_BIOCRO

# Get the baseline simulation result, which is based on the 2005 Miscanthus
# simulation, but where we have changed the atmospheric CO2 concentration and
# all hourly air temperatures
CROP <- miscanthus_x_giganteus
weather <- get_growing_season_climate(weather$'2005')
new_catm <- 500
temp_offset <- 1

baseline_rb_result <- with(CROP, {run_biocro(
    initial_values,
    within(parameters, {Catm = new_catm}),
    within(weather, {temp = temp + temp_offset}),
    direct_modules,
    differential_modules,
    ode_solver
)})

# Now use partial application
crop_func <- with(CROP, {partial_run_biocro(
    initial_values,
    parameters,
    weather,
    direct_modules,
    differential_modules,
    ode_solver,
    c("Catm", "temp")
)})

# Specify the values for Catm and temp in several ways, checking to make sure
# the results are the same as the baseline
rb_x_vals <- list(
    c(new_catm, weather$temp + temp_offset),
    list(Catm = new_catm, temp = weather$temp + temp_offset),
    list(temp = weather$temp + temp_offset, Catm = new_catm)
)

for (i in seq_along(rb_x_vals)) {
    msg <- paste("Testing `partial_run_biocro` with input case", i)
    test_that(paste("Testing `partial_run_biocro` with input case", i), {
        expect_equal(crop_func(rb_x_vals[[i]])$Leaf, baseline_rb_result$Leaf)
    })
}

# Make sure errors are reported when expected
test_that("functions generated by partial_run_biocro produce error messages when expected", {
    expect_error(
        crop_func(list(Catm = new_catm, weather$temp + temp_offset))
    )

    expect_error(
        crop_func(c(Catm = new_catm, temp = weather$temp + temp_offset))
    )

    expect_error(
        crop_func(setNames(
            c(500, soybean_weather$'2002'$temp + 2.0),
            c("Catm", rep("temp", length(soybean_weather$'2002'$temp)))
        ))
    )

    expect_error(
        crop_func(list(weather$temp + temp_offset)),
        "The .* argument .* does not have the correct number of elements"
    )

    expect_error(
        crop_func(c(weather$temp + temp_offset)),
        "The .* argument .* does not have the correct number of elements"
    )
})

test_that("functions generated by partial_run_biocro produce useful error messages", {

    skip(paste("Skipping some tests of partial_run_biocro pending changes",
               "\n\tto the error messaging used by the generated function."))

    expect_error(
        crop_func(list(weather$temp + temp_offset)),
        paste0("The number of values passed to this function is not the number expected\\..*",
               "Try passing the values in a named list to get more information.")

        ## (This is essentially the same test as I added to the
        ## previous (non-skipped) test_that block, but with a slightly
        ## different expected error message.  I prefer that the
        ## message omit any reference to "unlist" or to `x`, which the
        ## user may not and should not have to know about.)
    )

    expect_error(
        crop_func(c(weather$temp + temp_offset)),
        paste0("The number of values passed to this function is not the number expected\\..*",
               "Try passing the values in a named list to get more information.")
    )

    expect_error(
        crop_func(list(Catm = new_catm,
                             weather$temp + temp_offset)),
        "When using named arguments, all argument values must be named"

        ## The current error message is
        ##
        ##   The names of the `x` argument do not match those specified by `arg_names`:
        ##   `arg_names`: Catm, temp
        ##   `names(x)`: Catm,
        ##
        ## The proposed message is more to the point: the user either
        ## forgot to name the second argument or didn't realize all
        ## arguments must be named if any are.  Printing out the
        ## actual names is not that important in this case as it might
        ## be if the user had used a different quantity name than the
        ## one required or simply misspelled a name (see the next
        ## test).
    )

    expect_error(
        crop_func(list(catm = new_catm,
                             temp = weather$temp + temp_offset)),
        "The names used in the list passed to crop_func do not match the list of names the function requires."

        ## The current error message is
        ##
        ##     The names of the `x` argument do not match those specified by `arg_names`:
        ##     `arg_names`: Catm, temp
        ##     `names(x)`: catm, temp
        ##
        ## This is useful and moderately acceptable.  It would be preferable,
        ## however, to eliminate references to "arg_names" and to "x", which
        ## only a user very well versed in the documentation or one who looks
        ## at the implementation of partial_run_biocro will know about.
        ##
        ## I'm not sure how easy it is to get the name of the function
        ## (crop_func here) from within the function.  This pending test
        ## is "aspirational".  A vaguer reference to the function could be
        ## used instead, e.g. "The names used in the list passed to this
        ## function do not match ...".
        ##
        ## Here is one case where it *is* worthwhile printing out the expected
        ## and actual names, though I would label them something like
        ## "supplied list item names" and "required names" in order to avoid
        ## refering to "x" and "arg_names".  Note that this proposed test
        ## doesn't test that part of the error message.
    )

    expect_error(
        crop_func(c(Catm = new_catm, temp = weather$temp + temp_offset)),
        "If named arguments are used and include drivers, use a list rather than a vector"

        ## The current error message is
        ##
        ##   The names of the `x` argument do not match those specified by `arg_names`:
        ##   `arg_names`: Catm, temp
        ##   `names(x)`: Catm, temp1, temp2, temp3, [etc., etc. etc.!!!]
        ##
        ## This message is just plain annoying and not all that helpful.  The
        ## user *thinks* they used the correct names and just gets this
        ## baffling and annoyingly long error.
    )

    expect_error(
        crop_func(setNames(
            c(500, soybean_weather$'2002'$temp + 2.0),
            c("Catm", rep("temp", length(soybean_weather$'2002'$temp)))
        )),
        "If named arguments are used and include drivers, use a list rather than a vector"

        ## The current error message is
        ##
        ##   The names of the `x` argument do not match those specified by `arg_names`:
        ##  `arg_names`: Catm, temp
        ##  `names(x)`: Catm, temp, temp, temp, temp, [etc., etc. etc.!!!]
        ##
        ## Again, this message is annoying and unhelpful.  And it seems
        ## somewhat unlikely that any actual user would call crop_func
        ## in this way.  Perhaps this test was concocted simply to demonstrate
        ## that the problem with the previous test was not simply due to the
        ## way R automatically names vector components when vectors get
        ## flattened.

    )
})

# TESTING PARTIAL_EVALUATE_MODULE
module <- 'BioCro:thermal_time_linear'

# Get the baseline result
tbase = 10
temp = 20
baseline_em_result <- evaluate_module(
    module,
    list(sowing_time = 0, tbase = tbase, temp = temp, time = 1)
)

# Now use partial application
ttc_func <- partial_evaluate_module(
    module,
    list(sowing_time = 0, time = 1),
    c("tbase", "temp")
)

# Specify the values for Catm and temp in several ways, checking to make sure
# the results are the same as the baseline
em_x_vals <- list(
    c(tbase, temp),
    c(tbase = tbase, temp = temp),
    c(temp = temp, tbase = tbase),
    list(tbase = tbase, temp = temp),
    list(temp = temp, tbase = tbase)
)

for (i in seq_along(em_x_vals)) {
    msg <- paste("Testing `partial_evaluate_module` with input case", i)
    test_that(paste("Testing `partial_evaluate_module` with input case", i), {
        expect_equal(ttc_func(em_x_vals[[i]])$outputs, baseline_em_result)
    })
}

# Make sure errors are reported when expected
test_that("partial_evaluate_module produces error messages when expected", {
    expect_error(
        ttc_func(c(tbase = tbase, temp))
    )
})