Skip to content

Commit

Permalink
Deal with error messages
Browse files Browse the repository at this point in the history
  • Loading branch information
@heleenderoo
heleenderoo committed Mar 6, 2024
1 parent 0c72bdb commit 3d74919
Show file tree
Hide file tree
Showing 3 changed files with 93 additions and 12 deletions.
60 changes: 49 additions & 11 deletions src/functions/get_layer_inconsistencies.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -5037,6 +5037,7 @@ assign_env(paste0("list_layer_inconsistencies_", survey_form),

for (i in seq_along(unique(df$unique_survey_profile))) {


# Determine index of layers with the given unique_survey_profile in df

vec <- which(unique(df$unique_survey_profile)[i] ==
Expand Down Expand Up @@ -5917,12 +5918,22 @@ assign_env(paste0("list_layer_inconsistencies_", survey_form),

assertthat::assert_that(
paste(df$horizon_master[vec_ff], collapse = "_") %in%
all_combinations,
all_combinations ||
(length(unique(df$horizon_master[vec_ff])) == 1 &&
length(unique(df$horizon_number[vec_ff])) == 2),
msg = paste0("Unknown combination of two forest floor layers ('",
df$horizon_master[vec_ff[1]], "' and '",
df$horizon_master[vec_ff[2]],
"')."))

if (!paste(df$horizon_master[vec_ff], collapse = "_") %in%
all_combinations &&
(length(unique(df$horizon_master[vec_ff])) == 1 &&
length(unique(df$horizon_number[vec_ff])) == 2)) {
df$layer_number[vec_ff] <- rank(df$horizon_number[vec_ff],
na.last = "keep")
}

# If the forest floor layers are not called "O" and "O2"

for (j in c(3, 5:ncol(layer_number_two_forest_floor_layers))) {
Expand Down Expand Up @@ -5966,13 +5977,21 @@ assign_env(paste0("list_layer_inconsistencies_", survey_form),
function(x) paste(sort(x), collapse = "_"))

assertthat::assert_that(
paste(sort(layers_ff), collapse = "_") %in% sorted_combinations,
paste(sort(layers_ff), collapse = "_") %in% sorted_combinations ||
(length(unique(df$horizon_number[vec_ff])) == 3),
msg = paste0("Unknown combination of three forest floor layers ('",
df$horizon_master[vec_ff[1]], "', '",
df$horizon_master[vec_ff[2]], "' and '",
df$horizon_master[vec_ff[3]],
"')."))

if (!paste(sort(layers_ff), collapse = "_") %in% sorted_combinations &&
(length(unique(df$horizon_number[vec_ff])) == 3)) {
df$layer_number[vec_ff] <- rank(df$horizon_number[vec_ff],
na.last = "keep")
}


col_table <-
sorted_combinations[which(sorted_combinations ==
paste(sort(layers_ff), collapse = "_"))]
Expand Down Expand Up @@ -6055,6 +6074,20 @@ assign_env(paste0("list_layer_inconsistencies_", survey_form),
which(!is.na(df$horizon_limit_up[vec_horizon_number]) &
!is.na(df$horizon_limit_low[vec_horizon_number]))]

# Check for redundant layers

if (length(vec_nonempty) > 1) {

source("./src/functions/get_redundant_layers.R")

redundant_layers <- get_redundant_layers(
layers = layers[which(vec %in% vec_nonempty)],
superior_layer_limits = df$horizon_limit_up[vec_nonempty],
inferior_layer_limits = df$horizon_limit_low[vec_nonempty],
df_sub = as.data.frame(df[vec_nonempty, ]))
} else {
redundant_layers <- as_tibble(data.frame(col = NULL))
}

# Check if the ranking based on horizon_limit_up is the same
# like the ranking based on horizon_limit_low
Expand All @@ -6070,7 +6103,8 @@ assign_env(paste0("list_layer_inconsistencies_", survey_form),
identical(rank(as.numeric(df$horizon_limit_up[vec_nonempty]),
na.last = "keep"),
rank(as.numeric(df$horizon_number[vec_nonempty]),
na.last = "keep"))) {
na.last = "keep")) &&
nrow(redundant_layers) == 0) {

# Rank the layers based on horizon_number
# (including layers without layer limit information)
Expand Down Expand Up @@ -6120,13 +6154,13 @@ assign_env(paste0("list_layer_inconsistencies_", survey_form),

# Check for redundant layers

source("./src/functions/get_redundant_layers.R")

redundant_layers <- get_redundant_layers(
layers = layers[which(vec %in% vec_nonempty)],
superior_layer_limits = df$horizon_limit_up[vec_nonempty],
inferior_layer_limits = df$horizon_limit_low[vec_nonempty],
df_sub = as.data.frame(df[vec_nonempty, ]))
# source("./src/functions/get_redundant_layers.R")
#
# redundant_layers <- get_redundant_layers(
# layers = layers[which(vec %in% vec_nonempty)],
# superior_layer_limits = df$horizon_limit_up[vec_nonempty],
# inferior_layer_limits = df$horizon_limit_low[vec_nonempty],
# df_sub = as.data.frame(df[vec_nonempty, ]))

# If there are any redundant layers

Expand Down Expand Up @@ -6244,8 +6278,12 @@ assign_env(paste0("list_layer_inconsistencies_", survey_form),
vec_r <-
vec_non_redundant[which(df$horizon_master[vec_non_redundant] == "R")]

layer_numbers_remaining <- df[vec_non_redundant, ] %>%
filter(!layer_number %in% df$layer_number[vec_r]) %>%
pull(layer_number)

if (!identical(vec_r, integer(0)) &&
df$layer_number[vec_r] == max(df$layer_number[vec_non_redundant])) {
all(df$layer_number[vec_r] > max(layer_numbers_remaining))) {

# Consider this layer redundant, since no soil in bedrock
# (largely unweathered hard rock)
Expand Down
4 changes: 3 additions & 1 deletion src/functions/merge_duplicate_records.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -143,7 +143,9 @@ list_man <- c("country", "partner_short", "partner", "survey_year",
"code_layer_orig", "part_size_clay_orig", "part_size_silt_orig",
"part_size_sand_orig", "bulk_density_orig",
"coarse_fragment_vol_orig", "organic_layer_weight_orig",
"organic_carbon_total_orig", "n_total_orig")
"organic_carbon_total_orig", "n_total_orig",
"part_size_clay_source", "part_size_silt_source",
"part_size_sand_source", "coarse_fragment_vol_source")

# Rule:
# if both values are the same: take the unique value,
Expand Down
41 changes: 41 additions & 0 deletions src/functions/solve_record_inconsistencies.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -780,6 +780,47 @@ if (survey_form == "s1_som") {

}



## Czech Republic ----

# Due to former mistake in database: Czech plot 2188 actually
# doesn't exist and refers to plot 188 (see read_raw)

lines_to_check <- df %>%
filter(plot_id == "58_188") %>%
filter(survey_year == 1995)

if (nrow(lines_to_check) > 0 &&
length(which(lines_to_check$code_layer == "M01")) == 2 &&
length(which(lines_to_check$code_layer == "M12")) == 2 &&
length(unique(lines_to_check$repetition)) == 1 &&
length(unique(lines_to_check$code_plot_orig)) == 2) {

lines_to_check <- lines_to_check %>%
filter(code_plot_orig != 188) %>%
pull(code_line)

df <- df %>%
mutate(repetition = ifelse((!is.na(code_line)) &
code_line %in% lines_to_check,
2,
repetition)) %>%
mutate(unique_survey_repetition =
ifelse((!is.na(code_line)) &
code_line %in% lines_to_check,
paste0(code_country, "_", survey_year, "_",
code_plot, "_", repetition),
unique_survey_repetition),
unique_layer_repetition =
ifelse((!is.na(code_line)) &
code_line %in% lines_to_check,
paste0(code_country, "_", survey_year, "_",
code_plot, "_", code_layer, "_", repetition),
unique_layer_repetition))

}

} # End of "if s1_som"


Expand Down

0 comments on commit 3d74919

Please sign in to comment.