Skip to content

Commit c93ff16

Browse files
heleenderooheleenderoo
committed
Expand for N and P
1 parent 526f5b2 commit c93ff16

File tree

7 files changed

+1703
-340
lines changed

7 files changed

+1703
-340
lines changed

‎src/functions/add_uncertainties_chem.R

Lines changed: 51 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -26,19 +26,46 @@ add_uncertainties_chem <- function(survey_form,
2626
# Uncertainties (in the required parameter units)
2727

2828
# TOC:
29+
2930
# layer_type organic and survey_year < 2000: +-11.8 g kg-1
3031
# layer_type organic and survey_year >= 2000: +- 5.2 g kg-1
3132
# layer_type mineral and survey_year < 2000: +- 3.5 g kg-1
3233
# layer_type mineral and survey_year >= 2000: +- 1.5 g kg-1
3334

35+
# Based on BioSoil reanalysis of '90s and '00s soil samples by a
36+
# central lab
37+
# Hiederer R, Durrant Houston T, Micheli E. Evaluation of BioSoil
38+
# Demonstration Project - Soil Data Analysis. EUR 24729 EN. Luxembourg
39+
# (Luxembourg): Publications Office of the European Union; 2011. JRC63301
40+
41+
# Total N:
42+
43+
lqa <- get_env(paste0(unlist(str_split(survey_form, "_"))[1],
44+
"_lqa")) %>%
45+
filter(code_parameter == "Total_N") %>% # "P_extr", "Total_N", "org_C"
46+
filter(!is.na(control_chart_std)) %>%
47+
arrange(control_chart_std) %>%
48+
pull(control_chart_std) %>%
49+
# There seem to be some extremely high values which do not seem
50+
# reliable.
51+
# Use the upper 80 % quantile (because higher ones may be unreliable,
52+
# e.g. due to calibration errors or mistakes in calculations)
53+
quantile(0.80)
54+
55+
# 4 g kg-1
56+
57+
3458
uncertainties <- data.frame(
35-
parameter_som = c("organic_carbon_total"),
36-
parameter_pfh = c("horizon_c_organic_total"),
37-
org_before_2000 = c(11.8),
38-
org_after_2000 = c(5.2),
39-
min_before_2000 = c(3.5),
40-
min_after_2000 = c(1.5),
41-
source = c("Confidence interval of central lab reanalyses by JRC (2011)")
59+
parameter_som = c("organic_carbon_total", "n_total",
60+
"extrac_p"),
61+
parameter_pfh = c("horizon_c_organic_total", "horizon_n_total",
62+
NA),
63+
org_before_2000 = c(11.8, 4, 4.9),
64+
org_after_2000 = c(5.2, 4, 4.9),
65+
min_before_2000 = c(3.5, 4, 4.9),
66+
min_after_2000 = c(1.5, 4, 4.9),
67+
source = c("Confidence interval of central lab reanalyses by JRC (2011)",
68+
"LQA", "LQA")
4269
)
4370

4471

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

4976
if (is.null(parameters)) {
50-
parameters <- c("organic_carbon_total")
77+
parameters <- c("organic_carbon_total", "n_total", "extrac_p")
5178
}
5279

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

6390
if (is.null(parameters)) {
64-
parameters <- c("horizon_c_organic_total")
91+
parameters <- c("horizon_c_organic_total", "horizon_n_total")
6592
}
6693

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

82109

110+
# Theoretically maximum possible value
111+
112+
max_i <- read.csv2("./data/additional_data/ranges_qaqc.csv") %>%
113+
filter(!is.na(max_possible)) %>%
114+
filter(parameter_som == parameter_i |
115+
parameter_pfh == parameter_i) %>%
116+
distinct(max_possible) %>%
117+
pull(max_possible)
118+
119+
assertthat::assert_that(length(max_i) == 1)
120+
83121

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

@@ -144,13 +182,13 @@ add_uncertainties_chem <- function(survey_form,
144182
!is.na(.data[[parameter_i]]),
145183
case_when(
146184
layer_type %in% c("forest_floor", "peat") & survey_year < 2000 ~
147-
pmin(.data[[parameter_max_i]] + unc_i$org_before_2000, 1000),
185+
pmin(.data[[parameter_max_i]] + unc_i$org_before_2000, max_i),
148186
layer_type %in% c("forest_floor", "peat") & survey_year >= 2000 ~
149-
pmin(.data[[parameter_max_i]] + unc_i$org_after_2000, 1000),
187+
pmin(.data[[parameter_max_i]] + unc_i$org_after_2000, max_i),
150188
layer_type == "mineral" & survey_year < 2000 ~
151-
pmin(.data[[parameter_max_i]] + unc_i$min_before_2000, 1000),
189+
pmin(.data[[parameter_max_i]] + unc_i$min_before_2000, max_i),
152190
layer_type == "mineral" & survey_year >= 2000 ~
153-
pmin(.data[[parameter_max_i]] + unc_i$min_after_2000, 1000)),
191+
pmin(.data[[parameter_max_i]] + unc_i$min_after_2000, max_i)),
154192
NA_integer_)) %>%
155193
relocate({{parameter_min_i}}, .after = {{parameter_i}}) %>%
156194
relocate({{parameter_max_i}}, .after = {{parameter_min_i}})

‎src/functions/depth_join.R

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -125,7 +125,10 @@ depth_join <- function(df1,
125125
}
126126

127127
if (mode == "time_specific_ff_concentrations") {
128-
possible_parameters <- "organic_carbon_total"
128+
possible_parameters <- c("organic_carbon_total",
129+
"n_total",
130+
"extrac_p",
131+
"extrac_s")
129132
}
130133

131134
parameters <- unique(

‎src/functions/gapfill_from_old_data.R

Lines changed: 63 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -4,6 +4,7 @@ gapfill_from_old_data <- function(survey_form,
44
save_to_env = FALSE,
55
parameters = c("bulk_density",
66
"organic_carbon_total",
7+
"n_total",
78
"organic_layer_weight",
89
"coarse_fragment_vol",
910
"part_size_clay",
@@ -408,6 +409,7 @@ gapfill_from_old_data <- function(survey_form,
408409
assertthat::assert_that(
409410
identical(parameters, c("bulk_density",
410411
"organic_carbon_total",
412+
"n_total",
411413
"organic_layer_weight",
412414
"coarse_fragment_vol",
413415
"part_size_clay",
@@ -460,13 +462,15 @@ gapfill_from_old_data <- function(survey_form,
460462
select(unique_layer_repetition,
461463
bulk_density,
462464
organic_carbon_total,
465+
n_total,
463466
organic_layer_weight,
464467
coarse_fragment_vol,
465468
part_size_clay,
466469
part_size_silt,
467470
part_size_sand) %>%
468471
rename(bulk_density_afscdb = bulk_density,
469472
organic_carbon_total_afscdb = organic_carbon_total,
473+
n_total_afscdb = n_total,
470474
organic_layer_weight_afscdb = organic_layer_weight,
471475
coarse_fragment_vol_afscdb = coarse_fragment_vol,
472476
part_size_clay_afscdb = part_size_clay,
@@ -504,6 +508,16 @@ gapfill_from_old_data <- function(survey_form,
504508
organic_carbon_total = coalesce(
505509
.data$organic_carbon_total,
506510
.data$organic_carbon_total_afscdb)) %>%
511+
# N total
512+
mutate(
513+
n_total_source = case_when(
514+
!is.na(n_total_source) ~ n_total_source,
515+
!is.na(.data$n_total) ~ "som (same year)",
516+
!is.na(.data$n_total_afscdb) ~ "FSCDB.LII (2012)",
517+
TRUE ~ NA_character_),
518+
n_total = coalesce(
519+
.data$n_total,
520+
.data$n_total_afscdb)) %>%
507521
# Organic layer weight
508522
mutate(
509523
organic_layer_weight_source = case_when(
@@ -570,6 +584,27 @@ gapfill_from_old_data <- function(survey_form,
570584
filter(is.na(.data$unique_survey_so_som)) %>%
571585
select(-unique_survey_so_som, -unique_layer_repetition)
572586

587+
# Some Romanian records were missing in both databases,
588+
# but the partner confirmed that they should be inserted.
589+
590+
layers_to_check <- c("52_2009_13_M12_3",
591+
"52_2009_13_M24_3",
592+
"52_2009_13_M48_3")
593+
594+
if (all(!layers_to_check %in% df$unique_layer_repetition)) {
595+
596+
assertthat::assert_that(
597+
all(layers_to_check %in% so_som_afscdb$unique_layer_repetition))
598+
599+
so_som_missing_records <- rbind(
600+
so_som_missing_records,
601+
so_som_afscdb %>%
602+
filter(unique_layer_repetition %in% layers_to_check) %>%
603+
select(-unique_survey_so_som, -unique_layer_repetition)
604+
)
605+
}
606+
607+
573608
# If there are any unique surveys in afscdb which are missing in so_som
574609

575610
if (nrow(so_som_missing_records) > 0) {
@@ -656,6 +691,7 @@ gapfill_from_old_data <- function(survey_form,
656691
"Record inserted from FSCDB.LII."),
657692
bulk_density_afscdb = bulk_density,
658693
organic_carbon_total_afscdb = organic_carbon_total,
694+
n_total_afscdb = n_total,
659695
organic_layer_weight_afscdb = organic_layer_weight,
660696
coarse_fragment_vol_afscdb = coarse_fragment_vol,
661697
part_size_clay_afscdb = part_size_clay,
@@ -747,7 +783,7 @@ gapfill_from_old_data <- function(survey_form,
747783
n_total_orig,
748784
origin_merged, origin_merge_info,
749785

750-
bulk_density_afscdb, organic_carbon_total_afscdb,
786+
bulk_density_afscdb, organic_carbon_total_afscdb, n_total_afscdb,
751787
organic_layer_weight_afscdb, coarse_fragment_vol_afscdb,
752788
part_size_clay_afscdb, part_size_silt_afscdb,
753789
part_size_sand_afscdb)
@@ -789,15 +825,17 @@ gapfill_from_old_data <- function(survey_form,
789825
code_plot = ifelse(code_country == 58 & code_plot == 2255,
790826
255,
791827
code_plot)) %>%
792-
mutate(repetition = ifelse(code_country == 58 & code_plot == 2188,
793-
2,
794-
plot_id),
795-
plot_id = ifelse(code_country == 58 & code_plot == 2188,
796-
"58_188",
797-
plot_id),
798-
code_plot = ifelse(code_country == 58 & code_plot == 2188,
799-
188,
800-
code_plot)) %>%
828+
# do not apply this because then, there seem to be two profiles
829+
# with 58_188 as plot_id
830+
# mutate(repetition = ifelse(code_country == 58 & code_plot == 2188,
831+
# 2,
832+
# repetition),
833+
# plot_id = ifelse(code_country == 58 & code_plot == 2188,
834+
# "58_188",
835+
# plot_id),
836+
# code_plot = ifelse(code_country == 58 & code_plot == 2188,
837+
# 188,
838+
# code_plot)) %>%
801839
mutate(
802840
unique_survey = paste0(code_country, "_",
803841
survey_year, "_",
@@ -1173,6 +1211,7 @@ gapfill_from_old_data <- function(survey_form,
11731211
assertthat::assert_that(
11741212
identical(parameters, c("bulk_density",
11751213
"organic_carbon_total",
1214+
"n_total",
11761215
"organic_layer_weight",
11771216
"coarse_fragment_vol",
11781217
"part_size_clay",
@@ -1223,10 +1262,12 @@ gapfill_from_old_data <- function(survey_form,
12231262
select(unique_layer_repetition_s1_som,
12241263
bulk_density,
12251264
organic_carbon_total,
1265+
n_total,
12261266
organic_layer_weight,
12271267
coarse_fragment_vol) %>%
12281268
rename(bulk_density_fscdb = bulk_density,
12291269
organic_carbon_total_fscdb = organic_carbon_total,
1270+
n_total_fscdb = n_total,
12301271
organic_layer_weight_fscdb = organic_layer_weight,
12311272
coarse_fragment_vol_fscdb = coarse_fragment_vol),
12321273
by = join_by("unique_layer_repetition" ==
@@ -1262,6 +1303,16 @@ gapfill_from_old_data <- function(survey_form,
12621303
organic_carbon_total = coalesce(
12631304
.data$organic_carbon_total,
12641305
.data$organic_carbon_total_fscdb)) %>%
1306+
# N total
1307+
mutate(
1308+
n_total_source = case_when(
1309+
!is.na(n_total_source) ~ n_total_source,
1310+
!is.na(.data$n_total) ~ "som (same year)",
1311+
!is.na(.data$n_total_fscdb) ~ "FSCDB.LI (2002)",
1312+
TRUE ~ NA_character_),
1313+
n_total = coalesce(
1314+
.data$n_total,
1315+
.data$n_total_fscdb)) %>%
12651316
# Organic layer weight
12661317
mutate(
12671318
organic_layer_weight_source = case_when(
@@ -1365,6 +1416,7 @@ gapfill_from_old_data <- function(survey_form,
13651416
other_obs = "Record inserted from FSCDB.LI.",
13661417
bulk_density_fscdb = bulk_density,
13671418
organic_carbon_total_fscdb = organic_carbon_total,
1419+
n_total_fscdb = n_total,
13681420
organic_layer_weight_fscdb = organic_layer_weight,
13691421
coarse_fragment_vol_fscdb = coarse_fragment_vol,
13701422
part_size_clay_fscdb = part_size_clay,
@@ -1428,6 +1480,7 @@ gapfill_from_old_data <- function(survey_form,
14281480
coarse_fragment_vol_orig, organic_layer_weight_orig,
14291481
organic_carbon_total_orig,
14301482
n_total_orig, bulk_density_fscdb, organic_carbon_total_fscdb,
1483+
n_total_fscdb,
14311484
organic_layer_weight_fscdb, coarse_fragment_vol_fscdb)
14321485

14331486
assertthat::assert_that(all(names(df) == names(s1_som_fscdb_to_add)))

0 commit comments

Comments
 (0)