diff --git a/NAMESPACE b/NAMESPACE index 7ba62a7..dc70802 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -4,13 +4,16 @@ export(acro_add_comments) export(acro_add_exception) export(acro_crosstab) export(acro_custom_output) +export(acro_disable_rounding) export(acro_disable_suppression) +export(acro_enable_rounding) export(acro_enable_suppression) export(acro_finalise) export(acro_glm) export(acro_hist) export(acro_init) export(acro_lm) +export(acro_pie) export(acro_pivot_table) export(acro_print_outputs) export(acro_remove_output) diff --git a/R/acro_init.R b/R/acro_init.R index f0e1014..18dc087 100644 --- a/R/acro_init.R +++ b/R/acro_init.R @@ -1,6 +1,6 @@ # Globals ----------------------------------------------------------------- acro_venv <- "r-acro" -acro_pkg <- "acro==0.4.12" +acro_pkg <- "acro==1.0.1" ch <- "conda-forge" @@ -66,6 +66,9 @@ get_use_conda <- function(use_conda = NULL) { #' #' @param config Name of a yaml configuration file with safe parameters. #' @param suppress Whether to automatically apply suppression. +#' @param mitigation The disclosure-control strategy applied to outputs, one of "none","suppress", "round". +#' @param round_base The base to round to when mitigation == "round". +#' @param federated Whether to run in federated mode. #' @param envname Name of the Python environment to use. #' @param use_conda Whether to use a Conda environment. #' If `NULL`, looks for environment variable `ACRO_USE_CONDA`, @@ -73,7 +76,7 @@ get_use_conda <- function(use_conda = NULL) { #' #' @return Invisibly returns the ACRO object, which is used internally. #' @export -acro_init <- function(config = "default", suppress = FALSE, envname = acro_venv, use_conda = NULL) { +acro_init <- function(config = "default", suppress = FALSE, mitigation = NULL, round_base = NULL, federated = NULL, envname = acro_venv, use_conda = NULL) { # define the environment use_conda <- get_use_conda(use_conda) @@ -90,7 +93,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, convert = FALSE) - acroEnv$ac <- acro$ACRO(config = config, suppress = suppress) + acroEnv$ac <- acro$ACRO(config = config, suppress = suppress, mitigation = mitigation, round_base = round_base, federated = federated) invisible(acroEnv$ac) } diff --git a/R/acro_tables.R b/R/acro_tables.R index 3c0cbb6..4bd29fb 100644 --- a/R/acro_tables.R +++ b/R/acro_tables.R @@ -379,3 +379,75 @@ acro_surv_func <- function(time, status, output, filename = "kaplan-meier.png") } return(results) } + +#' Pie chart +#' +#' @param data The object holding the data. +#' @param column The name of the column that will be used to plot the pie chart. +#' @param radius The radius of the pie chart. +#' @param clockwise logical indicating if slices are drawn clockwise or counter clockwise. +#' @param init.angle number specifying the starting angle (in degrees) for the slices. Defaults to 0 (i.e., ‘3 o'clock’) unless clockwise is true where init.angle defaults to 90 (degrees), (i.e., ‘12 o'clock’). +#' @param col colors to be used in filling or shading the slices +#' @param border The color to draw the border. +#' @param lty The line style. +#' @param filename The name of the file where the pie chart will be saved. +#' @param ... Any other parameters. +#' +#' @returns The pie chart +#' @export + +acro_pie <- function(data, column, radius = 0.8, clockwise = FALSE, init.angle = if (clockwise) 90 else 0, col = NULL, border = NULL, lty = NULL, filename = "pie.png", ...) { + if (is.null(acroEnv$ac)) { + stop("ACRO has not been initialised. Please first call acro_init()") + } + + # 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.") + } + + # If labels is NULL, try to extract names or levels from the data column + # This is commented because acro version 1.0.1 does not accept custom labels + # if (is.null(labels)) { + # labels <- unique(data[[column]]) + # } + + # Handle the boarder and lty parameters + wedgeprops <- NULL + + if (!is.null(border)) { + wedgeprops <- list() + wedgeprops$edgecolor <- border + } + + if (!is.null(lty)) { + if (identical(lty, 0) || lty == "blank") { + wedgeprops$linestyle <- "none" + } else { + lty_map <- c("solid", "dashed", "dotted", "dashdot") + if (is.numeric(lty)) { + if (lty >= 1 && lty <= length(lty_map)) { + wedgeprops$linestyle <- lty_map[lty] + } else { + warning("Unsupported line type:", lty, ". Defaulting to solid.") + wedgeprops$linestyle <- "solid" + } + } else if (is.character(lty)) { + if (lty %in% c("solid", "dashed", "dotted", "dotdash", "none")) { + wedgeprops$linestyle <- lty + } else { + warning(paste("Unsupported line type:", lty, ". Defaulting to solid.")) + wedgeprops$linestyle <- "solid" + } + } + } + } + + py_pie <- acroEnv$ac$pie(data = data, column = column, radius = radius, counterclock = !clockwise, startangle = init.angle, colors = col, wedgeprops = wedgeprops, filename = filename) + r_pie <- reticulate::py_to_r(py_pie) + + # Load the saved pie + image <- png::readPNG(r_pie) + grid::grid.raster(image) + return(r_pie) +} diff --git a/R/output_commands.R b/R/output_commands.R index ad91e39..9bfa595 100644 --- a/R/output_commands.R +++ b/R/output_commands.R @@ -123,3 +123,29 @@ acro_disable_suppression <- function() { } acroEnv$ac$disable_suppression() } + +#' Turns rounding on during a session +#' +#' @param base The base to round to +#' +#' @return No return value, called for side effects +#' @export + +acro_enable_rounding <- function(base = NULL) { + if (is.null(acroEnv$ac)) { + stop("ACRO has not been initialised. Please first call acro_init().") + } + acroEnv$ac$enable_rounding(base = base) +} + +#' Turns rounding off during a session +#' +#' @return No return value, called for side effects +#' @export + +acro_disable_rounding <- function() { + if (is.null(acroEnv$ac)) { + stop("ACRO has not been initialised. Please first call acro_init().") + } + acroEnv$ac$disable_rounding() +} diff --git a/inst/WORDLIST b/inst/WORDLIST index 069b542..7ea6fd0 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -27,6 +27,7 @@ https initialised json numpy +o'clock’ openml pre programme diff --git a/man/acro_disable_rounding.Rd b/man/acro_disable_rounding.Rd new file mode 100644 index 0000000..d484e50 --- /dev/null +++ b/man/acro_disable_rounding.Rd @@ -0,0 +1,14 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/output_commands.R +\name{acro_disable_rounding} +\alias{acro_disable_rounding} +\title{Turns rounding off during a session} +\usage{ +acro_disable_rounding() +} +\value{ +No return value, called for side effects +} +\description{ +Turns rounding off during a session +} diff --git a/man/acro_enable_rounding.Rd b/man/acro_enable_rounding.Rd new file mode 100644 index 0000000..d138e76 --- /dev/null +++ b/man/acro_enable_rounding.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/output_commands.R +\name{acro_enable_rounding} +\alias{acro_enable_rounding} +\title{Turns rounding on during a session} +\usage{ +acro_enable_rounding(base = NULL) +} +\arguments{ +\item{base}{The base to round to} +} +\value{ +No return value, called for side effects +} +\description{ +Turns rounding on during a session +} diff --git a/man/acro_init.Rd b/man/acro_init.Rd index 1e4cb99..aff67b2 100644 --- a/man/acro_init.Rd +++ b/man/acro_init.Rd @@ -7,6 +7,9 @@ acro_init( config = "default", suppress = FALSE, + mitigation = NULL, + round_base = NULL, + federated = NULL, envname = acro_venv, use_conda = NULL ) @@ -16,6 +19,12 @@ acro_init( \item{suppress}{Whether to automatically apply suppression.} +\item{mitigation}{The disclosure-control strategy applied to outputs, one of "none","suppress", "round".} + +\item{round_base}{The base to round to when mitigation == "round".} + +\item{federated}{Whether to run in federated mode.} + \item{envname}{Name of the Python environment to use.} \item{use_conda}{Whether to use a Conda environment. diff --git a/man/acro_pie.Rd b/man/acro_pie.Rd new file mode 100644 index 0000000..4a80c28 --- /dev/null +++ b/man/acro_pie.Rd @@ -0,0 +1,46 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/acro_tables.R +\name{acro_pie} +\alias{acro_pie} +\title{Pie chart} +\usage{ +acro_pie( + data, + column, + radius = 0.8, + clockwise = FALSE, + init.angle = if (clockwise) 90 else 0, + col = NULL, + border = NULL, + lty = NULL, + filename = "pie.png", + ... +) +} +\arguments{ +\item{data}{The object holding the data.} + +\item{column}{The name of the column that will be used to plot the pie chart.} + +\item{radius}{The radius of the pie chart.} + +\item{clockwise}{logical indicating if slices are drawn clockwise or counter clockwise.} + +\item{init.angle}{number specifying the starting angle (in degrees) for the slices. Defaults to 0 (i.e., ‘3 o'clock’) unless clockwise is true where init.angle defaults to 90 (degrees), (i.e., ‘12 o'clock’).} + +\item{col}{colors to be used in filling or shading the slices} + +\item{border}{The color to draw the border.} + +\item{lty}{The line style.} + +\item{filename}{The name of the file where the pie chart will be saved.} + +\item{...}{Any other parameters.} +} +\value{ +The pie chart +} +\description{ +Pie chart +} diff --git a/tests/testthat/test-acro_pie.R b/tests/testthat/test-acro_pie.R new file mode 100644 index 0000000..8efde3e --- /dev/null +++ b/tests/testthat/test-acro_pie.R @@ -0,0 +1,51 @@ +test_that("acro_pie without initialising ACRO object first", { + acroEnv$ac <- NULL + expect_error(acro_pie(nursery_data, "children"), "ACRO has not been initialised. Please first call acro_init()") +}) + +test_that("acro_pie works", { + testthat::skip_on_cran() + acro_init() + filename <- acro_pie(nursery_data, "children") + expect_true(file.exists(filename)) +}) + +test_that("acro_pie gives a warning on unused arguments", { + expect_warning( + acro_pie(data = nursery_data, column = "children", fake_arg = 123), + "Unused arguments were provided" + ) +}) + +test_that("acro_pie handles the border parameter", { + result <- acro_pie( + data = nursery_data, + column = "children", + border = "red", + ) + + expect_true(file.exists(result)) +}) + +test_that("acro_pie handles the line (lty) parameter", { + expect_silent(acro_pie(data = nursery_data, column = "children", lty = 0)) + expect_silent(acro_pie(data = nursery_data, column = "children", lty = "blank")) + + expect_silent(acro_pie(data = nursery_data, column = "children", lty = 2)) + expect_silent(acro_pie(data = nursery_data, column = "children", lty = "dashed")) + + # Test invalid numeric lty + expect_warning( + acro_pie(data = nursery_data, column = "children", lty = 99), + "Unsupported line type" + ) + + # Test invalid string lty + expect_warning( + acro_pie(data = nursery_data, column = "children", lty = "invalid_style"), + "Unsupported line type" + ) +}) + +# Delete the acro_artifacts folder +unlink("acro_artifacts", recursive = TRUE) diff --git a/tests/testthat/test-acro_rounding.R b/tests/testthat/test-acro_rounding.R new file mode 100644 index 0000000..dfb1570 --- /dev/null +++ b/tests/testthat/test-acro_rounding.R @@ -0,0 +1,26 @@ +test_that("acro_enable_rounding without initialising ACRO object first", { + acroEnv$ac <- NULL + expect_error(acro_enable_suppression(), "ACRO has not been initialised. Please first call acro_init()") +}) + +test_that("acro_enable_rounding works", { + testthat::skip_on_cran() + acro_init() + acro_enable_rounding() + table <- acro_pivot_table(data = nursery_data, index = "parents", columns = "recommend", values = "children", aggfunc = "mean") + output <- acro_print_outputs() + status <- "review" + exception <- "Rounding" + expect_true(any(grepl(status, output))) + expect_true(any(grepl(exception, output))) +}) + +test_that("acro_disable_rounding works", { + testthat::skip_on_cran() + acro_init() + acro_disable_rounding() + table <- acro_pivot_table(data = nursery_data, index = "parents", columns = "recommend", values = "children", aggfunc = "mean") + output <- acro_print_outputs() + status <- "fail" + expect_true(any(grepl(status, output))) +})