library(devtools)
Loading required package: usethis
Registered S3 method overwritten by 'htmlwidgets':
method from
print.htmlwidget tools:rstudio
library(usethis)
library(tidyverse)
── Attaching core tidyverse packages ───────────────────────────────────────────────────────────────────────────────────────── tidyverse 2.0.0 ──
✔ dplyr 1.1.4 ✔ readr 2.1.5
✔ forcats 1.0.0 ✔ stringr 1.5.1
✔ ggplot2 3.5.1 ✔ tibble 3.2.1
✔ lubridate 1.9.4 ✔ tidyr 1.3.1
✔ purrr 1.0.2 ── Conflicts ─────────────────────────────────────────────────────────────────────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag() masks stats::lag()
ℹ Use the ]8;;http://conflicted.r-lib.org/conflicted package]8;; to force all conflicts to become errors
Imported functions
Build doc and install
Run this to update documentation and install locally.
Examples
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)
Making data
\(2^2\) CCD
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
Factorial Plan Design Matrix
Defining Relationship: ~ A * B
Factors: A B
Levels: -1 1
Fraction: NA
Type: composite
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")
Centered design
set.seed(0)
fp <- fp_design_matrix(2, rep=3) %>%
mutate(Y=f(A, B))
fp
Factorial Plan Design Matrix
Defining Relationship: ~ A * B
Factors: A B
Levels: -1 1
Fraction: NA
Type: plain
fp %>%
lm(Y ~ A*B, data=.) %>%
anova()
Analysis of Variance Table
Response: Y
Df Sum Sq Mean Sq F value Pr(>F)
A 1 33.860 33.860 85.475 1.520e-05 ***
B 1 128.771 128.771 325.064 9.190e-08 ***
A:B 1 238.110 238.110 601.073 8.182e-09 ***
Residuals 8 3.169 0.396
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
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
Factorial Plan Design Matrix
Defining Relationship: ~ A * B
Factors: A B
Levels: -1 1
Fraction: NA
Type: centered
fpc %>%
lm(Y ~ A*B+I(A^2), data=.) %>%
anova()
Analysis of Variance Table
Response: Y
Df Sum Sq Mean Sq F value Pr(>F)
A 1 49.321 49.321 35.7121 9.240e-05 ***
B 1 99.147 99.147 71.7905 3.768e-06 ***
I(A^2) 1 11.536 11.536 8.3529 0.0147 *
A:B 1 210.842 210.842 152.6670 8.610e-08 ***
Residuals 11 15.192 1.381
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
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()

LS0tCnRpdGxlOiAiRGV2ZWxvcG1lbnQiCm91dHB1dDogaHRtbF9ub3RlYm9vawotLS0KCmBgYHtyIHNldHVwfQpsaWJyYXJ5KGRldnRvb2xzKQpsaWJyYXJ5KHVzZXRoaXMpCmxpYnJhcnkodGlkeXZlcnNlKQpgYGAKCiMgSW1wb3J0ZWQgZnVuY3Rpb25zCgpgYGB7ciBpbmNsdWRlPUZBTFNFfQp1c2VfaW1wb3J0X2Zyb20oCiAgImdsdWUiLCAKICAiZ2x1ZSIKKQoKdXNlX2ltcG9ydF9mcm9tKAogICJyZWFkciIsIGMoInJlYWRfY3N2IiwgInJlYWRfY3N2MiIsICJ3cml0ZV9jc3YiLCAid3JpdGVfY3N2MiIpCikKCnVzZV9pbXBvcnRfZnJvbSgKICAidGliYmxlIiwgCiAgYygidGliYmxlIiwgImFzX3RpYmJsZSIpCikKCnVzZV9pbXBvcnRfZnJvbSgiZ2doYWxmbm9ybSIsICJnZ2hhbGZub3JtIikKCnVzZV9pbXBvcnRfZnJvbSgibHVicmlkYXRlIiwgInN0YW1wIikKCnVzZV9pbXBvcnRfZnJvbSgKICAidGlkeXIiLAogICJwaXZvdF9sb25nZXIiCikKCnVzZV9pbXBvcnRfZnJvbSgKICAiZ3JEZXZpY2VzIiwgYygiZ3JleSIpCikKCnVzZV9pbXBvcnRfZnJvbSgKICAic3RhdHMiLCAKICBjKCJhcy5mb3JtdWxhIiwgImNvZWYiLCAiZWNkZiIsICJlZmZlY3RzIiwgIm5hLm9taXQiLAogICAgICAgICAgICAgICAicG5vcm0iLCAic2QiLCAic2V0TmFtZXMiLCAidGVybXMiKQopCgp1c2VfaW1wb3J0X2Zyb20oCiAgInV0aWxzIiwgYygidGFpbCIpCikKCnVzZV9pbXBvcnRfZnJvbSgKICAiZHBseXIiLCAKICAgYygKICAgICAiYWNyb3NzIiwKICAgICAiYWRkX3JvdyIsCiAgICAgImFycmFuZ2UiLCAKICAgICAiYmluZF9yb3dzIiwKICAgICAiY19hY3Jvc3MiLAogICAgICJkZXNjIiwKICAgICAiZmlsdGVyIiwKICAgICAiaWZfZWxzZSIsCiAgICAgIm11dGF0ZSIsIAogICAgICJuIiwgCiAgICAgInB1bGwiLAogICAgICJyZWxvY2F0ZSIsCiAgICAgInJlbmFtZV93aXRoIiwKICAgICAicm93d2lzZSIsCiAgICAgInNlbGVjdCIsCiAgICAgInNsaWNlX3RhaWwiLAogICAgICJzdW1tYXJpemVfYWxsIiwKICAgICAidW5ncm91cCIKICAgKQopCgp1c2VfaW1wb3J0X2Zyb20oCiAgInB1cnJyIiwgCiAgIGMoCiAgICAgImFjY3VtdWxhdGUiLAogICAgICJkaXNjYXJkIiwKICAgICAia2VlcCIsCiAgICAgImxpc3RfbWVyZ2UiLAogICAgICJtYXAiLCAKICAgICAic2V0X25hbWVzIiwKICAgICAid2FsayIsCiAgICAgIml3YWxrIgogICApICAgCikKCnVzZV9pbXBvcnRfZnJvbSgKICAiZ2dwbG90MiIsIAogIGMoCiAgICAiYWVzIiwgCiAgICAiY29vcmRfY2FydGVzaWFuIiwKICAgICJlbGVtZW50X3RleHQiLAogICAgImdncGxvdCIsCiAgICAiZ2VvbV9jb2wiLAogICAgImdlb21fZnVuY3Rpb24iLAogICAgImdlb21faGxpbmUiLAogICAgImdlb21fbGFiZWwiLAogICAgImdlb21fbGluZSIsCiAgICAiZ2VvbV9wb2ludCIsCiAgICAiZ2VvbV9xcSIsCiAgICAiZ2VvbV9xcV9saW5lIiwKICAgICJnZW9tX3RpbGUiLAogICAgImxhYnMiLAogICAgInNjYWxlX2ZpbGxfdmlyaWRpc19kIiwKICAgICJzY2FsZV95X2NvbnRpbnVvdXMiLAogICAgInNlY19heGlzIiwKICAgICJzdGF0X3FxIiwKICAgICJ0aGVtZSIKICAgIAogICkKKQoKdXNlX2ltcG9ydF9mcm9tKAogICJybGFuZyIsIAogIGMoImlzX2Zvcm11bGEiLCJzeW0iKQopCgp1c2VfaW1wb3J0X2Zyb20oCiAgInN0cmluZ3IiLAogICJzdHJfcmVtb3ZlX2FsbCIKKQpgYGAKIyBCdWlsZCBkb2MgYW5kIGluc3RhbGwKClJ1biB0aGlzIHRvIHVwZGF0ZSBkb2N1bWVudGF0aW9uIGFuZCBpbnN0YWxsIGxvY2FsbHkuCgoKYGBge3IgaW5jbHVkZT1GQUxTRSwgZXZhbD1GQUxTRX0KZGV2dG9vbHM6OmRvY3VtZW50KCkKZGV2dG9vbHM6OmJ1aWxkX3ZpZ25ldHRlcygpCmRldnRvb2xzOjppbnN0YWxsKCkKYGBgCgojIEV4YW1wbGVzCgpgYGB7cn0KbGlicmFyeShhZGFzLnV0aWxzKQpgYGAKCgpgYGB7cn0KZnBfZGVzaWduX21hdHJpeCg1KSAlPiUgCiAgZnBfZnJhY3Rpb24ofkEqQipDKkQpICU+JSAKICBmcF9mcmFjdGlvbih+QipDKkQqRSkgJT4lIAogIGRwbHlyOjptdXRhdGUoWT1ybm9ybShkcGx5cjo6bigpKSkKYGBgCgpgYGB7cn0KZnBfYWxpYXMofkEqQipDKkQpCmZwX2FsaWFzKH5CKkMqRCpFKQpgYGAKCmBgYHtyfQpkbSA8LSBmcF9kZXNpZ25fbWF0cml4KDMpCgpmcF9hdWdtZW50X2NlbnRlciA8LSBmdW5jdGlvbihkbSwgcmVwPTUpIHsKICBzdG9waWZub3QoImZhY3RvcmlhbC5wbGFuIiAlaW4lIGNsYXNzKGRtKSkKICByIDwtIG5yb3coZG0pCiAgZmN0IDwtIGF0dHIoZG0sICJmYWN0b3JzIikKICAKICBkbSAlPiUgCiAgICBhZGRfcm93KAogICAgICBTdGRPcmRlciA9IChyKzEpOihyK3JlcCksCiAgICAgIFJ1bk9yZGVyID0gc2FtcGxlKChyKzEpOihyK3JlcCkpLAogICAgICAudHJlYXQgPSAiMCIsCiAgICAgIC5yZXAgPSAxOnJlcCwKICAgICkgJT4lIAogICAgbXV0YXRlKAogICAgICBhY3Jvc3Moe2ZjdH0sIH4gMCkKICAgICkKfQoKZG0gJT4lIAogIGZwX2F1Z21lbnRfY2VudGVyKDUpCmBgYAoKCiMgTWFraW5nIGRhdGEKCiMjICQyXjIkIENDRAoKYGBge3J9CnNldC5zZWVkKDApCgpmIDwtIGZ1bmN0aW9uKGEsIGIpIHsKICAxICsgMiphICsgMyphXjIrIDMqYiArIDAuMDUqYl4yICsgNCphKmIgKyBybm9ybShsZW5ndGgoYSkpCn0KCmRtIDwtIGZwX2Rlc2lnbl9tYXRyaXgoMiwgcmVwPTMpICU+JSAKICBmcF9hdWdtZW50X2NlbnRlcihyZXA9NCkgJT4lCiAgZnBfYXVnbWVudF9heGlhbChyZXA9MikgJT4lCiAgbXV0YXRlKAogICAgWSA9IGYoQSwgQikKICApCgpkbQpgYGAKCgpgYGB7cn0KZG0gJT4lIAogIGZpbHRlcigudHJlYXQgIT0gImNlbnRlciIgJiAudHJlYXQgIT0gImF4aWFsIikgJT4lIAogIGxtKFkgfiBBKkIsIGRhdGE9LikgJT4lCiAgYW5vdmEoKQpgYGAKCmBgYHtyfQpkbSAlPiUgCiAgZmlsdGVyKC50cmVhdCAhPSAiYXhpYWwiKSAlPiUgCiAgbG0oWSB+IEEqSShBXjIpKkIsIGRhdGE9LikgJT4lCiAgYW5vdmEoKQpgYGAKCgoKYGBge3J9CmRtICU+JSAKICBsbShZIH4gQSpJKEFeMikqQipJKEJeMikrQTpCLCBkYXRhPS4pICU+JQogIGFub3ZhKCkKYGBgCgpgYGB7cn0KZG0gJT4lIAogIGxtKFkgfiAgQSAqIEIgKiBJKEFeMikgKiBJKEJeMiksIGRhdGE9LikgJT4lCiAgYW5vdmEoKQpgYGAKCgpgYGB7cn0KY2NkX2V4cGVyaW1lbnRfeWllbGQgPC0gbGlzdCgKICBiYXNlID0gZG0gJT4lIAogICAgZmlsdGVyKC50cmVhdCAhPSAiY2VudGVyIiAmIC50cmVhdCAhPSAiYXhpYWwiKSAlPiUgCiAgICBwdWxsKFkpLAogIGNlbnRlciA9IGRtICU+JSAKICAgIGZpbHRlcigudHJlYXQgPT0gImNlbnRlciIpICU+JSAKICAgIHB1bGwoWSksCiAgYXhpYWwgPSBkbSAlPiUKICAgIGZpbHRlcigudHJlYXQgPT0gImF4aWFsIikgJT4lIAogICAgcHVsbChZKQopCmBgYAoKCgoKYGBge3J9CmRtIDwtIGZwX2Rlc2lnbl9tYXRyaXgoMywgcmVwPTIpCgojIGZwX2FkZF9zY2FsZSA8LSBmdW5jdGlvbihkbSwgLi4uLCBzdWZmaXg9Il9zIikgewojICAgYXR0cihkbSwgInNjYWxlcyIpIDwtIGxpc3QoKQojICAgZm9yIChpIGluIDE6Li4ubGVuZ3RoKCkpIHsKIyAgICAgbmFtZSA8LSAuLi5uYW1lcygpW2ldCiMgICAgIHJuZyA8LSAuLi5lbHQoaSkKIyAgICAgaWYgKCEoaXMubnVtZXJpYyhybmcpICYgbGVuZ3RoKHJuZykgPT0gMiAmIGlzLm51bWVyaWMoZG1bW25hbWVdXSkpKSB7CiMgICAgICAgd2FybmluZygiU2tpcHBpbmcgZmFjdG9yICIsIG5hbWUsICIgKGl0IGlzIG5vdCBhIG51bWJlciwgb3Igd3Jvbmcgc2NhbGUgcmFuZ2UvdHlwZSBwcm92aWRlZClcbiIpCiMgICAgICAgbmV4dAojICAgICB9CiMgICAgIGRtIDwtIGRtICU+JSAKIyAgICAgICBtdXRhdGUoCiMgICAgICAgICAhIXBhc3RlMChuYW1lLCBzdWZmaXgpIDo9IHNjYWxlczo6cmVzY2FsZSghIXN5bShuYW1lKSwgdG89cm5nKQojICAgICAgICkKIyAgICAgYXR0cihkbSwgInNjYWxlcyIpIDwtIGFwcGVuZChhdHRyKGRtLCAic2NhbGVzIiksIHNldE5hbWVzKGxpc3Qocm5nKSwgbmFtZSkpCiMgICB9CiMgICByZXR1cm4oZG0pCiMgfQoKZG1zIDwtICBkbSAlPiUgCiAgZnBfYWRkX3NjYWxlKEE9YygyLCAxMiksIEI9Yyg0MCwgNjApLCBzdWZmaXg9IiIpCgpkbXMKYGBgCgpgYGB7cn0KZnBfZGVzaWduX21hdHJpeCgyKSAlPiUgCiAgZnBfYWRkX25hbWVzKEE9IlRlbXBlcmF0dXJlIiwgQj0iUHJlc3N1cmUiKSAKYGBgCgpgYGB7cn0KZG0gPC0gZnBfZGVzaWduX21hdHJpeCgyKSAlPiUgCiAgZnBfYWRkX25hbWVzKEE9IlRlbXBlcmF0dXJlIiwgQj0iUHJlc3N1cmUiKSAlPiUgCiAgZnBfYWRkX3NjYWxlKEE9YygyLCAxMiksIEI9Yyg0MCwgNjApLCBzdWZmaXg9Il9zIikgJT4lCiAgZnBfd3JpdGVfY3N2KCJkZXNpZ25fbWF0cml4LmNzdiIpCmBgYAoKCmBgYHtyfQpkbSAlPiUKICBmcF9yZWFkX2NzdigiZGVzaWduX21hdHJpeC5jc3YiKQpgYGAKCgojIENlbnRlcmVkIGRlc2lnbgoKYGBge3J9CnNldC5zZWVkKDApCmZwIDwtIGZwX2Rlc2lnbl9tYXRyaXgoMiwgcmVwPTMpICU+JSAKICBtdXRhdGUoWT1mKEEsIEIpKQpmcApgYGAKCgpgYGB7cn0KZnAgJT4lIAogIGxtKFkgfiBBKkIsIGRhdGE9LikgJT4lIAogIGFub3ZhKCkKYGBgCkFsbCBmYWN0b3JzIGFuZCB0aGVpciBpbnRlcmFjdGlvbnMgYXJlIHNpZ25pZmljYW50LiBCdXQgaXMgdGhlIHR3by1sZXZlbCBtb2RlbCBlbm91Z2g/IExldCdzIGNoZWNrIGZvciB0aGUgcXVhZHJhdGljIHRlcm1zLCBieSBhdWdtZW50aW5nIHRoZSBwbGFuIHdpdGggYSBjZW50cmFsIHBvaW50IHJlcGVhdGVkIDQgdGltZXMuIFdlIGFsc28gbG9hZCB0aGUgYGNlbnRlcmAgZmllbGQgZnJvbSB0aGUgYGNjZF9leHBlcmltZW50X3lpZWxkYCBkYXRhc2V0OgoKYGBge3J9CnNldC5zZWVkKDApCmYgPC0gZnVuY3Rpb24oYSwgYikgewogIDEgKyAyKmEgKyAzKmIgKyAoMyphXjIgKyAwLjA1KmJeMikqMC41ICsgNCphKmIgKyBybm9ybShsZW5ndGgoYSkpCn0KCmZwYyA8LSBmcCAlPiUgCiAgZnBfYXVnbWVudF9jZW50ZXIocmVwPTQpICU+JSAKICBtdXRhdGUoWT1mKEEsQikpCgpmcCA8LSBmcGMgJT4lIAogIGZpbHRlcigudHJlYXQgIT0gImNlbnRlciIpCgpmcGMKCmZwYyAlPiUgCiAgbG0oWSB+IEEqQitJKEFeMiksIGRhdGE9LikgJT4lIAogIGFub3ZhKCkKCmZwICU+JSAKICBsbShZfkEqQiwgZGF0YT0uKSAlPiUgCiAgcHJlZGljdChuZXdkYXRhPWZwYywgaW50ZXJ2YWw9ImNvbmZpZGVuY2UiKSAlPiUgCiAgYmluZF9jb2xzKGZwYykgJT4lIAogIGZpbHRlcigudHJlYXQgPT0gImNlbnRlciIpICU+JSAKICBzdW1tYXJpc2UobHdyPW1pbihsd3IpLCB1cHI9bWF4KHVwcikpICU+JSAKICBtdXRhdGUod2hhdD0iYmFzZSIpICU+JSAKICBiaW5kX3Jvd3MoCiAgICBmcGMgJT4lIAogICAgICBmaWx0ZXIoLnRyZWF0ID09ICJjZW50ZXIiKSAlPiUgCiAgICAgIHB1bGwoWSkgJT4lIAogICAgICB0LnRlc3QoKSAlPiUgCiAgICAgIGJyb29tOjp0aWR5KCkgJT4lIAogICAgICBzZWxlY3QobHdyPWNvbmYubG93LCB1cHI9Y29uZi5oaWdoKSAlPiUgCiAgICAgIG11dGF0ZSgid2hhdCI9ImNlbnRlciIpCiAgKSAlPiUgCiAgZ2dwbG90KGFlcyh4PXdoYXQsIHltaW49bHdyLCB5bWF4PXVwcikpICsKICBnZW9tX2Vycm9yYmFyKCkKYGBgCgoK