Nothing
## ----knitr-setup, include=FALSE,cache=FALSE,echo=FALSE--------------
library(knitr)
opts_chunk$set(comment = NA, size = 'normalsize', prompt = TRUE, highlight = FALSE,
cache = TRUE, crop = FALSE, concordance = FALSE, fig.align='center',
fig.path='paper-figures/Paper-', out.width="0.4\\textwidth", fig.lp = "F:",
background = "#FFFFFF")
opts_knit$set(out.format = "latex")
knit_hooks$set(crop = hook_pdfcrop)
options(width = 70, prompt = "R> ", continue = "+ ", digits = 3, useFancyQuotes = FALSE)
thm <- knit_theme$get('default')
# Set default font colour (fgcolor) to black
thm$highlight <- "\\definecolor{fgcolor}{rgb}{0, 0, 0}\n
\\newcommand{\\hlnum}[1]{\\textcolor[rgb]{0.686,0.059,0.569}{#1}}%\n
\\newcommand{\\hlstr}[1]{\\textcolor[rgb]{0.192,0.494,0.8}{#1}}%\n
\\newcommand{\\hlcom}[1]{\\textcolor[rgb]{0.678,0.584,0.686}{\\textit{#1}}}%\n
\\newcommand{\\hlopt}[1]{\\textcolor[rgb]{0,0,0}{#1}}%\n
\\newcommand{\\hlstd}[1]{\\textcolor[rgb]{0.345,0.345,0.345}{#1}}%\n
\\newcommand{\\hlkwa}[1]{\\textcolor[rgb]{0.161,0.373,0.58}{\\textbf{#1}}}%\n\\newcommand{\\hlkwb}[1]{\\textcolor[rgb]{0.69,0.353,0.396}{#1}}%\n
\\newcommand{\\hlkwc}[1]{\\textcolor[rgb]{0.333,0.667,0.333}{#1}}%\n
\\newcommand{\\hlkwd}[1]{\\textcolor[rgb]{0.737,0.353,0.396}{\\textbf{#1}}}%"
thm$background <- "#FFFFFF"
thm$fontstyle <- "italic"
knit_theme$set(thm)
## Specific to vignette
options(cl.cores = 1)
## ----spv-example, echo=FALSE, fig.width=5, fig.height=5, fig.cap = "An example of a variance dispersion graph.",out.width="0.35\\textwidth", message=FALSE----
library("vdg")
data("D310")
set.seed(1)
vdgex <- spv(n = 100000, design = D310, formula = ~.^2, at = TRUE)
plot(vdgex, which = "vdgquantile", tau = c(0, 1))[[1]] + theme(legend.position = "none")
## ----qp-ex, echo = FALSE, fig.width = 6, fig.height=4.5, fig.cap = "An example of a quantile plot, corresponding to the example in Figure~\\ref{F:spv-example}.",out.width="0.35\\textwidth"----
set.seed(1)
qpex <- spv(n = 50000, design = D310, formula = ~.^2, at = TRUE, nr.rad = 6)
my_ecdf <- function(x) {
xs <- sort(x)
xun <- unique(xs)
n <- length(xun)
prop <- rep(NA, n)
for (i in seq_along(xun))
prop[i] <- sum(xs <= xun[i]) / n
return(cbind(x = xun, y = prop))
}
ds <- formatC(sqrt(rowSums(qpex$sample^2)), format = "f", digits = 3)
lst <- split(qpex$spv[-1], f = factor(ds[-1]))
ecd <- lapply(lst, my_ecdf)
df <- as.data.frame(do.call(rbind, ecd))
df$Radius <- factor(ds[-1])
df$Distance <- sqrt(rowSums(qpex$sample^2))[-1]
ggplot(data = df, mapping = aes(y = x, x = y, group = Radius, colour = Radius)) + geom_line(size = 1) + ylab("SPV Quantile") + xlab("Proportion")
## ----fds-example, echo = FALSE, fig.width = 5.5, fig.height=5.5, out.width="0.35\\textwidth", fig.cap = "An example of and FDS plot, corresponding to Figures~\\ref{F:spv-example} and \\ref{F:qp-ex}.",results='hide'----
set.seed(1)
fdsex <- spv(n = 50000, design = D310, formula = ~.^2)
plot(fdsex, which = "fds", np = 100)
## ----lhs,fig.height=5.5,fig.width=5.5,fig.cap="An example of an LHS of 10 points in a two-dimensional design space.",results='hide'----
library("vdg")
set.seed(8745)
samp <- LHS(n = 10, m = 2, lim = c(-1, 1))
plot(samp, main = "", pty = "s", pch = 16, ylim = c(-1, 1),
asp = 1, xlab = expression(X[1]), ylab = expression(X[2]))
abline(h = seq(-1, 1, length.out = 10),
v = seq(-1, 1, length.out = 10), lty = 3, col = "grey")
## ----vign, eval=FALSE-----------------------------------------------
# vignette(topic = "vdg", package = "vdg")
## ----load-roq-------------------------------------------------------
data("D416B")
data("D416C")
## ----vdgroq,fig.width=9, fig.height=5.5, results='hide', fig.cap="A VDG for Roquemore's hybrid designs D416B and D416C for a full quadratic model.",out.width="0.7\\textwidth"----
quad4 <- formula( ~ (x1 + x2 + x3 + x4)^2 + I(x1^2) + I(x2^2) +
I(x3^2) + I(x4^2))
set.seed(1234)
spv1 <- spv(n = 5000, design = list(D416B = D416B,
D416C = D416C), formula = quad4)
plot(spv1, which = "vdgboth")
## ----quad4, eval=FALSE----------------------------------------------
# quad4 <- formula( ~ .^2 + I(x1^2) + I(x2^2) + I(x3^2) + I(x4^2))
## ----ex1-bothroqfds,fig.width=6, fig.height=5, results='hide',fig.cap="A standard and variance ratio FDS plot for Roquemore's hybrid designs D416B and D416C for a full quadratic model.",fig.show='hold'----
plot(spv1, which = "fds")
plot(spv1, which = "fds", VRFDS = TRUE, np = 100)
## ----vdgroq-theme,fig.width=7, fig.height=4, results='hide', fig.cap="A second version of Figure~\\ref{F:vdgroq}.",out.width="0.5\\textwidth"----
p <- plot(spv1, which = "vdgboth")
p$vdgboth + theme_bw() + theme(panel.grid = element_blank())
## ----make-ccd3------------------------------------------------------
library("rsm")
ccd3 <- as.data.frame(ccd(basis = 3, n0 = 4,
alpha = "spherical", oneblock = TRUE))[, 3:5]
## ----algdes-cand,results='hide'-------------------------------------
set.seed(8619)
cand <- runif_sphere(n = 10000, m = 3)
colnames(cand) <- colnames(ccd3)
## ----algdes-AD------------------------------------------------------
quad3 <- formula( ~ (x1 + x2 + x3)^2 + I(x1^2) + I(x2^2) + I(x3^2))
library("AlgDesign")
set.seed(3476)
desD <- optFederov(quad3, data = cand, nTrials = 22, criterion = "D")
desA <- optFederov(quad3, data = cand, nTrials = 22, criterion = "A")
## ----ex2-spv,results='hide',fig.show='hide'-------------------------
spv2 <- spv(n = 10000, formula = quad3,
design = list(CCD = ccd3, D = desD$design, A = desA$design))
plot(spv2, which = 2:3)
## ----ccdfds,include=FALSE,echo=FALSE,fig.height=5,fig.width=6,fig.show='hide'----
plot(spv2, which = 2)[[1]] + theme(plot.title = element_text(size = 16), legend.position = "none")
## ----ccdvdg,include=FALSE,echo=FALSE,fig.height=5,fig.width=8,fig.show='hide'----
plot(spv2, which = 3)[[1]] + theme(plot.title = element_text(size = 16))
## ----GJdesreg,echo=FALSE,fig.width=5,fig.height=5,fig.cap="The design region and D-optimal design of \\cite{Goo2011}. Some runs are replicated."----
df <- data.frame(Time = c(360, 420, 720, 720, 660, 360, 360), Temperature = c(550, 550, 523, 520, 520, 529, 550))
p <- ggplot(data = df, aes(x = Time, y = Temperature)) + geom_path() + geom_point(data = GJ54)
p
## ----keepfun--------------------------------------------------------
keepfun <- function(x) apply(x >= -1 & x <= 1, 1, all) &
(x[, 2] <= -1.08 * x[, 1] + 0.28) & (x[, 2] >= -0.36 * x[, 1] - 0.76)
## ----ex3-for--------------------------------------------------------
cube2 <- formula( ~ (Time + Temperature)^2 + I(Time^2) +
I(Temperature^2) + I(Time^3) + I(Temperature^3) +
Time:I(Temperature^2) + I(Time^2):Temperature)
GJmod <- update(cube2, ~ . - I(Time^3) - I(Time^2):Temperature)
## ----ex3-spv--------------------------------------------------------
spv3 <- spv(n = 10000, design = stdrange(GJ54), type = "lhs",
formula = list(Cubic = cube2, GoosJones = GJmod),
keepfun = keepfun)
## ----vdggj-noplot,eval=FALSE----------------------------------------
# plot(spv3, which = 1, points.size = 2)
## ----vdggj,fig.width=8,fig.height=4,results='hide',echo=FALSE,fig.cap="VDG for the D-optimal design of \\citet{Goo2011}, for the two models.",out.width="0.5\\textwidth"----
plot(spv3, which = 1, points.size = 2)[[1]] + theme(plot.title = element_text(size = 16))
## ----rgl-code,eval=FALSE--------------------------------------------
# library("rgl")
# with(spv3$Cubic, plot3d(x = sample[, "Time"],
# y = sample[, "Temperature"], z = spv))
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.