Skip to content

Commit

Permalink
Improve calcCropCalendar() and others for readability
Browse files Browse the repository at this point in the history
  • Loading branch information
Sara Minoli authored and Sara Minoli committed Aug 9, 2022
1 parent 4579bda commit c953584
Show file tree
Hide file tree
Showing 5 changed files with 106 additions and 49 deletions.
76 changes: 52 additions & 24 deletions cropCalendars/R/calcCropCalendars.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -26,49 +26,77 @@ calcCropCalendars <- function(lon = NULL,
mppet_diff <- mclimate$mppet_diff

# Seasonality type
seasonality <- calcSeasonality(mtemp, mprec, 10)
seasonality <- calcSeasonality(
monthly_temp = mtemp,
monthly_prec = mprec,
temp_min = 10
)

# Sowing date
sowing <- calcSowingDate(crop_parameters, mtemp, mppet, seasonality, lat)
sowing <- calcSowingDate(
croppar = crop_parameters,
monthly_temp = mtemp,
monthly_ppet = mppet,
seasonality = seasonality,
lat = lat
)

sowing_month <- sowing[["sowing_month"]]
sowing_day <- sowing[["sowing_doy"]]
sowing_season <- sowing[["sowing_season"]]

# Harvest date
harvest_rule <- calcHarvestRule(crop_parameters, mtemp, mppet, seasonality)
harvest_rule <- calcHarvestRule(
croppar = crop_parameters,
monthly_temp = mtemp,
monthly_ppet = mppet,
seasonality = seasonality
)

harvest_vector <- calcHarvestDateVector(crop_parameters, sowing_day,
sowing_season, mtemp, mppet,
mppet_diff)
harvest_vector <- calcHarvestDateVector(
croppar = crop_parameters,
sowing_date = sowing_day,
sowing_season = sowing_season,
monthly_temp = mtemp,
monthly_ppet = mppet,
monthly_ppet_diff = mppet_diff
)

harvest <- calcHarvestDate(crop_parameters, mtemp, sowing_day,
sowing_month, sowing_season, seasonality,
harvest_rule, harvest_vector)
harvest <- calcHarvestDate(
croppar = crop_parameters,
monthly_temp = mtemp,
sowing_date = sowing_day,
sowing_month = sowing_month,
sowing_season = sowing_season,
seasonality = seasonality,
harvest_rule = harvest_rule,
hd_vector = harvest_vector
)

harvest_day_rf <- harvest[["hd_rf"]]
harvest_day_ir <- harvest[["hd_ir"]]
harvest_reas_rf <- harvest[["harvest_reason_rf"]]
harvest_reas_ir <- harvest[["harvest_reason_ir"]]
harvest_reas_rf <- names(harvest[["harvest_reason_rf"]])
harvest_reas_ir <- names(harvest[["harvest_reason_ir"]])

# Growing period length
growpriod_rf <- calcGrowingPeriod(sowing_day, harvest_day_rf, 365)
growpriod_ir <- calcGrowingPeriod(sowing_day, harvest_day_ir, 365)

# Output table
pixel_df <- data.frame("lon" = rep(lon, 2),
"lat" = rep(lat, 2),
"cft_id" = rep(crop_parameters$cft_id, 2),
"crop" = rep(crop_parameters$crop_name, 2),
"irrigation" = c("Rainfed", "Irrigated"),
"seasonality_type" = rep(seasonality, 2),
"sowing_season" = rep(sowing_season, 2),
"sowing_month" = rep(sowing_month, 2),
"sowing_doy" = rep(sowing_day, 2),
"harvest_rule" = rep(harvest_rule, 2),
"harvest_reason" = c(harvest_reas_rf, harvest_reas_ir),
"maturity_doy" = c(harvest_day_rf, harvest_day_ir),
"growing_period" = c(growpriod_rf, growpriod_ir) )
pixel_df <- data.frame(
"lon" = rep(lon, 2),
"lat" = rep(lat, 2),
"crop" = rep(crop_parameters$crop_name, 2),
"irrigation" = c("Rainfed", "Irrigated"),
"seasonality_type" = rep(seasonality, 2),
"sowing_season" = rep(sowing_season, 2),
"sowing_month" = rep(sowing_month, 2),
"sowing_doy" = rep(sowing_day, 2),
"harvest_rule" = rep(names(harvest_rule), 2),
"harvest_reason" = c(harvest_reas_rf, harvest_reas_ir),
"maturity_doy" = c(harvest_day_rf, harvest_day_ir),
"growing_period" = c(growpriod_rf, growpriod_ir)
)

return(pixel_df)

Expand Down
45 changes: 35 additions & 10 deletions cropCalendars/R/calcHarvestRule.R
View file
Original file line number Diff line number Diff line change
@@ -1,7 +1,11 @@
#' @title Calculate harvest rule (Minoli et al., 2019)
#'
#' @export
calcHarvestRule <- function(croppar, monthly_temp, monthly_ppet, seasonality) {
calcHarvestRule <- function(croppar,
monthly_temp,
monthly_ppet,
seasonality
) {

# extract individual parameter names and values
for(i in colnames(croppar)) {
Expand All @@ -12,21 +16,42 @@ calcHarvestRule <- function(croppar, monthly_temp, monthly_ppet, seasonality) {
temp_min <- min(monthly_temp)

if (seasonality == "NO_SEASONALITY") {
if (temp_max <= temp_base_rphase) harvest_rule <- 1
else if (temp_max > temp_base_rphase & temp_max <= temp_opt_rphase) harvest_rule <- 4
else harvest_rule <- 7
if (temp_max <= temp_base_rphase) {
harvest_rule <- 1
names(harvest_rule) <- "t-low_no-seas"
} else if (temp_max > temp_base_rphase & temp_max <= temp_opt_rphase) {
harvest_rule <- 4
names(harvest_rule) <- "t-mid_no-seas"
} else {
harvest_rule <- 7
names(harvest_rule) <- "t-high_no-seas"
}
}

else if (seasonality == "PREC") {
if (temp_max <= temp_base_rphase) harvest_rule <- 2
else if (temp_max > temp_base_rphase & temp_max <= temp_opt_rphase) harvest_rule <- 5
else harvest_rule <- 8
if (temp_max <= temp_base_rphase) {
harvest_rule <- 2
names(harvest_rule) <- "t-low_prec-seas"
} else if (temp_max > temp_base_rphase & temp_max <= temp_opt_rphase) {
harvest_rule <- 5
names(harvest_rule) <- "t-mid_prec-seas"
} else {
harvest_rule <- 8
names(harvest_rule) <- "t-high_prec-seas"
}
}

else {
if (temp_max <= temp_base_rphase) harvest_rule <- 3
else if (temp_max > temp_base_rphase & temp_max <= temp_opt_rphase) harvest_rule <- 6
else harvest_rule <- 9
if (temp_max <= temp_base_rphase) {
harvest_rule <- 3
names(harvest_rule) <- "t-low_mix-seas"
} else if (temp_max > temp_base_rphase & temp_max <= temp_opt_rphase) {
harvest_rule <- 6
names(harvest_rule) <- "t-mid_mix-seas"
} else {
harvest_rule <- 9
names(harvest_rule) <- "t-high_mix-seas"
}
}

return(harvest_rule)
Expand Down
10 changes: 5 additions & 5 deletions cropCalendars/R/calcVrf.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -12,11 +12,11 @@
#' @param tv3 vern.temp.opt.max
#' @param tv4 vern.temp.max

calcVrf <- function(sdate = NA,
hdate = NA,
mdt = rep(NA, 365),
vd = 0,
vd_b = 0.2,
calcVrf <- function(sdate = NA,
hdate = NA,
mdt = rep(NA, 365),
vd = 0,
vd_b = 0.2,
max.vern.days = 70,
max.vern.months = 5,
tv1 = -4,
Expand Down
12 changes: 7 additions & 5 deletions cropCalendars/R/getCropParam.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,9 +2,9 @@
#'
#' @export

getCropParam <- function(crops = NULL,
getCropParam <- function(crops = "all",
cropparam_file = NULL,
print_all = FALSE
print_all_par = FALSE
) {
# If not specified, read default parameter file
if (is.null(cropparam_file)) {
Expand All @@ -15,9 +15,11 @@ getCropParam <- function(crops = NULL,
crop_parameters_all <- read.csv(cropparam_file,
header = T,
stringsAsFactors = F)
crop_parameters_all <- subset(crop_parameters_all,
crop_name %in% crops)
if (print_all) {
if (crops != "all") {
crop_parameters_all <- subset(crop_parameters_all,
crop_name %in% crops)
}
if (print_all_par) {
cat("Importing crop-parameter table ...",
"----------------------------------",
sep = "\n")
Expand Down
12 changes: 7 additions & 5 deletions cropCalendars/R/isWinterCrop.R
View file
Original file line number Diff line number Diff line change
@@ -1,15 +1,17 @@
#' @title Tests if given season should be classified as winter crop
#' @title Tests if a given growing season should be classified as winter crop
#'
#' @param start Sowing date as day of the year (DOY)
#' @param end Harvest (or maturity) date as day of the year (DOY)
#' @param tcm Temperature of the coldest month (deg C)
#' @param lat Latitude (decimal degrees)
#'
#' @details This is the rule suggested by Portman et al. 2010, slightly
#' changed in that <= 7 instead of 6°C is used.
#' @export
isWinterCrop <- function(start,
end,
tcm,
lat
isWinterCrop <- function(start = NULL,
end = NULL,
tcm = NULL,
lat = NULL
) {

# tcm = temp of coldest month
Expand Down

0 comments on commit c953584

Please sign in to comment.