Merge pull request #2 from izaak-jephson/main

Update documentation for metadata functions
ScotGovAnalysis · Sep 5, 2024 · 3430044 · 3430044
2 parents 0c87645 + c06e276
commit 3430044
Show file tree

Hide file tree

Showing 13 changed files with 179 additions and 82 deletions.
diff --git a/NAMESPACE b/NAMESPACE
@@ -8,8 +8,8 @@ export(add_data_table)
 export(add_data_tables)
 export(add_notes_sheet)
 export(add_sheet_to_metadata)
-export(add_tables_to_metadata)
 export(create_metadata)
+export(create_table_layout)
 export(format_columns)
 export(format_rows)
 export(generate_table_metadata)

diff --git a/R/build_metadata.R b/R/build_metadata.R
@@ -1,5 +1,7 @@
-#' Create metadata
+#' Initialise Metadata Object
 #'
+#' @description Creates an empty metadata object which can be added to with
+#' `r xlsss::add_sheet_to_metadata`
 #' @export
 create_metadata <- function(){
 
@@ -11,13 +13,14 @@ create_metadata <- function(){
     )
 }
 
-#' Instructs metadata to add tables to a given worksheet
+#' Add Sheet to Metadata Object
 #'
+#' @description Adds a new sheet to a metadata object.
 #' @param metadata Metadata object
-#' @param sheet_name Sheet name
-#' @param sheet_title Sheet title
-#' @param table_names List of table names
-#' @param table_notes List of table notes
+#' @param sheet_name Name to be displayed on sheet tab
+#' @param sheet_title Title to be show in bold in cell A1 on sheet
+#' @param table_names Character vector of table names to include on this sheet. Names must match those in the table_list object
+#' @param table_notes Numeric vector of notes to be included underneath tables on this sheet
 #' @export
 add_sheet_to_metadata <- function(metadata,
                                   sheet_name,
@@ -36,47 +39,60 @@ add_sheet_to_metadata <- function(metadata,
     )
 }
 
-#' Add table metadata for all tables
+#' Combine Metadata and Tables to Create Layout
 #'
+#' Takes a metadata object and adds specified table_data to create a table layout to
+#' be passed to `r xlsss::make_output_tables`
 #' @param metadata Metadata object
-#' @param table_list List of tables
+#' @param table_data Tibble of tables. Must include columns: name, table and title.
+#' `name` column must match the table names specified in the metadata object.
+#' `table` column contains the tables to be outputted to excel
+#' `title` column is only used where more than one table is included on a sheet
+#' and is the sub title to be printed above the table.
 #' @export
-add_tables_to_metadata <- function(metadata, table_list) {
+create_table_layout <- function(metadata, table_data) {
   metadata %>%
     dplyr::mutate(
       tables = purrr::map(.data$table_names,
-                          ~ generate_table_metadata(.x, table_list))) %>%
+                          ~ generate_table_metadata(.x, table_data))) %>%
     dplyr::mutate(
       n_tables = purrr::map(.data$tables, nrow) %>% as.numeric(),
       notes_start = purrr::map(
         .data$tables,
         ~ .x %>%
           dplyr::select(.data$n_rows) %>%
-          purrr::map( ~ sum(.x)) %>%
+          purrr::map(~ sum(.x)) %>%
           as.numeric()
       )
-    )
+    ) %>%
+    dplyr::select(.data$sheet_name,
+                  .data$sheet_title,
+                  .data$table_names,
+                  .data$table_notes,
+                  .data$tables,
+                  .data$n_tables,
+                  .data$notes_start)
 
 }
 
-#' Generate metadata for a single sheet
+#' Generate Metadata for a Single Sheet
 #'
 #' @param table_names Table name
-#' @param table_list List of tables
+#' @param table_data Tibble of tables
 #' @param padding_rows_multi Row gap for sheet with multiple tables
 #' @param padding_rows_single Row gap for sheet with single table
 #' @export
 generate_table_metadata <- function(table_names,
-                                    table_list,
+                                    table_data,
                                     padding_rows_multi = 2,
                                     padding_rows_single = 1){
 
   dplyr::tibble(
     table_name = table_names,
-    table = table_list %>%
+    table = table_data %>%
       dplyr::filter(.data$name %in% table_names) %>%
       dplyr::pull(.data$table),
-    table_title = table_list %>%
+    table_title = table_data %>%
       dplyr::filter(.data$name %in% table_names) %>%
       dplyr::pull(.data$title)
   ) %>%
@@ -99,3 +115,19 @@ generate_table_metadata <- function(table_names,
     )
 
 }
+
+
+#' Convert List of Tables to table_data
+#'
+#' @description Helper function for quickly turning named list of tables into a
+#' table_data object for use in the `r xlsss::create_table_layout` function.
+#' @param table_list List of tables to be converted to table_data
+#'
+table_list_to_tibble <- function(table_list){
+  dplyr::tibble(
+    name = names(table_list),
+    table = table_list,
+    title = paste(names(table_list)))
+}
+
+
diff --git a/R/export_tables.R b/R/export_tables.R
@@ -1,9 +1,8 @@
-#' Create tibble of sheet titles based on publication date
+#' Create tibble of sheet titles for contents page
 #'
-#' @param publication_date Publication date
 #' @param table_layout Table layout object created by metadata functions
 #' @export
-make_contents_table <- function(publication_date, table_layout) {
+make_contents_table <- function(table_layout) {
   contents <- table_layout %>%
     dplyr::select(.data$sheet_name, .data$sheet_title) %>%
     dplyr::rename(Sheet = .data$sheet_name, Description = .data$sheet_title) %>%
@@ -19,7 +18,9 @@ make_contents_table <- function(publication_date, table_layout) {
 #' @param contents Contents
 #' @param contents_title Character string of title to include on contents page.
 #' @export
-add_contents_sheet <- function(wb, contents, contents_title) {
+add_contents_sheet <- function(wb,
+                               contents,
+                               contents_title) {
   contents_table <-
     contents %>%
     dplyr::slice(-1) %>%
@@ -30,7 +31,8 @@ add_contents_sheet <- function(wb, contents, contents_title) {
       text = .data$Sheet
     ))
 
-  class(contents_table$`Table Number`) <- c(class(contents_table$`Table Number`), "formula")
+  class(contents_table$`Table Number`) <-
+    c(class(contents_table$`Table Number`), "formula")
 
   openxlsx::modifyBaseFont(wb,
                            fontSize = 12,
@@ -101,7 +103,9 @@ add_contents_sheet <- function(wb, contents, contents_title) {
 #' @param contents Contents
 #' @param notes_list List of notes to include in publication
 #' @export
-add_notes_sheet <- function(wb, contents, notes_list) {
+add_notes_sheet <- function(wb,
+                            contents,
+                            notes_list) {
   openxlsx::addWorksheet(wb, sheetName = "Notes")
 
   notes_list <- notes_list %>%
@@ -175,7 +179,12 @@ add_notes_sheet <- function(wb, contents, notes_list) {
 #' @param start_row Row to start formatting
 #' @param end_row Row to end formatting
 #' @export
-format_columns <- function(wb, sheet_name, table, column, start_row, end_row) {
+format_columns <- function(wb,
+                           sheet_name,
+                           table,
+                           column,
+                           start_row,
+                           end_row) {
   # Format numbers with commas
   if (purrr::is_integer(table[[column]])) {
     openxlsx::addStyle(wb, sheet_name,
@@ -209,7 +218,13 @@ format_columns <- function(wb, sheet_name, table, column, start_row, end_row) {
 #' @param start_col Start column of formatting
 #' @param end_col End row of formatting
 #' @export
-format_rows <- function(wb, sheet_name, table, table_row, sheet_row, start_col, end_col) {
+format_rows <- function(wb,
+                        sheet_name,
+                        table,
+                        table_row,
+                        sheet_row,
+                        start_col,
+                        end_col) {
   # Make total rows bold
   if (table[[table_row, 1]] == "Total" |
       stringr::str_starts(table[[table_row, 1]],"Financial")) {
@@ -231,11 +246,26 @@ format_rows <- function(wb, sheet_name, table, table_row, sheet_row, start_col,
 #' @param tables Tables to be included on sheet
 #' @param header_rows Number of header rows
 #' @export
-add_data_tables <- function(wb, sheet_name, sheet_title, tables, header_rows) {
+add_data_tables <- function(wb,
+                            sheet_name,
+                            sheet_title,
+                            tables,
+                            header_rows) {
   tables %>%
-    dplyr::select(.data$table, .data$start_row, .data$end_row, .data$table_title, .data$table_name) %>%
+    dplyr::select(.data$table,
+                  .data$start_row,
+                  .data$end_row,
+                  .data$table_title,
+                  .data$table_name) %>%
     purrr::pmap(function(table, start_row, end_row, table_title, table_name) {
-      xlsss::add_data_table(wb, sheet_name, sheet_title, table, start_row, end_row, header_rows, table_name)
+      xlsss::add_data_table(wb,
+                            sheet_name,
+                            sheet_title,
+                            table,
+                            start_row,
+                            end_row,
+                            header_rows,
+                            table_name)
       if(nrow(tables) > 1){
         openxlsx::writeData(wb, sheet_name,
                             x = table_title,
@@ -266,7 +296,14 @@ add_data_tables <- function(wb, sheet_name, sheet_title, tables, header_rows) {
 #' @param n_tables Number of tables
 #' @param notes_start Row that notes start on
 #' @export
-add_data_sheet <- function(wb, sheet_name, sheet_title, sheet_tables, notes_list, note_mapping, n_tables, notes_start) {
+add_data_sheet <- function(wb,
+                           sheet_name,
+                           sheet_title,
+                           sheet_tables,
+                           notes_list,
+                           note_mapping,
+                           n_tables,
+                           notes_start) {
   # Define start and end points for tables
   header_rows <- 5
 
@@ -375,7 +412,14 @@ add_data_sheet <- function(wb, sheet_name, sheet_title, sheet_tables, notes_list
 #' @param header_rows Number of header rows
 #' @param table_name Name of table
 #' @export
-add_data_table <- function(wb, sheet_name, sheet_title, table, start_row, end_row, header_rows, table_name) {
+add_data_table <- function(wb,
+                           sheet_name,
+                           sheet_title,
+                           table,
+                           start_row,
+                           end_row,
+                           header_rows,
+                           table_name) {
   # Format data table
   openxlsx::addStyle(wb,
                      sheet_name,
@@ -394,7 +438,8 @@ add_data_table <- function(wb, sheet_name, sheet_title, table, start_row, end_ro
                            rowNames = FALSE,
                            keepNA = TRUE,
                            na.string = "n/a",
-                           tableStyle = "TableStyleLight1", headerStyle = openxlsx::createStyle(wrapText = TRUE),
+                           tableStyle = "TableStyleLight1",
+                           headerStyle = openxlsx::createStyle(wrapText = TRUE),
                            stack = TRUE,
                            withFilter = openxlsx::openxlsx_getOp("withFilter", FALSE)
   )
@@ -446,7 +491,14 @@ add_data_table <- function(wb, sheet_name, sheet_title, table, start_row, end_ro
 #' @param end_row Row to end formatting
 #' @param header_rows Number of header rows
 #' @export
-negative_to_c <- function (wb, sheet_name, table, column, row, start_row, end_row, header_rows){
+negative_to_c <- function (wb,
+                           sheet_name,
+                           table,
+                           column,
+                           row,
+                           start_row,
+                           end_row,
+                           header_rows){
   if (table[[column]][[row]] == -1 & (!is.na(table[[column]][[row]]))){
     openxlsx::writeData(wb,
                         sheet_name,
@@ -494,17 +546,19 @@ tweak_formatting <- function(wb) {
 #'
 #' @param table_layout Table layout object created by metadata functions
 #' @param notes_list List of notes in publication
-#' @param publication_date Publication date
 #' @param contents_title Title of contents page
 #' @param workbook_filename Filename to export workbook to
 #' @export
-make_output_tables <- function(table_layout, notes_list, publication_date, contents_title, workbook_filename) {
+make_output_tables <- function(table_layout,
+                               notes_list,
+                               contents_title,
+                               workbook_filename) {
 
   wb <- openxlsx::createWorkbook()
 
   openxlsx::modifyBaseFont(wb, fontSize = 12, fontColour = "black", fontName = "Roboto")
 
-  contents <- xlsss::make_contents_table(publication_date, table_layout)
+  contents <- xlsss::make_contents_table(table_layout)
 
   wb <- xlsss::add_contents_sheet(wb, contents, contents_title)
 

diff --git a/README.Rmd b/README.Rmd
@@ -19,14 +19,14 @@ knitr::opts_chunk$set(
 [![R-CMD-check](https://github.com/izaak-jephson/xlsss/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/izaak-jephson/xlsss/actions/workflows/R-CMD-check.yaml)
 <!-- badges: end -->
 
-The goal of xlsss is to automate production of statistical tables for Socail Security Scotland.
+The goal of xlsss is to automate production of statistical tables for Social Security Scotland.
 
 ## Installation
 
 You can install the development version of xlsss from [GitHub](https://github.com/) with:
 
 ``` r
 # install.packages("devtools")
-devtools::install_github("izaak-jephson/xlsss")
+devtools::install_github("ScotGovAnalysis/xlsss")
 ```
 
diff --git a/README.md b/README.md
@@ -9,7 +9,7 @@
 <!-- badges: end -->
 
 The goal of xlsss is to automate production of statistical tables for
-Socail Security Scotland.
+Social Security Scotland.
 
 ## Installation
 
@@ -18,5 +18,5 @@ You can install the development version of xlsss from
 
 ``` r
 # install.packages("devtools")
-devtools::install_github("izaak-jephson/xlsss")
+devtools::install_github("ScotGovAnalysis/xlsss")
 ```
diff --git a/man/add_sheet_to_metadata.Rd b/man/add_sheet_to_metadata.Rd
diff --git a/man/add_tables_to_metadata.Rd b/man/add_tables_to_metadata.Rd