Skip to content

Commit

Permalink
Rework the gmse_apply code so that the new inputs from the work of @A…
Browse files Browse the repository at this point in the history
…drianBach Issue #59  and options for variation in user budgets can be put into GMSE apply. The changes now get into the paras vector appropriately, and do not cause any crash, but further testing is needed to make sure that gmse_apply is using the information correctly, and testthat functions need to be rewritten.
  • Loading branch information
bradduthie committed Apr 13, 2020
1 parent b73c815 commit d48a4f9
Show file tree
Hide file tree
Showing 2 changed files with 42 additions and 9 deletions.
8 changes: 4 additions & 4 deletions R/gmse.R
Original file line number Diff line number Diff line change
Expand Up @@ -62,10 +62,10 @@
#'@param manager_sense This adjusts the sensitivity that a manager assumes their actions have with respect to changes in costs (their policy). For example, given a `manage_sense` value of 0.9, if the cost of culling resources doubles, then instead of a manager assuming the the number of culled resources per user will be cut in half, the manager will instead assume that the number of resources culled will be cut by one half times eight tenths. As a general rule, a value of ca 0.8 allows the manager to predict stake-holder responses to policy accurately; future versions of GMSE could allow managers to adjust this dynamically based on simulation history.
#'@param public_land The proportion of the landscape that will be public, and not owned by stakeholders. The remaining proportion of the landscape will be evenly divided among stakeholders. Note that this option is only available when land_ownership == TRUE.
#'@param group_think If TRUE, all users will have identical actions; the genetic algorithm will find actions for one user and copy them for all users. This is a useful option if a lot of users are required but variation among user decisions can be ignored.
#'@param action_thres A value for the deviation of the estimated population from the manager target, above which manager will not update the policy.
#'@param budget_bonus A percentage of the initial budget manager will receive if policy was not updated last time step. Corresponds to the time, energy and money saved by waiting for a better time to update the policy.
#'@param age_repr The age below which resources are incapable of reproducing.
#'@param usr_budget_rng This specifies a range around the value of `user_budget`, such that the expected value of each user's budget will be `user_budget`, with a uniform distribution plus or minus `usr_budget_rng`. Note that the minimum `usr_budget_rng` allowed is 1 regardless of the range set.
#'@param action_thres A value for the deviation of the estimated population from the manager target, above which manager will not update the policy.
#'@param budget_bonus A percentage of the initial budget manager will receive if policy was not updated last time step. Corresponds to the time, energy and money saved by waiting for a better time to update the policy.
#'@return A large list is returned that includes detailed simulation histories for the resource, observation, management, and user models. This list includes eight elements, most of which are themselves complex lists of arrays: (1) A list of length `time_max` in which each element is an array of resources as they exist at the end of each time step. Resource arrays include all resources and their attributes (e.g., locations, growth rates, offspring, how they are affected by stakeholders, etc.). (2) A list of length `time_max` in which each element is an array of resource observations from the observation model. Observation arrays are similar to resource arrays, except that they can have a smaller number of rows if not all resources are observed, and they have additional columns that show the history of each resource being observed over the course of `times_observe` observations in the observation model. (3) A 2D array showing parameter values at each time step (unique rows); most of these values are static but some (e.g., resource number) change over time steps. (4) A list of length `time_max` in which each element is an array of the landscape that identifies proportion of crop production per cell. This allows for looking at where crop production is increased or decreased over time steps as a consequence of resource and stakeholder actions. (5) The total time the simulation took to run (not counting plotting time). (6) A 2D array of agents and their traits. (7) A list of length `time_max` in which each element is a 3D array of the costs of performing each action for managers and stakeholders (each agent gets its own array layer with an identical number of rows and columns); the change in costs of particular actions can therefore be be examined over time. (8) A list of length `time_max` in which each element is a 3D array of the actions performed by managers and stakeholders (each agent gets its own array layer with an identical number of rows and columns); the change in actions of agents can therefore be examined over time. Because the above lists cannot possibly be interpreted by eye all at once in the simulation output, it is highly recommended that the contents of a simulation be stored and interprted individually if need be; alternativley, simulations can more easily be interpreted through plots when `plotting = TRUE`.
#'@examples
#'\dontrun{
Expand Down Expand Up @@ -420,8 +420,8 @@ gmse <- function( time_max = 100, # Max number of time steps in sim
scaring, culling, castration, feeding, help_offspring,
tend_crops, tend_crop_yld, kill_crops, stakeholders,
manage_caution, land_ownership, manage_freq, converge_crit,
manager_sense, public_land, group_think, action_thres,
budget_bonus);
manager_sense, public_land, group_think, age_repr,
usr_budget_rng, action_thres, budget_bonus);

paras_errors(input_list);

Expand Down
43 changes: 38 additions & 5 deletions R/gmse_apply.R
Original file line number Diff line number Diff line change
Expand Up @@ -570,6 +570,24 @@ update_old_gmse <- function(arg_vals, ol, list_add){
ol[["PARAS"]][102] <- list_add[["group_think"]];
}
}
if("age_repr" %in% names_add){
ol[["age_repr"]] <- list_add[["age_repr"]];
if(is.null(ol[["PARAS"]]) == FALSE & is.na(ol[["PARAS"]])[1] == FALSE){
ol[["PARAS"]][112] <- list_add[["age_repr"]];
}
}
if("action_thres" %in% names_add){
ol[["action_thres"]] <- list_add[["action_thres"]];
if(is.null(ol[["PARAS"]]) == FALSE & is.na(ol[["PARAS"]])[1] == FALSE){
ol[["PARAS"]][106] <- list_add[["action_thres"]];
}
}
if("budget_bonus" %in% names_add){
ol[["budget_bonus"]] <- list_add[["budget_bonus"]];
if(is.null(ol[["PARAS"]]) == FALSE & is.na(ol[["PARAS"]])[1] == FALSE){
ol[["PARAS"]][111] <- list_add[["budget_bonus"]];
}
}
return(ol);
}

Expand Down Expand Up @@ -648,7 +666,8 @@ pass_paras <- function( old_list = NULL, time_max = 100, land_dim_1 = 100,
manage_caution = 1, land_ownership = FALSE,
manage_freq = 1, converge_crit = 1,
manager_sense = 0.1, public_land = 0,
group_think = FALSE, PARAS = NULL, ...
group_think = FALSE, age_repr = 1, usr_budget_rng = 0,
action_thres = 0, budget_bonus = 0, PARAS = NULL, ...
){

if(is.null(PARAS) == FALSE){
Expand All @@ -668,8 +687,9 @@ pass_paras <- function( old_list = NULL, time_max = 100, land_dim_1 = 100,
scaring, culling, castration, feeding, help_offspring,
tend_crops, tend_crop_yld, kill_crops, stakeholders,
manage_caution, land_ownership, manage_freq, converge_crit,
manager_sense, public_land, group_think);

manager_sense, public_land, group_think, age_repr,
usr_budget_rng, action_thres, budget_bonus);

paras_errors(input_list);

ldims <- land_errors(input_list, ...);
Expand Down Expand Up @@ -707,9 +727,10 @@ pass_paras <- function( old_list = NULL, time_max = 100, land_dim_1 = 100,
user_res_opts[4], user_res_opts[5], user_lnd_opts[1],
user_lnd_opts[2], manage_caution, minimum_cost, user_budget,
converge_crit, RESOURCE_ini, lambda, group_think, fixed_recapt,
land_ownership, public_land
land_ownership, public_land, action_thres, 1, 0, 0, 0,
budget_bonus, age_repr, 16, manager_budget
);

return( list(gmse_user_input = as.vector(input_list),
gmse_para_vect = as.vector(paras))
);
Expand Down Expand Up @@ -1105,6 +1126,18 @@ paras_errors <- function(input_list){
if(input_list[56] < 0 | input_list[56] > 1){
stop("ERROR: group_think must be TRUE/FALSE");
}
if(input_list[57] < 0){
stop("ERROR: Age of reproduction cannot be negative");
}
if(input_list[58] < 0){
stop("ERROR: Range of user budgets cannot be negative");
}
if(input_list[59] < 0){
stop("ERROR: Action threshold for manager cannot be negative");
}
if(input_list[60] < 0){
stop("ERROR: Manager budget bonus cannot be negative");
}
}

argument_list <- function(res_mod, obs_mod, man_mod, use_mod, oth_vals){
Expand Down

0 comments on commit d48a4f9

Please sign in to comment.