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