In ehassler/MontgomeryDAE: MontgomeryDAE - Data and examples from Montgomery's "Design and Analysis of Experiments"

source('_format.R')

Chapter 12 in the text introduces robust parameter designs. These designs allow the experimenter to investigate situations where not all of the factors can be easily controlled.

Example 12.1

Recall the filtration experiment from Example 6.2. Assume that temperature (z) is difficult to control, while pressure (x1), concentration (x2), and stirring rate (x3) are easy to control. We fit the following:

df <- Table6.10
colnames(df) <- c('z', 'x1', 'x2', 'x3', 'y', 'Block')
model <- lm(y ~ z * (x1 + x2 + x3), data=df)
print(summary(model))

\noindent Since $x_1$ is not significant let's refit:

model <- lm(y ~ z * (x2 + x3), data=df)
print(summary(model))

\noindent We can pick those terms that do not involve $z$ to find $\mathbb{E}_z[y(\mathbf{x}, z)]$: $$ \mathbb{E}_z[y(\mathbf{x}, z)] = 70.06 + 4.94 x_2 + 7.31 x_3~. $$ Next, $\mathrm{Var}_z\bigl[y(\mathbf{x}, z)\bigr]$ is $$ \mathrm{Var}_z\bigl[y(\mathbf{x}, z)\bigr] = [10.812 - 9.063 x_2 + 8.312 x_3]^2 \sigma_z^2 + \sigma^2 ~. $$

Holding temperature $z=0$ we can plot the contours (blue) of the expected value, then plot the contours (orange) of the variance on top of that:

x2 <- seq(from=-1, to=1, length.out=100)
x3 <- seq(from=-1, to=1, length.out=100)
z <- matrix(predict(model, cbind(
    'z'=rep(0, 100^2),
    expand.grid('x2'=x2, 'x3'=x3)
)), ncol=100)

poe.coefs <- (
    model.matrix(
        ~ z * (x2 + x3),
        data=cbind(
            'z'=rep(1, 100^2),
            expand.grid('x2'=x2, 'x3'=x3)
        )
    ) 
    %*% 
    matrix(c(0, coef(model)['z'], 0, 0, coef(model)[c('z:x2','z:x3')]))
)^2
z.poe <- matrix(sqrt(poe.coefs), nrow=100)

contour(x2, x3, z, col='blue', xlab='Concentration', ylab='StirringRate')
contour(x2, x3, z.poe, col='orange', add=TRUE)

---

Example 12.2

Consider the semiconductor manufacturing experiment data in Table 12.3. We fit the following model:

df <- Table12.3[,-1]
model <- lm(y ~ (z1 + z2 + z3) * (x1 + x2) + x1:x2 + I(x1^2) + I(x2^2), data=df)
print(summary(model))

\noindent We can pick those terms that do not involve $z_i$ to find $\mathbb{E}z[y(\mathbf{x}, z)]$: $$ \mathbb{E}_z[y(\mathbf{x}, z)] = 30.365 -2.921 x_1 - 4.129 x_2 + 2.869 x_1 x_2 + 2.596 x_1^2 + 2.183 x_2^2~. $$ Next, $\mathrm{Var}_z\bigl[y(\mathbf{x}, \mathbf{z})\bigr]$ is \begin{align} \mathrm{Var}{\mathbf{z}}\bigl[y(\mathbf{x}, \mathbf{z})\bigr] &= [2.731 - 0.269 x_1 + 2.006 x_2]^2 \sigma_{z_1}^2 \ &\phantom{=}~+ [-2.331 + 0.894 x_1 -1.431 x_2]^2 \sigma_{z_2}^2 \ &\phantom{=}~+ [2.331 + 2.581 x_1 + 1.556 x_2]^2 \sigma_{z_3}^2 \ &\phantom{=}~+ \sigma^2 ~. \end{align}

Letting $\sigma_{z_i}^2 = 1$ we plot the contours of mean (blue) and variance (orange) as follows:

x1 <- seq(from=-1, to=1, length.out=100)
x2 <- seq(from=-1, to=1, length.out=100)

mean.df <- cbind(
    data.frame(
        'z1'=rep(0, 100^2),
        'z2'=rep(0, 100^2),
        'z3'=rep(0, 100^2)
    ),
    expand.grid('x1'=x1, 'x2'=x2)
)

z <- matrix(predict(model, mean.df), ncol=100)

var.df <- cbind(
    data.frame(
        'z1'=rep(1, 100^2),
        'z2'=rep(1, 100^2),
        'z3'=rep(1, 100^2)
    ),
    expand.grid('x1'=x1, 'x2'=x2)
)

X.m <- model.matrix( ~ (z1 + z2 + z3) * (x1 + x2) + x1:x2 + I(x1^2) + I(x2^2), data=var.df)
b <- coef(model)
z1.terms <- matrix(c(0, b[2], 0, 0, 0, 0, 0, 0, b[9], b[10], 0, 0, 0, 0, 0))
z2.terms <- matrix(c(0, 0, b[3], 0, 0, 0, 0, 0, 0, 0, b[11], b[12], 0, 0, 0))
z3.terms <- matrix(c(0, 0, 0, b[4], 0, 0, 0, 0, 0, 0, 0, 0, b[13], b[14], 0))

poe.coefs <- sqrt((X.m %*% z1.terms)^2 + (X.m %*% z2.terms)^2 + (X.m %*% z3.terms)^2)
z.poe <- matrix(poe.coefs, nrow=100)

contour(x1, x2, z, col='blue', xlab='x1', ylab='x2')
contour(x1, x2, z.poe, col='orange', add=TRUE)

ehassler/MontgomeryDAE documentation built on March 20, 2021, 7:08 p.m.