Skip to content

Commit

Permalink
Merge pull request #70 from JGCRI/RenameExpectations
Browse files Browse the repository at this point in the history
Update names of expectations to match paper
  • Loading branch information
kvcalvin authored Oct 1, 2020
2 parents 25e4476 + 8e9346a commit be3d382
Show file tree
Hide file tree
Showing 21 changed files with 80 additions and 109 deletions.
2 changes: 1 addition & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -29,6 +29,7 @@ Suggests:
rmarkdown
BugReports: https://github.com/JGCRI/gcamland/issues
Collate:
'adaptive_expectation.R'
'ag_production_technology.R'
'bayesian.R'
'constants.R'
Expand All @@ -37,7 +38,6 @@ Collate:
'generate_price_data.R'
'generate_scenario_info.R'
'helpers.R'
'lagged_expectation.R'
'land_allocator.R'
'land_leaf.R'
'land_node.R'
Expand Down
2 changes: 1 addition & 1 deletion NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -16,7 +16,7 @@ export(SRB.SCENARIO.INFO)
export(ScenarioInfo)
export(add_parameter_data)
export(as.ScenarioInfo)
export(calc_lagged_expectation)
export(calc_adaptive_expectation)
export(export_results)
export(get_PCHES_results)
export(get_hindcast_AgProdChange)
Expand Down
32 changes: 16 additions & 16 deletions R/lagged_expectation.R → R/adaptive_expectation.R
Original file line number Diff line number Diff line change
@@ -1,15 +1,15 @@
# lagged_expectation.R
# adaptive_expectation.R

#' LaggedExpectation_calcExpectedYield
#' AdaptiveExpectation_calcExpectedYield
#'
#' @details Calculate the expected yield for a LandLeaf using
#' a lagged approach -- use linear combination of previous expectation and
#' an adaptive approach -- use linear combination of previous expectation and
#' new information.
#' @param aLandLeaf LandLeaf to calculate expected yield for
#' @param aPeriod Current model period
#' @param aScenarioInfo Scenario-related information, including names, logits, expectations
#' @author KVC November 2017
LaggedExpectation_calcExpectedYield <- function(aLandLeaf, aPeriod, aScenarioInfo) {
AdaptiveExpectation_calcExpectedYield <- function(aLandLeaf, aPeriod, aScenarioInfo) {
# Silence package checks
sector <- year <- yield <- lm <- predict <- GCAM_commodity <- NULL

Expand All @@ -30,7 +30,7 @@ LaggedExpectation_calcExpectedYield <- function(aLandLeaf, aPeriod, aScenarioInf
previousExpectation <- aLandLeaf$mExpectedYield[[aPeriod - 1]]

# Get new information
if( aScenarioInfo$mExpectationType == "LaggedCurr" ) {
if( aScenarioInfo$mExpectationType == "HybridPerfectAdaptive" ) {
newInformation <- aLandLeaf$mYield[[aPeriod]]
} else {
newInformation <- aLandLeaf$mYield[[aPeriod - 1]]
Expand Down Expand Up @@ -59,14 +59,14 @@ LaggedExpectation_calcExpectedYield <- function(aLandLeaf, aPeriod, aScenarioInf
}
yield_table$yield <- yield_table$base_yield * yield_table$yield_ratio

# Now, we call calc_lagged_expectation() to calculate the expectations
if( aScenarioInfo$mExpectationType == "LaggedCurr" ) {
# Now, we call calc_adaptive_expectation() to calculate the expectations
if( aScenarioInfo$mExpectationType == "HybridPerfectAdaptive" ) {
currYear <- get_per_to_yr(aPeriod, aScenarioInfo$mScenarioType)
expectedYield <- calc_lagged_expectation(currYear, shareOld, yield_table, 'yield')
expectedYield <- calc_adaptive_expectation(currYear, shareOld, yield_table, 'yield')
} else {
timestep <- get_per_to_yr(aPeriod+1, aScenarioInfo$mScenarioType) - get_per_to_yr(aPeriod, aScenarioInfo$mScenarioType)
prevYear <- get_per_to_yr(aPeriod, aScenarioInfo$mScenarioType) - timestep
expectedYield <- calc_lagged_expectation(prevYear, shareOld, yield_table, 'yield')
expectedYield <- calc_adaptive_expectation(prevYear, shareOld, yield_table, 'yield')
}
}

Expand All @@ -76,16 +76,16 @@ LaggedExpectation_calcExpectedYield <- function(aLandLeaf, aPeriod, aScenarioInf
return(expectedYield)
}

#' LaggedExpectation_calcExpectedPrice
#' AdaptiveExpectation_calcExpectedPrice
#'
#' @details Calculate the expected price for a LandLeaf using
#' a lagged approach -- use linear combination of previous expectation and
#' an adaptive approach -- use linear combination of previous expectation and
#' new information.
#' @param aLandLeaf LandLeaf to calculate expected price for
#' @param aPeriod Current model period
#' @param aScenarioInfo Scenario-related information, including names, logits, expectations
#' @author KVC November 2017
LaggedExpectation_calcExpectedPrice <- function(aLandLeaf, aPeriod, aScenarioInfo){
AdaptiveExpectation_calcExpectedPrice <- function(aLandLeaf, aPeriod, aScenarioInfo){
# Silence package checks
sector <- lm <- predict <- year <- price <- NULL

Expand All @@ -106,17 +106,17 @@ LaggedExpectation_calcExpectedPrice <- function(aLandLeaf, aPeriod, aScenarioInf

if(aLandLeaf$mProductName[1] %in% unique(price_table$sector)) {
# Calculate expected price
if( aScenarioInfo$mExpectationType == "LaggedCurr" ) {
if( aScenarioInfo$mExpectationType == "HybridPerfectAdaptive" ) {
currYear <- get_per_to_yr(aPeriod, aScenarioInfo$mScenarioType)
expectedPrice <- calc_lagged_expectation(currYear, shareOld, price_table, 'price')
expectedPrice <- calc_adaptive_expectation(currYear, shareOld, price_table, 'price')
} else {
if( aPeriod > 1 ) {
prevYear <- get_per_to_yr(aPeriod-1, aScenarioInfo$mScenarioType)
} else {
timestep <- get_per_to_yr(aPeriod+1, aScenarioInfo$mScenarioType) - get_per_to_yr(aPeriod, aScenarioInfo$mScenarioType)
prevYear <- get_per_to_yr(aPeriod, aScenarioInfo$mScenarioType) - timestep
}
expectedPrice <- calc_lagged_expectation(prevYear, shareOld, price_table, 'price')
expectedPrice <- calc_adaptive_expectation(prevYear, shareOld, price_table, 'price')
}

} else {
Expand Down Expand Up @@ -155,7 +155,7 @@ LaggedExpectation_calcExpectedPrice <- function(aLandLeaf, aPeriod, aScenarioInf
#' @param colname Name of the column that has the data for which we are
#' computing the expectation (e.g. \code{'price'})
#' @export
calc_lagged_expectation <- function(t, alpha, datatbl, colname)
calc_adaptive_expectation <- function(t, alpha, datatbl, colname)
{
year <- datatbl[['year']]
x <- datatbl[[colname]]
Expand Down
10 changes: 5 additions & 5 deletions R/ag_production_technology.R
Original file line number Diff line number Diff line change
Expand Up @@ -90,11 +90,11 @@ AgProductionTechnology_calcProfitRate <- function(aLandLeaf, aPeriod, aScenarioI
} else if(aScenarioInfo$mExpectationType == "Linear") {
expectedPrice <- LinearExpectation_calcExpectedPrice(aLandLeaf, aPeriod, aScenarioInfo)
expectedYield <- LinearExpectation_calcExpectedYield(aLandLeaf, aPeriod, aScenarioInfo)
} else if(aScenarioInfo$mExpectationType == "Lagged" | aScenarioInfo$mExpectationType == "LaggedCurr") {
expectedPrice <- LaggedExpectation_calcExpectedPrice(aLandLeaf, aPeriod, aScenarioInfo)
expectedYield <- LaggedExpectation_calcExpectedYield(aLandLeaf, aPeriod, aScenarioInfo)
} else if(aScenarioInfo$mExpectationType == "Mixed") {
expectedPrice <- LaggedExpectation_calcExpectedPrice(aLandLeaf, aPeriod, aScenarioInfo)
} else if(aScenarioInfo$mExpectationType == "Adaptive" | aScenarioInfo$mExpectationType == "HybridPerfectAdaptive") {
expectedPrice <- AdaptiveExpectation_calcExpectedPrice(aLandLeaf, aPeriod, aScenarioInfo)
expectedYield <- AdaptiveExpectation_calcExpectedYield(aLandLeaf, aPeriod, aScenarioInfo)
} else if(aScenarioInfo$mExpectationType == "HybridLinearAdaptive") {
expectedPrice <- AdaptiveExpectation_calcExpectedPrice(aLandLeaf, aPeriod, aScenarioInfo)
expectedYield <- LinearExpectation_calcExpectedYield(aLandLeaf, aPeriod, aScenarioInfo)
}

Expand Down
4 changes: 2 additions & 2 deletions R/generate_scenario_info.R
Original file line number Diff line number Diff line change
Expand Up @@ -42,7 +42,7 @@ DEFAULT.SCENARIO.TYPE <- "Reference"
#' @return New ScenarioInfo object
#' @export
#' @author KVC November 2017
ScenarioInfo <- function(# Currently only "Perfect", "Linear", "Lagged", and "LaggedCurr" ExpectationType are supported
ScenarioInfo <- function(# Currently only "Perfect", "Linear", "Adaptive", "HybridLinearAdaptive", and "HybridPerfectAdaptive" ExpectationType are supported
aExpectationType = NULL,
aLaggedShareOld1 = NA,
aLaggedShareOld2 = NA,
Expand Down Expand Up @@ -280,7 +280,7 @@ update_scen_info <- function(aName = NULL, aScenarioType = DEFAULT.SCENARIO.TYPE
new_scen_info$mLinearYears3 <- aLinearYears3
}

# Set share of old expectations in lagged expectation if specified
# Set share of old expectations in adaptive expectation if specified
if(is.numeric(aLaggedShareOld)) {
# Set all groups to this value if it specified. These can be individually overwritten later.
new_scen_info$mLaggedShareOld1 <- aLaggedShareOld
Expand Down
6 changes: 3 additions & 3 deletions R/helpers.R
Original file line number Diff line number Diff line change
Expand Up @@ -73,7 +73,7 @@ getStartYear <- function(aScenType) {
#' @details Get the scenario name to use in ensemble runs
#' @param aScenName Scenario base name
#' @param aExpectation Expectation type
#' @param aYears Years for Lagged or Linear expectations (NULL for Perfect)
#' @param aYears Years for Adaptive or Linear expectations (NULL for Perfect)
#' @param aAgFor Logit exponent for AgroForestLand
#' @param aAgForNonPast Logit exponent for AgroForestLand_NonPasture
#' @param aCrop Logit exponent for Cropland
Expand All @@ -84,9 +84,9 @@ getScenName <- function(aScenName, aExpectation, aYears, aAgFor, aAgForNonPast,
# Add expectation information
if(aExpectation == "Linear") {
scenNameAdj <- paste(aScenName, "_", aExpectation, aYears, sep="")
} else if (aExpectation == "Lagged") {
} else if (aExpectation == "Adaptive") {
scenNameAdj <- paste(aScenName, "_", aExpectation, aYears, sep="")
} else if (aExpectation == "Mixed") {
} else if (aExpectation == "HybridLinearAdaptive") {
scenNameAdj <- paste(aScenName, "_", aExpectation, aYears, sep="")
} else {
scenNameAdj <- paste(aScenName, "_", aExpectation, sep="")
Expand Down
28 changes: 14 additions & 14 deletions R/main.R
Original file line number Diff line number Diff line change
Expand Up @@ -6,8 +6,8 @@
#' Parameter combinations are selected by generating a quasi-random
#' sequence and mapping it to a specified range for each parameter.
#' Then, each parameter set is run through the offline land model in
#' each of the Perfect, Lagged, and Linear variants. (I.e., if N
#' parameter sets are selected, then 3N scenarios are run.)
#' each of the Perfect, Adaptive, HybridPerfectAdaptive, HybridLinearAdaptive, and Linear variants.
#' (I.e., if N parameter sets are selected, then 5N scenarios are run.)
#'
#' This function is strictly for running the ensemble of models. Analysis
#' must be completed after the fact.
Expand Down Expand Up @@ -58,7 +58,7 @@ run_ensemble <- function(N = 500, aOutputDir = "./outputs", skip = 0,
message("****************************************************")

# Determine the number of parameters. If aDifferentiateParamByCrop = TRUE, then we have 3 parameters each for
# lagged share and linear years. If FALSE, then only one paramter for each. In both cases, there are 3 logit exponents
# lagged share and linear years. If FALSE, then only one parameter for each. In both cases, there are 3 logit exponents
if( aDifferentiateParamByCrop ) {
NPARAM <- 9
} else {
Expand Down Expand Up @@ -187,8 +187,8 @@ run_ensemble <- function(N = 500, aOutputDir = "./outputs", skip = 0,
#' Parameter combinations are selected by generating a quasi-random
#' sequence and mapping it to a specified range for each parameter.
#' Then, each parameter set is run through the offline land model in
#' each of the Perfect, Lagged, and Linear variants. (I.e., if N
#' parameter sets are selected, then 3N scenarios are run.)
#' each of the Perfect, Adaptive, HybridLinearAdaptive, HybridPerfectAdaptive, and Linear variants.
#' (I.e., if N parameter sets are selected, then 5N scenarios are run.)
#'
#' If the scenario type is "Hindcast", then after each model has been run, the
#' Bayesian analysis will be run so that its results can be stored with the rest
Expand Down Expand Up @@ -364,7 +364,7 @@ run_ensemble_bayes <- function(N = 500, aOutputDir = "./outputs", skip = 0,

#' Generate the ensemble members for a single set of parameters
#'
#' This generates one each of the Perfect, Lagged, and Linear scenario types
#' This generates one each of the Perfect, Adaptive, HybridLinearAdaptive, HybridPerfectAdaptive, and Linear scenario types
#' using the input parameters. The return value is a list of the three
#' \code{ScenarioInfo} objects for the scenarios generated.
#'
Expand Down Expand Up @@ -411,12 +411,12 @@ gen_ensemble_member <- function(agFor, agForNonPast, crop, share1, share2, share
aOutputDir = aOutputDir)


## Lagged scenario - without including current prices (i.e., y[i] = a*y[i-1] + (1-a)*x[i-1])
## Adaptive scenario - without including current prices (i.e., y[i] = a*y[i-1] + (1-a)*x[i-1])
share <- paste(share1, share2, share3, sep="-")
scenName <- getScenName(aScenType, "Lagged", share, agFor, agForNonPast, crop)
scenName <- getScenName(aScenType, "Adaptive", share, agFor, agForNonPast, crop)

lagscen <- ScenarioInfo(aScenarioType = aScenType,
aExpectationType = "Lagged",
aExpectationType = "Adaptive",
aLinearYears1 = NA,
aLinearYears2 = NA,
aLinearYears3 = NA,
Expand All @@ -433,12 +433,12 @@ gen_ensemble_member <- function(agFor, agForNonPast, crop, share1, share2, share
aSerialNum = serialnum+0.2,
aOutputDir = aOutputDir)

## Lagged scenario - with including current prices (i.e., y[i] = a*y[i-1] + (1-a)*x[i])
## HybridPerfectAdaptive scenario - with including current prices (i.e., y[i] = a*y[i-1] + (1-a)*x[i])
share <- paste(share1, share2, share3, sep="-")
scenName <- getScenName(aScenType, "LaggedCurr", share, agFor, agForNonPast, crop)
scenName <- getScenName(aScenType, "HybridPerfectAdaptive", share, agFor, agForNonPast, crop)

lagcurrscen <- ScenarioInfo(aScenarioType = aScenType,
aExpectationType = "LaggedCurr",
aExpectationType = "HybridPerfectAdaptive",
aLinearYears1 = NA,
aLinearYears2 = NA,
aLinearYears3 = NA,
Expand Down Expand Up @@ -479,9 +479,9 @@ gen_ensemble_member <- function(agFor, agForNonPast, crop, share1, share2, share
## mixed scenario, using linear for yield and adaptive for prices
linyears <- paste(linyears1, linyears2, linyears3, sep="-")
share <- paste(share1, share2, share3, sep="-")
scenName <- getScenName(aScenType, "Mixed", paste(linyears, share, sep="_"), agFor, agForNonPast, crop)
scenName <- getScenName(aScenType, "HybridLinearAdaptive", paste(linyears, share, sep="_"), agFor, agForNonPast, crop)
mixedscen <- ScenarioInfo(aScenarioType = aScenType,
aExpectationType = "Mixed",
aExpectationType = "HybridLinearAdaptive",
aLinearYears1 = linyears1,
aLinearYears2 = linyears2,
aLinearYears3 = linyears3,
Expand Down
2 changes: 1 addition & 1 deletion R/process_hindcast_data.R
Original file line number Diff line number Diff line change
Expand Up @@ -71,7 +71,7 @@ get_historic_yields <- function(){
#' @export
get_hindcast_AgProdChange <- function(aScenType){
# Silence package checks
year <- prev_year <- GCAM_commodity <- yield.x <- yield.y <- region <- AgProdChange <- NULL
year <- prev_year <- GCAM_commodity <- yield <- yield.x <- yield.y <- region <- AgProdChange <- NULL

# Compute AgProdChange
if(aScenType != "Hindcast5yr") {
Expand Down
2 changes: 1 addition & 1 deletion data-raw/stats-testdata.R
Original file line number Diff line number Diff line change
Expand Up @@ -79,7 +79,7 @@ gen_stats_testdata <- function()
limits <- c(0, 6)
scentype <- 'Hindcast'
exptype1 <- 'Perfect'
exptype2 <- 'Lagged'
exptype2 <- 'Adaptive'

rn <- randtoolbox::sobol(Nsample, NPARAM)
p <- limits[1] + rn*(limits[2]-limits[1])
Expand Down

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

2 changes: 1 addition & 1 deletion man/gen_ensemble_member.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

2 changes: 1 addition & 1 deletion man/getScenName.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

4 changes: 2 additions & 2 deletions man/run_ensemble.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

4 changes: 2 additions & 2 deletions man/run_ensemble_bayes.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

Binary file modified tests/testthat/data/bayes-scenario-info.rds
Binary file not shown.
Loading

0 comments on commit be3d382

Please sign in to comment.