From 5264bdb29fe6ce868f2d735718e9bb59aee4102f Mon Sep 17 00:00:00 2001 From: Abel 'Akronix' Serrano Juste Date: Wed, 13 Mar 2024 17:36:14 +0100 Subject: [PATCH 1/2] Clear flags when reversing prior to do other manual corrections Firts clear flags of previous changes made by treenetproc, add the 'rev' flag and then do the other manual corrections. This comes out from the need that sometimes we want to reverse a change made by treenetproc and, at the same item position, force a jump. With the previous code, the force jump got a NA value since there was a 'fill' flag when the forcejump function was executing (see second statement of the forcejump function). This was because removing the previous flags and setting the 'rev' flag was done after all the corrections are made. --- R/corr_dendro_L2.R | 8 +++++-- R/functions_corr.R | 56 +++++++++++++++++++++++++++++++--------------- 2 files changed, 44 insertions(+), 20 deletions(-) diff --git a/R/corr_dendro_L2.R b/R/corr_dendro_L2.R index a9c0f1d..21c1410 100644 --- a/R/corr_dendro_L2.R +++ b/R/corr_dendro_L2.R @@ -121,18 +121,22 @@ corr_dendro_L2 <- function(dendro_L1 = NULL, dendro_L2, reverse = NULL, reverse = reverse, tz = tz) df <- reverse_list[[1]] diff_old <- reverse_list[[2]] + + # unset previous fill / out / jump flags and set the 'rev' flag + df <- revflags(df = df) } + if (length(force) != 0) { df <- forcejump(data_L2 = df, force = force, n_days = n_days) } + if (length(delete) != 0) { df <- deleteperiod(df = df, delete = delete) } df <- calcmax(df = df) df <- calctwdgro(df = df, tz = tz) - df <- summariseflagscorr(df = df, reverse = reverse, force = force, - delete = delete) + df <- summariseflagscorr(df = df, force = force, delete = delete) df <- df %>% dplyr::mutate(gro_yr = ifelse(is.na(value), NA, gro_yr)) %>% diff --git a/R/functions_corr.R b/R/functions_corr.R index 8dedd59..cb6a7e2 100644 --- a/R/functions_corr.R +++ b/R/functions_corr.R @@ -176,45 +176,65 @@ deleteperiod <- function(df, delete) { return(df) } +#' Reverse flags +#' +#' \code{revflags} removes all the flag of changes done +#' by any treenetproc automatic correction and adds instead +#' the "rev" flag +#' +#' @param df input \code{data.frame}. +#' +#' @keywords internal +#' +revflags <- function(df) { + + # create flags vector appeding "rev" flag when it's an item where there's a reversed change + flags <- paste(df$flags, ifelse(df$flagreversecorr, paste(df$flags,"rev",sep=", "), df$flags), sep=", ") + + + # remove flags of changes that are to be reversed + flags <- ifelse(grepl("(.*out|.*fill|.*jump)(.*rev)", flags, perl = TRUE), + gsub("out[[:digit:]]*,[[:blank:]]*|fill,[[:blank:]]*|jump[[:digit:]]*,[[:blank:]]*", + "", + flags), + flags) + + df$flags <- flags + + return(df) + +} + + #' Summarise Flags #' #' \code{summariseflagscorr} appends the flags of the corrections to the -#' existing flags. +#' existing flags (except for reverse). #' #' @param df input \code{data.frame}. #' #' @keywords internal #' -summariseflagscorr <- function(df, reverse = NULL, force = NULL, - delete = NULL) { +summariseflagscorr <- function(df, force = NULL, delete = NULL) { - list_flags <- vector("list", length = 3) + list_flags <- vector("list", length = 2) - if (length(reverse) != 0) { - list_flags[[1]] <- ifelse(df$flagreversecorr, "rev", NA) - } else { - list_flags[[1]] <- NA - } if (length(force) != 0) { - list_flags[[2]] <- ifelse(df$flagforcejump, "fjump", NA) + list_flags[[1]] <- ifelse(df$flagforcejump, "fjump", NA) } else { - list_flags[[2]] <- NA + list_flags[[1]] <- NA } if (length(delete) != 0) { - list_flags[[3]] <- ifelse(df$flagdelete, "del", NA) + list_flags[[2]] <- ifelse(df$flagdelete, "del", NA) } else { - list_flags[[3]] <- NA + list_flags[[2]] <- NA } flags <- do.call("paste", c(list_flags, sep = ", ")) list_all <- list(df$flags, flags) flags <- do.call("paste", c(list_all, sep = ", ")) - # remove flags of changes that were reversed - flags <- ifelse(grepl("(.*out|.*fill|.*jump)(.*rev)", flags, perl = TRUE), - gsub(".*out[[:digit:]]*|.*fill|.*jump[[:digit:]]*", "", - flags), - flags) + # remove all other flags if value was deleted flags <- gsub(".*del", "del", flags) # remove NA's and single commas From fd6f72397e18768adc7df3993ae35ae11536478d Mon Sep 17 00:00:00 2001 From: Abel 'Akronix' Serrano Juste Date: Mon, 15 Apr 2024 14:25:56 +0200 Subject: [PATCH 2/2] Fixed bug that duplicated flags when reversing and keep rev, flag after deleting --- R/functions_corr.R | 34 +++++++++++++++++----------------- 1 file changed, 17 insertions(+), 17 deletions(-) diff --git a/R/functions_corr.R b/R/functions_corr.R index cb6a7e2..91c4742 100644 --- a/R/functions_corr.R +++ b/R/functions_corr.R @@ -187,22 +187,19 @@ deleteperiod <- function(df, delete) { #' @keywords internal #' revflags <- function(df) { - - # create flags vector appeding "rev" flag when it's an item where there's a reversed change - flags <- paste(df$flags, ifelse(df$flagreversecorr, paste(df$flags,"rev",sep=", "), df$flags), sep=", ") - - - # remove flags of changes that are to be reversed - flags <- ifelse(grepl("(.*out|.*fill|.*jump)(.*rev)", flags, perl = TRUE), - gsub("out[[:digit:]]*,[[:blank:]]*|fill,[[:blank:]]*|jump[[:digit:]]*,[[:blank:]]*", - "", - flags), - flags) - - df$flags <- flags + # clear previous treenetproc flags and append "rev" flag + clearprevflags <- function (original_flags) { + new_flags <-gsub(".*out[[:digit:]]*|.*fill|.*jump[[:digit:]]*", + "", + original_flags) + return (ifelse(new_flags == "", "rev", paste(new_flags, "rev", sep=", "))) + } + + # substitute flags vector appeding "rev" flag when it's an item where there's a reversed change + df$flags <- ifelse(df$flagreversecorr, clearprevflags(df$flags), df$flags) return(df) - + } @@ -234,9 +231,12 @@ summariseflagscorr <- function(df, force = NULL, delete = NULL) { flags <- do.call("paste", c(list_flags, sep = ", ")) list_all <- list(df$flags, flags) flags <- do.call("paste", c(list_all, sep = ", ")) - - # remove all other flags if value was deleted - flags <- gsub(".*del", "del", flags) + + # if value deleted: + # if it was reversed keep the "rev, del" flags, otherwise remove all other flags and append "del" flag + flags <- ifelse(grepl(".*rev.*del", flags), + "rev, del", + gsub(".*del", "del", flags)) # remove NA's and single commas flags <- gsub(", NA|NA, |^, ", "", flags) flags <- ifelse(flags %in% c("NA", ""), NA, flags)