# R/LHS.R In vdg: Variance Dispersion Graphs and Fraction of Design Space Plots

#' Latin Hypercube Sampling
#'
#' Different versions of latin hypercube sampling (LHS): ordinary LHS,  midpoint LHS, symmetric LHS or randomized symmetric LHS. LHS is a method
#' for constructing space-filling designs. They can be more efficient for hypercuboidal design regions than other sampling methods.
#'
#' @aliases LHS MLHS SLHS RSLHS
#' @param n number of design points to generate
#' @param m number of design factors
#' @param lim limits of the coordinates in all dimensions
#' @return Matrix with samples as rows.
#' @author Pieter C. Schoonees
#' @references
#' Pieter C. Schoonees, Niel J. le Roux, Roelof L.J. Coetzer (2016). Flexible Graphical Assessment of
#' Experimental Designs in R: The vdg Package. \emph{Journal of Statistical Software}, 74(3), 1-22.
#'  \doi{10.18637/jss.v074.i03}.
#' @examples
#'
#' set.seed(1234)
#' pts <- seq(-1, 1, length = 11)
#'
#' # Ordinary LHS
#' samp <- LHS(n = 10, m = 2)
#' plot(samp, main = "LHS")
#' abline(h = pts, v = pts, col = "lightgrey")
#'
#' # Midpoint LHS
#' samp <- MLHS(n = 10, m = 2)
#' plot(samp, main = "MLHS")
#' abline(h = pts, v = pts, col = "lightgrey")
#'
#' # Symmetric LHS
#' samp <- SLHS(n = 10, m = 2)
#' plot(samp, main = "SLHS")
#' abline(h = pts, v = pts, col = "lightgrey")
#'
#' # Randomized Symmetric LHS
#' samp <- RSLHS(n = 10, m = 2)
#' plot(samp, main = "RSLHS")
#' abline(h = pts, v = pts, col = "lightgrey")
#' @keywords design
#' @export
LHS <-
function (n, m = 3, lim = c(-1, 1))
{
pts <- seq(from = lim, to = lim, length = n + 1)
pts <- pts[-1]
samp <- matrix(0, nrow = n, ncol = m)
for(i in 1:m)
samp[,i] <- pts[sample(1:n, n)]
umat <- matrix(runif(m*n), nrow = n, ncol = m)
samp <- samp - (lim - lim)*umat/n
samp
}
#' @rdname LHS
#' @export
MLHS <-
function (n, m = 3, lim = c(-1, 1))
{
pts <- seq(from = lim, to = lim, length = n + 1)
pts <- pts[-1]
samp <- matrix(0, nrow = n, ncol = m)
for(i in 1:m)
samp[,i] <- pts[sample(1:n, n)]
samp <- samp - (lim - lim)*0.5/n
samp
}
#' @rdname LHS
#' @export
SLHS <-
function (n, m = 3, lim = c(-1, 1))
{
k <- n/2
if(n %% 2 != 0) stop("Not a even number of points - a symmetric LHD cannot be constructed.")
pts <- seq(from = lim, to = lim, length = n + 1)
pts <- pts[-1]
samp <- matrix(0, nrow = k, ncol = m)
for(i in 1:m)
samp[,i] <- sample(1:n, k)
samp <- rbind(samp, n + 1 - samp)
for(i in 1:m)
samp[,i] <- pts[samp[,i]]
samp <- samp - (lim - lim)*0.5/n
samp
}
#' @rdname LHS
#' @export
RSLHS <-
function (n, m = 3, lim = c(-1, 1))
{
k <- n/2
if(n %% 2 != 0) stop("Not a even number of points - a symmetric LHD cannot be constructed.")
pts <- seq(from = lim, to = lim, length = n + 1)
pts <- pts[-1]
samp <- matrix(0, nrow = k, ncol = m)
for(i in 1:m)
samp[,i] <- sample(1:n, k)
samp <- rbind(samp, n + 1 - samp)
# samp2 <- samp/(n/2)-1
for(i in 1:m)
samp[,i] <- pts[samp[,i]]
umat <- matrix(runif(n*m), nrow = n, ncol = m)
samp <- samp - (lim - lim)*umat/n
samp
}


## Try the vdg package in your browser

Any scripts or data that you put into this service are public.

vdg documentation built on July 8, 2022, 1:08 a.m.