Nothing
tests/testthat/test-top-predator-fluxes.R
In StrathE2E2: End-to-End Marine Food Web Model
test_that("check top predator feeding flux calculations", {
#-----------------------------------------------------------------------------------------------------------------
#
# This test uses a 'Testbed' version of the model in which all of the external drivers are set to constant values.
# We expect the model outputs to converge to a steady state under these conditions. Then we take the masses of the
# food web variables from the steady state model output, and manually derive the uptake fluxes between them.
# These manually derived fluxes are then compared with the fluxes generated in the 'flux_matrix' outputs from the model.
# So the test is checking that the flux calculations in the C-code of the package are correctly evaluated.
#
# The Testbed model is stored in /StrathE2E2/tests/testdata/models/
#
# The model has been run for >1000 years to ensure a steady state, and the end-state saved as initial conditions.
# So the model should be at steady state from time 0. In fact, the input csv file containing the initial conditions
# does not hold sufficient precision (number of decimal places) to ensure perfect steady state from the onset of a run.
# This is manifest as some tiny oscillations in the first year or so of a run before everything settles to its steady state.
# Hence we run the Testbed model for 10 years and then base the test on the final year of the run.
#
# For convenience, the Testbed model uses the fitted parameters from the North Sea implementation of StrathE2E2.
#
# Two important points to note:
# 1) The temperature driving data for all three spatial compartmets of the Testbed
# model are set to 10C, wich matches the Q10 reference temperature in the fixed parameter inputs. This means that when manually
# calculating the uptake fluxes there is no need to compute any temperature corrections for the maximum uptake rate
# parameters. However, the C-code in the model IS doing the Q10 calculation, so this is an important aspect of the testing.
# As a consequence, it is very important not to change the temperature driving values in the Testbed model - they must be
# equal to the Q10 reference temperature value.
# 2) The sediment habitats are all set to the same area (0.125). This affects the calculation of uptake of corpses by scavengers.
# By setting the habitats to equal area, we can simply sum the mass of corpses across each zone and use that as input to the
# manual calculation of uptake . The C code performs this calculation separately for each habitat and then adds the
# results. So this is an additional test of the model code. But it means that the habitat areas should not be edited in the
# input csv files.
#
# This test applies the above approach to uptake by bird, pinniped and cetacean classes.
#
#-----------------------------------------------------------------------------------------------------------------
#
# The following non-exported functions in the package are needed for the test:
# source("internal.R")
# source("read_fitted_parameters.R")
# source("read_fixed_parameters.R")
# source("read_physics_drivers.R")
# source("read_physical_parameters.R")
#
#-----------------------------------------------------------------------------------------------------------------
#Some additional functions required for assembling the tests
#######################
#Function to pull the final year annual average mass of a variable out of the results
pull_final_year_mean<-function(results,vtoget){
vgot<-(elt(results$output, vtoget))
vmean<-mean(vgot[(length(vgot)-360):(length(vgot))])
vmean
}
######################
#Function to pull flux data out of the flow matrix generated by the model
extract_model_flux<-function(matrixname,preyname,predname){
predi<-which(colnames(matrixname)==predname)
preyi<-which(colnames(matrixname)==preyname)
model_flux<-(matrixname[preyi,predi]/360)
model_flux
}
#######################
#Top predator (Beddington deAngelis uptake function
f3<-function(a,b,k1,k2,k3)
# prey,pred,umax,hs,bdap
{
return ((b*k1*a)/(a+k2+(k3*b)))
}
#######################
#-----------------------------------------------------------------------------------------------------------------
#Run the Testbed model and pull out data from the results object
#Run the testbed model - assuming R home dir is "/GitLab/StrathE2E2/tests"
model<-e2e_read(model.name="Testbed",
model.variant="Const",
model.ident="base",
models.path="../testdata/models")
results <- e2e_run(model,nyears=10,csv.output=FALSE)
#plot_full_length_timeseries(model,results)
#extract_new_initial_cond_from_end_of_run(model, results)
#Pull out the inshore and offshore final year data for phytoplankton and zoopkankton groups
#names(results$output[1:78]) # Lists the names of state varibales in the header
corpse_s0<-pull_final_year_mean(results,"corpse_s0")
corpse_s1<-pull_final_year_mean(results,"corpse_s1")
corpse_s2<-pull_final_year_mean(results,"corpse_s2")
corpse_s3<-pull_final_year_mean(results,"corpse_s3")
discard_i<-pull_final_year_mean(results,"discard_i")
omni_i<-pull_final_year_mean(results,"omni_i")
carn_i<-pull_final_year_mean(results,"carn_i")
benths_i<-pull_final_year_mean(results,"benths_i")
benthc_i<-pull_final_year_mean(results,"benthc_i")
fishp_i<-pull_final_year_mean(results,"fishp_i")
fishd_i<-pull_final_year_mean(results,"fishd_i")
fishm_i<-pull_final_year_mean(results,"fishm_i")
bird_i <-pull_final_year_mean(results,"bird_i")
seal_i <-pull_final_year_mean(results,"seal_i")
ceta_i <-pull_final_year_mean(results,"ceta_i")
corpse_i <- corpse_s0 + corpse_s1 + corpse_s2 + corpse_s3
corpse_d0<-pull_final_year_mean(results,"corpse_d0")
corpse_d1<-pull_final_year_mean(results,"corpse_d1")
corpse_d2<-pull_final_year_mean(results,"corpse_d2")
corpse_d3<-pull_final_year_mean(results,"corpse_d3")
discard_o<-pull_final_year_mean(results,"discard_o")
omni_o<- pull_final_year_mean(results,"omni_o")
carn_o<- pull_final_year_mean(results,"carn_o")
benths_o<-pull_final_year_mean(results,"benths_o")
benthc_o<-pull_final_year_mean(results,"benthc_o")
fishp_o<-pull_final_year_mean(results,"fishp_o")
fishd_o<-pull_final_year_mean(results,"fishd_o")
fishm_o<-pull_final_year_mean(results,"fishm_o")
bird_o <-pull_final_year_mean(results,"bird_o")
seal_o <-pull_final_year_mean(results,"seal_o")
ceta_o <-pull_final_year_mean(results,"ceta_o")
corpse_o <- corpse_d0 + corpse_d1 + corpse_d2 + corpse_d3
#Pull out the flow matrix from the results
flow_matrix<-elt(results$final.year.outputs,"flow_matrix_all_fluxes")
flow_matrix_ns<-elt(results$final.year.outputs,"flow_matrix_excl_spawn_recruit")
#colnames(flow_matrix) #Lists the column names in the flow matrix
#rownames(flow_matrix) #Lists the row names in the flow matrix
#-----------------------------------------------------------------------------------------------------------------
#Pull data out of the model object, ie data that have been assembled from the input csv files
#Pull out the model configuration to get areas and volumes
model.path<-model$setup$model.path
read.model.setup(model.path) # Models/Model/Variant/MODEL_SETUP.csv
physical.parameters <- read_physical_parameters(model.path)
so_depth<-elt(physical.parameters,"so_depth")
si_depth<-elt(physical.parameters,"si_depth")
d_depth<-elt(physical.parameters,"d_depth")
area_s0<-elt(physical.parameters,"x_area_s0")
area_s1<-elt(physical.parameters,"x_area_s1")
area_s2<-elt(physical.parameters,"x_area_s2")
area_s3<-elt(physical.parameters,"x_area_s3")
area_d0<-elt(physical.parameters,"x_area_d0")
area_d1<-elt(physical.parameters,"x_area_d1")
area_d2<-elt(physical.parameters,"x_area_d2")
area_d3<-elt(physical.parameters,"x_area_d3")
shallowprop<-(area_s0+area_s1+area_s2+area_s3)
volume_so<-so_depth*(1-shallowprop)
volume_d<-d_depth*(1-shallowprop)
volume_si<-si_depth*(shallowprop)
# Pull out the uptake function parameters needed to manually calculate the fluxes
model.path<-model$setup$model.path
read.model.setup(model.path) # Models/Model/Variant/MODEL_SETUP.csv
fitted.parameters <- read_fitted_parameters(model.path)
fixed.parameters <- read_fixed_parameters(model.path)
CZ_inedible <- elt(fixed.parameters,"CZ_inedible")
#Calculate edible component of carn zoo
CZ_inedible_i <- CZ_inedible * shallowprop
CZ_inedible_o <- CZ_inedible * (1-shallowprop)
if(carn_o>0) CZ_edible_o <- max(0,carn_o-(CZ_inedible_o/carn_o)) else CZ_edible_o <- 0
if(carn_i>0) CZ_edible_i <- max(0,carn_i-(CZ_inedible_i/carn_i)) else CZ_edible_i <- 0
u_bird<-elt(fitted.parameters,"u_bird")
h_bird<-elt(fitted.parameters,"h_bird")
bda_par_bird<-elt(fitted.parameters,"bda_par_bird")
PREF_corpse_bird<-elt(fitted.parameters,"PREF_corp_bird")
PREF_discard_bird<-elt(fitted.parameters,"PREF_disc_bird")
PREF_carn_bird<-elt(fitted.parameters,"PREF_carn_bird")
PREF_benths_bird<-elt(fitted.parameters,"PREF_benths_bird")
PREF_benthc_bird<-elt(fitted.parameters,"PREF_benthc_bird")
PREF_fishp_bird<-elt(fitted.parameters,"PREF_fishp_bird")
PREF_fishd_bird<-elt(fitted.parameters,"PREF_fishd_bird")
PREF_fishm_bird<-elt(fitted.parameters,"PREF_fishm_bird")
#....
u_seal<-elt(fitted.parameters,"u_seal")
h_seal<-elt(fitted.parameters,"h_seal")
bda_par_seal<-elt(fitted.parameters,"bda_par_seal")
PREF_corpse_seal<-elt(fitted.parameters,"PREF_corp_seal")
PREF_discard_seal<-elt(fitted.parameters,"PREF_disc_seal")
PREF_carn_seal<-elt(fitted.parameters,"PREF_carn_seal")
PREF_benths_seal<-elt(fitted.parameters,"PREF_benths_seal")
PREF_benthc_seal<-elt(fitted.parameters,"PREF_benthc_seal")
PREF_fishp_seal<-elt(fitted.parameters,"PREF_fishp_seal")
PREF_fishd_seal<-elt(fitted.parameters,"PREF_fishd_seal")
PREF_fishm_seal<-elt(fitted.parameters,"PREF_fishm_seal")
PREF_bird_seal<-elt(fitted.parameters,"PREF_bird_seal")
#....
u_ceta<-elt(fitted.parameters,"u_ceta")
h_ceta<-elt(fitted.parameters,"h_ceta")
bda_par_ceta<-elt(fitted.parameters,"bda_par_ceta")
PREF_discard_ceta<-elt(fitted.parameters,"PREF_disc_ceta")
PREF_omni_ceta<-elt(fitted.parameters,"PREF_omni_ceta")
PREF_carn_ceta<-elt(fitted.parameters,"PREF_carn_ceta")
PREF_benths_ceta<-elt(fitted.parameters,"PREF_benths_ceta")
PREF_benthc_ceta<-elt(fitted.parameters,"PREF_benthc_ceta")
PREF_fishp_ceta<-elt(fitted.parameters,"PREF_fishp_ceta")
PREF_fishd_ceta<-elt(fitted.parameters,"PREF_fishd_ceta")
PREF_fishm_ceta<-elt(fitted.parameters,"PREF_fishm_ceta")
PREF_bird_ceta<-elt(fitted.parameters,"PREF_bird_ceta")
PREF_seal_ceta<-elt(fitted.parameters,"PREF_seal_ceta")
bda_par_bird_o <- bda_par_bird * 1/(1-shallowprop)
bda_par_seal_o <- bda_par_seal * 1/(1-shallowprop)
bda_par_ceta_o <- bda_par_ceta * 1/(1-shallowprop)
bda_par_bird_i <- bda_par_bird * 1/(shallowprop)
bda_par_seal_i <- bda_par_seal * 1/(shallowprop)
bda_par_ceta_i <- bda_par_ceta * 1/(shallowprop)
#-----------------------------------------------------------------------------------------------------------------
#Now calculate the fluxes
calc_flux_corpse_bird_o<- f3(corpse_o,(bird_o),u_bird*PREF_corpse_bird,h_bird*(volume_so+volume_d),bda_par_bird_o)
calc_flux_corpse_bird_i<- f3(corpse_i,(bird_i),u_bird*PREF_corpse_bird,h_bird*(volume_si),bda_par_bird_i)
calc_flux_corpse_bird_w <- calc_flux_corpse_bird_o + calc_flux_corpse_bird_i
model_flux_corpse_bird<-extract_model_flux(flow_matrix,"corpses","bird")
#calc_flux_corpse_bird_w
#model_flux_corpse_bird
#............................
calc_flux_discard_bird_o<- f3(discard_o,(bird_o),u_bird*PREF_discard_bird,h_bird*(volume_so+volume_d),bda_par_bird_o)
calc_flux_discard_bird_i<- f3(discard_i,(bird_i),u_bird*PREF_discard_bird,h_bird*(volume_si),bda_par_bird_i)
calc_flux_discard_bird_w <- calc_flux_discard_bird_o + calc_flux_discard_bird_i
model_flux_discard_bird<-extract_model_flux(flow_matrix,"discards","bird")
#calc_flux_discard_bird_w
#model_flux_discard_bird
#............................
calc_flux_carn_bird_o<- f3(CZ_edible_o,(bird_o),u_bird*PREF_carn_bird,h_bird*(volume_so+volume_d),bda_par_bird_o)
calc_flux_carn_bird_i<- f3(CZ_edible_i,(bird_i),u_bird*PREF_carn_bird,h_bird*(volume_si),bda_par_bird_i)
calc_flux_carn_bird_w <- calc_flux_carn_bird_o + calc_flux_carn_bird_i
model_flux_carn_bird<-extract_model_flux(flow_matrix,"carnzoo","bird")
#calc_flux_carn_bird_w
#model_flux_carn_bird
#............................
calc_flux_benths_bird_o<- f3(benths_o,(bird_o),u_bird*PREF_benths_bird,h_bird*(volume_so+volume_d),bda_par_bird_o)
calc_flux_benths_bird_i<- f3(benths_i,(bird_i),u_bird*PREF_benths_bird,h_bird*(volume_si),bda_par_bird_i)
calc_flux_benths_bird_w <- calc_flux_benths_bird_o + calc_flux_benths_bird_i
model_flux_benths_bird<-extract_model_flux(flow_matrix,"benths","bird")
#calc_flux_benths_bird_w
#model_flux_benths_bird
#............................
calc_flux_benthc_bird_o<- f3(benthc_o,(bird_o),u_bird*PREF_benthc_bird,h_bird*(volume_so+volume_d),bda_par_bird_o)
calc_flux_benthc_bird_i<- f3(benthc_i,(bird_i),u_bird*PREF_benthc_bird,h_bird*(volume_si),bda_par_bird_i)
calc_flux_benthc_bird_w <- calc_flux_benthc_bird_o + calc_flux_benthc_bird_i
model_flux_benthc_bird<-extract_model_flux(flow_matrix,"benthc","bird")
#calc_flux_benthc_bird_w
#model_flux_benthc_bird
#............................
calc_flux_fishp_bird_o<- f3(fishp_o,(bird_o),u_bird*PREF_fishp_bird,h_bird*(volume_so+volume_d),bda_par_bird_o)
calc_flux_fishp_bird_i<- f3(fishp_i,(bird_i),u_bird*PREF_fishp_bird,h_bird*(volume_si),bda_par_bird_i)
calc_flux_fishp_bird_w <- calc_flux_fishp_bird_o + calc_flux_fishp_bird_i
model_flux_fishp_bird<-extract_model_flux(flow_matrix,"pfish","bird")
#calc_flux_fishp_bird_w
#model_flux_fishp_bird
#............................
calc_flux_fishd_bird_o<- f3(fishd_o,(bird_o),u_bird*PREF_fishd_bird,h_bird*(volume_so+volume_d),bda_par_bird_o)
calc_flux_fishd_bird_i<- f3(fishd_i,(bird_i),u_bird*PREF_fishd_bird,h_bird*(volume_si),bda_par_bird_i)
calc_flux_fishd_bird_w <- calc_flux_fishd_bird_o + calc_flux_fishd_bird_i
model_flux_fishd_bird<-extract_model_flux(flow_matrix,"dfish","bird")
#calc_flux_fishd_bird_w
#model_flux_fishd_bird
#............................
calc_flux_fishm_bird_o<- f3(fishm_o,(bird_o),u_bird*PREF_fishm_bird,h_bird*(volume_so+volume_d),bda_par_bird_o)
calc_flux_fishm_bird_i<- f3(fishm_i,(bird_i),u_bird*PREF_fishm_bird,h_bird*(volume_si),bda_par_bird_i)
calc_flux_fishm_bird_w <- calc_flux_fishm_bird_o + calc_flux_fishm_bird_i
model_flux_fishm_bird<-extract_model_flux(flow_matrix,"mfish","bird")
#calc_flux_fishm_bird_w
#model_flux_fishm_bird
#............................
#............................
calc_flux_corpse_seal_o<- f3(corpse_o,(seal_o),u_seal*PREF_corpse_seal,h_seal*(volume_so+volume_d),bda_par_seal_o)
calc_flux_corpse_seal_i<- f3(corpse_i,(seal_i),u_seal*PREF_corpse_seal,h_seal*(volume_si),bda_par_seal_i)
calc_flux_corpse_seal_w <- calc_flux_corpse_seal_o + calc_flux_corpse_seal_i
model_flux_corpse_seal<-extract_model_flux(flow_matrix,"corpses","seal")
#calc_flux_corpse_seal_w
#model_flux_corpse_seal
#............................
calc_flux_discard_seal_o<- f3(discard_o,(seal_o),u_seal*PREF_discard_seal,h_seal*(volume_so+volume_d),bda_par_seal_o)
calc_flux_discard_seal_i<- f3(discard_i,(seal_i),u_seal*PREF_discard_seal,h_seal*(volume_si),bda_par_seal_i)
calc_flux_discard_seal_w <- calc_flux_discard_seal_o + calc_flux_discard_seal_i
model_flux_discard_seal<-extract_model_flux(flow_matrix,"discards","seal")
#calc_flux_discard_seal_w
#model_flux_discard_seal
#............................
calc_flux_carn_seal_o<- f3(CZ_edible_o,(seal_o),u_seal*PREF_carn_seal,h_seal*(volume_so+volume_d),bda_par_seal_o)
calc_flux_carn_seal_i<- f3(CZ_edible_i,(seal_i),u_seal*PREF_carn_seal,h_seal*(volume_si),bda_par_seal_i)
calc_flux_carn_seal_w <- calc_flux_carn_seal_o + calc_flux_carn_seal_i
model_flux_carn_seal<-extract_model_flux(flow_matrix,"carnzoo","seal")
#calc_flux_carn_seal_w
#model_flux_carn_seal
#............................
calc_flux_benths_seal_o<- f3(benths_o,(seal_o),u_seal*PREF_benths_seal,h_seal*(volume_so+volume_d),bda_par_seal_o)
calc_flux_benths_seal_i<- f3(benths_i,(seal_i),u_seal*PREF_benths_seal,h_seal*(volume_si),bda_par_seal_i)
calc_flux_benths_seal_w <- calc_flux_benths_seal_o + calc_flux_benths_seal_i
model_flux_benths_seal<-extract_model_flux(flow_matrix,"benths","seal")
#calc_flux_benths_seal_w
#model_flux_benths_seal
#............................
calc_flux_benthc_seal_o<- f3(benthc_o,(seal_o),u_seal*PREF_benthc_seal,h_seal*(volume_so+volume_d),bda_par_seal_o)
calc_flux_benthc_seal_i<- f3(benthc_i,(seal_i),u_seal*PREF_benthc_seal,h_seal*(volume_si),bda_par_seal_i)
calc_flux_benthc_seal_w <- calc_flux_benthc_seal_o + calc_flux_benthc_seal_i
model_flux_benthc_seal<-extract_model_flux(flow_matrix,"benthc","seal")
#calc_flux_benthc_seal_w
#model_flux_benthc_seal
#............................
calc_flux_fishp_seal_o<- f3(fishp_o,(seal_o),u_seal*PREF_fishp_seal,h_seal*(volume_so+volume_d),bda_par_seal_o)
calc_flux_fishp_seal_i<- f3(fishp_i,(seal_i),u_seal*PREF_fishp_seal,h_seal*(volume_si),bda_par_seal_i)
calc_flux_fishp_seal_w <- calc_flux_fishp_seal_o + calc_flux_fishp_seal_i
model_flux_fishp_seal<-extract_model_flux(flow_matrix,"pfish","seal")
#calc_flux_fishp_seal_w
#model_flux_fishp_seal
#............................
calc_flux_fishd_seal_o<- f3(fishd_o,(seal_o),u_seal*PREF_fishd_seal,h_seal*(volume_so+volume_d),bda_par_seal_o)
calc_flux_fishd_seal_i<- f3(fishd_i,(seal_i),u_seal*PREF_fishd_seal,h_seal*(volume_si),bda_par_seal_i)
calc_flux_fishd_seal_w <- calc_flux_fishd_seal_o + calc_flux_fishd_seal_i
model_flux_fishd_seal<-extract_model_flux(flow_matrix,"dfish","seal")
#calc_flux_fishd_seal_w
#model_flux_fishd_seal
#............................
calc_flux_fishm_seal_o<- f3(fishm_o,(seal_o),u_seal*PREF_fishm_seal,h_seal*(volume_so+volume_d),bda_par_seal_o)
calc_flux_fishm_seal_i<- f3(fishm_i,(seal_i),u_seal*PREF_fishm_seal,h_seal*(volume_si),bda_par_seal_i)
calc_flux_fishm_seal_w <- calc_flux_fishm_seal_o + calc_flux_fishm_seal_i
model_flux_fishm_seal<-extract_model_flux(flow_matrix,"mfish","seal")
#calc_flux_fishm_seal_w
#model_flux_fishm_seal
#............................
calc_flux_bird_seal_o<- f3(bird_o,(seal_o),u_seal*PREF_bird_seal,h_seal*(volume_so+volume_d),bda_par_seal_o)
calc_flux_bird_seal_i<- f3(bird_i,(seal_i),u_seal*PREF_bird_seal,h_seal*(volume_si),bda_par_seal_i)
calc_flux_bird_seal_w <- calc_flux_bird_seal_o + calc_flux_bird_seal_i
model_flux_bird_seal<-extract_model_flux(flow_matrix,"bird","seal")
#calc_flux_bird_seal_w
#model_flux_bird_seal
#............................
#............................
calc_flux_discard_ceta_o<- f3(discard_o,(ceta_o),u_ceta*PREF_discard_ceta,h_ceta*(volume_so+volume_d),bda_par_ceta_o)
calc_flux_discard_ceta_i<- f3(discard_i,(ceta_i),u_ceta*PREF_discard_ceta,h_ceta*(volume_si),bda_par_ceta_i)
calc_flux_discard_ceta_w <- calc_flux_discard_ceta_o + calc_flux_discard_ceta_i
model_flux_discard_ceta<-extract_model_flux(flow_matrix,"discards","ceta")
#calc_flux_discard_ceta_w
#model_flux_discard_ceta
#............................
calc_flux_omni_ceta_o<- f3(omni_o,(ceta_o),u_ceta*PREF_omni_ceta,h_ceta*(volume_so+volume_d),bda_par_ceta_o)
calc_flux_omni_ceta_i<- f3(omni_i,(ceta_i),u_ceta*PREF_omni_ceta,h_ceta*(volume_si),bda_par_ceta_i)
calc_flux_omni_ceta_w <- calc_flux_omni_ceta_o + calc_flux_omni_ceta_i
model_flux_omni_ceta<-extract_model_flux(flow_matrix,"omnivzoo","ceta")
#calc_flux_omni_ceta_w
#model_flux_omni_ceta
#............................
calc_flux_carn_ceta_o<- f3(CZ_edible_o,(ceta_o),u_ceta*PREF_carn_ceta,h_ceta*(volume_so+volume_d),bda_par_ceta_o)
calc_flux_carn_ceta_i<- f3(CZ_edible_i,(ceta_i),u_ceta*PREF_carn_ceta,h_ceta*(volume_si),bda_par_ceta_i)
calc_flux_carn_ceta_w <- calc_flux_carn_ceta_o + calc_flux_carn_ceta_i
model_flux_carn_ceta<-extract_model_flux(flow_matrix,"carnzoo","ceta")
#calc_flux_carn_ceta_w
#model_flux_carn_ceta
#............................
calc_flux_benths_ceta_o<- f3(benths_o,(ceta_o),u_ceta*PREF_benths_ceta,h_ceta*(volume_so+volume_d),bda_par_ceta_o)
calc_flux_benths_ceta_i<- f3(benths_i,(ceta_i),u_ceta*PREF_benths_ceta,h_ceta*(volume_si),bda_par_ceta_i)
calc_flux_benths_ceta_w <- calc_flux_benths_ceta_o + calc_flux_benths_ceta_i
model_flux_benths_ceta<-extract_model_flux(flow_matrix,"benths","ceta")
#calc_flux_benths_ceta_w
#model_flux_benths_ceta
#............................
calc_flux_benthc_ceta_o<- f3(benthc_o,(ceta_o),u_ceta*PREF_benthc_ceta,h_ceta*(volume_so+volume_d),bda_par_ceta_o)
calc_flux_benthc_ceta_i<- f3(benthc_i,(ceta_i),u_ceta*PREF_benthc_ceta,h_ceta*(volume_si),bda_par_ceta_i)
calc_flux_benthc_ceta_w <- calc_flux_benthc_ceta_o + calc_flux_benthc_ceta_i
model_flux_benthc_ceta<-extract_model_flux(flow_matrix,"benthc","ceta")
#calc_flux_benthc_ceta_w
#model_flux_benthc_ceta
#............................
calc_flux_fishp_ceta_o<- f3(fishp_o,(ceta_o),u_ceta*PREF_fishp_ceta,h_ceta*(volume_so+volume_d),bda_par_ceta_o)
calc_flux_fishp_ceta_i<- f3(fishp_i,(ceta_i),u_ceta*PREF_fishp_ceta,h_ceta*(volume_si),bda_par_ceta_i)
calc_flux_fishp_ceta_w <- calc_flux_fishp_ceta_o + calc_flux_fishp_ceta_i
model_flux_fishp_ceta<-extract_model_flux(flow_matrix,"pfish","ceta")
#calc_flux_fishp_ceta_w
#model_flux_fishp_ceta
#............................
calc_flux_fishd_ceta_o<- f3(fishd_o,(ceta_o),u_ceta*PREF_fishd_ceta,h_ceta*(volume_so+volume_d),bda_par_ceta_o)
calc_flux_fishd_ceta_i<- f3(fishd_i,(ceta_i),u_ceta*PREF_fishd_ceta,h_ceta*(volume_si),bda_par_ceta_i)
calc_flux_fishd_ceta_w <- calc_flux_fishd_ceta_o + calc_flux_fishd_ceta_i
model_flux_fishd_ceta<-extract_model_flux(flow_matrix,"dfish","ceta")
#calc_flux_fishd_ceta_w
#model_flux_fishd_ceta
#............................
calc_flux_fishm_ceta_o<- f3(fishm_o,(ceta_o),u_ceta*PREF_fishm_ceta,h_ceta*(volume_so+volume_d),bda_par_ceta_o)
calc_flux_fishm_ceta_i<- f3(fishm_i,(ceta_i),u_ceta*PREF_fishm_ceta,h_ceta*(volume_si),bda_par_ceta_i)
calc_flux_fishm_ceta_w <- calc_flux_fishm_ceta_o + calc_flux_fishm_ceta_i
model_flux_fishm_ceta<-extract_model_flux(flow_matrix,"mfish","ceta")
#calc_flux_fishm_ceta_w
#model_flux_fishm_ceta
#............................
calc_flux_bird_ceta_o<- f3(bird_o,(ceta_o),u_ceta*PREF_bird_ceta,h_ceta*(volume_so+volume_d),bda_par_ceta_o)
calc_flux_bird_ceta_i<- f3(bird_i,(ceta_i),u_ceta*PREF_bird_ceta,h_ceta*(volume_si),bda_par_ceta_i)
calc_flux_bird_ceta_w <- calc_flux_bird_ceta_o + calc_flux_bird_ceta_i
model_flux_bird_ceta<-extract_model_flux(flow_matrix,"bird","ceta")
#calc_flux_bird_ceta_w
#model_flux_bird_ceta
#............................
calc_flux_seal_ceta_o<- f3(seal_o,(ceta_o),u_ceta*PREF_seal_ceta,h_ceta*(volume_so+volume_d),bda_par_ceta_o)
calc_flux_seal_ceta_i<- f3(seal_i,(ceta_i),u_ceta*PREF_seal_ceta,h_ceta*(volume_si),bda_par_ceta_i)
calc_flux_seal_ceta_w <- calc_flux_seal_ceta_o + calc_flux_seal_ceta_i
model_flux_seal_ceta<-extract_model_flux(flow_matrix,"seal","ceta")
#calc_flux_seal_ceta_w
#model_flux_seal_ceta
#............................
#............................
#Implement testthat checks...
expect_equal(model_flux_corpse_bird,calc_flux_corpse_bird_w , 1e-7)
expect_equal(model_flux_discard_bird,calc_flux_discard_bird_w , 1e-7)
expect_equal(model_flux_carn_bird,calc_flux_carn_bird_w , 1e-7)
expect_equal(model_flux_benths_bird,calc_flux_benths_bird_w , 1e-7)
expect_equal(model_flux_benthc_bird,calc_flux_benthc_bird_w , 1e-7)
expect_equal(model_flux_fishp_bird,calc_flux_fishp_bird_w , 1e-7)
expect_equal(model_flux_fishm_bird,calc_flux_fishm_bird_w , 1e-7)
expect_equal(model_flux_fishd_bird,calc_flux_fishd_bird_w , 1e-7)
expect_equal(model_flux_corpse_seal,calc_flux_corpse_seal_w , 1e-7)
expect_equal(model_flux_discard_seal,calc_flux_discard_seal_w , 1e-7)
expect_equal(model_flux_carn_seal,calc_flux_carn_seal_w , 1e-7)
expect_equal(model_flux_benths_seal,calc_flux_benths_seal_w , 1e-7)
expect_equal(model_flux_benthc_seal,calc_flux_benthc_seal_w , 1e-7)
expect_equal(model_flux_fishp_seal,calc_flux_fishp_seal_w , 1e-7)
expect_equal(model_flux_fishm_seal,calc_flux_fishm_seal_w , 1e-7)
expect_equal(model_flux_fishd_seal,calc_flux_fishd_seal_w , 1e-7)
expect_equal(model_flux_bird_seal,calc_flux_bird_seal_w , 1e-7)
expect_equal(model_flux_discard_ceta,calc_flux_discard_ceta_w , 1e-7)
expect_equal(model_flux_omni_ceta,calc_flux_omni_ceta_w , 1e-7)
expect_equal(model_flux_carn_ceta,calc_flux_carn_ceta_w , 1e-7)
expect_equal(model_flux_benths_ceta,calc_flux_benths_ceta_w , 1e-7)
expect_equal(model_flux_benthc_ceta,calc_flux_benthc_ceta_w , 1e-7)
expect_equal(model_flux_fishp_ceta,calc_flux_fishp_ceta_w , 1e-7)
expect_equal(model_flux_fishm_ceta,calc_flux_fishm_ceta_w , 1e-7)
expect_equal(model_flux_fishd_ceta,calc_flux_fishd_ceta_w , 1e-7)
expect_equal(model_flux_bird_ceta,calc_flux_bird_ceta_w , 1e-7)
expect_equal(model_flux_seal_ceta,calc_flux_seal_ceta_w , 1e-7)
})
Try the StrathE2E2 package in your browser
Any scripts or data that you put into this service are public.
StrathE2E2 documentation built on Jan. 23, 2021, 1:07 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
test_that("check top predator feeding flux calculations", {
#-----------------------------------------------------------------------------------------------------------------
#
# This test uses a 'Testbed' version of the model in which all of the external drivers are set to constant values.
# We expect the model outputs to converge to a steady state under these conditions. Then we take the masses of the
# food web variables from the steady state model output, and manually derive the uptake fluxes between them.
# These manually derived fluxes are then compared with the fluxes generated in the 'flux_matrix' outputs from the model.
# So the test is checking that the flux calculations in the C-code of the package are correctly evaluated.
#
# The Testbed model is stored in /StrathE2E2/tests/testdata/models/
#
# The model has been run for >1000 years to ensure a steady state, and the end-state saved as initial conditions.
# So the model should be at steady state from time 0. In fact, the input csv file containing the initial conditions
# does not hold sufficient precision (number of decimal places) to ensure perfect steady state from the onset of a run.
# This is manifest as some tiny oscillations in the first year or so of a run before everything settles to its steady state.
# Hence we run the Testbed model for 10 years and then base the test on the final year of the run.
#
# For convenience, the Testbed model uses the fitted parameters from the North Sea implementation of StrathE2E2.
#
# Two important points to note:
# 1) The temperature driving data for all three spatial compartmets of the Testbed
# model are set to 10C, wich matches the Q10 reference temperature in the fixed parameter inputs. This means that when manually
# calculating the uptake fluxes there is no need to compute any temperature corrections for the maximum uptake rate
# parameters. However, the C-code in the model IS doing the Q10 calculation, so this is an important aspect of the testing.
# As a consequence, it is very important not to change the temperature driving values in the Testbed model - they must be
# equal to the Q10 reference temperature value.
# 2) The sediment habitats are all set to the same area (0.125). This affects the calculation of uptake of corpses by scavengers.
# By setting the habitats to equal area, we can simply sum the mass of corpses across each zone and use that as input to the
# manual calculation of uptake . The C code performs this calculation separately for each habitat and then adds the
# results. So this is an additional test of the model code. But it means that the habitat areas should not be edited in the
# input csv files.
#
# This test applies the above approach to uptake by bird, pinniped and cetacean classes.
#
#-----------------------------------------------------------------------------------------------------------------
#
# The following non-exported functions in the package are needed for the test:
# source("internal.R")
# source("read_fitted_parameters.R")
# source("read_fixed_parameters.R")
# source("read_physics_drivers.R")
# source("read_physical_parameters.R")
#
#-----------------------------------------------------------------------------------------------------------------
#Some additional functions required for assembling the tests
#######################
#Function to pull the final year annual average mass of a variable out of the results
pull_final_year_mean<-function(results,vtoget){
vgot<-(elt(results$output, vtoget))
vmean<-mean(vgot[(length(vgot)-360):(length(vgot))])
vmean
}
######################
#Function to pull flux data out of the flow matrix generated by the model
extract_model_flux<-function(matrixname,preyname,predname){
predi<-which(colnames(matrixname)==predname)
preyi<-which(colnames(matrixname)==preyname)
model_flux<-(matrixname[preyi,predi]/360)
model_flux
}
#######################
#Top predator (Beddington deAngelis uptake function
f3<-function(a,b,k1,k2,k3)
# prey,pred,umax,hs,bdap
{
return ((b*k1*a)/(a+k2+(k3*b)))
}
#######################
#-----------------------------------------------------------------------------------------------------------------
#Run the Testbed model and pull out data from the results object
#Run the testbed model - assuming R home dir is "/GitLab/StrathE2E2/tests"
model<-e2e_read(model.name="Testbed",
model.variant="Const",
model.ident="base",
models.path="../testdata/models")
results <- e2e_run(model,nyears=10,csv.output=FALSE)
#plot_full_length_timeseries(model,results)
#extract_new_initial_cond_from_end_of_run(model, results)
#Pull out the inshore and offshore final year data for phytoplankton and zoopkankton groups
#names(results$output[1:78]) # Lists the names of state varibales in the header
corpse_s0<-pull_final_year_mean(results,"corpse_s0")
corpse_s1<-pull_final_year_mean(results,"corpse_s1")
corpse_s2<-pull_final_year_mean(results,"corpse_s2")
corpse_s3<-pull_final_year_mean(results,"corpse_s3")
discard_i<-pull_final_year_mean(results,"discard_i")
omni_i<-pull_final_year_mean(results,"omni_i")
carn_i<-pull_final_year_mean(results,"carn_i")
benths_i<-pull_final_year_mean(results,"benths_i")
benthc_i<-pull_final_year_mean(results,"benthc_i")
fishp_i<-pull_final_year_mean(results,"fishp_i")
fishd_i<-pull_final_year_mean(results,"fishd_i")
fishm_i<-pull_final_year_mean(results,"fishm_i")
bird_i <-pull_final_year_mean(results,"bird_i")
seal_i <-pull_final_year_mean(results,"seal_i")
ceta_i <-pull_final_year_mean(results,"ceta_i")
corpse_i <- corpse_s0 + corpse_s1 + corpse_s2 + corpse_s3
corpse_d0<-pull_final_year_mean(results,"corpse_d0")
corpse_d1<-pull_final_year_mean(results,"corpse_d1")
corpse_d2<-pull_final_year_mean(results,"corpse_d2")
corpse_d3<-pull_final_year_mean(results,"corpse_d3")
discard_o<-pull_final_year_mean(results,"discard_o")
omni_o<- pull_final_year_mean(results,"omni_o")
carn_o<- pull_final_year_mean(results,"carn_o")
benths_o<-pull_final_year_mean(results,"benths_o")
benthc_o<-pull_final_year_mean(results,"benthc_o")
fishp_o<-pull_final_year_mean(results,"fishp_o")
fishd_o<-pull_final_year_mean(results,"fishd_o")
fishm_o<-pull_final_year_mean(results,"fishm_o")
bird_o <-pull_final_year_mean(results,"bird_o")
seal_o <-pull_final_year_mean(results,"seal_o")
ceta_o <-pull_final_year_mean(results,"ceta_o")
corpse_o <- corpse_d0 + corpse_d1 + corpse_d2 + corpse_d3
#Pull out the flow matrix from the results
flow_matrix<-elt(results$final.year.outputs,"flow_matrix_all_fluxes")
flow_matrix_ns<-elt(results$final.year.outputs,"flow_matrix_excl_spawn_recruit")
#colnames(flow_matrix) #Lists the column names in the flow matrix
#rownames(flow_matrix) #Lists the row names in the flow matrix
#-----------------------------------------------------------------------------------------------------------------
#Pull data out of the model object, ie data that have been assembled from the input csv files
#Pull out the model configuration to get areas and volumes
model.path<-model$setup$model.path
read.model.setup(model.path) # Models/Model/Variant/MODEL_SETUP.csv
physical.parameters <- read_physical_parameters(model.path)
so_depth<-elt(physical.parameters,"so_depth")
si_depth<-elt(physical.parameters,"si_depth")
d_depth<-elt(physical.parameters,"d_depth")
area_s0<-elt(physical.parameters,"x_area_s0")
area_s1<-elt(physical.parameters,"x_area_s1")
area_s2<-elt(physical.parameters,"x_area_s2")
area_s3<-elt(physical.parameters,"x_area_s3")
area_d0<-elt(physical.parameters,"x_area_d0")
area_d1<-elt(physical.parameters,"x_area_d1")
area_d2<-elt(physical.parameters,"x_area_d2")
area_d3<-elt(physical.parameters,"x_area_d3")
shallowprop<-(area_s0+area_s1+area_s2+area_s3)
volume_so<-so_depth*(1-shallowprop)
volume_d<-d_depth*(1-shallowprop)
volume_si<-si_depth*(shallowprop)
# Pull out the uptake function parameters needed to manually calculate the fluxes
model.path<-model$setup$model.path
read.model.setup(model.path) # Models/Model/Variant/MODEL_SETUP.csv
fitted.parameters <- read_fitted_parameters(model.path)
fixed.parameters <- read_fixed_parameters(model.path)
CZ_inedible <- elt(fixed.parameters,"CZ_inedible")
#Calculate edible component of carn zoo
CZ_inedible_i <- CZ_inedible * shallowprop
CZ_inedible_o <- CZ_inedible * (1-shallowprop)
if(carn_o>0) CZ_edible_o <- max(0,carn_o-(CZ_inedible_o/carn_o)) else CZ_edible_o <- 0
if(carn_i>0) CZ_edible_i <- max(0,carn_i-(CZ_inedible_i/carn_i)) else CZ_edible_i <- 0
u_bird<-elt(fitted.parameters,"u_bird")
h_bird<-elt(fitted.parameters,"h_bird")
bda_par_bird<-elt(fitted.parameters,"bda_par_bird")
PREF_corpse_bird<-elt(fitted.parameters,"PREF_corp_bird")
PREF_discard_bird<-elt(fitted.parameters,"PREF_disc_bird")
PREF_carn_bird<-elt(fitted.parameters,"PREF_carn_bird")
PREF_benths_bird<-elt(fitted.parameters,"PREF_benths_bird")
PREF_benthc_bird<-elt(fitted.parameters,"PREF_benthc_bird")
PREF_fishp_bird<-elt(fitted.parameters,"PREF_fishp_bird")
PREF_fishd_bird<-elt(fitted.parameters,"PREF_fishd_bird")
PREF_fishm_bird<-elt(fitted.parameters,"PREF_fishm_bird")
#....
u_seal<-elt(fitted.parameters,"u_seal")
h_seal<-elt(fitted.parameters,"h_seal")
bda_par_seal<-elt(fitted.parameters,"bda_par_seal")
PREF_corpse_seal<-elt(fitted.parameters,"PREF_corp_seal")
PREF_discard_seal<-elt(fitted.parameters,"PREF_disc_seal")
PREF_carn_seal<-elt(fitted.parameters,"PREF_carn_seal")
PREF_benths_seal<-elt(fitted.parameters,"PREF_benths_seal")
PREF_benthc_seal<-elt(fitted.parameters,"PREF_benthc_seal")
PREF_fishp_seal<-elt(fitted.parameters,"PREF_fishp_seal")
PREF_fishd_seal<-elt(fitted.parameters,"PREF_fishd_seal")
PREF_fishm_seal<-elt(fitted.parameters,"PREF_fishm_seal")
PREF_bird_seal<-elt(fitted.parameters,"PREF_bird_seal")
#....
u_ceta<-elt(fitted.parameters,"u_ceta")
h_ceta<-elt(fitted.parameters,"h_ceta")
bda_par_ceta<-elt(fitted.parameters,"bda_par_ceta")
PREF_discard_ceta<-elt(fitted.parameters,"PREF_disc_ceta")
PREF_omni_ceta<-elt(fitted.parameters,"PREF_omni_ceta")
PREF_carn_ceta<-elt(fitted.parameters,"PREF_carn_ceta")
PREF_benths_ceta<-elt(fitted.parameters,"PREF_benths_ceta")
PREF_benthc_ceta<-elt(fitted.parameters,"PREF_benthc_ceta")
PREF_fishp_ceta<-elt(fitted.parameters,"PREF_fishp_ceta")
PREF_fishd_ceta<-elt(fitted.parameters,"PREF_fishd_ceta")
PREF_fishm_ceta<-elt(fitted.parameters,"PREF_fishm_ceta")
PREF_bird_ceta<-elt(fitted.parameters,"PREF_bird_ceta")
PREF_seal_ceta<-elt(fitted.parameters,"PREF_seal_ceta")
bda_par_bird_o <- bda_par_bird * 1/(1-shallowprop)
bda_par_seal_o <- bda_par_seal * 1/(1-shallowprop)
bda_par_ceta_o <- bda_par_ceta * 1/(1-shallowprop)
bda_par_bird_i <- bda_par_bird * 1/(shallowprop)
bda_par_seal_i <- bda_par_seal * 1/(shallowprop)
bda_par_ceta_i <- bda_par_ceta * 1/(shallowprop)
#-----------------------------------------------------------------------------------------------------------------
#Now calculate the fluxes
calc_flux_corpse_bird_o<- f3(corpse_o,(bird_o),u_bird*PREF_corpse_bird,h_bird*(volume_so+volume_d),bda_par_bird_o)
calc_flux_corpse_bird_i<- f3(corpse_i,(bird_i),u_bird*PREF_corpse_bird,h_bird*(volume_si),bda_par_bird_i)
calc_flux_corpse_bird_w <- calc_flux_corpse_bird_o + calc_flux_corpse_bird_i
model_flux_corpse_bird<-extract_model_flux(flow_matrix,"corpses","bird")
#calc_flux_corpse_bird_w
#model_flux_corpse_bird
#............................
calc_flux_discard_bird_o<- f3(discard_o,(bird_o),u_bird*PREF_discard_bird,h_bird*(volume_so+volume_d),bda_par_bird_o)
calc_flux_discard_bird_i<- f3(discard_i,(bird_i),u_bird*PREF_discard_bird,h_bird*(volume_si),bda_par_bird_i)
calc_flux_discard_bird_w <- calc_flux_discard_bird_o + calc_flux_discard_bird_i
model_flux_discard_bird<-extract_model_flux(flow_matrix,"discards","bird")
#calc_flux_discard_bird_w
#model_flux_discard_bird
#............................
calc_flux_carn_bird_o<- f3(CZ_edible_o,(bird_o),u_bird*PREF_carn_bird,h_bird*(volume_so+volume_d),bda_par_bird_o)
calc_flux_carn_bird_i<- f3(CZ_edible_i,(bird_i),u_bird*PREF_carn_bird,h_bird*(volume_si),bda_par_bird_i)
calc_flux_carn_bird_w <- calc_flux_carn_bird_o + calc_flux_carn_bird_i
model_flux_carn_bird<-extract_model_flux(flow_matrix,"carnzoo","bird")
#calc_flux_carn_bird_w
#model_flux_carn_bird
#............................
calc_flux_benths_bird_o<- f3(benths_o,(bird_o),u_bird*PREF_benths_bird,h_bird*(volume_so+volume_d),bda_par_bird_o)
calc_flux_benths_bird_i<- f3(benths_i,(bird_i),u_bird*PREF_benths_bird,h_bird*(volume_si),bda_par_bird_i)
calc_flux_benths_bird_w <- calc_flux_benths_bird_o + calc_flux_benths_bird_i
model_flux_benths_bird<-extract_model_flux(flow_matrix,"benths","bird")
#calc_flux_benths_bird_w
#model_flux_benths_bird
#............................
calc_flux_benthc_bird_o<- f3(benthc_o,(bird_o),u_bird*PREF_benthc_bird,h_bird*(volume_so+volume_d),bda_par_bird_o)
calc_flux_benthc_bird_i<- f3(benthc_i,(bird_i),u_bird*PREF_benthc_bird,h_bird*(volume_si),bda_par_bird_i)
calc_flux_benthc_bird_w <- calc_flux_benthc_bird_o + calc_flux_benthc_bird_i
model_flux_benthc_bird<-extract_model_flux(flow_matrix,"benthc","bird")
#calc_flux_benthc_bird_w
#model_flux_benthc_bird
#............................
calc_flux_fishp_bird_o<- f3(fishp_o,(bird_o),u_bird*PREF_fishp_bird,h_bird*(volume_so+volume_d),bda_par_bird_o)
calc_flux_fishp_bird_i<- f3(fishp_i,(bird_i),u_bird*PREF_fishp_bird,h_bird*(volume_si),bda_par_bird_i)
calc_flux_fishp_bird_w <- calc_flux_fishp_bird_o + calc_flux_fishp_bird_i
model_flux_fishp_bird<-extract_model_flux(flow_matrix,"pfish","bird")
#calc_flux_fishp_bird_w
#model_flux_fishp_bird
#............................
calc_flux_fishd_bird_o<- f3(fishd_o,(bird_o),u_bird*PREF_fishd_bird,h_bird*(volume_so+volume_d),bda_par_bird_o)
calc_flux_fishd_bird_i<- f3(fishd_i,(bird_i),u_bird*PREF_fishd_bird,h_bird*(volume_si),bda_par_bird_i)
calc_flux_fishd_bird_w <- calc_flux_fishd_bird_o + calc_flux_fishd_bird_i
model_flux_fishd_bird<-extract_model_flux(flow_matrix,"dfish","bird")
#calc_flux_fishd_bird_w
#model_flux_fishd_bird
#............................
calc_flux_fishm_bird_o<- f3(fishm_o,(bird_o),u_bird*PREF_fishm_bird,h_bird*(volume_so+volume_d),bda_par_bird_o)
calc_flux_fishm_bird_i<- f3(fishm_i,(bird_i),u_bird*PREF_fishm_bird,h_bird*(volume_si),bda_par_bird_i)
calc_flux_fishm_bird_w <- calc_flux_fishm_bird_o + calc_flux_fishm_bird_i
model_flux_fishm_bird<-extract_model_flux(flow_matrix,"mfish","bird")
#calc_flux_fishm_bird_w
#model_flux_fishm_bird
#............................
#............................
calc_flux_corpse_seal_o<- f3(corpse_o,(seal_o),u_seal*PREF_corpse_seal,h_seal*(volume_so+volume_d),bda_par_seal_o)
calc_flux_corpse_seal_i<- f3(corpse_i,(seal_i),u_seal*PREF_corpse_seal,h_seal*(volume_si),bda_par_seal_i)
calc_flux_corpse_seal_w <- calc_flux_corpse_seal_o + calc_flux_corpse_seal_i
model_flux_corpse_seal<-extract_model_flux(flow_matrix,"corpses","seal")
#calc_flux_corpse_seal_w
#model_flux_corpse_seal
#............................
calc_flux_discard_seal_o<- f3(discard_o,(seal_o),u_seal*PREF_discard_seal,h_seal*(volume_so+volume_d),bda_par_seal_o)
calc_flux_discard_seal_i<- f3(discard_i,(seal_i),u_seal*PREF_discard_seal,h_seal*(volume_si),bda_par_seal_i)
calc_flux_discard_seal_w <- calc_flux_discard_seal_o + calc_flux_discard_seal_i
model_flux_discard_seal<-extract_model_flux(flow_matrix,"discards","seal")
#calc_flux_discard_seal_w
#model_flux_discard_seal
#............................
calc_flux_carn_seal_o<- f3(CZ_edible_o,(seal_o),u_seal*PREF_carn_seal,h_seal*(volume_so+volume_d),bda_par_seal_o)
calc_flux_carn_seal_i<- f3(CZ_edible_i,(seal_i),u_seal*PREF_carn_seal,h_seal*(volume_si),bda_par_seal_i)
calc_flux_carn_seal_w <- calc_flux_carn_seal_o + calc_flux_carn_seal_i
model_flux_carn_seal<-extract_model_flux(flow_matrix,"carnzoo","seal")
#calc_flux_carn_seal_w
#model_flux_carn_seal
#............................
calc_flux_benths_seal_o<- f3(benths_o,(seal_o),u_seal*PREF_benths_seal,h_seal*(volume_so+volume_d),bda_par_seal_o)
calc_flux_benths_seal_i<- f3(benths_i,(seal_i),u_seal*PREF_benths_seal,h_seal*(volume_si),bda_par_seal_i)
calc_flux_benths_seal_w <- calc_flux_benths_seal_o + calc_flux_benths_seal_i
model_flux_benths_seal<-extract_model_flux(flow_matrix,"benths","seal")
#calc_flux_benths_seal_w
#model_flux_benths_seal
#............................
calc_flux_benthc_seal_o<- f3(benthc_o,(seal_o),u_seal*PREF_benthc_seal,h_seal*(volume_so+volume_d),bda_par_seal_o)
calc_flux_benthc_seal_i<- f3(benthc_i,(seal_i),u_seal*PREF_benthc_seal,h_seal*(volume_si),bda_par_seal_i)
calc_flux_benthc_seal_w <- calc_flux_benthc_seal_o + calc_flux_benthc_seal_i
model_flux_benthc_seal<-extract_model_flux(flow_matrix,"benthc","seal")
#calc_flux_benthc_seal_w
#model_flux_benthc_seal
#............................
calc_flux_fishp_seal_o<- f3(fishp_o,(seal_o),u_seal*PREF_fishp_seal,h_seal*(volume_so+volume_d),bda_par_seal_o)
calc_flux_fishp_seal_i<- f3(fishp_i,(seal_i),u_seal*PREF_fishp_seal,h_seal*(volume_si),bda_par_seal_i)
calc_flux_fishp_seal_w <- calc_flux_fishp_seal_o + calc_flux_fishp_seal_i
model_flux_fishp_seal<-extract_model_flux(flow_matrix,"pfish","seal")
#calc_flux_fishp_seal_w
#model_flux_fishp_seal
#............................
calc_flux_fishd_seal_o<- f3(fishd_o,(seal_o),u_seal*PREF_fishd_seal,h_seal*(volume_so+volume_d),bda_par_seal_o)
calc_flux_fishd_seal_i<- f3(fishd_i,(seal_i),u_seal*PREF_fishd_seal,h_seal*(volume_si),bda_par_seal_i)
calc_flux_fishd_seal_w <- calc_flux_fishd_seal_o + calc_flux_fishd_seal_i
model_flux_fishd_seal<-extract_model_flux(flow_matrix,"dfish","seal")
#calc_flux_fishd_seal_w
#model_flux_fishd_seal
#............................
calc_flux_fishm_seal_o<- f3(fishm_o,(seal_o),u_seal*PREF_fishm_seal,h_seal*(volume_so+volume_d),bda_par_seal_o)
calc_flux_fishm_seal_i<- f3(fishm_i,(seal_i),u_seal*PREF_fishm_seal,h_seal*(volume_si),bda_par_seal_i)
calc_flux_fishm_seal_w <- calc_flux_fishm_seal_o + calc_flux_fishm_seal_i
model_flux_fishm_seal<-extract_model_flux(flow_matrix,"mfish","seal")
#calc_flux_fishm_seal_w
#model_flux_fishm_seal
#............................
calc_flux_bird_seal_o<- f3(bird_o,(seal_o),u_seal*PREF_bird_seal,h_seal*(volume_so+volume_d),bda_par_seal_o)
calc_flux_bird_seal_i<- f3(bird_i,(seal_i),u_seal*PREF_bird_seal,h_seal*(volume_si),bda_par_seal_i)
calc_flux_bird_seal_w <- calc_flux_bird_seal_o + calc_flux_bird_seal_i
model_flux_bird_seal<-extract_model_flux(flow_matrix,"bird","seal")
#calc_flux_bird_seal_w
#model_flux_bird_seal
#............................
#............................
calc_flux_discard_ceta_o<- f3(discard_o,(ceta_o),u_ceta*PREF_discard_ceta,h_ceta*(volume_so+volume_d),bda_par_ceta_o)
calc_flux_discard_ceta_i<- f3(discard_i,(ceta_i),u_ceta*PREF_discard_ceta,h_ceta*(volume_si),bda_par_ceta_i)
calc_flux_discard_ceta_w <- calc_flux_discard_ceta_o + calc_flux_discard_ceta_i
model_flux_discard_ceta<-extract_model_flux(flow_matrix,"discards","ceta")
#calc_flux_discard_ceta_w
#model_flux_discard_ceta
#............................
calc_flux_omni_ceta_o<- f3(omni_o,(ceta_o),u_ceta*PREF_omni_ceta,h_ceta*(volume_so+volume_d),bda_par_ceta_o)
calc_flux_omni_ceta_i<- f3(omni_i,(ceta_i),u_ceta*PREF_omni_ceta,h_ceta*(volume_si),bda_par_ceta_i)
calc_flux_omni_ceta_w <- calc_flux_omni_ceta_o + calc_flux_omni_ceta_i
model_flux_omni_ceta<-extract_model_flux(flow_matrix,"omnivzoo","ceta")
#calc_flux_omni_ceta_w
#model_flux_omni_ceta
#............................
calc_flux_carn_ceta_o<- f3(CZ_edible_o,(ceta_o),u_ceta*PREF_carn_ceta,h_ceta*(volume_so+volume_d),bda_par_ceta_o)
calc_flux_carn_ceta_i<- f3(CZ_edible_i,(ceta_i),u_ceta*PREF_carn_ceta,h_ceta*(volume_si),bda_par_ceta_i)
calc_flux_carn_ceta_w <- calc_flux_carn_ceta_o + calc_flux_carn_ceta_i
model_flux_carn_ceta<-extract_model_flux(flow_matrix,"carnzoo","ceta")
#calc_flux_carn_ceta_w
#model_flux_carn_ceta
#............................
calc_flux_benths_ceta_o<- f3(benths_o,(ceta_o),u_ceta*PREF_benths_ceta,h_ceta*(volume_so+volume_d),bda_par_ceta_o)
calc_flux_benths_ceta_i<- f3(benths_i,(ceta_i),u_ceta*PREF_benths_ceta,h_ceta*(volume_si),bda_par_ceta_i)
calc_flux_benths_ceta_w <- calc_flux_benths_ceta_o + calc_flux_benths_ceta_i
model_flux_benths_ceta<-extract_model_flux(flow_matrix,"benths","ceta")
#calc_flux_benths_ceta_w
#model_flux_benths_ceta
#............................
calc_flux_benthc_ceta_o<- f3(benthc_o,(ceta_o),u_ceta*PREF_benthc_ceta,h_ceta*(volume_so+volume_d),bda_par_ceta_o)
calc_flux_benthc_ceta_i<- f3(benthc_i,(ceta_i),u_ceta*PREF_benthc_ceta,h_ceta*(volume_si),bda_par_ceta_i)
calc_flux_benthc_ceta_w <- calc_flux_benthc_ceta_o + calc_flux_benthc_ceta_i
model_flux_benthc_ceta<-extract_model_flux(flow_matrix,"benthc","ceta")
#calc_flux_benthc_ceta_w
#model_flux_benthc_ceta
#............................
calc_flux_fishp_ceta_o<- f3(fishp_o,(ceta_o),u_ceta*PREF_fishp_ceta,h_ceta*(volume_so+volume_d),bda_par_ceta_o)
calc_flux_fishp_ceta_i<- f3(fishp_i,(ceta_i),u_ceta*PREF_fishp_ceta,h_ceta*(volume_si),bda_par_ceta_i)
calc_flux_fishp_ceta_w <- calc_flux_fishp_ceta_o + calc_flux_fishp_ceta_i
model_flux_fishp_ceta<-extract_model_flux(flow_matrix,"pfish","ceta")
#calc_flux_fishp_ceta_w
#model_flux_fishp_ceta
#............................
calc_flux_fishd_ceta_o<- f3(fishd_o,(ceta_o),u_ceta*PREF_fishd_ceta,h_ceta*(volume_so+volume_d),bda_par_ceta_o)
calc_flux_fishd_ceta_i<- f3(fishd_i,(ceta_i),u_ceta*PREF_fishd_ceta,h_ceta*(volume_si),bda_par_ceta_i)
calc_flux_fishd_ceta_w <- calc_flux_fishd_ceta_o + calc_flux_fishd_ceta_i
model_flux_fishd_ceta<-extract_model_flux(flow_matrix,"dfish","ceta")
#calc_flux_fishd_ceta_w
#model_flux_fishd_ceta
#............................
calc_flux_fishm_ceta_o<- f3(fishm_o,(ceta_o),u_ceta*PREF_fishm_ceta,h_ceta*(volume_so+volume_d),bda_par_ceta_o)
calc_flux_fishm_ceta_i<- f3(fishm_i,(ceta_i),u_ceta*PREF_fishm_ceta,h_ceta*(volume_si),bda_par_ceta_i)
calc_flux_fishm_ceta_w <- calc_flux_fishm_ceta_o + calc_flux_fishm_ceta_i
model_flux_fishm_ceta<-extract_model_flux(flow_matrix,"mfish","ceta")
#calc_flux_fishm_ceta_w
#model_flux_fishm_ceta
#............................
calc_flux_bird_ceta_o<- f3(bird_o,(ceta_o),u_ceta*PREF_bird_ceta,h_ceta*(volume_so+volume_d),bda_par_ceta_o)
calc_flux_bird_ceta_i<- f3(bird_i,(ceta_i),u_ceta*PREF_bird_ceta,h_ceta*(volume_si),bda_par_ceta_i)
calc_flux_bird_ceta_w <- calc_flux_bird_ceta_o + calc_flux_bird_ceta_i
model_flux_bird_ceta<-extract_model_flux(flow_matrix,"bird","ceta")
#calc_flux_bird_ceta_w
#model_flux_bird_ceta
#............................
calc_flux_seal_ceta_o<- f3(seal_o,(ceta_o),u_ceta*PREF_seal_ceta,h_ceta*(volume_so+volume_d),bda_par_ceta_o)
calc_flux_seal_ceta_i<- f3(seal_i,(ceta_i),u_ceta*PREF_seal_ceta,h_ceta*(volume_si),bda_par_ceta_i)
calc_flux_seal_ceta_w <- calc_flux_seal_ceta_o + calc_flux_seal_ceta_i
model_flux_seal_ceta<-extract_model_flux(flow_matrix,"seal","ceta")
#calc_flux_seal_ceta_w
#model_flux_seal_ceta
#............................
#............................
#Implement testthat checks...
expect_equal(model_flux_corpse_bird,calc_flux_corpse_bird_w , 1e-7)
expect_equal(model_flux_discard_bird,calc_flux_discard_bird_w , 1e-7)
expect_equal(model_flux_carn_bird,calc_flux_carn_bird_w , 1e-7)
expect_equal(model_flux_benths_bird,calc_flux_benths_bird_w , 1e-7)
expect_equal(model_flux_benthc_bird,calc_flux_benthc_bird_w , 1e-7)
expect_equal(model_flux_fishp_bird,calc_flux_fishp_bird_w , 1e-7)
expect_equal(model_flux_fishm_bird,calc_flux_fishm_bird_w , 1e-7)
expect_equal(model_flux_fishd_bird,calc_flux_fishd_bird_w , 1e-7)
expect_equal(model_flux_corpse_seal,calc_flux_corpse_seal_w , 1e-7)
expect_equal(model_flux_discard_seal,calc_flux_discard_seal_w , 1e-7)
expect_equal(model_flux_carn_seal,calc_flux_carn_seal_w , 1e-7)
expect_equal(model_flux_benths_seal,calc_flux_benths_seal_w , 1e-7)
expect_equal(model_flux_benthc_seal,calc_flux_benthc_seal_w , 1e-7)
expect_equal(model_flux_fishp_seal,calc_flux_fishp_seal_w , 1e-7)
expect_equal(model_flux_fishm_seal,calc_flux_fishm_seal_w , 1e-7)
expect_equal(model_flux_fishd_seal,calc_flux_fishd_seal_w , 1e-7)
expect_equal(model_flux_bird_seal,calc_flux_bird_seal_w , 1e-7)
expect_equal(model_flux_discard_ceta,calc_flux_discard_ceta_w , 1e-7)
expect_equal(model_flux_omni_ceta,calc_flux_omni_ceta_w , 1e-7)
expect_equal(model_flux_carn_ceta,calc_flux_carn_ceta_w , 1e-7)
expect_equal(model_flux_benths_ceta,calc_flux_benths_ceta_w , 1e-7)
expect_equal(model_flux_benthc_ceta,calc_flux_benthc_ceta_w , 1e-7)
expect_equal(model_flux_fishp_ceta,calc_flux_fishp_ceta_w , 1e-7)
expect_equal(model_flux_fishm_ceta,calc_flux_fishm_ceta_w , 1e-7)
expect_equal(model_flux_fishd_ceta,calc_flux_fishd_ceta_w , 1e-7)
expect_equal(model_flux_bird_ceta,calc_flux_bird_ceta_w , 1e-7)
expect_equal(model_flux_seal_ceta,calc_flux_seal_ceta_w , 1e-7)
})
Try the StrathE2E2 package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.