drop_na implemneted in remove outliers

DESCRIPTION

@@ -8,7 +8,7 @@ Description: The 'inti' package is part of the 'inkaverse' project for developin
     experiments and data collection (tarpuy()), data analysis and graphics (yupana())
     , and technical writing. 
     Learn more about the 'inkaverse' project at <https://inkaverse.com/>.
-Date: 2022-07-17
+Date: 2022-07-29
 Authors@R: c(
     person("Flavio", "Lozano-Isla", email = "[email protected]", role = c("aut", "cre")
           , comment = c(ORCID = "0000-0002-0714-669X")),

NEWS.md

@@ -6,6 +6,7 @@
   - `gdocs2rmd()` ==> `gdocs2qmd()`
  - Fix `plot_raw()`: "length(x) = 2 > 1' in coercion to 'logical(1)"
  - Update `jc_tombola()`
+ - `outliers_remove(drop.na = FALSE)` allows avoid drop NA values by default 
 
 # inti 0.5.6
 

R/figure2qmd.R

@@ -8,7 +8,7 @@
 #' 
 #' @details
 #' 
-#' Quarto option can be included in the title using "{{}}" separated by commas.
+#' Quarto option can be included in the title using "{{}}" separated by commas
 #'
 #' @return string mutated
 #' 
@@ -18,38 +18,49 @@
 figure2qmd <- function(text
                        , path = "."
                        , opts = NA
-                       ) {
+) {
 
   # path <- tempdir()
   # text <- "The experiment was carried out in a complete randomized block design with two irrigation treatments with five replications of each genotype per treatment. In well-watered (WW) treatment, plants were irrigated according to their transpiration demand ([Figure  @fig:id.z21kyltlev9z]:A) and in water deficit (WD) treatment, the water supply was gradually reduced until the wilting point [(Ray & Sinclair, 1998)](https://www.zotero.org/google-docs/?y2XuVg). At 35 dap, before the stress initiation, the pots were watered to soaking and then allowed to drain overnight [(Bhatnagar-Mathur et al., 2007)](https://www.zotero.org/google-docs/?aBxXpi). The next morning, the pots were sealed in a plastic bag secured with a twist tie to prevent water loss except by transpiration and arranged in the greenhouse according to the experimental design. Thereafter, all the pots were weighed and this weight was defined as the initial pot weight. The inter-daily weight of the pots was measured for ten days to calculate the initial dry down parameters for treatment application ([Figure  @fig:id.z21kyltlev9z]:B). The WD treatment started at 45 dap which coincides with the beginning of tuber initiation."
   # text <- "![(A) Fraction of transpirable soil water (FTSW). (B) Daily transpiration in 15 potato genotypes under well-watered (WW) and water deficit (WD) conditions.](img_0.png){#fig-id.olts8je85fk5}"
   # text <- "![Choose the images. {{fig-width: “50%”, echo: true}}](img_1.png){#fig:id.bzfoh3m13vt1}"
 
   # text %>% gsub(".+\\{\\{(.+)\\}\\}(.+)", "\\1", .)
-  # text <- "![null|null](img_6.  jpg)  "
+  # text <- "![null|null](img_5.jpg)  \t\n\r\v\f"
 
   # result %>% cat()
 
-  result <- if(isTRUE(grepl("null|null", text))) { 
+  result <- if(isTRUE(grepl("\\!\\[null", text))) { 
 
     opt <- text %>% 
-      gsub("[[:blank:]]", "", .) %>% 
-      gsub(".+](.*)", "\\1", .) %>% 
-      gsub("\\(|\\)", "'", .) %>% 
-      gsub("img", file.path(path, "img"), .) %>% 
-      paste("knitr::include_graphics(", ., ")") %>% 
-      gsub("[[:blank:]]", "", .)
+      tibble::enframe(name = "num") %>% 
+      dplyr::mutate(img = gsub(".+](.*)", "\\1", .data$value)) %>% 
+      dplyr::mutate(img = gsub("[[:space:]]", "", .data$img)) %>% 
+      dplyr::mutate(img = gsub("\\(|\\)", "", .data$img)) %>% 
+      dplyr::select(!c(.data$value)) %>% 
+      tidyr::pivot_longer(!.data$num) %>% 
 
-    chunk <- paste(
-      "```{r}\n\n"
+      dplyr::mutate(opt = dplyr::case_when(
+        .data$name %in% "id" ~ paste0("#| label: ", .data$value)
+        , .data$name %in% "title" ~ paste0("#| fig-cap: '", .data$value, "'")
+        , .data$name %in% "img" ~ paste0("\nknitr::include_graphics('", file.path(path, .data$value) %>% gsub("\\\\", "\\/", .),"')")
+        , .data$name %in% "opts" ~ .data$value %>% gsub(",", "\n#|", .) %>% paste("#|", .)
+      )) %>% 
+      tidyr::drop_na(.data$opt) %>% 
+      dplyr::select(.data$opt) %>% 
+      dplyr::mutate(opt = gsub("[[:space:]]", "", .data$opt)) %>% 
+      purrr::as_vector() %>% 
+      paste0(collapse = "\n")
+
+    chunk <- paste0(
+      "```{r}\n"
       , opt
-      , "\n\n```"
-    ) %>% 
-      gsub("[[:blank:]]", "", .)
+      , "\n```"
+    ) 
 
     # chunk %>% cat()
 
-    } else if (isTRUE(grepl("^\\!\\[", text))) { # 
+  } else if (isTRUE(grepl("^\\!\\[", text))) { # 
 
     opt <- text %>% 
       tibble::enframe(name = "num") %>% 
@@ -74,31 +85,31 @@ figure2qmd <- function(text
         , .data$name %in% "title" ~ paste0("#| fig-cap: '", .data$value, "'")
         , .data$name %in% "path" ~ paste0("\nknitr::include_graphics('", file.path(path, .data$value) %>% gsub("\\\\", "\\/", .),"')")
         , .data$name %in% "opts" ~ .data$value %>% gsub(",", "\n#|", .) %>% paste("#|", .)
-        )) %>% 
+      )) %>% 
       dplyr::select(.data$opt) %>% 
       purrr::as_vector() %>% 
       paste0(collapse = "\n")
-      
+
     chunk <- paste0(
       "```{r}\n"
       , opt
       , "\n```"
-      ) 
+    ) 
 
     # chunk %>% cat()
 
-    } else if(isTRUE(grepl("fig\\:", text))) {
-      
-      cite <- text %>%
-        gsub("fig\\:", "fig-", .) %>% 
-        gsub("]:", "]", .) %>% 
-        gsub("Figure  \\@", "\\@", .)
-      
-    } else {
-      
-      text
-      
-    }
+  } else if(isTRUE(grepl("fig\\:", text))) {
+
+    cite <- text %>%
+      gsub("fig\\:", "fig-", .) %>% 
+      gsub("]:", "]", .) %>% 
+      gsub("Figure  \\@", "\\@", .)
+
+  } else {
+
+    text
+
+  }
 
   return(result)
 

R/gdoc2qmd.R

@@ -7,6 +7,10 @@
 #'
 #' @return path
 #' 
+#' @details 
+#' 
+#' If you add "> END" will replace by "knitr::knit_exit()"
+#' 
 #' @export
 #' 
 
@@ -26,9 +30,10 @@ gdoc2qmd <- function(file
     readLines() %>% 
     tibble::enframe() %>%
     dplyr::rowwise() %>%
+    dplyr::mutate(value = gsub("```Unknown element type at this position: UNSUPPORTED```", "\\\\newpage \n\n", .data$value)) %>%
+    dplyr::mutate(value = gsub("> END", "```{r}\nknitr::knit_exit() \n```", .data$value)) %>% 
     dplyr::mutate(value = figure2qmd(.data$value, path = export)) %>% 
     dplyr::mutate(value = table2qmd(.data$value)) %>%
-    dplyr::mutate(value = gsub("```Unknown element type at this position: UNSUPPORTED```", "\\\\newpage \n\n", .data$value)) %>% 
     dplyr::select(.data$value) %>% 
     tibble::deframe() %>% 
     writeLines(con = file.path(export, "_doc.Rmd") %>% gsub("\\\\", "\\/", .))

R/outliers_remove.R

@@ -5,6 +5,7 @@
 #' @param data Experimental design data frame with the factors and traits.
 #' @param trait Name of the trait.
 #' @param model The fixed or random effects in the model.
+#' @param drop_na drop NA values from the data.frame
 #'
 #' @description
 #'
@@ -32,15 +33,17 @@
 #' rmout <- outliers_remove(
 #'   data = potato
 #'   , trait ="stemdw"
-#'   , model = "0 + (1|bloque) + geno"
+#'   , model = "0 + treat*geno + (1|bloque) + geno"
+#'   , drop_na = FALSE
 #'   )
-#'   
-#' rmout$outliers
+#' 
+#' rmout
 #'   
 
 outliers_remove <- function(data
                             , trait
                             , model
+                            , drop_na = TRUE
                             ) {
 
   out_flag <- bholm <- NULL
@@ -83,7 +86,12 @@ outliers_remove <- function(data
     dplyr::filter(out_flag %in% "OUTLIER")
 
   nwdt <- cbind(newdt, BHStud_test) %>%
-    dplyr::filter(!out_flag %in% "OUTLIER") %>%
+    mutate({{trait}} := case_when(
+      !out_flag %in% "OUTLIER" ~ as.character(.data[[trait]])
+      , TRUE ~ NA_character_
+    )) %>% 
+    mutate(across({{trait}}, as.numeric)) %>% 
+    {if (isTRUE(drop_na)) {drop_na(data = ., any_of({{trait}}))} else {.}} %>% 
     select({{model_fact}}) %>%
     relocate({{trait}}, .after = last_col())
 

R/table2qmd.R

@@ -31,14 +31,14 @@ table2qmd <- function(text) {
       dplyr::select(.data$opt) %>% 
       purrr::as_vector() %>% 
       paste0(collapse = "\n")
-      
+
     chunk <- paste0(
       "```{r}\n"
       , opt
       , "\n\nknitr::kable(NA)"
       , "\n```"
-    ) 
-    
+    )
+
     # chunk %>% cat()
 
   } else if(isTRUE(grepl("tbl\\:", text))) {