Skip to content

Fix CLEANED app and batch output compatibility #34

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.

Sign up for GitHub

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

Open
M-Emmanuel wants to merge 1 commit into
base: staging
Choose a base branch
from
Open

Fix CLEANED app and batch output compatibility #34

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
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
225 changes: 195 additions & 30 deletions R/differences.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -44,8 +44,95 @@ calculate_differences <- function(outFile,...){
if (length(outputList) == 0) {

stop("No files in source directory")
}

} else {
# ---------------------------------------------------------------------------
# Helpers
# ---------------------------------------------------------------------------
scalar_num <- function(x, default = NA_real_) {
if (is.null(x) || length(x) == 0) return(default)
if (is.data.frame(x) || is.list(x)) return(default)
x <- suppressWarnings(as.numeric(x[1]))
if (length(x) == 0 || !is.finite(x)) return(default)
x
}

scalar_chr <- function(x, default = NA_character_) {
if (is.null(x) || length(x) == 0) return(default)
x <- as.character(x[1])
if (length(x) == 0 || is.na(x) || x == "") return(default)
x
}

safe_div <- function(num, den, default = 0) {
num <- scalar_num(num, default = NA_real_)
den <- scalar_num(den, default = NA_real_)

if (is.na(num) || is.na(den)) return(NA_real_)
if (den == 0) return(default)

num / den
}

safe_sum_vec <- function(x, default = NA_real_) {
if (is.null(x) || length(x) == 0) return(default)
x <- suppressWarnings(as.numeric(x))
x[!is.finite(x)] <- NA_real_
s <- sum(x, na.rm = TRUE)
if (is.nan(s) || !is.finite(s)) return(default)
s
}

get_section <- function(output, nm) {
if (is.null(output) || !is.list(output) || !nm %in% names(output) || is.null(output[[nm]])) {
return(data.frame())
}
x <- output[[nm]]
if (is.data.frame(x)) return(x)
tryCatch(as.data.frame(x), error = function(e) data.frame())
}

get_nested_section <- function(output, nm1, nm2) {
if (is.null(output) || !is.list(output) || !nm1 %in% names(output) || is.null(output[[nm1]])) {
return(data.frame())
}
sec <- output[[nm1]]
if (!is.list(sec) || !nm2 %in% names(sec) || is.null(sec[[nm2]])) {
return(data.frame())
}
x <- sec[[nm2]]
if (is.data.frame(x)) return(x)
tryCatch(as.data.frame(x), error = function(e) data.frame())
}

get_named_value <- function(df, name_col = "Names", value_col = "Value", target, default = NA_real_) {
if (!is.data.frame(df) || nrow(df) == 0 || !name_col %in% names(df) || !value_col %in% names(df)) {
return(default)
}
idx <- which(as.character(df[[name_col]]) == target)
if (length(idx) == 0) return(default)
scalar_num(df[[value_col]][idx[1]], default = default)
}

get_row_value <- function(df, filter_col, filter_value, value_col, default = NA_real_) {
if (!is.data.frame(df) || nrow(df) == 0 ||
!filter_col %in% names(df) || !value_col %in% names(df)) {
return(default)
}
idx <- which(as.character(df[[filter_col]]) == filter_value)
if (length(idx) == 0) return(default)
scalar_num(df[[value_col]][idx[1]], default = default)
}

get_last_row_value <- function(df, filter_col, filter_value, value_col, default = NA_real_) {
if (!is.data.frame(df) || nrow(df) == 0 ||
!filter_col %in% names(df) || !value_col %in% names(df)) {
return(default)
}
idx <- which(as.character(df[[filter_col]]) == filter_value)
if (length(idx) == 0) return(default)
scalar_num(df[[value_col]][idx[length(idx)]], default = default)
}

scenarioList <- list()

Expand All @@ -55,35 +142,113 @@ calculate_differences <- function(outFile,...){

output <- jsonlite::fromJSON(outputList[[i]], flatten = TRUE)

# Productivity
total_milk_produced_kg_fpcm_per_year <- as.numeric(output[["livestock_productivity"]][["consumable_livestock_product"]][output[["livestock_productivity"]][["consumable_livestock_product"]]$produced_item == "Milk (FPCM)","production_kg_per_year"][3])
total_meat_produced_kg_per_year <- as.numeric(output[["livestock_productivity"]][["consumable_livestock_product"]][output[["livestock_productivity"]][["consumable_livestock_product"]]$produced_item == "Meat","production_kg_per_year"][3])
total_protein_produced_kg_per_year <- as.numeric(output[["livestock_productivity"]][["consumable_livestock_product"]][output[["livestock_productivity"]][["consumable_livestock_product"]]$produced_item == "Milk (FPCM)","protein_kg_per_year"][3]) +
as.numeric(output[["livestock_productivity"]][["consumable_livestock_product"]][output[["livestock_productivity"]][["consumable_livestock_product"]]$produced_item == "Meat","protein_kg_per_year"][3])
total_tlu <- sum(output[["livestock_productivity"]][["manure_produced"]]$tlu, na.rm = T)

# Land requirement
total_land_requirement_ha <- as.numeric(output[["land_required"]][["land_and_dm_required"]][output[["land_required"]][["land_and_dm_required"]]$Names == "total_area_used_for_feed_production_ha","Value"])
total_land_requirement_ha_per_kg_fpcm <- ifelse(!is.finite(total_land_requirement_ha/total_milk_produced_kg_fpcm_per_year),0,total_land_requirement_ha/total_milk_produced_kg_fpcm_per_year)*1000
total_land_requirement_ha_per_kg_meat <- ifelse(!is.finite(total_land_requirement_ha/total_meat_produced_kg_per_year),0,total_land_requirement_ha/total_meat_produced_kg_per_year)*1000
total_land_requirement_ha_per_kg_protein <- ifelse(!is.finite(total_land_requirement_ha/total_protein_produced_kg_per_year),0,total_land_requirement_ha/total_protein_produced_kg_per_year)*1000
total_land_requirement_ha_per_tlu <- ifelse(!is.finite(total_land_requirement_ha/total_tlu),0,total_land_requirement_ha/total_tlu)

# N balance
total_n_balance_kg_n_per_year <- output[["soil_impacts"]][["overal_soil_impact"]][output[["soil_impacts"]][["overal_soil_impact"]]$sources == "total", "balance_N_kg_N_year"]
percent_area_mining <- output[["soil_impacts"]][["overal_soil_impact"]][output[["soil_impacts"]][["overal_soil_impact"]]$sources == "total", "percent_area_mining"]
percent_area_leaching <- output[["soil_impacts"]][["overal_soil_impact"]][output[["soil_impacts"]][["overal_soil_impact"]]$sources == "total", "percent_area_leaching"]
n_balance_kg_n_per_ha_per_year <- ifelse(!is.finite(total_n_balance_kg_n_per_year/total_land_requirement_ha),0,total_n_balance_kg_n_per_year/total_land_requirement_ha)
n_balance_kg_n_per_kg_fpcm <- ifelse(!is.finite(total_n_balance_kg_n_per_year/total_milk_produced_kg_fpcm_per_year),0,total_n_balance_kg_n_per_year/total_milk_produced_kg_fpcm_per_year)
n_balance_kg_n_per_kg_meat <- ifelse(!is.finite(total_n_balance_kg_n_per_year/total_meat_produced_kg_per_year),0,total_n_balance_kg_n_per_year/total_meat_produced_kg_per_year)
n_balance_kg_n_per_kg_protein <- ifelse(!is.finite(total_n_balance_kg_n_per_year/total_protein_produced_kg_per_year),0,total_n_balance_kg_n_per_year/total_protein_produced_kg_per_year)

# Soil Erosion
erosion_t_soil_year <- output[["soil_impacts"]][["overal_soil_impact"]][output[["soil_impacts"]][["overal_soil_impact"]]$sources == "total", "erosion_t_soil_year"]
erosion_t_soil_per_ha_per_year <- ifelse(!is.finite(erosion_t_soil_year/total_land_requirement_ha),0,erosion_t_soil_year/total_land_requirement_ha)
erosion_kgsoil_per_kg_fpcm <- ifelse(!is.finite(erosion_t_soil_year/total_milk_produced_kg_fpcm_per_year), 0, erosion_t_soil_year/total_milk_produced_kg_fpcm_per_year)*1000
erosion_kgsoil_per_kg_meat <- ifelse(!is.finite(erosion_t_soil_year/total_meat_produced_kg_per_year), 0, erosion_t_soil_year/total_meat_produced_kg_per_year)*1000
erosion_kgsoil_per_kg_protein <- ifelse(!is.finite(erosion_t_soil_year/total_protein_produced_kg_per_year), 0, erosion_t_soil_year/total_protein_produced_kg_per_year)*1000
# -------------------------------------------------------------------------
# Read sections safely
# -------------------------------------------------------------------------
# Newer combineOutputs structure
consumable_livestock_product <- get_section(output, "consumable_livestock_product")
manure_produced <- get_section(output, "manure_produced")
land_and_dm_required <- get_section(output, "land_dmi_required")
ghg_balance <- get_section(output, "ghg_balance")
global_warming_potential <- get_section(output, "global_warming_potential")
water_use_for_production <- get_section(output, "water_use_for_production")
nitrogen_balance <- get_section(output, "nitrogen_balance")
soil_erosion_detail <- get_section(output, "soil_erosion_detail")
soil_carbon <- get_section(output, "soil_carbon")
biomass <- get_section(output, "biomass")

# Backward-compatible older structure
old_consumable_livestock_product <- get_nested_section(output, "livestock_productivity", "consumable_livestock_product")
old_manure_produced <- get_nested_section(output, "livestock_productivity", "manure_produced")
old_land_and_dm_required <- get_nested_section(output, "land_required", "land_and_dm_required")
old_overall_soil_impact <- get_nested_section(output, "soil_impacts", "overal_soil_impact")
old_ghg_balance <- get_nested_section(output, "ghg_emission", "ghg_balance")
old_water_use_for_production <- get_nested_section(output, "water_required", "water_use_for_production")

# -------------------------------------------------------------------------
# Productivity
# -------------------------------------------------------------------------
if (nrow(consumable_livestock_product) > 0 && "total_milk" %in% names(consumable_livestock_product)) {
total_milk_produced_kg_fpcm_per_year <- scalar_num(consumable_livestock_product$total_milk)
total_meat_produced_kg_per_year <- scalar_num(consumable_livestock_product$total_meat)
total_protein_produced_kg_per_year <- scalar_num(consumable_livestock_product$total_protein_milk) +
scalar_num(consumable_livestock_product$total_protein_meat)
total_milk_produced_energy_kcal_per_year <- scalar_num(consumable_livestock_product$total_energy_milk)
total_meat_produced_energy_kcal_per_year <- scalar_num(consumable_livestock_product$total_energy_meat)
total_tlu <- scalar_num(consumable_livestock_product$total_tlu)
} else {
total_milk_produced_kg_fpcm_per_year <- get_row_value(old_consumable_livestock_product, "produced_item", "Milk (FPCM)", "production_kg_per_year")
total_meat_produced_kg_per_year <- get_row_value(old_consumable_livestock_product, "produced_item", "Meat", "production_kg_per_year")
total_protein_produced_kg_per_year <-
get_row_value(old_consumable_livestock_product, "produced_item", "Milk (FPCM)", "protein_kg_per_year", default = 0) +
get_row_value(old_consumable_livestock_product, "produced_item", "Meat", "protein_kg_per_year", default = 0)
total_milk_produced_energy_kcal_per_year <- get_row_value(old_consumable_livestock_product, "produced_item", "Milk (FPCM)", "production_energy_kcal_per_year")
total_meat_produced_energy_kcal_per_year <- get_row_value(old_consumable_livestock_product, "produced_item", "Meat", "production_energy_kcal_per_year")
total_tlu <- safe_sum_vec(old_manure_produced$tlu)
}

total_milk_produced_ame_days_per_year <- safe_div(total_milk_produced_energy_kcal_per_year, 2100)
total_meat_produced_ame_days_per_year <- safe_div(total_meat_produced_energy_kcal_per_year, 2100)

# -------------------------------------------------------------------------
# Land requirement
# -------------------------------------------------------------------------
if (nrow(land_and_dm_required) > 0) {
total_land_requirement_ha <- get_named_value(
land_and_dm_required,
target = "total_area_used_for_feed_production_ha"
)
} else {
total_land_requirement_ha <- get_named_value(
old_land_and_dm_required,
target = "total_area_used_for_feed_production_ha"
)
}

total_land_requirement_ha_per_kg_fpcm <- safe_div(total_land_requirement_ha, total_milk_produced_kg_fpcm_per_year) * 1000
total_land_requirement_ha_per_kg_meat <- safe_div(total_land_requirement_ha, total_meat_produced_kg_per_year) * 1000
total_land_requirement_ha_per_kg_protein <- safe_div(total_land_requirement_ha, total_protein_produced_kg_per_year) * 1000
total_land_requirement_ha_per_tlu <- safe_div(total_land_requirement_ha, total_tlu)

# -------------------------------------------------------------------------
# N balance
# -------------------------------------------------------------------------
if (nrow(nitrogen_balance) > 0 && "nbalance_kg_n_total" %in% names(nitrogen_balance)) {
total_n_balance_kg_n_per_year <- safe_sum_vec(nitrogen_balance$nbalance_kg_n_total)
percent_area_mining <- safe_div(
safe_sum_vec(nitrogen_balance$area_mining, default = 0),
safe_sum_vec(nitrogen_balance$area_total, default = 0),
default = 0
) * 100
percent_area_leaching <- safe_div(
safe_sum_vec(nitrogen_balance$area_leaching, default = 0),
safe_sum_vec(nitrogen_balance$area_total, default = 0),
default = 0
) * 100
} else {
total_n_balance_kg_n_per_year <- get_row_value(old_overall_soil_impact, "sources", "total", "balance_N_kg_N_year")
percent_area_mining <- get_row_value(old_overall_soil_impact, "sources", "total", "percent_area_mining")
percent_area_leaching <- get_row_value(old_overall_soil_impact, "sources", "total", "percent_area_leaching")
}

n_balance_kg_n_per_ha_per_year <- safe_div(total_n_balance_kg_n_per_year, total_land_requirement_ha)
n_balance_kg_n_per_kg_fpcm <- safe_div(total_n_balance_kg_n_per_year, total_milk_produced_kg_fpcm_per_year)
n_balance_kg_n_per_kg_meat <- safe_div(total_n_balance_kg_n_per_year, total_meat_produced_kg_per_year)
n_balance_kg_n_per_kg_protein <- safe_div(total_n_balance_kg_n_per_year, total_protein_produced_kg_per_year)

# -------------------------------------------------------------------------
# Soil erosion
# -------------------------------------------------------------------------
if (nrow(soil_erosion_detail) > 0 && "soil_loss_plot" %in% names(soil_erosion_detail)) {
erosion_t_soil_year <- safe_sum_vec(soil_erosion_detail$soil_loss_plot)
} else {
erosion_t_soil_year <- get_row_value(old_overall_soil_impact, "sources", "total", "erosion_t_soil_year")
}

erosion_t_soil_per_ha_per_year <- safe_div(erosion_t_soil_year, total_land_requirement_ha)
erosion_kgsoil_per_kg_fpcm <- safe_div(erosion_t_soil_year, total_milk_produced_kg_fpcm_per_year) * 1000
erosion_kgsoil_per_kg_meat <- safe_div(erosion_t_soil_year, total_meat_produced_kg_per_year) * 1000
erosion_kgsoil_per_kg_protein <- safe_div(erosion_t_soil_year, total_protein_produced_kg_per_year) * 1000

# GHG emission
ghg_emission_t_co2_eq_per_year <- sum(as.numeric(output[["ghg_emission"]][["ghg_balance"]]$value),na.rm = T)
Expand Down
Loading