Add diff_tables and replace_all_na

DESCRIPTION

@@ -20,6 +20,7 @@ Imports:
     readr,
     readxl,
     rlang,
+    stats,
     stringr,
     tidyr,
     tidyselect,

NAMESPACE

@@ -7,6 +7,8 @@ export(convert_col_date)
 export(convert_date)
 export(convert_to_age_band)
 export(create_sss_calendar)
+export(diff_column)
+export(diff_tables)
 export(extract_table)
 export(financial_year)
 export(import_raw_tables)
@@ -18,6 +20,7 @@ export(make_number_percent)
 export(make_string_numeric)
 export(make_supp_negative)
 export(mround)
+export(replace_all_na)
 export(round_and_suppress)
 export(transpose_data)
 importFrom(magrittr,"%>%")

R/convert_types.R

@@ -57,7 +57,7 @@ make_string_numeric <- function(value){
 #' This function applies [make_string_numeric()] across a whole table.
 #' @param table A data frame
 #' @param across Columns to convert across. Takes tidyselect specification.
-#' #' Defaults to `everything()`
+#' Defaults to `everything()`
 #' @export
 
 make_all_string_numeric <- function(table, across = tidyselect::everything()) {
@@ -95,7 +95,7 @@ make_number_percent <- function(value){
 #' This function applies [make_number_percent()] across a whole table.
 #' @param table A data frame
 #' @param across Columns to convert across. Takes tidyselect specification.
-#' #' Defaults to `contains("Percentage")`
+#' Defaults to `contains("Percentage")`
 #' @export
 
 make_all_number_percent <- function(table, across = tidyselect::contains("Percentage")){
@@ -106,3 +106,21 @@ make_all_number_percent <- function(table, across = tidyselect::contains("Percen
         {{across}},
         ~ purrr::map_vec(.x, ~ make_number_percent(.x))))
 }
+
+#' Replace NA Over a Table
+#'
+#' This function applies [replace_na()] across a whole table.
+#' @param table A data frame
+#' @param replace Value to replace NA with
+#' @param across Columns to convert across. Takes tidyselect specification.
+#' Defaults to `everything()`
+#' @export
+
+replace_all_na <- function(table, replace, across = tidyselect::everything()) {
+  table %>%
+    dplyr::mutate(
+      dplyr::across(
+        {{across}},
+        ~tidyr::replace_na(.x, replace)))
+
+}

R/import_tables.R

@@ -1,3 +1,5 @@
+#' Extract Publication Table from Raw Import
+#'
 #' This function takes raw input read from a publication file and extracts the
 #' underlying data
 #' @param data A data frame read from a publication file
@@ -28,6 +30,8 @@ extract_table <- function(data) {
 
 }
 
+#' Import Raw Data from Publication Tables
+#'
 #' This function takes an excel file of publication tables and reads in the data
 #' (including titles, heading and notes). Useful for debugging if `import tables()`
 #' is not working as expected.
@@ -42,6 +46,8 @@ import_raw_tables <- function(filepath) {
     purrr::map(dplyr::as_tibble)
 }
 
+#' Import and Extract Publication Tables
+#'
 #' This function takes an excel file of publication tables, reads in the data and
 #' extracts the data tables.
 #' @param filepath Excel file containing publication tables

R/qa_tables.R

@@ -0,0 +1,62 @@
+#' Take the Difference of a Matching Column in Two Tables
+#'
+#' This function returns a vector of differences corresponding to a specified column
+#' in two data frames. It will only consider rows present in both data
+#' sets based on the first column.
+#' @param table_1 First table
+#' @param table_2 Second table
+#' @param column column to consider
+#' @export
+
+
+diff_column <- function(table_1, table_2, column) {
+  this_time <-
+    table_2 %>%
+    dplyr::filter(dplyr::if_any(1, ~ . %in% table_1[[1]])) %>%
+    dplyr::filter(dplyr::if_any(1, ~ !stringr::str_detect(., "Total"))) %>%
+    dplyr::filter(dplyr::if_any(1, ~ !stringr::str_detect(., "Financial"))) %>%
+    dplyr::pull(table_2[column] %>% colnames())
+
+  last_time <-
+    table_1 %>%
+    dplyr::filter(dplyr::if_any(1, ~ . %in% table_2[[1]])) %>%
+    dplyr::filter(dplyr::if_any(1, ~ !stringr::str_detect(., "Total"))) %>%
+    dplyr::filter(dplyr::if_any(1, ~ !stringr::str_detect(., "Financial"))) %>%
+    dplyr::pull(table_1[column] %>% colnames())
+
+  last_time - this_time
+
+}
+
+
+#' Take the Difference of All Matching Columns in Two Tables
+#'
+#' This function returns a table of differences for any matching numeric columns
+#' in two dataframes. It will only consider rows and columns present in both data
+#' sets (row selection is based on the first column).
+#' @param table_1 First table
+#' @param table_2 Second table
+#' @export
+diff_tables <- function(table_1, table_2){
+
+  is_col_numeric <- table_1 %>% purrr::map_lgl(is.numeric)
+
+  numeric_cols <- colnames(table_1)[is_col_numeric]
+
+  other_cols <- colnames(table_1)[!is_col_numeric]
+
+  diffs <- purrr::map(numeric_cols, ~ sssstats::diff_column(table_1, table_2, .))
+
+  filtered_table <- table_1 %>%
+    dplyr::filter(dplyr::if_any(1, ~ . %in% table_2[[1]])) %>%
+    dplyr::filter(dplyr::if_any(1, ~ !stringr::str_detect(., "Total"))) %>%
+    dplyr::filter(dplyr::if_any(1, ~ !stringr::str_detect(., "Financial")))
+
+ # filtered_table[other_cols]
+diffs
+   stats::setNames(diffs, numeric_cols) %>%
+     dplyr::as_tibble() %>%
+     dplyr::bind_cols(filtered_table[other_cols]) %>%
+     dplyr::relocate(tidyselect::all_of(other_cols), .before = tidyselect::everything())
+
+}