library(devtools)
library(usethis)
library(tidyverse)
Run this to update documentation and install locally.
library(adas.utils)
fp_design_matrix(5) %>%
fp_fraction(~A*B*C*D) %>%
fp_fraction(~B*C*D*E) %>%
dplyr::mutate(Y=rnorm(dplyr::n()))
fp_alias(~A*B*C*D)
fp_alias(~B*C*D*E)
dm <- fp_design_matrix(3)
fp_augment_center <- function(dm, rep=5) {
stopifnot("factorial.plan" %in% class(dm))
r <- nrow(dm)
fct <- attr(dm, "factors")
dm %>%
add_row(
StdOrder = (r+1):(r+rep),
RunOrder = sample((r+1):(r+rep)),
.treat = "0",
.rep = 1:rep,
) %>%
mutate(
across({fct}, ~ 0)
)
}
dm %>%
fp_augment_center(5)
set.seed(0)
f <- function(a, b) {
1 + 2*a + 3*a^2+ 3*b + 0.05*b^2 + 4*a*b + rnorm(length(a))
}
dm <- fp_design_matrix(2, rep=3) %>%
fp_augment_center(rep=4) %>%
fp_augment_axial(rep=2) %>%
mutate(
Y = f(A, B)
)
dm
dm %>%
filter(.treat != "center" & .treat != "axial") %>%
lm(Y ~ A*B, data=.) %>%
anova()
dm %>%
filter(.treat != "axial") %>%
lm(Y ~ A*I(A^2)*B, data=.) %>%
anova()
dm %>%
lm(Y ~ A*I(A^2)*B*I(B^2)+A:B, data=.) %>%
anova()
dm %>%
lm(Y ~ A * B * I(A^2) * I(B^2), data=.) %>%
anova()
ccd_experiment_yield <- list(
base = dm %>%
filter(.treat != "center" & .treat != "axial") %>%
pull(Y),
center = dm %>%
filter(.treat == "center") %>%
pull(Y),
axial = dm %>%
filter(.treat == "axial") %>%
pull(Y)
)
dm <- fp_design_matrix(3, rep=2)
# fp_add_scale <- function(dm, ..., suffix="_s") {
# attr(dm, "scales") <- list()
# for (i in 1:...length()) {
# name <- ...names()[i]
# rng <- ...elt(i)
# if (!(is.numeric(rng) & length(rng) == 2 & is.numeric(dm[[name]]))) {
# warning("Skipping factor ", name, " (it is not a number, or wrong scale range/type provided)\n")
# next
# }
# dm <- dm %>%
# mutate(
# !!paste0(name, suffix) := scales::rescale(!!sym(name), to=rng)
# )
# attr(dm, "scales") <- append(attr(dm, "scales"), setNames(list(rng), name))
# }
# return(dm)
# }
dms <- dm %>%
fp_add_scale(A=c(2, 12), B=c(40, 60), suffix="")
dms
fp_design_matrix(2) %>%
fp_add_names(A="Temperature", B="Pressure")
dm <- fp_design_matrix(2) %>%
fp_add_names(A="Temperature", B="Pressure") %>%
fp_add_scale(A=c(2, 12), B=c(40, 60), suffix="_s") %>%
fp_write_csv("design_matrix.csv")
dm %>%
fp_read_csv("design_matrix.csv")
battery <- examples_url("battery.dat") %>% read.table(header=TRUE) %>%
mutate(across(Temperature:Material, factor)) %>% glimpse()
Rows: 36
Columns: 6
$ RunOrder <int> 34, 25, 16, 7, 8, 1, 26, 36, 6, 13, 3, 31, 27, 29, 12, 14, 30, 24, 5, 21, 1…
$ StandardOrder <int> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, …
$ Temperature <fct> 15, 70, 125, 15, 70, 125, 15, 70, 125, 15, 70, 125, 15, 70, 125, 15, 70, 12…
$ Material <fct> 1, 1, 1, 2, 2, 2, 3, 3, 3, 1, 1, 1, 2, 2, 2, 3, 3, 3, 1, 1, 1, 2, 2, 2, 3, …
$ Repeat <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, …
$ Response <int> 130, 34, 20, 150, 136, 25, 138, 174, 96, 155, 40, 70, 188, 122, 70, 110, 12…
cotton <- examples_url("cotton.dat") %>% read.table(header=TRUE) %>%
mutate(Cotton = factor(Cotton)) %>%
glimpse()
Rows: 25
Columns: 3
$ Run <int> 14, 23, 20, 16, 21, 24, 7, 11, 8, 9, 17, 18, 25, 4, 22, 15, 3, 6, 1, 2, 13, 12, …
$ Cotton <fct> 15, 15, 15, 15, 15, 20, 20, 20, 20, 20, 25, 25, 25, 25, 25, 30, 30, 30, 30, 30, …
$ Strength <int> 7, 7, 15, 11, 9, 12, 17, 12, 18, 18, 14, 18, 18, 19, 19, 19, 25, 22, 19, 23, 7, …
usethis::use_data(battery, overwrite=TRUE)
✔ Saving "battery" to "data/battery.rda".
☐ Document your data (see <]8;;https://r-pkgs.org/data.htmlhttps://r-pkgs.org/data.html]8;;>).
usethis::use_data(cotton, overwrite=TRUE)
✔ Saving "cotton" to "data/cotton.rda".
☐ Document your data (see <]8;;https://r-pkgs.org/data.htmlhttps://r-pkgs.org/data.html]8;;>).
set.seed(0)
fp <- fp_design_matrix(2, rep=3) %>%
mutate(Y=f(A, B))
fp
fp %>%
lm(Y ~ A*B, data=.) %>%
anova()
All factors and their interactions are significant. But is the
two-level model enough? Let’s check for the quadratic terms, by
augmenting the plan with a central point repeated 4 times. We also load
the center
field from the ccd_experiment_yield
dataset:
set.seed(0)
f <- function(a, b) {
1 + 2*a + 3*b + (3*a^2 + 0.05*b^2)*0.5 + 4*a*b + rnorm(length(a))
}
fpc <- fp %>%
fp_augment_center(rep=4) %>%
mutate(Y=f(A,B))
fp <- fpc %>%
filter(.treat != "center")
fpc
fpc %>%
lm(Y ~ A*B+I(A^2), data=.) %>%
anova()
fp %>%
lm(Y~A*B, data=.) %>%
predict(newdata=fpc, interval="confidence") %>%
bind_cols(fpc) %>%
filter(.treat == "center") %>%
summarise(lwr=min(lwr), upr=max(upr)) %>%
mutate(what="base") %>%
bind_rows(
fpc %>%
filter(.treat == "center") %>%
pull(Y) %>%
t.test() %>%
broom::tidy() %>%
select(lwr=conf.low, upr=conf.high) %>%
mutate("what"="center")
) %>%
ggplot(aes(x=what, ymin=lwr, ymax=upr)) +
geom_errorbar()