Skip to content

Commit

Permalink
Cleaned up the FAQ vignette
Browse files Browse the repository at this point in the history
  • Loading branch information
bertcarnell committed Jun 22, 2024
1 parent dc7fa0e commit e28944d
Show file tree
Hide file tree
Showing 6 changed files with 81 additions and 211 deletions.
6 changes: 3 additions & 3 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -23,9 +23,9 @@ export(optimumLHS)
export(poly2int)
export(poly_prod)
export(poly_sum)
export(q_dirichlet)
export(q_factor)
export(q_integer)
export(qdirichlet)
export(qfactor)
export(qinteger)
export(randomLHS)
export(runifint)
import(Rcpp)
Expand Down
28 changes: 15 additions & 13 deletions R/quantile_transforms.R
Original file line number Diff line number Diff line change
@@ -1,15 +1,17 @@
# Copyright 2023 Robert Carnell
# Copyright 2024 Robert Carnell

#' Quantile Transformations
#'
#' A collection of functions that transform the margins of a Latin hypercube
#' sample in non-standard ways
#' sample in multiple ways
#'
#' \code{qdirichlet} is not an exact quantile function since the quantile of a
#' multivariate distribution is not unique. \code{qdirichlet} is also not the independent quantiles of the marginal distributions since
#' those quantiles do not sum to one. \code{qdirichlet} is the quantile of the underlying gamma functions, normalized.
#' This has been tested to show that \code{qdirichlet} approximates the Dirichlet distribution well and creates the correct marginal means and variances
#' when using a Latin hypercube sample
#' multivariate distribution is not unique. \code{qdirichlet} is also not the
#' independent quantiles of the marginal distributions since
#' those quantiles do not sum to one. \code{qdirichlet} is the quantile of the
#' underlying gamma functions, normalized. This is the same procedure that
#' is used to generate random deviates from the Dirichlet distribution therefore
#' it will produce transformed Latin hypercube samples with the intended distribution.
#'
#' \code{q_factor} divides the [0,1] interval into \code{nlevel(fact)} equal sections
#' and assigns values in those sections to the factor level.
Expand All @@ -31,11 +33,11 @@
#' X <- randomLHS(20, 7)
#' Y <- as.data.frame(X)
#' Y[,1] <- qnorm(X[,1], 2, 0.5)
#' Y[,2] <- q_factor(X[,2], factor(LETTERS[c(1,3,5,7,8)]))
#' Y[,3] <- q_integer(X[,3], 5, 17)
#' Y[,4:6] <- q_dirichlet(X[,4:6], c(2,3,4))
#' Y[,7] <- q_factor(X[,7], ordered(LETTERS[c(1,3,5,7,8)]))
q_factor <- function(p, fact)
#' Y[,2] <- qfactor(X[,2], factor(LETTERS[c(1,3,5,7,8)]))
#' Y[,3] <- qinteger(X[,3], 5, 17)
#' Y[,4:6] <- qdirichlet(X[,4:6], c(2,3,4))
#' Y[,7] <- qfactor(X[,7], ordered(LETTERS[c(1,3,5,7,8)]))
qfactor <- function(p, fact)
{
if (!is.factor(fact)) {
stop("fact must be a factor or ordered")
Expand All @@ -53,7 +55,7 @@ q_factor <- function(p, fact)
#' @rdname quanttrans
#'
#' @export
q_integer <- function(p, a, b)
qinteger <- function(p, a, b)
{
if (!is.numeric(p) | any(p < 0) | any(p > 1)) {
stop("p must be a numeric between 0 and 1")
Expand All @@ -74,7 +76,7 @@ q_integer <- function(p, a, b)
#' @importFrom stats qgamma
#'
#' @export
q_dirichlet <- function(X, alpha)
qdirichlet <- function(X, alpha)
{
lena <- length(alpha)
if (!is.matrix(X) & !is.data.frame(X)) {
Expand Down
37 changes: 20 additions & 17 deletions man/quanttrans.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

40 changes: 20 additions & 20 deletions tests/testthat/test-quantile_transforms.R
Original file line number Diff line number Diff line change
Expand Up @@ -2,65 +2,65 @@

context("test-quantile_transformations")

test_that("q_factor works", {
test_that("qfactor works", {
p <- randomLHS(n=5, k=1)
fact <- factor(LETTERS[1:4])
res <- q_factor(p, fact)
res <- qfactor(p, fact)
expect_true(all(levels(res) %in% levels(fact)))
expect_true(all(fact[floor(p[,1]*nlevels(fact)) + 1] == res))

p <- randomLHS(n=5, k=1)
fact <- factor(LETTERS[1:4], levels = LETTERS[4:1], ordered = TRUE)
res <- q_factor(p, fact)
res <- qfactor(p, fact)
expect_true(all(levels(res) %in% levels(fact)))
expect_true(all(levels(fact)[floor(p[,1]*nlevels(fact)) + 1] == as.character(res)))

p <- randomLHS(n=25, k=1)
fact <- factor(LETTERS[1:5])
res <- q_factor(p, fact)
res <- qfactor(p, fact)
expect_true(all(levels(res) %in% levels(fact)))
expect_true(all(fact[floor(p[,1]*nlevels(fact)) + 1] == res))
expect_equivalent(rep(5, 5), c(table(res)))

p <- randomLHS(n=25, k=1)
fact <- ordered(LETTERS[1:5])
res <- q_factor(p, fact)
res <- qfactor(p, fact)
expect_true(all(levels(res) %in% levels(fact)))
expect_true(all(levels(fact)[floor(p[,1]*nlevels(fact)) + 1] == as.character(res)))
expect_equivalent(rep(5, 5), c(table(res)))

expect_error(q_factor("a", factor("a")))
expect_error(q_factor(c(0.1, 0.2), "a"))
expect_error(q_factor(1.1, factor("a")))
expect_error(q_factor(-3, factor("a")))
expect_error(qfactor("a", factor("a")))
expect_error(qfactor(c(0.1, 0.2), "a"))
expect_error(qfactor(1.1, factor("a")))
expect_error(qfactor(-3, factor("a")))
})

test_that("q_integer works", {
test_that("qinteger works", {
p <- randomLHS(n = 25, k = 1)
res <- q_integer(p, 6, 12)
res <- qinteger(p, 6, 12)
expect_equal(6, min(res))
expect_equal(12, max(res))
expect_true(all(res %in% 6:12))

p <- randomLHS(n = 25, k = 1)
res <- q_integer(p, -4L, 2L)
res <- qinteger(p, -4L, 2L)
expect_equal(-4, min(res))
expect_equal(2, max(res))
expect_true(all(res %in% -4:2))

expect_error(q_integer("a", 1, 5))
expect_error(q_integer(c(0.1, 0.2), 1.1, 5))
expect_error(q_integer(c(0.1, 0.2), 1, 5.2))
expect_error(q_integer(c(0.1, 0.2), 8, 5))
expect_error(q_integer(1.1, factor("a")))
expect_error(q_integer(-3, factor("a")))
expect_error(qinteger("a", 1, 5))
expect_error(qinteger(c(0.1, 0.2), 1.1, 5))
expect_error(qinteger(c(0.1, 0.2), 1, 5.2))
expect_error(qinteger(c(0.1, 0.2), 8, 5))
expect_error(qinteger(1.1, factor("a")))
expect_error(qinteger(-3, factor("a")))
})

test_that("q_dirichlet works", {
test_that("qdirichlet works", {
set.seed(19753)
X <- randomLHS(500, 5)
Y <- X
Y[,1:3] <- q_dirichlet(X[,1:3], rep(2,3))
Y[,1:3] <- qdirichlet(X[,1:3], rep(2,3))
Y[,4] <- qnorm(X[,4], 2, 1)
Y[,5] <- qunif(X[,5], 1, 3)

Expand Down
2 changes: 1 addition & 1 deletion vignettes/correlated_lhs.Rmd
Original file line number Diff line number Diff line change
Expand Up @@ -105,7 +105,7 @@ apply(lhs_B$transformed_lhs, 2, mean) # close to 4/10, 3/10, 2/10, 1/10
### Method 2: `q_dirichlet`

```{r}
lhs_B <- lhs::q_dirichlet(lhs::randomLHS(30, 4), c(4,3,2,1))
lhs_B <- lhs::qdirichlet(lhs::randomLHS(30, 4), c(4,3,2,1))
```

Check properties
Expand Down
Loading

0 comments on commit e28944d

Please sign in to comment.