Clear flags when reversing prior to do other manual corrections

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)) %>%

R/functions_corr.R

@@ -176,47 +176,67 @@ 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) {
+  # 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)
+
+}
+
+
 
 #' 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)
+
+  # 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)