Skip to content
GitLab
Commit 636307bc authored by Simon, Wolfram's avatar Simon, Wolfram
Browse files

minor changes

parent ca68851c
Expand all Hide whitespace changes
Inline Side-by-side
Grassland/Grassland.R
View file @ 636307bc
This diff is collapsed.
R_to_SQL_database/Cifos_Model_Data_EU.R
View file @ 636307bc
......@@ -906,20 +906,17 @@ dat_map_processing = dat_proc_asf %>% dplyr::select(proc_out) %>%
# Comparing different processing sheets ----------------------------------
# dat_proc_rec = read_excel("D:/GAMS/EU_model_Feb2022/European_CiFoS_model_data.xlsx", sheet = "Processing_Fraction" )
dat_proc_rec = read_excel("D:/GAMS/EU_model_Feb2022/European_CiFoS_model_data.xlsx", sheet = "Processing_Fraction" )
# dat_proc_comp = Processing_sheet_final %>% left_join(dat_proc_rec %>% select(proc_out, Utilization), by="proc_out") %>%
# mutate(Utilization = case_when(proc_out == "barleyfor" ~ "FeedOnly",
# proc_out == "wheatfor" ~ "FeedOnly",
# TRUE ~ Utilization)) %>%
# dplyr::select(-dietary_products) %>% clean_names()
#
# write_csv(dat_proc_comp, "Input_data/processing_sheet_17_02_22.csv")
dat_proc_comp = Processing_sheet_final %>% left_join(dat_proc_rec %>% select(proc_out, Utilization), by="proc_out") %>%
mutate(Utilization = case_when(proc_out == "barleyfor" ~ "FeedOnly",
proc_out == "wheatfor" ~ "FeedOnly",
TRUE ~ Utilization)) %>%
dplyr::select(-dietary_products) %>% clean_names()
write_csv(dat_proc_comp, "Input_data/processing_sheet_17_02_22.csv")
# Removing duplicates 22.2.22 ----------------------------------------------------
dat_proc_dup = read_excel("D:/GAMS/EU_model_Feb2022/European_CiFoS_model_data.xlsx", sheet = "Processing_Fraction" )
dat_proc_dup %>% distinct() %>% write_csv("Input_data/processing_sheet_no_dup.csv")
# Human nutrition sheet ---------------------------------------------------
# Human nutrtion sheet
......@@ -1111,26 +1108,6 @@ hum_nutr_all_FG = hum_nutr_all %>% dplyr::select(-FoodGroup) %>%
# check = full_join(hum_nutr_all, proc_new, by = c("product"="proc_out"))
write_csv(hum_nutr_all_FG, "Input_data/hum_nutr_all.csv")
# Comparing versions - Demi NAs filling --------------------------------------
hum_food_22.2.22 = read_xlsx('Input_data/Human_Food_Demi_22.2.22.xlsx', sheet = "Sheet1")
hum_food_latest = read_excel("D:/GAMS/EU_model_Feb2022/European_CiFoS_model_data.xlsx", sheet = "Human_Food_Nutr" )
# Consistency checks - Are the same products in both of the sheets
# - Number of rows are identical 139
# # both sheets have the same products. Sheet can be directly replaced by demis sheet!
hum_food_22.2.22$Product[!hum_food_22.2.22$Product %in% hum_food_latest$Product]
hum_food_latest$Product[!hum_food_latest$Product %in% hum_food_22.2.22$Product]
# Minor transformation and N calclation
hum_food_updated = hum_food_22.2.22 %>% dplyr::select(-USDA_Code) %>%
type.convert() %>%
dplyr::mutate(N = case_when(is.na(N) ~ Protein/6.25,
TRUE ~ N))
write_csv(hum_food_updated, "Input_data/Human_food_update_22_2_22.csv")
# Animal nutrition new ----------------------------------------------------
# Cifos sheet
dat_animnutr = readxl::read_excel("Input_data/Copy of European_CiFoS_model_data_ANITANov21.xlsx", sheet = "Animal_Nutr")
......@@ -1319,6 +1296,7 @@ FunAnimDatExtract = function(dat, cvb_code, cvb_name, product){
# Calculations
#[F.H11] GE (kJ/kg) = 24.14 x CP + 36.57 x CFAT + 20.92 x CF + 16.99 x NFE - 0.63 x SUG*
dplyr::mutate(
ge = case_when(
sug > 80 ~ round((cp*24.14+cfat*36.57+cf*13.81+nfe*16.99-0.63*sug)/1000,1),
sug <= 80 ~ round((cp*24.14+cfat*36.57+cf*13.81+nfe*16.99-0.63)/1000,1)),
......@@ -2024,17 +2002,6 @@ ani_nutr_v7.2.22=animal_nutrition_all_old %>% dplyr::select(c(product)) %>%
write_csv(animal_nutrition_all, "Input_data/animal_nutrition_all.csv")
read_csv("Input_data/animal_nutrition_all.csv")
}
# Update - 22.2.22 -------------------------------------------------------
dat_aninutr_recent = read_excel("D:/GAMS/EU_model_Feb2022/European_CiFoS_model_data.xlsx", sheet = "Animal_Feed_Nutr" )
dat_aninutr_updated = dat_aninutr_recent %>% dplyr::select(-Origin) %>%
distinct(Product, .keep_all = T)
write_csv(dat_aninutr_updated, "Input_data/dat_ani_nutr_update_22_2_22.csv")
# Loss fraction sheet ----------------------------------------------------
dat_lossfrac = read_excel("Input_data/Copy of European_CiFoS_model_data_ANITANov21.xlsx", sheet = "Loss_Fraction_New")
dat_lossfrac_join= dat_lossfrac %>% dplyr::select(c(1:10)) %>% janitor::row_to_names(1)%>% select(-ProdCat ,-Fam_SPAM) %>%
......@@ -2179,26 +2146,6 @@ loss_maped %>% write_csv("Input_data/loss_fraction.csv")
# write_csv(loss_frac_all, "Input_data/loss_frac_all.csv")
# Loss fraction sheet - UPDATE 22/02/2022 --------------------------------------
# - one table with loss fractions per category in Gustavsson et al. (2013)
# - one classification tabl: FamGustavson to Product
if (Sys.getenv("USERNAME") == "wacke003"){
localGit = "C:/Users/wacke003/Git/cifos-model.eu/"
} else {
localGit = "C:/Wolfram_Admin/GAMS/EU_model_frmSep21/cifos-model_eu/"
}
excel_file = paste(localGit,"European_CiFoS_model_data.xlsx",sep="")
fLoss = readxl::read_excel(excel_file, sheet = "Loss_Fraction") %>%
dplyr::select("Fam_Gustavson","Postharvest","ProcessingPackaging",
"Distribution","Consumption","Feeding") %>%
distinct()
write_csv(fLoss,"Input_data/LossFraction.csv")
# Consistency checks -----------------------------------------------------
# RULE: What is in the procout ani nutrition should be in the processing and the loss fraction sheet product
# A$C[!A$C %in% B$C] # returns all values of A$C that are NOT in B$C
......@@ -2512,19 +2459,17 @@ fao_foodgroup_map = read_csv("Input_data/FBS_FAO_prot_food_supply_mapout.csv") #
# Protein supply ----------------------------------------------------------
FBS_FAO_prot_food_supply =
# FBS_FAO_prot_food_supply =
FBS_FAO_downloaded_bulk %>% as_tibble() %>% clean_names()%>%
dplyr::filter(year %in% c("2010":"2019"), #for a year average
area_code %in% country_eu, #filtering for EU+UKD countries
element == 'Protein supply quantity (g/capita/day)') %>%
grepl('Protein|(kg/capita/yr)',element)) %>%
dplyr::select(-c(area_code, element_code,item_code,unit)) %>%
pivot_wider(names_from = element,
values_from = value,
values_fn = {mean}) %>%
pivot_wider(names_from = element,
values_from = value) #%>%
clean_names() %>%
replace(is.na(.), 0) %>%
left_join(fao_foodgroup_map, by="item") %>%
drop_na() %>%
dplyr::group_by(area, item, FoodGroups) %>%
dplyr::summarise(protein_gppp = mean(protein_supply_quantity_g_capita_day)) %>% ungroup() %>%
dplyr::group_by(area, FoodGroups) %>%
......@@ -2541,25 +2486,20 @@ write_csv(FBS_FAO_prot_food_supply, "Input_data/FBS_FAO_prot_food_supply3.csv")
# Food supply -------------------------------------------------------------
FBS_FAO_food_supply =
FBS_FAO_downloaded_bulk %>% as_tibble() %>% clean_names()%>%
FBS_FAO_downloaded_EUgroup %>% as_tibble() %>% clean_names() %>%
dplyr::filter(year %in% c("2010":"2019"), #for a year average
area_code %in% country_eu, #filtering for EU+UKD countries
element == 'Food supply quantity (kg/capita/yr)') %>%
dplyr::select(-c(area_code, element_code,item_code,unit)) %>%
pivot_wider(names_from = element,
values_from = value,
values_fn = {mean}) %>%
grepl('(kg/capita/yr)',element)) %>%
dplyr::select(-c(domain_code,domain,area_code, element_code,item_code,year_code,unit,flag,flag_description)) %>%
pivot_wider(names_from = element,
values_from = value) %>%
clean_names() %>%
replace(is.na(.), 0) %>%
left_join(fao_foodgroup_map, by="item") %>%
drop_na() %>%
dplyr::group_by(area, item, FoodGroups) %>%
dplyr::summarise(food_supply_kgcapyr = mean(food_supply_quantity_kg_capita_yr)) %>%
dplyr::group_by(area,item, FoodGroups) %>%
summarise(food_supply_kgcapyr=mean(food_supply_quantity_kg_capita_yr)) %>%
ungroup() %>%
dplyr::group_by(area, FoodGroups) %>%
dplyr::summarise(food_supply_kgcapyr = sum(food_supply_kgcapyr)) %>%
mutate(food_supply_kgcapyr = round(food_supply_kgcapyr,1)) %>%
mutate_all(~replace(., is.nan(.), 0)) %>%
summarise(food_supply_kgcapyr=sum(food_supply_kgcapyr)) %>%
mutate(area = recode(area, "United Kingdom of Great Britain and Northern Ireland"="United Kingdom")) %>%
rename(cifos_country = area)
......@@ -2573,6 +2513,9 @@ FBS_FAO_food_supply %>% summarise(food_supply_kgcapyr = sum(food_supply_kgcapyr)
write_csv(FBS_FAO_food_supply, "Input_data/FBS_FAO_food_supply.csv")
# Import_Export -----------------------------------------------------------
# Meeting with Renee on the 21.02.22
# Renee: that was done for validation data
......@@ -2584,34 +2527,30 @@ write_csv(FBS_FAO_food_supply, "Input_data/FBS_FAO_food_supply.csv")
# import - export - stock - non_food_uses(feed, other, seed, ... ) > negative value net_export; vice versa
# For whole EU not for countries
FBS_FAO_import_export =
FBS_FAO_downloaded_bulk %>% as_tibble() %>% clean_names() %>%
FBS_FAO_downloaded_EUgroup %>% as_tibble() %>% clean_names() %>%
dplyr::filter(year %in% c("2010":"2019"), #for a year average
area == c('European Union (27)','United Kingdom of Great Britain and Northern Ireland'),#area == c("Eu-27", "United Kingdom of Great Britain and Northern Ireland"), #filtering for all European countries
grepl('Import|Export|Feed|Stock|non-food|Tourist|Seed',element)) %>%
dplyr::select(-c(area_code, element_code,item_code,unit)) %>%
pivot_wider(names_from = element,
values_from = value,
values_fn = {mean}) %>%
area == "Europe", #filtering for all European countries
grepl('Import|Export',element)) %>%
dplyr::select(-c(domain_code,domain,area_code, element_code,item_code,year_code,unit,flag,flag_description)) %>%
pivot_wider(names_from = element,
values_from = value) %>%
clean_names() %>%
replace(is.na(.), 0) %>%
left_join(fao_foodgroup_map, by="item") %>%
drop_na() %>%
dplyr::group_by(FoodGroups, item, area) %>%
dplyr::summarise(across(import_quantity:tourist_consumption, mean)) %>%
ungroup() %>% dplyr::group_by(FoodGroups) %>%
dplyr::summarise(across(import_quantity:tourist_consumption, sum)) %>%
dplyr::mutate_if(is.numeric, ~ . * 1000) %>%
dplyr::mutate(net_import_export = import_quantity-(export_quantity+stock_variation+feed+seed+other_uses_non_food+tourist_consumption),
net_export = case_when(net_import_export < 0 ~ net_import_export * -1,
TRUE~0),
net_import = case_when(net_import_export > 0 ~ net_import_export,
TRUE~0)) %>%
dplyr::rename(export_ton = export_quantity,
import_ton = import_quantity) %>%
relocate(export_ton, .after = "import_ton")
write_csv(FBS_FAO_import_export, "Input_data/FBS_FAO_import_export2.csv")
dplyr::group_by(FoodGroups) %>%
dplyr::summarise(Import_ton = mean(import_quantity),
Export_ton = mean(export_quantity)) %>%
dplyr::mutate_if(is.numeric, ~ . * 1000)
write_csv(FBS_FAO_import_export, "Input_data/FBS_FAO_import_export.csv")
# Testing the amount of proteins we get: 76.4 g protein per day with the weighted mean calculation
FBS_FAO_prot_food_supply %>% summarise(prot = sum(protein_gppp))
write_csv(FBS_FAO_prot_food_supply, "FBS_FAO_prot_food_supply.csv")
# Crop_others sheet -------------------------------------------------------
......@@ -2667,15 +2606,6 @@ CropFert =
write_csv(CropFert, "Input_data/cropfert_inter.csv")
# Fert_Nutr ---------------------------------------------------------------
# Sheet contains the products (procraw and procout) with NPK values on DM basis
proc_recent = read_excel("D:/GAMS/EU_model_Feb2022/European_CiFoS_model_data.xlsx", sheet = "Processing" )
dat_aninutr_updated = dat_aninutr_recent %>% dplyr::select(-Origin) %>%
distinct(Product, .keep_all = T)
write_csv(dat_aninutr_updated, "Input_data/dat_ani_nutr_update_22_2_22.csv")
# Data maps ---------------------------------------------------------------
# Anitas excel -- differs a bit to mine
data_map = read_excel("Input_data/Copy of European_CiFoS_model_data_ANITANov21.xlsx", sheet = "Data_Map")
......@@ -2818,125 +2748,4 @@ dat_dist = dat_distance %>% pivot_longer(names_to = "CountryB",
write_csv(dat_dist, "Input_data/dat_dist.csv")
# FertNutr sheet -------------------------------------------------------------
if (Sys.getenv("USERNAME") == "wacke003"){
localGit = "C:/Users/wacke003/Git/cifos-model.eu/"
} else {
localGit = "D:/GAMS/EU_model_Feb2022/"
}
excel_file = paste(localGit,"European_CiFoS_model_data.xlsx",sep="")
FertNutr = readxl::read_excel(excel_file, sheet = "FertNutr")
AnimalNutr = readxl::read_excel(excel_file, sheet = "Animal_Feed_Nutr")
HumanNutr = readxl::read_excel(excel_file, sheet = "Human_Food_Nutr")
CropNutr = readxl::read_excel(excel_file, sheet = "Crop_Nutrient")
tmp = FertNutr %>%
select(-c("N","P")) %>% left_join(AnimalNutr,by="Product") %>%
select(ProductType,Product,N,P) %>%
left_join(CropNutr %>% select(crop_cifos,Nharv,Pharv),
by=c("Product"="crop_cifos")) %>%
mutate(across(c("N","P"),as.numeric)) %>%
mutate(N=N*1e-3,P=P*1e-3) %>% # convert values to mass fractions
mutate(N_=case_when(ProductType=="ProcOut"~N, # if processing product, prioritise value from animal nutr sheet
ProductType=="ProcRaw" & !is.na(Nharv) ~ Nharv, # if raw product, prioritise value from crop nutr sheet
ProductType=="ProcOut" & is.na(N) ~ Nharv, # use value from CropNutr sheet if no value in AnimalNutr sheet
TRUE ~ N))%>%
mutate(P_=case_when(ProductType=="ProcOut"~P, # if processing product, prioritise value from animal nutr sheet
ProductType=="ProcRaw" & !is.na(Pharv) ~ Pharv, # if raw product, prioritise value from crop nutr sheet
ProductType=="ProcOut" & is.na(P) ~ Pharv, # use value from CropNutr sheet if no value in AnimalNutr sheet
TRUE ~ P)) %>%
select(ProductType,Product,N_,P_) %>% rename(N=N_,P=P_)
write_csv(tmp,"Input_data/FertNutr.csv")
# class_FamGustavson ------------------------------------------------------
# Issue#39 in repo Cifos-Model-EU: THOMASs:
# Also, I noticed that there are more products than ProcRaw+ProcOut in the class_FamGustavson sheet.
# This does not matter, we just need to remember that $loaddc will not work on the GP(FamG,AllProd) mapping set.
class_FamGustavson = readxl::read_excel(excel_file, sheet = "class_FamGustavson")
processing = readxl::read_excel(excel_file, sheet = "Processing_Fraction")
# Gettting a vector for procout and procraw
fun_vec = function(col){
processing %>% select(col) %>% distinct() %>%
rename("Product" = col)
}
procout = fun_vec("proc_out")
procraw = fun_vec("proc_raw")
procout_raw = bind_rows(procout, procraw)
procout_raw %>% nrow()
# All the procouts+procraws count to 334 (with duplicates)
procout_raw_dist = procout_raw %>% distinct()
procout_raw_dist %>% nrow()
# All the procouts+procraws count to 313 (without duplicates)\
nrow(class_FamGustavson)
# 326
# 326-313=13
# There are 13 more Products in class_FamGustavson$Product than in proc_out+proc_raw from the processing sheet
# Final class_FamGustavson sheet
class_FamGustavsonv23_2_22 = procout_raw_dist %>% left_join(class_FamGustavson, by="Product")
write_csv(class_FamGustavsonv23_2_22, "Input_data/class_FamGustavsonv23_2_22.csv")
# Consistency checks -----------------------------------------------------
# Loading data where Products occur
class_FamGustavson = readxl::read_excel(excel_file, sheet = "class_FamGustavson")
FertNutr = readxl::read_excel(excel_file, sheet = "FertNutr")
AnimalNutr = readxl::read_excel(excel_file, sheet = "Animal_Feed_Nutr")
HumanNutr = readxl::read_excel(excel_file, sheet = "Human_Food_Nutr")
CropNutr = readxl::read_excel(excel_file, sheet = "Crop_Nutrient")
# This corresponds to AllProd (procout+procraw)
procout_raw_dist
# Are all the elements of procout+procraw in the related sheets?
# All values of animal nutrition that are not in loss fraction
Fun_Consist = function(ref_dat=procout_raw_dist, col_ref, nest_dat){
nest_dat$Product[!nest_dat$Product %in% ref_dat$Product]
}
# All elemetns in animal nutrition are in the proc_raw or procout
Fun_Consist(nest_dat = AnimalNutr) #character(0)
Fun_Consist(nest_dat = HumanNutr) #character(0)
Fun_Consist(nest_dat = FertNutr) #character(0)
Fun_Consist(nest_dat = class_FamGustavson) #character(0)
CropNutr$crop_cifos[!CropNutr$crop_cifos %in% procout_raw_dist$Product] #character(0)
# Vice versa checking: are all the products that are in the child sheets of processing in processing?
Fun_Consist_child = function(nest_dat=procout_raw_dist, ref_dat){
nest_dat$Product[!nest_dat$Product %in% ref_dat$Product]
}
Fun_Consist_child(ref_dat = AnimalNutr)
#"pearl_millet_beer" "sorghum_beer" "flax_fiber_and_tow" "seed_cotton_fibres"
# "tobacco_leaves" "barley_beer" "other_fibres" "tobacco"
Fun_Consist_child(ref_dat = HumanNutr) #all proc_raw are missing
Fun_Consist_child(ref_dat = class_FamGustavson) #character(0)
Fun_Consist_child(ref_dat = FertNutr) #character(0)
Fun_Consist(nest_dat = HumanNutr) #character(0)
Fun_Consist(nest_dat = FertNutr) #character(0)
Fun_Consist(nest_dat = class_FamGustavson) #character(0)
CropNutr$crop_cifos[!CropNutr$crop_cifos %in% procout_raw_dist$Product] #character(0)
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment