diff --git a/DESCRIPTION b/DESCRIPTION index 74521db..c75ed88 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Package: BoutrosLab.plotting.general -Version: 7.1.1 +Version: 7.1.2 Type: Package Title: Functions to Create Publication-Quality Plots -Date: 2024-01-08 +Date: 2024-04-02 Authors@R: c(person("Paul Boutros", role = c("aut", "cre"), email = "PBoutros@mednet.ucla.edu"), person("Christine P'ng", role = "ctb"), person("Jeff Green", role = "ctb"), diff --git a/NEWS b/NEWS index bf9f97c..f0eeef6 100644 --- a/NEWS +++ b/NEWS @@ -1,3 +1,9 @@ +BoutrosLab.plotting.general 7.1.2 2024-04-02 + +UPDATE +* Improved "sample.order" argument checking + +-------------------------------------------------------------------------- BoutrosLab.plotting.general 7.1.1 2024-01-08 UPDATE diff --git a/R/create.barplot.R b/R/create.barplot.R index 2f4c272..10554f5 100644 --- a/R/create.barplot.R +++ b/R/create.barplot.R @@ -617,9 +617,9 @@ create.barplot <- function( } # reorder the bars in decreasing or increasing order if specified - if (is.null(sample.order) || is.na(sample.order)) { sample.order <- 'none'; } + sample.order <- prep.sample.order(sample.order); - if (sample.order[1] != 'none') { + if (length(sample.order) != 1 || sample.order != sample.order.default()) { for (i in 1:length(trellis.object$panel.args)) { # will need two separate ways for horizontal and non - horizontal @@ -636,16 +636,11 @@ create.barplot <- function( } if (length(sample.order) == 1) { - if(! sample.order %in% c('decreasing', 'increasing')) { - stop('sample.order should be `decreasing` or `increasing`'); - } - # This looks backwards but gets reversed later # Might want to revisit if it makes more sense to sort in correct order here - sample.order.decreasing <- sample.order != 'decreasing'; ordering <- order( trellis.object$panel.args[[1]]$y[c(1:num.bars)], - decreasing = sample.order.decreasing + decreasing = sample.order != sample.order.decreasing() ); } @@ -699,14 +694,9 @@ create.barplot <- function( } if (length(sample.order) == 1) { - if(! sample.order %in% c('decreasing', 'increasing')) { - stop('sample.order should be `decreasing` or `increasing`'); - } - - sample.order.decreasing <- sample.order != 'decreasing'; ordering <- order( trellis.object$panel.args[[1]]$x[c(1:num.bars)], - decreasing = sample.order.decreasing + decreasing = sample.order != sample.order.decreasing() ); } diff --git a/R/create.boxplot.R b/R/create.boxplot.R index 90d4b17..3ea250d 100644 --- a/R/create.boxplot.R +++ b/R/create.boxplot.R @@ -397,8 +397,9 @@ create.boxplot <- function( } + sample.order <- prep.sample.order.setting(sample.order); # reorder by median - if (sample.order == 'increasing' | sample.order == 'decreasing') { + if (sample.order %in% sample.order.auto.values()) { if (is.numeric(trellis.object$panel.args[[1]]$x)) { num.boxes <- levels(trellis.object$panel.args[[1]]$y); @@ -423,7 +424,9 @@ create.boxplot <- function( ranks <- rank(values.to.sort.by, ties.method = 'random'); # swap the rankings if decreasing order is specified - if (sample.order == 'decreasing') { ranks <- rank(values.to.sort.by * ( -1 ), ties.method = 'random'); } + if (sample.order == sample.order.decreasing()) { + ranks <- rank(values.to.sort.by * ( -1 ), ties.method = 'random'); + } newlocations <- NULL; @@ -476,7 +479,9 @@ create.boxplot <- function( ranks <- rank(values.to.sort.by, ties.method = 'random'); - if (sample.order == 'decreasing') { ranks <- rank(values.to.sort.by * (-1), ties.method = 'random'); } + if (sample.order == sample.order.decreasing()) { + ranks <- rank(values.to.sort.by * (-1), ties.method = 'random'); + } newlocations <- NULL; diff --git a/R/prep.inputs.R b/R/prep.inputs.R new file mode 100644 index 0000000..d981f98 --- /dev/null +++ b/R/prep.inputs.R @@ -0,0 +1,39 @@ +prep.sample.order <- function(sample.order) { + if (length(sample.order) == 1) { + return(prep.sample.order.setting(sample.order)); + } + + contains.na <- any(is.na(sample.order)); + + if (is.null(sample.order) || contains.na) { + sample.order <- sample.order.default(); + + if (contains.na) { + warning(paste( + 'NA values found in "sample.order" (using default "none" setting).' + )); + } + } + + return(sample.order); + } + +prep.sample.order.setting <- function(sample.order) { + if (!(sample.order %in% valid.sample.order.values())) { + stop(paste('Invalid "sample.order":', paste0('(', sample.order, ')'))) + } + return(sample.order); + } + +sample.order.default <- function() 'none'; +sample.order.increasing <- function() 'increasing'; +sample.order.decreasing <- function() 'decreasing'; +sample.order.auto.values <- function() { + c(sample.order.increasing(), sample.order.decreasing()); + } +valid.sample.order.values <- function() { + c( + sample.order.default(), + sample.order.auto.values() + ); + } diff --git a/tests/testthat/test-prep.inputs.R b/tests/testthat/test-prep.inputs.R new file mode 100644 index 0000000..3ff0540 --- /dev/null +++ b/tests/testthat/test-prep.inputs.R @@ -0,0 +1,66 @@ +test_that( + 'prep.sample.order replaces NULL with default', + { + sample.order <- NULL; + result <- prep.sample.order(sample.order); + + expect_equal(result, sample.order.default()); + } + ); + +test_that( + 'prep.sample.order replaces with default value if NAs are present', + { + sample.order <- c(NA, 'sample', 'order', NA); + result <- prep.sample.order(sample.order); + + expect_equal(result, sample.order.default()); + } + ); + +test_that( + 'prep.sample.order warns if NAs are present', + { + sample.order <- c(NA, 'sample', 'order', NA); + + expect_warning( + { prep.sample.order(sample.order); }, + regexp = 'NA' + ); + } + ); + +test_that( + 'prep.sample.order errors on invalid string input', + { + sample.order <- 'invalid sample order setting'; + expect_error( + { + prep.sample.order(sample.order); + }, + regexp = sample.order + ); + } + ); + +test_that( + 'prep.sample.order.setting errors with invalid setting', + { + sample.order <- 'invalid sample order setting'; + expect_error( + { + prep.sample.order.setting(sample.order); + }, + regexp = sample.order + ); + } + ); + +test_that( + 'prep.sample.order.setting returns valid setting', + { + sample.order <- sample.order.default(); + result <- prep.sample.order.setting(sample.order); + expect_equal(result, sample.order); + } + );