tests/testthat/test-annealing-ecology.R

In StrathE2E2: End-to-End Marine Food Web Model

test_that("test simulated annealing code (ecology parameters) produces correct output structure", {

skip_on_cran()

#-----------------------------------------------------------------------------------------------------------------
#
# This test runs the 1970-1999 version of the simulated annealing (ecology model parameters) function to determine
# whether the ouputs conform to the expected structure.
#
# The test uses the North Sea model which is provide in the package, with the csv.output argument set to FALSE
#
# The returned object should be a list of 3 element. The 3rd element should have 3 sub-elements
#
# We test various attributes of the list and its contents to check that theyare as expected.
#
#------------------------------------------------------------------------------------------------------------------

# Read the internal 1970-1999 North Sea model
model<-e2e_read(model.name="North_Sea",
                   model.variant="1970-1999",
                   model.ident="TEST")
nyears<-3
n_iter<-10
 test_run <- e2e_optimize_eco(model, nyears=nyears, n_iter=n_iter, start_temperature=0.5,
                                               csv.output=FALSE,runtime.plot=FALSE)

#--------------

#Extract some attributes of the returned list object
n_1stlev <- nrow(summary(test_run))  # Number of 1st level objects in the list - should =3
n_2ndlev <- nrow(summary(test_run$new_parameter_data))  # Number of parameter objects in the parameter data level of the list - should =3

#--------------

#Extract attributes of the first 2 elements of the list
nr_prop<-nrow(test_run$parameter_proposal_history) # number of rows of data in the proposal history - should = n_iter
nr_accp<-nrow(test_run$parameter_accepted_history) # number of rows of data in the proposal history - should = n_iter

proposal_lik <- test_run$parameter_proposal_history$annual_obj  # Likelihoods for proposed parameters on each iteration
accepted_lik <- test_run$parameter_accepted_history$annual_obj  # Likelihoods for accepted parameters on each iteration
dif_lik <- accepted_lik-proposal_lik   # accepted values should never be less than proposed values
nneg<-length(which(dif_lik<0))  # nneg should=0

#--------------

# Find out if the final parameter objects generated by the annealing process match the structure expected for the model inputs
model.path <-   model$setup$model.path
#setupdata  <-	read.model.setup(model.path)			# Models/Model/Variant/MODEL_SETUP.csv

# setupdata[13] = "fitted_microbiology_others_Testbed.csv"
# setupdata[14] = "fitted_preference_matrix_Testbed.csv"
# setupdata[15] = "fitted_uptake_mort_rates_Testbed.csv"

#pf_microbiol<-readcsv(model.path, PARAMETERS_DIR, setupdata[13])
#pf_prefmat  <-readcsv(model.path, PARAMETERS_DIR, setupdata[14],row.names=1)
#pf_uptmort  <-readcsv(model.path, PARAMETERS_DIR, setupdata[15])

pf_microbiol<- get.model.file(model.path, PARAMETERS_DIR, file.pattern=FITTED_PARAMETERS_MICROBIOLOGY)
pf_prefmat  <- get.model.file(model.path, PARAMETERS_DIR, file.pattern=FITTED_PARAMETERS_PREFERENCE, row.names=1)
pf_uptmort  <- get.model.file(model.path, PARAMETERS_DIR, file.pattern=FITTED_PARAMETERS_UPTAKE_MORT)

#--------------

#new and expected row and column numbers for the preference matrix
nc_new_prefmat <- ncol(test_run$new_parameter_data$new_preference_matrix) # Columns in the new preference matrix
nr_new_prefmat <- nrow(test_run$new_parameter_data$new_preference_matrix) # Rows in the new preference matrix
nc_exp_prefmat <- ncol(pf_prefmat)  # Columns in the existing preference matrix
nr_exp_prefmat <- nrow(pf_prefmat)  # Rows in the existing preference matrix

nc_new_prefmat
nc_exp_prefmat
nr_new_prefmat
nr_exp_prefmat


#--------------

#new and expected row and column numbers for the uptake and mortality parameters
nc_new_upmort <- ncol(test_run$new_parameter_data$new_uptake_mort_rate_parameters) # Columns in the new uptake and mortality parameter set
nr_new_upmort <- nrow(test_run$new_parameter_data$new_uptake_mort_rate_parameters) # Rows in the uptake and mortality parameter set
nc_exp_upmort <- ncol(pf_uptmort)  # Columns in the existing uptake and mortality parameter set
nr_exp_upmort <- nrow(pf_uptmort)  # Rows in the existing uptake and mortality parameter set

nc_new_upmort
nc_exp_upmort
nr_new_upmort
nr_exp_upmort


#--------------

#new and expected row and column numbers for the microbiology parameters
nc_new_microbiol <- ncol(test_run$new_parameter_data$new_microbiology_parameters) # Columns in the new microbiology parameter set
nr_new_microbiol <- nrow(test_run$new_parameter_data$new_microbiology_parameters) # Rows in the new microbiology parameter set
nc_exp_microbiol <- ncol(pf_microbiol)  # Columns in the existing microbiology parameter set
nr_exp_microbiol <- nrow(pf_microbiol)  # Rows in the existing microbiology parameter set

nc_new_microbiol
nc_exp_microbiol
nr_new_microbiol
nr_exp_microbiol

#--------------


#Implement the testthat checks

expect_equal(n_1stlev, 3)
expect_equal(n_2ndlev, 3)

expect_equal(nr_prop, n_iter)
expect_equal(nr_accp, n_iter)
expect_equal(nneg,0)

expect_equal(nc_new_prefmat,nc_exp_prefmat)
expect_equal(nr_new_prefmat,nr_exp_prefmat)

expect_equal(nc_new_upmort,nc_exp_upmort)
expect_equal(nr_new_upmort,nr_exp_upmort)

expect_equal(nc_new_microbiol,nc_exp_microbiol)
expect_equal(nr_new_microbiol,nr_exp_microbiol)

})