diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml deleted file mode 100644 index 90e4af90..00000000 --- a/.github/workflows/test-coverage.yaml +++ /dev/null @@ -1,63 +0,0 @@ -# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples -# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help -on: - push: - branches: [main, master] - pull_request: - -name: test-coverage.yaml - -permissions: read-all - -jobs: - test-coverage: - runs-on: ubuntu-latest - env: - GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} - USE_RENV: "FALSE" - - steps: - - uses: actions/checkout@v4 - - - uses: r-lib/actions/setup-r@v2 - with: - use-public-rspm: true - - - uses: r-lib/actions/setup-r-dependencies@v2 - with: - extra-packages: any::covr, any::xml2 - needs: coverage - - - name: Test coverage - run: | - cov <- covr::package_coverage( - quiet = FALSE, - clean = FALSE, - install_path = file.path(normalizePath(Sys.getenv("RUNNER_TEMP"), winslash = "/"), "package") - ) - print(cov) - covr::to_cobertura(cov) - shell: Rscript {0} - - - uses: codecov/codecov-action@v5 - with: - # Fail if error if not on PR, or if on PR and token is given - fail_ci_if_error: ${{ github.event_name != 'pull_request' || secrets.CODECOV_TOKEN }} - files: ./cobertura.xml - plugins: noop - disable_search: true - token: ${{ secrets.CODECOV_TOKEN }} - - - name: Show testthat output - if: always() - run: | - ## -------------------------------------------------------------------- - find '${{ runner.temp }}/package' -name 'testthat.Rout*' -exec cat '{}' \; || true - shell: bash - - - name: Upload test results - if: failure() - uses: actions/upload-artifact@v4 - with: - name: coverage-test-failures - path: ${{ runner.temp }}/package diff --git a/NAMESPACE b/NAMESPACE index f75e7ea7..e447df74 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -8,6 +8,15 @@ export(add_item_cbs_name) export(add_item_prod_code) export(add_item_prod_name) export(build_supply_use) +export(calculate_nue_crops) +export(calculate_nue_livestock) +export(calculate_system_nue) +export(create_grafs_plot_df) +export(create_n_nat_destiny) +export(create_n_nat_consumption_comparison) +export(create_n_production) +export(create_n_prov_destiny) +export(create_n_soil_inputs) export(expand_trade_sources) export(get_bilateral_trade) export(get_faostat_data) diff --git a/R/grafs_plot_df.R b/R/grafs_plot_df.R new file mode 100644 index 00000000..670e4cf4 --- /dev/null +++ b/R/grafs_plot_df.R @@ -0,0 +1,1427 @@ +#' @title Create GRAFS plot dataset +#' +#' @description +#' Combines land input data and N flows from crops, livestock, imports, and +#' exports to generate a dataset of nitrogen (MgN) by province and year, to +#' create a GRAFS plot, offered by Alfredo Rodríguez. +#' +#' @return +#' A tibble containing province, year, label, data, and alignment. +#' +#' @export +create_grafs_plot_df <- function() { + prov_destiny_df <- create_n_prov_destiny() + nat_destiny_df <- create_n_nat_destiny() + + nat_destiny_df <- nat_destiny_df |> + dplyr::mutate(Province_name = "Spain") + + prov_destiny_df <- prov_destiny_df |> + dplyr::filter(Province_name != "Spain") |> + dplyr::bind_rows(nat_destiny_df) + + n_balance <- whep_read_file("n_balance_ygpit_all") + + df_land <- .create_land_df() + df_flow <- .create_n_flow_df(prov_destiny_df) + df_import <- .create_n_import_df(prov_destiny_df) + df_lu <- .create_livestock_lu_df() + df_population <- .create_population_df() + df_n_input <- .create_n_input_df(n_balance) + df_land_surplus <- .create_land_surplus_df(prov_destiny_df) + df_livestock <- .create_livestock_df(prov_destiny_df) + df_lv_r_m <- .create_feed_df(prov_destiny_df) + df_crop_losses <- .create_crop_losses_df(n_balance, prov_destiny_df) + df_animal_losses <- .create_animal_losses_df(prov_destiny_df) + df_livestock_export <- .create_livestock_export_df(prov_destiny_df) + df_milk <- .create_milk_df(prov_destiny_df) + df_livestock_total <- .create_livestock_total_df(prov_destiny_df) + + df_crplndtot <- df_flow |> + dplyr::filter( + province != "Spain", + label %in% + c( + "{CROP_EXPORT}", + "{CROPS_TO_POP}", + "{CROPS_TO_LIVESTOCK}" + ) + ) |> + dplyr::mutate(data = suppressWarnings(as.numeric(data))) |> + dplyr::group_by(province, year) |> + dplyr::summarise( + data = sum(data, na.rm = TRUE), + .groups = "drop" + ) |> + dplyr::mutate( + label = "{CRPLNDTOTN}", + align = "R" + ) + + df_crplndtot_spain <- df_flow |> + dplyr::filter( + province == "Spain", + label %in% c("{CROP_EXPORT}", "{CROPS_TO_POP}", "{CROPS_TO_LIVESTOCK}") + ) |> + dplyr::group_by(year) |> + dplyr::summarise(data = sum(data, na.rm = TRUE), .groups = "drop") |> + dplyr::mutate(province = "Spain", label = "{CRPLNDTOTN}", align = "R") + + df_crplndtot <- dplyr::bind_rows( + df_crplndtot, + df_crplndtot_spain + ) + + df_all_flows <- dplyr::bind_rows( + df_flow, + df_import, + df_livestock, + df_milk, + df_livestock_export, + df_lv_r_m, + df_crop_losses, + df_animal_losses + ) + + df_livestock_surplus <- .create_livestock_surplus_df(df_all_flows) + + df_combined <- .combine_and_finalize_df( + crop_livestock_flows = df_flow, + df_livestock = dplyr::bind_rows(df_livestock, df_milk, df_livestock_export), + df_lv_r_m = df_lv_r_m, + df_crop_losses = df_crop_losses, + df_animal_losses = df_animal_losses, + df_livestock_total = df_livestock_total, + df_livestock_surplus = df_livestock_surplus, + df_land_surplus = df_land_surplus + ) + + df_final <- dplyr::bind_rows( + df_land |> dplyr::mutate(data = as.character(data)), + df_combined, + df_import |> dplyr::mutate(data = as.character(data)), + df_lu |> dplyr::mutate(data = as.character(data)), + df_n_input |> dplyr::mutate(data = as.character(data)), + df_population |> dplyr::mutate(data = as.character(data)), + df_crplndtot |> dplyr::mutate(data = as.character(data)) + ) |> + dplyr::arrange(province, year, label) |> + dplyr::filter(!is.na(province) & !is.na(year)) |> + dplyr::mutate(arrowColor = "") |> + dplyr::select(province, year, label, data, align, arrowColor) + + n_labels <- c( + "{IMANOT}", + "{IMANOTR}", + "{IMANOTM}", + "{IMPHUMANMEAT}", + "{IMPHUMANEGGS}", + "{IMPHUMFISH}", + "{IMPHUMMILK}", + "{IMPORT_ANIMALCR}", + "{IMPORT_ANIMALCR_RUM}", + "{IMPORT_ANIMALCR_MONOG}", + "{CROP_POPIMPORT}", + "{IMPHMANA}", + "{CROP_EXPORT}", + "{CROPS_TO_POP}", + "{CROPS_TO_LIVESTOCK}", + "{LIVESTOCK_TO_HUMAN}", + "{GRASS_TO_LIVESTOCK}", + "{RCRTOLVSTCK_R}", + "{MCRTOLVSTCK_M}", + "{CRP_OTHUSES}", + "{AN_LS}", + "{AN_OTH}", + "{AN_LS_OTH}", + "{LV_EDBL}", + "{LVSTCK_NOEDIBLE}", + "{LVST_MILK}", + "{LIVESTOCK_EXPORTED}", + "{LVSTCKTOTN}", + "{OXDEPCROPS}", + "{FIXCR}", + "{LIVESTOCK_TO_CROPS}", + "{LIVESTOCK_TO_GRASS}", + "{OXDEPGRASS}", + "{SYF_GRASS}", + "{SYNTHF_TOTAL}", + "{SYNTHF}", + "{FIXGR}", + "{FIX_DEP_GRASS}", + "{FIX_DEP_CR}", + "{CROP_SURPLUS}", + "{GRASS_SURPLUS}", + "{LIVGASLOSS}", + "{WASTEWATER}", + "{CRPLNDTOTN}", + "{GREHN}", + "{FORN}", + "{PERiN}", + "{PERrN}", + "{HORiN}", + "{HORrN}", + "{NPEiN}", + "{NPErN}", + "{ARAiN}", + "{ARArN}" + ) + + df_final <- df_final |> + dplyr::mutate( + data = suppressWarnings( + ifelse( + label %in% n_labels, + as.numeric(data) / 1000, + as.numeric(data) + ) + ), + data = as.character(data) + ) + + missing_labels <- c( + "{FORha}", + "{FORMha}", + "{FORN}", + "{HAGRASS}", + "{HACULT}", + "{PERiN}", + "{PERrN}", + "{NPEiN}", + "{NPErN}", + "{GREHN}", + "{GREHMha}", + "{POPULATIONM}", + "{PERiMha}", + "{PERrMha}", + "{NPEiMha}", + "{NPErMha}", + "{RUMIANTSMLU}", + "{MONOGMLU}", + "{GRASSMha}", + "{HORiN}", + "{HORrN}", + "{ARAiN}", + "{ARArN}", + "{KM2_PROVINCE}", + "{AN_LS}", + "{AN_OTH}", + "{AN_LS_OTH}" + ) + + df_missing_spain <- df_final |> + dplyr::filter(province != "Spain") |> + dplyr::filter(label %in% missing_labels) |> + dplyr::mutate(data = as.numeric(data)) |> + dplyr::group_by(year, label) |> + dplyr::summarise(data = sum(data, na.rm = TRUE), .groups = "drop") |> + dplyr::mutate( + province = "Spain", + align = "R", + data = as.character(data) + ) + + df_final <- dplyr::bind_rows( + df_final, + df_missing_spain + ) + + non_additive_labels <- c( + "{YEAR}", + "{PROVINCE_NAME}", + "{WIDTH_MAX}", + "{FORha}", + "{FORMha}", + "{HAGRASS}", + "{HACULT}", + "{GREHha}", + "{GREHMha}", + "{PERiha}", + "{PERrha}", + "{HORiha}", + "{HORrha}", + "{NPEiha}", + "{NPErha}", + "{ARAiha}", + "{ARArha}", + "{PERiMha}", + "{PERrMha}", + "{HORiMha}", + "{HORrMha}", + "{NPEiMha}", + "{NPErMha}", + "{ARAiMha}", + "{ARArMha}", + "{RUMIANTSLU}", + "{RUMIANTSMLU}", + "{MONOGLU}", + "{MONOGMLU}", + "{POPULATIONM}", + "{KM2_PROVINCE}" + ) + + df_final <- df_final |> + dplyr::mutate(data_num = suppressWarnings(as.numeric(data))) |> + dplyr::group_by(province, year, label) |> + dplyr::summarise( + data = dplyr::case_when( + label %in% non_additive_labels & any(!is.na(data_num)) ~ + as.character(dplyr::first(data_num[!is.na(data_num)])), + label %in% non_additive_labels ~ dplyr::first(data), + all(is.na(data_num)) ~ dplyr::first(data), + TRUE ~ as.character(sum(data_num, na.rm = TRUE)) + ), + align = dplyr::first(align), + arrowColor = "", + .groups = "drop" + ) + + #Path needs to be adjusted by user, until the final version can be uploaded + #to SACO + readr::write_csv( + df_final, + "C:/PhD/GRAFS_plot/inst/extdata/GRAFS_spain_data.csv" + ) + + df_final +} + +#' @title Create nitrogen import dataset by province +#' +#' @description +#' Generates a dataset of nitrogen flows (MgN) by province and year, including +#' N soil inputs, production data, imports. +#' @param prov_destiny_df A data frame containing production and destiny +#' information. +#' +#' @return +#' A tibble with columns `province`, `year`, `label`, `data`, and `align`. +#' +#' @keywords internal +.create_n_import_df <- function(prov_destiny_df = NULL) { + if (is.null(prov_destiny_df)) { + prov_destiny_df <- create_n_prov_destiny() + } + + item_box_lookup <- whep_read_file("codes_coefs_items_full") |> + dplyr::select(item, group) |> + dplyr::filter(!is.na(item), !is.na(group)) |> + dplyr::distinct() |> + dplyr::group_by(item) |> + dplyr::summarise(group = dplyr::first(group), .groups = "drop") + + df_n_flows <- prov_destiny_df |> + dplyr::left_join(item_box_lookup, by = c("Item" = "item")) |> + dplyr::mutate( + Box_filled = dplyr::case_when( + Item %in% c("Holm oak", "Average wood") ~ + "semi_natural_agroecosystems", + Item == "Fallow" ~ "Cropland", + group %in% c("Crop products", "Primary crops", "crop residue") ~ + "Cropland", + group %in% c("Livestock products", "Livestock") ~ "Livestock", + group %in% c("Agro-industry", "Fish") ~ group, + !is.na(Box) ~ Box, + TRUE ~ NA_character_ + ) + ) |> + dplyr::mutate( + label = dplyr::case_when( + Box_filled == "Agro-industry" & + Origin == "Outside" & + Destiny == "livestock_rum" ~ + "{IMANOTR}", + Box_filled == "Agro-industry" & + Origin == "Outside" & + Destiny == "livestock_mono" ~ + "{IMANOTM}", + Item %in% + c( + "Milk - Excluding Butter", + "Milk, lactation", + "Whey", + "Butter, Ghee" + ) & + Origin == "Outside" & + Destiny %in% c("population_food", "population_other_uses") ~ + "{IMPHUMMILK}", + Item %in% + c( + "Bovine Meat", + "Mutton & Goat Meat", + "Pigmeat", + "Poultry Meat", + "Meat, Other", + "Offals, Edible" + ) & + Origin == "Outside" & + Destiny %in% c("population_food", "population_other_uses") ~ + "{IMPHUMANMEAT}", + Item == "Eggs" & + Origin == "Outside" & + Destiny %in% c("population_food", "population_other_uses") ~ + "{IMPHUMANEGGS}", + Box_filled == "Fish" & + Origin == "Outside" & + Destiny %in% c("population_food", "population_other_uses") ~ + "{IMPHUMFISH}", + Box_filled != "Agro-industry" & + Origin == "Outside" & + Destiny == "livestock_rum" ~ + "{IMPORT_ANIMALCR_RUM}", + Box_filled != "Agro-industry" & + Origin == "Outside" & + Destiny == "livestock_mono" ~ + "{IMPORT_ANIMALCR_MONOG}", + Origin == "Livestock" & + Destiny == "Cropland" ~ + "{LIVESTOCK_TO_CROPS}", + Origin == "Livestock" & + Destiny == "semi_natural_agroecosystems" ~ + "{LIVESTOCK_TO_GRASS}", + Origin == "Deposition" & + Destiny == "Cropland" ~ + "{OXDEPCROPS}", + Origin == "Fixation" & + Destiny == "Cropland" ~ + "{FIXCR}", + Origin == "Synthetic" & + Destiny == "Cropland" ~ + "{SYNTHF}", + Origin == "Deposition" & + Destiny == "semi_natural_agroecosystems" ~ + "{OXDEPGRASS}", + Origin == "Fixation" & + Destiny == "semi_natural_agroecosystems" ~ + "{FIXGR}", + Origin == "Synthetic" & + Destiny == "semi_natural_agroecosystems" ~ + "{SYF_GRASS}", + Origin == "People" ~ "{WASTEWATER}", + TRUE ~ NA_character_ + ) + ) |> + dplyr::filter(!is.na(label)) |> + dplyr::group_by(Province_name, Year, label) |> + dplyr::summarise(data = sum(MgN, na.rm = TRUE), .groups = "drop") + + df_crop_popimport <- prov_destiny_df |> + dplyr::filter( + Box == "Cropland", + Origin == "Outside", + Destiny %in% c("population_food", "population_other_uses") + ) |> + dplyr::group_by(Province_name, Year) |> + dplyr::summarise(data = sum(MgN, na.rm = TRUE), .groups = "drop") |> + dplyr::mutate( + label = "{CROP_POPIMPORT}", + province = Province_name, + year = Year, + align = "R" + ) |> + dplyr::select(province, year, label, data, align) + + df_fix_dep_cr <- df_n_flows |> + dplyr::filter(label %in% c("{OXDEPCROPS}", "{FIXCR}")) |> + dplyr::group_by(Province_name, Year) |> + dplyr::summarise(data = sum(data), .groups = "drop") |> + dplyr::mutate(label = "{FIX_DEP_CR}") + + df_fix_dep_grass <- df_n_flows |> + dplyr::filter(label %in% c("{OXDEPGRASS}", "{FIXGR}")) |> + dplyr::group_by(Province_name, Year) |> + dplyr::summarise(data = sum(data), .groups = "drop") |> + dplyr::mutate(label = "{FIX_DEP_GRASS}") + + df_import_animalcr <- df_n_flows |> + dplyr::filter( + label %in% c("{IMPORT_ANIMALCR_RUM}", "{IMPORT_ANIMALCR_MONOG}") + ) |> + dplyr::group_by(Province_name, Year) |> + dplyr::summarise(data = sum(data), .groups = "drop") |> + dplyr::mutate(label = "{IMPORT_ANIMALCR}") + + df_synth_total <- df_n_flows |> + dplyr::filter(label == "{SYNTHF}") |> + dplyr::mutate(label = "{SYNTHF_TOTAL}") + + df_imanot <- df_n_flows |> + dplyr::filter(label %in% c("{IMANOTR}", "{IMANOTM}")) |> + dplyr::group_by(Province_name, Year) |> + dplyr::summarise(data = sum(data), .groups = "drop") |> + dplyr::mutate(label = "{IMANOT}") + + df_n_flows <- dplyr::bind_rows( + df_n_flows, + df_fix_dep_cr, + df_fix_dep_grass, + df_import_animalcr, + df_synth_total, + df_imanot + ) |> + dplyr::mutate( + province = Province_name, + year = Year, + align = "L" + ) |> + dplyr::select(province, year, label, data, align) + + right_labels <- c( + "{CROP_POPIMPORT}", + "{IMPORT_ANIMALCR_RUM}", + "{IMPORT_ANIMALCR_MONOG}", + "{IMPORT_ANIMALCR}", + "{IMANOTR}", + "{IMANOTM}", + "{IMANOT}" + ) + + df_imphmana <- prov_destiny_df |> + dplyr::filter( + Origin == "Outside", + Destiny %in% c("population_food", "population_other_uses"), + Box %in% c("Livestock", "Fish") + ) |> + dplyr::group_by(Province_name, Year) |> + dplyr::summarise(data = sum(MgN, na.rm = TRUE), .groups = "drop") |> + dplyr::mutate( + label = "{IMPHMANA}", + province = Province_name, + year = Year, + align = "L" + ) |> + dplyr::select(province, year, label, data, align) + + df_n_flows <- dplyr::bind_rows( + df_n_flows, + df_imphmana, + df_crop_popimport + ) + + df_n_flows <- df_n_flows |> + tidyr::complete( + province, + year, + label, + fill = list(data = 0, align = "L") + ) |> + dplyr::mutate( + align = dplyr::case_when( + label %in% right_labels ~ "R", + TRUE ~ "L" + ) + ) + + df_n_flows +} + + +#' @title Create Livestock LU (Livestock Units) dataset +#' +#' @description +#' Calculated livestock units (LU) by province and year for ruminants and +#' monogastric animals. +#' Converts stock numbers into standardized LU values using conversion factors. +#' +#' @return +#' A tibble with columns `province`, `year`, `label`, `data`, and `align`. +#' +#' @keywords internal +.create_livestock_lu_df <- function() { + livestock_lu <- whep_read_file("livestock_prod_ygps") + lu_lookup <- whep_read_file("livestock_units") + + df_lu <- livestock_lu |> + dplyr::select( + Province_name, + Year, + Livestock_cat, + Stock_Number + ) |> + dplyr::distinct() |> + dplyr::left_join( + lu_lookup, + by = "Livestock_cat" + ) |> + dplyr::filter(!is.na(LU_head), system %in% c("ruminant", "monogastric")) |> + dplyr::mutate( + LU = Stock_Number * LU_head + ) |> + dplyr::group_by(Province_name, Year, system) |> + dplyr::summarise(LU = sum(LU, na.rm = TRUE), .groups = "drop") |> + tidyr::pivot_wider( + names_from = system, + values_from = LU, + values_fill = 0 + ) |> + dplyr::mutate( + `{RUMIANTSLU}` = ruminant, + `{RUMIANTSMLU}` = ruminant / 1e6, + `{MONOGLU}` = monogastric, + `{MONOGMLU}` = monogastric / 1e6 + ) |> + dplyr::select( + province = Province_name, + year = Year, + `{RUMIANTSLU}`, + `{RUMIANTSMLU}`, + `{MONOGLU}`, + `{MONOGMLU}` + ) |> + tidyr::pivot_longer( + cols = -c(province, year), + names_to = "label", + values_to = "data" + ) |> + dplyr::mutate(align = "R") + + df_lu +} + +#' @title Create land dataset by province +#' +#' @description +#' Generates a dataset of land use by province and year of cropland (permanent +#' and non permanent), horticulture, and forest area for N and area (ha), +#' separated into irrigated and rainfed. +#' +#' @return +#' A tibble with columns `province`, `year`, `label`, `data`, and `align`. +#' +#' @keywords internal +.create_land_df <- function() { + n_balance <- whep_read_file("n_balance_ygpit_all") + crop_lookup <- whep_read_file("grafs_crop_categories") + + permanent_biomass <- crop_lookup |> + dplyr::filter(crop_type == "permanent") |> + dplyr::pull(Name_biomass) + + horticulture_biomass <- crop_lookup |> + dplyr::filter(crop_type == "horticulture") |> + dplyr::pull(Name_biomass) + + non_permanent_biomass <- crop_lookup |> + dplyr::filter(crop_type == "non_permanent") |> + dplyr::pull(Name_biomass) + + df_land <- n_balance |> + dplyr::filter( + LandUse %in% c("Cropland", "Forest_low", "Forest_high", "Dehesa") + ) |> + dplyr::group_by(Province_name, Year) |> + dplyr::summarise( + FORha = sum( + Area_ygpit_ha[LandUse %in% c("Forest_low", "Forest_high", "Dehesa")], + na.rm = TRUE + ), + FORMha = FORha / 1e6, + FORN = sum( + (Prod_MgN + UsedResidue_MgN + GrazedWeeds_MgN)[ + LandUse %in% c("Forest_low", "Forest_high", "Dehesa") + ], + na.rm = TRUE + ), + + PERiha = sum( + Area_ygpit_ha[ + LandUse == "Cropland" & + Name_biomass %in% permanent_biomass & + Irrig_cat == "Irrigated" + ], + na.rm = TRUE + ), + PERrha = sum( + Area_ygpit_ha[ + LandUse == "Cropland" & + Name_biomass %in% permanent_biomass & + Irrig_cat == "Rainfed" + ], + na.rm = TRUE + ), + PERiMha = PERiha / 1e6, + PERrMha = PERrha / 1e6, + PERiN = sum( + (Prod_MgN + UsedResidue_MgN + GrazedWeeds_MgN)[ + LandUse == "Cropland" & + Name_biomass %in% permanent_biomass & + Irrig_cat == "Irrigated" + ], + na.rm = TRUE + ), + PERrN = sum( + (Prod_MgN + UsedResidue_MgN + GrazedWeeds_MgN)[ + LandUse == "Cropland" & + Name_biomass %in% permanent_biomass & + Irrig_cat == "Rainfed" + ], + na.rm = TRUE + ), + + HORiha = sum( + Area_ygpit_ha[ + LandUse == "Cropland" & + Name_biomass %in% horticulture_biomass & + Irrig_cat == "Irrigated" + ], + na.rm = TRUE + ), + HORrha = sum( + Area_ygpit_ha[ + LandUse == "Cropland" & + Name_biomass %in% horticulture_biomass & + Irrig_cat == "Rainfed" + ], + na.rm = TRUE + ), + HORiMha = HORiha / 1e6, + HORrMha = HORrha / 1e6, + HORiN = sum( + (Prod_MgN + UsedResidue_MgN + GrazedWeeds_MgN)[ + LandUse == "Cropland" & + Name_biomass %in% horticulture_biomass & + Irrig_cat == "Irrigated" + ], + na.rm = TRUE + ), + HORrN = sum( + (Prod_MgN + UsedResidue_MgN + GrazedWeeds_MgN)[ + LandUse == "Cropland" & + Name_biomass %in% horticulture_biomass & + Irrig_cat == "Rainfed" + ], + na.rm = TRUE + ), + + NPEiha = sum( + Area_ygpit_ha[ + LandUse == "Cropland" & + Name_biomass %in% non_permanent_biomass & + Irrig_cat == "Irrigated" + ], + na.rm = TRUE + ), + NPErha = sum( + Area_ygpit_ha[ + LandUse == "Cropland" & + Name_biomass %in% non_permanent_biomass & + Irrig_cat == "Rainfed" + ], + na.rm = TRUE + ), + NPEiMha = NPEiha / 1e6, + NPErMha = NPErha / 1e6, + NPEiN = sum( + (Prod_MgN + UsedResidue_MgN + GrazedWeeds_MgN)[ + LandUse == "Cropland" & + Name_biomass %in% non_permanent_biomass & + Irrig_cat == "Irrigated" + ], + na.rm = TRUE + ), + NPErN = sum( + (Prod_MgN + UsedResidue_MgN + GrazedWeeds_MgN)[ + LandUse == "Cropland" & + Name_biomass %in% non_permanent_biomass & + Irrig_cat == "Rainfed" + ], + na.rm = TRUE + ), + + .groups = "drop" + ) |> + tidyr::pivot_longer( + -c(Province_name, Year), + names_to = "var", + values_to = "data" + ) |> + + dplyr::mutate( + label = paste0("{", var, "}"), + province = Province_name, + year = Year, + align = "R" + ) |> + dplyr::select(province, year, label, data, align) + + df_land +} + + +#' @title Create dataset for greeonhouse, grassland, and N soil input +#' +#' @description +#' Generates dataset for greenhouse, grasslands, total km2, surpluses. +#' Combines with crops/forest dataset. +#' +#' @return +#' A tibble with columns `province`, `year`, `label`, `data`, and `align`. +#' +#' @keywords internal +.create_n_input_df <- function(n_balance) { + n_balance |> + dplyr::group_by(Province_name, Year) |> + dplyr::summarise( + `{GREHha}` = sum(Area_ygpit_ha[Irrig_cat == "Greenhouse"], na.rm = TRUE), + `{GREHMha}` = `{GREHha}` / 1e6, + `{GREHN}` = sum( + Prod_MgN[Irrig_cat == "Greenhouse"] + + UsedResidue_MgN[Irrig_cat == "Greenhouse"] + + GrazedWeeds_MgN[Irrig_cat == "Greenhouse"], + na.rm = TRUE + ), + `{HAGRASS}` = sum( + Area_ygpit_ha[ + LandUse %in% + c( + "Dehesa", + "Forest_high", + "Forest_low", + "Other", + "Pasture_Shrubland" + ) + ], + na.rm = TRUE + ), + `{GRASSMha}` = `{HAGRASS}` / 1e6, + `{HACULT}` = sum(Area_ygpit_ha[LandUse == "Cropland"], na.rm = TRUE), + `{KM2_PROVINCE}` = sum(Area_ygpit_ha, na.rm = TRUE) / 100, + .groups = "drop" + ) |> + tidyr::pivot_longer( + -c(Province_name, Year), + names_to = "label", + values_to = "data" + ) |> + dplyr::select(province = Province_name, year = Year, label, data) |> + dplyr::mutate(align = "L") +} + + +#' @title Create land nitrogen surplus dataset (cropland & semi-natural systems) +#' +#' @description +#' Calculates nitrogen surplus for cropland and semi-natural agroecosystems +#' (grassland) by province and year. The surplus is calculated as the difference +#' between total nitrogen inputs and outputs. +#' Inputs include nitrogen from synthetic fertilizers, biological fixation, +#' atmospheric deposition, and livestock manure. +#' Outputs include nitrogen flows from cropland to population, livestock, +#' exports, and other uses. +#' +#' @param prov_destiny_df A data frame containing nitrogen flows with columns +#' such as `Origin`, `Destiny`, `Province_name`, `Year`, and `MgN`. +#' +#' @return +#' A tibble with columns: Province name, year, label (`{CROP_SURPLUS}` or `{GRASS_SURPLUS}`), nitrogen +#' surplus (MgN), and text alignment. +#' +#' @keywords internal +.create_land_surplus_df <- function(prov_destiny_df) { + inputs <- prov_destiny_df |> + dplyr::filter( + (Origin %in% + c("Synthetic", "Fixation", "Deposition", "Livestock") & + Destiny %in% c("Cropland", "semi_natural_agroecosystems")) + ) |> + dplyr::mutate( + system = dplyr::case_when( + Destiny == "Cropland" ~ "crop", + Destiny == "semi_natural_agroecosystems" ~ "grass" + ) + ) |> + dplyr::group_by(Province_name, Year, system) |> + dplyr::summarise(input = sum(MgN, na.rm = TRUE), .groups = "drop") + + outputs <- prov_destiny_df |> + dplyr::filter( + (Origin == "Cropland" & + Destiny %in% + c( + "population_food", + "population_other_uses", + "livestock_rum", + "livestock_mono", + "export" + )) | + (Origin == "semi_natural_agroecosystems" & + Destiny %in% + c( + "population_food", + "population_other_uses", + "livestock_rum", + "livestock_mono", + "export" + )) + ) |> + dplyr::mutate( + system = dplyr::case_when( + Origin == "Cropland" ~ "crop", + Origin == "semi_natural_agroecosystems" ~ "grass" + ) + ) |> + dplyr::group_by(Province_name, Year, system) |> + dplyr::summarise(output = sum(MgN, na.rm = TRUE), .groups = "drop") + + dplyr::full_join( + inputs, + outputs, + by = c("Province_name", "Year", "system") + ) |> + dplyr::mutate( + input = dplyr::coalesce(input, 0), + output = dplyr::coalesce(output, 0), + surplus = input - output, + label = dplyr::case_when( + system == "crop" ~ "{CROP_SURPLUS}", + system == "grass" ~ "{GRASS_SURPLUS}" + ), + province = Province_name, + year = Year, + align = "R" + ) |> + dplyr::select(province, year, label, data = surplus, align) +} + + +#' @title Create nitrogen flow dataset by province +#' +#' @description +#' Generates nitrogen flow data (MgN) by province and year, representing +#' @title Create nitrogen flow dataset by province +#' +#' @description +#' Generates nitrogen flow data (MgN) by province and year, representing +#' exchanges between cropland, livestock, grassland, population, and exports. +#' +#' @param prov_destiny_df A data frame containing production and destiny +#' information. +#' +#' @return A tibble with columns `province`, `year`, `label`, `data`, and +#' `align`. +#' +#' @keywords internal + +#' +#' @param prov_destiny_df A data frame containing production and destiny +#' information. +#' +#' @return A tibble with columns `province`, `year`, `label`, `data`, `align`. +#' +#' @keywords internal +.create_n_flow_df <- function(prov_destiny_df = NULL) { + if (is.null(prov_destiny_df)) { + prov_destiny_df <- create_n_prov_destiny() + } + + # --- Crop & livestock flows --- + crop_livestock_flows <- prov_destiny_df |> + dplyr::mutate( + label = dplyr::case_when( + Origin == "Cropland" & Destiny == "export" ~ "{CROP_EXPORT}", + Origin == "Cropland" & + Destiny %in% c("population_food", "population_other_uses") ~ + "{CROPS_TO_POP}", + Origin == "Cropland" & + Destiny %in% c("livestock_rum", "livestock_mono") ~ + "{CROPS_TO_LIVESTOCK}", + Origin == "Livestock" & + Destiny %in% c("population_food", "population_other_uses") ~ + "{LIVESTOCK_TO_HUMAN}", + Origin == "semi_natural_agroecosystems" & + Destiny %in% c("livestock_rum", "livestock_mono") ~ + "{GRASS_TO_LIVESTOCK}", + TRUE ~ NA_character_ + ) + ) |> + dplyr::filter(!is.na(label)) |> + dplyr::group_by(Province_name, Year, label) |> + dplyr::summarise(data = sum(MgN, na.rm = TRUE), .groups = "drop") |> + dplyr::mutate(align = "L") |> + dplyr::rename(province = Province_name, year = Year) |> + tidyr::complete( + province = unique(prov_destiny_df$Province_name), + year = unique(prov_destiny_df$Year), + label = c( + "{CROP_EXPORT}", + "{CROPS_TO_POP}", + "{CROPS_TO_LIVESTOCK}", + "{LIVESTOCK_TO_HUMAN}", + "{GRASS_TO_LIVESTOCK}" + ), + fill = list(data = 0, align = "L") + ) + crop_livestock_flows +} + +#' @title Create livestock production dataset +#' +#' @description +#' Generates nitrogen production from livestock destined for population +#' (food or other uses) by province and year, distinguishing edible and +#' non-edible products. +#' +#' @param prov_destiny_df A data frame containing production and destiny +#' information. +#' +#' @return A tibble with columns `province`, `year`, `label`, `data`, `align`. +#' +#' @keywords internal +.create_livestock_df <- function(prov_destiny_df) { + df_livestock <- prov_destiny_df |> + dplyr::filter( + Destiny %in% c("population_food", "population_other_uses"), + Origin == "Livestock" + ) |> + dplyr::mutate( + group_item = ifelse( + Item %in% c("Hides and skins", "Wool (Clean Eq.)", "Silk"), + "non_edible", + "edible" + ) + ) |> + dplyr::group_by(Province_name, Year, group_item) |> + dplyr::summarise(MgN = sum(MgN, na.rm = TRUE), .groups = "drop") |> + dplyr::mutate( + label = dplyr::case_when( + group_item == "non_edible" ~ "{LVSTCK_NOEDIBLE}", + group_item == "edible" ~ "{LV_EDBL}" + ), + align = "L" + ) |> + dplyr::select( + province = Province_name, + year = Year, + label, + data = MgN, + align + ) + + df_livestock +} + +#' @title Create milk production dataset +#' +#' @description +#' Generates nitrogen data for milk and dairy products consumed by population. +#' +#' @param prov_destiny_df A data frame containing production and destiny +#' information. +#' +#' @return A tibble with columns `province`, `year`, `label`, `data`, `align`. +#' +#' @keywords internal +.create_milk_df <- function(prov_destiny_df) { + df_milk <- prov_destiny_df |> + dplyr::filter( + Origin == "Livestock", + Destiny == "population_food", + Item %in% + c("Milk - Excluding Butter", "Milk, lactation", "Whey", "Butter, Ghee") + ) |> + dplyr::group_by(Province_name, Year) |> + dplyr::summarise(MgN = sum(MgN, na.rm = TRUE), .groups = "drop") |> + dplyr::mutate( + label = "{LVST_MILK}", + align = "L" + ) |> + dplyr::select( + province = Province_name, + year = Year, + label, + data = MgN, + align + ) + + df_milk +} + +#' @title Create livestock export dataset +#' +#' @description +#' Generates nitrogen flows associated with exported livestock products. +#' +#' @param prov_destiny_df A data frame containing production and destiny +#' information. +#' +#' @return A tibble with columns `province`, `year`, `label`, `data`, `align`. +#' +#' @keywords internal +.create_livestock_export_df <- function(prov_destiny_df) { + df_livestock_export <- prov_destiny_df |> + dplyr::filter( + Destiny == "export", + Origin == "Livestock" + ) |> + dplyr::group_by(Province_name, Year) |> + dplyr::summarise(data = sum(MgN, na.rm = TRUE), .groups = "drop") |> + dplyr::mutate( + label = "{LIVESTOCK_EXPORTED}", + align = "L", + province = Province_name, + year = Year + ) |> + dplyr::select(province, year, label, data, align) + + df_livestock_export +} + +#' @title Create feed from cropland dataset +#' +#' @description +#' Creates nitrogen data representing feed transfers from cropland to +#' ruminant and monogastric livestock. +#' +#' @param prov_destiny_df A data frame containing production and destiny +#' information. +#' +#' @return A tibble with columns `province`, `year`, `label`, `data`, `align`. +#' +#' @keywords internal +.create_feed_df <- function(prov_destiny_df) { + df_feed <- prov_destiny_df |> + dplyr::filter( + Origin == "Cropland", + Destiny %in% c("livestock_rum", "livestock_mono") + ) |> + dplyr::group_by(Province_name, Year, Destiny) |> + dplyr::summarise( + data = sum(MgN, na.rm = TRUE), + .groups = "drop" + ) |> + dplyr::mutate( + label = dplyr::case_when( + Destiny == "livestock_rum" ~ "{RCRTOLVSTCK_R}", + Destiny == "livestock_mono" ~ "{MCRTOLVSTCK_M}" + ), + align = "L" + ) |> + dplyr::rename(province = Province_name, year = Year) |> + dplyr::select(province, year, label, data, align) + + df_feed +} + +#' @title Create crop losses dataset +#' +#' @description +#' Generates N data from other uses in cropland. +#' +#' @param prov_destiny_df A data frame containing production and destiny +#' information. +#' +#' @return A tibble with columns `province`, `year`, `label`, `data`, `align`. +#' +#' @keywords internal +.create_crop_losses_df <- function(n_balance, prov_destiny_df) { + df_crop_oth <- prov_destiny_df |> + dplyr::filter( + Origin == "Cropland", + Destiny == "population_other_uses" + ) |> + dplyr::group_by(Province_name, Year) |> + dplyr::summarise( + data = sum(MgN, na.rm = TRUE), + .groups = "drop" + ) |> + dplyr::mutate( + label = "{CRP_OTHUSES}", + align = "L" + ) |> + dplyr::rename( + province = Province_name, + year = Year + ) +} + + +#' @title Create animal losses dataset +#' +#' @description +#' Generates nitrogen loss data from livestock, including metabolic losses and +#' livestock products used for other uses. +#' +#' @param prov_destiny_df A data frame containing production and destiny +#' information. +#' +#' @return A tibble with columns `province`, `year`, `label`, `data`, `align`. +#' +#' @keywords internal +.create_animal_losses_df <- function(prov_destiny_df) { + n_excretion <- whep_read_file("n_excretion_ygs") |> + dplyr::select( + Year, + Province_name, + Livestock_cat, + Gross_Prod_GgN, + Net_Prod_GgN + ) |> + dplyr::distinct() |> + dplyr::mutate( + `{AN_LS}` = (Gross_Prod_GgN - Net_Prod_GgN) * 1e3 + ) |> + dplyr::group_by(Province_name, Year) |> + dplyr::summarise( + `{AN_LS}` = sum(`{AN_LS}`, na.rm = TRUE), + .groups = "drop" + ) + + an_oth <- prov_destiny_df |> + dplyr::filter( + Origin == "Livestock", + Destiny == "population_other_uses" + ) |> + dplyr::group_by(Province_name, Year) |> + dplyr::summarise( + `{AN_OTH}` = sum(MgN, na.rm = TRUE), + .groups = "drop" + ) + + df_animal_losses <- n_excretion |> + dplyr::left_join(an_oth, by = c("Province_name", "Year")) |> + dplyr::mutate( + `{AN_OTH}` = ifelse(is.na(`{AN_OTH}`), 0, `{AN_OTH}`), + `{AN_LS_OTH}` = `{AN_LS}` + `{AN_OTH}` + ) |> + tidyr::pivot_longer( + cols = c(`{AN_LS}`, `{AN_OTH}`, `{AN_LS_OTH}`), + names_to = "label", + values_to = "data" + ) |> + dplyr::mutate( + align = "R" + ) |> + dplyr::rename( + province = Province_name, + year = Year + ) + + df_animal_losses +} + +#' @title Create combined livestock nitrogen dataset +#' +#' @description +#' Combines nitrogen data from livestock destined for humans, exports, and +#' losses to generate combined nitrogen output from livestock. +#' +#' @param prov_destiny_df A data frame containing production and destiny +#' information. +#' +#' @return A tibble with columns `province`, `year`, `label`, `data`, `align`. +#' +#' @keywords internal +.create_livestock_total_df <- function(prov_destiny_df) { + prov_destiny_df |> + dplyr::filter( + Origin == "Livestock", + Destiny %in% + c( + "population_food", + "population_other_uses", + "export" + ) + ) |> + dplyr::group_by(Province_name, Year) |> + dplyr::summarise(data = sum(MgN, na.rm = TRUE), .groups = "drop") |> + dplyr::mutate( + label = "{LVSTCKTOTN}", + align = "L" + ) |> + dplyr::select( + province = Province_name, + year = Year, + label, + data, + align + ) +} + +#' @title Create livestock loss dataset +#' +#' @description +#' Calculates nitrogen losses from livestock excretion based on +#' excretion and loss share data. +#' +#' @return A tibble with columns `province`, `year`, `label`, `data`, `align`. +#' +#' @keywords internal +.create_livestock_surplus_df <- function(df_all_flows) { + input_labels <- c( + "{CROPS_TO_LIVESTOCK}", + "{GRASS_TO_LIVESTOCK}", + "{IMANOTR}", + "{IMANOTM}", + "{IMPORT_ANIMALCR_RUM}", + "{IMPORT_ANIMALCR_MONOG}" + ) + + output_labels <- c( + "{LIVESTOCK_TO_HUMAN}", + "{LIVESTOCK_EXPORTED}", + "{LIVESTOCK_TO_CROPS}", + "{LIVESTOCK_TO_GRASS}", + "{AN_OTH}" + ) + + df_inputs <- df_all_flows |> + dplyr::filter(label %in% input_labels) |> + dplyr::group_by(province, year) |> + dplyr::summarise( + input = sum(as.numeric(data), na.rm = TRUE), + .groups = "drop" + ) + + df_outputs <- df_all_flows |> + dplyr::filter(label %in% output_labels) |> + dplyr::group_by(province, year) |> + dplyr::summarise( + output = sum(as.numeric(data), na.rm = TRUE), + .groups = "drop" + ) + + dplyr::full_join(df_inputs, df_outputs, by = c("province", "year")) |> + dplyr::mutate( + input = dplyr::coalesce(input, 0), + output = dplyr::coalesce(output, 0), + data = input - output, + label = "{LIVGASLOSS}", + align = "R" + ) |> + dplyr::select(province, year, label, data, align) +} + +#' @title Create population dataset +#' +#' @description +#' Loads population data (in million inhabitants, MInhab) and converts it +#' into the GRAFS plot structure. +#' +#' @return +#' A tibble with columns `province`, `year`, `label`, `data`, `align`. +#' +#' @keywords internal +.create_population_df <- function() { + population <- whep_read_file("population_yg") + + df_pop <- population |> + dplyr::select( + province = Province_name, + year = Year, + Pop_Mpeop_yg + ) |> + dplyr::mutate( + label = "{POPULATIONM}", + data = Pop_Mpeop_yg, + align = "L" + ) |> + dplyr::select(province, year, label, data, align) + + df_pop +} + + +#' @title Combine and finalize nitrogen flow dataset +#' +#' @description +#' Merges all the created nitrogen datasets into a unified structure. +#' Adding missing labels and setting WIDTH_MAX to 1500. IMPHUMHONEY should be 0. +#' The other labels (CRPNOLV", "NCONTCROP") are +#' set to 0, since I don't know how to create them yet. +#' +#' @param crop_livestock_flows Data frame of crop-livestock nitrogen flows. +#' @param df_livestock Data frame of livestock nitrogen data. +#' @param df_lv_r_m Data frame of livestock feed data. +#' @param df_crop_losses Data frame of crop nitrogen losses. +#' @param df_animal_losses Data frame of animal nitrogen losses. +#' @param df_livestock_total Data frame of total livestock nitrogen. +#' @param df_livestock_surplus Data frame of livestock surplus nitrogen. +#' +#' @return A tibble with standardized columns `province`, `year`, `label`, +#' `data`, and `align`. +#' +#' @keywords internal +.combine_and_finalize_df <- function( + crop_livestock_flows, + df_livestock, + df_lv_r_m, + df_crop_losses, + df_animal_losses, + df_livestock_total, + df_livestock_surplus, + df_land_surplus +) { + df_combi <- dplyr::bind_rows( + crop_livestock_flows |> dplyr::select(province, year, label, data, align), + df_livestock |> dplyr::select(province, year, label, data, align), + df_lv_r_m |> dplyr::select(province, year, label, data, align), + df_crop_losses |> dplyr::select(province, year, label, data, align), + df_animal_losses |> dplyr::select(province, year, label, data, align), + df_livestock_total |> dplyr::select(province, year, label, data, align), + df_livestock_surplus |> dplyr::select(province, year, label, data, align), + df_land_surplus |> dplyr::select(province, year, label, data, align) + ) |> + dplyr::arrange(province, year, label) |> + dplyr::mutate( + data = as.character(data), + align = as.character(align) + ) + + missing_labels <- c( + "{IMPHUMHONEY}", + "{CRP_LS_OTHUSES}", + "{CRP_LS}", + "{CRPNOLV}", + "{NCONTCROP}", + "{WIDTH_MAX}" + ) + + df_combi <- df_combi |> + tidyr::complete( + province, + year, + label = c(unique(df_combi$label), missing_labels), + fill = list(data = "0", align = "L") + ) |> + dplyr::mutate( + align = dplyr::case_when( + label %in% c("{NCONTCROP}", "{ORGOT}") ~ "R", + TRUE ~ align + ) + ) |> + dplyr::bind_rows( + dplyr::distinct(df_combi, province, year) |> + dplyr::mutate( + label = "{YEAR}", + data = as.character(year), + align = "L" + ) |> + dplyr::select(province, year, label, data, align), + dplyr::distinct(df_combi, province, year) |> + dplyr::mutate( + label = "{PROVINCE_NAME}", + data = as.character(province), + align = "L" + ) |> + dplyr::select(province, year, label, data, align) + ) |> + dplyr::mutate( + data = dplyr::case_when( + label == "{WIDTH_MAX}" ~ "1500", + TRUE ~ data + ), + align = dplyr::case_when( + label == "{WIDTH_MAX}" ~ "L", + label %in% + c( + "{NCONTCROP}", + "{ORGOT}" + ) ~ + "R", + TRUE ~ align + ) + ) |> + dplyr::arrange(province, year, label) + + df_combi +} diff --git a/R/input_files.R b/R/input_files.R index ce917515..8fef26c3 100644 --- a/R/input_files.R +++ b/R/input_files.R @@ -55,6 +55,7 @@ whep_read_file <- function(file_alias, type = "parquet", version = NULL) { file_info <- .fetch_file_info(file_alias, whep::whep_inputs) version <- .choose_version(file_info$version, version) + pin_name <- if (!is.na(file_info$pin_name)) file_info$pin_name else file_alias tryCatch( .get_local_board() |> @@ -62,7 +63,7 @@ whep_read_file <- function(file_alias, type = "parquet", version = NULL) { error = function(e) { file_info |> .get_remote_board() |> - .download_and_read(file_alias, type, version) + .download_and_read(pin_name, type, version) } ) } diff --git a/R/input_output_plots.R b/R/input_output_plots.R new file mode 100644 index 00000000..a2bf966d --- /dev/null +++ b/R/input_output_plots.R @@ -0,0 +1,390 @@ +#' Plot N inputs, production and surplus +#' +#' @param system Character. One of "Cropland" or +#' "semi_natural_agroecosystems". +#' +#' @return A ggplot object. +#' @export +plot_input_output <- function( + system = c("Cropland", "semi_natural_agroecosystems") +) { + system <- match.arg(system) + data <- create_n_nat_destiny() + + df_system <- data |> + dplyr::filter( + Province_name != "Sea" + ) + + inputs <- df_system |> + dplyr::filter( + Destiny == system, + Origin %in% + c("Deposition", "Fixation", "Synthetic", "Livestock", "People") + ) |> + dplyr::group_by(Year, Origin) |> + dplyr::summarise(MgN = sum(MgN, na.rm = TRUE), .groups = "drop") |> + dplyr::mutate( + Type = dplyr::recode( + Origin, + "Deposition" = "Deposition", + "Fixation" = "Fixation", + "Synthetic" = "Synthetic_fertilizer", + "Livestock" = "Manure", + "People" = "Urban" + ) + ) + + residue_items <- c("Straw", "Other crop residues") + + production <- df_system |> + dplyr::filter( + Origin == system, + Destiny %in% + c( + "population_food", + "population_other_uses", + "livestock_rum", + "livestock_mono", + "export" + ) + ) |> + dplyr::mutate( + Type = dplyr::if_else(Item %in% residue_items, "Residues", "Production") + ) |> + dplyr::group_by(Year, Type) |> + dplyr::summarise(MgN = sum(MgN, na.rm = TRUE), .groups = "drop") + + input_sum <- inputs |> + dplyr::group_by(Year) |> + dplyr::summarise(Input_Total = sum(MgN), .groups = "drop") + + prod_sum <- production |> + dplyr::group_by(Year) |> + dplyr::summarise(Production = sum(MgN), .groups = "drop") + + surplus <- input_sum |> + dplyr::left_join(prod_sum, by = "Year") |> + dplyr::mutate( + Production = dplyr::coalesce(Production, 0), + Surplus = pmax(Input_Total - Production, 0) + ) |> + dplyr::select(Year, Surplus) |> + dplyr::mutate(Type = "Surplus") + + plot_df <- dplyr::bind_rows( + inputs |> dplyr::select(Year, Type, MgN), + production |> dplyr::select(Year, Type, MgN), + surplus |> dplyr::rename(MgN = Surplus) + ) |> + dplyr::mutate( + MgN = MgN / 1000, + MgN = dplyr::case_when( + Type %in% + c( + "Synthetic_fertilizer", + "Manure", + "Fixation", + "Deposition", + "Urban" + ) ~ -MgN, + TRUE ~ MgN + ), + Type = factor( + Type, + levels = c( + "Synthetic_fertilizer", + "Manure", + "Fixation", + "Deposition", + "Urban", + "Surplus", + "Production", + "Residues" + ) + ) + ) + + ggplot2::ggplot(plot_df, ggplot2::aes(x = Year, y = MgN, fill = Type)) + + ggplot2::geom_area(position = "stack") + + ggplot2::geom_hline(yintercept = 0, linetype = "dashed") + + ggplot2::labs( + title = paste("Spanish nitrogen inputs and outputs –", system), + x = "Year", + y = "Gg N", + fill = "" + ) + + ggplot2::scale_fill_manual( + values = c( + "Synthetic_fertilizer" = "red4", + "Manure" = "darkorange3", + "Urban" = "darkorange4", + "Fixation" = "olivedrab4", + "Deposition" = "gray40", + "Surplus" = "slategray", + "Residues" = "goldenrod3", + "Production" = "orange3" + ) + ) + + ggplot2::theme_minimal() +} + + +#' Plot N inputs, production and surplus for Livestock system +#' +#' @return A ggplot object. +#' @export +plot_input_output_livestock <- function() { + data <- create_n_nat_destiny() + + df <- data |> + dplyr::filter(Province_name != "Sea") + + inputs <- df |> + dplyr::filter( + Destiny %in% c("livestock_rum", "livestock_mono") + ) |> + dplyr::group_by(Year, Destiny) |> + dplyr::summarise(MgN = sum(MgN, na.rm = TRUE), .groups = "drop") |> + dplyr::mutate( + Type = dplyr::recode( + Destiny, + "livestock_rum" = "Feed_ruminants", + "livestock_mono" = "Feed_monogastric" + ) + ) + + production <- df |> + dplyr::filter( + Origin == "Livestock", + Destiny %in% + c( + "population_food", + "population_other_uses", + "export", + "livestock_rum", + "livestock_mono" + ) + ) |> + dplyr::group_by(Year) |> + dplyr::summarise(MgN = sum(MgN, na.rm = TRUE), .groups = "drop") |> + dplyr::mutate(Type = "Production") + + input_sum <- inputs |> + dplyr::group_by(Year) |> + dplyr::summarise(Input_Total = sum(MgN), .groups = "drop") + + prod_sum <- production |> + dplyr::select(Year, Production = MgN) + + surplus <- input_sum |> + dplyr::left_join(prod_sum, by = "Year") |> + dplyr::mutate( + Production = dplyr::coalesce(Production, 0), + Surplus = Input_Total - Production + ) |> + dplyr::select(Year, Surplus) |> + dplyr::mutate(Type = "Surplus") + + plot_df <- dplyr::bind_rows( + inputs |> dplyr::select(Year, Type, MgN), + production |> dplyr::select(Year, Type, MgN), + surplus |> dplyr::rename(MgN = Surplus) + ) |> + dplyr::mutate( + MgN = MgN / 1000, + MgN = dplyr::case_when( + Type %in% c("Feed_ruminants", "Feed_monogastric") ~ -MgN, + TRUE ~ MgN + ), + Type = factor( + Type, + levels = c( + "Feed_ruminants", + "Feed_monogastric", + "Surplus", + "Production" + ) + ) + ) + + ggplot2::ggplot(plot_df, ggplot2::aes(x = Year, y = MgN, fill = Type)) + + ggplot2::geom_area(position = "stack") + + ggplot2::geom_hline(yintercept = 0, linetype = "dashed") + + ggplot2::labs( + title = "Spanish nitrogen inputs and ouputs – Livestock system", + x = "Year", + y = "Gg N", + fill = "" + ) + + ggplot2::scale_fill_manual( + values = c( + "Feed_ruminants" = "darkolivegreen3", + "Feed_monogastric" = "#1b9e77", + "Surplus" = "slategray", + "Production" = "orange3" + ) + ) + + ggplot2::theme_minimal() +} + + +#' Plot N inputs and uses for full agro-food system (system level) +#' +#' @return A ggplot object. +#' @export +plot_input_output_system <- function() { + data <- create_n_nat_destiny() + + df <- data |> + dplyr::filter(Province_name != "Sea") + + soil_inputs <- df |> + dplyr::filter( + Origin %in% c("Synthetic", "Fixation", "Deposition"), + Destiny %in% c("Cropland", "semi_natural_agroecosystems") + ) |> + dplyr::group_by(Year, Origin) |> + dplyr::summarise(MgN = sum(MgN), .groups = "drop") |> + dplyr::mutate( + Type = dplyr::recode( + Origin, + "Synthetic" = "Synthetic_fertilizer", + "Fixation" = "Fixation", + "Deposition" = "Deposition" + ) + ) + + feed_import <- df |> + dplyr::filter( + Origin == "Outside", + Destiny %in% c("livestock_rum", "livestock_mono") + ) |> + dplyr::group_by(Year) |> + dplyr::summarise(MgN = sum(MgN), .groups = "drop") |> + dplyr::mutate(Type = "Feed_import") + + food_import <- df |> + dplyr::filter( + Origin == "Outside", + Destiny %in% c("population_food", "population_other_uses") + ) |> + dplyr::group_by(Year) |> + dplyr::summarise(MgN = sum(MgN), .groups = "drop") |> + dplyr::mutate(Type = "Food_import") + + inputs <- dplyr::bind_rows( + soil_inputs |> dplyr::select(Year, Type, MgN), + feed_import, + food_import + ) + + livestock_ingestion <- df |> + dplyr::filter( + Destiny %in% c("livestock_rum", "livestock_mono"), + Origin %in% c("Cropland", "semi_natural_agroecosystems") + ) |> + dplyr::group_by(Year) |> + dplyr::summarise(MgN = sum(MgN), .groups = "drop") |> + dplyr::mutate(Type = "Feed") + + human_ingestion <- df |> + dplyr::filter( + Destiny %in% c("population_food", "population_other_uses"), + Origin %in% c("Cropland", "semi_natural_agroecosystems", "Livestock") + ) |> + dplyr::mutate( + Type = dplyr::if_else(Destiny == "population_food", "Food", "Other_uses") + ) |> + dplyr::group_by(Year, Type) |> + dplyr::summarise(MgN = sum(MgN), .groups = "drop") + + exports <- df |> + dplyr::filter(Destiny == "export") |> + dplyr::group_by(Year) |> + dplyr::summarise(MgN = sum(MgN), .groups = "drop") |> + dplyr::mutate(Type = "Export") + + uses_core <- dplyr::bind_rows( + livestock_ingestion, + human_ingestion, + exports + ) + + input_sum <- inputs |> + dplyr::group_by(Year) |> + dplyr::summarise(Input_Total = sum(MgN), .groups = "drop") + + use_sum <- uses_core |> + dplyr::group_by(Year) |> + dplyr::summarise(Use_Total = sum(MgN), .groups = "drop") + + surplus <- input_sum |> + dplyr::left_join(use_sum, by = "Year") |> + dplyr::mutate( + Use_Total = dplyr::coalesce(Use_Total, 0), + MgN = pmax(Input_Total - Use_Total, 0), + Type = "Surplus" + ) |> + dplyr::select(Year, Type, MgN) + + plot_df <- dplyr::bind_rows( + inputs, + uses_core, + surplus + ) |> + dplyr::mutate( + MgN = MgN / 1000, + MgN = dplyr::case_when( + Type %in% + c( + "Synthetic_fertilizer", + "Fixation", + "Deposition", + "Feed_import", + "Food_import" + ) ~ -MgN, + TRUE ~ MgN + ), + Type = factor( + Type, + levels = c( + "Synthetic_fertilizer", + "Fixation", + "Deposition", + "Feed_import", + "Food_import", + "Surplus", + "Feed", + "Food", + "Other_uses", + "Export" + ) + ) + ) + + ggplot2::ggplot(plot_df, ggplot2::aes(x = Year, y = MgN, fill = Type)) + + ggplot2::geom_area(position = "stack") + + ggplot2::geom_hline(yintercept = 0, linetype = "dashed") + + ggplot2::labs( + title = "Spanish nitrogen inputs and outputs – Agro-food system", + x = "Year", + y = "Gg N", + fill = "" + ) + + ggplot2::scale_fill_manual( + values = c( + "Synthetic_fertilizer" = "red4", + "Fixation" = "olivedrab4", + "Deposition" = "gray40", + "Feed_import" = "#1b9e77", + "Food_import" = "darkolivegreen3", + "Feed" = "darkorange3", + "Food" = "darkorange4", + "Other_uses" = "sandybrown", + "Export" = "orange3", + "Surplus" = "slategray" + ) + ) + + ggplot2::theme_minimal() +} diff --git a/R/n_prov_destiny.R b/R/n_prov_destiny.R new file mode 100644 index 00000000..c63b5ca2 --- /dev/null +++ b/R/n_prov_destiny.R @@ -0,0 +1,1638 @@ +#' @title GRAFS Nitrogen (N) flows +#' +#' @description +#' Provides N flows of the spanish agro-food system on a provincial level +#' between 1860 and 2020. This dataset is the the base of the GRAFS model and +#' contains data in megagrams of N (MgN) for each year, province, item, origin +#' and destiny. Thereby, the origin column represents where N comes from, which +#' includes N soil inputs, imports and production. The destiny column shows +#' where N goes to, which includes export, population food, population other +#' uses and feed or cropland (in case of N soil inputs). +#' Processed items, residues, woody crops, grazed weeds are taken into account. +#' +#' @return +#' A final tibble containing N flow data by origin and destiny. +#' It includes the following columns: +#' - `year`: The year in which the recorded event occurred. +#' - `province_name`: The Spanish province where the data is from. +#' - `item`: The item which was produced, defined in `names_biomass_cb`. +#' - `irrig_cat`: Irrigation form (irrigated or rainfed) +#' - `box`: One of the GRAFS model systems: cropland, +#' Semi-natural agroecosystems, Livestock, Fish, or Agro-industry. +#' - `origin`: The origin category of N: Cropland, +#' Semi-natural agroecosystems, Livestock, Fish, Agro-industry, Deposition, +#' Fixation, Synthetic, People (waste water), Livestock (manure). +#' - `destiny`: The destiny category of N: population_food, +#' population_other_uses, livestock_mono, livestock_rum (feed), export, +#' Cropland (for N soil inputs). +#' - `MgN`: Nitrogen amount in megagrams (Mg). +#' +#' @export +create_n_prov_destiny <- function() { + codes_coefs_items_full <- whep_read_file("codes_coefs_items_full") + biomass_coefs <- whep_read_file("biomass_coefs") + pie_full_destinies_fm <- whep_read_file("pie_full_destinies_fm") + processed_prov_fixed <- whep_read_file("processed_prov_fixed") + livestock_prod_ygps <- whep_read_file("livestock_prod_ygps") + crop_area_npp_no_fallow <- whep_read_file("crop_area_npp_ygpitr_no_fallow") + npp_ygpit <- whep_read_file("npp_ygpit") + codes_coefs <- whep_read_file("codes_coefs") + intake_ygiac <- whep_read_file("intake_ygiac") + population_yg <- whep_read_file("population_yg") + n_balance_ygpit_all <- whep_read_file("n_balance_ygpit_all") |> + dplyr::filter(Year <= 2021) + + biomass_item_merged <- .merge_items_biomass(npp_ygpit, codes_coefs) + n_soil_inputs <- .calculate_n_soil_inputs(n_balance_ygpit_all, codes_coefs) + + livestock_product_items <- codes_coefs_items_full |> + dplyr::filter(group %in% c("Livestock products", "Livestock")) |> + dplyr::pull(item) + + add_feed_output <- .add_feed( + intake_ygiac |> + dplyr::filter(!Item %in% livestock_product_items) + ) + + prod_combined_boxes <- biomass_item_merged |> + .aggregate_crop_seminatural( + .summarise_crops_residues(crop_area_npp_no_fallow) + ) |> + .combine_production_boxes( + .prepare_livestock_production(livestock_prod_ygps) + ) + + + food_and_other_uses <- population_yg |> + .calculate_population_share() |> + .calculate_food_and_other_uses(pie_full_destinies_fm) + + grafs_prod_item_trade <- biomass_item_merged |> + .remove_seeds_from_system(pie_full_destinies_fm, prod_combined_boxes) |> + .add_grass_wood() |> + .prepare_prod_data( + .prepare_processed_data(processed_prov_fixed), + codes_coefs_items_full + ) |> + .convert_fm_dm_n(biomass_coefs) |> + .combine_destinies(add_feed_output$feed_intake, food_and_other_uses) |> + .convert_to_items_n(codes_coefs_items_full, biomass_coefs) |> + .calculate_trade() |> + .finalize_prod_destiny( + codes_coefs_items_full, + n_soil_inputs, + add_feed_output$feed_share_rum_mono + ) |> + .add_n_soil_inputs(n_soil_inputs) |> + dplyr::select( + Year, + Province_name, + Item, + Irrig_cat, + Box, + Origin, + Destiny, + MgN + ) +} + +#' @title GRAFS Nitrogen (N) flows – National Spain +#' +#' @description +#' Provides N flows of the Spanish agro-food system on a national level +#' between 1860 and 2020. This dataset is the national equivalent of the +#' provincial GRAFS model and represents Spain as a single system without +#' internal trade between provinces. All production, consumption and soil +#' inputs are aggregated nationally before calculating trade with the +#' outside. +#' +#' @return +#' A final tibble containing national N flow data by origin and destiny. +#' +#' @export +create_n_nat_destiny <- function() { + prov <- create_n_prov_destiny() + + prov_lookup <- prov |> + dplyr::group_by(Item, Box, Irrig_cat) |> + dplyr::summarise(weight = sum(MgN, na.rm = TRUE), .groups = "drop") |> + dplyr::group_by(Item) |> + dplyr::slice_max(weight, n = 1, with_ties = FALSE) |> + dplyr::ungroup() + + nat_production_detail <- prov |> + dplyr::filter(Origin == Box) |> + dplyr::group_by(Year, Item, Box, Irrig_cat) |> + dplyr::summarise(production = sum(MgN, na.rm = TRUE), .groups = "drop") + + nat_production <- nat_production_detail |> + dplyr::group_by(Year, Item) |> + dplyr::summarise( + production = sum(production, na.rm = TRUE), + .groups = "drop" + ) + + nat_consumption <- prov |> + dplyr::filter( + Destiny %in% + c( + "population_food", + "population_other_uses", + "livestock_rum", + "livestock_mono" + ) + ) |> + dplyr::group_by(Year, Item, Destiny) |> + dplyr::summarise( + consumption = sum(MgN, na.rm = TRUE), + .groups = "drop" + ) + + nat_cons_wide <- nat_consumption |> + tidyr::pivot_wider( + names_from = Destiny, + values_from = consumption, + values_fill = 0 + ) + + nat_total_consumption <- nat_consumption |> + dplyr::group_by(Year, Item) |> + dplyr::summarise( + consumption = sum(consumption, na.rm = TRUE), + .groups = "drop" + ) + + nat_balance <- nat_production |> + dplyr::full_join(nat_total_consumption, by = c("Year", "Item")) |> + dplyr::mutate( + production = dplyr::coalesce(production, 0), + consumption = dplyr::coalesce(consumption, 0), + export = pmax(production - consumption, 0), + import = pmax(consumption - production, 0) + ) + + nat_shares <- nat_cons_wide |> + dplyr::left_join(nat_production, by = c("Year", "Item")) |> + dplyr::mutate( + production = dplyr::coalesce(production, 0), + + food = dplyr::coalesce(population_food, 0), + other = dplyr::coalesce(population_other_uses, 0), + feed_rum = dplyr::coalesce(livestock_rum, 0), + feed_mono = dplyr::coalesce(livestock_mono, 0), + feed = feed_rum + feed_mono, + + demand = food + other + feed, + local = pmin(production, demand), + + food_local = dplyr::if_else(demand > 0, local * (food / demand), 0), + other_local = dplyr::if_else(demand > 0, local * (other / demand), 0), + feed_local = dplyr::if_else(demand > 0, local * (feed / demand), 0), + + food_gap = pmax(food - food_local, 0), + other_gap = pmax(other - other_local, 0), + feed_gap = pmax(feed - feed_local, 0), + + total_gap = food_gap + other_gap + feed_gap, + + share_food = dplyr::if_else(total_gap > 0, food_gap / total_gap, 0), + share_other = dplyr::if_else(total_gap > 0, other_gap / total_gap, 0), + share_feed = dplyr::if_else(total_gap > 0, feed_gap / total_gap, 0), + + share_rum = dplyr::if_else(feed > 0, feed_rum / feed, 0), + share_mono = dplyr::if_else(feed > 0, feed_mono / feed, 0), + + share_feed_rum = share_feed * share_rum, + share_feed_mono = share_feed * share_mono + ) |> + dplyr::select( + Year, + Item, + share_food, + share_other, + share_feed_rum, + share_feed_mono + ) |> + tidyr::pivot_longer( + cols = c( + share_food, + share_other, + share_feed_rum, + share_feed_mono + ), + names_to = "Destiny", + values_to = "share" + ) |> + dplyr::mutate( + Destiny = dplyr::recode( + Destiny, + share_food = "population_food", + share_other = "population_other_uses", + share_feed_rum = "livestock_rum", + share_feed_mono = "livestock_mono" + ) + ) |> + dplyr::ungroup() + + imports <- nat_balance |> + dplyr::filter(import > 0) |> + dplyr::left_join(nat_shares, by = c("Year", "Item")) |> + dplyr::mutate( + share = dplyr::coalesce(share, 0), + MgN = import * share, + Province_name = "Spain", + Origin = "Outside" + ) |> + dplyr::left_join(prov_lookup, by = "Item") |> + dplyr::filter(MgN > 0) |> + dplyr::select( + Year, + Province_name, + Item, + Irrig_cat, + Box, + Origin, + Destiny, + MgN + ) + + export_shares <- nat_production_detail |> + dplyr::group_by(Year, Item) |> + dplyr::mutate( + total_production = sum(production, na.rm = TRUE), + share = dplyr::if_else( + total_production > 0, + production / total_production, + 0 + ) + ) |> + dplyr::ungroup() |> + dplyr::select(Year, Item, Box, Irrig_cat, share) + + exports <- nat_balance |> + dplyr::filter(export > 0) |> + dplyr::left_join(export_shares, by = c("Year", "Item")) |> + dplyr::mutate( + Province_name = "Spain", + Origin = Box, + Destiny = "export", + MgN = export * dplyr::coalesce(share, 0) + ) |> + dplyr::filter(MgN > 0) |> + dplyr::select( + Year, + Province_name, + Item, + Irrig_cat, + Box, + Origin, + Destiny, + MgN + ) + + nat_soil_inputs <- prov |> + dplyr::filter( + Origin %in% c("Deposition", "Fixation", "Synthetic", "Livestock", "People"), + Destiny %in% c("Cropland", "semi_natural_agroecosystems") + ) |> + dplyr::group_by(Year, Item, Irrig_cat, Box, Origin, Destiny) |> + dplyr::summarise(MgN = sum(MgN, na.rm = TRUE), .groups = "drop") |> + dplyr::mutate(Province_name = "Spain") + + nat_local_total <- nat_balance |> + dplyr::mutate(local = pmin(production, consumption)) |> + dplyr::select(Year, Item, local) + + nat_destiny_shares <- nat_consumption |> + dplyr::left_join( + nat_total_consumption |> dplyr::rename(total = consumption), + by = c("Year", "Item") + ) |> + dplyr::mutate( + destiny_share = dplyr::if_else(total > 0, consumption / total, 0) + ) |> + dplyr::select(Year, Item, Destiny, destiny_share) + + nat_local_detail <- nat_local_total |> + dplyr::left_join(nat_destiny_shares, by = c("Year", "Item")) |> + dplyr::mutate(MgN_local = local * destiny_share) |> + dplyr::left_join(export_shares, by = c("Year", "Item")) |> + dplyr::mutate( + MgN = MgN_local * share, + Origin = Box, + Province_name = "Spain" + ) |> + dplyr::filter(!is.na(Box), MgN > 0) |> + dplyr::select(Year, Province_name, Item, Irrig_cat, Box, Origin, Destiny, MgN) + + dplyr::bind_rows(nat_local_detail, nat_soil_inputs, exports, imports) |> + dplyr::arrange(Year, Item, Origin, Destiny) +} + + +#' @title Production of Cropland, Livestock, and Semi-natural agroecosystems +#' @description Merge items with biomasses. +#' +#' @param npp_ygpit_csv Dataframe with N data. +#' @param names_biomass_cb Dataframe with biomass names and associated item +#' names. +#' +#' @return A list with two merged dataframes: 'crop_area_npp_merged' and +#' 'npp_ygpit_merged'. +#' @keywords internal +#' @noRd +.merge_items_biomass <- function( + npp_ygpit_csv, + names_biomass_cb +) { + npp_ygpit_csv |> + dplyr::left_join( + names_biomass_cb |> dplyr::select(Name_biomass, Item), + by = "Name_biomass" + ) +} + +#' @title Crops Production and Residues ---------------------------------------- +#' +#' @param crop_area_npp_ygpitr_no_fallow Dataframe excluding fallow. +#' +#' @return A dataframe summarizing total crop production and residues per +#' province and year. +#' @keywords internal +#' @noRd +.summarise_crops_residues <- function(crop_area_npp_ygpitr_no_fallow) { + crop_area_npp_prod_residue <- crop_area_npp_ygpitr_no_fallow |> + dplyr::mutate(LandUse = "Cropland") |> + dplyr::rename(prod_type = Product_residue) |> + dplyr::group_by( + Year, + Province_name, + Name_biomass, + Item, + prod_type, + LandUse, + Irrig_cat + ) |> + dplyr::summarise( + production_fm = sum(as.numeric(Prod_ygpit_Mg), na.rm = TRUE), + .groups = "drop" + ) |> + dplyr::mutate(Box = "Cropland") + + crop_area_npp_prod_residue +} + +#' @title Combining all plant production (harvested products and residues, +#' and grazed grass) ---------------------------------------------------------- +#' +#' @param npp_ygpit_merged NPP merged data including all biomasses and items. +#' +#' @return A dataframe combining products, residues, and grazed biomass. +#' @keywords internal +#' @noRd +.aggregate_crop_seminatural <- function( + npp_ygpit_merged, + crop_area_npp_prod_residue +) { + fallow_grazed <- npp_ygpit_merged |> + dplyr::filter( + LandUse == "Cropland", + Item == "Fallow", + Name_biomass == "Fallow" + ) |> + dplyr::group_by( + Year, + Province_name, + Name_biomass, + Item, + LandUse, + Irrig_cat + ) |> + dplyr::summarise( + production_fm = sum(GrazedWeeds_MgDM, na.rm = TRUE), + .groups = "drop" + ) |> + dplyr::mutate( + prod_type = "Grass", + Box = "Cropland" + ) + + semi_natural <- npp_ygpit_merged |> + dplyr::filter(LandUse != "Cropland") |> + dplyr::select( + Year, + Province_name, + Name_biomass, + Item, + LandUse, + Irrig_cat, + GrazedWeeds_MgDM, + Prod_ygpit_Mg, + Used_Residue_MgFM + ) |> + tidyr::pivot_longer( + cols = c(GrazedWeeds_MgDM, Prod_ygpit_Mg, Used_Residue_MgFM), + names_to = "prod_source", + values_to = "production_fm" + ) |> + dplyr::mutate( + prod_type = dplyr::recode( + prod_source, + GrazedWeeds_MgDM = "Grass", + Prod_ygpit_Mg = "Product", + Used_Residue_MgFM = "Residue" + ) + ) |> + dplyr::select(-prod_source) |> + dplyr::mutate(Box = "semi_natural_agroecosystems") + + combined_biomasses <- dplyr::bind_rows( + crop_area_npp_prod_residue, + fallow_grazed, + semi_natural + ) + + combined_biomasses +} + +#' @title Livestock Production ------------------------------------------------- +#' +#' @param livestock_prod_ygps A dataframe including livestock production data. +#' +#' @return A dataframe formatted for integration with other production data. +#' @keywords internal +#' @noRd +.prepare_livestock_production <- function(livestock_prod_ygps) { + livestock <- livestock_prod_ygps |> + dplyr::select( + Year, + Province_name, + Item, + Name_biomass, + Prod_Mg + ) |> + dplyr::mutate( + Box = "Livestock", + prod_type = "Product" + ) + + livestock +} + +#' @title Combine Cropland, Semi_natural_agroecosystems and Livestock ---------- +#' +#' @param combined_biomasses Dataframe of crop production. +#' @param semi_natural_agroecosystems Dataframe of production from semi-natural +#' agroecosystems. +#' @param livestock Dataframe of livestock production. +#' +#' @return Combined dataframe of all production systems. +#' @keywords internal +#' @noRd +.combine_production_boxes <- function( + combined_biomasses, + livestock +) { + grafs_prod_combined <- dplyr::bind_rows( + combined_biomasses, + livestock |> + dplyr::rename(production_fm = Prod_Mg) + ) + + grafs_prod_combined +} + +#' @title Seed production per province, based on national seed rate per Area +#' @description Calculates the amount of seeds used per province and subtracts +#' it from total production. +#' COMMENT: in a few cases, seeds are higher then production, so that we get +#' negative values. When the share is over 50%, it is therefore set back to 50%. +#' +#' @param npp_ygpit_csv Dataframe containing crop area by province. +#' @param pie_full_destinies_fm Dataframe containing domestic supply by +#' destiny, including seed usage. +#' @param grafs_prod_combined Dataframe with total production values. +#' +#' @return A dataframe with production values after subtracting seed usage. +#' @keywords internal +#' @noRd +.remove_seeds_from_system <- function( + npp_ygpit_merged, + pie_full_destinies_fm, + grafs_prod_combined +) { + cropland_area <- npp_ygpit_merged |> + dplyr::filter(LandUse == "Cropland") |> + dplyr::summarise( + Area_ha = sum(Area_ygpit_ha, na.rm = TRUE), + .by = c("Year", "Province_name", "Item") + ) + + seed_reference <- pie_full_destinies_fm |> + dplyr::filter(Element == "Domestic_supply", Destiny == "Seed") |> + dplyr::summarise( + Seed_total = sum(Value_destiny, na.rm = TRUE), + .by = c("Year", "Item") + ) |> + dplyr::left_join( + cropland_area |> + dplyr::summarise( + National_area = sum(Area_ha, na.rm = TRUE), + .by = c("Year", "Item") + ), + by = c("Year", "Item") + ) |> + dplyr::mutate( + Seed_rate_per_ha = dplyr::if_else( + National_area > 0, + Seed_total / National_area, + 0 + ) + ) |> + dplyr::select(Year, Item, Seed_rate_per_ha) + + seed_rates <- cropland_area |> + dplyr::left_join(seed_reference, by = c("Year", "Item")) |> + dplyr::mutate( + Seeds_used_MgFM = Area_ha * dplyr::coalesce(Seed_rate_per_ha, 0) + ) + + # Substracting the Seed data from Production in grafs_prod_combined. + grafs_prod_combined_no_seeds <- grafs_prod_combined |> + dplyr::left_join( + seed_rates |> + dplyr::select(Year, Province_name, Item, Seeds_used_MgFM), + by = c("Year", "Province_name", "Item") + ) |> + dplyr::mutate( + Seeds_used_MgFM = dplyr::coalesce(Seeds_used_MgFM, 0), + Seeds_used_capped = dplyr::if_else( + Seeds_used_MgFM > 0.5 * production_fm, + 0.5 * production_fm, + Seeds_used_MgFM + ), + production_fm = production_fm - Seeds_used_capped + ) |> + dplyr::select(-Seeds_used_MgFM, -Seeds_used_capped) + + grafs_prod_combined_no_seeds +} + +#' @title Structuring dataset (GrazedWeeds and Used_Residues in ProductionFM) +#' @description Replace production_fm with GrazedWeeds_MgDM (for Fallow). +#' +#' @param grafs_prod_combined_no_seeds Dataframe of production without seeds. +#' +#' @return A dataframe with added grass and wood production. +#' @keywords internal +#' @noRd +.add_grass_wood <- function(grafs_prod_combined_no_seeds) { + grafs_prod_added <- grafs_prod_combined_no_seeds |> + dplyr::mutate( + Item = dplyr::case_when( + prod_type == "Grass" & Name_biomass == "Fallow" ~ "Fallow", + prod_type == "Grass" ~ "Grassland", + prod_type == "Residue" & + Box != "Cropland" & + Name_biomass %in% + c( + "Holm oak forest", + "Conifers", + "Mediterranean shrubland" + ) ~ + "Firewood", + TRUE ~ Item + ), + Name_biomass = dplyr::case_when( + prod_type == "Grass" & Item == "Grassland" ~ "Grass", + Item == "Firewood" ~ "Firewood", + TRUE ~ Name_biomass + ) + ) |> + # 20% DM to FM for Grass + dplyr::mutate( + production_fm = dplyr::if_else( + prod_type == "Grass" & Item == "Grassland" & !is.na(production_fm), + production_fm / 0.2, + production_fm + ) + ) |> + dplyr::filter(!is.na(production_fm)) |> + dplyr::group_by( + Year, + Province_name, + Name_biomass, + Item, + Box, + LandUse, + Irrig_cat, + prod_type + ) |> + dplyr::summarise( + production_fm = sum(production_fm, na.rm = TRUE), + .groups = "drop" + ) |> + dplyr::arrange(Year, Province_name, Name_biomass, Item) + + grafs_prod_added +} + +#' @title Processed Items ------------------------------------------------------ +#' @description Summarise processed items by Year, Province, Biomass, +#' Item & ProcessedItem. +#' +#' @param processed_prov_fixed Dataframe containing data for processed items. +#' +#' @return A dataframe with processed item values structured for integration. +#' @keywords internal +#' @noRd +.prepare_processed_data <- function( + processed_prov_fixed +) { + processed_data <- processed_prov_fixed |> + dplyr::group_by(Year, Province_name, Name_biomass, Item, ProcessedItem) |> + dplyr::summarise( + ProcessedItem_amount = sum(ProcessedItem_amount, na.rm = TRUE), + .groups = "drop" + ) |> + dplyr::mutate( + Item = ProcessedItem, + production_fm = ProcessedItem_amount, + Box = "Cropland", + prod_type = "Product" + ) |> + dplyr::select( + Year, + Province_name, + Name_biomass, + Item, + Box, + production_fm, + prod_type + ) + + processed_data +} + +#' @title Match structure of grafs_prod_combined_no_seeds ---------------------- +#' @description Combines grass, wood and processed item data into a unified +#' structure and merges biomass names. +#' +#' @param grafs_prod_added Data with added grass and wood production. +#' @param processed_data Dataframe with processed item values. +#' @param codes_coefs_items_full Dataframe with item-to-biomass names. +#' +#' @return A unified dataframe with complete production data for items. +#' @keywords internal +#' @noRd +.prepare_prod_data <- function( + grafs_prod_added, + processed_data, + codes_coefs_items_full +) { + added_grass_wood_prepared <- grafs_prod_added |> + dplyr::select( + Year, + Province_name, + Name_biomass, + Item, + Box, + LandUse, + Irrig_cat, + prod_type, + production_fm + ) |> + dplyr::bind_rows(processed_data) |> + dplyr::arrange(Year, Province_name, Name_biomass, Item) + + # Merging Item and Name_biomass and creating Name_biomass_primary + added_grass_wood_merged <- added_grass_wood_prepared |> + dplyr::rename(Name_biomass_primary = Name_biomass) |> + dplyr::left_join( + codes_coefs_items_full |> + dplyr::select(item, Name_biomass), + by = c("Item" = "item") + ) |> + dplyr::mutate( + Name_biomass = dplyr::if_else( + !is.na(Name_biomass), + Name_biomass, + Name_biomass_primary + ) + ) |> + dplyr::relocate(Name_biomass, .after = Name_biomass_primary) + + added_grass_wood_merged +} + +#' @title Convert Fresh Matter (FM) to Dry Matter (DM) and finally to N +#' @description Define a list of special items that require using the primary +#' biomass name for selecting conversion coefficients. +#' +#' @param added_grass_wood_merged Dataframe with production values and biomass. +#' @param biomass_coefs Dataframe with FM→DM and DM→N conversion coefficients +#' for each biomass. +#' +#' @return A dataframe with total dry matter and N production. +#' @keywords internal +#' @noRd +.convert_fm_dm_n <- function( + added_grass_wood_merged, + biomass_coefs +) { + special_items <- c( + "Nuts and products", + "Vegetables, Other", + "Fruits, Other", + "Cereals, Other", + "Pulses, Other and products" + ) + + grazed_no_seeds_primary <- added_grass_wood_merged |> + dplyr::mutate( + Biomass_match = dplyr::if_else( + Item %in% special_items, + Name_biomass_primary, + Name_biomass + ) + ) + + prod_grazed_no_seeds_n <- grazed_no_seeds_primary |> + dplyr::left_join( + biomass_coefs |> + dplyr::select( + Name_biomass, + Product_kgDM_kgFM, + Product_kgN_kgDM, + Residue_kgDM_kgFM, + Residue_kgN_kgDM + ), + by = c("Biomass_match" = "Name_biomass") + ) |> + dplyr::mutate( + # Some residues (e.g. Straw) can miss residue-specific coefficients. + # In that case, fall back to product coefficients to avoid dropping + # production to zero. + Residue_kgDM_kgFM = dplyr::coalesce( + Residue_kgDM_kgFM, + Product_kgDM_kgFM + ), + Residue_kgN_kgDM = dplyr::coalesce( + Residue_kgN_kgDM, + Product_kgN_kgDM + ), + conversion_dm = dplyr::if_else( + prod_type %in% + c( + "Residue", + "Grass" + ), + Residue_kgDM_kgFM, + Product_kgDM_kgFM + ), + conversion_n_dm = dplyr::if_else( + prod_type %in% + c( + "Residue", + "Grass" + ), + Residue_kgN_kgDM, + Product_kgN_kgDM + ), + production_n = production_fm * conversion_dm * conversion_n_dm + ) |> + dplyr::select(-Name_biomass) |> + dplyr::select( + Year, + Province_name, + Item, + Box, + LandUse, + Irrig_cat, + prod_type, + production_n + ) |> + dplyr::filter(!(is.na(Item) & production_n == 0)) |> + dplyr::group_by( + Year, + Province_name, + Item, + Box, + LandUse, + Irrig_cat, + prod_type + ) |> + dplyr::summarise( + production_n = sum(production_n, na.rm = TRUE), + .groups = "drop" + ) + + grafs_prod_item <- prod_grazed_no_seeds_n |> + dplyr::group_by( + Year, + Province_name, + Item, + Box, + LandUse, + Irrig_cat, + prod_type + ) |> + dplyr::summarise( + production_n = sum(production_n, na.rm = TRUE), + .groups = "drop" + ) + + grafs_prod_item +} + +#' @title Consumption (Destinies) --------------------------------------------- +#' +#' @description Intake Livestock: sum all data (FM_Mg) for the same Year, +#' Province_name, Item. Calculates feed shares for ruminant and monogastric +#' animals. +#' +#' @param feed_intake A dataframe with feed intake data in FM. +#' +#' @return A dataframe with the total FM_Mg per year, province, and item. +#' @keywords internal +#' @noRd +.add_feed <- function(feed_intake) { + feed_wide <- feed_intake |> + dplyr::mutate( + Livestock_type = dplyr::case_when( + Livestock_cat %in% + c( + "Cattle_meat", + "Cattle_milk", + "Goats", + "Sheep", + "Donkeys_mules", + "Horses" + ) ~ + "ruminant", + Livestock_cat %in% + c("Pigs", "Poultry", "Rabbits", "Fur animals", "Other") ~ + "monogastric", + Livestock_cat == "Pets" ~ "pets", + TRUE ~ NA_character_ + ) + ) |> + dplyr::summarise( + feed_amount = sum(FM_Mg, na.rm = TRUE), + .by = c("Year", "Province_name", "Item", "Livestock_type") + ) |> + tidyr::pivot_wider( + names_from = Livestock_type, + values_from = feed_amount, + values_fill = 0 + ) |> + dplyr::mutate( + ruminant = dplyr::coalesce(ruminant, 0), + monogastric = dplyr::coalesce(monogastric, 0), + pets = dplyr::coalesce(pets, 0), + feed = ruminant + monogastric, + food_pets = pets + ) + + feed_share_rum_mono <- feed_wide |> + dplyr::mutate( + feed_total = feed, + share_rum = dplyr::if_else(feed_total > 0, ruminant / feed_total, 0), + share_mono = dplyr::if_else(feed_total > 0, monogastric / feed_total, 0) + ) + + list( + feed_intake = feed_wide |> + dplyr::select(Year, Province_name, Item, feed, food_pets), + feed_share_rum_mono = feed_share_rum_mono |> + dplyr::select(Year, Province_name, Item, share_rum, share_mono) + ) +} + +#' @title Population +#' @description Use column Pop_Mpeop_yg. Calculate the share of population +#' (population in each province divided through whole population in +#' Spain to get the share). +#' +#' @param population_share A dataframe with population data. +#' +#' @return A dataframe including population shares. +#' @keywords internal +#' @noRd +.calculate_population_share <- function( + population_share +) { + population_share <- population_share |> + dplyr::select(Year, Province_name, Pop_Mpeop_yg) |> + dplyr::group_by(Year) |> + dplyr::mutate( + Total_pop_spain = sum(Pop_Mpeop_yg, na.rm = TRUE), + Pop_share = Pop_Mpeop_yg / Total_pop_spain + ) |> + dplyr::ungroup() |> + dplyr::select( + Year, + Province_name, + Pop_Mpeop_yg, + Pop_share + ) + + population_share +} + +#' @title Food and Other uses--------------------------------------------------- +#' @description Sum all Elements for food and other uses and multiply by +#' population share +#' +#' @param pie_full_destinies_fm A dataframe containing domestic supply food and +#' other uses. +#' @param population_share A dataframe containing population share by province. +#' +#' @return A dataframe including food and other uses consumption per province +#' and item. +#' @keywords internal +#' @noRd +.calculate_food_and_other_uses <- function( + population_share, + pie_full_destinies_fm +) { + total_food_other_uses <- pie_full_destinies_fm |> + dplyr::filter( + Destiny %in% c("Food", "Other_uses"), + Element == "Domestic_supply" + ) |> + dplyr::group_by(Year, Item, Destiny) |> + dplyr::summarise( + Total_value = sum(Value_destiny, na.rm = TRUE), + .groups = "drop" + ) |> + tidyr::pivot_wider( + names_from = Destiny, + values_from = Total_value + ) + + prov_food_other_uses <- total_food_other_uses |> + dplyr::left_join( + population_share, + by = "Year", + relationship = "many-to-many" + ) |> + dplyr::mutate( + Food = Pop_share * Food, + Other_uses = Pop_share * Other_uses + ) |> + dplyr::rename( + food = Food, + other_uses = Other_uses + ) |> + dplyr::select(Year, Province_name, Item, food, other_uses) + + prov_food_other_uses +} + +#' @title Combine all destinies ------------------------------------------------ +#' @description Merges food, feed, and other uses into one dataset. +#' +#' @param grafs_prod_item Dataframe production data for items. +#' @param feed_intake Feed intake values per province and item. +#' @param prov_food_other_uses Food and Other uses per province and item. +#' +#' @return A combined dataframe with food, feed, and other uses. +#' @keywords internal +#' @noRd +#' +.combine_destinies <- function( + grafs_prod_item, + feed_intake, + prov_food_other_uses +) { + grafs_prod_item_sum <- grafs_prod_item |> + dplyr::group_by(Year, Province_name, Item, Box, Irrig_cat) |> + dplyr::summarise( + production_n = sum(production_n, na.rm = TRUE), + .groups = "drop" + ) + + # Pre-calculate production totals to avoid expensive group_by later + production_totals <- grafs_prod_item_sum |> + dplyr::group_by(Year, Province_name, Item) |> + dplyr::summarise( + production_total = sum(production_n, na.rm = TRUE), + .groups = "drop" + ) + + feed_clean <- feed_intake |> + dplyr::group_by(Year, Province_name, Item) |> + dplyr::summarise( + feed = sum(feed, na.rm = TRUE), + food_pets = sum(food_pets, na.rm = TRUE), + .groups = "drop" + ) + + prov_food_other_uses_clean <- prov_food_other_uses |> + dplyr::group_by(Year, Province_name, Item) |> + dplyr::summarise( + food = sum(food, na.rm = TRUE), + other_uses = sum(other_uses, na.rm = TRUE), + .groups = "drop" + ) + + # Feed for pets is assigned to food. + grafs_prod_item_combined <- grafs_prod_item_sum |> + dplyr::full_join( + prov_food_other_uses_clean, + by = c("Year", "Province_name", "Item") + ) |> + dplyr::full_join( + feed_clean, + by = c("Year", "Province_name", "Item") + ) |> + dplyr::left_join( + production_totals, + by = c("Year", "Province_name", "Item") + ) |> + dplyr::mutate( + food = dplyr::coalesce(food, 0) + dplyr::coalesce(food_pets, 0), + other_uses = dplyr::coalesce(other_uses, 0), + feed = dplyr::coalesce(feed, 0), + production_n = dplyr::coalesce(production_n, 0), + production_total = dplyr::coalesce(production_total, 0) + ) |> + + dplyr::select(-food_pets) + + # Split consumption proportionally across all Box/Irrig_cat rows by their + # share of total item production. This handles both the irrigated/rainfed + # split within Cropland AND items that span multiple boxes (e.g. Cropland + + # semi_natural). Without this, the non-Cropland rows would each receive the + # full consumption value, causing overcounting that grows with production. + # When production_total = 0 (pure import items), there is only one row so + # production_share = 1 is correct. + grafs_prod_item_combined <- grafs_prod_item_combined |> + dplyr::mutate( + production_share = dplyr::if_else( + production_total > 0, + production_n / production_total, + 1 + ), + food = food * production_share, + feed = feed * production_share, + other_uses = other_uses * production_share + ) |> + dplyr::select(-production_total, -production_share) + + grafs_prod_item_combined +} + +#' @title Finalizing data +#' @description Final merging of Item and Name_biomass and converting FM to DM, +#' and DM to N. +#' +#' @param grafs_prod_item_combined Dataframe with FM values for food, feed, +#' and other uses. +#' @param codes_coefs_items_full Dataframe linking items to biomass names. +#' @param biomass_coefs Dataframe including conversion factors +#' (DM/FM and N/DM). +#' +#' @return A dataframe with food, feed, and other uses in MgN. +#' @keywords internal +#' @noRd +.convert_to_items_n <- function( + grafs_prod_item_combined = whep_read_file(""), + codes_coefs_items_full = whep_read_file("codes_coefs_items_full"), + biomass_coefs = whep_read_file("biomass_coefs") +) { + grafs_prod_item_combined |> + dplyr::left_join( + codes_coefs_items_full |> + dplyr::select(item, Name_biomass), + by = c("Item" = "item") + ) |> + dplyr::mutate( + prod_type = dplyr::case_when( + Name_biomass %in% c("Grass", "Fallow") ~ "Grass", + Name_biomass == "Average wood" ~ "Residue", + TRUE ~ "Product" + ) + ) |> + tidyr::pivot_longer( + cols = c(food, other_uses, feed), + names_to = "destiny", + values_to = "value_fm" + ) |> + dplyr::left_join( + biomass_coefs |> + dplyr::select( + Name_biomass, + Product_kgDM_kgFM, + Product_kgN_kgDM, + Residue_kgDM_kgFM, + Residue_kgN_kgDM + ), + by = "Name_biomass" + ) |> + dplyr::mutate( + n_value = dplyr::case_when( + prod_type %in% c("Residue", "Grass") ~ + value_fm * Residue_kgDM_kgFM * Residue_kgN_kgDM, + prod_type == "Product" ~ + value_fm * Product_kgDM_kgFM * Product_kgN_kgDM, + TRUE ~ NA_real_ + ) + ) |> + dplyr::select(-value_fm) |> + tidyr::pivot_wider( + names_from = destiny, + values_from = n_value + ) |> + dplyr::select( + Year, + Province_name, + Item, + Name_biomass, + prod_type, + Box, + Irrig_cat, + production_n, + food, + other_uses, + feed + ) +} + +#' @title Consumption and Trade +#' @description Calculation of consumption by destiny and trade +#' (export, import). National scaling can be activated, for analysis for whole +#' Spain. It should be deactivated for provincial analysis +#' +#' @param grafs_prod_item_n A dataframe with N values (MgN) by destiny. +#' @param pie_full_destinies_fm A data frame with destiny data. +#' @param biomass_coefs A data frame with biomass coefficients. +#' @param codes_coefs_items_full A lookup table with coefficients. +#' +#' @return A dataframe with consumption, exports, and imports in MgN. +#' @keywords internal +#' @noRd +.calculate_trade <- function(grafs_prod_item_n) { + grafs_prod_item_n |> + dplyr::mutate( + food = dplyr::coalesce(food, 0), + other_uses = dplyr::coalesce(other_uses, 0), + feed = dplyr::coalesce(feed, 0), + + demand_total = food + other_uses + feed, + + import = pmax(demand_total - production_n, 0), + export = pmax(production_n - demand_total, 0) + ) |> + dplyr::select( + Year, + Province_name, + Item, + Box, + Irrig_cat, + production_n, + food, + other_uses, + feed, + export, + import + ) +} + + +#' @title Prepare final dataset +#' @description Assigns Box to item groups and Irrig_cat to Cropland. +#' @param grafs_prod_item_trade A dataset containing consumptiom and trade data. +#' @param codes_coefs_items_full A dataset linking items to groups for Box +#' assignment. +#' @return A dataframe with Box and Irrig_cat columns assigned. +#' @keywords internal +#' @noRd +.prep_final_ds <- function(grafs_prod_item_trade, codes_coefs_items_full) { + grafs_prod_item_trade |> + dplyr::left_join( + dplyr::select(codes_coefs_items_full, item, group), + by = c("Item" = "item") + ) |> + dplyr::mutate( + group = dplyr::recode(group, "Additives" = "Agro-industry"), + + Box = dplyr::case_when( + Item == "Acorns" ~ "semi_natural_agroecosystems", + is.na(Box) & Item == "Fallow" ~ "Cropland", + is.na(Box) & + group %in% c("Crop products", "Primary crops", "crop residue") ~ + "Cropland", + is.na(Box) & group %in% c("Livestock products", "Livestock") ~ + "Livestock", + is.na(Box) & group %in% c("Agro-industry", "Fish") ~ group, + TRUE ~ Box + ), + Irrig_cat = dplyr::if_else(Box == "Cropland", Irrig_cat, NA_character_) + ) |> + dplyr::select(-group) +} + + +#' @title Calculate consumption shares +#' @description Calculates food, feed, and other uses shares for each item. +#' @param grafs_prod_destiny_final A dataset containing consumption and trade +#' per item, province, origin, and destiny. +#' @return A dataset with total consumption and consumption shares for food, +#' other uses, and feed. +#' @keywords internal +#' @noRd +.calculate_consumption_shares <- function(df) { + df |> + dplyr::mutate( + demand_total = food + other_uses + feed, + + local_total = pmin(production_n, demand_total), + + food_local = dplyr::if_else( + demand_total > 0, + local_total * (food / demand_total), + 0 + ), + other_local = dplyr::if_else( + demand_total > 0, + local_total * (other_uses / demand_total), + 0 + ), + feed_local = dplyr::if_else( + demand_total > 0, + local_total * (feed / demand_total), + 0 + ), + + food_share = dplyr::if_else(local_total > 0, food_local / local_total, 0), + other_uses_share = dplyr::if_else( + local_total > 0, + other_local / local_total, + 0 + ), + feed_share = dplyr::if_else(local_total > 0, feed_local / local_total, 0) + ) |> + dplyr::select( + Year, + Province_name, + Item, + Box, + Irrig_cat, + local_total, + food_share, + other_uses_share, + feed_share + ) +} + +#' @title Split local consumption +#' @description Splits local consumption proportionally according to demand +#' shares (food, other uses, feed). Feed is further split into +#' livestock_rum and livestock_mono. +#' @param local_vs_import A dataset containing local and imported consumption. +#' @param feed_share_rum_mono A dataset with feed shares between ruminants +#' and monogastric animals. +#' @return A dataset with consumption split into population_food, +#' livestock_rum, livestock_mono, and population_other_uses. +#' @keywords internal +#' @noRd +.split_local_consumption <- function(local_vs_import, feed_share_rum_mono) { + local_vs_import |> + dplyr::left_join( + feed_share_rum_mono, + by = c("Year", "Province_name", "Item") + ) |> + dplyr::mutate( + share_rum = dplyr::coalesce(share_rum, 0), + share_mono = dplyr::coalesce(share_mono, 0), + share_total = share_rum + share_mono, + share_rum = dplyr::if_else(is.na(share_rum), 0, share_rum), + share_mono = dplyr::if_else(is.na(share_mono), 0, share_mono), + + local_food_raw = local_consumption * food_share, + local_other_raw = local_consumption * other_uses_share, + local_feed_raw = local_consumption * feed_share, + + total_local_alloc = local_food_raw + local_other_raw + local_feed_raw, + + scale_factor = dplyr::if_else( + total_local_alloc > local_consumption & total_local_alloc > 0, + local_consumption / total_local_alloc, + 1 + ), + + local_food = local_food_raw * scale_factor, + local_other_uses = local_other_raw * scale_factor, + local_feed = local_feed_raw * scale_factor, + + population_food = local_food, + population_other_uses = local_other_uses, + livestock_rum = local_feed * share_rum, + livestock_mono = local_feed * share_mono, + + Origin = Box + ) |> + dplyr::select( + -share_total, + -local_food_raw, + -local_other_raw, + -local_feed_raw, + -total_local_alloc, + -scale_factor, + -local_food, + -local_other_uses, + -local_feed + ) |> + tidyr::pivot_longer( + cols = c( + population_food, + population_other_uses, + livestock_rum, + livestock_mono + ), + names_to = "Destiny", + values_to = "MgN" + ) +} + + +#' @title Split imported consumption +#' @description Splits imported consumption as the residual demand after local +#' allocation with priority for food, then other uses, then feed. Livestock +#' feed is split into livestock_rum (ruminants) and livestock_mono +#' (monogastric). +#' @param local_vs_import A dataset containing local and import consumption. +#' @param feed_share_rum_mono A dataset with feed shares split into ruminants +#' and monogastric animals. +#' @return A dataset with imported consumption, split into population_food, +#' livestock_rum, livestock_mono, and population_other_uses. +#' @keywords internal +#' @noRd +.split_import_consumption <- function( + local_vs_import, + feed_share_rum_mono, + shares_import_wide +) { + local_vs_import |> + dplyr::left_join( + feed_share_rum_mono, + by = c("Year", "Province_name", "Item") + ) |> + dplyr::mutate( + share_rum = dplyr::coalesce(share_rum, 0), + share_mono = dplyr::coalesce(share_mono, 0), + + food_local = local_consumption * food_share, + other_local = local_consumption * other_uses_share, + feed_local = local_consumption * feed_share, + + food_gap = pmax(food - food_local, 0), + other_gap = pmax(other_uses - other_local, 0), + feed_gap = pmax(feed - feed_local, 0), + + total_gap = food_gap + other_gap + feed_gap, + + share_food = dplyr::if_else(total_gap > 0, food_gap / total_gap, 0), + share_other = dplyr::if_else(total_gap > 0, other_gap / total_gap, 0), + share_feed = dplyr::if_else(total_gap > 0, feed_gap / total_gap, 0), + + population_food = import_consumption * share_food, + population_other_uses = import_consumption * share_other, + import_feed = import_consumption * share_feed, + + livestock_rum = import_feed * share_rum, + livestock_mono = import_feed * share_mono, + + Origin = "Outside", + Irrig_cat = NA_character_ + ) |> + dplyr::select( + -food_local, + -other_local, + -feed_local, + -food_gap, + -other_gap, + -feed_gap, + -total_gap, + -share_food, + -share_other, + -share_feed, + -import_feed + ) |> + dplyr::summarise( + population_food = sum(population_food, na.rm = TRUE), + population_other_uses = sum(population_other_uses, na.rm = TRUE), + livestock_rum = sum(livestock_rum, na.rm = TRUE), + livestock_mono = sum(livestock_mono, na.rm = TRUE), + .by = c("Year", "Province_name", "Item", "Box", "Origin", "Irrig_cat") + ) |> + tidyr::pivot_longer( + cols = c( + population_food, + population_other_uses, + livestock_rum, + livestock_mono + ), + names_to = "Destiny", + values_to = "MgN" + ) +} + + +#' @title Adding exports +#' @description Adds exports to the final dataset. +#' @param grafs_prod_destiny_final A dataset containing consumption and trade. +#' @return A dataset with added exports for each item and province. +#' @keywords internal +#' @noRd +.add_exports <- function(grafs_prod_destiny_final) { + grafs_prod_destiny_final |> + dplyr::transmute( + Year, + Province_name, + Item, + Irrig_cat, + Destiny = "export", + MgN = export, + Origin = Box, + Box = Box + ) |> + dplyr::group_by( + Year, + Province_name, + Item, + Irrig_cat, + Box, + Origin, + Destiny + ) |> + dplyr::summarise(MgN = sum(MgN, na.rm = TRUE), .groups = "drop") +} + + +#' @title Finalize N flow output +#' @description Combines consumption, import, and export N flows. +#' @param grafs_prod_item_trade A dataset containing trade data. +#' @param codes_coefs_items_full An excel linking items to groups for +#' classification. +#' @param n_soil_inputs A dataset containing N soil inputs. +#' @param feed_share_rum_mono A dataset containing feed shares between ruminant +#' and monogastric animals. +#' @return A dataset containing the final nitrogen flows (MgN) by +#' year, province, item, irrigation category, Box, origin, and destiny. +#' Includes local consumption, imports, and exports. +#' @keywords internal +#' @noRd +.finalize_prod_destiny <- function( + grafs_prod_item_trade, + codes_coefs_items_full, + n_soil_inputs, + feed_share_rum_mono +) { + biomass_coefs <- whep_read_file("biomass_coefs") + grafs_prod_destiny_final <- .prep_final_ds( + grafs_prod_item_trade, + codes_coefs_items_full + ) |> + dplyr::group_by(Year, Province_name, Item, Box, Irrig_cat) |> + dplyr::summarise( + production_n = sum(production_n, na.rm = TRUE), + food = sum(food, na.rm = TRUE), + other_uses = sum(other_uses, na.rm = TRUE), + feed = sum(feed, na.rm = TRUE), + export = sum(export, na.rm = TRUE), + import = sum(import, na.rm = TRUE), + .groups = "drop" + ) + + shares_import <- .calculate_consumption_shares(grafs_prod_destiny_final) + + pie_imports_n <- whep_read_file("pie_full_destinies_fm") |> + dplyr::filter( + Element == "Import", + Destiny %in% c("Food", "Other_uses", "Feed") + ) |> + dplyr::group_by(Year, Item, Destiny) |> + dplyr::summarise( + value_fm = sum(Value_destiny, na.rm = TRUE), + .groups = "drop" + ) |> + dplyr::left_join( + codes_coefs_items_full |> + dplyr::select(item, Name_biomass), + by = c("Item" = "item") + ) |> + dplyr::left_join( + biomass_coefs |> + dplyr::select( + Name_biomass, + Product_kgDM_kgFM, + Product_kgN_kgDM, + Residue_kgDM_kgFM, + Residue_kgN_kgDM + ), + by = "Name_biomass" + ) |> + dplyr::mutate( + prod_type = dplyr::case_when( + Name_biomass %in% c("Grass", "Fallow") ~ "Grass", + Name_biomass == "Average wood" ~ "Residue", + TRUE ~ "Product" + ) + ) |> + dplyr::mutate( + value_n = dplyr::case_when( + prod_type %in% c("Residue", "Grass") ~ + value_fm * + dplyr::coalesce(Residue_kgDM_kgFM, Product_kgDM_kgFM) * + dplyr::coalesce(Residue_kgN_kgDM, Product_kgN_kgDM), + prod_type == "Product" ~ + value_fm * + Product_kgDM_kgFM * + Product_kgN_kgDM, + + TRUE ~ NA_real_ + ) + ) |> + dplyr::group_by(Year, Item) |> + dplyr::mutate( + total = sum(value_n, na.rm = TRUE), + share = dplyr::if_else(total > 0, value_n / total, 0) + ) |> + dplyr::ungroup() + + shares_import_wide <- pie_imports_n |> + dplyr::select(Year, Item, Destiny, share) |> + tidyr::pivot_wider( + names_from = Destiny, + values_from = share, + names_prefix = "share_" + ) + + local_vs_import <- grafs_prod_destiny_final |> + dplyr::left_join( + shares_import, + by = c("Year", "Province_name", "Item", "Box", "Irrig_cat") + ) |> + dplyr::mutate( + local_consumption = pmin(production_n, food + other_uses + feed), + import_consumption = pmax((food + other_uses + feed) - production_n, 0) + ) + + dplyr::bind_rows( + .split_local_consumption(local_vs_import, feed_share_rum_mono), + .split_import_consumption( + local_vs_import, + feed_share_rum_mono, + shares_import_wide + ), + .add_exports(grafs_prod_destiny_final) + ) |> + dplyr::filter(MgN > 0) +} + +#' @title Add soil N inputs +#' @description Transforms soil N inputs (deposition, fixation, synthetic, +#' manure, urban) into long format and adds them to the production-destiny +#' dataframe. +#' +#' @param grafs_prod_destiny_final A tibble from `.finalize_prod_destiny()` +#' containing destinies. +#' @param n_soil_inputs A dataframe with soil inputs. +#' +#' @return The input dataframe extended with soil N input flows. +#' @keywords internal +#' @noRd +.add_n_soil_inputs <- function(grafs_prod_destiny_final, soil_inputs) { + soil_inputs_long <- soil_inputs |> + tidyr::pivot_longer( + cols = c(deposition, fixation, synthetic, manure, urban), + names_to = "Origin", + values_to = "MgN" + ) |> + dplyr::mutate( + Destiny = dplyr::case_when( + Origin %in% c("deposition", "fixation", "synthetic") ~ Box, + Origin == "manure" ~ Box, + Origin == "urban" ~ Box + ), + Origin = dplyr::case_when( + Origin == "deposition" ~ "Deposition", + Origin == "fixation" ~ "Fixation", + Origin == "synthetic" ~ "Synthetic", + Origin == "manure" ~ "Livestock", + Origin == "urban" ~ "People" + ), + Box = Destiny + ) |> + dplyr::select(Year, Province_name, Item, Irrig_cat, Origin, Destiny, MgN) + + dplyr::bind_rows( + grafs_prod_destiny_final, + soil_inputs_long + ) |> + dplyr::filter(MgN != 0) |> + dplyr::arrange(Year, Province_name, Item, Irrig_cat, Origin, Destiny) +} diff --git a/R/n_soil_inputs_nue.R b/R/n_soil_inputs_nue.R new file mode 100644 index 00000000..24d4d472 --- /dev/null +++ b/R/n_soil_inputs_nue.R @@ -0,0 +1,361 @@ +#' @title Nitrogen (N) soil inputs for Spain ---------------------------------- +#' +#' @description +#' Calculates total nitrogen inputs to soils in Spain at the provincial level. +#' This includes contributions from: +#' - Atmospheric deposition (`deposition`) +#' - Biological nitrogen fixation (`fixation`) +#' - Synthetic fertilizers (`synthetic`) +#' - Manure (excreta, solid, liquid) (`manure`) +#' - Urban sources (`urban`) +#' +#' Special land use categories and items are aggregated: +#' - Semi-natural agroecosystems (e.g., Dehesa, Pasture_Shrubland) +#' - Firewood biomass (e.g., Conifers, Holm oak) +#' +#' @return A tibble containing: +#' - `Year`: Year +#' - `Province_name`: Spanish province +#' - `Item`: Crop, land use, or biomass item +#' - `Box`: Land use or ecosystem box for aggregation +#' - `deposition`: N input from atmospheric deposition (Mg) +#' - `fixation`: N input from biological N fixation (Mg) +#' - `synthetic`: N input from synthetic fertilizers (Mg) +#' - `manure`: N input from livestock manure (Mg) +#' - `urban`: N input from urban sources (Mg) +#' +#' @export +create_n_soil_inputs <- function() { + .calculate_n_soil_inputs( + whep_read_file("n_balance_ygpit_all"), + whep_read_file("codes_coefs") + ) +} + +#' @title Assign some special items to Boxes ----------------------------------- +#' @return A named list with assigned items. +#' @keywords internal +#' @noRd +.assign_items <- function() { + list( + semi_natural_agroecosystems = c( + "Dehesa", + "Forest_high", + "Forest_low", + "Other", + "Pasture_Shrubland" + ), + Firewood_biomass = c( + "Conifers", + "Holm oak", + "Holm oak forest", + "Mediterranean shrubland" + ) + ) +} + +#' @title Calculate N Inputs --------------------------------------------------- +#' @description Merges N balance data with items and aggregates deposition, +#' fixation, synthetic, urban, and manure inputs for each combination of year, +#' province, item, and box. +#' +#' @param n_balance_ygpit_all A data frame containing nitrogen balance data. +#' @param names_biomass_cb A data frame merging biomass names to item names. +#' +#' @return One tibble: 'n_soil_inputs' +#' @keywords internal +#' @noRd +.calculate_n_soil_inputs <- function( + n_balance_ygpit_all, + names_biomass_cb +) { + categories <- .assign_items() + + # Merge Name_biomass with Item + items <- names_biomass_cb |> + dplyr::distinct(Name_biomass, Item) + + # Create mapping tables + firewood_biomass <- tibble::tibble( + Name_biomass = categories$Firewood_biomass, + item_firewood = "Firewood" + ) + + semi_natural_agroecosystems <- tibble::tibble( + LandUse = categories$semi_natural_agroecosystems, + Box_semi_natural_agroecosystems = "semi_natural_agroecosystems" + ) + + # Combine all necessary n Inputs + n_soil_inputs <- n_balance_ygpit_all |> + dplyr::left_join(items, by = "Name_biomass") |> + dplyr::left_join(firewood_biomass, by = "Name_biomass") |> + dplyr::left_join(semi_natural_agroecosystems, by = "LandUse") |> + dplyr::mutate( + Item = dplyr::coalesce(item_firewood, Item), + Box = dplyr::coalesce(Box_semi_natural_agroecosystems, LandUse) + ) |> + dplyr::select(-item_firewood, -Box_semi_natural_agroecosystems) |> + dplyr::summarise( + deposition = sum(Deposition, na.rm = TRUE), + fixation = sum(BNF, na.rm = TRUE), + synthetic = sum(Synthetic, na.rm = TRUE), + manure = sum(Solid + Liquid, na.rm = TRUE), + urban = sum(Urban, na.rm = TRUE), + .by = c(Year, Province_name, Item, Irrig_cat, Box) + ) |> + dplyr::arrange(Year, Province_name) + + n_soil_inputs +} + +#' @title N production for Spain ----------------------------------------------- +#' +#' @description Calculates N production at the provincial level in Spain. +#' Production is derived from consumption, export, import, and other uses. +#' +#' @return A tibble containing: +#' - `Year`: Year +#' - `Province_name`: Spanish province +#' - `Item`: Product item +#' - `Box`: Ecosystem box +#' - `prod`: Produced N (Mg) +#' +#' @export +create_n_production <- function() { + grafs_prod_destiny_final <- create_n_prov_destiny() + + .calculate_n_production(grafs_prod_destiny_final) +} + +#' @title Calculate N Production +#' @description Internal function to calculate nitrogen production. +#' @param grafs_prod_destiny A data frame with consumption, export, import data. +#' @return A tibble with production and import values. +#' @keywords internal +#' @noRd +.calculate_n_production <- function(grafs_prod_destiny) { + n_prod_data <- grafs_prod_destiny |> + dplyr::filter(!is.na(Box)) |> + tidyr::replace_na(list(MgN = 0)) |> + tidyr::pivot_wider( + names_from = Destiny, + values_from = MgN, + values_fill = 0 + ) |> + dplyr::mutate( + feed = livestock_rum + livestock_mono, + prod = population_food + + population_other_uses + + feed + + export, + # Fish has no domestic production + prod = dplyr::if_else(Box == "Fish", 0, prod) + ) |> + dplyr::summarise( + prod = sum(prod, na.rm = TRUE), + .by = c(Year, Province_name, Item, Box) + ) |> + dplyr::arrange(Year, Province_name, Item, Box) + + n_prod_data +} + + +#' @title N soil inputs and Nitrogen Use Efficiency (NUE) for crop ------------- +#' +#' @description +#' N inputs (deposition, fixation, synthetic fertilizers, urban sources, manure) +#' and N production in Spain from 1860 to the present for the GRAFS model at the +#' provincial level. +#' The crop NUE is defined as the percentage of produced nitrogen relative to +#' the total nitrogen inputs to the soil. +#' Total soil inputs are calculated as: +#' inputs = deposition + fixation + synthetic + manure + urban +#' +#' @returns +#' A tibble containing nitrogen input, production, and NUE data. +#' It includes the following columns: +#' - `Year`: Year. +#' - `Province_name`: The Spanish province. +#' - `Item`: The item which was produced, defined in `names_biomass_cb`. +#' - `Box`: One of the two systems of the GRAFS model: cropland or +#' semi-natural agroecosystems. +#' - `deposition`: Atmospheric nitrogen deposition in megagrams (Mg). +#' - `fixation`: Nitrogen fixation in megagrams (Mg). +#' - `synthetic`: Synthetic nitrogen fertilizer applied to the land in +#' megagrams (Mg). +#' - `manure`: Nitrogen in manure applied to the land in megagrams (Mg). +#' - `urban`: Nitrogen in wastewater from human sources in megagrams (Mg). +#' - `prod`: Produced nitrogen in megagrams (Mg). +#' - `inputs`: Total nitrogen inputs in megagrams (Mg). +#' +#' +#' @export +calculate_nue_crops <- function() { + n_soil_inputs <- create_n_soil_inputs() |> + dplyr::group_by(Year, Province_name, Item, Box) |> + dplyr::summarise( + deposition = sum(deposition, na.rm = TRUE), + fixation = sum(fixation, na.rm = TRUE), + synthetic = sum(synthetic, na.rm = TRUE), + manure = sum(manure, na.rm = TRUE), + urban = sum(urban, na.rm = TRUE), + .groups = "drop" + ) + + n_prod_data <- create_n_production() + + nue <- dplyr::inner_join( + n_soil_inputs, + n_prod_data, + by = c("Year", "Province_name", "Item", "Box") + ) |> + dplyr::filter(!is.na(Box)) |> + dplyr::mutate( + inputs = deposition + fixation + synthetic + manure + urban + ) |> + dplyr::filter( + !is.na(prod), + !is.na(inputs), + prod > 0, + inputs > 0 + ) |> + dplyr::mutate( + nue = prod / inputs * 100 + ) |> + dplyr::select(Year, Province_name, Item, Box, nue) + + nue +} + + +#' @title NUE for Livestock ---------------------------------------------------- +#' +#' @description +#' Calculates Nitrogen Use Efficiency (NUE) for livestock categories +#' (excluding pets). +#' +#' The livestock NUE is defined as the percentage of nitrogen in livestock +#' products relative to the nitrogen in feed intake: +#' nue = prod_n / feed_n * 100 +#' +#' Additionally, a mass balance is calculated to check the recovery of N in +#' products and excretion relative to feed intake: +#' mass_balance = (prod_n + excretion_n) / feed_n +#' +#' @return A tibble containing: +#' - `Year`: Year +#' - `Province_name`: Spanish province +#' - `Livestock_cat`: Livestock category +#' - `Item`: Produced item +#' - `prod_n`: Nitrogen in livestock products (Mg) +#' - `feed_n`: Nitrogen in feed intake (Mg) +#' - `excretion_n`: Nitrogen excreted (Mg) +#' - `nue`: Nitrogen Use Efficiency (%) +#' - `mass_balance`: Mass balance ratio (%) +#' +#' @export +calculate_nue_livestock <- function() { + intake_n <- whep_read_file("intake_ygiac") |> + dplyr::filter(Livestock_cat != "Pets") |> + dplyr::group_by(Year, Province_name, Livestock_cat) |> + dplyr::summarise( + feed_n = sum(N_MgN, na.rm = TRUE), + .groups = "drop" + ) + + prod_n <- whep_read_file("livestock_prod_ygps") |> + dplyr::filter(!is.na(Prod_MgN)) |> + dplyr::group_by(Year, Province_name, Livestock_cat, Item) |> + dplyr::summarise( + prod_n = sum(Prod_MgN, na.rm = TRUE), + .groups = "drop" + ) + + excretion_n <- whep_read_file("n_excretion_ygs") |> + dplyr::group_by(Year, Province_name, Livestock_cat) |> + dplyr::summarise( + excretion_n = sum(Excr_MgN, na.rm = TRUE), + .groups = "drop" + ) + + nue_livestock <- intake_n |> + dplyr::inner_join( + prod_n, + by = c("Year", "Province_name", "Livestock_cat") + ) |> + dplyr::left_join( + excretion_n, + by = c("Year", "Province_name", "Livestock_cat") + ) |> + dplyr::mutate( + nue = prod_n / feed_n * 100, + mass_balance = (prod_n + excretion_n) / feed_n + ) |> + dplyr::select( + Year, + Province_name, + Livestock_cat, + Item, + prod_n, + feed_n, + excretion_n, + nue, + mass_balance + ) + + nue_livestock +} + +#' @title System NUE ----------------------------------------------------------- +#' +#' @description +#' Calculates the NUE for Spain at the provincial level. +#' The system NUE is defined as the percentage of total nitrogen production +#' (`total_prod`) relative to the sum of all nitrogen inputs (`inputs`) into the +#' soil system. +#' +#' @param n_soil_inputs A tibble of nitrogen soil input (deposition, fixation, +#' synthetic, manure, urban) +#' +#' @return A tibble with the following columns: +#' - `Year`: Year +#' - `Province_name`: Spanish province +#' - `total_prod`: Total nitrogen production (Mg) +#' - `inputs`: Total nitrogen inputs (Mg) +#' - `nue_system`: System-level Nitrogen Use Efficiency (%) +#' +#' @export +calculate_system_nue <- function(n_soil_inputs = create_n_soil_inputs()) { + n_soil_inputs <- n_soil_inputs |> + dplyr::group_by(Year, Province_name) |> + dplyr::summarise( + deposition = sum(deposition, na.rm = TRUE), + fixation = sum(fixation, na.rm = TRUE), + synthetic = sum(synthetic, na.rm = TRUE), + manure = sum(manure, na.rm = TRUE), + urban = sum(urban, na.rm = TRUE), + .groups = "drop" + ) + + total_outputs <- dplyr::bind_rows( + whep_read_file("n_balance_ygpit_all"), + whep_read_file("livestock_prod_ygps") + ) |> + dplyr::group_by(Year, Province_name) |> + dplyr::summarise( + total_prod = sum(Prod_MgN, na.rm = TRUE), + .groups = "drop" + ) + + system_nue <- total_outputs |> + dplyr::left_join(n_soil_inputs, by = c("Year", "Province_name")) |> + dplyr::mutate( + inputs = deposition + fixation + synthetic + manure + urban, + nue_system = total_prod / inputs * 100 + ) |> + dplyr::select(Year, Province_name, total_prod, inputs, nue_system) + + system_nue +} diff --git a/R/utils.R b/R/utils.R index ad0dbe46..a49bbdf7 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1,29 +1,144 @@ # Suppress R CMD check warnings for dplyr NSE (Non Standard Evaluation) utils::globalVariables( c( + "", + "", + "", + "", + "", + "", + "", + "", + "", + "", + "", + "", + "", + "", + "", + "", + "", + "", + "", + "", + "Acoss", + "across", + "aes", "alias", + "align", + "Animal_class", + "arrowColor", "area", "area_code", "area_code_p", + "Area_ha", + "Area_ha_cropland", + "Area_ygpit_ha", "area_name", "balanced_export", "balanced_import", "bilateral_trade", + "Biomass_match", + "BNF", + "Box", + "Box_destiny", + "Box_semi_natural_agroecosystems", + "Category", "cf", + "consumption", + "Consumption_N", + "consumption_total", + "conversion_dm", + "conversion_n", + "Cropland_Production_MgN", + "data", + "data_monog", + "data_rum", + "deposition", + "Deposition", + "destiny", + "Destiny", + "Destiny_feed", + "Denitrif_MgN", + "Domestic_feed_MgN", "domestic_supply", "element", + "element_text", "Element", + "Excr_GgN", + "Excr_MgN", + "Excreta", + "excretion_n", + "Export", + "Export_MgN", + "Export_prov", "export", + "everything", + "facet_wrap", + "feed", + "Feed", + "feed_import", + "Feed_import_MgN", + "feed_import_N", + "Feed_MgDM", + "feed_mg_dm", + "Feed_MgFM", + "Feed_MgN", + "feed_n", + "feed_share", + "feed_total", "feedtype", + "fertiliser_N", "fill_value", "final_value_processed", + "fixation", + "flow_type", + "FM_Mg", + "FM_Mg_total", + "food", + "Food", + "Food_Consumption_MgN", + "Food_Mg", + "Food_MgDM", + "food_mg_dm", + "Food_MgFM", + "Food_MgN", + "food_pets", + "food_share", "from_code", + "geom_bar", + "geom_sf", + "ggplot", + "GRASS_TO_LIVESTOCK", + "grafs_prod_destiny", + "grafs_prod_item_n", + "GrazedWeeds_MgDM", + "GrazedWeeds_MgN", + "group", + "group_item", "groups", - "import", + "herbaceous", + "human_share", + "IMANOTM_val", + "IMANOTR_val", "Imp/Exp", + "import", + "Import", + "import_feed", + "Import_MgN", + "Imported_feed_share", + "import_food", + "Import_prov", + "import_other_uses", + "imported_MgN", + "import_consumption", "Info_Format", + "inputs", + "Inputs_MgN", "intake", "intake_dm", + "Irrig_cat", + "Irrig_type", "item", "Item", "item_cbs_code", @@ -34,51 +149,197 @@ utils::globalVariables( "item_cbs_name", "item_code", "item_code_cbs", + "item_firewood", "item_processed", "item_prod_code", "item_prod_name", "item_to_process", "item_type", + "labs", + "label", + "LandUse", + "Liquid", "live_anim_code", + "Livestock_cat", + "Livestock_density", + "Livestock_type", + ".load_inputs_typologies_julia", + "local_MgN", + "local_consumption", + "local_feed_share", "loss", "loss_share", + "Loss_share", + "LU", + "LU_head", + "LU_share", + "LU_total", + "LU_total_spain", + "manure", + "Manure_share", + "mass_balance", + "MgN", + "MgN_amount", + "MgN_dep", + "MgN_feed", + "MgN_fix", + "MgN_manure", + "MgN_mono", + "MgN_rum", + "MgN_syn", + "MgN_total", + "MgN_urban", + "monogastric", + "mutate", + "n_input", + "N_input_type", + "N_input_value", + "n_prod_data", + "n_soil_inputs", + "n_value", "Name", + "Name_biomass", + "Name_biomass_primary", + "N_MgN", + "National_area", + "net_trade", + "Net_feed_import", + "Net_Prod_GgN", + "Net_trade", "No", + "nue", + "nue_system", + "Origin", + "Other_uses", + "other_uses", + "OtherUses_Mg", + "OtherUses_MgDM", + "other_uses_mg_dm", + "OtherUses_MgFM", + "OtherUses_MgN", + "other_share", + "other_uses_share", + "output", + "pop_share", + "Pop_share", + "Pop_Mpeop_yg", "prefilled", "proc", - "process", "proc_cbs_code", "proc_group", + "ProcessedItem", + "ProcessedItem_amount", + "Processeditem", + "processeditem", + "prod", "prod_ygpit_mg", + "Prod_ygpit_Mg", + "Prod_Mg", + "Prod_MgN", + "Prod_MgN_total", + "prod_n", + "Prod_Residue_Product_Mg", + "prod_type", + "Product", "product_fraction", + "Product_kgDM_kgFM", + "Product_kgN_kgDM", + "Product_residue", "product_residue", + "Production", + "Production_DM", + "Production_FM", + "Production_MgN", + "production_dm", + "production_fm", + "production_n", + "production_n_tmp", + "Production_N", + "Production_N_tmp", + "Production_prov", + "Province_name", + "province", "proxy_ratio", + "Residue_kgDM_kgFM", + "Residue_kgN_kgDM", + "ruminant", "SACO_link", + "scale_fill_manual", "scaling", "seed", + "Seed_rate_per_ha", + "Seed_total", + "Seeds_used_MgFM", + "Seeds_used_capped", + "Semi_nat_feed_MgN", + "Semi_nat_share", + "SemiNatural_feed_MgN", + "SemiNatural_feed_share", "sex", + "Solid", + "Stock_Number", "source_value", "stock_variation", + "str", + "stri_trans_general", + "Surplus", + "Synthetic", + "synthetic", + "theme", + "theme_minimal", + "trade_destiny", "supply", "Timeline_End", "Timeline_Freq", "Timeline_Start", + "to_code", + "Total_Food_value", + "Total_Manure", + "Total_Mg", + "Total_N_input", + "Total_N_input_all", + "Total_OtherUses_value", + "Total_feed_MgN", + "Total_feed_import", + "Total_pop_spain", "total_export", "total_import", + "total_prod", "total_trade", - "to_code", + "Total_value", "Trade", "type", + "Typologie", + "Typologies", + "Typologies_all_years", + "Typologies_map", + "Typology", "unit", - "value", + "urban", + "Urban", + "UsedResidue_MgN", + "Used_Residue_MgFM", "Value", + "Value_destiny", + "value", "value_carried_backward", "value_carried_forward", + "value_destiny", + "value_fm", "value_interpfilled", "value_proc", "value_proc_raw", "value_to_process", + "woody", + "woody_prod", + "woody_share", + "Year", "year", - "Year" + "share", + "share_mono", + "share_rum", + "N2O_MgN", + "NH3_MgN", + "Gross_Prod_GgN" ) ) diff --git a/README.Rmd b/README.Rmd index e053bc1e..44c5e013 100644 --- a/README.Rmd +++ b/README.Rmd @@ -19,7 +19,6 @@ knitr::opts_chunk$set( [![R-CMD-check](https://github.com/eduaguilera/whep/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/eduaguilera/whep/actions/workflows/R-CMD-check.yaml) [![CRAN status](https://www.r-pkg.org/badges/version/whep)](https://CRAN.R-project.org/package=whep) [![whep status badge](https://eduaguilera.r-universe.dev/whep/badges/version)](https://eduaguilera.r-universe.dev/whep) -[![Codecov test coverage](https://codecov.io/gh/eduaguilera/whep/branch/main/graph/badge.svg)](https://app.codecov.io/gh/eduaguilera/whep?branch=main) ## Project diff --git a/README.md b/README.md index a46043ed..055c416b 100644 --- a/README.md +++ b/README.md @@ -10,8 +10,6 @@ status](https://www.r-pkg.org/badges/version/whep)](https://CRAN.R-project.org/package=whep) [![whep status badge](https://eduaguilera.r-universe.dev/whep/badges/version)](https://eduaguilera.r-universe.dev/whep) -[![Codecov test -coverage](https://codecov.io/gh/eduaguilera/whep/branch/main/graph/badge.svg)](https://app.codecov.io/gh/eduaguilera/whep?branch=main) ## Project diff --git a/_pkgdown.yml b/_pkgdown.yml index 3bd672af..210551b4 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -66,6 +66,24 @@ reference: Get a tidy dataframe with the found sources for different data. contents: - expand_trade_sources + +- title: N calculations + desc: > + Functions to calculate nitrogen flows and efficiency. + contents: + - calculate_nue_crops + - calculate_nue_livestock + - calculate_system_nue + - create_n_production + - create_n_nat_destiny + - create_n_prov_destiny + - create_n_soil_inputs + +- title: N GRAFS plot + desc: > + Functions to generate data for creating GRAFS plots + contents: + - create_grafs_plot_df - title: Gap filling functions desc: > diff --git a/data/whep_inputs.rda b/data/whep_inputs.rda index 964c9767..65fea484 100644 Binary files a/data/whep_inputs.rda and b/data/whep_inputs.rda differ diff --git a/inst/extdata/whep_inputs.csv b/inst/extdata/whep_inputs.csv index 0425bd7f..a31791a4 100644 --- a/inst/extdata/whep_inputs.csv +++ b/inst/extdata/whep_inputs.csv @@ -1,4 +1,4 @@ -alias,board_url,version +alias,board_url,version,pin_name commodity_balance_sheet,https://saco.csic.es/public.php/dav/files/nrJ3JGPZyZeQMW8/Model%20inputs/world/_pins.yaml,20250714T123343Z-114b5 bilateral_trade,https://saco.csic.es/public.php/dav/files/nrJ3JGPZyZeQMW8/Model%20inputs/world/_pins.yaml,20250714T123347Z-2c392 processing_coefs,https://saco.csic.es/public.php/dav/files/nrJ3JGPZyZeQMW8/Model%20inputs/world/_pins.yaml,20250714T123348Z-06c63 @@ -6,3 +6,39 @@ feed_intake,https://saco.csic.es/public.php/dav/files/nrJ3JGPZyZeQMW8/Model%20in primary_prod,https://saco.csic.es/public.php/dav/files/nrJ3JGPZyZeQMW8/Model%20inputs/world/_pins.yaml,20250714T123350Z-74e7f crop_residues,https://saco.csic.es/public.php/dav/files/nrJ3JGPZyZeQMW8/Model%20inputs/world/_pins.yaml,20250714T123350Z-1d7be read_example,https://saco.csic.es/public.php/dav/files/nrJ3JGPZyZeQMW8/Model%20inputs/world/_pins.yaml,20250721T152756Z-f00da +luh2_v2h_states,https://saco.csic.es/public.php/dav/files/nrJ3JGPZyZeQMW8/Model%20inputs/world/_pins.yaml,20251006T152247Z-942cc +faostat-production,https://saco.csic.es/public.php/dav/files/nrJ3JGPZyZeQMW8/Model%20inputs/world/_pins.yaml,20260325T111448Z-4fffe +faostat-production-old,https://saco.csic.es/public.php/dav/files/nrJ3JGPZyZeQMW8/Model%20inputs/world/_pins.yaml,20260325T113330Z-572c9 +eu-agridb-fodder,https://saco.csic.es/public.php/dav/files/nrJ3JGPZyZeQMW8/Model%20inputs/world/_pins.yaml,20260325T113350Z-145f3 +faostat-emissions-livestock,https://saco.csic.es/public.php/dav/files/nrJ3JGPZyZeQMW8/Model%20inputs/world/_pins.yaml,20260325T113403Z-23bf8 +faostat-trade-totals,https://saco.csic.es/public.php/dav/files/nrJ3JGPZyZeQMW8/Model%20inputs/world/_pins.yaml,20260325T120525Z-7b85f +luh2-areas,https://saco.csic.es/public.php/dav/files/nrJ3JGPZyZeQMW8/Model%20inputs/world/_pins.yaml,20260325T112205Z-4d7cb +international-yields,https://saco.csic.es/public.php/dav/files/nrJ3JGPZyZeQMW8/Model%20inputs/world/_pins.yaml,20260325T112220Z-b6167 +historical-trade-exports,https://saco.csic.es/public.php/dav/files/nrJ3JGPZyZeQMW8/Model%20inputs/world/_pins.yaml,20260325T121518Z-d548c +historical-trade-imports,https://saco.csic.es/public.php/dav/files/nrJ3JGPZyZeQMW8/Model%20inputs/world/_pins.yaml,20260325T121523Z-72a63 +gdp-population,https://saco.csic.es/public.php/dav/files/nrJ3JGPZyZeQMW8/Model%20inputs/world/_pins.yaml,20260325T085548Z-ec5a9 +faostat-production-processed,https://saco.csic.es/public.php/dav/files/nrJ3JGPZyZeQMW8/Model%20inputs/world/_pins.yaml,20260325T113346Z-5637e +faostat-fbs-new,https://saco.csic.es/public.php/dav/files/nrJ3JGPZyZeQMW8/Model%20inputs/world/_pins.yaml,20260325T113807Z-b184a +faostat-fbs-old,https://saco.csic.es/public.php/dav/files/nrJ3JGPZyZeQMW8/Model%20inputs/world/_pins.yaml,20260325T114920Z-874a4 +faostat-cbs-old-animal,https://saco.csic.es/public.php/dav/files/nrJ3JGPZyZeQMW8/Model%20inputs/world/_pins.yaml,20260325T115537Z-9e898 +faostat-cbs-old-crops,https://saco.csic.es/public.php/dav/files/nrJ3JGPZyZeQMW8/Model%20inputs/world/_pins.yaml,20260325T120222Z-3d77b +faostat-cbs-new,https://saco.csic.es/public.php/dav/files/nrJ3JGPZyZeQMW8/Model%20inputs/world/_pins.yaml,20260325T120441Z-ff6fe +fishstat-trade,https://saco.csic.es/public.php/dav/files/nrJ3JGPZyZeQMW8/Model%20inputs/world/_pins.yaml,20260330T095440Z-8bd94 +grafs_prod_destiny,https://saco.csic.es/public.php/dav/files/nrJ3JGPZyZeQMW8/Model%20inputs/nitrogen_spain/_pins.yaml,20250724T110924Z-0508f +biomass_coefs,https://saco.csic.es/public.php/dav/files/nrJ3JGPZyZeQMW8/Model%20inputs/nitrogen_spain/_pins.yaml,20250728T082553Z-f2fac +codes_coefs,https://saco.csic.es/public.php/dav/files/nrJ3JGPZyZeQMW8/Model%20inputs/nitrogen_spain/_pins.yaml,20250724T143014Z-a83d1 +crop_area_npp_ygpit_all,https://saco.csic.es/public.php/dav/files/nrJ3JGPZyZeQMW8/Model%20inputs/nitrogen_spain/_pins.yaml,20250728T100115Z-8cb10 +crop_area_npp_ygpitr_no_fallow,https://saco.csic.es/public.php/dav/files/nrJ3JGPZyZeQMW8/Model%20inputs/nitrogen_spain/_pins.yaml,20250728T093400Z-9bdb1 +feed_avail_all,https://saco.csic.es/public.php/dav/files/nrJ3JGPZyZeQMW8/Model%20inputs/nitrogen_spain/_pins.yaml,20250724T120137Z-6239a +livestock_prod_ygps,https://saco.csic.es/public.php/dav/files/nrJ3JGPZyZeQMW8/Model%20inputs/nitrogen_spain/_pins.yaml,20250728T103307Z-1d546 +n_balance_ygpit_all,https://saco.csic.es/public.php/dav/files/nrJ3JGPZyZeQMW8/Model%20inputs/nitrogen_spain/_pins.yaml,20260417T112701Z-9d07a,n-balance-ygpit-all +n_excretion_ygs,https://saco.csic.es/public.php/dav/files/nrJ3JGPZyZeQMW8/Model%20inputs/nitrogen_spain/_pins.yaml,20250814T093633Z-c429a +pie_full_destinies_fm,https://saco.csic.es/public.php/dav/files/nrJ3JGPZyZeQMW8/Model%20inputs/nitrogen_spain/_pins.yaml,20260417T142119Z-5fc5b,pie-full-destinies-fm-old +population_yg,https://saco.csic.es/public.php/dav/files/nrJ3JGPZyZeQMW8/Model%20inputs/nitrogen_spain/_pins.yaml,20250728T102929Z-b4f44 +processed_prov_fixed,https://saco.csic.es/public.php/dav/files/nrJ3JGPZyZeQMW8/Model%20inputs/nitrogen_spain/_pins.yaml,20250724T140654Z-23fcb +codes_coefs_items_full,https://saco.csic.es/public.php/dav/files/nrJ3JGPZyZeQMW8/Model%20inputs/nitrogen_spain/_pins.yaml,20250728T081525Z-c6479 +npp_ygpit,https://saco.csic.es/public.php/dav/files/nrJ3JGPZyZeQMW8/Model%20inputs/nitrogen_spain/_pins.yaml,20250728T084811Z-9e48b +intake_ygiac,https://saco.csic.es/public.php/dav/files/nrJ3JGPZyZeQMW8/Model%20inputs/nitrogen_spain/_pins.yaml,20250728T085614Z-4981f +grafs_crop_categories,https://saco.csic.es/public.php/dav/files/nrJ3JGPZyZeQMW8/Model%20inputs/nitrogen_spain/_pins.yaml,20260127T114257Z-afabb +livestock_units,https://saco.csic.es/public.php/dav/files/nrJ3JGPZyZeQMW8/Model%20inputs/nitrogen_spain/_pins.yaml,20260128T120326Z-40647 +n_fix_ygpit_all,https://saco.csic.es/public.php/dav/files/nrJ3JGPZyZeQMW8/Model%20inputs/nitrogen_spain/_pins.yaml,20260202T110154Z-2383a diff --git a/inst/scripts/check_import_totals_new.R b/inst/scripts/check_import_totals_new.R new file mode 100644 index 00000000..938dccfb --- /dev/null +++ b/inst/scripts/check_import_totals_new.R @@ -0,0 +1,15 @@ +library(devtools) +library(dplyr) + +load_all(quiet = TRUE) + +env_new <- new.env(parent = globalenv()) +sys.source("R/n_prov_destiny.R", envir = env_new) + +res_new <- env_new$create_n_prov_destiny() +nat_new <- env_new$create_n_nat_destiny() + +cat("res_new imports total:", sum(filter(res_new, Origin == "Outside")$MgN, na.rm = TRUE), "\n") +cat("res_new import rows:", nrow(filter(res_new, Origin == "Outside")), "\n") +cat("nat_new imports total:", sum(filter(nat_new, Origin == "Outside")$MgN, na.rm = TRUE), "\n") +cat("nat_new import rows:", nrow(filter(nat_new, Origin == "Outside")), "\n") diff --git a/inst/scripts/check_n_balance_straw.R b/inst/scripts/check_n_balance_straw.R new file mode 100644 index 00000000..7e1034a6 --- /dev/null +++ b/inst/scripts/check_n_balance_straw.R @@ -0,0 +1,31 @@ +library(whep) +library(dplyr) + +n_balance <- whep_read_file("n_balance_ygpit_all") +crop_area <- whep_read_file("crop_area_npp_ygpitr_no_fallow") + +cat("n_balance columns include Item:", "Item" %in% names(n_balance), "\n") +cat("n_balance columns include Name_biomass:", "Name_biomass" %in% names(n_balance), "\n") +cat( + "n_balance rows with straw token:", + sum( + grepl("straw", apply(n_balance, 1, paste, collapse = "|"), ignore.case = TRUE) + ), + "\n" +) + +if ("Item" %in% names(n_balance)) { + cat("n_balance Item==Straw rows:", nrow(filter(n_balance, Item == "Straw")), "\n") +} + +if ("Item" %in% names(crop_area)) { + cat("crop_area Item==Straw rows:", nrow(filter(crop_area, Item == "Straw")), "\n") +} + +if (all(c("Item", "Product_residue") %in% names(crop_area))) { + print( + crop_area |> + filter(Item == "Straw") |> + count(Product_residue, name = "rows") + ) +} diff --git a/inst/scripts/prepare_upload.R b/inst/scripts/prepare_upload.R index 140919dc..48f08dd4 100644 --- a/inst/scripts/prepare_upload.R +++ b/inst/scripts/prepare_upload.R @@ -26,10 +26,11 @@ create_version <- function(data, board, name, ...) { # Change this accordingly if your data is not CSV. # Please make the output a tibble. read_input <- function(path) { - path |> - readr::read_csv(show_col_types = FALSE) + data <- readr::read_csv(path, show_col_types = FALSE) + tibble::as_tibble(data) } + prepare_for_upload <- function(input_path, data_name, ...) { board <- pins::board_temp(versioned = TRUE) @@ -68,6 +69,6 @@ prepare_for_upload <- function(input_path, data_name, ...) { } prepare_for_upload( - "/path/to/your/data", - "simple_name_for_your_data" + "C:\\PhD\\GRAFS\\Inputs_SACO\\inputs_saco_new\\pie_full_destinies_fm.csv", + "pie_full_destinies_fm" ) diff --git a/man/calculate_nue_crops.Rd b/man/calculate_nue_crops.Rd new file mode 100644 index 00000000..3a795956 --- /dev/null +++ b/man/calculate_nue_crops.Rd @@ -0,0 +1,36 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/n_soil_inputs_nue.R +\name{calculate_nue_crops} +\alias{calculate_nue_crops} +\title{N soil inputs and Nitrogen Use Efficiency (NUE) for crop -------------} +\usage{ +calculate_nue_crops() +} +\value{ +A tibble containing nitrogen input, production, and NUE data. +It includes the following columns: +\itemize{ +\item \code{Year}: Year. +\item \code{Province_name}: The Spanish province. +\item \code{Item}: The item which was produced, defined in \code{names_biomass_cb}. +\item \code{Box}: One of the two systems of the GRAFS model: cropland or +semi-natural agroecosystems. +\item \code{deposition}: Atmospheric nitrogen deposition in megagrams (Mg). +\item \code{fixation}: Nitrogen fixation in megagrams (Mg). +\item \code{synthetic}: Synthetic nitrogen fertilizer applied to the land in +megagrams (Mg). +\item \code{manure}: Nitrogen in manure applied to the land in megagrams (Mg). +\item \code{urban}: Nitrogen in wastewater from human sources in megagrams (Mg). +\item \code{prod}: Produced nitrogen in megagrams (Mg). +\item \code{inputs}: Total nitrogen inputs in megagrams (Mg). +} +} +\description{ +N inputs (deposition, fixation, synthetic fertilizers, urban sources, manure) +and N production in Spain from 1860 to the present for the GRAFS model at the +provincial level. +The crop NUE is defined as the percentage of produced nitrogen relative to +the total nitrogen inputs to the soil. +Total soil inputs are calculated as: +inputs = deposition + fixation + synthetic + manure + urban +} diff --git a/man/calculate_nue_livestock.Rd b/man/calculate_nue_livestock.Rd new file mode 100644 index 00000000..ae58379c --- /dev/null +++ b/man/calculate_nue_livestock.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/n_soil_inputs_nue.R +\name{calculate_nue_livestock} +\alias{calculate_nue_livestock} +\title{NUE for Livestock ----------------------------------------------------} +\usage{ +calculate_nue_livestock() +} +\value{ +A tibble containing: +\itemize{ +\item \code{Year}: Year +\item \code{Province_name}: Spanish province +\item \code{Livestock_cat}: Livestock category +\item \code{Item}: Produced item +\item \code{prod_n}: Nitrogen in livestock products (Mg) +\item \code{feed_n}: Nitrogen in feed intake (Mg) +\item \code{excretion_n}: Nitrogen excreted (Mg) +\item \code{nue}: Nitrogen Use Efficiency (\%) +\item \code{mass_balance}: Mass balance ratio (\%) +} +} +\description{ +Calculates Nitrogen Use Efficiency (NUE) for livestock categories +(excluding pets). + +The livestock NUE is defined as the percentage of nitrogen in livestock +products relative to the nitrogen in feed intake: +nue = prod_n / feed_n * 100 + +Additionally, a mass balance is calculated to check the recovery of N in +products and excretion relative to feed intake: +mass_balance = (prod_n + excretion_n) / feed_n +} diff --git a/man/calculate_system_nue.Rd b/man/calculate_system_nue.Rd new file mode 100644 index 00000000..ef2df63c --- /dev/null +++ b/man/calculate_system_nue.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/n_soil_inputs_nue.R +\name{calculate_system_nue} +\alias{calculate_system_nue} +\title{System NUE -----------------------------------------------------------} +\usage{ +calculate_system_nue(n_soil_inputs = create_n_soil_inputs()) +} +\arguments{ +\item{n_soil_inputs}{A tibble of nitrogen soil input (deposition, fixation, +synthetic, manure, urban)} +} +\value{ +A tibble with the following columns: +\itemize{ +\item \code{Year}: Year +\item \code{Province_name}: Spanish province +\item \code{total_prod}: Total nitrogen production (Mg) +\item \code{inputs}: Total nitrogen inputs (Mg) +\item \code{nue_system}: System-level Nitrogen Use Efficiency (\%) +} +} +\description{ +Calculates the NUE for Spain at the provincial level. +The system NUE is defined as the percentage of total nitrogen production +(\code{total_prod}) relative to the sum of all nitrogen inputs (\code{inputs}) into the +soil system. +} diff --git a/man/create_grafs_plot_df.Rd b/man/create_grafs_plot_df.Rd new file mode 100644 index 00000000..f0ad1c95 --- /dev/null +++ b/man/create_grafs_plot_df.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/grafs_plot_df.R +\name{create_grafs_plot_df} +\alias{create_grafs_plot_df} +\title{Create GRAFS plot dataset} +\usage{ +create_grafs_plot_df() +} +\value{ +A tibble containing province, year, label, data, and alignment. +} +\description{ +Combines land input data and N flows from crops, livestock, imports, and +exports to generate a dataset of nitrogen (MgN) by province and year, to +create a GRAFS plot, offered by Alfredo Rodríguez. +} diff --git a/man/create_n_nat_destiny.Rd b/man/create_n_nat_destiny.Rd new file mode 100644 index 00000000..a152f67d --- /dev/null +++ b/man/create_n_nat_destiny.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/n_prov_destiny_national.R +\name{create_n_nat_destiny} +\alias{create_n_nat_destiny} +\title{GRAFS Nitrogen (N) flows – National Spain} +\usage{ +create_n_nat_destiny() +} +\value{ +A final tibble containing national N flow data by origin and destiny. +} +\description{ +Provides N flows of the Spanish agro-food system on a national level +between 1860 and 2020. This dataset is the national equivalent of the +provincial GRAFS model and represents Spain as a single system without +internal trade between provinces. All production, consumption and soil +inputs are aggregated nationally before calculating trade with the +outside. +} diff --git a/man/create_n_production.Rd b/man/create_n_production.Rd new file mode 100644 index 00000000..2fe1bdc2 --- /dev/null +++ b/man/create_n_production.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/n_soil_inputs_nue.R +\name{create_n_production} +\alias{create_n_production} +\title{N production for Spain -----------------------------------------------} +\usage{ +create_n_production() +} +\value{ +A tibble containing: +\itemize{ +\item \code{Year}: Year +\item \code{Province_name}: Spanish province +\item \code{Item}: Product item +\item \code{Box}: Ecosystem box +\item \code{Box_destiny}: Destination box +\item \code{import}: Imported N (Mg) +\item \code{prod}: Produced N (Mg) +} +} +\description{ +Calculates N production at the provincial level in Spain. +Production is derived from consumption, export, import, and other uses. +} diff --git a/man/create_n_prov_destiny.Rd b/man/create_n_prov_destiny.Rd new file mode 100644 index 00000000..b4663274 --- /dev/null +++ b/man/create_n_prov_destiny.Rd @@ -0,0 +1,36 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/n_prov_destiny.R +\name{create_n_prov_destiny} +\alias{create_n_prov_destiny} +\title{GRAFS Nitrogen (N) flows} +\usage{ +create_n_prov_destiny() +} +\value{ +A final tibble containing N flow data by origin and destiny. +It includes the following columns: +\itemize{ +\item \code{year}: The year in which the recorded event occurred. +\item \code{province_name}: The Spanish province where the data is from. +\item \code{item}: The item which was produced, defined in \code{names_biomass_cb}. +\item \code{box}: One of the GRAFS model systems: cropland, +Semi-natural agroecosystems, Livestock, Fish, or Agro-industry. +\item \code{origin}: The origin category of N: Cropland, +Semi-natural agroecosystems, Livestock, Fish, Agro-industry, Deposition, +Fixation, Synthetic, People (waste water), Livestock (manure). +\item \code{destiny}: The destiny category of N: population_food, +population_other_uses, livestock (feed), export, Cropland (for N soil +inputs). +\item \code{MgN}: Nitrogen amount in megagrams (Mg). +} +} +\description{ +Provides N flows of the spanish agro-food system on a provincial level +between 1860 and 2020. This dataset is the the base of the GRAFS model and +contains data in megagrams of N (MgN) for each year, province, item, origin +and destiny. Thereby, the origin column represents where N comes from, which +includes N soil inputs, imports and production. The destiny column shows +where N goes to, which includes export, population food, population other +uses and feed or cropland (in case of N soil inputs). +Processed items, residues, woody crops, grazed weeds are taken into account. +} diff --git a/man/create_n_soil_inputs.Rd b/man/create_n_soil_inputs.Rd new file mode 100644 index 00000000..ca79e65d --- /dev/null +++ b/man/create_n_soil_inputs.Rd @@ -0,0 +1,39 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/n_soil_inputs_nue.R +\name{create_n_soil_inputs} +\alias{create_n_soil_inputs} +\title{Nitrogen (N) soil inputs for Spain ----------------------------------} +\usage{ +create_n_soil_inputs() +} +\value{ +A tibble containing: +\itemize{ +\item \code{Year}: Year +\item \code{Province_name}: Spanish province +\item \code{Item}: Crop, land use, or biomass item +\item \code{Box}: Land use or ecosystem box for aggregation +\item \code{deposition}: N input from atmospheric deposition (Mg) +\item \code{fixation}: N input from biological N fixation (Mg) +\item \code{synthetic}: N input from synthetic fertilizers (Mg) +\item \code{manure}: N input from livestock manure (Mg) +\item \code{urban}: N input from urban sources (Mg) +} +} +\description{ +Calculates total nitrogen inputs to soils in Spain at the provincial level. +This includes contributions from: +\itemize{ +\item Atmospheric deposition (\code{deposition}) +\item Biological nitrogen fixation (\code{fixation}) +\item Synthetic fertilizers (\code{synthetic}) +\item Manure (solid, liquid) (\code{manure}) +\item Urban sources (\code{urban}) +} + +Special land use categories and items are aggregated: +\itemize{ +\item Semi-natural agroecosystems (e.g., Dehesa, Pasture_Shrubland) +\item Firewood biomass (e.g., Conifers, Holm oak) +} +} diff --git a/man/dot-combine_and_finalize_df.Rd b/man/dot-combine_and_finalize_df.Rd new file mode 100644 index 00000000..1b998b2a --- /dev/null +++ b/man/dot-combine_and_finalize_df.Rd @@ -0,0 +1,42 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/grafs_plot_df.R +\name{.combine_and_finalize_df} +\alias{.combine_and_finalize_df} +\title{Combine and finalize nitrogen flow dataset} +\usage{ +.combine_and_finalize_df( + crop_livestock_flows, + df_livestock, + df_lv_r_m, + df_crop_losses, + df_animal_losses, + df_livestock_total, + df_livestock_gas_loss +) +} +\arguments{ +\item{crop_livestock_flows}{Data frame of crop-livestock nitrogen flows.} + +\item{df_livestock}{Data frame of livestock nitrogen data.} + +\item{df_lv_r_m}{Data frame of livestock feed data.} + +\item{df_crop_losses}{Data frame of crop nitrogen losses.} + +\item{df_animal_losses}{Data frame of animal nitrogen losses.} + +\item{df_livestock_total}{Data frame of total livestock nitrogen.} + +\item{df_livestock_gas_loss}{Data frame of livestock gaseous nitrogen losses.} +} +\value{ +A tibble with standardized columns \code{province}, \code{year}, \code{label}, +\code{data}, and \code{align}. +} +\description{ +Merges all the created nitrogen datasets into a unified structure. +Adding missing labels and setting WIDTH_MAX to 1500. IMPHUMHONEY should be 0. +The other labels (CRPNOLV", "NCONTCROP") are +set to 0, since I don't know how to create them yet. +} +\keyword{internal} diff --git a/man/dot-create_N_input_df.Rd b/man/dot-create_N_input_df.Rd new file mode 100644 index 00000000..e5f1b6f0 --- /dev/null +++ b/man/dot-create_N_input_df.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/grafs_plot_df.R +\name{.create_n_input_df} +\alias{.create_n_input_df} +\title{Create dataset for greeonhouse, grassland, and N soil input} +\usage{ +.create_n_input_df(n_balance, df_land) +} +\value{ +A tibble with columns \code{province}, \code{year}, \code{label}, \code{data}, and \code{align}. +} +\description{ +Generates dataset for greenhouse, grasslands, N inputs (manure, deposition, +fixation, surplus, and wastewater). +Combines with crops/forest dataset. +} +\keyword{internal} diff --git a/man/dot-create_animal_losses_df.Rd b/man/dot-create_animal_losses_df.Rd new file mode 100644 index 00000000..1be49909 --- /dev/null +++ b/man/dot-create_animal_losses_df.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/grafs_plot_df.R +\name{.create_animal_losses_df} +\alias{.create_animal_losses_df} +\title{Create animal losses dataset} +\usage{ +.create_animal_losses_df(prov_destiny_df) +} +\arguments{ +\item{prov_destiny_df}{A data frame containing production and destiny +information.} +} +\value{ +A tibble with columns \code{province}, \code{year}, \code{label}, \code{data}, \code{align}. +} +\description{ +Generates nitrogen loss data from livestock, including metabolic losses and +livestock products used for other uses. +} +\keyword{internal} diff --git a/man/dot-create_crop_losses_df.Rd b/man/dot-create_crop_losses_df.Rd new file mode 100644 index 00000000..e797f21e --- /dev/null +++ b/man/dot-create_crop_losses_df.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/grafs_plot_df.R +\name{.create_crop_losses_df} +\alias{.create_crop_losses_df} +\title{Create crop losses dataset} +\usage{ +.create_crop_losses_df(n_balance, prov_destiny_df) +} +\arguments{ +\item{prov_destiny_df}{A data frame containing production and destiny +information.} +} +\value{ +A tibble with columns \code{province}, \code{year}, \code{label}, \code{data}, \code{align}. +} +\description{ +Generates nitrogen other uses from cropland. +} +\keyword{internal} diff --git a/man/dot-create_feed_df.Rd b/man/dot-create_feed_df.Rd new file mode 100644 index 00000000..5cf55194 --- /dev/null +++ b/man/dot-create_feed_df.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/grafs_plot_df.R +\name{.create_feed_df} +\alias{.create_feed_df} +\title{Create feed from cropland dataset} +\usage{ +.create_feed_df(prov_destiny_df) +} +\arguments{ +\item{prov_destiny_df}{A data frame containing production and destiny +information.} +} +\value{ +A tibble with columns \code{province}, \code{year}, \code{label}, \code{data}, \code{align}. +} +\description{ +Creates nitrogen data representing feed transfers from cropland to +ruminant and monogastric livestock. +} +\keyword{internal} diff --git a/man/dot-create_land_df.Rd b/man/dot-create_land_df.Rd new file mode 100644 index 00000000..c2a446a8 --- /dev/null +++ b/man/dot-create_land_df.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/grafs_plot_df.R +\name{.create_land_df} +\alias{.create_land_df} +\title{Create land dataset by province} +\usage{ +.create_land_df() +} +\value{ +A tibble with columns \code{province}, \code{year}, \code{label}, \code{data}, and \code{align}. +} +\description{ +Generates a dataset of land use by province and year of cropland (permanent +and non permanent), horticulture, and forest area for N and area (ha), +separated into irrigated and rainfed. +} +\keyword{internal} diff --git a/man/dot-create_livestock_df.Rd b/man/dot-create_livestock_df.Rd new file mode 100644 index 00000000..cfa84532 --- /dev/null +++ b/man/dot-create_livestock_df.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/grafs_plot_df.R +\name{.create_livestock_df} +\alias{.create_livestock_df} +\title{Create livestock production dataset} +\usage{ +.create_livestock_df(prov_destiny_df) +} +\arguments{ +\item{prov_destiny_df}{A data frame containing production and destiny +information.} +} +\value{ +A tibble with columns \code{province}, \code{year}, \code{label}, \code{data}, \code{align}. +} +\description{ +Generates nitrogen production from livestock destined for population +(food or other uses) by province and year, distinguishing edible and +non-edible products. +} +\keyword{internal} diff --git a/man/dot-create_livestock_export_df.Rd b/man/dot-create_livestock_export_df.Rd new file mode 100644 index 00000000..447d6f7c --- /dev/null +++ b/man/dot-create_livestock_export_df.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/grafs_plot_df.R +\name{.create_livestock_export_df} +\alias{.create_livestock_export_df} +\title{Create livestock export dataset} +\usage{ +.create_livestock_export_df(prov_destiny_df) +} +\arguments{ +\item{prov_destiny_df}{A data frame containing production and destiny +information.} +} +\value{ +A tibble with columns \code{province}, \code{year}, \code{label}, \code{data}, \code{align}. +} +\description{ +Generates nitrogen flows associated with exported livestock products. +} +\keyword{internal} diff --git a/man/dot-create_livestock_gas_loss_df.Rd b/man/dot-create_livestock_gas_loss_df.Rd new file mode 100644 index 00000000..b0b857bd --- /dev/null +++ b/man/dot-create_livestock_gas_loss_df.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/grafs_plot_df.R +\name{.create_livestock_gas_loss_df} +\alias{.create_livestock_gas_loss_df} +\title{Create livestock gaseous loss dataset} +\usage{ +.create_livestock_gas_loss_df() +} +\value{ +A tibble with columns \code{province}, \code{year}, \code{label}, \code{data}, \code{align}. +} +\description{ +Calculates gaseous nitrogen losses from livestock excretion based on +excretion and loss share data. +} +\keyword{internal} diff --git a/man/dot-create_livestock_lu_df.Rd b/man/dot-create_livestock_lu_df.Rd new file mode 100644 index 00000000..75ccaee4 --- /dev/null +++ b/man/dot-create_livestock_lu_df.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/grafs_plot_df.R +\name{.create_livestock_lu_df} +\alias{.create_livestock_lu_df} +\title{Create Livestock LU (Livestock Units) dataset} +\usage{ +.create_livestock_lu_df() +} +\value{ +A tibble with columns \code{province}, \code{year}, \code{label}, \code{data}, and \code{align}. +} +\description{ +Calculated livestock units (LU) by province and year for ruminants and +monogastric animals. +Converts stock numbers into standardized LU values using conversion factors. +} +\keyword{internal} diff --git a/man/dot-create_livestock_total_df.Rd b/man/dot-create_livestock_total_df.Rd new file mode 100644 index 00000000..a7085b79 --- /dev/null +++ b/man/dot-create_livestock_total_df.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/grafs_plot_df.R +\name{.create_livestock_total_df} +\alias{.create_livestock_total_df} +\title{Create combined livestock nitrogen dataset} +\usage{ +.create_livestock_total_df( + crop_livestock_flows, + df_livestock_export, + df_animal_losses +) +} +\arguments{ +\item{crop_livestock_flows}{Data frame with livestock-to-human nitrogen data.} + +\item{df_livestock_export}{Data frame with livestock export nitrogen data.} + +\item{df_animal_losses}{Data frame with livestock loss nitrogen data.} +} +\value{ +A tibble with columns \code{province}, \code{year}, \code{label}, \code{data}, \code{align}. +} +\description{ +Combines nitrogen data from livestock destined for humans, exports, and +losses to generate combined nitrogen output from livestock. +} +\keyword{internal} diff --git a/man/dot-create_milk_df.Rd b/man/dot-create_milk_df.Rd new file mode 100644 index 00000000..19b077c1 --- /dev/null +++ b/man/dot-create_milk_df.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/grafs_plot_df.R +\name{.create_milk_df} +\alias{.create_milk_df} +\title{Create milk production dataset} +\usage{ +.create_milk_df(prov_destiny_df) +} +\arguments{ +\item{prov_destiny_df}{A data frame containing production and destiny +information.} +} +\value{ +A tibble with columns \code{province}, \code{year}, \code{label}, \code{data}, \code{align}. +} +\description{ +Generates nitrogen data for milk and dairy products consumed by population. +} +\keyword{internal} diff --git a/man/dot-create_n_flow_df.Rd b/man/dot-create_n_flow_df.Rd new file mode 100644 index 00000000..da94354b --- /dev/null +++ b/man/dot-create_n_flow_df.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/grafs_plot_df.R +\name{.create_n_flow_df} +\alias{.create_n_flow_df} +\title{Create nitrogen flow dataset by province} +\usage{ +.create_n_flow_df(prov_destiny_df = NULL) +} +\arguments{ +\item{prov_destiny_df}{A data frame containing production and destiny +information.} +} +\value{ +A tibble with columns \code{province}, \code{year}, \code{label}, \code{data}, and +\code{align}. + +A tibble with columns \code{province}, \code{year}, \code{label}, \code{data}, \code{align}. +} +\description{ +Generates nitrogen flow data (MgN) by province and year, representing +#' @title Create nitrogen flow dataset by province + +Generates nitrogen flow data (MgN) by province and year, representing +exchanges between cropland, livestock, grassland, population, and exports. +} +\keyword{internal} diff --git a/man/dot-create_n_import_df.Rd b/man/dot-create_n_import_df.Rd new file mode 100644 index 00000000..4754f703 --- /dev/null +++ b/man/dot-create_n_import_df.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/grafs_plot_df.R +\name{.create_n_import_df} +\alias{.create_n_import_df} +\title{Create nitrogen import dataset by province} +\usage{ +.create_n_import_df(prov_destiny_df = NULL) +} +\arguments{ +\item{prov_destiny_df}{A data frame containing production and destiny +information.} +} +\value{ +A tibble with columns \code{province}, \code{year}, \code{label}, \code{data}, and \code{align}. +} +\description{ +Generates a dataset of nitrogen imports (MgN) by province and year, splitting +imports, livestock, and population data into labels. +} +\keyword{internal} diff --git a/man/dot-create_population_df.Rd b/man/dot-create_population_df.Rd new file mode 100644 index 00000000..d8593c21 --- /dev/null +++ b/man/dot-create_population_df.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/grafs_plot_df.R +\name{.create_population_df} +\alias{.create_population_df} +\title{Create population dataset} +\usage{ +.create_population_df() +} +\value{ +A tibble with columns \code{province}, \code{year}, \code{label}, \code{data}, \code{align}. +} +\description{ +Loads population data (in million inhabitants, MInhab) and converts it +into the GRAFS plot structure. +} +\keyword{internal} diff --git a/renv.lock b/renv.lock index 8b6bef62..0d051713 100644 --- a/renv.lock +++ b/renv.lock @@ -4486,6 +4486,46 @@ "Maintainer": "Jennifer Bryan ", "Repository": "CRAN" }, + "readxl": { + "Package": "readxl", + "Version": "1.4.5", + "Source": "Repository", + "Title": "Read Excel Files", + "Authors@R": "c( person(\"Hadley\", \"Wickham\", , \"hadley@posit.co\", role = \"aut\", comment = c(ORCID = \"0000-0003-4757-117X\")), person(\"Jennifer\", \"Bryan\", , \"jenny@posit.co\", role = c(\"aut\", \"cre\"), comment = c(ORCID = \"0000-0002-6983-2759\")), person(\"Posit, PBC\", role = c(\"cph\", \"fnd\"), comment = \"Copyright holder of all R code and all C/C++ code without explicit copyright attribution\"), person(\"Marcin\", \"Kalicinski\", role = c(\"ctb\", \"cph\"), comment = \"Author of included RapidXML code\"), person(\"Komarov Valery\", role = c(\"ctb\", \"cph\"), comment = \"Author of included libxls code\"), person(\"Christophe Leitienne\", role = c(\"ctb\", \"cph\"), comment = \"Author of included libxls code\"), person(\"Bob Colbert\", role = c(\"ctb\", \"cph\"), comment = \"Author of included libxls code\"), person(\"David Hoerl\", role = c(\"ctb\", \"cph\"), comment = \"Author of included libxls code\"), person(\"Evan Miller\", role = c(\"ctb\", \"cph\"), comment = \"Author of included libxls code\") )", + "Description": "Import excel files into R. Supports '.xls' via the embedded 'libxls' C library and '.xlsx' via the embedded 'RapidXML' C++ library . Works on Windows, Mac and Linux without external dependencies.", + "License": "MIT + file LICENSE", + "URL": "https://readxl.tidyverse.org, https://github.com/tidyverse/readxl", + "BugReports": "https://github.com/tidyverse/readxl/issues", + "Depends": [ + "R (>= 3.6)" + ], + "Imports": [ + "cellranger", + "tibble (>= 2.0.1)", + "utils" + ], + "Suggests": [ + "covr", + "knitr", + "rmarkdown", + "testthat (>= 3.1.6)", + "withr" + ], + "LinkingTo": [ + "cpp11 (>= 0.4.0)", + "progress" + ], + "VignetteBuilder": "knitr", + "Config/Needs/website": "tidyverse/tidytemplate, tidyverse", + "Config/testthat/edition": "3", + "Encoding": "UTF-8", + "Note": "libxls v1.6.3 c199d13", + "RoxygenNote": "7.3.2", + "NeedsCompilation": "yes", + "Author": "Hadley Wickham [aut] (), Jennifer Bryan [aut, cre] (), Posit, PBC [cph, fnd] (Copyright holder of all R code and all C/C++ code without explicit copyright attribution), Marcin Kalicinski [ctb, cph] (Author of included RapidXML code), Komarov Valery [ctb, cph] (Author of included libxls code), Christophe Leitienne [ctb, cph] (Author of included libxls code), Bob Colbert [ctb, cph] (Author of included libxls code), David Hoerl [ctb, cph] (Author of included libxls code), Evan Miller [ctb, cph] (Author of included libxls code)", + "Maintainer": "Jennifer Bryan ", + "Repository": "https://packagemanager.posit.co/cran/__linux__/noble/latest" + }, "rematch": { "Package": "rematch", "Version": "2.0.0", @@ -4912,6 +4952,42 @@ "Maintainer": "Gábor Csárdi ", "Repository": "CRAN" }, + "s2": { + "Package": "s2", + "Version": "1.1.9", + "Source": "Repository", + "Title": "Spherical Geometry Operators Using the S2 Geometry Library", + "Authors@R": "c( person(given = \"Dewey\", family = \"Dunnington\", role = c(\"aut\"), email = \"dewey@fishandwhistle.net\", comment = c(ORCID = \"0000-0002-9415-4582\")), person(given = \"Edzer\", family = \"Pebesma\", role = c(\"aut\", \"cre\"), email = \"edzer.pebesma@uni-muenster.de\", comment = c(ORCID = \"0000-0001-8049-7069\")), person(\"Ege\", \"Rubak\", email=\"rubak@math.aau.dk\", role = c(\"aut\")), person(\"Jeroen\", \"Ooms\", , \"jeroen.ooms@stat.ucla.edu\", role = \"ctb\", comment = \"configure script\"), person(family = \"Google, Inc.\", role = \"cph\", comment = \"Original s2geometry.io source code\") )", + "Description": "Provides R bindings for Google's s2 library for geometric calculations on the sphere. High-performance constructors and exporters provide high compatibility with existing spatial packages, transformers construct new geometries from existing geometries, predicates provide a means to select geometries based on spatial relationships, and accessors extract information about geometries.", + "License": "Apache License (== 2.0)", + "Encoding": "UTF-8", + "LazyData": "true", + "RoxygenNote": "7.3.2", + "SystemRequirements": "cmake, OpenSSL >= 1.0.1, Abseil >= 20230802.0", + "LinkingTo": [ + "Rcpp", + "wk" + ], + "Imports": [ + "Rcpp", + "wk (>= 0.6.0)" + ], + "Suggests": [ + "bit64", + "testthat (>= 3.0.0)", + "vctrs" + ], + "URL": "https://r-spatial.github.io/s2/, https://github.com/r-spatial/s2, http://s2geometry.io/", + "BugReports": "https://github.com/r-spatial/s2/issues", + "Depends": [ + "R (>= 3.0.0)" + ], + "Config/testthat/edition": "3", + "NeedsCompilation": "yes", + "Author": "Dewey Dunnington [aut] (ORCID: ), Edzer Pebesma [aut, cre] (ORCID: ), Ege Rubak [aut], Jeroen Ooms [ctb] (configure script), Google, Inc. [cph] (Original s2geometry.io source code)", + "Maintainer": "Edzer Pebesma ", + "Repository": "CRAN" + }, "sass": { "Package": "sass", "Version": "0.4.10", @@ -5029,6 +5105,86 @@ "Author": "Gábor Csárdi [cre], Hadley Wickham [aut], Winston Chang [aut], Robert Flight [aut], Kirill Müller [aut], Jim Hester [aut], R Core team [ctb], Posit Software, PBC [cph, fnd]", "Repository": "CRAN" }, + "sf": { + "Package": "sf", + "Version": "1.0-21", + "Source": "Repository", + "Title": "Simple Features for R", + "Authors@R": "c(person(given = \"Edzer\", family = \"Pebesma\", role = c(\"aut\", \"cre\"), email = \"edzer.pebesma@uni-muenster.de\", comment = c(ORCID = \"0000-0001-8049-7069\")), person(given = \"Roger\", family = \"Bivand\", role = \"ctb\", comment = c(ORCID = \"0000-0003-2392-6140\")), person(given = \"Etienne\", family = \"Racine\", role = \"ctb\"), person(given = \"Michael\", family = \"Sumner\", role = \"ctb\"), person(given = \"Ian\", family = \"Cook\", role = \"ctb\"), person(given = \"Tim\", family = \"Keitt\", role = \"ctb\"), person(given = \"Robin\", family = \"Lovelace\", role = \"ctb\"), person(given = \"Hadley\", family = \"Wickham\", role = \"ctb\"), person(given = \"Jeroen\", family = \"Ooms\", role = \"ctb\", comment = c(ORCID = \"0000-0002-4035-0289\")), person(given = \"Kirill\", family = \"M\\u00fcller\", role = \"ctb\"), person(given = \"Thomas Lin\", family = \"Pedersen\", role = \"ctb\"), person(given = \"Dan\", family = \"Baston\", role = \"ctb\"), person(given = \"Dewey\", family = \"Dunnington\", role = \"ctb\", comment = c(ORCID = \"0000-0002-9415-4582\")) )", + "Description": "Support for simple feature access, a standardized way to encode and analyze spatial vector data. Binds to 'GDAL' for reading and writing data, to 'GEOS' for geometrical operations, and to 'PROJ' for projection conversions and datum transformations. Uses by default the 's2' package for geometry operations on geodetic (long/lat degree) coordinates.", + "License": "GPL-2 | MIT + file LICENSE", + "URL": "https://r-spatial.github.io/sf/, https://github.com/r-spatial/sf", + "BugReports": "https://github.com/r-spatial/sf/issues", + "Depends": [ + "methods", + "R (>= 3.3.0)" + ], + "Imports": [ + "classInt (>= 0.4-1)", + "DBI (>= 0.8)", + "graphics", + "grDevices", + "grid", + "magrittr", + "s2 (>= 1.1.0)", + "stats", + "tools", + "units (>= 0.7-0)", + "utils" + ], + "Suggests": [ + "blob", + "nanoarrow", + "covr", + "dplyr (>= 1.0.0)", + "ggplot2", + "knitr", + "lwgeom (>= 0.2-14)", + "maps", + "mapview", + "Matrix", + "microbenchmark", + "odbc", + "pbapply", + "pillar", + "pool", + "raster", + "rlang", + "rmarkdown", + "RPostgres (>= 1.1.0)", + "RPostgreSQL", + "RSQLite", + "sp (>= 1.2-4)", + "spatstat (>= 2.0-1)", + "spatstat.geom", + "spatstat.random", + "spatstat.linnet", + "spatstat.utils", + "stars (>= 0.6-0)", + "terra", + "testthat (>= 3.0.0)", + "tibble (>= 1.4.1)", + "tidyr (>= 1.2.0)", + "tidyselect (>= 1.0.0)", + "tmap (>= 2.0)", + "vctrs", + "wk (>= 0.9.0)" + ], + "LinkingTo": [ + "Rcpp" + ], + "VignetteBuilder": "knitr", + "Encoding": "UTF-8", + "RoxygenNote": "7.3.2", + "Config/testthat/edition": "2", + "Config/needs/coverage": "XML", + "SystemRequirements": "GDAL (>= 2.0.1), GEOS (>= 3.4.0), PROJ (>= 4.8.0), sqlite3", + "Collate": "'RcppExports.R' 'init.R' 'import-standalone-s3-register.R' 'crs.R' 'bbox.R' 'read.R' 'db.R' 'sfc.R' 'sfg.R' 'sf.R' 'bind.R' 'wkb.R' 'wkt.R' 'plot.R' 'geom-measures.R' 'geom-predicates.R' 'geom-transformers.R' 'transform.R' 'proj.R' 'sp.R' 'grid.R' 'arith.R' 'tidyverse.R' 'tidyverse-vctrs.R' 'cast_sfg.R' 'cast_sfc.R' 'graticule.R' 'datasets.R' 'aggregate.R' 'agr.R' 'maps.R' 'join.R' 'sample.R' 'valid.R' 'collection_extract.R' 'jitter.R' 'sgbp.R' 'spatstat.R' 'stars.R' 'crop.R' 'gdal_utils.R' 'nearest.R' 'normalize.R' 'sf-package.R' 'defunct.R' 'z_range.R' 'm_range.R' 'shift_longitude.R' 'make_grid.R' 's2.R' 'terra.R' 'geos-overlayng.R' 'break_antimeridian.R'", + "NeedsCompilation": "yes", + "Author": "Edzer Pebesma [aut, cre] (ORCID: ), Roger Bivand [ctb] (ORCID: ), Etienne Racine [ctb], Michael Sumner [ctb], Ian Cook [ctb], Tim Keitt [ctb], Robin Lovelace [ctb], Hadley Wickham [ctb], Jeroen Ooms [ctb] (ORCID: ), Kirill Müller [ctb], Thomas Lin Pedersen [ctb], Dan Baston [ctb], Dewey Dunnington [ctb] (ORCID: )", + "Maintainer": "Edzer Pebesma ", + "Repository": "CRAN" + }, "shiny": { "Package": "shiny", "Version": "1.10.0", @@ -5661,6 +5817,50 @@ "Maintainer": "Davis Vaughan ", "Repository": "CRAN" }, + "units": { + "Package": "units", + "Version": "0.8-7", + "Source": "Repository", + "Title": "Measurement Units for R Vectors", + "Authors@R": "c(person(\"Edzer\", \"Pebesma\", role = c(\"aut\", \"cre\"), email = \"edzer.pebesma@uni-muenster.de\", comment = c(ORCID = \"0000-0001-8049-7069\")), person(\"Thomas\", \"Mailund\", role = \"aut\", email = \"mailund@birc.au.dk\"), person(\"Tomasz\", \"Kalinowski\", role = \"aut\"), person(\"James\", \"Hiebert\", role = \"ctb\"), person(\"Iñaki\", \"Ucar\", role = \"aut\", email = \"iucar@fedoraproject.org\", comment = c(ORCID = \"0000-0001-6403-5550\")), person(\"Thomas Lin\", \"Pedersen\", role = \"ctb\") )", + "Depends": [ + "R (>= 3.0.2)" + ], + "Imports": [ + "Rcpp" + ], + "LinkingTo": [ + "Rcpp (>= 0.12.10)" + ], + "Suggests": [ + "NISTunits", + "measurements", + "xml2", + "magrittr", + "pillar (>= 1.3.0)", + "dplyr (>= 1.0.0)", + "vctrs (>= 0.3.1)", + "ggplot2 (> 3.2.1)", + "testthat (>= 3.0.0)", + "vdiffr", + "knitr", + "rvest", + "rmarkdown" + ], + "VignetteBuilder": "knitr", + "Description": "Support for measurement units in R vectors, matrices and arrays: automatic propagation, conversion, derivation and simplification of units; raising errors in case of unit incompatibility. Compatible with the POSIXct, Date and difftime classes. Uses the UNIDATA udunits library and unit database for unit compatibility checking and conversion. Documentation about 'units' is provided in the paper by Pebesma, Mailund & Hiebert (2016, ), included in this package as a vignette; see 'citation(\"units\")' for details.", + "SystemRequirements": "udunits-2", + "License": "GPL-2", + "URL": "https://r-quantities.github.io/units/, https://github.com/r-quantities/units", + "BugReports": "https://github.com/r-quantities/units/issues", + "RoxygenNote": "7.3.2", + "Encoding": "UTF-8", + "Config/testthat/edition": "3", + "NeedsCompilation": "yes", + "Author": "Edzer Pebesma [aut, cre] (), Thomas Mailund [aut], Tomasz Kalinowski [aut], James Hiebert [ctb], Iñaki Ucar [aut] (), Thomas Lin Pedersen [ctb]", + "Maintainer": "Edzer Pebesma ", + "Repository": "CRAN" + }, "urlchecker": { "Package": "urlchecker", "Version": "1.0.1", @@ -6038,6 +6238,35 @@ "Maintainer": "Lionel Henry ", "Repository": "CRAN" }, + "wk": { + "Package": "wk", + "Version": "0.9.4", + "Source": "Repository", + "Title": "Lightweight Well-Known Geometry Parsing", + "Authors@R": "c( person(given = \"Dewey\", family = \"Dunnington\", role = c(\"aut\", \"cre\"), email = \"dewey@fishandwhistle.net\", comment = c(ORCID = \"0000-0002-9415-4582\")), person(given = \"Edzer\", family = \"Pebesma\", role = c(\"aut\"), email = \"edzer.pebesma@uni-muenster.de\", comment = c(ORCID = \"0000-0001-8049-7069\")), person(given = \"Anthony\", family = \"North\", email = \"anthony.jl.north@gmail.com\", role = c(\"ctb\")) )", + "Maintainer": "Dewey Dunnington ", + "Description": "Provides a minimal R and C++ API for parsing well-known binary and well-known text representation of geometries to and from R-native formats. Well-known binary is compact and fast to parse; well-known text is human-readable and is useful for writing tests. These formats are useful in R only if the information they contain can be accessed in R, for which high-performance functions are provided here.", + "License": "MIT + file LICENSE", + "Encoding": "UTF-8", + "RoxygenNote": "7.2.3", + "Suggests": [ + "testthat (>= 3.0.0)", + "vctrs (>= 0.3.0)", + "sf", + "tibble", + "readr" + ], + "URL": "https://paleolimbot.github.io/wk/, https://github.com/paleolimbot/wk", + "BugReports": "https://github.com/paleolimbot/wk/issues", + "Config/testthat/edition": "3", + "Depends": [ + "R (>= 2.10)" + ], + "LazyData": "true", + "NeedsCompilation": "yes", + "Author": "Dewey Dunnington [aut, cre] (), Edzer Pebesma [aut] (), Anthony North [ctb]", + "Repository": "CRAN" + }, "xfun": { "Package": "xfun", "Version": "0.52", diff --git a/renv/activate.R b/renv/activate.R index 90b251ca..e4d691b3 100644 --- a/renv/activate.R +++ b/renv/activate.R @@ -695,19 +695,11 @@ local({ } - renv_bootstrap_platform_prefix_default <- function() { - - # read version component - version <- Sys.getenv("RENV_PATHS_VERSION", unset = "R-%v") - - # expand placeholders - placeholders <- list( - list("%v", format(getRversion()[1, 1:2])), - list("%V", format(getRversion()[1, 1:3])) - ) + renv_bootstrap_platform_prefix <- function() { - for (placeholder in placeholders) - version <- gsub(placeholder[[1L]], placeholder[[2L]], version, fixed = TRUE) + # construct version prefix + version <- paste(R.version$major, R.version$minor, sep = ".") + prefix <- paste("R", numeric_version(version)[1, 1:2], sep = "-") # include SVN revision for development versions of R # (to avoid sharing platform-specific artefacts with released versions of R) @@ -716,19 +708,10 @@ local({ identical(R.version[["nickname"]], "Unsuffered Consequences") if (devel) - version <- paste(version, R.version[["svn rev"]], sep = "-r") - - version - - } - - renv_bootstrap_platform_prefix <- function() { - - # construct version prefix - version <- renv_bootstrap_platform_prefix_default() + prefix <- paste(prefix, R.version[["svn rev"]], sep = "-r") # build list of path components - components <- c(version, R.version$platform) + components <- c(prefix, R.version$platform) # include prefix if provided by user prefix <- renv_bootstrap_platform_prefix_impl() @@ -967,14 +950,14 @@ local({ } renv_bootstrap_validate_version_dev <- function(version, description) { - + expected <- description[["RemoteSha"]] if (!is.character(expected)) return(FALSE) - + pattern <- sprintf("^\\Q%s\\E", version) grepl(pattern, expected, perl = TRUE) - + } renv_bootstrap_validate_version_release <- function(version, description) { @@ -1215,89 +1198,86 @@ local({ } renv_json_read_patterns <- function() { - + list( - + # objects - list("{", "\t\n\tobject(\t\n\t", TRUE), - list("}", "\t\n\t)\t\n\t", TRUE), - + list("{", "\t\n\tobject(\t\n\t"), + list("}", "\t\n\t)\t\n\t"), + # arrays - list("[", "\t\n\tarray(\t\n\t", TRUE), - list("]", "\n\t\n)\n\t\n", TRUE), - + list("[", "\t\n\tarray(\t\n\t"), + list("]", "\n\t\n)\n\t\n"), + # maps - list(":", "\t\n\t=\t\n\t", TRUE), - - # newlines - list("\\u000a", "\n", FALSE) - + list(":", "\t\n\t=\t\n\t") + ) - + } renv_json_read_envir <- function() { envir <- new.env(parent = emptyenv()) - + envir[["+"]] <- `+` envir[["-"]] <- `-` - + envir[["object"]] <- function(...) { result <- list(...) names(result) <- as.character(names(result)) result } - + envir[["array"]] <- list - + envir[["true"]] <- TRUE envir[["false"]] <- FALSE envir[["null"]] <- NULL - + envir - + } renv_json_read_remap <- function(object, patterns) { - + # repair names if necessary if (!is.null(names(object))) { - + nms <- names(object) for (pattern in patterns) nms <- gsub(pattern[[2L]], pattern[[1L]], nms, fixed = TRUE) names(object) <- nms - + } - + # repair strings if necessary if (is.character(object)) { for (pattern in patterns) object <- gsub(pattern[[2L]], pattern[[1L]], object, fixed = TRUE) } - + # recurse for other objects if (is.recursive(object)) for (i in seq_along(object)) object[i] <- list(renv_json_read_remap(object[[i]], patterns)) - + # return remapped object object - + } renv_json_read_default <- function(file = NULL, text = NULL) { # read json text text <- paste(text %||% readLines(file, warn = FALSE), collapse = "\n") - + # convert into something the R parser will understand patterns <- renv_json_read_patterns() transformed <- text for (pattern in patterns) transformed <- gsub(pattern[[1L]], pattern[[2L]], transformed, fixed = TRUE) - + # parse it rfile <- tempfile("renv-json-", fileext = ".R") on.exit(unlink(rfile), add = TRUE) @@ -1307,10 +1287,9 @@ local({ # evaluate in safe environment result <- eval(json, envir = renv_json_read_envir()) - # fix up strings if necessary -- do so only with reversible patterns - patterns <- Filter(function(pattern) pattern[[3L]], patterns) + # fix up strings if necessary renv_json_read_remap(result, patterns) - + } diff --git a/tests/testthat/test-create-grafs-plot-df.R b/tests/testthat/test-create-grafs-plot-df.R new file mode 100644 index 00000000..2b7aea72 --- /dev/null +++ b/tests/testthat/test-create-grafs-plot-df.R @@ -0,0 +1,3 @@ +test_that("create_grafs_plot_df exists and is a function", { + expect_true(is.function(create_grafs_plot_df)) +}) diff --git a/tests/testthat/test_bilateral_trade.R b/tests/testthat/test_bilateral_trade.R deleted file mode 100644 index 0e6b2067..00000000 --- a/tests/testthat/test_bilateral_trade.R +++ /dev/null @@ -1,302 +0,0 @@ -testthat::test_that(".prefer_flow_direction chooses preferred trade data", { - bilateral_trade <- tibble::tribble( - ~from_code, ~to_code, ~year, ~item_cbs_code, ~element, ~value, - 1, 2, 2000, 1, "Import", 0, - 1, 2, 2000, 1, "Export", 0, - 1, 2, 2000, 2, "Export", 0, - 1, 3, 2000, 2, "Import", 0, - 2, 3, 2000, 2, "Import", 0, - 2, 3, 2001, 2, "Export", 0, - 2, 3, 2001, 2, "Import", 0, - ) |> - dplyr::arrange(from_code, to_code, year, item_cbs_code) - - brute_group_by_result <- bilateral_trade |> - dplyr::group_by(from_code, to_code, year, item_cbs_code) |> - dplyr::filter(dplyr::n() == 1 | element == "Import") |> - dplyr::ungroup() |> - dplyr::arrange(from_code, to_code, year, item_cbs_code) - - my_result <- .prefer_flow_direction(bilateral_trade, "Import") |> - dplyr::arrange(from_code, to_code, year, item_cbs_code) - - expected_import_result <- tibble::tribble( - ~from_code, ~to_code, ~year, ~item_cbs_code, ~element, ~value, - 1, 2, 2000, 1, "Import", 0, - 1, 2, 2000, 2, "Export", 0, - 1, 3, 2000, 2, "Import", 0, - 2, 3, 2000, 2, "Import", 0, - 2, 3, 2001, 2, "Import", 0, - ) |> - dplyr::arrange(from_code, to_code, year, item_cbs_code) - - testthat::expect_equal(my_result, brute_group_by_result) - testthat::expect_equal(my_result, expected_import_result) - - brute_group_by_result <- bilateral_trade |> - dplyr::group_by(from_code, to_code, year, item_cbs_code) |> - dplyr::filter(dplyr::n() == 1 | element == "Export") |> - dplyr::ungroup() |> - dplyr::arrange(from_code, to_code, year, item_cbs_code) - - my_result <- .prefer_flow_direction(bilateral_trade, "Export") |> - dplyr::arrange(from_code, to_code, year, item_cbs_code) - - expected_export_result <- tibble::tribble( - ~from_code, ~to_code, ~year, ~item_cbs_code, ~element, ~value, - 1, 2, 2000, 1, "Export", 0, - 1, 2, 2000, 2, "Export", 0, - 1, 3, 2000, 2, "Import", 0, - 2, 3, 2000, 2, "Import", 0, - 2, 3, 2001, 2, "Export", 0, - ) |> - dplyr::arrange(from_code, to_code, year, item_cbs_code) - - testthat::expect_equal(my_result, brute_group_by_result) - testthat::expect_equal(my_result, expected_export_result) -}) - -testthat::test_that(".estimate_bilateral_trade creates expected matrix", { - exports <- c(5, 0, 4) - imports <- c(1, 3, 0) - expected <- matrix( - # fmt: skip - c( - 0.9027778, 2.708333, 0, - 0.0000000, 0.000000, 0, - 0.7222222, 2.166667, 0 - ), - byrow = TRUE, - ncol = 3 - ) - result <- .estimate_bilateral_trade(exports, imports) - testthat::expect_equal(result, expected, tolerance = 1e-6) - - # Martin' slide example - exports <- c(500, 300, 100, 0, 0, 0) - imports <- c(200, 150, 120, 200, 190, 30) - expected <- matrix( - # fmt: skip - c( - 112, 84, 67, 112, 106, 17, - 67, 50, 40, 67, 64, 10, - 22, 17, 13, 22, 21, 3, - 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0 - ), - byrow = TRUE, - ncol = 6 - ) - result <- .estimate_bilateral_trade(exports, imports) - testthat::expect_equal(result, expected, tolerance = 1) - - # No data imports sum 0 - exports <- c(5, 0, 4) - imports <- c(0, 0, 0) - expected <- matrix( - # fmt: skip - c( - 0, 0, 0, - 0, 0, 0, - 0, 0, 0 - ), - byrow = TRUE, - ncol = 3 - ) - result <- .estimate_bilateral_trade(exports, imports) - testthat::expect_equal(result, expected, tolerance = 1) - - # No data exports sum 0 - exports <- c(0, 0, 0) - imports <- c(1, 3, 0) - expected <- matrix( - # fmt: skip - c( - 0, 0, 0, - 0, 0, 0, - 0, 0, 0 - ), - byrow = TRUE, - ncol = 3 - ) - result <- .estimate_bilateral_trade(exports, imports) - testthat::expect_equal(result, expected, tolerance = 1) - - # No data both sum 0 - exports <- c(0, 0, 0) - imports <- c(0, 0, 0) - expected <- matrix( - # fmt: skip - c( - 0, 0, 0, - 0, 0, 0, - 0, 0, 0 - ), - byrow = TRUE, - ncol = 3 - ) - result <- .estimate_bilateral_trade(exports, imports) - testthat::expect_equal(result, expected, tolerance = 1) -}) - -testthat::test_that(".fill_missing_trade only fills NA entries of matrix", { - original <- matrix( - # fmt: skip - c( - 140, NA, NA, - 50, 100, NA, - NA, NA, NA - ), - byrow = TRUE, - ncol = 3 - ) - - expected <- matrix( - # fmt: skip - c( - 140.00, 7.65, 2.45, - 50.00, 100.00, 2.96, - 3.64, 4.55, 1.46 - ), - byrow = TRUE, - ncol = 3 - ) - total_trade <- tibble::tribble( - ~area_code, ~export, ~import, - 4, 250, 200, - 6, 200, 250, - 7, 100, 80 - ) |> - .balance_total_trade() - - original |> - .fill_missing_trade(total_trade) |> - testthat::expect_equal(expected, tolerance = 1e-2) -}) - -testthat::test_that(".fill_missing_trade does nothing for non-NA matrices", { - original <- matrix( - # fmt: skip - c( - 140, 40, 30, - 50, 100, 77, - 11, 324, 23 - ), - byrow = TRUE, - ncol = 3 - ) - total_trade <- tibble::tribble( - ~area_code, ~export, ~import, - 4, 250, 250, - 6, 300, 550, - 7, 450, 150 - ) |> - .balance_total_trade() - - original |> - .fill_missing_trade(total_trade) |> - testthat::expect_equal(original, tolerance = 1e-2) -}) - -testthat::test_that(".fill_missing_trade fills with 0s if row sum is already past CBS report", { - original <- matrix( - # fmt: skip - c( - 140, NA, - NA, 100 - ), - byrow = TRUE, - ncol = 2 - ) - expected <- matrix( - # fmt: skip - c( - 140, 0, - 0, 100 - ), - byrow = TRUE, - ncol = 2 - ) - total_trade <- tibble::tribble( - ~area_code, ~export, ~import, - 4, 130, 200, - 6, 90, 100, - ) |> - .balance_total_trade() - - original |> - .fill_missing_trade(total_trade) |> - testthat::expect_equal(expected, tolerance = 1e-2) -}) - -testthat::test_that(".balance_matrix makes rows and columns have target sum", { - total_trade <- tibble::tibble( - area_code = c(4, 6, 7, 9, 10, 75), - export = c(500, 300, 100, 0, 0, 0), - import = c(200, 150, 120, 200, 190, 30) - ) |> - .balance_total_trade() - - trade_matrix <- matrix( - # fmt: skip - c( - 140, 30, 34, 140, 120, 8, - 50, 100, 20, 50, 60, 5, - 11, 8, 50, 11, 11, 2, - 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0 - ), - byrow = TRUE, - ncol = 6 - ) - - # Rescaling exports to match total sum of 890 imports - balanced_total_exports <- c(494.44, 296.67, 98.89, 0, 0, 0) - balanced_total_imports <- c(200, 150, 120, 200, 190, 30) - - result <- .balance_matrix(trade_matrix, total_trade) - testthat::expect_equal( - rowSums(result), - balanced_total_exports, - tolerance = 1e-2 - ) - testthat::expect_equal( - colSums(result), - balanced_total_imports, - tolerance = 1e-2 - ) -}) - -testthat::test_that(".build_trade_matrix completes missing countries", { - codes <- factor(c(1, 2, 4, 5, 999)) - btd <- tibble::tribble( - ~from_code, ~to_code, ~value, - 1, 2, 1, - 1, 4, 2, - 4, 2, 1, - 5, 4, 2 - ) |> - dplyr::mutate( - from_code = factor(from_code, levels = codes), - to_code = factor(to_code, levels = codes), - ) - expected <- matrix( - # fmt: skip - c( - NA, 1, 2, NA, NA, - NA, NA, NA, NA, NA, - NA, 1, NA, NA, NA, - NA, NA, 2, NA, NA, - NA, NA, NA, NA, NA - ), - byrow = TRUE, - ncol = 5, - dimnames = list(sort(codes), sort(codes)) - ) - - btd |> - .build_trade_matrix(codes) |> - testthat::expect_equal(expected) -}) diff --git a/tests/testthat/test_code_names.R b/tests/testthat/test_code_names.R deleted file mode 100644 index 5e0db313..00000000 --- a/tests/testthat/test_code_names.R +++ /dev/null @@ -1,244 +0,0 @@ -testthat::test_that("add_area_name correctly sets new column in table", { - table <- tibble::tibble(area_code = c(1, 2, 4444, 3)) - - table |> - add_area_name() |> - testthat::expect_equal( - tibble::tribble( - ~area_code, ~area_name, - 1, "Armenia", - 2, "Afghanistan", - 4444, NA, - 3, "Albania" - ) - ) - - table |> - dplyr::rename(dummy_name = area_code) |> - add_area_name(code_column = "dummy_name") |> - testthat::expect_equal( - tibble::tribble( - ~dummy_name, ~area_name, - 1, "Armenia", - 2, "Afghanistan", - 4444, NA, - 3, "Albania" - ) - ) - - table |> - dplyr::rename(dummy_name = area_code) |> - add_area_name(code_column = "dummy_name", name_column = "my_name") |> - testthat::expect_equal( - tibble::tribble( - ~dummy_name, ~my_name, - 1, "Armenia", - 2, "Afghanistan", - 4444, NA, - 3, "Albania" - ) - ) -}) - -testthat::test_that("add_area_code correctly sets new column in table", { - table <- tibble::tibble( - area_name = c("Armenia", "Afghanistan", "Dummy Country", "Albania") - ) - - table |> - add_area_code() |> - testthat::expect_equal( - tibble::tribble( - ~area_name, ~area_code, - "Armenia", 1, - "Afghanistan", 2, - "Dummy Country", NA, - "Albania", 3 - ) - ) - - table |> - dplyr::rename(dummy_name = area_name) |> - add_area_code(name_column = "dummy_name") |> - testthat::expect_equal( - tibble::tribble( - ~dummy_name, ~area_code, - "Armenia", 1, - "Afghanistan", 2, - "Dummy Country", NA, - "Albania", 3 - ) - ) - - table |> - dplyr::rename(dummy_name = area_name) |> - add_area_code(name_column = "dummy_name", code_column = "dummy_code") |> - testthat::expect_equal( - tibble::tribble( - ~dummy_name, ~dummy_code, - "Armenia", 1, - "Afghanistan", 2, - "Dummy Country", NA, - "Albania", 3 - ) - ) -}) - -testthat::test_that("add_item_cbs_name correctly sets new column in table", { - table <- tibble::tibble(item_cbs_code = c(2559, 2744, 9876)) - - table |> - add_item_cbs_name() |> - testthat::expect_equal( - tibble::tribble( - ~item_cbs_code, ~item_cbs_name, - 2559, "Cottonseed", - 2744, "Eggs", - 9876, NA - ) - ) - - table |> - dplyr::rename(dummy_code = item_cbs_code) |> - add_item_cbs_name(code_column = "dummy_code") |> - testthat::expect_equal( - tibble::tribble( - ~dummy_code, ~item_cbs_name, - 2559, "Cottonseed", - 2744, "Eggs", - 9876, NA - ) - ) - - table |> - dplyr::rename(dummy_code = item_cbs_code) |> - add_item_cbs_name(code_column = "dummy_code", name_column = "my_name") |> - testthat::expect_equal( - tibble::tribble( - ~dummy_code, ~my_name, - 2559, "Cottonseed", - 2744, "Eggs", - 9876, NA - ) - ) -}) - -testthat::test_that("add_item_cbs_code correctly sets new column in table", { - table <- tibble::tibble(item_cbs_name = c("Cottonseed", "Eggs", "Dummy item")) - - table |> - add_item_cbs_code() |> - testthat::expect_equal( - tibble::tribble( - ~item_cbs_name, ~item_cbs_code, - "Cottonseed", 2559, - "Eggs", 2744, - "Dummy item", NA - ) - ) - - table |> - dplyr::rename(dummy_name = item_cbs_name) |> - add_item_cbs_code(name_column = "dummy_name") |> - testthat::expect_equal( - tibble::tribble( - ~dummy_name, ~item_cbs_code, - "Cottonseed", 2559, - "Eggs", 2744, - "Dummy item", NA - ) - ) - - table |> - dplyr::rename(dummy_name = item_cbs_name) |> - add_item_cbs_code(name_column = "dummy_name", code_column = "dummy_code") |> - testthat::expect_equal( - tibble::tribble( - ~dummy_name, ~dummy_code, - "Cottonseed", 2559, - "Eggs", 2744, - "Dummy item", NA - ) - ) -}) - -testthat::test_that("add_item_prod_name correctly sets new column in table", { - table <- tibble::tibble(item_prod_code = c(27, 358, 12345)) - - table |> - add_item_prod_name() |> - testthat::expect_equal( - tibble::tribble( - ~item_prod_code, ~item_prod_name, - 27, "Rice", - 358, "Cabbages", - 12345, NA - ) - ) - - table |> - dplyr::rename(dummy_code = item_prod_code) |> - add_item_prod_name(code_column = "dummy_code") |> - testthat::expect_equal( - tibble::tribble( - ~dummy_code, ~item_prod_name, - 27, "Rice", - 358, "Cabbages", - 12345, NA - ) - ) - - table |> - dplyr::rename(dummy_code = item_prod_code) |> - add_item_prod_name(code_column = "dummy_code", name_column = "my_name") |> - testthat::expect_equal( - tibble::tribble( - ~dummy_code, ~my_name, - 27, "Rice", - 358, "Cabbages", - 12345, NA - ) - ) -}) - -testthat::test_that("add_item_prod_code correctly sets new column in table", { - table <- tibble::tibble(item_prod_name = c("Rice", "Cabbages", "Dummy item")) - - table |> - add_item_prod_code() |> - testthat::expect_equal( - tibble::tribble( - ~item_prod_name, ~item_prod_code, - "Rice", 27, - "Cabbages", 358, - "Dummy item", NA - ) - ) - - table |> - dplyr::rename(dummy_name = item_prod_name) |> - add_item_prod_code(name_column = "dummy_name") |> - testthat::expect_equal( - tibble::tribble( - ~dummy_name, ~item_prod_code, - "Rice", 27, - "Cabbages", 358, - "Dummy item", NA - ) - ) - - table |> - dplyr::rename(dummy_name = item_prod_name) |> - add_item_prod_code( - name_column = "dummy_name", - code_column = "dummy_code" - ) |> - testthat::expect_equal( - tibble::tribble( - ~dummy_name, ~dummy_code, - "Rice", 27, - "Cabbages", 358, - "Dummy item", NA - ) - ) -}) diff --git a/tests/testthat/test_commodity_balance_sheet.R b/tests/testthat/test_commodity_balance_sheet.R deleted file mode 100644 index 67a9eb6a..00000000 --- a/tests/testthat/test_commodity_balance_sheet.R +++ /dev/null @@ -1,99 +0,0 @@ -# TODO: Consider fixing these unbalances somehow -k_ignore_unbalanced <- c( - "Linum" = 772, - "Seed cotton" = 328, - "Oil, palm fruit" = 254, - "Hemp" = 776, - "Coconuts" = 248, - "Kapok fruit" = 310, - "Palmkernel Cake" = 2595 -) - -k_tolerance <- 1e-6 - -testthat::test_that("get_wide_cbs gives consistent Commodity Balance Sheet", { - testthat::skip_on_ci() - testthat::skip_on_cran() - - cbs <- get_wide_cbs() |> - dplyr::filter(!(item_cbs_code %in% k_ignore_unbalanced)) |> - dplyr::mutate( - value_in = production + import + stock_retrieval, - value_out = export + food + feed + seed + processing + other_uses, - my_domestic_supply = food + feed + seed + processing + other_uses - ) - - pointblank::expect_col_vals_expr( - cbs, - rlang::expr( - dplyr::near(value_in, value_out, tol = !!k_tolerance) - ) - ) - - pointblank::expect_col_vals_expr( - cbs, - rlang::expr( - dplyr::near(domestic_supply, my_domestic_supply, tol = !!k_tolerance) - ) - ) -}) - -testthat::test_that("get_codes_coeffs gives consistent shares of processed items", { - testthat::skip_on_ci() - testthat::skip_on_cran() - - coefs <- get_processing_coefs() - cbs <- get_wide_cbs() - - df <- coefs |> - dplyr::left_join( - cbs, - dplyr::join_by( - year, - area_code, - item_cbs_code_processed == item_cbs_code - ) - ) |> - dplyr::group_by(year, area_code, item_cbs_code_processed) |> - dplyr::mutate(total_proc_item = sum(final_value_processed)) - - pointblank::expect_col_vals_expr( - df, - rlang::expr( - dplyr::near(production, total_proc_item, tol = !!k_tolerance) - ), - # TODO: Fix few problematic data rows - threshold = 0.99 - ) - - pointblank::expect_col_vals_expr( - df, - rlang::expr( - dplyr::near( - value_to_process * initial_conversion_factor, - initial_value_processed, - tol = !!k_tolerance - ) - ) - ) - pointblank::expect_col_vals_expr( - df, - rlang::expr( - dplyr::near( - initial_value_processed * conversion_factor_scaling, - final_value_processed, - tol = !!k_tolerance - ) - ) - ) - pointblank::expect_col_vals_expr( - df, - rlang::expr( - dplyr::near( - initial_conversion_factor * conversion_factor_scaling, - final_conversion_factor, - tol = !!k_tolerance - ) - ) - ) -}) diff --git a/tests/testthat/test_gapfilling.R b/tests/testthat/test_gapfilling.R deleted file mode 100644 index c8f263e0..00000000 --- a/tests/testthat/test_gapfilling.R +++ /dev/null @@ -1,356 +0,0 @@ -# Helper fixtures -------------------------------------------------------------- - -linear_fill_fixture <- function() { - tibble::tribble( - ~category, ~year, ~value, - "a", 2015, NA, - "a", 2016, 3, - "a", 2017, NA, - "a", 2018, NA, - "a", 2019, 0, - "a", 2020, NA, - "b", 2015, 1, - "b", 2016, NA, - "b", 2017, NA, - "b", 2018, NA, - "b", 2019, 5, - "b", 2020, NA - ) -} - -simple_linear_series <- function() { - tibble::tribble( - ~year, ~value, - 2015, 10, - 2016, NA, - 2017, NA, - 2018, NA, - 2019, 20 - ) -} - -single_anchor_series <- function(anchor = 42) { - tibble::tribble( - ~year, ~value, - 2015, NA, - 2016, anchor, - 2017, NA - ) -} - -proxy_fill_fixture <- function() { - tibble::tribble( - ~category, ~year, ~value, ~proxy_variable, - "a", 2015, NA, 1, - "a", 2016, 3, 2, - "a", 2017, NA, 2, - "a", 2018, NA, 2, - "a", 2019, 0, 2, - "a", 2020, NA, 2, - "b", 2015, 1, 1, - "b", 2016, NA, 2, - "b", 2017, NA, 3, - "b", 2018, NA, 4, - "b", 2019, 5, 5, - "b", 2020, NA, 6 - ) -} - -sum_fill_fixture <- function() { - tibble::tribble( - ~category, ~year, ~value, ~change_variable, - "a", 2014, NA, 2, - "a", 2015, NA, 3, - "a", 2016, 3, 2, - "a", 2017, NA, 3, - "a", 2018, NA, 4, - "a", 2019, 0, 1, - "a", 2020, NA, 1, - "b", 2015, 1, 0, - "b", 2016, NA, 0, - "b", 2017, NA, 0, - "b", 2018, NA, 0, - "b", 2019, 5, 0, - "b", 2020, NA, 1 - ) -} - -# linear_fill ------------------------------------------------------------------ - -testthat::test_that("linear_fill fills gaps and preserves originals", { - result <- linear_fill_fixture() |> - linear_fill(value, year, .by = "category") - - result |> - pointblank::expect_col_exists("source_value") |> - pointblank::expect_col_vals_in_set( - source_value, - c( - "Original", - "Linear interpolation", - "Last value carried forward", - "First value carried backwards" - ) - ) |> - pointblank::expect_col_vals_not_null(value) |> - pointblank::expect_col_vals_equal( - value, - c(3, 0, 1, 5), - preconditions = \(df) df |> dplyr::filter(source_value == "Original") - ) - - dplyr::is_grouped_df(result) |> - testthat::expect_false() -}) - -testthat::test_that("linear_fill interpolates between anchor points, and adds flags", { - linear_fill_fixture() |> - linear_fill( - value, - year, - interpolate = TRUE, - fill_forward = FALSE, - fill_backward = FALSE, - .by = "category" - ) |> - testthat::expect_equal( - tibble::tribble( - ~category, ~year, ~value, ~source_value, - "a", 2015, NA, "Gap not filled", - "a", 2016, 3, "Original", - "a", 2017, 2, "Linear interpolation", - "a", 2018, 1, "Linear interpolation", - "a", 2019, 0, "Original", - "a", 2020, NA, "Gap not filled", - "b", 2015, 1, "Original", - "b", 2016, 2, "Linear interpolation", - "b", 2017, 3, "Linear interpolation", - "b", 2018, 4, "Linear interpolation", - "b", 2019, 5, "Original", - "b", 2020, NA, "Gap not filled" - ) - ) -}) - -testthat::test_that("linear_fill carries values backward from first anchor, and adds flags", { - linear_fill_fixture() |> - linear_fill( - value, - year, - interpolate = FALSE, - fill_forward = FALSE, - fill_backward = TRUE, - .by = "category" - ) |> - testthat::expect_equal( - tibble::tribble( - ~category, ~year, ~value, ~source_value, - "a", 2015, 3, "First value carried backwards", - "a", 2016, 3, "Original", - "a", 2017, NA, "Gap not filled", - "a", 2018, NA, "Gap not filled", - "a", 2019, 0, "Original", - "a", 2020, NA, "Gap not filled", - "b", 2015, 1, "Original", - "b", 2016, NA, "Gap not filled", - "b", 2017, NA, "Gap not filled", - "b", 2018, NA, "Gap not filled", - "b", 2019, 5, "Original", - "b", 2020, NA, "Gap not filled" - ) - ) -}) - -testthat::test_that("linear_fill carries values forward from last anchor, and adds flags", { - linear_fill_fixture() |> - linear_fill( - value, - year, - interpolate = FALSE, - fill_forward = TRUE, - fill_backward = FALSE, - .by = "category" - ) |> - testthat::expect_equal( - tibble::tribble( - ~category, ~year, ~value, ~source_value, - "a", 2015, NA, "Gap not filled", - "a", 2016, 3, "Original", - "a", 2017, NA, "Gap not filled", - "a", 2018, NA, "Gap not filled", - "a", 2019, 0, "Original", - "a", 2020, 0, "Last value carried forward", - "b", 2015, 1, "Original", - "b", 2016, NA, "Gap not filled", - "b", 2017, NA, "Gap not filled", - "b", 2018, NA, "Gap not filled", - "b", 2019, 5, "Original", - "b", 2020, 5, "Last value carried forward" - ) - ) -}) - -testthat::test_that("linear_fill interpolates grouped series", { - linear_fill_fixture() |> - linear_fill(value, year, .by = "category") |> - pointblank::expect_col_vals_equal( - value, - c(3, 3, 2, 1, 0, 0), - preconditions = \(df) df |> dplyr::filter(category == "a") - ) |> - pointblank::expect_col_vals_equal( - value, - c(1, 2, 3, 4, 5, 5), - preconditions = \(df) df |> dplyr::filter(category == "b") - ) -}) - -testthat::test_that("linear_fill propagates a single anchor value", { - single_anchor_series() |> - linear_fill( - value, - year, - interpolate = FALSE, - fill_forward = TRUE, - fill_backward = TRUE - ) |> - pointblank::expect_col_vals_equal(value, c(42, 42, 42)) |> - pointblank::expect_col_vals_in_set( - source_value, - c( - "First value carried backwards", - "Original", - "Last value carried forward" - ) - ) -}) - -# proxy_fill ------------------------------------------------------------------ - -testthat::test_that("proxy_fill scales gaps from proxy ratios", { - proxy_fill_fixture() |> - proxy_fill( - value, - proxy_variable, - year, - .by = "category" - ) |> - pointblank::expect_col_exists("proxy_ratio") |> - pointblank::expect_col_exists("source_value") |> - pointblank::expect_col_vals_in_set( - source_value, - c( - "Original", - "Proxy interpolated", - "Proxy carried forward", - "Proxy carried backwards" - ) - ) |> - pointblank::expect_col_vals_equal( - value, - c(3, 0, 1, 5), - preconditions = \(df) df |> dplyr::filter(source_value == "Original") - ) |> - pointblank::expect_col_vals_expr( - ~ dplyr::near(proxy_ratio, value / proxy_variable, tol = 1e-6), - preconditions = \(df) df |> dplyr::filter(!is.na(value)) - ) -}) - -testthat::test_that("proxy_fill works without grouping variables", { - tibble::tribble( - ~year, ~value, ~proxy_variable, - 2015, 10, 5, - 2016, NA, 10, - 2017, 30, 15 - ) |> - proxy_fill(value, proxy_variable, year) |> - pointblank::expect_col_exists("proxy_ratio") |> - pointblank::expect_col_vals_not_null(proxy_ratio) -}) - -# sum_fill --------------------------------------------------------------------- - -testthat::test_that("sum_fill accumulates changes while keeping originals", { - sum_fill_fixture() |> - sum_fill( - value, - change_variable, - start_with_zero = TRUE, - .by = "category" - ) |> - pointblank::expect_col_exists("source_value") |> - pointblank::expect_col_vals_in_set( - source_value, - c("Original", "Filled with sum") - ) |> - pointblank::expect_col_vals_not_null(value) |> - pointblank::expect_col_vals_equal( - value, - c(2, 5, 3, 6, 10, 0, 1), - preconditions = \(df) df |> dplyr::filter(category == "a") - ) |> - pointblank::expect_col_vals_equal( - value, - c(1, 1, 1, 1, 5, 6), - preconditions = \(df) df |> dplyr::filter(category == "b") - ) -}) - -testthat::test_that("sum_fill handles accumulation without explicit groups", { - tibble::tribble( - ~year, ~value, ~change_variable, - 2015, 10, 0, - 2016, NA, 2, - 2017, NA, 3, - 2018, NA, 1 - ) |> - sum_fill(value, change_variable) |> - pointblank::expect_col_vals_equal(value, c(10, 12, 15, 16)) |> - pointblank::expect_col_vals_in_set( - source_value, - c("Original", "Filled with sum") - ) -}) - -testthat::test_that("sum_fill start_with_zero toggles behaviour", { - contiguous_gaps <- tibble::tribble( - ~value, ~change_variable, - NA, 1, - NA, 2, - NA, 3, - NA, 4 - ) - - contiguous_gaps |> - sum_fill(value, change_variable) |> - pointblank::expect_col_vals_equal(value, c(1, 3, 6, 10)) |> - pointblank::expect_col_vals_equal(source_value, "Filled with sum") - - contiguous_gaps |> - sum_fill( - value, - change_variable, - start_with_zero = FALSE - ) |> - pointblank::expect_col_vals_null(value) -}) - -testthat::test_that("sum_fill respects grouping keys", { - sum_fill_fixture() |> - sum_fill( - value, - change_variable, - .by = "category" - ) |> - pointblank::expect_col_vals_equal( - value, - c(2, 5, 3, 6, 10, 0, 1), - preconditions = \(df) df |> dplyr::filter(category == "a") - ) |> - pointblank::expect_col_vals_equal( - value, - c(1, 1, 1, 1, 5, 6), - preconditions = \(df) df |> dplyr::filter(category == "b") - ) -}) diff --git a/tests/testthat/test_input_files.R b/tests/testthat/test_input_files.R deleted file mode 100644 index 02f121fb..00000000 --- a/tests/testthat/test_input_files.R +++ /dev/null @@ -1,77 +0,0 @@ -testthat::test_that(".fetch_file_info fails for non-existent file_alias", { - file_inputs <- dplyr::tribble( - ~alias, ~board_url, ~version, - "file_alias_1", "some_url", "some_version" - ) - - testthat::expect_error( - .fetch_file_info("file_alias_2", file_inputs), - "There is no file entry with alias file_alias_2" - ) -}) - -testthat::test_that(".fetch_file_info fails for duplicated entries only in filtered rows", { - file_inputs <- dplyr::tribble( - ~alias, ~board_url, ~version, - "file_alias_1", "some_url", "some_version", - "file_alias_1", "some_other_url", "some_other_version", - "file_alias_2", "some_url", "some_version_2" - ) - - testthat::expect_error( - .fetch_file_info("file_alias_1", file_inputs), - paste0( - "There are 2 file entries with alias file_alias_1 and there should ", - "be only one. Double check the content of ", - "'whep_inputs' dataset." - ) - ) - - # Don't bother making the call fully work. It fails when trying to download, - # so it already passed the filter we wanted to test. - testthat::expect_error(whep_read_file("file_alias_2")) -}) - -testthat::test_that(".read_file reads file with correct extension", { - testthat::local_mocked_bindings( - read_csv = function(...) { - tibble::tibble(a = 1) - }, - .package = "readr" - ) - testthat::local_mocked_bindings( - read_parquet = function(...) { - tibble::tibble(a = 2) - }, - .package = "nanoparquet" - ) - - paths <- c("some_file.csv", "some_file.parquet", "some_file.tsv") - - .read_file(paths, "csv") |> - testthat::expect_equal(tibble::tibble(a = 1)) - - .read_file(paths, "parquet") |> - testthat::expect_equal(tibble::tibble(a = 2)) - - .read_file(paths, "txt") |> - testthat::expect_error( - "Unknown file type txt. Available for this file: csv, parquet, and tsv" - ) -}) - -testthat::test_that(".choose_version sets correct version for pins call", { - paths <- c("some_file.csv", "some_file.parquet", "some_file.tsv") - - .choose_version(frozen_version = "some_version", user_version = NULL) |> - testthat::expect_equal("some_version") - - .choose_version(frozen_version = "some_version", user_version = "latest") |> - testthat::expect_equal(NULL) - - .choose_version( - frozen_version = "some_version", - user_version = "some_other_version" - ) |> - testthat::expect_equal("some_other_version") -}) diff --git a/tests/testthat/test_sources.R b/tests/testthat/test_sources.R deleted file mode 100644 index 47659df9..00000000 --- a/tests/testthat/test_sources.R +++ /dev/null @@ -1,40 +0,0 @@ -library("testthat") - -test_that("trade source data is expanded from year range to single year rows", { - trade_sources <- tibble::tibble( - Name = c("a", "b", "c", "d", "e"), - Trade = c("t1", "t2", "t3", NA, "t5"), - Info_Format = c("year", "partial_series", "year", "year", "year"), - Timeline_Start = c(1, 1, 2, 1, 3), - Timeline_End = c(3, 4, 5, 1, 2), - Timeline_Freq = c(1, 1, 2, 1, NA), - `Imp/Exp` = "Imp", - SACO_link = NA, - ) - expected <- tibble::tibble( - Name = c("a_1", "a_2", "a_3", "b", "b", "b", "b", "c_2", "c_4"), - Trade = c("t1", "t1", "t1", "t2", "t2", "t2", "t2", "t3", "t3"), - Info_Format = c( - "year", - "year", - "year", - "partial_series", - "partial_series", - "partial_series", - "partial_series", - "year", - "year" - ), - Year = c(1, 2, 3, 1, 2, 3, 4, 2, 4), - ) - - actual <- - trade_sources |> - expand_trade_sources() |> - dplyr::ungroup() - - expect_equal( - dplyr::select(actual, Name, Trade, Info_Format, Year), - expected - ) -}) diff --git a/tests/testthat/test_supply_use.R b/tests/testthat/test_supply_use.R deleted file mode 100644 index 9c08e0e4..00000000 --- a/tests/testthat/test_supply_use.R +++ /dev/null @@ -1,152 +0,0 @@ -.expect_equal_unordered <- function(actual, expected) { - actual <- actual |> - dplyr::select(sort(names(actual))) |> - dplyr::arrange(dplyr::across(everything())) - - expected <- expected |> - dplyr::select(sort(names(actual))) |> - dplyr::arrange(dplyr::across(everything())) - - testthat::expect_equal(actual, expected) -} - -testthat::test_that(".build_processing works for processed items", { - coeffs <- tibble::tribble( - ~year, ~area_code, ~item_cbs_code_to_process, ~value_to_process, - ~item_cbs_code_processed, ~final_value_processed, - 2000, 1, 1, 10, 2, 20, - 2000, 1, 1, 10, 3, 30, - 2000, 1, 4, 20, 2, 40, - 2000, 2, 5, 30, 6, 20 - ) - - expected <- tibble::tribble( - ~year, ~area_code, ~proc_group, ~proc_cbs_code, ~item_cbs_code, - ~value, ~type, - 2000, 1, "processing", 1, 2, 20, "supply", - 2000, 1, "processing", 1, 3, 30, "supply", - 2000, 1, "processing", 1, 1, 10, "use", - 2000, 1, "processing", 4, 2, 40, "supply", - 2000, 1, "processing", 4, 4, 20, "use", - 2000, 2, "processing", 5, 6, 20, "supply", - 2000, 2, "processing", 5, 5, 30, "use" - ) - - coeffs |> - .build_processing() |> - .expect_equal_unordered(expected) -}) - -testthat::test_that(".build_use_husbandry gives feed intake needs for animal husbandry", { - feed_intake <- tibble::tribble( - ~year, ~area_code, ~live_anim_code, ~item_cbs_code, ~supply, - 2000, 1, 1, 2, 20, - 2000, 1, 1, 3, 40, - 2000, 2, 4, 6, 40, - 2000, 2, 5, 6, 20, - 2001, 2, 5, 7, 20 - ) - - expected <- tibble::tribble( - ~year, ~area_code, ~proc_cbs_code, ~item_cbs_code, ~value, ~type, - 2000, 1, 1, 2, 20, "use", - 2000, 1, 1, 3, 40, "use", - 2000, 2, 4, 6, 40, "use", - 2000, 2, 5, 6, 20, "use", - 2001, 2, 5, 7, 20, "use" - ) - - feed_intake |> - .build_use_husbandry() |> - .expect_equal_unordered(expected) -}) - -testthat::test_that(".build_supply_husbandry gives livestock and their products", { - husbandry_items <- tibble::tibble(live_anim_code = c(1, 2, 4)) - - primary_prod <- tibble::tribble( - ~year, ~area_code, ~item_prod_code, ~item_cbs_code, ~live_anim_code, - ~unit, ~value, - 2000, 1, 1, 2, NA, "LU", 20, - 2000, 1, 3, 4, NA, "LU", 30, - 2000, 1, 5, 6, 1, "tonnes", 40, - 2000, 1, 7, 8, 1, "tonnes", 45, - 2001, 1, 1, 2, NA, "LU", 40, - 2001, 1, 7, 8, 1, "tonnes", 50, - 2001, 1, 7, 9, NA, "tonnes", 50, - 2002, 1, 7, 2, 3, "tonnes", 50 - ) - - expected <- tibble::tribble( - ~year, ~area_code, ~proc_cbs_code, ~item_cbs_code, ~value, ~type, - 2000, 1, 2, 2, 13, "supply", - 2000, 1, 4, 4, 19.5, "supply", - 2000, 1, 1, 6, 40, "supply", - 2000, 1, 1, 8, 45, "supply", - 2001, 1, 2, 2, 26, "supply", - 2001, 1, 1, 8, 50, "supply" - ) - - husbandry_items |> - .build_supply_husbandry(primary_prod) |> - .expect_equal_unordered(expected) -}) - -testthat::test_that(".build_use_crop_production gives seed use for crop production", { - cbs_items <- tibble::tibble(item_cbs_code = c(1, 3, 8)) - - cbs <- tibble::tribble( - ~year, ~area_code, ~item_cbs_code, ~seed, - 2000, 1, 1, 20, - 2000, 1, 3, 25, - 2001, 1, 8, 30, - 2001, 1, 9, 30 - ) - - expected <- tibble::tribble( - ~year, ~area_code, ~proc_cbs_code, ~item_cbs_code, ~value, ~type, - 2000, 1, 1, 1, 20, "use", - 2000, 1, 3, 3, 25, "use", - 2001, 1, 8, 8, 30, "use" - ) - - cbs_items |> - .build_use_crop_production(cbs) |> - .expect_equal_unordered(expected) -}) - -testthat::test_that(".build_supply_crop_production gives crops and their residues", { - crop_prod_items <- tibble::tibble(item_prod_code = c(1, 2, 4)) - - primary_prod <- tibble::tribble( - ~year, ~area_code, ~item_prod_code, ~item_cbs_code, ~live_anim_code, - ~unit, ~value, - 2000, 1, 1, 3, NA, "tonnes", 40, - 2000, 1, 2, 3, NA, "tonnes", 45, - 2000, 1, 4, 5, NA, "tonnes", 50, - 2001, 1, 4, 5, NA, "tonnes", 60, - 2001, 1, 6, 3, NA, "tonnes", 60 - ) - - crop_residues <- tibble::tribble( - ~year, ~area_code, ~item_cbs_code_crop, ~item_cbs_code_residue, ~value, - 2000, 1, 3, 10, 40, - 2000, 1, 5, 11, 45, - 2001, 1, 5, 12, 60, - 2001, 1, 4, 10, 80 - ) - - expected <- tibble::tribble( - ~year, ~area_code, ~proc_cbs_code, ~item_cbs_code, ~value, ~type, - 2000, 1, 3, 3, 85, "supply", - 2000, 1, 5, 5, 50, "supply", - 2001, 1, 5, 5, 60, "supply", - 2000, 1, 3, 10, 40, "supply", - 2000, 1, 5, 11, 45, "supply", - 2001, 1, 5, 12, 60, "supply" - ) - - crop_prod_items |> - .build_supply_crop_production(primary_prod, crop_residues) |> - .expect_equal_unordered(expected) -})