diff --git a/R/convert_output.R b/R/convert_output.R index ba3d1283..9778fc08 100644 --- a/R/convert_output.R +++ b/R/convert_output.R @@ -2190,9 +2190,9 @@ convert_output <- function( # temporarily add call to local csv so I can test # con_file <- glue::glue("~/GitHub/stockplotr/inst/resources/{model}_var_names.csv") var_names_sheet <- utils::read.csv(con_file, na.strings = "") - + if (tolower(model) == "bam") { - var_names_sheet <- var_names_sheet |> + var_names_sheet <- var_names_sheet |> dplyr::mutate(label = tolower(label)) } diff --git a/R/process_data.R b/R/process_data.R index ec5b5087..bc7f6c12 100644 --- a/R/process_data.R +++ b/R/process_data.R @@ -534,7 +534,7 @@ process_table <- function( dplyr::rename( !!mod_uncert_lab := uncertainty ) |> - # set values to strings to include trailing zeros from rounding and # format large estimate values with commas + # set values to strings to include trailing zeros from rounding and # format large estimate values with commas dplyr::mutate(estimate = formatC(estimate, format = "f", digits = digits, big.mark = ",")) |> tidyr::pivot_wider( id_cols = dplyr::all_of(c(stringr::str_to_title(mod_cols))), diff --git a/R/table_index.R b/R/table_index.R index 19880a80..3c67358c 100644 --- a/R/table_index.R +++ b/R/table_index.R @@ -48,18 +48,17 @@ #' ) #' } table_index <- function( - dat, - era = NULL, - interactive = TRUE, - group = NULL, - method = "sum", - module = NULL, - label = NULL, - digits = 2, - make_rda = FALSE, - tables_dir = getwd() - ) { - + dat, + era = NULL, + interactive = TRUE, + group = NULL, + method = "sum", + module = NULL, + label = NULL, + digits = 2, + make_rda = FALSE, + tables_dir = getwd() +) { # TODO: do group and facet need to be uncommented and updated? # Filter data for landings prepared_data <- filter_data( @@ -71,14 +70,16 @@ table_index <- function( scale_amount = 1, interactive = interactive ) |> - dplyr::mutate(estimate = round(as.numeric(estimate), digits = digits), - uncertainty = round(as.numeric(uncertainty), digits = digits)) - + dplyr::mutate( + estimate = round(as.numeric(estimate), digits = digits), + uncertainty = round(as.numeric(uncertainty), digits = digits) + ) + # Add check if there is any data if (nrow(prepared_data) == 0) { cli::cli_abort("No index data found.") } - + # get uncertainty label by model uncert_lab <- prepared_data |> dplyr::filter(!is.na(uncertainty_label)) |> @@ -86,22 +87,22 @@ table_index <- function( dplyr::reframe(unique_uncert = unique(uncertainty_label)) # changed to reframe -- may cause errors uncert_lab <- stats::setNames(uncert_lab$unique_uncert, uncert_lab$model) # if (length(unique(uncert_lab)) == 1) uncert_lab <- unique(uncert_lab) # might need this line - + # This needs to be adjusted when comparing different models and diff error if (length(uncert_lab) > 1 & length(unique(uncert_lab)) == 1 | length(names(uncert_lab)) == 1) { # prepared_data$model # cli::cli_alert_warning("More than one value for uncertainty exists: {uncert_lab}") uncert_lab <- uncert_lab[[1]] # cli::cli_alert_warning("The first value ({uncert_lab}) will be chosen.") } - + if (is.na(uncert_lab)) uncert_lab <- "uncertainty" - + # get fleet names # TODO: change from fleets to id_group AFTER the process data step and adjust throughout the table based on indexing fleets <- unique(prepared_data$fleet) |> # sort numerically even if fleets are 100% characters stringr::str_sort(numeric = TRUE) - + # TODO: fix this so that fleet names aren't removed if, e.g., group = "fleet" table_data_info <- process_table( dat = prepared_data, @@ -113,12 +114,12 @@ table_index <- function( table_data <- table_data_info[[1]] indexed_vars <- table_data_info[[2]] id_col_vals <- table_data_info[[3]] - + # id_group_vals <- sapply(id_cols, function(x) unique(prepared_data[[x]]), simplify = FALSE) # TODO: add check if there is a index column for every error column -- if not remove the error (can keep index) - + # if (uncert_lab != "") uncert_lab <- glue::glue("({uncert_lab})") - + # merge error and index columns and rename df_list <- merge_error( table_data, @@ -126,31 +127,30 @@ table_index <- function( unit_label = "", # should this be CPUE? uncert_lab ) - + # transform dfs into tables final <- lapply(df_list, function(df) { df |> gt::gt() |> add_theme() }) - + # export figure to rda if argument = T if (make_rda == TRUE) { - # Caption contains no key quantities for index table # So, export captions/alt text csv if absent if (!file.exists(fs::path(getwd(), "captions_alt_text.csv"))) { caps_alttext <- utils::read.csv( system.file("resources", "captions_alt_text_template.csv", package = "stockplotr") ) - # export df with captions and alt text to csv - utils::write.csv( - x = caps_alttext, - file = fs::path(getwd(), "captions_alt_text.csv"), - row.names = FALSE - ) + # export df with captions and alt text to csv + utils::write.csv( + x = caps_alttext, + file = fs::path(getwd(), "captions_alt_text.csv"), + row.names = FALSE + ) } - + if (length(df_list) == 1) { create_rda( object = final$label, @@ -168,7 +168,7 @@ table_index <- function( cli::cli_alert_warning("Multiple tables cannot be exported at this time.") cli::cli_alert_info("We are currently developing this feature.") } - + # Send table(s) to viewer if (!is.data.frame(table_data)) { for (t in final) { diff --git a/R/utils_table.R b/R/utils_table.R index 0250d354..0aa9f65a 100644 --- a/R/utils_table.R +++ b/R/utils_table.R @@ -185,7 +185,7 @@ check_label_differences <- function(dat, index_variables, id_group = NULL) { #' @param uncert_lab uncertainty label. Typically inherited from another function #' but is the exact string of the uncertainty in the data (e.g., "sd", "se", "cv", #' "uncertainty").) -#' @param id_col_vals A list of variables identifying grouping of the data and +#' @param id_col_vals A list of variables identifying grouping of the data and #' their unique values. #' @param unit_label String. The units of the estimate being presented in the table. #' @@ -194,11 +194,11 @@ check_label_differences <- function(dat, index_variables, id_group = NULL) { #' to reduce redundancy in the table. #' merge_error <- function( - table_data, - id_col_vals, - unit_label, - uncert_lab - ) { + table_data, + id_col_vals, + unit_label, + uncert_lab +) { # TODO: change fleets to grouping when the data is indexed by factors other than fleet lapply(table_data, function(tab_dat) { label_cols <- names(tab_dat)[-c(1, grep(glue::glue("^{uncert_lab}"), names(tab_dat)))] @@ -211,12 +211,13 @@ merge_error <- function( tolower(l_col), paste( stringr::str_escape(unlist(id_col_vals, use.names = FALSE)), - collapse = "|") + collapse = "|" ) - + ) + # Identify which uncert col aligns with l_col uncert_col <- uncert_cols[grep(l_col, uncert_cols)] - + # adjust tab dat to combine the uncert_col value into the l_col = l_col (uncert_col) tab_dat <- tab_dat |> dplyr::mutate( @@ -226,7 +227,7 @@ merge_error <- function( # maybe not good practice to insert dash? # ifelse( # is.na(.data[[l_col]]), - "-" + "-" # as.character(.data[[l_col]]) # ) ) @@ -234,13 +235,13 @@ merge_error <- function( # Remove uncertainty colummn id'd in this step of the loop dplyr::select(-dplyr::all_of(uncert_col)) } # close loop combining label and uncertainty - + # Adjust all header label names now header_labs <- stringr::str_replace_all(colnames(tab_dat), "_", " ") |> stringr::str_to_title() header_labs2 <- glue::glue("{header_labs[-1]}{ifelse(unit_label!='', paste0(' ', unit_label,' '), ' ')}({uncert_lab})") colnames(tab_dat) <- c(header_labs[1], header_labs2) - + return(tab_dat) }) # close and end lapply } diff --git a/man/merge_error.Rd b/man/merge_error.Rd index a657d9ac..174521e8 100644 --- a/man/merge_error.Rd +++ b/man/merge_error.Rd @@ -9,7 +9,7 @@ merge_error(table_data, id_col_vals, unit_label, uncert_lab) \arguments{ \item{table_data}{list of dataframes that will be eventually turned into tables} -\item{id_col_vals}{A list of variables identifying grouping of the data and +\item{id_col_vals}{A list of variables identifying grouping of the data and their unique values.} \item{unit_label}{String. The units of the estimate being presented in the table.} diff --git a/tests/testthat/test-table_index.R b/tests/testthat/test-table_index.R index cc3df6e7..12cb3855 100644 --- a/tests/testthat/test-table_index.R +++ b/tests/testthat/test-table_index.R @@ -6,7 +6,7 @@ test_that("table_index generates plots without errors", { interactive = FALSE ) ) - + # expect error-free plot with many arguments expect_no_error( table_index( @@ -15,8 +15,8 @@ test_that("table_index generates plots without errors", { tables_dir = getwd() ) ) - - + + # expect gt object is returned # adjust this test to work for multiple output tables # expect_s3_class( @@ -40,11 +40,11 @@ test_that("rda file made when indicated", { make_rda = TRUE, tables_dir = getwd() ) - + # expect that both tables dir and the index_table.rda file exist expect_true(dir.exists(fs::path(getwd(), "tables"))) expect_true(file.exists(fs::path(getwd(), "tables", "index_table.rda"))) - + # erase temporary testing files file.remove(fs::path(getwd(), "captions_alt_text.csv")) unlink(fs::path(getwd(), "tables"), recursive = T)