yield_mod_r: Modifies input rasters by provided multipliers
In marcusspiegel/agroEcoTradeoff: Landuse Tradeoff analysis model

Description Usage Arguments Details Note See Also Examples

This is a raster-based version of this function.

1 2	yield_mod_r(inlist, ybetas, code, cropnames, write_out = FALSE, silent = TRUE)

`inlist`	Named list of input RasterBricks
`ybetas`	list of 2 rasters or 2 vectors providing yield modifications
`code`	Unique simulation code resulting from run_code function
`cropnames`	Names of simulated crops
`write_out`	FALSE (default) or TRUE: write modified standardized yields to disk
`silent`	Hide or show print statements (TRUE [default] or FALSE)

For ybetas, if rasters are provided, they should be as a single brick that maps the yield impacts of climate change/irrigation, or both, with 1 layer for each crop. Vectors can alternatively be provided that apply a uniform yield modification. A single value can be provided, in which case it will be recycled across all assessed crops, or a vector equal in length to the number of crops being analyzed can be used. The first element of ybeta can be treated as a climate change modifier, as a way to modify the potential yield of each crop to investigate, say, the spatial patterns that will result if yield achieve only half their potential. The second element should be reserved for testing irrigation effects, for the sake of good practice.

ybetas could also be used in future to test fertilizer-related yield modifications, thereby becoming a three parameter term. The write_out logic will need to be fixed for theified pp_curr and p_yield also

yield_mod_dt for data.table based version

rc <- run_code(input_key = "ZA")
il <- fetch_inputs(input_key = "ZA")  # fetch all necessary inputs
inlist <- il[c("p_yield", "pp_curr")]

# Wrong ybetas length
ybetas <- list(rep(0.75, nlayers(inlist[[1]])), c(0.9, 1))
ybeta <- yield_mod_r(inlist = inlist, ybetas = ybetas, code = rc)

# Correct ybetas (passed as vectors)
ybetas <- list(rep(0.75, nlayers(inlist[[1]])),
               rep(0.75, nlayers(inlist[[1]])))
ybeta <- yield_mod_r(inlist = inlist, ybetas = ybetas, code = rc,
                     cropnames = il$cropnames)

# Null modification passed
ybetas <- list(1, rep(1, 9))
ybeta2 <- yield_mod_r(inlist = inlist, ybetas = ybetas, code = rc,
                      cropnames = il$cropnames)  # wrong lengths
ybetas <- list(1, 1)
ybeta2 <- yield_mod_r(inlist = inlist, ybetas = ybetas, code = rc,
                      cropnames = il$cropnames)  # right lengths
# ybeta2$p_yield - inlist$p_yield  # zeroes, as they should be
ybetas <- list(rep(1, 9), rep(1, 9))
ybeta2 <- yield_mod_r(inlist = inlist, ybetas = ybetas, code = rc,
                      cropnames = il$cropnames)
# ybeta2$p_yield - inlist$p_yield  # zeroes, as they should be

# ybetas as rasters
dfact <- c(0.9, 1.2)
ybetas <- lapply(1:2, function(x) {
 r <- inlist[[1]]  # recycling
 r[] <- rnorm(n = ncell(r), mean = dfact[x], sd = 0.05)
 mask(r, inlist[[1]])
})
ybeta3 <- yield_mod_r(inlist = inlist, ybetas = ybetas, code = rc,
                      cropnames = il$cropnames)
ybeta3$p_yield - (ybetas[[1]] * ybetas[[2]] * inlist$p_yield)  # zeroes

# Raster modifier X vector
ybetas[[2]] <- c(0.9, 0.9)
ybeta3 <- yield_mod_r(inlist = inlist, ybetas = ybetas, code = rc, cropnames = il$cropnames)  # wrong lengths
ybetas[[2]] <- c(1)
ybeta3 <- yield_mod_r(inlist = inlist, ybetas = ybetas, code = rc,
                      cropnames = il$cropnames)  # wrong lengths
ybetas[[2]] <- rep(1.25, nlayers(inlist[[1]]))
ybeta4 <- yield_mod_r(inlist = inlist, ybetas = ybetas, code = rc,
                      cropnames = il$cropnames)
ybeta4$p_yield - (ybetas[[1]] * 1.25 * inlist$p_yield)  # zeroes

# Compare yield_mod_dt with yield_mod_r
# set up dt inputs first
dang <- Sys.time()
inlist2 <- raster_list_to_dt(inlist = inlist)
ybetas <- list(rep(0.75, nlayers(inlist[[1]])),
               rep(0.75, nlayers(inlist[[1]])))
ybeta_dt1 <- yield_mod_dt(inlist = inlist2[[2]], ybetas = ybetas,
                          code = rc, cropnames = il$cropnames)
ybeta_dt1_y_std <- dt_to_raster(cbind(inlist2[[1]], ybeta_dt1$y_std),
                                CRSobj = projection(il$currprod))
Sys.time() - dang  # 0.92 seconds

# versus 6 seconds for raster based version (probably much faster in memory,
# to be fair)
system.time(ybeta <- yield_mod_r(inlist = inlist, ybetas = ybetas,
                                 code = rc, cropnames = il$cropnames))
round(ybeta_dt1_y_std[[2:10]], 7) - round(ybeta$y_std, 7)
# the same, but for very small rounding (R Inferno)
plot(round(ybeta_dt1_y_std[[2:10]], 9) - round(ybeta$y_std, 9))
# ...due to very minor rounding (R Inferno)