Add create_status_cols function (#22)

* Add create_status_cols function

- Functionalized initialization of sawmill_pass and sawmill_status columns in timber at the start of the check_grain function
- Added to-do notes for build_chairs function
- Updated .gitignore to include .DS_Store

* Recover validate_contingency_table

- Added missing lines of code for validate_contingency_table function

.gitignore

@@ -2,3 +2,4 @@
 .RData
 .Rproj.user
 /ignored
+.DS_Store

DESCRIPTION

@@ -13,7 +13,7 @@ Description:
 License: GPL-3
 Encoding: UTF-8
 LazyData: true
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1
 Imports: 
     dplyr,
     readr,

NAMESPACE

@@ -9,6 +9,7 @@ export(build_chairs)
 export(build_horse)
 export(build_table)
 export(check_grain)
+export(create_status_cols)
 export(debark)
 export(dedupe_MA)
 export(do_MA)

R/build_chairs.R

@@ -47,12 +47,20 @@
 #'
 #' @export
 
+# Encapsulating odds_ratio and se_log_or separately
+# When the grain is the odds_ratio, the function would just return the odds ratio passed (when flag is OR)
+#   If parameter se = TRUE, then pass se as well
+#
+# Support different log_base, default to exp(1) -- natural log base
+#
+#
+# Next step: Create a function that works on tables, based on passed odds ratios/se
 
 build_chairs <- function(timber, log_base = exp(1)) {
 
   dplyr::mutate(timber,
                 odds_ratio = dplyr::case_when(
-                  grain == "odds_ratio" ~ odds,
+                  grain == "odds_ratio" ~ odds, # Call this function, pass it with the odds ratio
                   grain == "con_table_pos_neg" | grain == "con_table_pos_tot" | grain == "prev_table_pos_tot" ~ (A/B) / (C/D),
                   TRUE ~ NA_real_),
                 se_log_or  = dplyr::case_when(

R/check_grain.R

@@ -133,20 +133,24 @@ check_grain <- function(timber) {
     timber[ , 'grain'] <- NA_character_
   }
 
-  # Column `sawmill_pass` indicates whether sawmill should operate on the
-  # resistance outcome. Set `sawmill_pass = FALSE` after other co-occurring
-  # events during check failure.
-  if (!('sawmill_pass' %in% names(timber))) {
-    timber[ , 'sawmill_pass'] <- TRUE
-    message("Column 'sawmill_pass' did not exist and was created.")
-  }
-
-  # Column `sawmill_status` indicates the current sawmill status.
-  # Set `sawmill_status` after every sawmill operation.
-  if (!('sawmill_status' %in% names(timber))) {
-    timber[ , 'sawmill_status'] <- 'Initialized.'
-    message("Column 'sawmill_status' did not exist and was created.")
-  }
+  # Initialize 'sawmill_pass' and 'sawmill_status' if they do not exist
+  create_status_cols(timber)
+
+
+  # # Column `sawmill_pass` indicates whether sawmill should operate on the
+  # # resistance outcome. Set `sawmill_pass = FALSE` after other co-occurring
+  # # events during check failure.
+  # if (!('sawmill_pass' %in% names(timber))) {
+  #   timber[ , 'sawmill_pass'] <- TRUE
+  #   message("Column 'sawmill_pass' did not exist and was created.")
+  # }
+  #
+  # # Column `sawmill_status` indicates the current sawmill status.
+  # # Set `sawmill_status` after every sawmill operation.
+  # if (!('sawmill_status' %in% names(timber))) {
+  #   timber[ , 'sawmill_status'] <- 'Initialized.'
+  #   message("Column 'sawmill_status' did not exist and was created.")
+  # }
 
 
   # Check if `res_format` is a supported grain --------------------------------

R/create_status_cols.R

@@ -0,0 +1,50 @@
+
+
+#' @title
+#'    Initializes the `sawmill_status` and `sawmill_pass` columns at the start
+#'    of the \code{check_grain()} function
+#'
+#' @description
+#'    \code{create_status_cols()} adds columns to the passed tibble, containing
+#'    the sawmill status provided.
+#'
+#' @param timber
+#'    A tibble of timber, with a table built by \code{\link{build_table}}.
+#'
+#' @param status
+#'    A sawmill status description.
+#'
+#' @details
+#'    The \code{create_status_cols()} function works by initializing the default
+#'    sawmill status as specified in the \code{check_grain()} function.
+#'    The `sawmill_pass` column indicates whether sawmill should operate on the
+#'    resistance outcome. Set `sawmill_pass = FALSE` after other co-occurring
+#'    events during check failure.
+#'
+#' @return
+#'    The passed tibble of timber with additional columns containing the current
+#'    sawmill status.
+#'
+#'
+#' @export
+
+create_status_cols <- function(timber, status = "Initialized.") {
+    # Column 'sawmill_pass' indicates whether sawmill should operate on the
+    # resistance outcome. Set 'sawmill_pass = FALSE' after other co-occurring
+    # events during check failure.
+    if (!('sawmill_pass' %in% names(timber))) {
+        timber[ , 'sawmill_pass'] <- TRUE
+        message("Column 'sawmill_pass' did not exist and was created.")
+    }
+
+    # Column 'sawmill_status' indicates the current sawmill status.
+    # Set 'sawmill_status' after every sawmill operation.
+    if (!('sawmill_status' %in% names(timber))) {
+        # Default status
+        timber[ , 'sawmill_status'] <- status
+        message("Column 'sawmill_status' did not exist and was created.")
+    }
+
+    return(timber)
+
+}

R/validate_contingency_table.R

@@ -86,8 +86,23 @@ validate_contingency_table <- function (.A = NA, .B = NA,
                 table_type = table_type))
   }
 
+  # Check table type.
+  if ( !is.na(.A) & !is.na(.C) ) {
 
-  status_OK <- "OK: parameters pass checks for contingency table."
+    table_type <- "con_table_pos_tot"
+
+  } else if ( !is.na(.B) & !is.na(.D) ) {
+
+    table_type <- "con_table_neg_tot"
+
+  } else {
+
+    status     <- "Error: could not determine table type."
+    table_type <- "NA: could not determine table type."
+
+  }
+
+  status <- "OK: parameters pass checks for contingency table."
 
   return(list(is_valid   = TRUE,
               status     = status,