Commit ca68851c authored by Simon, Wolfram's avatar Simon, Wolfram
Browse files

Continued with the grassland checks. Checked hyde documentation and adjusted...

Continued with the grassland checks. Checked hyde documentation and adjusted the comparison accordingly. It still shows quite large deviations between our data fro grass and crop and the faostat land use data set. Gotta talk to hannah. Arable land looks better when comparing with fao. Also checked the FAOcode and realized that they differ from GAUL code. Be mindful!
parent 563f80b1
......@@ -112,10 +112,9 @@ dat_grass_crop =
# Available land per lut --------------------------------------------------
available_land_area = dat_grass_crop %>%
mutate(area_ha = area_ha *100) %>%
filter(stock_rate == "00") %>%
dplyr::mutate(area_ha = area_ha *100) %>%
dplyr::filter(stock_rate == "00") %>%
dplyr::select(-stock_rate) %>%
left_join(., country_map %>% mutate(ADM0_CODE_GAUL = as.character(ADM0_CODE_GAUL)), by = c("adm0_cod" = "ADM0_CODE_GAUL"))
......@@ -221,6 +220,7 @@ grass_EU28_final =
# Subsetting per stocking rate --------------------------------------------
grassing_density_potential_init =
dat_grass_crop %>%
dplyr::mutate(area_ha = area_ha *100) %>%
dplyr::group_by(adm0_cod, aez, soil, lut_cifos) %>% #selecting the stocking rate per zone with the maximum yield.
dplyr::top_n(1, yield_DM_kgha) %>% #selects the LSU (=grazing density) with the highest yields per group combination of adm0_cod, aez, soil, lut_cifos.
mutate(scenario = "potential") #tag it as potential to be able to distinguish it from the current later after rbind
......@@ -353,7 +353,7 @@ Fun_area_join = function(dat, vec_lut){
mutate(diff_perc = (100/area_ha*area_ha_cifos)-100)
}
grass_area_cifos = Fun_area_join(dat = grass_area, vec_lut = c("pasture_marginal", "rangeland"))
grass_area_cifos = Fun_area_join(dat = grass_area, vec_lut = c("pasture_marginal", "rangeland", "pasture_arable"))
arable_area_cifos = Fun_area_join(dat = arable_area,
vec_lut = c("arable"))
......@@ -385,13 +385,13 @@ Comb_Zon_EU28 %>% select(-c(ADM0_CODE,iso3_SPAM)) %>%
pasture_arable = pasture_areaha,
pasture_marginal = pastureCrop_areaha,
rangeland = rangeland_areaha) %>%
pivot_longer(cols = arable:rangeland,
pivot_longer(cols = arable:rangeland,
names_to = "lut_cifos",
values_to = "area_ha") %>%
relocate(soil_cifos, .before = lut_cifos) %>%
relocate(soil_cifos, .before = lut_cifos) %>%
dplyr::filter(lut_cifos %in% vec_lut) %>%
group_by(country_cifos) %>%
summarise(area_ha_cifos = sum(area_ha)) %>%
dplyr::group_by(country_cifos) %>%
dplyr::summarise(area_ha_cifos = sum(area_ha,na.rm=T)) %>%
left_join(dat, by=c("country_cifos"="country")) %>%
mutate(diff_perc = (100/area_ha*area_ha_cifos)-100)
}
......@@ -412,27 +412,71 @@ EU_cntr_Cifos = c("Austria","Belgium","Bulgaria","Croatia","Cyprus", "Czechia","
"Estonia","Finland","France","Germany","Greece","Hungary","Ireland",
"Italy","Latvia","Lithuania","Luxembourg","Malta","Netherlands","Poland",
"Portugal","Romania","Slovakia","Slovenia","Spain","Sweden",'United Kingdom')
landuse_fao_bulk = read_csv("INput_data/Inputs_LandUse_E_All_Data_NOFLAG.csv")
# For checking
check_dat_LUT = landuse_fao_bulk %>% select(Area, Item,Y2008,Y2009,Y2010,Y2011,Y2012) %>%
filter(Item %in% c("Arable land", "Land under permanent crops",
"Land under perm. meadows and pastures")) %>%
clean_names() %>% type.convert() %>%
mutate(area = recode(area, "United Kingdom of Great Britain and Northern Ireland"= "United Kingdom")) %>%
filter(., area %in% EU_cntr_Cifos) %>%
pivot_longer(cols = "y2008":"y2012",
names_to = "year",
values_to = "area_ha") %>%
dplyr::mutate(area_ha = area_ha*1000) %>%
rename("country" = "area") %>%
group_by(country, item) %>%
summarise(area_ha = mean(area_ha,na.rm=T))
fao_arable_area =
read_csv("INput_data/area_harvested_FAO_arablecrops.csv") %>%
fao_arable_grass_area =
landuse_fao_bulk %>%
clean_names() %>% type.convert() %>%
mutate(area = recode(area, "United Kingdom of Great Britain and Northern Ireland"= "United Kingdom")) %>%
filter(., area %in% EU_cntr_Cifos) %>%
rename("country" = "area",
"area_ha"="value") %>%
group_by(year_code, country) %>%
summarise(area_ha = mean(area_ha,na.rm=T)) %>%
ungroup() %>%
pivot_longer(cols = "y1961":"y2019",
names_to = "year",
values_to = "area_ha") %>%
dplyr::mutate(area_ha = area_ha*1000) %>%
# HYDE paper: We started with country totals for the FAO categories of
# “arable land and permanent crops” and “permanent mead-
# ows and pastures”, further referred to here as “cropland”
# and “grazing land” respectively - https://doi.org/10.5194/essd-9-927-2017
dplyr::filter(year %in% c("y2009","y2010","y2011"),
item %in% c("Arable land", "Land under permanent crops",
"Land under perm. meadows and pastures")) %>%
rename("country" = "area") %>%
group_by(country, item) %>%
summarise(area_ha = mean(area_ha,na.rm=T))
# Summing over items
# arable
arable_area_fao = fao_arable_grass_area %>% dplyr::filter(item %in% c("Arable land","Land under permanent crops")) %>%
group_by(country) %>%
summarise(area_ha = sum(area_ha,na.rm=T))
# grass
grass_area_fao = fao_arable_grass_area %>%
dplyr::filter(item %in% c("Land under perm. meadows and pastures")) %>%
group_by(country) %>%
summarise(area_ha = sum(area_ha,na.rm=T))
summarise(area_ha = sum(area_ha,na.rm=T))
# Applying the function with FAO arable area data to the extracted datasets of Leandro and Wolfram
arable_area_cifos_WJex_fao = Fun_area_join_WJSextract(dat = fao_arable_area, vec_lut = c("arable"))
arable_area_cifos_fao = Fun_area_join(dat = fao_arable_area, vec_lut = c("arable"))
arable_area_cifos_WJex_fao = Fun_area_join_WJSextract(dat = arable_area_fao, vec_lut = c("arable"))
arable_area_cifos_fao = Fun_area_join(dat = grass_area_fao, vec_lut = c("arable"))
grass_area_cifos_WJex_fao = Fun_area_join_WJSextract(dat = grass_area_fao, vec_lut = c("pasture_marginal", "rangeland","pasture_arable"))
grass_area_cifos_fao = Fun_area_join(dat = grass_area_fao, vec_lut = c("pasture_marginal", "rangeland","pasture_arable"))
# Plotting the two extraction types from Leandro and Wolfram
gg_WJS_fao_arable = Fun_ggplot_area_deviation(arable_area_cifos_WJex_fao, lut_vec="arable", author_vec = "WJS",vec_source = "FAOSTAT - 10 year average")
gg_leandro_fao_arable = Fun_ggplot_area_deviation(arable_area_cifos_fao, lut_vec="arable", author_vec = "Leandro",vec_source = "FAOSTAT - 10 year average")
gg_WJS_fao_arable = Fun_ggplot_area_deviation(arable_area_cifos_WJex_fao, lut_vec="arable", author_vec = "WJS",vec_source = "FAOSTAT - 3 year average around 2010")
gg_leandro_fao_arable = Fun_ggplot_area_deviation(arable_area_cifos_fao, lut_vec="arable", author_vec = "Leandro",vec_source = "FAOSTAT - 3 year average around 2010")
gg_WJS_fao_grass = Fun_ggplot_area_deviation(grass_area_cifos_WJex_fao, lut_vec="grass", author_vec = "WJS",vec_source = "FAOSTAT - 3 year average around 2010")
gg_leandro_fao_grass = Fun_ggplot_area_deviation(grass_area_cifos_fao, lut_vec="grass", author_vec = "Leandro",vec_source = "FAOSTAT - 3 year average around 2010")
# Conclusion: Leandros extraction is way to low (average around -60% of the FAOSTAT reference)
# Arable land
......@@ -442,6 +486,9 @@ ggarrange(gg_leandro_eurostat_arable, gg_leandro_fao_arable,
# Grass area
ggarrange(gg_leandro_eurostat_grass, gg_WJS_eurostat_grass, nrow = 2)
# Grass area
ggarrange(gg_WJS_fao_grass, gg_leandro_fao_grass, nrow = 2)
# EU28 - Subsetting -------------------------------------------------------
EU_iso3 = c("AUT","BEL", "BGR", "HRV", "CZE", "DNK", "EST","FIN", "FRA", "DEU", "GRC", "HUN", "IRL", "ITA","LVA",
"LTU", "LUX", "MLT", "NLD", "POL", "PRT","ROU", "SVK","SVN", "ESP", "SWE", "GBR", "CYP")
......
......@@ -55,8 +55,8 @@ FAOSTAT_cntr <- read_csv(here("Input_data", "Mappings", "FAOSTAT_data_4-22-2021_
dat_map_SPAM_GAUL_CIFOS_FAO = read.csv(here("Input_data", "Mappings", "dat_map_SPAM_GAUL_CIFOS_FAO.csv")) %>% as_tibble()
dat_map_SPAM_GAUL_CIFOS_FAO_full = dat_map_SPAM_GAUL_CIFOS_FAO %>%
dplyr::select(-M49_Code, -iso2_code_FAO, -iso3_code_FAO) %>% left_join(., FAOSTAT_cntr, by = c("name_cntr_FAO" = "Country")) #needs some more checking > NAs in last col
# dat_map_SPAM_GAUL_CIFOS_FAO = dat_map_SPAM_GAUL_CIFOS %>% full_join(., FAOSTAT_cntr, c("name_cntr_GAUL2015" ="Country"))
# write_csv(dat_map_SPAM_GAUL_CIFOS_FAO, here("Input_data", "Mappings", "dat_map_SPAM_GAUL_CIFOS_FAO.csv"))
# dat_map_SPAM_GAUL_CIFOS_FAO = dat_map_SPAM_GAUL_CIFOS %>% full_join(., FAOSTAT_cntr, c("name_cntr_GAUL2015" ="Country"))
write_csv(dat_map_SPAM_GAUL_CIFOS_FAO, here("Input_data", "Mappings", "dat_map_SPAM_GAUL_CIFOS_FAO.csv"))
# Distinct at SPAM 2010
dat_map_SPAM_dist = dat_map_SPAM_GAUL_CIFOS_FAO_full %>% distinct_at(vars(iso3_SPAM), .keep_all = T)
......
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