Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Update names of expectations to match paper #70

Merged
merged 1 commit into from
Oct 1, 2020
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
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