lhs/ 0000755 0001762 0000144 00000000000 14347432332 011045 5 ustar ligges users lhs/NAMESPACE 0000644 0001762 0000144 00000001310 14216201655 012254 0 ustar ligges users # Generated by roxygen2: do not edit by hand
export(augmentLHS)
export(createAddelKemp)
export(createAddelKemp3)
export(createAddelKempN)
export(createBose)
export(createBoseBush)
export(createBoseBushl)
export(createBush)
export(createBusht)
export(create_galois_field)
export(create_oalhs)
export(geneticLHS)
export(get_library_versions)
export(improvedLHS)
export(maximinLHS)
export(oa_to_oalhs)
export(optAugmentLHS)
export(optSeededLHS)
export(optimumLHS)
export(poly2int)
export(poly_prod)
export(poly_sum)
export(randomLHS)
export(runifint)
import(Rcpp)
importFrom(stats,dist)
importFrom(stats,na.exclude)
importFrom(stats,na.omit)
importFrom(stats,runif)
importFrom(utils,packageVersion)
useDynLib(lhs)
lhs/ChangeLog 0000644 0001762 0000144 00000000133 14220725306 012610 0 ustar ligges users For recent changes, see the git logs at https://github.com/bertcarnell/lhs/commits/master
lhs/man/ 0000755 0001762 0000144 00000000000 14115430532 011611 5 ustar ligges users lhs/man/createBoseBush.Rd 0000644 0001762 0000144 00000003117 13734234256 015013 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/createOA.R
\name{createBoseBush}
\alias{createBoseBush}
\title{Create an orthogonal array using the Bose-Bush algorithm.}
\usage{
createBoseBush(q, ncol, bRandom = TRUE)
}
\arguments{
\item{q}{the number of symbols in the array}
\item{ncol}{number of parameters or columns}
\item{bRandom}{should the array be randomized}
}
\value{
an orthogonal array
}
\description{
The \code{bosebush} program
produces \code{OA( 2q^2, k, q, 2 )}, \code{k <= 2q+1}, for powers of 2, \code{q=2^r}.
}
\details{
From Owen: An orthogonal array \code{A} is a matrix of \code{n} rows, \code{k}
columns with every element being one of \code{q} symbols
\code{0,...,q-1}. The array has strength \code{t} if, in every \code{n} by \code{t}
submatrix, the \code{q^t} possible distinct rows, all appear
the same number of times. This number is the index
of the array, commonly denoted \code{lambda}. Clearly,
\code{lambda*q^t=n}. The notation for such an array is \code{OA( n, k, q, t )}.
}
\examples{
A <- createBoseBush(4, 3, FALSE)
B <- createBoseBush(8, 3, TRUE)
}
\references{
Owen, Art. Orthogonal Arrays for: Computer Experiments, Visualizations, and Integration in high dimenstions. \url{http://lib.stat.cmu.edu/designs/oa.c}. 1994
R.C. Bose and K.A. Bush (1952) Annals of Mathematical Statistics, Vol 23 pp 508-524.
}
\seealso{
Other methods to create orthogonal arrays [createBush()],
[createBose()], [createAddelKemp()], [createAddelKemp3()],
[createAddelKempN()], [createBusht()], [createBoseBushl()]
}
lhs/man/createBusht.Rd 0000644 0001762 0000144 00000003270 13734234256 014366 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/createOA.R
\name{createBusht}
\alias{createBusht}
\title{Create an orthogonal array using the Bush algorithm with alternate strength.}
\usage{
createBusht(q, ncol, strength, bRandom = TRUE)
}
\arguments{
\item{q}{the number of symbols in the array}
\item{ncol}{number of parameters or columns}
\item{strength}{the strength of the array to be created}
\item{bRandom}{should the array be randomized}
}
\value{
an orthogonal array
}
\description{
The \code{busht} program produces \code{OA( q^t, k, q, t )}, \code{k <= q+1}, \code{t>=3},
for prime powers \code{q}.
}
\details{
From Owen: An orthogonal array \code{A} is a matrix of \code{n} rows, \code{k}
columns with every element being one of \code{q} symbols
\code{0,...,q-1}. The array has strength \code{t} if, in every \code{n} by \code{t}
submatrix, the \code{q^t} possible distinct rows, all appear
the same number of times. This number is the index
of the array, commonly denoted \code{lambda}. Clearly,
\code{lambda*q^t=n}. The notation for such an array is \code{OA( n, k, q, t )}.
}
\examples{
set.seed(1234)
A <- createBusht(3, 4, 2, TRUE)
B <- createBusht(3, 4, 3, FALSE)
G <- createBusht(3, 4, 3, TRUE)
}
\references{
Owen, Art. Orthogonal Arrays for: Computer Experiments, Visualizations, and Integration in high dimenstions. \url{http://lib.stat.cmu.edu/designs/oa.c}. 1994
K.A. Bush (1952) Annals of Mathematical Statistics, Vol 23 pp 426-434
}
\seealso{
Other methods to create orthogonal arrays [createBoseBush()],
[createBose()], [createAddelKemp()], [createAddelKemp3()],
[createAddelKempN()], [createBoseBushl()]
}
lhs/man/createAddelKemp3.Rd 0000644 0001762 0000144 00000003264 13734234256 015215 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/createOA.R
\name{createAddelKemp3}
\alias{createAddelKemp3}
\title{Create an orthogonal array using the Addelman-Kempthorne algorithm
with \code{2q^3} rows.}
\usage{
createAddelKemp3(q, ncol, bRandom = TRUE)
}
\arguments{
\item{q}{the number of symbols in the array}
\item{ncol}{number of parameters or columns}
\item{bRandom}{should the array be randomized}
}
\value{
an orthogonal array
}
\description{
The \code{addelkemp3} program produces
\code{OA( 2*q^3, k, q, 2 )}, \code{k <= 2q^2+2q+1}, for prime powers \code{q}.
\code{q} may be an odd prime power, or \code{q} may be 2 or 4.
}
\details{
From Owen: An orthogonal array \code{A} is a matrix of \code{n} rows, \code{k}
columns with every element being one of \code{q} symbols
\code{0,...,q-1}. The array has strength \code{t} if, in every \code{n} by \code{t}
submatrix, the \code{q^t} possible distinct rows, all appear
the same number of times. This number is the index
of the array, commonly denoted \code{lambda}. Clearly,
\code{lambda*q^t=n}. The notation for such an array is \code{OA( n, k, q, t )}.
}
\examples{
A <- createAddelKemp3(3, 3, TRUE)
B <- createAddelKemp3(3, 5, FALSE)
}
\references{
Owen, Art. Orthogonal Arrays for: Computer Experiments, Visualizations, and Integration in high dimenstions. \url{http://lib.stat.cmu.edu/designs/oa.c}. 1994
S. Addelman and O. Kempthorne (1961) Annals of Mathematical Statistics, Vol 32 pp 1167-1176.
}
\seealso{
Other methods to create orthogonal arrays [createBushBush()],
[createBose()], [createAddelKemp()],
[createAddelKempN()], [createBusht()], [createBoseBushl()]
}
lhs/man/optAugmentLHS.Rd 0000644 0001762 0000144 00000003231 13425061507 014576 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/optAugmentLHS.R
\name{optAugmentLHS}
\alias{optAugmentLHS}
\title{Optimal Augmented Latin Hypercube Sample}
\usage{
optAugmentLHS(lhs, m = 1, mult = 2)
}
\arguments{
\item{lhs}{The Latin Hypercube Design to which points are to be added}
\item{m}{The number of additional points to add to matrix \code{lhs}}
\item{mult}{\code{m*mult} random candidate points will be created.}
}
\value{
An \code{n} by \code{k} Latin Hypercube Sample matrix with values uniformly distributed on [0,1]
}
\description{
Augments an existing Latin Hypercube Sample, adding points to the design, while
maintaining the \emph{latin} properties of the design. This function attempts to
add the points to the design in an optimal way.
}
\details{
Augments an existing Latin Hypercube Sample, adding points to the design, while
maintaining the \emph{latin} properties of the design. This function attempts to
add the points to the design in a way that maximizes S optimality.
S-optimality seeks to maximize the mean distance from each design point to all
the other points in the design, so the points are as spread out as possible.
}
\examples{
set.seed(1234)
a <- randomLHS(4,3)
b <- optAugmentLHS(a, 2, 3)
}
\references{
Stein, M. (1987) Large Sample Properties of Simulations Using Latin Hypercube Sampling.
\emph{Technometrics}. \bold{29}, 143--151.
}
\seealso{
[randomLHS()], [geneticLHS()], [improvedLHS()], [maximinLHS()], and
[optimumLHS()] to generate Latin Hypercube Samples. [optSeededLHS()] and
[augmentLHS()] to modify and augment existing designs.
}
\keyword{design}
lhs/man/createBush.Rd 0000644 0001762 0000144 00000003040 13734234256 014175 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/createOA.R
\name{createBush}
\alias{createBush}
\title{Create an orthogonal array using the Bush algorithm.}
\usage{
createBush(q, ncol, bRandom = TRUE)
}
\arguments{
\item{q}{the number of symbols in the array}
\item{ncol}{number of parameters or columns}
\item{bRandom}{should the array be randomized}
}
\value{
an orthogonal array
}
\description{
The \code{bush} program
produces \code{OA( q^3, k, q, 3 )}, \code{k <= q+1} for prime powers \code{q}.
}
\details{
From Owen: An orthogonal array \code{A} is a matrix of \code{n} rows, \code{k}
columns with every element being one of \code{q} symbols
\code{0,...,q-1}. The array has strength \code{t} if, in every \code{n} by \code{t}
submatrix, the \code{q^t} possible distinct rows, all appear
the same number of times. This number is the index
of the array, commonly denoted \code{lambda}. Clearly,
\code{lambda*q^t=n}. The notation for such an array is \code{OA( n, k, q, t )}.
}
\examples{
A <- createBush(3, 3, FALSE)
B <- createBush(4, 5, TRUE)
}
\references{
Owen, Art. Orthogonal Arrays for: Computer Experiments, Visualizations, and Integration in high dimenstions. \url{http://lib.stat.cmu.edu/designs/oa.c}. 1994
K.A. Bush (1952) Annals of Mathematical Statistics, Vol 23 pp 426-434
}
\seealso{
Other methods to create orthogonal arrays [createBoseBush()],
[createBose()], [createAddelKemp()], [createAddelKemp3()],
[createAddelKempN()], [createBusht()], [createBoseBushl()]
}
lhs/man/lhs-package.Rd 0000644 0001762 0000144 00000001141 13637001570 014260 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/lhs.R
\docType{package}
\name{lhs-package}
\alias{lhs}
\alias{lhs-package}
\title{lhs: Latin Hypercube Samples}
\description{
Provides a number of methods for creating and augmenting Latin Hypercube Samples and Orthogonal Array Latin Hypercube Samples.
}
\seealso{
Useful links:
\itemize{
\item \url{https://github.com/bertcarnell/lhs}
\item Report bugs at \url{https://github.com/bertcarnell/lhs/issues}
}
}
\author{
\strong{Maintainer}: Rob Carnell \email{bertcarnell@gmail.com}
}
\keyword{internal}
lhs/man/augmentLHS.Rd 0000644 0001762 0000144 00000004734 13425060620 014117 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/augmentLHS.R
\name{augmentLHS}
\alias{augmentLHS}
\title{Augment a Latin Hypercube Design}
\usage{
augmentLHS(lhs, m = 1)
}
\arguments{
\item{lhs}{The Latin Hypercube Design to which points are to be added.
Contains an existing latin hypercube design with a number of rows equal
to the points in the design (simulations) and a number of columns equal
to the number of variables (parameters). The values of each cell must be
between 0 and 1 and uniformly distributed}
\item{m}{The number of additional points to add to matrix \code{lhs}}
}
\value{
An \code{n} by \code{k} Latin Hypercube Sample matrix with values
uniformly distributed on [0,1]
}
\description{
Augments an existing Latin Hypercube Sample, adding points to the design, while
maintaining the \emph{latin} properties of the design.
}
\details{
Augments an existing Latin Hypercube Sample, adding points to the design, while
maintaining the \emph{latin} properties of the design. Augmentation is perfomed
in a random manner.
The algorithm used by this function has the following steps.
First, create a new matrix to hold the candidate points after the design has
been re-partitioned into \eqn{(n+m)^{2}}{(n+m)^2} cells, where n is number of
points in the original \code{lhs} matrix. Then randomly sweep through each
column (1\ldots\code{k}) in the repartitioned design to find the missing cells.
For each column (variable), randomly search for an empty row, generate a
random value that fits in that row, record the value in the new matrix.
The new matrix can contain more filled cells than \code{m} unles \eqn{m = 2n},
in which case the new matrix will contain exactly \code{m} filled cells.
Finally, keep only the first m rows of the new matrix. It is guaranteed to
have \code{m} full rows in the new matrix. The deleted rows are partially full.
The additional candidate points are selected randomly due to the random search
for empty cells.
}
\examples{
set.seed(1234)
a <- randomLHS(4,3)
b <- augmentLHS(a, 2)
}
\references{
Stein, M. (1987) Large Sample Properties of Simulations Using Latin
Hypercube Sampling. \emph{Technometrics}. \bold{29}, 143--151.
}
\seealso{
[randomLHS()], [geneticLHS()], [improvedLHS()], [maximinLHS()],
and [optimumLHS()] to generate Latin Hypercube Samples. [optAugmentLHS()]
and [optSeededLHS()] to modify and augment existing designs.
}
\author{
Rob Carnell
}
\keyword{design}
lhs/man/createBose.Rd 0000644 0001762 0000144 00000003004 13734234256 014164 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/createOA.R
\name{createBose}
\alias{createBose}
\title{Create an orthogonal array using the Bose algorithm.}
\usage{
createBose(q, ncol, bRandom = TRUE)
}
\arguments{
\item{q}{the number of symbols in the array}
\item{ncol}{number of parameters or columns}
\item{bRandom}{should the array be randomized}
}
\value{
an orthogonal array
}
\description{
The \code{bose} program
produces \code{OA( q^2, k, q, 2 )}, \code{k <= q+1} for prime powers \code{q}.
}
\details{
From Owen: An orthogonal array \code{A} is a matrix of \code{n} rows, \code{k}
columns with every element being one of \code{q} symbols
\code{0,...,q-1}. The array has strength \code{t} if, in every \code{n} by \code{t}
submatrix, the \code{q^t} possible distinct rows, all appear
the same number of times. This number is the index
of the array, commonly denoted \code{lambda}. Clearly,
\code{lambda*q^t=n}. The notation for such an array is \code{OA( n, k, q, t )}.
}
\examples{
A <- createBose(3, 3, FALSE)
B <- createBose(5, 4, TRUE)
}
\references{
Owen, Art. Orthogonal Arrays for: Computer Experiments, Visualizations, and Integration in high dimenstions. \url{http://lib.stat.cmu.edu/designs/oa.c}. 1994
R.C. Bose (1938) Sankhya Vol 3 pp 323-338
}
\seealso{
Other methods to create orthogonal arrays [createBush()],
[createBoseBush()], [createAddelKemp()], [createAddelKemp3()],
[createAddelKempN()], [createBusht()], [createBoseBushl()]
}
lhs/man/createAddelKempN.Rd 0000644 0001762 0000144 00000003013 13734234256 015240 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/createOA.R
\name{createAddelKempN}
\alias{createAddelKempN}
\title{Create an orthogonal array using the Addelman-Kempthorne algorithm with
alternate strength with \code{2q^n} rows.}
\usage{
createAddelKempN(q, ncol, exponent, bRandom = TRUE)
}
\arguments{
\item{q}{the number of symbols in the array}
\item{ncol}{number of parameters or columns}
\item{exponent}{the exponent on q}
\item{bRandom}{should the array be randomized}
}
\value{
an orthogonal array
}
\description{
The \code{addelkempn} program produces
\code{OA( 2*q^n, k, q, 2 )}, \code{k <= 2(q^n - 1)/(q-1)-1}, for prime powers \code{q}.
\code{q} may be an odd prime power, or \code{q} may be 2 or 4.
}
\details{
From Owen: An orthogonal array \code{A} is a matrix of \code{n} rows, \code{k}
columns with every element being one of \code{q} symbols
\code{0,...,q-1}. The array has strength \code{t} if, in every \code{n} by \code{t}
submatrix, the \code{q^t} possible distinct rows, all appear
the same number of times. This number is the index
of the array, commonly denoted \code{lambda}. Clearly,
\code{lambda*q^t=n}. The notation for such an array is \code{OA( n, k, q, t )}.
}
\examples{
A <- createAddelKempN(3, 4, 3, TRUE)
B <- createAddelKempN(3, 4, 4, TRUE)
}
\seealso{
Other methods to create orthogonal arrays [createBoseBush()],
[createBose()], [createBush()], [createAddelKemp()], [createAddelKemp3()],
[createBusht()], [createBoseBushl()]
}
lhs/man/improvedLHS.Rd 0000644 0001762 0000144 00000005573 14115501162 014304 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/improvedLHS.r
\name{improvedLHS}
\alias{improvedLHS}
\title{Improved Latin Hypercube Sample}
\usage{
improvedLHS(n, k, dup = 1)
}
\arguments{
\item{n}{The number of partitions (simulations or design points or rows)}
\item{k}{The number of replications (variables or columns)}
\item{dup}{A factor that determines the number of candidate points used in the
search. A multiple of the number of remaining points than can be added.}
}
\value{
An \code{n} by \code{k} Latin Hypercube Sample matrix with values uniformly distributed on [0,1]
}
\description{
Draws a Latin Hypercube Sample from a set of uniform distributions for use in
creating a Latin Hypercube Design. This function attempts to optimize the
sample with respect to an optimum euclidean distance between design points.
}
\details{
Latin hypercube sampling (LHS) was developed to generate a distribution
of collections of parameter values from a multidimensional distribution.
A square grid containing possible sample points is a Latin square iff there
is only one sample in each row and each column. A Latin hypercube is the
generalisation of this concept to an arbitrary number of dimensions. When
sampling a function of \code{k} variables, the range of each variable is divided
into \code{n} equally probable intervals. \code{n} sample points are then drawn such that a
Latin Hypercube is created. Latin Hypercube sampling generates more efficient
estimates of desired parameters than simple Monte Carlo sampling.
This program generates a Latin Hypercube Sample by creating random permutations
of the first \code{n} integers in each of \code{k} columns and then transforming those
integers into n sections of a standard uniform distribution. Random values are
then sampled from within each of the n sections. Once the sample is generated,
the uniform sample from a column can be transformed to any distribution byusing the quantile functions, e.g. qnorm(). Different columns can have
different distributions.
This function attempts to optimize the sample with respect to an optimum
euclidean distance between design points.
\deqn{Optimum distance = frac{n}{n^{\frac{1.0}{k}}}}{Optimum distance = n/n^(1.0/k)}
}
\examples{
set.seed(1234)
A <- improvedLHS(4, 3, 2)
}
\references{
Beachkofski, B., Grandhi, R. (2002) Improved Distributed Hypercube Sampling
\emph{American Institute of Aeronautics and Astronautics Paper} \bold{1274}.
This function is based on the MATLAB program written by John Burkardt and modified 16 Feb 2005
\url{https://people.math.sc.edu/Burkardt/m_src/ihs/ihs.html}
}
\seealso{
[randomLHS()], [geneticLHS()], [maximinLHS()], and [optimumLHS()]
to generate Latin Hypercube Samples. [optAugmentLHS()], [optSeededLHS()], and
[augmentLHS()] to modify and augment existing designs.
}
\keyword{design}
lhs/man/optimumLHS.Rd 0000644 0001762 0000144 00000005776 13636661005 014170 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/optimumLHS.R
\name{optimumLHS}
\alias{optimumLHS}
\title{Optimum Latin Hypercube Sample}
\usage{
optimumLHS(n = 10, k = 2, maxSweeps = 2, eps = 0.1, verbose = FALSE)
}
\arguments{
\item{n}{The number of partitions (simulations or design points or rows)}
\item{k}{The number of replications (variables or columns)}
\item{maxSweeps}{The maximum number of times the CP algorithm is applied to all the columns.}
\item{eps}{The optimal stopping criterion. Algorithm stops when the change in
optimality measure is less than eps*100\% of the previous value.}
\item{verbose}{Print informational messages}
}
\value{
An \code{n} by \code{k} Latin Hypercube Sample matrix with values uniformly distributed on [0,1]
}
\description{
Draws a Latin Hypercube Sample from a set of uniform distributions for use in
creating a Latin Hypercube Design. This function uses the Columnwise
Pairwise (\acronym{CP}) algorithm to generate an optimal design with respect to the S
optimality criterion.
}
\details{
Latin hypercube sampling (LHS) was developed to generate a distribution
of collections of parameter values from a multidimensional distribution.
A square grid containing possible sample points is a Latin square iff there
is only one sample in each row and each column. A Latin hypercube is the
generalisation of this concept to an arbitrary number of dimensions. When
sampling a function of \code{k} variables, the range of each variable is divided
into \code{n} equally probable intervals. \code{n} sample points are then drawn such that a
Latin Hypercube is created. Latin Hypercube sampling generates more efficient
estimates of desired parameters than simple Monte Carlo sampling.
This program generates a Latin Hypercube Sample by creating random permutations
of the first \code{n} integers in each of \code{k} columns and then transforming those
integers into n sections of a standard uniform distribution. Random values are
then sampled from within each of the n sections. Once the sample is generated,
the uniform sample from a column can be transformed to any distribution by
using the quantile functions, e.g. qnorm(). Different columns can have
different distributions.
S-optimality seeks to maximize the mean distance from each design point to all
the other points in the design, so the points are as spread out as possible.
This function uses the \acronym{CP} algorithm to generate an optimal
design with respect to the S optimality criterion.
}
\examples{
A <- optimumLHS(4, 3, 5, .05)
}
\references{
Stocki, R. (2005) A method to improve design reliability using optimal Latin hypercube sampling
\emph{Computer Assisted Mechanics and Engineering Sciences} \bold{12}, 87--105.
}
\seealso{
[randomLHS()], [geneticLHS()], [improvedLHS()] and [maximinLHS()]
to generate Latin Hypercube Samples. [optAugmentLHS()], [optSeededLHS()], and
[augmentLHS()] to modify and augment existing designs.
}
\keyword{design}
lhs/man/createAddelKemp.Rd 0000644 0001762 0000144 00000003126 13734234256 015127 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/createOA.R
\name{createAddelKemp}
\alias{createAddelKemp}
\title{Create an orthogonal array using the Addelman-Kempthorne algorithm.}
\usage{
createAddelKemp(q, ncol, bRandom = TRUE)
}
\arguments{
\item{q}{the number of symbols in the array}
\item{ncol}{number of parameters or columns}
\item{bRandom}{should the array be randomized}
}
\value{
an orthogonal array
}
\description{
The \code{addelkemp} program produces \code{OA( 2q^2, k, q, 2 )}, \code{k <= 2q+1},
for odd prime powers \code{q}.
}
\details{
From Owen: An orthogonal array \code{A} is a matrix of \code{n} rows, \code{k}
columns with every element being one of \code{q} symbols
\code{0,...,q-1}. The array has strength \code{t} if, in every \code{n} by \code{t}
submatrix, the \code{q^t} possible distinct rows, all appear
the same number of times. This number is the index
of the array, commonly denoted \code{lambda}. Clearly,
\code{lambda*q^t=n}. The notation for such an array is \code{OA( n, k, q, t )}.
}
\examples{
A <- createAddelKemp(3, 3, TRUE)
B <- createAddelKemp(3, 5, FALSE)
}
\references{
Owen, Art. Orthogonal Arrays for: Computer Experiments, Visualizations, and Integration in high dimenstions. \url{http://lib.stat.cmu.edu/designs/oa.c}. 1994
S. Addelman and O. Kempthorne (1961) Annals of Mathematical Statistics, Vol 32 pp 1167-1176.
}
\seealso{
Other methods to create orthogonal arrays [createBoseBush()],
[createBose()], [createAddelKemp3()],
[createAddelKempN()], [createBusht()], [createBoseBushl()]
}
lhs/man/create_oalhs.Rd 0000644 0001762 0000144 00000001452 13425060620 014533 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/create_oalhs.R
\name{create_oalhs}
\alias{create_oalhs}
\title{Create an orthogonal array Latin hypercube}
\usage{
create_oalhs(n, k, bChooseLargerDesign, bverbose)
}
\arguments{
\item{n}{the number of samples or rows in the LHS (integer)}
\item{k}{the number of parameters or columns in the LHS (integer)}
\item{bChooseLargerDesign}{should a larger oa design be chosen than the n and k requested?}
\item{bverbose}{should information be printed with execution}
}
\value{
a numeric matrix which is an orthogonal array Latin hypercube sample
}
\description{
Create an orthogonal array Latin hypercube
}
\examples{
set.seed(34)
A <- create_oalhs(9, 4, TRUE, FALSE)
B <- create_oalhs(9, 4, TRUE, FALSE)
}
lhs/man/geneticLHS.Rd 0000644 0001762 0000144 00000007622 13636661005 014104 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/geneticLHS.R
\name{geneticLHS}
\alias{geneticLHS}
\title{Latin Hypercube Sampling with a Genetic Algorithm}
\usage{
geneticLHS(
n = 10,
k = 2,
pop = 100,
gen = 4,
pMut = 0.1,
criterium = "S",
verbose = FALSE
)
}
\arguments{
\item{n}{The number of partitions (simulations or design points or rows)}
\item{k}{The number of replications (variables or columns)}
\item{pop}{The number of designs in the initial population}
\item{gen}{The number of generations over which the algorithm is applied}
\item{pMut}{The probability with which a mutation occurs in a column of the progeny}
\item{criterium}{The optimality criterium of the algorithm. Default is \code{S}. \code{Maximin} is also supported}
\item{verbose}{Print informational messages. Default is \code{FALSE}}
}
\value{
An \code{n} by \code{k} Latin Hypercube Sample matrix with values uniformly distributed on [0,1]
}
\description{
Draws a Latin Hypercube Sample from a set of uniform distributions for use in
creating a Latin Hypercube Design. This function attempts to optimize the
sample with respect to the S optimality criterion through a genetic type
algorithm.
}
\details{
Latin hypercube sampling (LHS) was developed to generate a distribution
of collections of parameter values from a multidimensional distribution.
A square grid containing possible sample points is a Latin square iff there
is only one sample in each row and each column. A Latin hypercube is the
generalisation of this concept to an arbitrary number of dimensions. When
sampling a function of \code{k} variables, the range of each variable is divided
into \code{n} equally probable intervals. \code{n} sample points are then drawn such that a
Latin Hypercube is created. Latin Hypercube sampling generates more efficient
estimates of desired parameters than simple Monte Carlo sampling.
This program generates a Latin Hypercube Sample by creating random permutations
of the first \code{n} integers in each of \code{k} columns and then transforming those
integers into n sections of a standard uniform distribution. Random values are
then sampled from within each of the n sections. Once the sample is generated,
the uniform sample from a column can be transformed to any distribution by
using the quantile functions, e.g. qnorm(). Different columns can have
different distributions.
S-optimality seeks to maximize the mean distance from each design point to all
the other points in the design, so the points are as spread out as possible.
Genetic Algorithm:
\enumerate{
\item Generate \code{pop} random latin hypercube designs of size \code{n} by \code{k}
\item Calculate the S optimality measure of each design
\item Keep the best design in the first position and throw away half of the rest of the population
\item Take a random column out of the best matrix and place it in a random column of each of the other matricies, and take a random column out of each of the other matricies and put it in copies of the best matrix thereby causing the progeny
\item For each of the progeny, cause a genetic mutation \code{pMut} percent of the time. The mutation is accomplished by swtching two elements in a column
}
}
\examples{
set.seed(1234)
A <- geneticLHS(4, 3, 50, 5, .25)
}
\references{
Stocki, R. (2005) A method to improve design reliability using optimal Latin hypercube sampling
\emph{Computer Assisted Mechanics and Engineering Sciences} \bold{12}, 87--105.
Stein, M. (1987) Large Sample Properties of Simulations Using Latin Hypercube Sampling.
\emph{Technometrics}. \bold{29}, 143--151.
}
\seealso{
[randomLHS()], [improvedLHS()], [maximinLHS()],
and [optimumLHS()] to generate Latin Hypercube Samples. [optAugmentLHS()]
[optSeededLHS()], and [augtmentLHS()] to modify and augment existing designs.
}
\author{
Rob Carnell
}
\keyword{design}
lhs/man/poly2int.Rd 0000644 0001762 0000144 00000000756 14115430532 013670 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/galois_field.R
\name{poly2int}
\alias{poly2int}
\title{Convert polynomial to integer in 0..q-1
}
\usage{
poly2int(p, n, poly)
}
\arguments{
\item{p}{modulus}
\item{n}{the length of poly}
\item{poly}{the polynomial vector}
}
\value{
an integer
}
\description{
Convert polynomial to integer in 0..q-1
}
\examples{
gf <- create_galois_field(4)
stopifnot(poly2int(gf$p, gf$n, c(0, 0)) == 0)
}
lhs/man/create_galois_field.Rd 0000644 0001762 0000144 00000003433 14115430532 016047 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/galois_field.R
\name{create_galois_field}
\alias{create_galois_field}
\title{Create a Galois field}
\usage{
create_galois_field(q)
}
\arguments{
\item{q}{The order of the Galois Field q = p^n}
}
\value{
a GaloisField object containing
\describe{
\item{n}{q = p^n}
\item{p}{The prime modulus of the field q=p^n}
\item{q}{The order of the Galois Field q = p^n. \code{q} must be a prime power.}
\item{xton}{coefficients of the characteristic polynomial where the first coefficient is on $x^0$, the second is on $x^1$ and so on}
\item{inv}{An index for which row of \code{poly} (zero based) is the multiplicative inverse of this row. An \code{NA} indicates that this row of \code{poly} has no inverse. e.g. c(3, 4) means that row 4=3+1 is the inverse of row 1 and row 5=4+1 is the inverse of row 2}
\item{neg}{An index for which row of \code{poly} (zero based) is the negative or additive inverse of this row. An \code{NA} indicates that this row of \code{poly} has no negative. e.g. c(3, 4) means that row 4=3+1 is the negative of row 1 and row 5=4+1 is the negative of row 2}
\item{root}{An index for which row of \code{poly} (zero based) is the square root of this row. An \code{NA} indicates that this row of \code{poly} has no square root. e.g. c(3, 4) means that row 4=3+1 is the square root of row 1 and row 5=4+1 is the square root of row 2}
\item{plus}{sum table of the Galois Field}
\item{times}{multiplication table of the Galois Field}
\item{poly}{rows are polynomials of the Galois Field where the entries are the coefficients of the polynomial where the first coefficient is on $x^0$, the second is on $x^1$ and so on}
}
}
\description{
Create a Galois field
}
\examples{
gf <- create_galois_field(4);
}
lhs/man/optSeededLHS.Rd 0000644 0001762 0000144 00000003520 13636661005 014373 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/optSeededLHS.R
\name{optSeededLHS}
\alias{optSeededLHS}
\title{Optimum Seeded Latin Hypercube Sample}
\usage{
optSeededLHS(seed, m = 0, maxSweeps = 2, eps = 0.1, verbose = FALSE)
}
\arguments{
\item{seed}{The number of partitions (simulations or design points)}
\item{m}{The number of additional points to add to the seed matrix \code{seed}. default value is zero. If m is zero then the seed design is optimized.}
\item{maxSweeps}{The maximum number of times the CP algorithm is applied to all the columns.}
\item{eps}{The optimal stopping criterion}
\item{verbose}{Print informational messages}
}
\value{
An \code{n} by \code{k} Latin Hypercube Sample matrix with values uniformly distributed on [0,1]
}
\description{
Augments an existing Latin Hypercube Sample, adding points to the design, while
maintaining the \emph{latin} properties of the design. This function then uses the
columnwise pairwise (\acronym{CP}) algoritm to optimize the design. The original design is not necessarily maintained.
}
\details{
Augments an existing Latin Hypercube Sample, adding points to the design, while
maintaining the \emph{latin} properties of the design. This function then uses the
\acronym{CP} algoritm to optimize the design. The original design
is not necessarily maintained.
}
\examples{
set.seed(1234)
a <- randomLHS(4,3)
b <- optSeededLHS(a, 2, 2, .1)
}
\references{
Stein, M. (1987) Large Sample Properties of Simulations Using Latin Hypercube Sampling.
\emph{Technometrics}. \bold{29}, 143--151.
}
\seealso{
[randomLHS()], [geneticLHS()], [improvedLHS()], [maximinLHS()], and
[optimumLHS()] to generate Latin Hypercube Samples. [optAugmentLHS()] and
[augmentLHS()] to modify and augment existing designs.
}
\keyword{design}
lhs/man/runifint.Rd 0000644 0001762 0000144 00000000751 13636661005 013751 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/runifint.r
\name{runifint}
\alias{runifint}
\title{Create a Random Sample of Uniform Integers}
\usage{
runifint(n = 1, min_int = 0, max_int = 1)
}
\arguments{
\item{n}{The number of samples}
\item{min_int}{the minimum integer \code{x >= min_int}}
\item{max_int}{the maximum integer \code{x <= max_int}}
}
\value{
the sample sample of size \code{n}
}
\description{
Create a Random Sample of Uniform Integers
}
lhs/man/oa_to_oalhs.Rd 0000644 0001762 0000144 00000001274 13425355422 014402 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/oa_to_oalhs.R
\name{oa_to_oalhs}
\alias{oa_to_oalhs}
\title{Create a Latin hypercube from an orthogonal array}
\usage{
oa_to_oalhs(n, k, oa)
}
\arguments{
\item{n}{the number of samples or rows in the LHS (integer)}
\item{k}{the number of parameters or columns in the LHS (integer)}
\item{oa}{the orthogonal array to be used as the basis for the LHS (matrix of integers) or data.frame of factors}
}
\value{
a numeric matrix which is a Latin hypercube sample
}
\description{
Create a Latin hypercube from an orthogonal array
}
\examples{
oa <- createBose(3, 4, TRUE)
B <- oa_to_oalhs(9, 4, oa)
}
lhs/man/createBoseBushl.Rd 0000644 0001762 0000144 00000003427 13734234256 015173 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/createOA.R
\name{createBoseBushl}
\alias{createBoseBushl}
\title{Create an orthogonal array using the Bose-Bush algorithm with alternate strength >= 3.}
\usage{
createBoseBushl(q, ncol, lambda, bRandom = TRUE)
}
\arguments{
\item{q}{the number of symbols in the array}
\item{ncol}{number of parameters or columns}
\item{lambda}{the lambda of the BoseBush algorithm}
\item{bRandom}{should the array be randomized}
}
\value{
an orthogonal array
}
\description{
The \code{bosebushl} program produces \code{OA( lambda*q^2, k, q, 2 )},
\code{k <= lambda*q+1}, for prime powers \code{q} and \code{lambda > 1}. Both \code{q} and
\code{lambda} must be powers of the same prime.
}
\details{
From Owen: An orthogonal array \code{A} is a matrix of \code{n} rows, \code{k}
columns with every element being one of \code{q} symbols
\code{0,...,q-1}. The array has strength \code{t} if, in every \code{n} by \code{t}
submatrix, the \code{q^t} possible distinct rows, all appear
the same number of times. This number is the index
of the array, commonly denoted \code{lambda}. Clearly,
\code{lambda*q^t=n}. The notation for such an array is \code{OA( n, k, q, t )}.
}
\examples{
A <- createBoseBushl(3, 3, 3, TRUE)
B <- createBoseBushl(4, 4, 16, TRUE)
}
\references{
Owen, Art. Orthogonal Arrays for: Computer Experiments, Visualizations, and Integration in high dimenstions. \url{http://lib.stat.cmu.edu/designs/oa.c}. 1994
R.C. Bose and K.A. Bush (1952) Annals of Mathematical Statistics, Vol 23 pp 508-524.
}
\seealso{
Other methods to create orthogonal arrays [createBoseBush()],
[createBose()], [createBush()], [createAddelKemp()], [createAddelKemp3()],
[createAddelKempN()], [createBusht()]
}
lhs/man/poly_prod.Rd 0000644 0001762 0000144 00000001211 14115430532 014102 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/galois_field.R
\name{poly_prod}
\alias{poly_prod}
\title{Multiplication in polynomial representation}
\usage{
poly_prod(p, n, xton, p1, p2)
}
\arguments{
\item{p}{modulus}
\item{n}{length of polynomials}
\item{xton}{characteristic polynomial vector for the field (x to the n power)}
\item{p1}{polynomial vector 1}
\item{p2}{polynomial vector 2}
}
\value{
the product of p1 and p2
}
\description{
Multiplication in polynomial representation
}
\examples{
gf <- create_galois_field(4)
a <- poly_prod(gf$p, gf$n, gf$xton, c(1, 0), c(0, 1))
stopifnot(all(a == c(0, 1)))
}
lhs/man/maximinLHS.Rd 0000644 0001762 0000144 00000007511 14115501162 014113 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/maximinLHS.R
\name{maximinLHS}
\alias{maximinLHS}
\title{Maximin Latin Hypercube Sample}
\usage{
maximinLHS(
n,
k,
method = "build",
dup = 1,
eps = 0.05,
maxIter = 100,
optimize.on = "grid",
debug = FALSE
)
}
\arguments{
\item{n}{The number of partitions (simulations or design points or rows)}
\item{k}{The number of replications (variables or columns)}
\item{method}{\code{build} or \code{iterative} is the method of LHS creation.
\code{build} finds the next best point while constructing the LHS.
\code{iterative} optimizes the resulting sample on [0,1] or sample grid on [1,N]}
\item{dup}{A factor that determines the number of candidate points used in the
search. A multiple of the number of remaining points than can be
added. This is used when \code{method="build"}}
\item{eps}{The minimum percent change in the minimum distance used in the
\code{iterative} method}
\item{maxIter}{The maximum number of iterations to use in the \code{iterative} method}
\item{optimize.on}{\code{grid} or \code{result} gives the basis of the optimization.
\code{grid} optimizes the LHS on the underlying integer grid.
\code{result} optimizes the resulting sample on [0,1]}
\item{debug}{prints additional information about the process of the optimization}
}
\value{
An \code{n} by \code{k} Latin Hypercube Sample matrix with values uniformly distributed on [0,1]
}
\description{
Draws a Latin Hypercube Sample from a set of uniform distributions for use in
creating a Latin Hypercube Design. This function attempts to optimize the
sample by maximizing the minium distance between design points (maximin criteria).
}
\details{
Latin hypercube sampling (LHS) was developed to generate a distribution
of collections of parameter values from a multidimensional distribution.
A square grid containing possible sample points is a Latin square iff there
is only one sample in each row and each column. A Latin hypercube is the
generalisation of this concept to an arbitrary number of dimensions. When
sampling a function of \code{k} variables, the range of each variable is divided
into \code{n} equally probable intervals. \code{n} sample points are then drawn such that a
Latin Hypercube is created. Latin Hypercube sampling generates more efficient
estimates of desired parameters than simple Monte Carlo sampling.
This program generates a Latin Hypercube Sample by creating random permutations
of the first \code{n} integers in each of \code{k} columns and then transforming those
integers into n sections of a standard uniform distribution. Random values are
then sampled from within each of the n sections. Once the sample is generated,
the uniform sample from a column can be transformed to any distribution by
using the quantile functions, e.g. qnorm(). Different columns can have
different distributions.
Here, values are added to the design one by one such that the maximin criteria is
satisfied.
}
\examples{
set.seed(1234)
A1 <- maximinLHS(4, 3, dup=2)
A2 <- maximinLHS(4, 3, method="build", dup=2)
A3 <- maximinLHS(4, 3, method="iterative", eps=0.05, maxIter=100, optimize.on="grid")
A4 <- maximinLHS(4, 3, method="iterative", eps=0.05, maxIter=100, optimize.on="result")
}
\references{
Stein, M. (1987) Large Sample Properties of Simulations Using Latin Hypercube Sampling.
\emph{Technometrics}. \bold{29}, 143--151.
This function is motivated by the MATLAB program written by John Burkardt and modified 16 Feb 2005
\url{https://people.math.sc.edu/Burkardt/m_src/ihs/ihs.html}
}
\seealso{
[randomLHS()], [geneticLHS()], [improvedLHS()] and [optimumLHS()]
to generate Latin Hypercube Samples. [optAugmentLHS()], [optSeededLHS()], and
[augmentLHS()] to modify and augment existing designs.
}
\keyword{design}
lhs/man/poly_sum.Rd 0000644 0001762 0000144 00000001035 14115430532 013746 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/galois_field.R
\name{poly_sum}
\alias{poly_sum}
\title{Addition in polynomial representation}
\usage{
poly_sum(p, n, p1, p2)
}
\arguments{
\item{p}{modulus}
\item{n}{length of polynomial 1 and 2}
\item{p1}{polynomial vector 1}
\item{p2}{polynomial vector 2}
}
\value{
the sum of p1 and p2
}
\description{
Addition in polynomial representation
}
\examples{
gf <- create_galois_field(4)
a <- poly_sum(gf$p, gf$n, c(1, 0), c(0, 1))
stopifnot(all(a == c(1, 1)))
}
lhs/man/get_library_versions.Rd 0000644 0001762 0000144 00000000652 13754762666 016366 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/get_library_versions.R
\name{get_library_versions}
\alias{get_library_versions}
\title{Get version information for all libraries in the lhs package}
\usage{
get_library_versions()
}
\value{
a character string containing the versions
}
\description{
Get version information for all libraries in the lhs package
}
\examples{
get_library_versions()
}
lhs/man/randomLHS.Rd 0000644 0001762 0000144 00000001664 13416426305 013744 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/randomLHS.r
\name{randomLHS}
\alias{randomLHS}
\title{Construct a random Latin hypercube design}
\usage{
randomLHS(n, k, preserveDraw = FALSE)
}
\arguments{
\item{n}{the number of rows or samples}
\item{k}{the number of columns or parameters/variables}
\item{preserveDraw}{should the draw be constructed so that it is the same for variable numbers of columns?}
}
\value{
a Latin hypercube sample
}
\description{
\code{randomLHS(4,3)} returns a 4x3 matrix with each column
constructed as follows: A random permutation of (1,2,3,4) is
generated, say (3,1,2,4) for each of K columns. Then a uniform
random number is picked from each indicated quartile. In this
example a random number between .5 and .75 is chosen, then one between
0 and .25, then one between .25 and .5, finally one between
.75 and 1.
}
\examples{
a <- randomLHS(5, 3)
}
lhs/DESCRIPTION 0000644 0001762 0000144 00000001472 14347432332 012557 0 ustar ligges users Package: lhs
Title: Latin Hypercube Samples
Version: 1.1.6
Authors@R:
person(given = "Rob",
family = "Carnell",
role = c("aut", "cre"),
email = "bertcarnell@gmail.com")
Description: Provides a number of methods for creating and augmenting Latin Hypercube Samples and Orthogonal Array Latin Hypercube Samples.
License: GPL-3
Encoding: UTF-8
Depends: R (>= 3.4.0)
LinkingTo: Rcpp
Imports: Rcpp
Suggests: testthat, assertthat, DoE.base, knitr, rmarkdown
URL: https://github.com/bertcarnell/lhs
BugReports: https://github.com/bertcarnell/lhs/issues
RoxygenNote: 7.2.2
VignetteBuilder: knitr
NeedsCompilation: yes
Packaged: 2022-12-17 19:41:08 UTC; bertc
Author: Rob Carnell [aut, cre]
Maintainer: Rob Carnell
Repository: CRAN
Date/Publication: 2022-12-17 21:30:02 UTC
lhs/build/ 0000755 0001762 0000144 00000000000 14347415522 012146 5 ustar ligges users lhs/build/vignette.rds 0000644 0001762 0000144 00000000524 14347415522 014506 0 ustar ligges users RMO@jmIVS=uLa KS{Wn{F.-J>}0
&WQ9piQQM˹OӈC*d H R5^_T W"
"!EԃvhË^ӆ\$Rڜ
82k[״76WinxYppb{Sy5ץEKg=17Kk^T꽊R3`S.=SIFYh%[=Q(bȍP90GHOѰ lhs/tests/ 0000755 0001762 0000144 00000000000 13415250176 012206 5 ustar ligges users lhs/tests/testthat/ 0000755 0001762 0000144 00000000000 14347432332 014047 5 ustar ligges users lhs/tests/testthat/test-galois_field.R 0000644 0001762 0000144 00000011020 14115430532 017553 0 ustar ligges users test_that("Galois Fields Work", {
test_field <- function(q, p, n)
{
gf <- create_galois_field(q)
expect_equal(gf$p, p)
expect_equal(gf$q, q)
expect_equal(gf$n, n)
}
test_field(2, 2, 1)
test_field(3, 3, 1)
test_field(4, 2, 2)
test_field(9, 3, 2)
# q cannot be less than 2
expect_error(create_galois_field(-1))
expect_error(create_galois_field(1))
# q must be a prime power
expect_error(create_galois_field(100000000))
expect_error(create_galois_field(35))
# the prime power can't be too large
expect_error(create_galois_field(2^30))
})
test_that("Associative", {
check_associative <- function(gf){
for (i in 1:gf$q)
{
for (j in 1:gf$q)
{
for (k in 1:gf$q)
{
sum1 <- poly_sum(gf$p, gf$n, gf$poly[i,], gf$poly[j,])
sum2 <- poly_sum(gf$p, gf$n, sum1, gf$poly[k,])
sum3 <- poly_sum(gf$p, gf$n, gf$poly[j,], gf$poly[k,])
sum4 <- poly_sum(gf$p, gf$n, gf$poly[i,], sum3)
expect_equal(sum2, sum4)
prod1 <- poly_prod(gf$p, gf$n, gf$xton, gf$poly[i,], gf$poly[j,])
prod2 <- poly_prod(gf$p, gf$n, gf$xton, prod1, gf$poly[k,])
prod3 <- poly_prod(gf$p, gf$n, gf$xton, gf$poly[j,], gf$poly[k,])
prod4 <- poly_prod(gf$p, gf$n, gf$xton, gf$poly[i,], prod3)
expect_equal(prod2, prod4)
}
}
}
}
check_associative(create_galois_field(3))
check_associative(create_galois_field(4))
check_associative(create_galois_field(9))
check_associative(create_galois_field(8))
})
test_that("Commutative", {
check_commutative <- function(gf)
{
for (i in 1:gf$q)
{
for (j in 1:gf$q)
{
sum1 <- poly_sum(gf$p, gf$n, gf$poly[i,], gf$poly[j,])
sum2 <- poly_sum(gf$p, gf$n, gf$poly[j,], gf$poly[i,])
expect_equal(sum1, sum2)
prod1 <- poly_prod(gf$p, gf$n, gf$xton, gf$poly[i,], gf$poly[j,])
prod2 <- poly_prod(gf$p, gf$n, gf$xton, gf$poly[j,], gf$poly[i,])
expect_equal(prod1, prod2)
}
}
}
check_commutative(create_galois_field(3))
check_commutative(create_galois_field(4))
check_commutative(create_galois_field(9))
check_commutative(create_galois_field(8))
})
test_that("Identity", {
check_identity <- function(gf, zero, one)
{
for (i in 1:gf$q)
{
sum1 <- poly_sum(gf$p, gf$n, gf$poly[i,], zero)
expect_equal(sum1, gf$poly[i,])
prod1 <- poly_prod(gf$p, gf$n, gf$xton, gf$poly[i,], one)
expect_equal(prod1, gf$poly[i,])
}
}
check_identity(create_galois_field(3), 0, 1)
check_identity(create_galois_field(4), c(0,0), c(1,0))
check_identity(create_galois_field(9), c(0,0), c(1,0))
check_identity(create_galois_field(8), c(0,0,0), c(1,0,0))
})
test_that("Inverse", {
check_inverse <- function(gf, zero, one)
{
#gf <- create_galois_field(3)
for (i in 1:gf$q)
{
#i <- 1
sum1 <- poly_sum(gf$p, gf$n, gf$poly[i,], gf$poly[gf$neg[i] + 1,])
expect_equal(sum1, zero)
if (!is.na(gf$inv[i]))
{
prod1 <- poly_prod(gf$p, gf$n, gf$xton, gf$poly[i,], gf$poly[gf$inv[i] + 1,])
expect_equal(prod1, one)
}
}
}
check_inverse(create_galois_field(3), 0, 1)
check_inverse(create_galois_field(4), c(0,0), c(1,0))
check_inverse(create_galois_field(9), c(0,0), c(1,0))
check_inverse(create_galois_field(8), c(0,0,0), c(1,0,0))
})
test_that("Distributive", {
check_distributive <- function(gf)
{
for (i in 1:gf$q)
{
for (j in 1:gf$q)
{
for (k in 1:gf$q)
{
sum1 <- poly_sum(gf$p, gf$n, gf$poly[j,], gf$poly[k,])
prod1 <- poly_prod(gf$p, gf$n, gf$xton, gf$poly[i,], sum1)
prod2 <- poly_prod(gf$p, gf$n, gf$xton, gf$poly[i,], gf$poly[j,])
prod3 <- poly_prod(gf$p, gf$n, gf$xton, gf$poly[i,], gf$poly[k,])
sum2 <- poly_sum(gf$p, gf$n, prod2, prod3)
expect_equal(prod1, sum2)
}
}
}
}
check_distributive(create_galois_field(3))
check_distributive(create_galois_field(4))
check_distributive(create_galois_field(9))
check_distributive(create_galois_field(8))
})
test_that("Roots", {
check_roots <- function(gf)
{
#gf <- create_galois_field(3)
for (i in 1:gf$q)
{
if (!is.na(gf$root[i])){
prod1 <- poly_prod(gf$p, gf$n, gf$xton, gf$poly[gf$root[i] + 1,], gf$poly[gf$root[i] + 1,])
expect_equal(gf$poly[i, ], prod1)
}
}
}
check_roots(create_galois_field(3))
check_roots(create_galois_field(4))
check_roots(create_galois_field(9))
check_roots(create_galois_field(8))
})
lhs/tests/testthat/test-geneticlhs.R 0000644 0001762 0000144 00000003013 13423214736 017271 0 ustar ligges users # Copyright 2019 Robert Carnell
context("test-geneticlhs")
test_that("geneticLHS works", {
expect_error(geneticLHS(-1, 2))
expect_error(geneticLHS(10, -30))
expect_error(geneticLHS(10, 2, -2))
expect_error(geneticLHS(NA, 2))
expect_error(geneticLHS(NaN, 2))
expect_warning(expect_error(geneticLHS(Inf, 2)))
expect_error(geneticLHS(10, NA))
expect_error(geneticLHS(10, NaN))
expect_warning(expect_error(geneticLHS(10, Inf)))
expect_error(geneticLHS(10, 2, NA))
expect_error(geneticLHS(10, 2, NaN))
expect_warning(expect_error(geneticLHS(10, 2, Inf)))
set.seed(1976)
expect_true(checkLatinHypercube(geneticLHS(4, 2)))
set.seed(1977)
expect_true(checkLatinHypercube(geneticLHS(3, 3, 6)))
expect_error(geneticLHS(10, 2, 4, -1))
expect_error(geneticLHS(10, 2, 4, 4, -.1))
expect_error(geneticLHS(10, 2, 4, 4, 1.1))
expect_error(geneticLHS(10, 2, 2, NA))
expect_error(geneticLHS(10, 2, 2, NaN))
expect_warning(expect_error(geneticLHS(10, 2, 2, Inf)))
#expect_error(geneticLHS(10, 2, 2, 4, NA))
#expect_error(geneticLHS(10, 2, 2, 4, NaN))
expect_error(geneticLHS(10, 2, 2, 4, Inf))
set.seed(1976)
expect_true(checkLatinHypercube(geneticLHS(20, 5, pop = 100, gen = 4,
pMut = 0.2, criterium = "S")))
capture_output(X <- .Call("geneticLHS_cpp", 1L, 4L, 10L, 4L, 0.01, "S", TRUE))
expect_equal(nrow(X), 1)
A <- geneticLHS(1, 4)
expect_equal(nrow(A), 1)
expect_true(checkLatinHypercube(A))
})
lhs/tests/testthat/test-optseededlhs.R 0000644 0001762 0000144 00000002626 13423214206 017630 0 ustar ligges users # Copyright 2019 Robert Carnell
context("test-optseededlhs")
test_that("optseededLHS works", {
expect_error(optSeededLHS(randomLHS(10, 4), NA))
expect_error(optSeededLHS(randomLHS(10, 4), NaN))
expect_error(optSeededLHS(randomLHS(10, 4), Inf))
expect_error(optSeededLHS(randomLHS(10, 4), 2, NA))
expect_error(optSeededLHS(randomLHS(10, 4), 2, NaN))
expect_warning(expect_error(optSeededLHS(randomLHS(10, 4), 2, Inf)))
expect_error(optSeededLHS(randomLHS(10, 4), 2, 5, NA))
expect_error(optSeededLHS(randomLHS(10, 4), 2, 5, NaN))
expect_error(optSeededLHS(randomLHS(10, 4), 2, 5, Inf))
temp <- randomLHS(10, 4)
temp[1,1] <- NA
expect_error(optSeededLHS(temp, 5))
temp <- randomLHS(10, 4)
temp[1,1] <- 2
expect_error(optSeededLHS(temp, 5))
set.seed(1976)
A <- optSeededLHS(randomLHS(4, 2), 2)
expect_true(checkLatinHypercube(A))
set.seed(1977)
B <- optSeededLHS(randomLHS(3, 3), 3, 3, .05)
expect_true(checkLatinHypercube(B))
A <- optSeededLHS(randomLHS(10, 4), m = 0)
expect_true(checkLatinHypercube(A))
expect_error(.Call("optSeededLHS_cpp", 3, 4L, 4L, 0.01, matrix(1L, 2, 2), FALSE))
X <- .Call("optSeededLHS_cpp", 1L, 4L, 4L, 0.01, matrix(runif(4), nrow = 1, ncol = 4), FALSE)
expect_equal(nrow(X), 1)
expect_true(checkLatinHypercube(X))
expect_error(.Call("optSeededLHS_cpp", 3L, 4L, 4L, 0.01, matrix(1L, 2, 2), FALSE))
})
lhs/tests/testthat/test-maximinlhs.R 0000644 0001762 0000144 00000005610 13423215572 017321 0 ustar ligges users # Copyright 2019 Robert Carnell
context("test-maximinlhs")
test_that("maximinLHS works", {
expect_error(maximinLHS(-1, 2))
expect_error(maximinLHS(10, -30))
expect_error(maximinLHS(10, 2, dup = -2))
expect_error(maximinLHS(NA, 2))
expect_error(maximinLHS(NaN, 2))
expect_warning(expect_error(maximinLHS(Inf, 2)))
expect_error(maximinLHS(10, NA))
expect_error(maximinLHS(10, NaN))
expect_warning(expect_error(maximinLHS(10, Inf)))
expect_error(maximinLHS(10, 2, dup = NA))
expect_error(maximinLHS(10, 2, dup = NaN))
expect_warning(expect_error(maximinLHS(10, 2, dup = Inf)))
set.seed(1976)
expect_true(checkLatinHypercube(maximinLHS(4, 2)))
set.seed(1977)
expect_true(checkLatinHypercube(maximinLHS(3, 3, dup = 5)))
expect_error(maximinLHS(10, 4, method = "none"))
expect_error(maximinLHS(10, 4, method = "build", optimize.on = "none"))
expect_warning(maximinLHS(10, 4, method = "build", optimize.on = "result"))
expect_error(maximinLHS(10, c(4,5), method = "iterative"))
expect_error(maximinLHS(10, NA, method = "iterative"))
expect_error(maximinLHS(10, Inf, method = "iterative"))
expect_error(maximinLHS(12.2, 4, method = "iterative"))
expect_error(maximinLHS(12, 4.3, method = "iterative"))
expect_error(maximinLHS(12, 4, dup = 10.2, method = "iterative"))
A <- maximinLHS(12, 4, dup = 10, method = "iterative", optimize.on = "result")
expect_true(checkLatinHypercube(A))
A <- maximinLHS(20, 5, dup = 3, method = "iterative", optimize.on = "grid")
expect_true(checkLatinHypercube(A))
A <- maximinLHS(1, 4)
expect_equal(nrow(A), 1)
expect_true(checkLatinHypercube(A))
})
test_that("maximinLHS works with expanded capability", {
expect_true(checkLatinHypercube(maximinLHS(4, 3, method = "build", dup = 2)))
expect_true(checkLatinHypercube(maximinLHS(4, 3, method = "iterative", eps = 0.05, maxIter = 100, optimize.on = "grid")))
expect_true(checkLatinHypercube(maximinLHS(4, 3, method = "iterative", eps = 0.05, maxIter = 100, optimize.on = "result")))
})
test_that("maximinLHS debug capability for code coverage", {
capture_output(X <- maximinLHS(10, 4, method = "build",
optimize.on = "grid", debug = TRUE))
expect_equal(nrow(X), 10)
expect_warning(capture_output(X <- maximinLHS(10, 4, method = "build",
optimize.on = "result", debug = TRUE)))
expect_equal(nrow(X), 10)
capture_output(X <- maximinLHS(10, 10, method = "iterative",
optimize.on = "result", eps = 1E-9, debug = TRUE))
expect_equal(nrow(X), 10)
capture_output(X <- maximinLHS(5, 5, method = "iterative",
optimize.on = "result", eps = 1, debug = TRUE))
expect_error(.Call("maximinLHS_cpp", 3, 4L, 4L))
X <- .Call("maximinLHS_cpp", 1L, 4L, 4L)
expect_equal(nrow(X), 1)
})
lhs/tests/testthat/test-improvedlhs.r 0000644 0001762 0000144 00000002277 13423215476 017555 0 ustar ligges users # Copyright 2019 Robert Carnell
context("test-improvedlhs")
test_that("improvedLHS works", {
expect_error(improvedLHS(-1, 2))
expect_error(improvedLHS(10, -30))
expect_error(improvedLHS(10, 2, -2))
expect_error(improvedLHS(NA, 2))
expect_error(improvedLHS(NaN, 2))
expect_warning(expect_error(improvedLHS(Inf, 2)))
expect_error(improvedLHS(10, NA, 2))
expect_error(improvedLHS(10, NaN, 2))
expect_warning(expect_error(improvedLHS(10, Inf, 2)))
expect_error(improvedLHS(10, 2, NA))
expect_error(improvedLHS(10, 2, NaN))
expect_warning(expect_error(improvedLHS(10, 2, Inf)))
set.seed(1976)
expect_true(checkLatinHypercube(improvedLHS(4, 2)))
set.seed(1977)
expect_true(checkLatinHypercube(improvedLHS(3, 3, 5)))
set.seed(1111)
A <- improvedLHS(20, 6)
set.seed(1111)
B <- improvedLHS(20, 6)
expect_true(all(A == B))
D <- improvedLHS(20, 6)
expect_true(any(A != D))
A <- improvedLHS(1, 4)
expect_equal(nrow(A), 1)
expect_true(checkLatinHypercube(A))
})
test_that("improvedLHS errors work", {
expect_error(.Call("improvedLHS_cpp", 3, 4L, 4L))
X <- .Call("improvedLHS_cpp", 1L, 4L, 4L)
expect_equal(nrow(X), 1)
})
lhs/tests/testthat/test-create_oalhs.R 0000644 0001762 0000144 00000002526 13420500406 017572 0 ustar ligges users # Copyright 2019 Robert Carnell
context("test-create_oalhs")
test_that("create_oalhs works", {
oalhs <- create_oalhs(9, 4, TRUE, FALSE)
expect_true(checkLatinHypercube(oalhs))
expect_equal(nrow(oalhs), 9)
expect_equal(ncol(oalhs), 4)
# ask for an achievable design
oalhs <- create_oalhs(4, 2, TRUE, FALSE)
expect_true(checkLatinHypercube(oalhs))
expect_equal(nrow(oalhs), 4)
expect_equal(ncol(oalhs), 2)
# ask for a design that needs more rows
oalhs <- create_oalhs(20, 3, TRUE, FALSE)
expect_true(checkLatinHypercube(oalhs))
expect_equal(nrow(oalhs), 25)
expect_equal(ncol(oalhs), 3)
# ask for a design but ask for less rows
oalhs <- create_oalhs(20, 3, FALSE, FALSE)
expect_true(checkLatinHypercube(oalhs))
expect_equal(nrow(oalhs), 18)
expect_equal(ncol(oalhs), 3)
oalhs <- create_oalhs(20, 10, TRUE, FALSE)
expect_true(checkLatinHypercube(oalhs))
expect_equal(nrow(oalhs), 54)
expect_equal(ncol(oalhs), 10)
# check repeatability
set.seed(1001)
X <- create_oalhs(9, 4, TRUE, FALSE)
set.seed(1001)
Y <- create_oalhs(9, 4, TRUE, FALSE)
expect_true(all(X == Y))
expect_error(.Call("create_oalhs", 3, 4L, FALSE, FALSE))
expect_error(.Call("create_oalhs", 3L, 4L, 5, FALSE))
expect_error(.Call("create_oalhs", 3L, as.integer(NA), FALSE, FALSE))
})
lhs/tests/testthat/test-augmentlhs.R 0000644 0001762 0000144 00000002473 13423214555 017323 0 ustar ligges users # Copyright 2019 Robert Carnell
context("test-augmentlhs")
test_that("augment works", {
expect_error(augmentLHS(randomLHS(10, 4), NA))
expect_error(augmentLHS(randomLHS(10, 4), NaN))
expect_error(augmentLHS(randomLHS(10, 4), Inf))
set.seed(1976)
temp <- randomLHS(10, 4)
temp[1,1] <- NA
expect_error(augmentLHS(temp, 5))
set.seed(1976)
temp <- randomLHS(10, 4)
temp[1,1] <- 2
expect_error(augmentLHS(temp, 5))
set.seed(1976)
expect_true(checkLatinHypercube(augmentLHS(randomLHS(4, 2), 4)))
set.seed(1977)
expect_true(checkLatinHypercube(augmentLHS(randomLHS(3, 3), 3)))
set.seed(1977)
expect_true(checkLatinHypercube(augmentLHS(randomLHS(4, 1), 2)))
# this test addresses a bug where an error ocurred on adding 1 row in
# augmentLHS
temp <- randomLHS(7, 2)
temp <- augmentLHS(temp, 1)
expect_equal(nrow(temp), 8)
expect_true(checkLatinHypercube(augmentLHS(randomLHS(7, 2), 7)))
expect_true(checkLatinHypercube(augmentLHS(randomLHS(10, 5), 10)))
# test exceptions
expect_error(augmentLHS(c(1,2), 5))
expect_error(augmentLHS(randomLHS(10,3), c(5,9)))
expect_error(augmentLHS(randomLHS(10,3), -1))
expect_error(augmentLHS(randomLHS(10,3), 2.2))
A <- augmentLHS(randomLHS(1,4), 1)
expect_true(checkLatinHypercube(A))
})
lhs/tests/testthat/helper-lhs.R 0000644 0001762 0000144 00000002060 13753062737 016243 0 ustar ligges users # Copyright 2019 Robert Carnell
checkLatinHypercube <- function(X)
{
if (any(apply(X, 2, min) <= 0))
return(FALSE)
if (any(apply(X, 2, max) >= 1))
return(FALSE)
if (any(is.na(X)))
return(FALSE)
# check that the matrix is a latin hypercube
g <- function(Y)
{
# check that this column contains all the cells
breakpoints <- seq(0, 1, length = length(Y) + 1)
h <- hist(Y, plot = FALSE, breaks = breakpoints)
all(h$counts == 1)
}
# check all the columns
return(all(apply(X, 2, g)))
}
checkOA <- function(X)
{
# check that the matrix is an orthogonal array
Y <- t(X) %*% X
all(abs(Y[upper.tri(Y)]) < 1E-9)
}
encodeOA <- function(X, n)
{
assertthat::assert_that(n > 1 & is.integer(n),
msg = "n must be an integer > 1")
if (n == 2)
{
# 0, 1 => -1, 1
X <- X*2 - 1
} else if (n == 3)
{
# 0, 1, 2 => -1, 0, 1
X <- X - 1
} else if (n == 4)
{
# 0, 1, 2, 3 => -1, -1/3, 1/3, 1
X <- X * 2 / 3 - 1
} else if (n > 4)
{
X <- X * 2 / (n - 1) - 1
}
return(X)
}
lhs/tests/testthat/test-randomlhs.r 0000644 0001762 0000144 00000005057 13734227456 017215 0 ustar ligges users # Copyright 2019 Robert Carnell
context("test-randomlhs")
test_that("randomLHS works", {
A <- randomLHS(4,2)
expect_true(all(A > 0 & A < 1))
expect_equal(4, nrow(A))
expect_equal(2, ncol(A))
expect_true(checkLatinHypercube(A))
# doubles are truncated in n and k
A <- randomLHS(4.4, 2)
expect_true(all(A > 0 & A < 1))
expect_equal(4, nrow(A))
expect_equal(2, ncol(A))
expect_true(checkLatinHypercube(A))
A <- randomLHS(4, 2.8)
expect_true(all(A > 0 & A < 1))
expect_equal(4, nrow(A))
expect_equal(2, ncol(A))
expect_true(checkLatinHypercube(A))
A <- randomLHS(4.4, 2.8)
expect_true(all(A > 0 & A < 1))
expect_equal(4, nrow(A))
expect_equal(2, ncol(A))
expect_true(checkLatinHypercube(A))
expect_error(randomLHS(-1, 2))
expect_error(randomLHS(10, -30))
expect_error(randomLHS(NA, 2))
expect_error(randomLHS(NaN, 2))
expect_warning(expect_error(randomLHS(Inf, 2)))
expect_error(randomLHS(10, NA))
expect_error(randomLHS(10, NaN))
expect_warning(expect_error(randomLHS(10, Inf)))
A <- randomLHS(1, 5)
expect_equal(1, nrow(A))
expect_equal(5, ncol(A))
expect_true(checkLatinHypercube(A))
expect_error(randomLHS(c(1,2,3), c(3,4)))
expect_error(randomLHS(-1, 2, preserveDraw = TRUE))
expect_error(randomLHS(10, -30, preserveDraw = TRUE))
expect_error(randomLHS(NA, 2, preserveDraw = TRUE))
expect_error(randomLHS(NaN, 2, preserveDraw = TRUE))
expect_warning(expect_error(randomLHS(Inf, 2, preserveDraw = TRUE)))
expect_error(randomLHS(10, NA, preserveDraw = TRUE))
expect_error(randomLHS(10, NaN, preserveDraw = TRUE))
expect_warning(expect_error(randomLHS(10, Inf, preserveDraw = TRUE)))
A <- randomLHS(4, 2, preserveDraw = TRUE)
expect_true(all(A > 0 & A < 1))
expect_true(checkLatinHypercube(A))
set.seed(4)
A <- randomLHS(5, 3, preserveDraw = TRUE)
set.seed(4)
B <- randomLHS(5, 5, preserveDraw = TRUE)
expect_equal(A, B[,1:3], tolerance = 1E-12)
expect_true(checkLatinHypercube(A))
expect_true(checkLatinHypercube(B))
expect_error(.Call("randomLHS_cpp", 3, 4L, FALSE))
})
test_that("degenerate LHS problem is fixed", {
A <- randomLHS(1, 3)
expect_true(checkLatinHypercube(A))
})
# in version 1.0.1 and prior, this did not necessarily cause a segfault
# in all attempts. It was a relatively random occurence
test_that("Segfault does not occur with gctorture", {
for (i in 1:20)
{
gctorture(TRUE)
A <- randomLHS(10, 4)
gctorture(FALSE)
}
expect_true(checkLatinHypercube(A))
})
lhs/tests/testthat/test-createoa.R 0000644 0001762 0000144 00000012267 13753062737 016752 0 ustar ligges users # Copyright 2019 Robert Carnell
context("test-createoa")
test_that("createBose works", {
B <- createBose(2, 3, FALSE)
expect_true(checkOA(encodeOA(B, 2L)))
B <- createBose(3, 4, FALSE)
expect_true(checkOA(encodeOA(B, 3L)))
B <- createBose(3, 3)
expect_equal(nrow(B), 3^2)
expect_equal(ncol(B), 3)
B <- createBose(3, 4)
expect_equal(nrow(B), 3^2)
expect_equal(ncol(B), 4)
B <- createBose(5, 4)
expect_equal(nrow(B), 5^2)
expect_equal(ncol(B), 4)
expect_error(.Call("oa_type1", "bose", 3, 3L, FALSE))
expect_error(.Call("oa_type1", 0, 3L, 3L, FALSE))
expect_error(.Call("oa_type1", "bose", c(3L, 4L), 3L, FALSE))
expect_error(.Call("oa_type1", "bose", as.integer(NA), 3L, FALSE))
expect_error(.Call("oa_type1", "bob", 3L, 3L, FALSE))
})
test_that("createBoseBush works", {
B <- createBoseBush(2, 4, FALSE)
expect_true(checkOA(encodeOA(B, 2L)))
B <- createBoseBush(4, 8, FALSE)
expect_true(checkOA(encodeOA(B, 4L)))
B <- createBoseBush(4, 5)
expect_equal(nrow(B), 2*4^2)
expect_equal(ncol(B), 5)
B <- createBoseBush(4, 4)
expect_equal(nrow(B), 2*4^2)
expect_equal(ncol(B), 4)
B <- createBoseBush(8, 3)
expect_equal(nrow(B), 2*8^2)
expect_equal(ncol(B), 3)
expect_warning({
B <- createBoseBush(8, 17)
})
expect_equal(nrow(B), 2*8^2)
expect_equal(ncol(B), 17)
expect_true(checkOA(encodeOA(B, 8L)))
expect_error({
B <- createBoseBush(8, 18)
})
})
test_that("createBush works", {
B <- createBush(3, 3, FALSE)
expect_true(checkOA(encodeOA(B, 3L)))
B <- createBush(4, 5, FALSE)
expect_true(checkOA(encodeOA(B, 4L)))
B <- createBush(3, 3)
expect_equal(nrow(B), 3^3)
expect_equal(ncol(B), 3)
expect_true(checkOA(encodeOA(B, 3L)))
B <- createBush(3, 4)
expect_equal(nrow(B), 3^3)
expect_equal(ncol(B), 4)
expect_true(checkOA(encodeOA(B, 3L)))
B <- createBush(5, 4)
expect_equal(nrow(B), 5^3)
expect_equal(ncol(B), 4)
expect_true(checkOA(encodeOA(B, 5L)))
expect_warning({
B <- createBush(2, 3)
})
expect_equal(nrow(B), 2^3)
expect_equal(ncol(B), 3)
expect_true(checkOA(encodeOA(B, 2L)))
expect_error({
B <- createBush(2, 4)
})
})
test_that("createAddelKemp works", {
B <- createAddelKemp(2, 4, FALSE)
expect_true(checkOA(encodeOA(B, 2L)))
B <- createAddelKemp(3, 6, FALSE)
expect_true(checkOA(encodeOA(B, 3L)))
B <- createAddelKemp(4, 5)
expect_equal(nrow(B), 2*4^2)
expect_equal(ncol(B), 5)
B <- createAddelKemp(4, 4)
expect_equal(nrow(B), 2*4^2)
expect_equal(ncol(B), 4)
B <- createAddelKemp(5, 3)
expect_equal(nrow(B), 2*5^2)
expect_equal(ncol(B), 3)
expect_warning({
B <- createAddelKemp(q = 3^1, ncol = 2*3 + 1, bRandom = FALSE)
}, regexp = "Warning:")
expect_true(checkOA(encodeOA(B, 3L)))
expect_equal(7, ncol(B))
expect_equal(18, nrow(B))
})
test_that("createAddelKemp3 works", {
B <- createAddelKemp3(2, 13, FALSE)
expect_true(checkOA(encodeOA(B, 2L)))
B <- createAddelKemp3(3, 25, FALSE)
expect_true(checkOA(encodeOA(B, 3L)))
B <- createAddelKemp3(4, 5)
expect_equal(nrow(B), 2*4^3)
expect_equal(ncol(B), 5)
B <- createAddelKemp3(4, 4)
expect_equal(nrow(B), 2*4^3)
expect_equal(ncol(B), 4)
B <- createAddelKemp3(5, 3)
expect_equal(nrow(B), 2*5^3)
expect_equal(ncol(B), 3)
})
test_that("createBusht works", {
B <- createBusht(3, 4, 2, FALSE)
expect_true(checkOA(encodeOA(B, 3L)))
B <- createBusht(3, 4, 3, FALSE)
expect_true(checkOA(encodeOA(B, 3L)))
expect_error(.Call("oa_type2", "busht", 3, 4L, 3L, FALSE))
expect_error(.Call("oa_type2", 0, 3L, 4L, 3L, FALSE))
expect_error(.Call("oa_type2", "busht", c(3L, 4L), 4L, 3L, FALSE))
expect_error(.Call("oa_type2", "busht", as.integer(NA), 4L, 3L, FALSE))
expect_error(.Call("oa_type2", "bosebushl", as.integer(NA), 4L, 3L, FALSE))
expect_error(.Call("oa_type2", "addelkempn", as.integer(NA), 4L, 3L, FALSE))
expect_error(.Call("oa_type2", "bob", as.integer(NA), 4L, 3L, FALSE))
expect_error(.Call("oa_type2", "bob", 3L, 4L, 3L, FALSE))
X <- .Call("oa_type2", "busht", 3L, 4L, 3L, TRUE)
expect_equal(nrow(X), 64)
})
test_that("createBoseBushl works", {
B <- createBoseBushl(3, 5, 3, FALSE)
expect_true(checkOA(encodeOA(B, 3L)))
B <- createBoseBushl(4, 4, 16, FALSE)
expect_true(checkOA(encodeOA(B, 4L)))
B <- createBoseBushl(q = 2^2, ncol = 2*2^2, lambda = 2, bRandom = FALSE)
expect_true(checkOA(encodeOA(B, 4L)))
expect_warning({
B <- createBoseBushl(q = 2^2, ncol = 2*2^2 + 1, lambda = 2, bRandom = FALSE)
}, regexp = "Warning:")
expect_true(checkOA(encodeOA(B, 4L)))
expect_equal(9, ncol(B))
expect_equal(32, nrow(B))
expect_warning({
B <- createBoseBushl(q = 3^1, ncol = 3*3 + 1, lambda = 3, bRandom = FALSE)
}, regexp = "Warning:")
expect_true(checkOA(encodeOA(B, 3L)))
expect_equal(10, ncol(B))
expect_equal(27, nrow(B))
})
test_that("createAddelKempN works", {
B <- createAddelKempN(2, 3, 3, FALSE)
expect_true(checkOA(encodeOA(B, 2L)))
B <- createAddelKempN(3, 4, 4, FALSE)
expect_true(checkOA(encodeOA(B, 3L)))
# These two tests were failing prior to lhs 1.1
B <- createAddelKempN(3, 5, 3, FALSE)
expect_true(checkOA(encodeOA(B, 3L)))
B <- createAddelKempN(3, 25, 3, FALSE)
expect_true(checkOA(encodeOA(B, 3L)))
})
lhs/tests/testthat/test-get_library_versions.R 0000644 0001762 0000144 00000000236 13754762666 021424 0 ustar ligges users test_that("get_library_versions", {
a <- get_library_versions()
expect_true(is.character(a))
expect_equal(1, length(a))
expect_true(nchar(a) > 10)
})
lhs/tests/testthat/test-oa_to_oalhs.R 0000644 0001762 0000144 00000005252 13425356377 017454 0 ustar ligges users # Copyright 2019 Robert Carnell
context("test-oa_to_oalhs")
test_that("oa_to_oalhs works with internal oa generation", {
oa <- createBose(3, 4, TRUE)
oalhs <- oa_to_oalhs(9, 4, oa)
expect_true(checkLatinHypercube(oalhs))
oa <- createBose(3, 4, FALSE)
oalhs <- oa_to_oalhs(9, 4, oa)
expect_true(checkLatinHypercube(oalhs))
oa <- createBoseBush(8, 5, TRUE)
oalhs <- oa_to_oalhs(128, 5, oa)
expect_true(checkLatinHypercube(oalhs))
# check a mismatch in n causes an error
expect_error(oa_to_oalhs(3, 5, oa))
# check a mismatch in k causes an error
expect_error(oa_to_oalhs(128, 8, oa))
# check a wrong sized oa causes an error
expect_error(oa_to_oalhs(128, 5, oa[1:100,1:3]))
# check wrong type
expect_error(oa_to_oalhs(3, 5, matrix(1.2, nrow = 3, ncol = 5)))
oa <- createAddelKemp(3, 4, FALSE)
oalhs <- oa_to_oalhs(18, 4, oa)
expect_true(checkLatinHypercube(oalhs))
oa <- createAddelKemp3(4, 20, TRUE)
oalhs <- oa_to_oalhs(128, 20, oa)
expect_true(checkLatinHypercube(oalhs))
expect_error(.Call("oa_to_lhs", 4, 20L, oa, FALSE))
expect_error(.Call("oa_to_lhs", 4L, 20L, oa, 5))
expect_error(.Call("oa_to_lhs", as.integer(NA), 20L, oa, FALSE))
})
test_that("oa_to_oalhs works with DoE.base", {
# note: trying to ensure that a lack of DoE.base does not break the tests
# also trying to avoid attaching the DoE.base package because it causes warnings in the test suite
testthat::skip_if_not_installed("DoE.base")
# 12 rows, two columns of 1,2 and one column of 1:6
my_oa <- DoE.base::oa.design(ID = DoE.base::L12.2.2.6.1)
oalhs <- oa_to_oalhs(12, 3, my_oa)
expect_true(checkLatinHypercube(oalhs))
# 20 rows, 19 columns of 1,2
my_oa <- DoE.base::oa.design(ID = DoE.base::L20.2.19)
oalhs <- oa_to_oalhs(20, 19, my_oa)
expect_true(checkLatinHypercube(oalhs))
# can I get the oa back?
#c(ifelse(floor(oalhs*20) < 20/2, 1, 2)) == as.integer(as.matrix(my_oa))
# can I verify that the oalhs is an oa?
temp <- t(ifelse(floor(oalhs*20) < 20/2, -1, 1)) %*% ifelse(floor(oalhs*20) < 20/2, -1, 1)
expect_true(all(temp[upper.tri(temp)] == 0))
# 20 rows, 19 columns of 1,2
my_oa <- DoE.base::oa.design(ID = DoE.base::L9.3.4)
oalhs <- oa_to_oalhs(9, 4, my_oa)
expect_true(checkLatinHypercube(oalhs))
# can I verify that the oalhs is an oa?
temp1 <- ifelse(floor(oalhs*9) < 9/3, -1, ifelse(floor(oalhs*9) < 2*9/3, 0, 1))
temp <- t(temp1) %*% temp1
expect_true(all(temp[upper.tri(temp)] == 0))
})
test_that("Edge cases", {
A <- matrix(1L, nrow = 1, ncol = 4)
B <- oa_to_oalhs(1, 4, A)
expect_equal(nrow(B), 1)
expect_true(checkLatinHypercube(B))
})
lhs/tests/testthat/test-optaugmentlhs.R 0000644 0001762 0000144 00000002033 13423216603 020032 0 ustar ligges users # Copyright 2019 Robert Carnell
context("test-optaugmentlhs")
test_that("optAugmentLHS works", {
expect_error(optAugmentLHS(randomLHS(10, 4), NA))
expect_error(optAugmentLHS(randomLHS(10, 4), NaN))
expect_error(optAugmentLHS(randomLHS(10, 4), Inf))
expect_error(optAugmentLHS(randomLHS(10, 4), 2, NA))
expect_error(optAugmentLHS(randomLHS(10, 4), 2, NaN))
expect_error(optAugmentLHS(randomLHS(10, 4), 2, Inf))
temp <- randomLHS(10, 4)
temp[1,1] <- NA
expect_error(optAugmentLHS(temp, 5))
temp <- randomLHS(10, 4)
temp[1,1] <- 2
expect_error(optAugmentLHS(temp, 5))
set.seed(1976)
expect_true(checkLatinHypercube(optAugmentLHS(randomLHS(4, 2), 2)))
set.seed(1977)
expect_true(checkLatinHypercube(optAugmentLHS(randomLHS(3, 3), 3, 3)))
expect_error(optAugmentLHS(c(1,2), m = 4, mult = 2))
expect_error(optAugmentLHS(randomLHS(10, 4), c(1,2)))
expect_error(optAugmentLHS(randomLHS(10, 4), -2))
A <- optAugmentLHS(randomLHS(1,4), 1)
expect_true(checkLatinHypercube(A))
})
lhs/tests/testthat/test-optimumlhs.R 0000644 0001762 0000144 00000003552 13423217051 017346 0 ustar ligges users # Copyright 2019 Robert Carnell
context("test-optimumlhs")
test_that("optimumLHS works", {
expect_error(optimumLHS(-1, 2))
expect_error(optimumLHS(10, -30))
expect_error(optimumLHS(10, 2, -2))
expect_error(optimumLHS(10, 2, 3, -1))
expect_error(optimumLHS(10, 2, 3, 1.5))
expect_error(optimumLHS(10, 2, 3, 1))
expect_error(optimumLHS(10, 2, 3, 0))
expect_error(optimumLHS(NA, 2))
expect_error(optimumLHS(NaN, 2))
expect_warning(expect_error(optimumLHS(Inf, 2)))
expect_error(optimumLHS(10, NA))
expect_error(optimumLHS(10, NaN))
expect_warning(expect_error(optimumLHS(10, Inf)))
expect_error(optimumLHS(10, 2, NA))
expect_error(optimumLHS(10, 2, NaN))
expect_warning(expect_error(optimumLHS(10, 2, Inf)))
expect_error(optimumLHS(10, 2, 2, NA))
expect_error(optimumLHS(10, 2, 2, NaN))
expect_error(optimumLHS(10, 2, 2, Inf))
set.seed(1976)
rTemp <- optimumLHS(4, 2)
expect_true(checkLatinHypercube(rTemp))
set.seed(1977)
rTemp <- optimumLHS(3, 3, 5)
expect_true(checkLatinHypercube(rTemp))
set.seed(1978)
rTemp <- optimumLHS(5, 2, 5, .5)
expect_true(checkLatinHypercube(rTemp))
set.seed(2010)
for (i in 2:6)
{
for (j in 2:6)
{
A <- optimumLHS(i, j)
expect_true(checkLatinHypercube(A))
}
}
set.seed(2011)
for (i in 2:6)
{
for (j in 2:6)
{
A <- optimumLHS(i, j, 5)
expect_true(checkLatinHypercube(A))
}
}
set.seed(2012)
for (i in 2:6)
{
for (j in 2:6)
{
A <- optimumLHS(i, j, 5, 0.05)
expect_true(checkLatinHypercube(A))
}
}
expect_error(.Call("optimumLHS_cpp", 3, 4L, 4L, 0.01, FALSE))
X <- .Call("optimumLHS_cpp", 1L, 4L, 4L, 0.01, FALSE)
expect_equal(nrow(X), 1)
A <- optimumLHS(1, 4)
expect_equal(nrow(A), 1)
expect_true(checkLatinHypercube(A))
})
lhs/tests/testthat.R 0000644 0001762 0000144 00000000066 13415250176 014173 0 ustar ligges users library(testthat)
library(lhs)
test_check("lhs")
lhs/src/ 0000755 0001762 0000144 00000000000 14347415524 011640 5 ustar ligges users lhs/src/ak.h 0000644 0001762 0000144 00000007237 14215223423 012402 0 ustar ligges users /**
* @file ak.h
* @author Robert Carnell
* @copyright Copyright (c) 2013, Robert Carnell
*
* License: This file may be freely used and shared according to the original license.
*
* Reference:
*
*
* Original Header:
*
* These programs construct and manipulate orthogonal arrays. They were prepared by
*
* - Art Owen
* - Department of Statistics
* - Sequoia Hall
* - Stanford CA 94305
*
* They may be freely used and shared. This code comes
* with no warranty of any kind. Use it at your own
* risk.
*
* I thank the Semiconductor Research Corporation and
* the National Science Foundation for supporting this
* work.
*
*/
#ifndef AK_H
#define AK_H
#include "OACommonDefines.h"
#include "GaloisField.h"
#include "primes.h"
#include "matrix.h"
namespace oacpp {
/**
* Addelkemp class
*/
namespace oaaddelkemp
{
/**
* Check that the parameters of the addelkemp3 algorithm are consistent
* (ncol <= 2q^2+2q+1
*
* @param q the order of the Galois field or the number of symbols
* @param p the prime basis of the Galois field
* @param ncol the number of columns
* @return an indicator of success
*/
int addelkemp3check(int q, int p, int ncol);
/**
* Addelkemp algorithm for even p
*
* @param gf a Galois field
* @param kay the number of columns
* @param b original Addelkemp variable
* @param c original Addelkemp variable
* @param k original Addelkemp variable
* @return an indicator of success
*/
int akeven(GaloisField & gf, int* kay, std::vector & b, std::vector & c, std::vector & k);
/**
* Addelkemp algorithm for odd p
*
* @param gf a Galois field object
* @param kay the number of columns
* @param b original Addelkemp variable
* @param c original Addelkemp variable
* @param k original Addelkemp variable
* @return an indicator of success
*/
int akodd(GaloisField & gf, int* kay, std::vector & b, std::vector & c, std::vector & k);
/**
* Check that the parameters are consistent for the addelkempn algorithm
*
* @param q the order of Galois field or the number of symbols
* @param p the prime basis of the Galois field
* @param akn the akn
algorithm produces OA(2q^n,ncol,q,2)
* @param ncol the number of columns
* @return an indicator of success
* @throws runtime_exception
*/
void addelkempncheck(int q, int p, int akn, int ncol);
/**
* The addelkemp algorithm for general n to produce OA(2q^n,ncol,q,2)
*
* @param gf a Galois Field
* @param akn the akn
algorithm produces OA(2q^n,ncol,q,2)
* @param A the orthogonal array
* @param ncol the number of columns
* @return an indicator of success
*/
int addelkempn(GaloisField & gf, int akn, bclib::matrix & A, int ncol);
/**
* The addelkemp algorithm for n=3
*
* @param gf galois field
* @param A the orthogonal array
* @param ncol the number of columns
* @return an indicator of success
*/
int addelkemp3(GaloisField & gf, bclib::matrix & A, int ncol );
}
}
#endif
lhs/src/lhs_r.h 0000644 0001762 0000144 00000011073 13753062737 013126 0 ustar ligges users /**
* @file lhs_r.h
* @author Robert Carnell
* @copyright Copyright (c) 2013, Robert Carnell
*
* @license GNU General Public License (GPL v3)
* This program is free software: you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation, either version 3 of the License, or
* (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program. If not, see .
*/
#ifndef LHS_R_H
#define LHS_R_H
#include
#include "LHSCommonDefines.h"
#include "lhs_r_utilities.h"
#include "RStandardUniform.h"
#include "bclibVersion.h"
#include "oalibVersion.h"
#include "lhslibVersion.h"
/**
* Improved Latin hypercube sample algorithm
* @param n (IntegerVector length 1) number of rows / samples in the lhs
* @param k (IntegerVector length 1) number parameters / columns in the lhs
* @param dup (IntegerVector length 1) A factor that determines the number of candidate points used in the search.
* @return (NumericMatrix dim n x k) an lhs
*/
RcppExport SEXP improvedLHS_cpp(SEXP n, SEXP k, SEXP dup);
/**
* Latin hypercube sample algorithm using the maximin algorithm
* @param n (IntegerVector length 1) number of rows / samples in the lhs
* @param k (IntegerVector length 1) number parameters / columns in the lhs
* @param dup (IntegerVector length 1) A factor that determines the number of candidate points used in the search.
* @return (NumericMatrix dim n x k) an lhs
*/
RcppExport SEXP maximinLHS_cpp(SEXP n, SEXP k, SEXP dup);
/**
* Optimal Latin hypercube sample algorithm
* @param n (IntegerVector length 1) number of rows / samples in the lhs
* @param k (IntegerVector length 1) number parameters / columns in the lhs
* @param maxsweeps (IntegerVector length 1) the maximum number of sweeps to use in the algorithm
* @param eps (NumericVector length 1) The optimal stopping criterion
* @param bVerbose (LogicalVector length 1) should messages be printed
* @return (NumericMatrix dim n x k) an lhs
*/
RcppExport SEXP optimumLHS_cpp(SEXP n, SEXP k, SEXP maxsweeps, SEXP eps,
SEXP bVerbose);
/**
* Optimum Latin hypercube sample with a seed sample
* @param n (IntegerVector length 1) number of rows / samples in the lhs
* @param k (IntegerVector length 1) number parameters / columns in the lhs
* @param maxsweeps (IntegerVector length 1) the maximum number of sweeps to use in the algorithm
* @param eps (NumericVector length 1) The optimal stopping criterion
* @param pOld (NumericMatrix dim n x k) a seed matrix
* @param bVerbose (LogicalVector length 1) should messages be printed?
* @return (NumericMatrix dim n x k) an lhs
*/
RcppExport SEXP optSeededLHS_cpp(SEXP n, SEXP k, SEXP maxsweeps, SEXP eps,
SEXP pOld, SEXP bVerbose);
/**
* a simple random Latin hypercube sample
* @param n (IntegerVector length 1) number of rows / samples in the lhs
* @param k (IntegerVector length 1) number parameters / columns in the lhs
* @param preserveDraw (LogicalVector length 1) should be same draw be taken regardless of the number of parameters selected
* @return (NumericMatrix dim n x k) an lhs
*/
RcppExport SEXP randomLHS_cpp(SEXP n, SEXP k, SEXP preserveDraw);
/**
* A Latin hypercube sample using a genetic algorithm
* @param n (IntegerVector length 1) number of rows / samples in the lhs
* @param k (IntegerVector length 1) number parameters / columns in the lhs
* @param pop (IntegerVector length 1) the number of designs in the initial population
* @param gen (IntegerVector length 1) the number of generations over which the algorithm is applied
* @param pMut (NumericVector length 1) The probability with which a mutation occurs in a column of the progeny
* @param criterium (NumericVector length 1) The optimality criterium of the algorithm. Default is S. Maximin is also supported
* @param bVerbose (LogicalVector length 1) Print informational messages
* @return (NumericMatrix dim n x k) an lhs
*/
RcppExport SEXP geneticLHS_cpp(SEXP n, SEXP k, SEXP pop, SEXP gen, SEXP pMut,
SEXP criterium, SEXP bVerbose);
/**
* Get the versions of the bclib, oa, and lhslib C++ libraries
* @return String of version information
*/
RcppExport SEXP get_library_versions();
#endif /* LHS_R_H */
lhs/src/utilityLHS.h 0000644 0001762 0000144 00000030757 14215223423 014064 0 ustar ligges users /**
* @file utilityLHS.h
* @author Robert Carnell
* @copyright Copyright (c) 2022, Robert Carnell
*
* License GNU Lesser General Public License (LGPL v3)
* This program is free software: you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, either version 3 of the License, or
* (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public License
* along with this program. If not, see .
*/
#ifndef UTILITYLHS_H
#define UTILITYLHS_H
#include "LHSCommonDefines.h"
namespace lhslib
{
/**
* is the Latin hypercube sample valid
* @param result the latin hypercube sample with integer values
* @return the result of the validity check
*/
bool isValidLHS(const bclib::matrix & result);
/**
* is the Latin hypercube sample valid?
* @param result the latin hypercube sample
* @return the result of the validity check
*/
bool isValidLHS(const bclib::matrix & result);
/**
* rank a vector of objects
* @param toRank the vector of objects to rank
* @param ranks the ranks of the vector of values
* @tparam the type of element in the vectors
*/
template
void rank(const std::vector & toRank, std::vector & ranks)
{
if (toRank.size() != ranks.size())
{
ranks.resize(toRank.size(), 0);
}
typename std::vector::const_iterator toRank_it1;
typename std::vector::const_iterator toRank_it2;
std::vector::iterator ranks_it;
for (toRank_it1 = toRank.begin(), ranks_it = ranks.begin();
toRank_it1 != toRank.end() && ranks_it != ranks.end();
++toRank_it1, ++ranks_it)
{
*ranks_it = 0;
for (toRank_it2 = toRank.begin(); toRank_it2 != toRank.end(); ++toRank_it2)
{
if (*toRank_it1 < *toRank_it2)
{
(*ranks_it)++;
}
}
}
}
/**
* Initialize the matrix of available points
* @param avail the matrix of available points
*/
void initializeAvailableMatrix(bclib::matrix & avail);
/**
* print the Latin hypercube sample
* @param A the matrix to print
* @tparam T the type of matrix to print
*/
template
void lhsPrint(const bclib::matrix & A)
{
PRINT_MACRO << "\n";
msize_type cols = A.colsize();
msize_type rows = A.rowsize();
for (msize_type irow = 0; irow < rows; irow++)
{
for (msize_type jcol = 0; jcol < cols; jcol++)
{
PRINT_MACRO << A(irow, jcol) << ", ";
}
PRINT_MACRO << "\n";
}
}
/**
* calculate the squared distance between two values.
* @tparam T the type of values for the Arg1, Arg2, and return
*/
template
struct squareDifference
{
/**
* Calculate the squared distance between two values
* @param x Arg1
* @param y Arg2
* @return the (x-y)*(x-y)
*/
T operator()(const T & x, const T & y) const
{
return (x-y) * (x-y);
}
};
/**
* Calculate the total squared distance between two vectors
* @param A the first vector
* @param B the second vector
* @tparam T the type of the objects in the vector
* @return the total squared distance
*/
template
T calculateDistanceSquared(const std::vector & A, const std::vector & B)
{
if (A.size() != B.size())
{
throw std::runtime_error("Inputs of a different size");
}
// sum = sum + (a-b)*(a-b)
T sum = std::inner_product(A.begin(), A.end(), B.begin(), static_cast(0), std::plus(), squareDifference());
return sum;
}
/**
* Calculate the distance squared between two sequence of numbers
*
* this was primarily implemented to be able to calculate distances between rows
* of a matrix without having to copy those rows out
*
* @param Abegin the beginning of the first iterator
* @param Aend the end of the first iterator
* @param Bbegin the beginning of the second iterator
* @tparam T the type of object de-referenced by the iterator
* @tparam ISROWWISE a boolean to indicate if the iterator operates row-wise in the matrix
* @return the distance squared
*/
template
T calculateDistanceSquared(const typename bclib::matrixConstIter Abegin,
const typename bclib::matrixConstIter Aend,
const typename bclib::matrixConstIter Bbegin)
{
// sum = sum + (a-b)*(a-b)
T sum = std::inner_product(Abegin, Aend, Bbegin, static_cast(0), std::plus(), squareDifference());
return sum;
}
/**
* Calculate the distance between the rows of a matrix
* @param mat the matrix to calculate distances on
* @param result the matrix to hold the results of the calculation
* @tparam T the type of object in the matrix
*/
template
void calculateDistance(const bclib::matrix & mat, bclib::matrix & result)
{
msize_type m_rows = mat.rowsize();
if (result.rowsize() != m_rows || result.colsize() != m_rows)
{
result = bclib::matrix(m_rows, m_rows);
}
for (msize_type i = 0; i < m_rows - 1; i++)
{
for (msize_type j = i+1; j < m_rows; j++)
{
typename bclib::matrix::const_rowwise_iterator rowi_begin = mat.rowwisebegin(i);
typename bclib::matrix::const_rowwise_iterator rowi_end = mat.rowwiseend(i);
typename bclib::matrix::const_rowwise_iterator rowj_begin = mat.rowwisebegin(j);
T sum = calculateDistanceSquared(rowi_begin, rowi_end, rowj_begin);
result(i,j) = sqrt(static_cast(sum));
}
}
}
/**
* A function to invert a number in a STL algorithm
* @tparam T the type of number to invert
* @tparam W the type of the result. (normally a double or float)
*/
template
struct invert
{
/**
* A function to invert a number
* @param x the object to invert
* @return the inverse of x
*/
W operator()(const T & x) const
{
if (x != static_cast(0))
{
return 1.0 / static_cast(x);
}
else
{
return static_cast(x);
}
}
};
/**
* sum of the inverse distance between points in a matrix
* @param A the matrix
* @tparam T the type of object contained in the matrix
* @return the sum of the inverse distance between points
*/
template
double sumInvDistance(const bclib::matrix & A)
{
// create a matrix to hold the distances
bclib::matrix dist = bclib::matrix(A.rowsize(), A.rowsize());
// calculate the distances between the rows of A
calculateDistance(A, dist);
// invert all the distances
std::transform::iterator>(dist.begin(), dist.end(),
dist.begin(), invert());
// sum the inverted
double totalInvDistance = std::accumulate::iterator>(dist.begin(), dist.end(), 0.0);
return totalInvDistance;
}
/**
* Sum of the inverse distance between points
* @param A the matrix to sum
* @tparam T the type of object in the matrix
* @return the sum of the inverse distance between points
*/
template
double sumInvDistance_deprecated(const bclib::matrix & A)
{
msize_type nr = A.rowsize();
msize_type nc = A.colsize();
T oneDistance;
T diff;
double totalInvDistance = 0.0;
/* iterate the row of the first point from 0 to N-2 */
for (msize_type irow = 0; irow < nr - 1; irow++)
{
/* iterate the row the second point from i+1 to N-1 */
for (msize_type jrow = (irow + 1); jrow < nr; jrow++)
{
oneDistance = static_cast(0);
/* iterate through the columns, summing the squared differences */
for (msize_type kcol = 0; kcol < nc; kcol++)
{
/* calculate the square of the difference in one dimension between the
* points */
diff = A(irow,kcol) - A(jrow,kcol);
oneDistance += diff * diff;
}
/* sum the inverse distances */
if (oneDistance != 0)
{
totalInvDistance += (1.0 / sqrt(static_cast(oneDistance)));
}
}
}
return totalInvDistance;
}
/**
* Copy a matrix
* @param copyTo the matrix to copy to
* @param copyFrom the matrix to copy from
* @tparam the type of object contained in the matrix
*/
template
void copyMatrix(bclib::matrix & copyTo, const bclib::matrix & copyFrom)
{
if (copyFrom.rowsize() != copyTo.rowsize() ||
copyFrom.colsize() != copyTo.colsize() ||
copyFrom.isTransposed() != copyTo.isTransposed())
{
throw std::runtime_error("Matrices are not compatible for a copy");
}
std::copy::const_iterator, typename bclib::matrix::iterator>(copyFrom.begin(), copyFrom.end(), copyTo.begin());
}
/**
* Calculate the S optimality measure
* @param mat the matrix to calculate S optimality for
* @tparam the type of object contained in the matrix
* @return the S optimality measure
*/
template
double calculateSOptimal(const bclib::matrix & mat)
{
// B[i] <- 1/sum(1/dist(A[, , i]))
double sum = sumInvDistance(mat);
return 1.0 / sum;
}
/**
* Create a vector of random values on (0,1)
* @param n the number of random values
* @param output the output vector of random values
* @param oRandom the pseudo random number generator
*/
void runif_std(unsigned int n, std::vector & output, bclib::CRandom & oRandom);
/**
* Create a vector of random integer like values
* @param n the length of the random vector
* @param min the minimum integer value
* @param max the maximum integer value
* @param output the output vector of values
* @param oRandom the pseudo random number generator.
* @tparam T1 the integer valued type like int, unsigned int, long, long long, unsigned long
*/
template
void runifint(unsigned int n, T1 min, T1 max, std::vector & output, bclib::CRandom & oRandom)
{
if (output.size() != n)
{
output.resize(n);
}
std::vector r = std::vector(n);
runif_std(n, r, oRandom);
typename std::vector::iterator output_it;
std::vector::iterator r_it;
double range = static_cast(max) + 1.0 - static_cast(min);
for (output_it = output.begin(), r_it = r.begin();
output_it != output.end() && r_it != r.end(); ++output_it, ++r_it)
{
*output_it = min + static_cast(floor((*r_it) * range));
}
}
/**
* Create a random integer like values
* @param min the minimum integer value
* @param max the maximum integer value
* @param output the output value
* @param oRandom the pseudo random number generator
* @tparam T1 the integer valued type like int, unsigned int, long, long long, unsigned long
*/
template
void runifint(T1 min, T1 max, T1 * output, bclib::CRandom & oRandom)
{
double r = oRandom.getNextRandom();
double range = static_cast(max) + 1.0 - static_cast(min);
*output = min + static_cast(floor((r * range)));
}
} // end namespace
#endif /* UTILITYLHS_H */
lhs/src/matrix.h 0000644 0001762 0000144 00000064066 14215223422 013315 0 ustar ligges users /**
* @file matrix.h
* @author Robert Carnell
* @copyright Copyright (c) 2022, Robert Carnell
*
* @license GNU Lesser General Public License (LGPL v3)
* This program is free software: you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, either version 3 of the License, or
* (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public License
* along with this program. If not, see .
*/
#ifndef MATRIX_H
#define MATRIX_H
#include
#include
#include
#include
#include
/**
* @namespace bclib The bertcarnell template library namespace
*/
namespace bclib {
// forward declare the iterator
template class matrixIter;
template class matrixConstIter;
/**
* Matrix Class
* @tparam T a generic type of the kind that can be used in std::vector
*/
template
class matrix
{
friend class matrixIter; /**< make the class a friend of the row-wise iterator */
friend class matrixIter; /**< make the class a friend of the column-wise iterator */
friend class matrixConstIter; /**< make the class a friend of the row-wise iterator */
friend class matrixConstIter; /**< make the class a friend of the column-wise iterator */
public:
typedef typename std::vector::size_type size_type; /**< define the size_type as std::vector */
typedef typename std::vector::iterator iterator; /**< define iterator from the std::vector internals */
typedef typename std::vector::const_iterator const_iterator; /**< define the const iterator from the std::vector */
typedef matrixIter rowwise_iterator; /**< an iterator that iterates across rows then down columns */
typedef matrixIter columnwise_iterator; /**< an iterator that iterates down columns then across rows */
typedef matrixConstIter const_rowwise_iterator; /**< a const row-wise iterator */
typedef matrixConstIter const_columnwise_iterator; /**< a const column-wise iterator */
typedef ptrdiff_t difference_type; /**< define difference_type for consistency with stdlib */
typedef T value_type; /**< define value_type for consistency with stdlib */
typedef T * pointer; /**< define a pointer type for consistency with stdlib */
typedef T & reference; /**< define a reference type for consistency with stdlib */
private:
size_type rows; /**< number of rows */
size_type cols; /**< number of columns */
std::vector elements; /**< array of elements */
bool bTranspose; /**< is the matrix transposed from creation */
/**
* calculate tne location of the value in the vector holding the matrix values
* @param row the row location
* @param col the column location
* @return the location of the value in the vector holding the matrix values
*/
size_type calcLocation(const size_type row, const size_type col)
{
return (!bTranspose) ? (row*cols + col) : (col*rows + row);
}
/**
* calculate tne location of the value in the vector holding the matrix values
* @param row the row location
* @param col the column location
* @return the location fo the value in the vector holding the matrix values
*/
size_type calcLocation(const size_type row, const size_type col) const
{
return (!bTranspose) ? (row*cols + col) : (col*rows + row);
}
public:
/// The number of rows in the matrix
size_type rowsize() const {return rows;};
/// The number of columns in the matrix
size_type colsize() const {return cols;};
/**
* matrix element access
* @note does not check for index in range
* @param row row index (zero based)
* @param col column index (zero based)
* @return a reference to the requested element
*/
T& operator()(size_type row, size_type col)
{
return elements[calcLocation(row, col)];
}
/**
* matrix element access
* @note does not check for arguments out of range
* @param row row index (zero based)
* @param col column index (zero based)
* @return a const reference to the requested element
*/
const T& operator()(size_type row, size_type col) const
{
return elements[calcLocation(row, col)];
}
/**
* matrix element access
* @throws std::out_of_range from the internal std::vector
* @param row row index (zero based)
* @param col column index (zero based)
* @return a const reference to the requested element
*/
const T& at(size_type row, size_type col) const
{
return elements.at(calcLocation(row, col));
}
/**
* matrix element access
* @throws std::out_of_range from the internal std::vector
* @param row row index (zero based)
* @param col column index (zero based)
* @return a reference to the requested element
*/
T& at(size_type row, size_type col)
{
return elements.at(calcLocation(row,col));
}
/**
* matrix element access
* @throws std::out_of_range from the internal std::vector
* @param i vector index (zero based)
* @return a reference to the requested element
*/
T& at(size_type loc)
{
return elements.at(loc);
}
/**
* matrix element access
* @throws std::out_of_range from the internal std::vector
* @param i vector index (zero based)
* @return const a reference to the requested element
*/
const T& at(size_type loc) const
{
return elements.at(loc);
}
/// a pointer to the internal data array
T* data() {return elements.data();};
/// get the internal data vector
std::vector getDataVector() const {return elements;};
/// Default Constructor with zero rows and zero columns
matrix();
/**
* Constructor
* @param rows the number of rows in the matrix
* @param cols the number of columns in the matrix
*/
matrix(size_type rows, size_type cols);
/**
* Constructor
* @param rows the number of rows in the matrix
* @param cols the number of columns in the matrix
* @param elementArray an array to use as the initial values
*/
matrix(size_type rows, size_type cols, const T* elementArray);
/**
* Constructor
* @param rows the number of rows in the matrix
* @param cols the number of columns in the matrix
* @param elementVector a std::vector to use as the initial values
*/
matrix(size_type rows, size_type cols, const std::vector & elementVector);
/**
* Copy Constructor
* @param the matrix to be copied
*/
matrix(const matrix &);
/// Destructor
~matrix();
/**
* Matrix assignment
* @param right hand side matrix
* @return the left hand side matrix
*/
matrix& operator=( const matrix& );
/**
* Equality comparison operator
* @param rhs the right hand side matrix
* @return true if the matrices are equivalent
*/
bool operator==(const matrix & rhs) const;
/**
* Inequality comparison operator
* @param rhs the right hand side matrix
* @return true if the matrices are not equivalent
*/
bool operator!=(const matrix & rhs) const;
/**
* Get a row of the matrix as a std::vector
* @note does not check to ensure the row is in range
* @param row the row number
* @return a vector representation of that row
*/
std::vector getrow(size_type row) const;
/**
* Get a row of the matrix as a std::vector
* @throws std::out_of_range when the row is not in range
* @param row the row number
* @return a vector representation of that row
*/
std::vector getrow_at(size_type row) const;
/**
* Get a row of the matrix as a row matrix
* @note does not check to ensure argument is in range
* @param row the row number
* @return a matrix representation of that row
*/
matrix getRowMatrix(size_type row) const;
/**
* Get a row of the matrix as a row matrix
* @throws an out of range exception for an argument out of range
* @param row the row number
* @return a matrix representation of that row
*/
matrix getRowMatrix_at(size_type row) const;
/**
* get a column of the matrix as a vector
* @note does not check the array bounds
* @param col column number
* @return a vector of the requested column
*/
std::vector getcol(size_type col) const;
/**
* Get a column of the matrix as a vector
* @throws out_of_range error if the column requested is out of bounds
* @param col the column number
* @return a vector of the requested column
*/
std::vector getcol_at(size_type col) const;
/**
* Get a column of the matrix as a column matrix
* @note does not check if the requested column is in bounds
* @param col the column number
* @return a column matrix of the requested column
*/
matrix getColumnMatrix(size_type col) const;
/**
* Get a column of the matrix as a column matrix
* @throws if the requested column is out of range
* @param col the column number
* @return a column matrix of the requested column
*/
matrix getColumnMatrix_at(size_type col) const;
/**
* fill the matrix with a value
* @param x the value to fill the matrix with
*/
void fill(const T & x)
{
elements.assign(rows*cols, x);
};
/**
* fill the matrix with a value
* @param x the value to fill the matrix with
*/
//void fill(const T x)
//{
// elements.assign(rows*cols, x);
//};
/// Clear the matrix to zero rows and columns
void clear();
/// return true if the matrix is empty
bool isEmpty() const {return elements.empty();};
/// return a string representation of the matrix
std::string toString() const;
/// Transpose the matrix
void transpose();
/// return true if this matrix is operating as a transposed matrix from the original definition
bool isTransposed() const {return bTranspose;};
/********* Matrix Iterators *********/
/// an iterator for the beginning of the internal vector
iterator begin() {return elements.begin();};
const_iterator begin() const {return elements.begin();};
/// An iterator for one iteration past the end of the internal vector
iterator end() {return elements.end();};
const_iterator end() const {return elements.end();};
/// An iterator that operates along the matrix rows
rowwise_iterator rowwisebegin() {return rowwise_iterator(*this, 0, 0);};
const_rowwise_iterator rowwisebegin() const {return const_rowwise_iterator(*this, 0, 0);};
/**
* return a row wise iterator for the beginning of the ith row (0 based)
* @param irow
*/
rowwise_iterator rowwisebegin(size_type irow) {return rowwise_iterator(*this, irow, 0);};
const_rowwise_iterator rowwisebegin(size_type irow) const {return const_rowwise_iterator(*this, irow, 0);};
/// An iterator that operates along the matrix row
rowwise_iterator rowwiseend() {return rowwise_iterator(*this, rows, 0);};
const_rowwise_iterator rowwiseend() const {return const_rowwise_iterator(*this, rows, 0);};
/**
* return a row wise iterator for the end of the ith row (0 based)
* @param irow
*/
rowwise_iterator rowwiseend(size_type irow) {return rowwise_iterator(*this, irow+1, 0);};
const_rowwise_iterator rowwiseend(size_type irow) const {return const_rowwise_iterator(*this, irow+1, 0);};
/// An iterator that operates along the matrix columns
columnwise_iterator columnwisebegin() {return columnwise_iterator(*this, 0, 0);};
const_columnwise_iterator columnwisebegin() const {return const_columnwise_iterator(*this, 0, 0);};
/**
* return a column wise iterator for the beginning of the jth column (0 based)
* @param irow
*/
columnwise_iterator columnwisebegin(size_type jcol) {return columnwise_iterator(*this, 0, jcol);};
const_columnwise_iterator columnwisebegin(size_type jcol) const {return const_columnwise_iterator(*this, 0, jcol);};
/// An iterator that operates along the matrix columns
columnwise_iterator columnwiseend() {return columnwise_iterator(*this, 0, cols);};
const_columnwise_iterator columnwiseend() const {return const_columnwise_iterator(*this, 0, cols);};
/**
* return a column wise iterator for the end of the jth column (0 based)
* @param irow
*/
columnwise_iterator columnwiseend(size_type jcol) {return columnwise_iterator(*this, 0, jcol+1);};
const_columnwise_iterator columnwiseend(size_type jcol) const {return const_columnwise_iterator(*this, 0, jcol+1);};
};
/******************************************************************************/
/**
* An iterator class for the matrix
class
* @tparam T the type of object stored in the matrix
* @tparam ISROWWISE a boolean to indicate if the matrix is iterated row-wise
*/
template
class matrixIter
{
friend class matrixConstIter;
private:
matrix & myMatrix; /**< The object that the iterator is referencing */
typename matrix::size_type rows; /**< the row being pointed to */
typename matrix::size_type cols; /**< the column being pointed to */
public:
// required elements of an iterator class (inherited from std::iterator before it was deprecated)
using iterator_category = std::forward_iterator_tag;
using value_type = T;
using difference_type = T;
using pointer = T*;
using reference = T&;
/**
* Constructor
* @param mat the matrix being indexed
* @param r the row location of the iterator
* @param c the column location of the iterator
*/
matrixIter(matrix & mat, typename matrix::size_type r,
typename matrix::size_type c)
: myMatrix(mat), rows(r), cols(c) {}
/// Equality operator
bool operator==(const matrixIter & other) const;
/// Inequality operator
bool operator!=(const matrixIter & other) const
{
return !(*this == other);
}
/// pre-increment operator
matrixIter & operator++();
/// post-increment operator
matrixIter operator++(int);
/// assignment operator
matrixIter & operator=(const matrixIter & rhs);
/// de-reference operator
T & operator*()
{
return myMatrix(rows, cols);
}
};
/**
* An const_iterator class for the matrix
class
* @tparam T the type of object stored in the matrix
* @tparam ISROWWISE a boolean to indicate if the matrix is iterated row-wise
*/
template
class matrixConstIter
{
friend class matrixIter;
private:
const matrix & myMatrix; /**< The object that the iterator is referencing */
typename matrix::size_type rows; /**< the row being pointed to */
typename matrix::size_type cols; /**< the column being pointed to */
public:
// required elements of an iterator class (inherited from std::iterator before it was deprecated)
using iterator_category = std::forward_iterator_tag;
using value_type = T;
using difference_type = T;
using pointer = T*;
using reference = T&;
/**
* Constructor
* @param mat the matrix being indexed
* @param r the row location of the iterator
* @param c the column location of the iterator
*/
matrixConstIter(const matrix & mat, typename matrix::size_type r,
typename matrix::size_type c)
: myMatrix(mat), rows(r), cols(c) {}
/**
* Copy constructor from non-const to const
* @param mi the matrix being copied
*/
matrixConstIter(const matrixIter & mi)
: myMatrix(mi.myMatrix), rows(mi.rows), cols(mi.cols){}
/// Equality operator
bool operator==(const matrixConstIter & other) const;
/// Inequality operator
bool operator!=(const matrixConstIter & other) const
{
return !(*this == other);
}
/// pre-increment operator
matrixConstIter & operator++();
/// post-increment operator
matrixConstIter operator++(int);
/// Assignment operator
/** @TODO: does an assignment operator make sense for a const iterator? */
matrixConstIter & operator=(const matrixConstIter & rhs);
/// de-reference operator
const T & operator*()
{
return myMatrix(rows, cols);
}
};
// heavily influenced by: http://www.sj-vs.net/c-implementing-const_iterator-and-non-const-iterator-without-code-duplication/
/******************************************************************************/
template
matrix::matrix(size_type rows, size_type cols)
: rows(rows), cols(cols), bTranspose(false)
{
if ( rows == 0 || cols == 0 )
{
throw std::range_error("attempt to create a degenerate matrix");
}
elements = std::vector(rows*cols);
}
template
matrix::matrix(size_type rows, size_type cols, const T* elementArray)
: rows(rows), cols(cols), bTranspose(false)
{
if ( rows == 0 || cols == 0 )
{
throw std::range_error("attempt to create a degenerate matrix");
}
// initialize from array
elements = std::vector(rows*cols);
for (size_t i = 0; i < rows*cols; i++)
{
elements[i] = elementArray[i];
}
}
template
matrix::matrix(size_type rows, size_type cols, const std::vector & elementVector)
: rows(rows), cols(cols), bTranspose(false)
{
if ( rows == 0 || cols == 0 )
{
throw std::range_error("attempt to create a degenerate matrix");
}
if (elementVector.size() != rows*cols)
{
throw std::range_error("Input element Vector is not the right size");
}
elements.assign(elementVector.begin(), elementVector.end());
}
template
matrix::matrix(const matrix & cp)
: rows(cp.rows), cols(cp.cols), elements(cp.elements), bTranspose(cp.bTranspose)
{
}
template
matrix::~matrix()
{
}
template
matrix& matrix::operator=( const matrix& cp )
{
if (cp.rows != rows || cp.cols != cols )
{
rows = cp.rows;
cols = cp.cols;
}
elements = cp.elements;
bTranspose = cp.bTranspose;
return *this;
}
template
bool matrix::operator==(const matrix& cp) const
{
if (cp.rows != rows || cp.cols != cols)
{
return false;
}
return std::equal(elements.begin(), elements.end(), cp.elements.begin());
}
template
bool matrix::operator!=(const matrix & cp) const
{
if (*this == cp)
{
return false;
}
return true;
}
template
std::vector matrix::getrow(size_type row) const
{
std::vector a = std::vector(cols);
for (size_type j = 0; j < cols; j++)
{
a[j] = elements[calcLocation(row, j)];
}
return a;
}
template
std::vector matrix::getrow_at(size_type row) const
{
if (row >= rows)
{
std::ostringstream msg;
msg << "row " << row << " was requested, but the matrix has " << rows << " rows";
throw std::out_of_range(msg.str().c_str());
}
return getrow(row);
}
template
matrix matrix::getRowMatrix(size_type row) const
{
// the simple method has an extra loop of assignment
//std::vector a = this->getrow(i);
//return matrix(1,cols,a);
matrix a(1,cols);
for (size_type j = 0; j < cols; j++)
{
a(0,j) = elements[calcLocation(row, j)];
}
return a;
}
template
matrix matrix::getRowMatrix_at(size_type row) const
{
if (row >= rows)
{
std::ostringstream msg;
msg << "Row " << row << " was requested, but the matrix has " << rows << " rows";
throw std::out_of_range(msg.str().c_str());
}
return getRowMatrix(row);
}
template
std::vector matrix::getcol(size_type col) const
{
std::vector a = std::vector(rows);
for (size_type i = 0; i < rows; i++)
{
a[i] = elements[calcLocation(i, col)];
}
return a;
}
template
std::vector matrix::getcol_at(size_type col) const
{
if (col >= cols)
{
std::ostringstream msg;
msg << "Column " << col << " was requested, but the matrix has " << cols << " columns";
throw std::out_of_range(msg.str().c_str());
}
return getcol(col);
}
template
matrix matrix::getColumnMatrix(size_type col) const
{
matrix a(rows,1);
for (size_type i = 0; i < rows; i++)
{
a(i,0) = elements[calcLocation(i, col)];
}
return a;
}
template
matrix matrix::getColumnMatrix_at(size_type col) const
{
if (col >= cols)
{
std::ostringstream msg;
msg << "Column " << col << " was requested, but the matrix has " << cols << " columns";
throw std::out_of_range(msg.str().c_str());
}
return getColumnMatrix(col);
}
template
void matrix::clear()
{
elements.clear();
rows = 0;
cols = 0;
bTranspose = false;
}
template
matrix::matrix()
{
rows = 0;
cols = 0;
elements = std::vector();
bTranspose = false;
}
template
std::string matrix::toString() const
{
std::ostringstream msg;
for (size_type irow = 0; irow < rows; irow++)
{
for (size_type jcol = 0; jcol < cols; jcol++)
{
msg << (*this).at(irow, jcol);
if (cols > 1 && jcol < cols - 1)
{
msg << ",";
}
}
msg << "\n";
}
return msg.str();
}
template
void matrix::transpose()
{
// decide to not move data during transpose
bTranspose = !bTranspose;
size_type oldRows = rows;
rows = cols;
cols = oldRows;
}
/******************************************************************************/
template
bool matrixIter::operator==(const matrixIter & other) const
{
if (this->myMatrix == other.myMatrix &&
this->rows == other.rows &&
this->cols == other.cols)
{
return true;
}
return false;
}
template
matrixIter & matrixIter::operator++()
{
if (ISROWWISE)
{
if (cols < myMatrix.cols - 1)
{
cols++;
return *this;
}
else
{
cols = 0;
rows++;
return *this;
}
}
else // ISROWWISE = false
{
if (rows < myMatrix.rows - 1)
{
rows++;
return *this;
}
else
{
rows = 0;
cols++;
return *this;
}
}
}
template
matrixIter & matrixIter::operator=(const matrixIter & rhs)
{
// Check for self-assignment
if (this == &rhs)
{
return *this;
}
else
{
this->myMatrix = rhs.myMatrix;
this->rows = rhs.rows;
this->cols = rhs.cols;
return *this;
}
}
template
matrixIter matrixIter::operator++(int)
{
const matrixIter clone( *this );
++(*this);
return clone;
}
/******************************************************************************/
template
bool matrixConstIter::operator==(const matrixConstIter & other) const
{
if (this->myMatrix == other.myMatrix &&
this->rows == other.rows &&
this->cols == other.cols)
{
return true;
}
return false;
}
template
matrixConstIter & matrixConstIter::operator++()
{
if (ISROWWISE)
{
if (cols < myMatrix.cols - 1)
{
cols++;
return *this;
}
else
{
cols = 0;
rows++;
return *this;
}
}
else // ISROWWISE = false
{
if (rows < myMatrix.rows - 1)
{
rows++;
return *this;
}
else
{
rows = 0;
cols++;
return *this;
}
}
}
template
matrixConstIter & matrixConstIter::operator=(const matrixConstIter & rhs)
{
// Check for self-assignment
if (this == &rhs)
{
return *this;
}
else
{
this->myMatrix = rhs.myMatrix;
this->rows = rhs.rows;
this->cols = rhs.cols;
return *this;
}
}
template
matrixConstIter matrixConstIter::operator++(int)
{
const matrixConstIter clone( *this );
++(*this);
return clone;
}
} // end namespace
#endif /* MATRIX_H */
lhs/src/geneticLHS.cpp 0000644 0001762 0000144 00000022675 14215223422 014331 0 ustar ligges users /**
* @file geneticLHS.cpp
* @author Robert Carnell
* @copyright Copyright (c) 2014, Robert Carnell
*
* License GNU Lesser General Public License (LGPL v3)
* This program is free software: you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, either version 3 of the License, or
* (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public License
* along with this program. If not, see .
*/
#include "LHSCommonDefines.h"
#include "utilityLHS.h"
namespace lhslib
{
// TODO: multi-thread the iterations over population
void geneticLHS(int n, int k, int pop, int gen, double pMut, const std::string & criterium,
bool bVerbose, bclib::matrix & result, bclib::CRandom & oRandom)
{
if (n < 1 || k < 1)
{
throw std::runtime_error("nsamples are less than 1 (n) or nparameters less than 1 (k)");
}
msize_type m_n = static_cast(n);
msize_type m_k = static_cast(k);
if (result.rowsize() != m_n || result.colsize() != m_k)
{
throw std::runtime_error("result should be n x k for the lhslib::geneticLHS call");
}
if (gen < 1 || pop < 1)
{
throw std::invalid_argument("pop, and gen should be integers greater than 0");
}
msize_type m_pop = static_cast(pop);
msize_type m_gen = static_cast(gen);
if (pMut <= 0 || pMut >= 1)
{
throw std::invalid_argument("pMut should be between 0 and 1");
}
if (m_pop % 2 != 0)
{
throw std::invalid_argument("pop should be an even number");
}
std::vector > A = std::vector >(m_pop);
for (msize_type i = 0; i < m_pop; i++)
{
A[i] = bclib::matrix(m_n, m_k);
}
for (msize_type i = 0; i < m_pop; i++)
{
// fill A with random hypercubes
randomLHS(static_cast(m_n), static_cast(m_k), A[i], oRandom);
#ifdef _DEBUG
if (!lhslib::isValidLHS(A[i])) PRINT_MACRO("A is not valid at %d in randomLHS\n", static_cast(i));
#endif
}
std::vector