From 10ab7f957f5cbe4cc47acbc499ce4028d9df72b4 Mon Sep 17 00:00:00 2001 From: mahaalbashir Date: Mon, 22 Jun 2026 13:58:07 +0100 Subject: [PATCH 1/2] Adding more parameters for the table command --- R/acro_init.R | 2 +- R/acro_tables.R | 77 +++++++++-- R/utils.R | 81 ++++++++++++ tests/testthat/test-acro_table.R | 216 +++++++++++++++++++++++++++++-- 4 files changed, 358 insertions(+), 18 deletions(-) create mode 100644 R/utils.R diff --git a/R/acro_init.R b/R/acro_init.R index 465ddbd..f0e1014 100644 --- a/R/acro_init.R +++ b/R/acro_init.R @@ -89,7 +89,7 @@ acro_init <- function(config = "default", suppress = FALSE, envname = acro_venv, } # import the acro package and instantiate an object - acro <- reticulate::import("acro", delay_load = TRUE) + acro <- reticulate::import("acro", delay_load = TRUE, convert = FALSE) acroEnv$ac <- acro$ACRO(config = config, suppress = suppress) invisible(acroEnv$ac) diff --git a/R/acro_tables.R b/R/acro_tables.R index 511b198..fa1593c 100644 --- a/R/acro_tables.R +++ b/R/acro_tables.R @@ -12,7 +12,8 @@ acro_crosstab <- function(index, columns, values = NULL, aggfunc = NULL) { if (is.null(acroEnv$ac)) { stop("ACRO has not been initialised. Please first call acro_init()") } - table <- acroEnv$ac$crosstab(index, columns, values = values, aggfunc = aggfunc) + py_table <- acroEnv$ac$crosstab(index, columns, values = values, aggfunc = aggfunc) + table <-reticulate::py_to_r(py_table) return(table) } @@ -22,12 +23,14 @@ acro_crosstab <- function(index, columns, values = NULL, aggfunc = NULL) { #' @param columns Values to group by in the columns. #' @param dnn The names to be given to the dimensions in the result #' @param deparse.level Controls how the default `dnn` is constructed. +#' @param exclude levels to remove for all factors in index/columns +#' @param useNA whether to include NA values in the table #' @param ... Any other parameters. #' #' @return Cross tabulation of the data #' @export -acro_table <- function(index, columns, dnn = NULL, deparse.level = 0, ...) { +acro_table <- function(index, columns, dnn = NULL, deparse.level = 0, useNA = "no", exclude = NULL, ...) { if (is.null(acroEnv$ac)) { stop("ACRO has not been initialised. Please first call acro_init().") } @@ -55,20 +58,73 @@ acro_table <- function(index, columns, dnn = NULL, deparse.level = 0, ...) { acroEnv$col_names <- list("") } ) - } else if (deparse.level == 2) { - acroEnv$row_names <- list(deparse((substitute(index)))) - acroEnv$col_names <- list(deparse(substitute(columns))) } } else { acroEnv$row_names <- list(dnn[1]) acroEnv$col_names <- list(dnn[2]) } - table <- acroEnv$ac$crosstab(index, columns, rownames = acroEnv$row_names, colnames = acroEnv$col_names) + #Handling the exclude parameter + if (useNA != "no" && !is.null(exclude)) { + if (any(is.na(exclude))) warning("'exclude' containing NA and 'useNA' != \"no\"' are a bit contradicting") + + # Remove the NA and NaN from the exclude list, if they exist + exclude <- exclude[!(is.na(exclude) | is.nan(exclude))] + if (length(exclude) == 0) exclude <- NULL # nocov + } + + if (!is.null(exclude)) { + #Exclude everything in the exclude list from the data + keep_mask <- !(is_excluded(index, exclude) | is_excluded(columns, exclude)) + + index <- index[keep_mask] + columns <- columns[keep_mask] + + # Delete any dropped levels + if (is.factor(index)) index <- droplevels(index) + if (is.factor(columns)) columns <- droplevels(columns) + } + + # Handling the useNA parameter + if (useNA == "no") { + # Remove any NA or NaN from the data + keep_mask <- !(is_invalid(index) | is_invalid(columns)) + + index <- index[keep_mask] + columns <- columns[keep_mask] + } + + # Create factors + index <- create_factors(index, useNA) + columns <- create_factors(columns, useNA) + + # Manually convert index and columns to pandas categorical to convert the R fcators to python categories + pd <- reticulate::import("pandas", convert = FALSE) + index <- to_pandas_categorical(index, pd) + columns <- to_pandas_categorical(columns, pd) + + py_table <- acroEnv$ac$crosstab(index, columns, rownames = acroEnv$row_names, colnames = acroEnv$col_names) # Check for any unused arguments if (length(list(...)) > 0) { warning("Unused arguments were provided: ", paste0(names(list(...)), collapse = ", "), "\n", "Please use the help command to learn more about the function.") } + # Reset the index and keep the old indexes in a column + py_table <- py_table$reset_index() + + # Manually translate the table to R + r_dataframe <- reticulate::py_to_r(py_table) + table <- as.matrix(r_dataframe[, -1]) + + # Convert the string "NA" to the R empty values + index_names <- as.character(r_dataframe[[1]]) + column_names <- colnames(r_dataframe)[-1] + + index_names[index_names %in% "NA"] <- NA + column_names[column_names %in% "NA"] <- NA + + rownames(table) <- index_names + colnames(table) <- column_names + return(table) } @@ -87,7 +143,8 @@ acro_pivot_table <- function(data, values = NULL, index = NULL, columns = NULL, if (is.null(acroEnv$ac)) { stop("ACRO has not been initialised. Please first call acro_init()") } - table <- acroEnv$ac$pivot_table(data, values = values, index = index, columns = columns, aggfunc = aggfunc) + py_table <- acroEnv$ac$pivot_table(data, values = values, index = index, columns = columns, aggfunc = aggfunc) + table <- reticulate::py_to_r(py_table) return(table) } @@ -107,7 +164,8 @@ acro_hist <- function(data, column, breaks = 10, freq = TRUE, col = NULL, filena if (is.null(acroEnv$ac)) { stop("ACRO has not been initialised. Please first call acro_init()") } - histogram <- acroEnv$ac$hist(data = data, column = column, bins = as.integer(breaks), density = freq, color = col, filename = filename) + py_histogram <- acroEnv$ac$hist(data = data, column = column, bins = as.integer(breaks), density = freq, color = col, filename = filename) + histogram <- reticulate::py_to_r(py_histogram) # Load the saved histogram image <- png::readPNG(histogram) grid::grid.raster(image) @@ -128,7 +186,8 @@ acro_surv_func <- function(time, status, output, filename = "kaplan-meier.png") if (is.null(acroEnv$ac)) { stop("ACRO has not been initialised. Please first call acro_init()") } - results <- acroEnv$ac$surv_func(time = time, status = status, output = output, filename = filename) + py_results <- acroEnv$ac$surv_func(time = time, status = status, output = output, filename = filename) + results <- reticulate::py_to_r(py_results) if (output == "plot") { # Load the saved survival plot image <- png::readPNG(results[[2]]) diff --git a/R/utils.R b/R/utils.R new file mode 100644 index 0000000..3f24574 --- /dev/null +++ b/R/utils.R @@ -0,0 +1,81 @@ + +#' Identify empty values; NA or NaN in an object +#' +#' @param Values to check for empty values in it +#' +#' @returns logical vector that shows the places of the empty values +#' @export + +is_invalid <- function(obj) { + # Check for NA or NaN in the object + is.na(obj) | tolower(obj) %in% c("na", "nan") +} + +#' Identify values to be excluded from an object +#' +#' @param Values to exclude from +#' @param exclude_list Items to exclude from the values +#' +#' @returns logical vector that shows the places of the items that needs to be excluded +#' @export + +is_excluded <- function(obj, exclude_list) { + # Catch everything in the exclude list + mask <- obj %in% exclude_list + + # Catch NA if it is in the exclude list + # We are separating the checks for NaN and NA because is.na(x) flags both the NAs and the NaNs as TRUE. + # If the user wants to exclude one and not the other is.na() will not be able to do that + if (any(is.na(exclude_list) & !is.nan(exclude_list))) { + mask <- mask | (is.na(obj) & !is.nan(obj)) + } + + # Catch NA if it is in the exclude list + if (any(is.nan(exclude_list))) { + mask <- mask | is.nan(obj) # nocov + } + + return(mask) +} + +#' Convert data to factors and manage NA levels +#' +#' @param Values to create factors on +#' @param useNA whether to include NA values in the table +#' +#' @returns R vector factor +#' @export + +create_factors <- function(obj, useNA) { + # Check for NAs + char_obj <- as.character(obj) + is_true_na <- is.na(char_obj) + + # Create the factors + if (!is.factor(obj)) obj <- as.factor(obj) # nocov + + # Handle the useNA parameter + if (useNA == "always") { + levels(obj) <- union(levels(obj), "NA") # Always force NA + } else if (useNA == "ifany" && any(is_true_na)) { + levels(obj) <- union(levels(obj), "NA") # Only if NA exists + } + return(obj) +} + +#' Convert an R factor to a Pandas Categorical +#' +#' @param obj R factor vector to be converted +#' @param pd Reference to the Python `pandas` module +#' +#' @returns A Python `pandas.Categorical` object +#' @export + +to_pandas_categorical <- function(obj, pd) { + # Build the Pandas Categorical + pd$Categorical( + values = as.character(obj), + categories = levels(obj), + ordered = is.ordered(obj) + ) +} diff --git a/tests/testthat/test-acro_table.R b/tests/testthat/test-acro_table.R index aa115e2..eaf9299 100644 --- a/tests/testthat/test-acro_table.R +++ b/tests/testthat/test-acro_table.R @@ -14,11 +14,23 @@ test_that("acro_table works", { # Adding row names rownames(expected_table) <- c("not_recom", "priority", "recommend", "spec_prior", "very_recom") - acro_init() table <- acro_table(index = nursery_data[, c("recommend")], columns = nursery_data[, c("parents")]) - expect_equal(table[, -1, drop = FALSE], expected_table[, -1, drop = FALSE]) + # Sort the expected table alphabetically by row and column names + expected_table <- expected_table[ + order(rownames(expected_table)), + order(colnames(expected_table)), + drop = FALSE + ] + + # Sort the actual table alphabetically by row and column names + table <- table[ + order(rownames(table)), + order(colnames(table)), + drop = FALSE + ] + expect_equal(table, as.matrix(expected_table)) }) test_that("acro_table works with dnn", { @@ -35,9 +47,22 @@ test_that("acro_table works with dnn", { acro_init() table <- acro_table(index = nursery_data[, c("recommend")], columns = nursery_data[, c("parents")], dnn = c("recommend", "parents")) - print(table) - expect_equal(table[, -1, drop = FALSE], expected_table[, -1, drop = FALSE]) + # Sort the expected table alphabetically by row and column names + expected_table <- expected_table[ + order(rownames(expected_table)), + order(colnames(expected_table)), + drop = FALSE + ] + + # Sort the actual table alphabetically by row and column names + table <- table[ + order(rownames(table)), + order(colnames(table)), + drop = FALSE + ] + + expect_equal(table, as.matrix(expected_table)) }) test_that("acro_table works with deparse.level is one", { @@ -55,7 +80,21 @@ test_that("acro_table works with deparse.level is one", { acro_init() table <- acro_table(index = nursery_data[, c("recommend")], columns = nursery_data[, c("parents")], deparse.level = 1) - expect_equal(table[, -1, drop = FALSE], expected_table[, -1, drop = FALSE]) + # Sort the expected table alphabetically by row and column names + expected_table <- expected_table[ + order(rownames(expected_table)), + order(colnames(expected_table)), + drop = FALSE + ] + + # Sort the actual table alphabetically by row and column names + table <- table[ + order(rownames(table)), + order(colnames(table)), + drop = FALSE + ] + + expect_equal(table, as.matrix(expected_table)) }) test_that("acro_table works with deparse.level is one", { @@ -75,7 +114,21 @@ test_that("acro_table works with deparse.level is one", { columns <- nursery_data[, c("parents")] table <- acro_table(index = index, columns = columns, deparse.level = 1) - expect_equal(table[, -1, drop = FALSE], expected_table[, -1, drop = FALSE]) + # Sort the expected table alphabetically by row and column names + expected_table <- expected_table[ + order(rownames(expected_table)), + order(colnames(expected_table)), + drop = FALSE + ] + + # Sort the actual table alphabetically by row and column names + table <- table[ + order(rownames(table)), + order(colnames(table)), + drop = FALSE + ] + + expect_equal(table, as.matrix(expected_table)) }) test_that("acro_table works with deparse.level is two", { @@ -93,11 +146,158 @@ test_that("acro_table works with deparse.level is two", { acro_init() table <- acro_table(index = nursery_data[, c("recommend")], columns = nursery_data[, c("parents")], deparse.level = 2) - expect_equal(table[, -1, drop = FALSE], expected_table[, -1, drop = FALSE]) + # Sort the expected table alphabetically by row and column names + expected_table <- expected_table[ + order(rownames(expected_table)), + order(colnames(expected_table)), + drop = FALSE + ] + + # Sort the actual table alphabetically by row and column names + table <- table[ + order(rownames(table)), + order(colnames(table)), + drop = FALSE + ] + + expect_equal(table, as.matrix(expected_table)) }) test_that("acro_table throws a warning if an unused argument is used", { testthat::skip_on_cran() acro_init() - expect_warning(acro_table(index = nursery_data[, c("recommend")], columns = nursery_data[, c("parents")], deparse.level = 2, useNA = "always"), "Unused arguments were provided: useNA\nPlease use the help command to learn more about the function.") + expect_warning(acro_table(index = nursery_data[, c("recommend")], columns = nursery_data[, c("parents")], deparse.level = 2, dropna = "FALSE"), "Unused arguments were provided: dropna\nPlease use the help command to learn more about the function.") +}) + +test_that("acro_table works with the exclude parameter", { + testthat::skip_on_cran() + acro_init() + + # The actual table using the acro command + actual_table <- acro_table(index = nursery_data[, c("recommend")], columns = nursery_data[, c("parents")], exclude = c("usual", NA, NaN)) + # The expected table using the R table command + expected_table <- table(index = nursery_data[, c("recommend")], columns = nursery_data[, c("parents")], exclude = c("usual", NA, NaN)) + + # Sort the expected table alphabetically by row and column names + actual_table <- expected_table[ + order(rownames(expected_table)), + order(colnames(expected_table)), + drop = FALSE + ] + + # Sort the actual table alphabetically by row and column names + expected_table <- actual_table[ + order(rownames(actual_table)), + order(colnames(actual_table)), + drop = FALSE + ] + + expect_equal(actual_table, expected_table) +}) + +test_that("warning is triggered and NAs are removed from exclude list", { + exclude_list <- c("usual", NA, NaN) + + acro_init() + expect_warning( + table <- acro_table(nursery_data[, "recommend"], nursery_data[, "parents"], exclude = exclude_list, useNA = "always"), + "'exclude' containing NA and 'useNA' != \"no\"' are a bit contradicting" + ) +}) + + +test_that("acro_table works with useNA = 'no'", { + testthat::skip_on_cran() + acro_init() + + #Inject NAs in the index and columns + index_data <- replace(nursery_data[, "recommend"], 10:14, NA) + cols_data <- replace(nursery_data[, "parents"], 16:20, NA) + + actual_table <- acro_table( + index = index_data, + columns = cols_data, + useNA = "no" + ) + + expected_table <- table(index_data, cols_data, useNA = "no") + + # Sort the actual and expected table alphabetically by row and column names + actual_table <- actual_table[ + order(rownames(actual_table)), + order(colnames(actual_table)), + drop = FALSE + ] + expected_table <- expected_table[ + order(rownames(expected_table)), + order(colnames(expected_table)), + drop = FALSE + ] + + names(dimnames(expected_table)) <- NULL + expect_equal(actual_table, expected_table) +}) + +test_that("acro_table works with usena = 'ifany'", { + testthat::skip_on_cran() + acro_init() + + #Inject NAs in the index and columns + index_data <- replace(nursery_data[, "recommend"], 10:15, NA) + cols_data <- replace(nursery_data[, "parents"], 16:20, NA) + + actual_table <- acro_table( + index = index_data, + columns = cols_data, + useNA = "ifany" + ) + + expected_table <- table(index_data, cols_data, useNA = "ifany") + + # 4. Sort alphabetically to align R and Python outputs safely + actual_table <- actual_table[ + order(rownames(actual_table)), + order(colnames(actual_table)), + drop = FALSE + ] + expected_table <- expected_table[ + order(rownames(expected_table)), + order(colnames(expected_table)), + drop = FALSE + ] + + names(dimnames(expected_table)) <- NULL + expect_equal(actual_table, expected_table) +}) + +test_that("acro_table works with usena = 'always'", { + testthat::skip_on_cran() + acro_init() + + index_data <- nursery_data[, "recommend"] + cols_data <- nursery_data[, "parents"] + + actual_table <- acro_table( + index = index_data, + columns = cols_data, + useNA = "always" + ) + + expected_table <- table(index_data, cols_data, useNA = "always") + + # Sort the actual and expected table alphabetically by row and column names + actual_table <- actual_table[ + order(rownames(actual_table)), + order(colnames(actual_table)), + drop = FALSE + ] + + expected_table <- expected_table[ + order(rownames(expected_table)), + order(colnames(expected_table)), + drop = FALSE + ] + + names(dimnames(expected_table)) <- NULL + expect_equal(actual_table, expected_table <- expected_table[-nrow(expected_table), -ncol(expected_table), drop = FALSE]) }) From 2a8dcbf91b61b9d2f2c223729a0ac52ba586f047 Mon Sep 17 00:00:00 2001 From: "pre-commit-ci[bot]" <66853113+pre-commit-ci[bot]@users.noreply.github.com> Date: Tue, 23 Jun 2026 09:57:48 +0000 Subject: [PATCH 2/2] [pre-commit.ci] auto fixes from pre-commit.com hooks for more information, see https://pre-commit.ci --- DESCRIPTION | 2 +- NAMESPACE | 4 ++ R/acro_tables.R | 12 +++--- R/utils.R | 37 +++++++++---------- .../notebooks/acro_demo_2026.R | 0 .../notebooks/acro_demo_2026.Rmd | 0 .../notebooks/example-notebook-old.Rmd | 0 man/acro_table.Rd | 14 ++++++- man/create_factors.Rd | 19 ++++++++++ man/is_excluded.Rd | 19 ++++++++++ man/is_invalid.Rd | 17 +++++++++ man/to_pandas_categorical.Rd | 19 ++++++++++ tests/testthat/test-acro_table.R | 10 ++--- 13 files changed, 121 insertions(+), 32 deletions(-) rename acro_demo_2026.R => inst/notebooks/acro_demo_2026.R (100%) rename acro_demo_2026.Rmd => inst/notebooks/acro_demo_2026.Rmd (100%) rename example-notebook-old.Rmd => inst/notebooks/example-notebook-old.Rmd (100%) create mode 100644 man/create_factors.Rd create mode 100644 man/is_excluded.Rd create mode 100644 man/is_invalid.Rd create mode 100644 man/to_pandas_categorical.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 1290a52..0987b36 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -13,7 +13,6 @@ Description: A Tool for Semi-Automating the Statistical Disclosure Control of Re License: MIT + file LICENSE Encoding: UTF-8 Roxygen: list(markdown = TRUE) -RoxygenNote: 7.3.3 SystemRequirements: Python (>= 3.10) Imports: reticulate, @@ -32,3 +31,4 @@ Language: en-US URL: https://github.com/AI-SDC/ACRO-R BugReports: https://github.com/AI-SDC/ACRO-R/issues VignetteBuilder: knitr +Config/roxygen2/version: 8.0.0 diff --git a/NAMESPACE b/NAMESPACE index 4d2998a..5b92a1e 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -17,3 +17,7 @@ export(acro_remove_output) export(acro_rename_output) export(acro_surv_func) export(acro_table) +export(create_factors) +export(is_excluded) +export(is_invalid) +export(to_pandas_categorical) diff --git a/R/acro_tables.R b/R/acro_tables.R index fa1593c..0e4d1b8 100644 --- a/R/acro_tables.R +++ b/R/acro_tables.R @@ -13,7 +13,7 @@ acro_crosstab <- function(index, columns, values = NULL, aggfunc = NULL) { stop("ACRO has not been initialised. Please first call acro_init()") } py_table <- acroEnv$ac$crosstab(index, columns, values = values, aggfunc = aggfunc) - table <-reticulate::py_to_r(py_table) + table <- reticulate::py_to_r(py_table) return(table) } @@ -64,17 +64,17 @@ acro_table <- function(index, columns, dnn = NULL, deparse.level = 0, useNA = "n acroEnv$col_names <- list(dnn[2]) } - #Handling the exclude parameter + # Handling the exclude parameter if (useNA != "no" && !is.null(exclude)) { if (any(is.na(exclude))) warning("'exclude' containing NA and 'useNA' != \"no\"' are a bit contradicting") # Remove the NA and NaN from the exclude list, if they exist exclude <- exclude[!(is.na(exclude) | is.nan(exclude))] - if (length(exclude) == 0) exclude <- NULL # nocov + if (length(exclude) == 0) exclude <- NULL # nocov } if (!is.null(exclude)) { - #Exclude everything in the exclude list from the data + # Exclude everything in the exclude list from the data keep_mask <- !(is_excluded(index, exclude) | is_excluded(columns, exclude)) index <- index[keep_mask] @@ -95,12 +95,12 @@ acro_table <- function(index, columns, dnn = NULL, deparse.level = 0, useNA = "n } # Create factors - index <- create_factors(index, useNA) + index <- create_factors(index, useNA) columns <- create_factors(columns, useNA) # Manually convert index and columns to pandas categorical to convert the R fcators to python categories pd <- reticulate::import("pandas", convert = FALSE) - index <- to_pandas_categorical(index, pd) + index <- to_pandas_categorical(index, pd) columns <- to_pandas_categorical(columns, pd) py_table <- acroEnv$ac$crosstab(index, columns, rownames = acroEnv$row_names, colnames = acroEnv$col_names) diff --git a/R/utils.R b/R/utils.R index 3f24574..855058b 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1,4 +1,3 @@ - #' Identify empty values; NA or NaN in an object #' #' @param Values to check for empty values in it @@ -6,9 +5,9 @@ #' @returns logical vector that shows the places of the empty values #' @export -is_invalid <- function(obj) { +is_invalid <- function(Values) { # Check for NA or NaN in the object - is.na(obj) | tolower(obj) %in% c("na", "nan") + is.na(Values) | tolower(Values) %in% c("na", "nan") } #' Identify values to be excluded from an object @@ -19,20 +18,20 @@ is_invalid <- function(obj) { #' @returns logical vector that shows the places of the items that needs to be excluded #' @export -is_excluded <- function(obj, exclude_list) { +is_excluded <- function(Values, exclude_list) { # Catch everything in the exclude list - mask <- obj %in% exclude_list + mask <- Values %in% exclude_list # Catch NA if it is in the exclude list # We are separating the checks for NaN and NA because is.na(x) flags both the NAs and the NaNs as TRUE. # If the user wants to exclude one and not the other is.na() will not be able to do that if (any(is.na(exclude_list) & !is.nan(exclude_list))) { - mask <- mask | (is.na(obj) & !is.nan(obj)) + mask <- mask | (is.na(Values) & !is.nan(Values)) } # Catch NA if it is in the exclude list if (any(is.nan(exclude_list))) { - mask <- mask | is.nan(obj) # nocov + mask <- mask | is.nan(Values) # nocov } return(mask) @@ -46,36 +45,36 @@ is_excluded <- function(obj, exclude_list) { #' @returns R vector factor #' @export -create_factors <- function(obj, useNA) { +create_factors <- function(Values, useNA) { # Check for NAs - char_obj <- as.character(obj) - is_true_na <- is.na(char_obj) + char_values <- as.character(Values) + is_true_na <- is.na(char_values) # Create the factors - if (!is.factor(obj)) obj <- as.factor(obj) # nocov + if (!is.factor(Values)) Values <- as.factor(Values) # nocov # Handle the useNA parameter if (useNA == "always") { - levels(obj) <- union(levels(obj), "NA") # Always force NA + levels(Values) <- union(levels(Values), "NA") # Always force NA } else if (useNA == "ifany" && any(is_true_na)) { - levels(obj) <- union(levels(obj), "NA") # Only if NA exists + levels(Values) <- union(levels(Values), "NA") # Only if NA exists } - return(obj) + return(Values) } #' Convert an R factor to a Pandas Categorical #' -#' @param obj R factor vector to be converted +#' @param Values R factor vector to be converted #' @param pd Reference to the Python `pandas` module #' #' @returns A Python `pandas.Categorical` object #' @export -to_pandas_categorical <- function(obj, pd) { +to_pandas_categorical <- function(Values, pd) { # Build the Pandas Categorical pd$Categorical( - values = as.character(obj), - categories = levels(obj), - ordered = is.ordered(obj) + values = as.character(Values), + categories = levels(Values), + ordered = is.ordered(Values) ) } diff --git a/acro_demo_2026.R b/inst/notebooks/acro_demo_2026.R similarity index 100% rename from acro_demo_2026.R rename to inst/notebooks/acro_demo_2026.R diff --git a/acro_demo_2026.Rmd b/inst/notebooks/acro_demo_2026.Rmd similarity index 100% rename from acro_demo_2026.Rmd rename to inst/notebooks/acro_demo_2026.Rmd diff --git a/example-notebook-old.Rmd b/inst/notebooks/example-notebook-old.Rmd similarity index 100% rename from example-notebook-old.Rmd rename to inst/notebooks/example-notebook-old.Rmd diff --git a/man/acro_table.Rd b/man/acro_table.Rd index 999ab36..46119d9 100644 --- a/man/acro_table.Rd +++ b/man/acro_table.Rd @@ -4,7 +4,15 @@ \alias{acro_table} \title{Compute a simple cross tabulation of two (or more) factors.} \usage{ -acro_table(index, columns, dnn = NULL, deparse.level = 0, ...) +acro_table( + index, + columns, + dnn = NULL, + deparse.level = 0, + useNA = "no", + exclude = NULL, + ... +) } \arguments{ \item{index}{Values to group by in the rows.} @@ -15,6 +23,10 @@ acro_table(index, columns, dnn = NULL, deparse.level = 0, ...) \item{deparse.level}{Controls how the default \code{dnn} is constructed.} +\item{useNA}{whether to include NA values in the table} + +\item{exclude}{levels to remove for all factors in index/columns} + \item{...}{Any other parameters.} } \value{ diff --git a/man/create_factors.Rd b/man/create_factors.Rd new file mode 100644 index 0000000..5480225 --- /dev/null +++ b/man/create_factors.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{create_factors} +\alias{create_factors} +\title{Convert data to factors and manage NA levels} +\usage{ +create_factors(Values, useNA) +} +\arguments{ +\item{Values}{to create factors on} + +\item{useNA}{whether to include NA values in the table} +} +\value{ +R vector factor +} +\description{ +Convert data to factors and manage NA levels +} diff --git a/man/is_excluded.Rd b/man/is_excluded.Rd new file mode 100644 index 0000000..90f2904 --- /dev/null +++ b/man/is_excluded.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{is_excluded} +\alias{is_excluded} +\title{Identify values to be excluded from an object} +\usage{ +is_excluded(Values, exclude_list) +} +\arguments{ +\item{Values}{to exclude from} + +\item{exclude_list}{Items to exclude from the values} +} +\value{ +logical vector that shows the places of the items that needs to be excluded +} +\description{ +Identify values to be excluded from an object +} diff --git a/man/is_invalid.Rd b/man/is_invalid.Rd new file mode 100644 index 0000000..93ba9dc --- /dev/null +++ b/man/is_invalid.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{is_invalid} +\alias{is_invalid} +\title{Identify empty values; NA or NaN in an object} +\usage{ +is_invalid(Values) +} +\arguments{ +\item{Values}{to check for empty values in it} +} +\value{ +logical vector that shows the places of the empty values +} +\description{ +Identify empty values; NA or NaN in an object +} diff --git a/man/to_pandas_categorical.Rd b/man/to_pandas_categorical.Rd new file mode 100644 index 0000000..68f83d1 --- /dev/null +++ b/man/to_pandas_categorical.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{to_pandas_categorical} +\alias{to_pandas_categorical} +\title{Convert an R factor to a Pandas Categorical} +\usage{ +to_pandas_categorical(Values, pd) +} +\arguments{ +\item{Values}{R factor vector to be converted} + +\item{pd}{Reference to the Python \code{pandas} module} +} +\value{ +A Python \code{pandas.Categorical} object +} +\description{ +Convert an R factor to a Pandas Categorical +} diff --git a/tests/testthat/test-acro_table.R b/tests/testthat/test-acro_table.R index eaf9299..c5c5140 100644 --- a/tests/testthat/test-acro_table.R +++ b/tests/testthat/test-acro_table.R @@ -210,9 +210,9 @@ test_that("acro_table works with useNA = 'no'", { testthat::skip_on_cran() acro_init() - #Inject NAs in the index and columns + # Inject NAs in the index and columns index_data <- replace(nursery_data[, "recommend"], 10:14, NA) - cols_data <- replace(nursery_data[, "parents"], 16:20, NA) + cols_data <- replace(nursery_data[, "parents"], 16:20, NA) actual_table <- acro_table( index = index_data, @@ -242,9 +242,9 @@ test_that("acro_table works with usena = 'ifany'", { testthat::skip_on_cran() acro_init() - #Inject NAs in the index and columns + # Inject NAs in the index and columns index_data <- replace(nursery_data[, "recommend"], 10:15, NA) - cols_data <- replace(nursery_data[, "parents"], 16:20, NA) + cols_data <- replace(nursery_data[, "parents"], 16:20, NA) actual_table <- acro_table( index = index_data, @@ -275,7 +275,7 @@ test_that("acro_table works with usena = 'always'", { acro_init() index_data <- nursery_data[, "recommend"] - cols_data <- nursery_data[, "parents"] + cols_data <- nursery_data[, "parents"] actual_table <- acro_table( index = index_data,