Skip to content

Commit

Permalink
Expand for N and P
Browse files Browse the repository at this point in the history
  • Loading branch information
@heleenderoo
heleenderoo committed Oct 25, 2024
1 parent 526f5b2 commit c93ff16
Show file tree
Hide file tree
Showing 7 changed files with 1,703 additions and 340 deletions.
64 changes: 51 additions & 13 deletions src/functions/add_uncertainties_chem.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -26,19 +26,46 @@ add_uncertainties_chem <- function(survey_form,
# Uncertainties (in the required parameter units)

# TOC:

# layer_type organic and survey_year < 2000: +-11.8 g kg-1
# layer_type organic and survey_year >= 2000: +- 5.2 g kg-1
# layer_type mineral and survey_year < 2000: +- 3.5 g kg-1
# layer_type mineral and survey_year >= 2000: +- 1.5 g kg-1

# Based on BioSoil reanalysis of '90s and '00s soil samples by a
# central lab
# Hiederer R, Durrant Houston T, Micheli E. Evaluation of BioSoil
# Demonstration Project - Soil Data Analysis. EUR 24729 EN. Luxembourg
# (Luxembourg): Publications Office of the European Union; 2011. JRC63301

# Total N:

lqa <- get_env(paste0(unlist(str_split(survey_form, "_"))[1],
"_lqa")) %>%
filter(code_parameter == "Total_N") %>% # "P_extr", "Total_N", "org_C"
filter(!is.na(control_chart_std)) %>%
arrange(control_chart_std) %>%
pull(control_chart_std) %>%
# There seem to be some extremely high values which do not seem
# reliable.
# Use the upper 80 % quantile (because higher ones may be unreliable,
# e.g. due to calibration errors or mistakes in calculations)
quantile(0.80)

# 4 g kg-1


uncertainties <- data.frame(
parameter_som = c("organic_carbon_total"),
parameter_pfh = c("horizon_c_organic_total"),
org_before_2000 = c(11.8),
org_after_2000 = c(5.2),
min_before_2000 = c(3.5),
min_after_2000 = c(1.5),
source = c("Confidence interval of central lab reanalyses by JRC (2011)")
parameter_som = c("organic_carbon_total", "n_total",
"extrac_p"),
parameter_pfh = c("horizon_c_organic_total", "horizon_n_total",
NA),
org_before_2000 = c(11.8, 4, 4.9),
org_after_2000 = c(5.2, 4, 4.9),
min_before_2000 = c(3.5, 4, 4.9),
min_after_2000 = c(1.5, 4, 4.9),
source = c("Confidence interval of central lab reanalyses by JRC (2011)",
"LQA", "LQA")
)


Expand All @@ -47,7 +74,7 @@ add_uncertainties_chem <- function(survey_form,
if (survey_form_type == "som") {

if (is.null(parameters)) {
parameters <- c("organic_carbon_total")
parameters <- c("organic_carbon_total", "n_total", "extrac_p")
}

assertthat::assert_that(
Expand All @@ -61,7 +88,7 @@ add_uncertainties_chem <- function(survey_form,
if (survey_form_type == "pfh") {

if (is.null(parameters)) {
parameters <- c("horizon_c_organic_total")
parameters <- c("horizon_c_organic_total", "horizon_n_total")
}

assertthat::assert_that(
Expand All @@ -80,6 +107,17 @@ add_uncertainties_chem <- function(survey_form,
parameter_max_i <- paste0(parameter_i, "_max")


# Theoretically maximum possible value

max_i <- read.csv2("./data/additional_data/ranges_qaqc.csv") %>%
filter(!is.na(max_possible)) %>%
filter(parameter_som == parameter_i |
parameter_pfh == parameter_i) %>%
distinct(max_possible) %>%
pull(max_possible)

assertthat::assert_that(length(max_i) == 1)


if (!parameter_min_i %in% names(df)) {

Expand Down Expand Up @@ -144,13 +182,13 @@ add_uncertainties_chem <- function(survey_form,
!is.na(.data[[parameter_i]]),
case_when(
layer_type %in% c("forest_floor", "peat") & survey_year < 2000 ~
pmin(.data[[parameter_max_i]] + unc_i$org_before_2000, 1000),
pmin(.data[[parameter_max_i]] + unc_i$org_before_2000, max_i),
layer_type %in% c("forest_floor", "peat") & survey_year >= 2000 ~
pmin(.data[[parameter_max_i]] + unc_i$org_after_2000, 1000),
pmin(.data[[parameter_max_i]] + unc_i$org_after_2000, max_i),
layer_type == "mineral" & survey_year < 2000 ~
pmin(.data[[parameter_max_i]] + unc_i$min_before_2000, 1000),
pmin(.data[[parameter_max_i]] + unc_i$min_before_2000, max_i),
layer_type == "mineral" & survey_year >= 2000 ~
pmin(.data[[parameter_max_i]] + unc_i$min_after_2000, 1000)),
pmin(.data[[parameter_max_i]] + unc_i$min_after_2000, max_i)),
NA_integer_)) %>%
relocate({{parameter_min_i}}, .after = {{parameter_i}}) %>%
relocate({{parameter_max_i}}, .after = {{parameter_min_i}})
Expand Down
5 changes: 4 additions & 1 deletion src/functions/depth_join.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -125,7 +125,10 @@ depth_join <- function(df1,
}

if (mode == "time_specific_ff_concentrations") {
possible_parameters <- "organic_carbon_total"
possible_parameters <- c("organic_carbon_total",
"n_total",
"extrac_p",
"extrac_s")
}

parameters <- unique(
Expand Down
73 changes: 63 additions & 10 deletions src/functions/gapfill_from_old_data.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,7 @@ gapfill_from_old_data <- function(survey_form,
save_to_env = FALSE,
parameters = c("bulk_density",
"organic_carbon_total",
"n_total",
"organic_layer_weight",
"coarse_fragment_vol",
"part_size_clay",
Expand Down Expand Up @@ -408,6 +409,7 @@ gapfill_from_old_data <- function(survey_form,
assertthat::assert_that(
identical(parameters, c("bulk_density",
"organic_carbon_total",
"n_total",
"organic_layer_weight",
"coarse_fragment_vol",
"part_size_clay",
Expand Down Expand Up @@ -460,13 +462,15 @@ gapfill_from_old_data <- function(survey_form,
select(unique_layer_repetition,
bulk_density,
organic_carbon_total,
n_total,
organic_layer_weight,
coarse_fragment_vol,
part_size_clay,
part_size_silt,
part_size_sand) %>%
rename(bulk_density_afscdb = bulk_density,
organic_carbon_total_afscdb = organic_carbon_total,
n_total_afscdb = n_total,
organic_layer_weight_afscdb = organic_layer_weight,
coarse_fragment_vol_afscdb = coarse_fragment_vol,
part_size_clay_afscdb = part_size_clay,
Expand Down Expand Up @@ -504,6 +508,16 @@ gapfill_from_old_data <- function(survey_form,
organic_carbon_total = coalesce(
.data$organic_carbon_total,
.data$organic_carbon_total_afscdb)) %>%
# N total
mutate(
n_total_source = case_when(
!is.na(n_total_source) ~ n_total_source,
!is.na(.data$n_total) ~ "som (same year)",
!is.na(.data$n_total_afscdb) ~ "FSCDB.LII (2012)",
TRUE ~ NA_character_),
n_total = coalesce(
.data$n_total,
.data$n_total_afscdb)) %>%
# Organic layer weight
mutate(
organic_layer_weight_source = case_when(
Expand Down Expand Up @@ -570,6 +584,27 @@ gapfill_from_old_data <- function(survey_form,
filter(is.na(.data$unique_survey_so_som)) %>%
select(-unique_survey_so_som, -unique_layer_repetition)

# Some Romanian records were missing in both databases,
# but the partner confirmed that they should be inserted.

layers_to_check <- c("52_2009_13_M12_3",
"52_2009_13_M24_3",
"52_2009_13_M48_3")

if (all(!layers_to_check %in% df$unique_layer_repetition)) {

assertthat::assert_that(
all(layers_to_check %in% so_som_afscdb$unique_layer_repetition))

so_som_missing_records <- rbind(
so_som_missing_records,
so_som_afscdb %>%
filter(unique_layer_repetition %in% layers_to_check) %>%
select(-unique_survey_so_som, -unique_layer_repetition)
)
}


# If there are any unique surveys in afscdb which are missing in so_som

if (nrow(so_som_missing_records) > 0) {
Expand Down Expand Up @@ -656,6 +691,7 @@ gapfill_from_old_data <- function(survey_form,
"Record inserted from FSCDB.LII."),
bulk_density_afscdb = bulk_density,
organic_carbon_total_afscdb = organic_carbon_total,
n_total_afscdb = n_total,
organic_layer_weight_afscdb = organic_layer_weight,
coarse_fragment_vol_afscdb = coarse_fragment_vol,
part_size_clay_afscdb = part_size_clay,
Expand Down Expand Up @@ -747,7 +783,7 @@ gapfill_from_old_data <- function(survey_form,
n_total_orig,
origin_merged, origin_merge_info,

bulk_density_afscdb, organic_carbon_total_afscdb,
bulk_density_afscdb, organic_carbon_total_afscdb, n_total_afscdb,
organic_layer_weight_afscdb, coarse_fragment_vol_afscdb,
part_size_clay_afscdb, part_size_silt_afscdb,
part_size_sand_afscdb)
Expand Down Expand Up @@ -789,15 +825,17 @@ gapfill_from_old_data <- function(survey_form,
code_plot = ifelse(code_country == 58 & code_plot == 2255,
255,
code_plot)) %>%
mutate(repetition = ifelse(code_country == 58 & code_plot == 2188,
2,
plot_id),
plot_id = ifelse(code_country == 58 & code_plot == 2188,
"58_188",
plot_id),
code_plot = ifelse(code_country == 58 & code_plot == 2188,
188,
code_plot)) %>%
# do not apply this because then, there seem to be two profiles
# with 58_188 as plot_id
# mutate(repetition = ifelse(code_country == 58 & code_plot == 2188,
# 2,
# repetition),
# plot_id = ifelse(code_country == 58 & code_plot == 2188,
# "58_188",
# plot_id),
# code_plot = ifelse(code_country == 58 & code_plot == 2188,
# 188,
# code_plot)) %>%
mutate(
unique_survey = paste0(code_country, "_",
survey_year, "_",
Expand Down Expand Up @@ -1173,6 +1211,7 @@ gapfill_from_old_data <- function(survey_form,
assertthat::assert_that(
identical(parameters, c("bulk_density",
"organic_carbon_total",
"n_total",
"organic_layer_weight",
"coarse_fragment_vol",
"part_size_clay",
Expand Down Expand Up @@ -1223,10 +1262,12 @@ gapfill_from_old_data <- function(survey_form,
select(unique_layer_repetition_s1_som,
bulk_density,
organic_carbon_total,
n_total,
organic_layer_weight,
coarse_fragment_vol) %>%
rename(bulk_density_fscdb = bulk_density,
organic_carbon_total_fscdb = organic_carbon_total,
n_total_fscdb = n_total,
organic_layer_weight_fscdb = organic_layer_weight,
coarse_fragment_vol_fscdb = coarse_fragment_vol),
by = join_by("unique_layer_repetition" ==
Expand Down Expand Up @@ -1262,6 +1303,16 @@ gapfill_from_old_data <- function(survey_form,
organic_carbon_total = coalesce(
.data$organic_carbon_total,
.data$organic_carbon_total_fscdb)) %>%
# N total
mutate(
n_total_source = case_when(
!is.na(n_total_source) ~ n_total_source,
!is.na(.data$n_total) ~ "som (same year)",
!is.na(.data$n_total_fscdb) ~ "FSCDB.LI (2002)",
TRUE ~ NA_character_),
n_total = coalesce(
.data$n_total,
.data$n_total_fscdb)) %>%
# Organic layer weight
mutate(
organic_layer_weight_source = case_when(
Expand Down Expand Up @@ -1365,6 +1416,7 @@ gapfill_from_old_data <- function(survey_form,
other_obs = "Record inserted from FSCDB.LI.",
bulk_density_fscdb = bulk_density,
organic_carbon_total_fscdb = organic_carbon_total,
n_total_fscdb = n_total,
organic_layer_weight_fscdb = organic_layer_weight,
coarse_fragment_vol_fscdb = coarse_fragment_vol,
part_size_clay_fscdb = part_size_clay,
Expand Down Expand Up @@ -1428,6 +1480,7 @@ gapfill_from_old_data <- function(survey_form,
coarse_fragment_vol_orig, organic_layer_weight_orig,
organic_carbon_total_orig,
n_total_orig, bulk_density_fscdb, organic_carbon_total_fscdb,
n_total_fscdb,
organic_layer_weight_fscdb, coarse_fragment_vol_fscdb)

assertthat::assert_that(all(names(df) == names(s1_som_fscdb_to_add)))
Expand Down
Loading

0 comments on commit c93ff16

Please sign in to comment.