R/get_agent_x_list.R

In pointblank: Data Validation and Organization of Metadata for Local and Remote Tables

#
#                _         _    _      _                _    
#               (_)       | |  | |    | |              | |   
#  _ __    ___   _  _ __  | |_ | |__  | |  __ _  _ __  | | __
# | '_ \  / _ \ | || '_ \ | __|| '_ \ | | / _` || '_ \ | |/ /
# | |_) || (_) || || | | || |_ | |_) || || (_| || | | ||   < 
# | .__/  \___/ |_||_| |_| \__||_.__/ |_| \__,_||_| |_||_|\_\
# | |                                                        
# |_|                                                        
# 
# This file is part of the 'rich-iannone/pointblank' package.
# 
# (c) Richard Iannone <riannone@me.com>
# 
# For full copyright and license information, please look at
# https://rich-iannone.github.io/pointblank/LICENSE.html
#


#' Get the agent's **x-list**
#'
#' @description 
#' The agent's **x-list** is a record of information that the agent possesses at
#' any given time. The **x-list** will contain the most complete information
#' after an interrogation has taken place (before then, the data largely
#' reflects the validation plan). The **x-list** can be constrained to a
#' particular validation step (by supplying the step number to the `i`
#' argument), or, we can get the information for all validation steps by leaving
#' `i` unspecified. The **x-list** is indeed an R `list` object that contains a
#' veritable cornucopia of information.
#'
#' For an **x-list** obtained with `i` specified for a validation step, the
#' following components are available:
#' \itemize{
#' \item `time_start`: the time at which the interrogation began
#' (`POSIXct [0 or 1]`)
#' \item `time_end`: the time at which the interrogation ended
#' (`POSIXct [0 or 1]`)
#' \item `label`: the optional label given to the agent (`chr [1]`)
#' \item `tbl_name`: the name of the table object, if available (`chr [1]`)
#' \item `tbl_src`: the type of table used in the validation (`chr [1]`)
#' \item `tbl_src_details`: if the table is a database table, this provides
#' further details for the DB table (`chr [1]`)
#' \item `tbl`: the table object itself
#' \item `col_names`: the table's column names (`chr [ncol(tbl)]`)
#' \item `col_types`: the table's column types (`chr [ncol(tbl)]`)
#' \item `i`: the validation step index (`int [1]`)
#' \item `type`: the type of validation, value is validation function name
#' (`chr [1]`)
#' \item `columns`: the columns specified for the validation function
#' (`chr [variable length]`)
#' \item `values`: the values specified for the validation function
#' (`mixed types [variable length]`)
#' \item `briefs`: the brief for the validation step in the specified `lang`
#' (`chr [1]`)
#' \item `eval_error`, `eval_warning`: indicates whether the evaluation of the
#' step function, during interrogation, resulted in an error or a warning
#' (`lgl [1]`)
#' \item `capture_stack`: a list of captured errors or warnings during
#' step-function evaluation at interrogation time (`list [1]`)
#' \item `n`: the number of test units for the validation step (`num [1]`)
#' \item `n_passed`, `n_failed`: the number of passing and failing test units
#' for the validation step (`num [1]`)
#' \item `f_passed`: the fraction of passing test units for the validation step,
#' `n_passed` / `n` (`num [1]`)
#' \item `f_failed`: the fraction of failing test units for the validation step,
#' `n_failed` / `n` (`num [1]`)
#' \item `warn`, `stop`, `notify`: a logical value indicating whether the level
#' of failing test units caused the corresponding conditions to be entered
#' (`lgl [1]`)
#' \item `lang`: the two-letter language code that indicates which
#' language should be used for all briefs, the agent report, and the reporting
#' generated by the [scan_data()] function (`chr [1]`) 
#' }
#' 
#' If `i` is unspecified (i.e., not constrained to a specific validation step)
#' then certain length-one components in the **x-list** will be expanded to the
#' total number of validation steps (these are: `i`, `type`, `columns`,
#' `values`, `briefs`, `eval_error`, `eval_warning`, `capture_stack`, `n`,
#' `n_passed`, `n_failed`, `f_passed`, `f_failed`, `warn`, `stop`, and
#' `notify`). The **x-list** will also have additional components when `i` is
#' `NULL`, which are:
#' \itemize{
#' \item `report_object`: a **gt** table object, which is also presented as the
#' default print method for a `ptblank_agent`
#' \item `email_object`: a **blastula** `email_message` object with a default
#' set of components
#' \item `report_html`: the HTML source for the `report_object`, provided as
#' a length-one character vector
#' \item `report_html_small`: the HTML source for a narrower, more condensed
#' version of `report_object`, provided as a length-one character vector; The
#' HTML has inlined styles, making it more suitable for email message bodies
#' }
#'
#' @param agent An agent object of class `ptblank_agent`.
#' @param i The validation step number, which is assigned to each validation
#'   step in the order of invocation. If `NULL` (the default), the **x-list**
#'   will provide information for all validation steps. If a valid step number
#'   is provided then **x-list** will have information pertaining only to that
#'   step.
#' 
#' @return A `list` object.
#' 
#' @section Examples:
#' 
#' Create a simple data frame with a column of numerical values.
#' 
#' ```{r}
#' tbl <- dplyr::tibble(a = c(5, 7, 8, 5))
#' 
#' tbl
#' ```
#' 
#' Create an `action_levels()` list with fractional values for the `warn`,
#' `stop`, and `notify` states.
#' 
#' ```r
#' al <-
#'   action_levels(
#'     warn_at = 0.2,
#'     stop_at = 0.8,
#'     notify_at = 0.345
#'   )
#' ```
#' 
#' Create an agent (giving it the `tbl` and the `al` objects), supply two
#' validation step functions, then interrogate.
#' 
#' ```r
#' agent <-
#'   create_agent(
#'     tbl = tbl,
#'     actions = al
#'   ) %>%
#'   col_vals_gt(columns = vars(a), value = 7) %>%
#'   col_is_numeric(columns = vars(a)) %>%
#'   interrogate()
#' ```
#'   
#' Get the `f_passed` component of the agent x-list.
#' 
#' ```r
#' x <- get_agent_x_list(agent)
#' 
#' x$f_passed
#' ```
#' 
#' ```
#' #> [1] 0.25 1.00
#' ```
#' 
#' @family Post-interrogation
#' @section Function ID:
#' 8-1
#' 
#' @export
get_agent_x_list <- function(
    agent,
    i = NULL
) {
  
  if (!is.null(i)) {
    
    .warn <- agent$validation_set[[i, "warn"]]
    .notify <- agent$validation_set[[i, "notify"]]
    .stop <- agent$validation_set[[i, "stop"]]
    
    .agent_label <- agent$label
    .time_start <- agent$time_start
    .time_end <- agent$time_end
    .lang <- agent$lang
    .tbl <- agent$tbl
    .tbl_name <- agent$tbl_name
    .tbl_src <- agent$tbl_src
    .tbl_src_details <- agent$tbl_src_details
    .col_names <- agent$col_names
    .col_types <- agent$col_types
    
    .i <- i
    .type <- agent$validation_set[[i, "assertion_type"]]
    .columns <- agent$validation_set[[i, "column"]] %>% unlist()
    .values <- agent$validation_set[[i, "values"]] %>% unlist()
    .label <- agent$validation_set[[i, "label"]]
    .briefs <- agent$validation_set[[i, "brief"]]
    
    .eval_error <- agent$validation_set[[i, "eval_error"]]
    .eval_warning <- agent$validation_set[[i, "eval_warning"]]
    .capture_stack <- agent$validation_set[[i, "capture_stack"]]
    
    .n <- agent$validation_set[[i, "n"]]
    .n_passed <- agent$validation_set[[i, "n_passed"]]
    .n_failed <- agent$validation_set[[i, "n_failed"]]
    .f_passed <- agent$validation_set[[i, "f_passed"]]
    .f_failed <- agent$validation_set[[i, "f_failed"]]
    
    x <-
      list(
        time_start = .time_start,
        time_end = .time_end,
        label = .agent_label,
        tbl_name = .tbl_name,
        tbl_src = .tbl_src,
        tbl_src_details = .tbl_src_details,
        tbl = .tbl,
        col_names = .col_names,
        col_types = .col_types,
        i = .i,
        type = .type,
        columns = .columns,
        values = .values,
        label = .label,
        briefs = .briefs,
        eval_error = .eval_error,
        eval_warning = .eval_warning,
        capture_stack = .capture_stack,
        n = .n,
        n_passed = .n_passed,
        n_failed = .n_failed,
        f_passed = .f_passed,
        f_failed = .f_failed,
        warn = .warn,
        stop = .stop,
        notify = .notify,
        lang = .lang
      )
    
    class(x) <- c("x_list_i", "x_list")
  }
  
  if (is.null(i)) {
    
    .warn <- agent$validation_set$warn
    .notify <- agent$validation_set$notify
    .stop <- agent$validation_set$stop
    
    .agent_label <- agent$label
    .time_start <- agent$time_start
    .time_end <- agent$time_end
    .lang <- agent$lang
    .tbl <- agent$tbl
    .tbl_name <- agent$tbl_name
    .tbl_src <- agent$tbl_src
    .tbl_src_details <- agent$tbl_src_details
    .col_names <- agent$col_names
    .col_types <- agent$col_types
    
    .i <- agent$validation_set$i
    .type <- agent$validation_set$assertion_type
    .columns <- agent$validation_set$column
    .values <- agent$validation_set$values
    .label <- agent$validation_set$label
    .briefs <- agent$validation_set$brief
    
    .eval_error <- agent$validation_set$eval_error
    .eval_warning <- agent$validation_set$eval_warning
    .capture_stack <- agent$validation_set$capture_stack
    
    .n <- agent$validation_set$n
    .n_passed <- agent$validation_set$n_passed
    .n_failed <- agent$validation_set$n_failed
    .f_passed <- agent$validation_set$f_passed
    .f_failed <- agent$validation_set$f_failed
    
    .validation_set <- agent$validation_set
    
    .report_object <- agent %>% get_agent_report()
    .report_object_small <- agent %>% get_agent_report(size = "small")
    
    if (!is.null(.report_object)) {
      .report_html <- gt::as_raw_html(.report_object, inline_css = FALSE)
    } else {
      .report_html <- NULL
    }
    
    if (!is.null(.report_object_small)) {
      .report_html_small <- 
        gt::as_raw_html(.report_object_small, inline_css = TRUE)
    } else {
      .report_html_small <- NULL
    }
    
    if (length(.time_start) != 0) {
      
      # Create a 'temporary' x-list just for the `stock_msg_body()`
      # function used in the `blastula::compose_email()` call
      x <-
        list(
          time_start = .time_start,
          report_html_small = .report_html_small,
          lang = .lang,
          i = .i,
          n = .n,
          validation_set = .validation_set
        )
      
      .email_object <- 
        blastula::compose_email(
          header = NULL,
          body = glue::glue(stock_msg_body()) %>% gt::html(),
          footer = glue::glue(stock_msg_footer()) %>% gt::html(),
        )
      
    } else {
      .email_object <- NULL
    }
    
    x <-
      list(
        time_start = .time_start,
        time_end = .time_end,
        label = .agent_label,
        tbl_name = .tbl_name,
        tbl_src = .tbl_src,
        tbl_src_details = .tbl_src_details,
        tbl = .tbl,
        col_names = .col_names,
        col_types = .col_types,
        i = .i,
        type = .type,
        columns = .columns,
        values = .values,
        label = .label,
        briefs = .briefs,
        eval_error = .eval_error,
        eval_warning = .eval_warning,
        capture_stack = .capture_stack,
        n = .n,
        n_passed = .n_passed,
        n_failed = .n_failed,
        f_passed = .f_passed,
        f_failed = .f_failed,
        warn = .warn,
        stop = .stop,
        notify = .notify,
        lang = .lang,
        validation_set = .validation_set,
        report_object = .report_object,
        email_object = .email_object,
        report_html = .report_html,
        report_html_small = .report_html_small
      )
    
    class(x) <- c("x_list_n", "x_list")
  }
  
  x
}