├── .travis.yml ├── .Rbuildignore ├── _pkgdown.yml ├── inst ├── CITATION └── NEWS ├── DESCRIPTION ├── man ├── codata.Rd ├── ChemReact.Rd ├── heli.Rd ├── model.data.Rd ├── rsm-package.Rd ├── FO.Rd ├── bbd.Rd ├── djoin.Rd ├── varfcn.Rd ├── steepest.Rd ├── ccd.pick.Rd ├── rsm.Rd ├── coded.data.Rd ├── contour.lm.Rd └── ccd.Rd ├── .github └── workflows │ └── pkgdown.yaml ├── R ├── zzz.R ├── ccd.pick.R ├── emmeans-support.R ├── bbd.R ├── datasets.R ├── varfcn.R ├── old-ccd-bbd.R ├── coding.R ├── contour-lm.R └── rsm.R ├── README.md ├── NAMESPACE └── vignettes ├── plots.rmd └── illus.rmd /.travis.yml: -------------------------------------------------------------------------------- 1 | language: r 2 | cache: packages -------------------------------------------------------------------------------- /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^\.travis\.yml$ 4 | ^\.gitignore$ 5 | ^\.github$ 6 | 7 | ### rsm-plots.R 8 | Readme.md 9 | old-ccd-bbd.R 10 | ^_pkgdown\.yml$ 11 | ^docs$ 12 | ^pkgdown$ 13 | -------------------------------------------------------------------------------- /_pkgdown.yml: -------------------------------------------------------------------------------- 1 | url: https://github.com/rvlenth/rsm 2 | template: 3 | bootstrap: 5 4 | 5 | reference: 6 | - title: Overview 7 | contents: 8 | - rsm-package 9 | 10 | - title: Coding of data 11 | contents: 12 | - coded.data 13 | 14 | - title: Analysis 15 | contents: 16 | - rsm 17 | - FO 18 | - steepest 19 | - model.data 20 | 21 | - title: Experimental designs 22 | contents: 23 | - bbd 24 | - ccd 25 | - ccd.pick 26 | - djoin 27 | - varfcn 28 | 29 | - title: Graphics 30 | contents: 31 | - contour.lm 32 | 33 | - title: Data sets 34 | contents: 35 | - ChemReact 36 | - codata 37 | - heli 38 | 39 | 40 | -------------------------------------------------------------------------------- /inst/CITATION: -------------------------------------------------------------------------------- 1 | citHeader("To cite rsm in publications use:") 2 | 3 | bibentry( 4 | bibtype = "Article", 5 | title = "Response-Surface Methods in {R}, Using {rsm}", 6 | author = person("Russell", "Lenth", role = c("cre", "aut")), 7 | journal = "Journal of Statistical Software", 8 | year = "2009", 9 | volume = "32", 10 | number = "7", 11 | pages = "1--17", 12 | doi = "10.18637/jss.v032.i07", 13 | textVersion = paste("Russell V. Lenth (2009).", 14 | "Response-Surface Methods in R, Using rsm.", 15 | "Journal of Statistical Software, 32(7), 1-17.", 16 | "DOI: 10.18637/jss.v032.i07") 17 | ) 18 | 19 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: rsm 2 | Type: Package 3 | Version: 2.10.6 4 | Date: 2025-03-24 5 | Title: Response-Surface Analysis 6 | Authors@R: c(person("Russell", "Lenth", role = c("aut", "cre"), 7 | email = "russell-lenth@uiowa.edu")) 8 | Description: Provides functions to generate response-surface designs, 9 | fit first- and second-order response-surface models, 10 | make surface plots, obtain the path of steepest ascent, 11 | and do canonical analysis. A good reference on these methods 12 | is Chapter 10 of Wu, C-F J and Hamada, M (2009) 13 | "Experiments: Planning, Analysis, and Parameter Design Optimization" 14 | ISBN 978-0-471-69946-0. An early version of the package is 15 | documented in Journal of Statistical Software . 16 | URL: https://github.com/rvlenth/rsm,https://rvlenth.github.io/rsm/ 17 | BugReports: https://github.com/rvlenth/rsm/issues 18 | Suggests: emmeans (> 1.3.5.1), vdg, conf.design, DoE.base, FrF2, 19 | knitr, rmarkdown 20 | Imports: estimability 21 | License: GPL(>=2) 22 | LazyLoad: yes 23 | ByteCompile: yes 24 | VignetteBuilder: knitr 25 | 26 | -------------------------------------------------------------------------------- /man/codata.Rd: -------------------------------------------------------------------------------- 1 | % Copyright (c) 2008-2010, 2012-2025 Russell V. Lenth 2 | \name{codata} 3 | \alias{codata} 4 | \docType{data} 5 | \title{Automobile emissions data} 6 | \description{ 7 | This is a replicated 3^2 experiment reported in Box, Hunter, and Hunter (2005), Table 10.17. 8 | } 9 | \usage{codata} 10 | \format{ 11 | A data frame with 18 observations on the following 3 variables. 12 | \describe{ 13 | \item{\code{x1}}{a numeric vector, coded design variable for ethanol concentration} 14 | \item{\code{x2}}{a numeric vector, coded design variable for air-to-fuel ratio} 15 | \item{\code{y}}{a numeric vector, the response (CO concentration, in micrograms per cubic meter)} 16 | } 17 | } 18 | \details{ 19 | This example, when fitted with a second-order response surface, is an example of a rising ridge. The dataset is duscussed again one chapter later in the source text; Figure 11.17 of BH^2 suggests the coding formulas used in the example below. 20 | } 21 | \source{ 22 | Box, GEP, Hunter, JS, and Hunter, WG (2005) \emph{Statistics for Experimenters} (2nd ed), Wiley. 23 | } 24 | \examples{ 25 | # Create a coded dataset based on info in BH^2 Fig 11.17 26 | CO <- as.coded.data(codata, x1 ~ (Ethanol - 0.2)/0.1, x2 ~ A.F.ratio - 15) 27 | names(CO)[3] <- "CO.conc" 28 | } 29 | \keyword{datasets} 30 | \keyword{design} 31 | 32 | -------------------------------------------------------------------------------- /man/ChemReact.Rd: -------------------------------------------------------------------------------- 1 | % Copyright (c) 2008-2010, 2012-2025 Russell V. Lenth 2 | \name{ChemReact} 3 | \alias{ChemReact} 4 | \alias{ChemReact1} 5 | \alias{ChemReact2} 6 | %%%\docType{data} 7 | \title{Chemical Reaction Data} 8 | \description{ 9 | These data are from a central composite design with 2 factors in 2 blocks. 10 | The design variables are in actual, not coded, form. 11 | } 12 | \usage{ 13 | ChemReact 14 | ChemReact1 15 | ChemReact2 16 | } 17 | \format{ 18 | A data frame with 14 observations on the following 4 variables. 19 | \describe{ 20 | \item{\code{Time}}{a numeric vector; design variable with settings of 80, 85, and 90.} 21 | \item{\code{Temp}}{a numeric vector; design variable with settings of 170, 175, and 180.} 22 | \item{\code{Block}}{a factor with levels \code{B1} \code{B2}. 23 | Block \code{B1} is a first-order design with 3 center points. 24 | Block \code{B2} consists of axis points and 3 more center points.} 25 | \item{\code{Yield}}{a numeric vector; response variable: yield of the chemical process.} 26 | } 27 | \code{ChemReact1} and \code{ChemReact2} are the separate blocks. 28 | Each has 7 runs and three variables (\code{Block} is excluded from these). 29 | } 30 | 31 | \source{ 32 | Table 7.6 of Myers, RH, Montgomery, DC, and Anderson-Cook, CM (2009), 33 | \emph{Response Surface Methodology} (3rd ed.), Wiley. 34 | 35 | } 36 | \keyword{datasets} 37 | -------------------------------------------------------------------------------- /man/heli.Rd: -------------------------------------------------------------------------------- 1 | % Copyright (c) 2008-2010, 2012-2025 Russell V. Lenth 2 | \name{heli} 3 | \alias{heli} 4 | %%%\docType{data} 5 | \title{Paper Helicopter Data} 6 | \description{ 7 | A central composite design with 4 factors in 2 blocks. These data 8 | comprise a \code{\link{coded.data}} object. 9 | } 10 | \usage{heli} 11 | \format{ 12 | A data frame with 30 observations on the following 7 variables. 13 | Each observation reflects the results of 10 replicated flights under the 14 | same experimental conditions. 15 | \describe{ 16 | \item{\code{block}}{a factor with levels \code{1} \code{2}. 17 | Block 1 consists of 18 observations (a full factorial plus two center points). 18 | Block 2 consists of 12 observations -- 8 axis points and 4 center points.} 19 | \item{\code{x1}}{a numeric vector. Coded wing area, \code{x1 ~ (A - 12.4)/.6}} 20 | \item{\code{x2}}{a numeric vector. Coded length ratio, \code{x2 ~ (R - 2.52)/.26}} 21 | \item{\code{x3}}{a numeric vector. Coded body width, \code{x3 ~ (W - 1.25)/.25}} 22 | \item{\code{x4}}{a numeric vector. Coded body length, \code{x4 ~ (L - 2)/.5}} 23 | \item{\code{ave}}{a numeric vector. Average flight time, in csec.} 24 | \item{\code{logSD}}{a numeric vector. 100*log(SD of times).} 25 | } 26 | } 27 | \source{ 28 | Table 12.5 of Box, GEP, Hunter, JS, and Hunter, WG (2005) 29 | \emph{Statistics for Experimenters} (2nd ed.), Wiley. 30 | } 31 | \keyword{datasets} 32 | -------------------------------------------------------------------------------- /.github/workflows/pkgdown.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | pull_request: 7 | branches: [main, master] 8 | release: 9 | types: [published] 10 | workflow_dispatch: 11 | 12 | name: pkgdown 13 | 14 | permissions: read-all 15 | 16 | jobs: 17 | pkgdown: 18 | runs-on: ubuntu-latest 19 | # Only restrict concurrency for non-PR jobs 20 | concurrency: 21 | group: pkgdown-${{ github.event_name != 'pull_request' || github.run_id }} 22 | env: 23 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 24 | permissions: 25 | contents: write 26 | steps: 27 | - uses: actions/checkout@v4 28 | 29 | - uses: r-lib/actions/setup-pandoc@v2 30 | 31 | - uses: r-lib/actions/setup-r@v2 32 | with: 33 | use-public-rspm: true 34 | 35 | - uses: r-lib/actions/setup-r-dependencies@v2 36 | with: 37 | extra-packages: any::pkgdown, local::. 38 | needs: website 39 | 40 | - name: Build site 41 | run: pkgdown::build_site_github_pages(new_process = FALSE, install = FALSE) 42 | shell: Rscript {0} 43 | 44 | - name: Deploy to GitHub pages 🚀 45 | if: github.event_name != 'pull_request' 46 | uses: JamesIves/github-pages-deploy-action@v4.5.0 47 | with: 48 | clean: false 49 | branch: gh-pages 50 | folder: docs 51 | 52 | -------------------------------------------------------------------------------- /R/zzz.R: -------------------------------------------------------------------------------- 1 | ############################################################################## 2 | # Copyright (c) 2025 Russell V. Lenth # 3 | # # 4 | # This file is part of the rsm package for R (*rsm*) # 5 | # # 6 | # *rsm* is free software: you can redistribute it and/or modify # 7 | # it under the terms of the GNU General Public License as published by # 8 | # the Free Software Foundation, either version 2 of the License, or # 9 | # (at your option) any later version. # 10 | # # 11 | # *rsm* is distributed in the hope that it will be useful, # 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of # 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # 14 | # GNU General Public License for more details. # 15 | # # 16 | # A copy of the GNU General Public License is available at # 17 | # # 18 | ############################################################################## 19 | 20 | 21 | .onLoad = function(libname, pkgname) { 22 | if (requireNamespace("emmeans", quietly = TRUE)) 23 | emmeans::.emm_register("rsm", pkgname) 24 | } 25 | -------------------------------------------------------------------------------- /man/model.data.Rd: -------------------------------------------------------------------------------- 1 | % Copyright (c) 2008-2010, 2012-2025 Russell V. Lenth 2 | \name{model.data} 3 | \alias{model.data} 4 | \title{Reconstruct data from a linear model} 5 | \description{ 6 | Create a data frame with just the variables in the formula in 7 | a \code{lm} object. 8 | This is comparable to \code{\link{model.matrix}} or \code{\link{model.frame}} except that factors, 9 | polynomials, transformations, etc. are not expanded. 10 | } 11 | \usage{ 12 | model.data(lmobj, lhs = FALSE) 13 | } 14 | %- maybe also 'usage' for other objects documented here. 15 | \arguments{ 16 | \item{lmobj}{An object returned by \code{\link{lm}} or one of its relatives.} 17 | \item{lhs}{Boolean indicator of whether or not to include the variable(s) 18 | on the left-hand side of the model formula.} 19 | } 20 | \details{ 21 | This is an easy-to-use substitute for \code{\link{get_all_vars}}. 22 | The \code{formula}, \code{data}, and \code{subset} arguments, if present in 23 | \code{lmobj}'s call, affect the result appropriately. 24 | } 25 | \value{ 26 | A data frame containing each of the variables referenced in the model formula. 27 | } 28 | \references{ 29 | Lenth RV (2009) ``Response-Surface Methods in R, Using rsm'', 30 | \emph{Journal of Statistical Software}, 32(7), 1--17. 31 | \doi{10.18637/jss.v032.i07} 32 | } 33 | \author{ Russell V. Lenth } 34 | 35 | \seealso{\code{\link{model.matrix}}, \code{\link{model.frame}}} 36 | \examples{ 37 | library(rsm) 38 | trees.lm <- lm(log(Volume) ~ poly(log(Girth),3), data = trees, subset = 1:20) 39 | model.frame(trees.lm) 40 | model.data(trees.lm) 41 | } 42 | % Add one or more standard keywords, see file 'KEYWORDS' in the 43 | % R documentation directory. 44 | \keyword{ regression } 45 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | R package **rsm**: Response-surface methods and visualization 2 | ==== 3 | 4 | [![Build Status](https://travis-ci.org/rvlenth/rsm.svg?branch=master)](https://travis-ci.org/rvlenth/rsm) 5 | [![cran version](http://www.r-pkg.org/badges/version/rsm)](https://cran.r-project.org/package=rsm) 6 | [![downloads](http://cranlogs.r-pkg.org/badges/rsm)](http://cranlogs.r-pkg.org/badges/rsm) 7 | [![total downloads](http://cranlogs.r-pkg.org/badges/grand-total/rsm)](http://cranlogs.r-pkg.org/badges/grand-total/rsm) 8 | [![Research software impact](http://depsy.org/api/package/cran/rsm/badge.svg)](http://depsy.org/package/r/rsm) 9 | 10 | 11 | ## Features 12 | * Response-surface methods have to do with conducting a series of small experiments to find the optimum operating conditions for a process. The **rsm** package provides tools for designing response-surface experiments, analyzing the results, finding promising new settings for future experiments, and visualization of fitted response surfaces. 13 | * The package has three vignettes that will help orient the first-time user. Calling `vignette("article", package = "rsm")` brings up an updated rendering of the original *JSS* article that describes all of its functionality. A tutorial is available via `vignette("illus", package = "rsm")` -- it gives an illustration of how the package can be used. And one on **rsm**'s plotting capabilities is available via `vignette("plots", package = "rsm")`; it shows details for contour, image, or perspective plots. 14 | * Includes support for a coded-data structure, important for expressing the design layout relative to a central location. 15 | * Standard first- and second-order designs may be generated and appropriately randomized. 16 | * Facilities are provided for augmenting a design -- for example, adding a foldover block or a set of axis points. 17 | * The `rsm` function is a special extension of `lm` that facilitates fitting and evaluating first- and second-order models. Special functions `FO()`, `SO()`, `PQ()`, and `TWI()` are used to generate first-order, second-order, pure quadratic, and two-way-interaction predictors for a model. 18 | * Functions such as `steepest()` allow for finding follow-up experiments in terms of coded or decoded predictors. 19 | * Graphical tools are provided for creating contour and other plots -- not just for `rsm` objects, abut for any `lm` object with continuous predictors. 20 | 21 | ## Installation 22 | * To install latest version from CRAN, run 23 | ``` 24 | install.packages("rsm") 25 | ``` 26 | Release notes for the latest CRAN version are found at [http://cran.r-project.org/web/packages/rsm/NEWS](http://cran.r-project.org/web/packages/rsm/NEWS) -- or do `news(package = "rsm")` for notes on the version you have installed. 27 | 28 | * To install the latest development version from Github, have the newest **devtools** package installed, then run 29 | ``` 30 | devtools::install_github("rvlenth/rsm", dependencies = TRUE) 31 | ``` 32 | For latest release notes on this development version, see the [NEWS file](https://github.com/rvlenth/rsm/blob/master/inst/NEWS) 33 | -------------------------------------------------------------------------------- /man/rsm-package.Rd: -------------------------------------------------------------------------------- 1 | % Copyright (c) 2008-2010, 2012-2025 Russell V. Lenth 2 | \name{rsm-package} 3 | \alias{rsm-package} 4 | \docType{package} 5 | \title{ 6 | Response-surface analysis 7 | } 8 | \description{ 9 | The \code{rsm} package provides functions useful for designing and analyzing 10 | experiments that are done sequentially in hopes of optimizing a response surface. 11 | 12 | The function \code{\link{ccd}} can generate (and randomize) a central-composite 13 | design; it allows the user to specify an aliasing or fractional blocking structure. 14 | The function \code{\link{bbd}} generates and randomizes a Box-Behnken design. 15 | The function \code{\link{ccd.pick}} is useful for identifying good parameter choices 16 | in central-composite designs. Functions \code{cube}, \code{star}, \code{foldover}, \code{dupe}, and \code{djoin} are also provided to build-up designs from individual blocks. The function \code{varfcn} allows the experimenter to examine the predictive capabilities of a design before collecting data. 17 | 18 | The function \code{\link{rsm}} is an enhancement of \code{\link{lm}} that provides 19 | for additional analyses peculiar to response surfaces. It requires a model formula 20 | that contains a call to \code{\link{FO}} or \code{\link{SO}} to specify a first- or 21 | second-order model. Once the model is fitted, the \code{\link{steepest}} 22 | function may be used to obtain the direction of steepest ascent (or descent). 23 | \code{\link{canonical.path}} is an alternative to \code{steepest} for second-order 24 | response surfaces. 25 | 26 | In RSM methods, appropriate coding of data is 27 | important not only for numerical stability, but for proper scaling 28 | of results; the function \code{\link{coded.data}} and its relatives facilitate 29 | this coding requirement. 30 | 31 | Finally, a few more functions are provided that may be useful beyond response-surface applications. 32 | \code{\link{contour.lm}}, \code{\link{persp.lm}}, and \code{\link{image.lm}} aids in visualizing a response surface, 33 | or of any other \code{lm} object where a surface is fitted. \code{\link{model.data}} 34 | recovers the data used in a \code{lm} call, but unlike \code{model.frame}, no 35 | polynomials, factors, etc. are expanded. 36 | 37 | For more information and examples, use \samp{vignette("rsm")} and \samp{vignette("rs-illus")}. 38 | Additionally, \samp{vignette("rsm-plots")} provides some illustrations 39 | of the graphics functions. 40 | } 41 | \author{ 42 | Russell V. Lenth 43 | 44 | Maintainer: Russell V. Lenth 45 | } 46 | \references{ 47 | Box, GEP, Hunter, JS, and Hunter, WG (2005) 48 | \emph{Statistics for Experimenters} (2nd ed.), Wiley-Interscience. 49 | 50 | Lenth RV (2009) ``Response-Surface Methods in R, Using rsm'', 51 | \emph{Journal of Statistical Software}, 32(7), 1--17. 52 | \doi{10.18637/jss.v032.i07} 53 | 54 | Myers, RH, Montgomery, DC, and Anderson-Cook, CM (2009), 55 | \emph{Response Surface Methodology} (3rd ed.), Wiley. 56 | } 57 | \keyword{ package } 58 | \keyword{ regression } 59 | 60 | -------------------------------------------------------------------------------- /R/ccd.pick.R: -------------------------------------------------------------------------------- 1 | ############################################################################## 2 | # Copyright (c) 2008-2010, 2012-2025 Russell V. Lenth # 3 | # # 4 | # This file is part of the rsm package for R (*rsm*) # 5 | # # 6 | # *rsm* is free software: you can redistribute it and/or modify # 7 | # it under the terms of the GNU General Public License as published by # 8 | # the Free Software Foundation, either version 2 of the License, or # 9 | # (at your option) any later version. # 10 | # # 11 | # *rsm* is distributed in the hope that it will be useful, # 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of # 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # 14 | # GNU General Public License for more details. # 15 | # # 16 | # A copy of the GNU General Public License is available at # 17 | # # 18 | ############################################################################## 19 | 20 | ### Find good ccds 21 | 22 | ccd.pick = function(k, n.c=2^k, n0.c=1:10, blks.c=1, n0.s=1:10, 23 | bbr.c=1, wbr.s=1, bbr.s=1, best=10, 24 | sortby=c("agreement","N"), restrict) 25 | { 26 | grid = expand.grid (n.c=n.c, n0.c=n0.c, blks.c=blks.c, n.s=NA, n0.s=n0.s, bbr.c=bbr.c, wbr.s=wbr.s, bbr.s=bbr.s) 27 | grid$n.s = 2 * k * grid$wbr.s 28 | grid$N = with(grid, blks.c * bbr.c * (n.c + n0.c) + bbr.s * (2 * k * wbr.s + n0.s)) 29 | grid$alpha.rot = (with(grid, n.c * blks.c * bbr.c / (wbr.s * bbr.s))) ^ .25 30 | num = with(grid, n.c * (2 * k * wbr.s + n0.s)) 31 | den = with(grid, 2 * wbr.s * (n.c + n0.c)) 32 | grid$alpha.orth = sqrt(num / den) 33 | agreement = with(grid, abs(log(alpha.rot / alpha.orth))) 34 | 35 | # remove combinations that don't have enough d.f. 36 | extra.df = with(grid, n.c * blks.c - (k * (k + 1)/2 + blks.c)) 37 | grid = grid[extra.df >= 0, ] 38 | 39 | if (!missing(restrict)) 40 | for (restr in restrict) { 41 | r = with(grid, eval(parse(text=restr))) 42 | grid = grid[r,] 43 | } 44 | 45 | # regenerate 'agreement' in case # rows changed 46 | agreement = with(grid, abs(log(alpha.rot / alpha.orth))) 47 | if (!is.null(sortby)) { 48 | keys = list() 49 | for (key in sortby) 50 | keys[[key]] = with(grid, eval(parse(text=key))) 51 | ord = do.call("order", keys) 52 | } 53 | else 54 | ord = 1:nrow(grid) 55 | lim = min(best, nrow(grid)) 56 | ans = grid[ord[1:lim], ] 57 | row.names(ans) = 1:lim 58 | ans 59 | } 60 | -------------------------------------------------------------------------------- /man/FO.Rd: -------------------------------------------------------------------------------- 1 | % Copyright (c) 2008-2010, 2012-2025 Russell V. Lenth 2 | \name{FO} 3 | \alias{FO} 4 | \alias{TWI} 5 | \alias{PQ} 6 | \alias{SO} 7 | \alias{PE} 8 | \title{Response-surface model components} 9 | \description{ 10 | Use of one of these functions in a model is how you specify the portion of the model 11 | that is to be regarded as a response-surface component. 12 | } 13 | \usage{ 14 | FO (...) 15 | TWI (..., formula) 16 | PQ (...) 17 | SO (...) 18 | PE (...) 19 | } 20 | \arguments{ 21 | \item{\dots}{The numerical predictors for the response surface, 22 | separated by commas.} 23 | \item{formula}{Alternative way to specify two-way interactions. Use \code{formula} or \code{\dots}, never both.} 24 | } 25 | \details{ 26 | Use \code{FO()} in the model formula in \code{\link{rsm}} 27 | to specify a first-order response surface (i.e., a linear function) 28 | in its arguments. Use \code{TWI()} to generate two-way interactions, and \code{PQ()} to generate 29 | pure quadratic terms (squares of the \code{FO()} terms). A call to 30 | \code{SO()} creates all terms in \code{FO()}, \code{TWI()}, and \code{PQ()} (in that order) for those 31 | variables. However, specifying \code{SO()} in a model formula in \code{rsm} will be replaced 32 | by the explicit sum of model terms, so that the \code{anova} table shows separate sums of squares. 33 | Other variables (such as blocks or factors) may be included in the model 34 | but should never be included in the arguments to \code{FO} or \code{SO}. 35 | 36 | \code{PE} is used for fitting pure-error models. It should not be used in 37 | response-surface models. This function exists primarily for use 38 | by \code{\link{loftest}}, but could be useful in other linear-model 39 | contexts for fitting a model that interpolates the means at each distinct 40 | combination of argument values. 41 | 42 | The \code{formula} argument in \code{TWI} can simplify specifying models where only certain interactions are included. For example, \samp{TWI(formula = ~x1:(x2+x3))} is equivalent to \samp{TWI(x1,x2) + TWI(x1,x3)}. The formula is expanded using \code{\link{terms}}, and then only the second-order terms are retained. If this results in only one term, an error condition is raised. This is necessary to prevent \code{\link{rsm}} from getting confused in identifying second-order terms. 43 | } 44 | \value{ 45 | The functions \code{FO}, \code{TWI}, \code{PQ}, and \code{SO} return a matrix whose 46 | columns are the required predictors. 47 | 48 | \code{PE} returns a \code{factor} whose levels are all the distinct combinations of 49 | arguments provided to the function. 50 | } 51 | \examples{ 52 | ### See 'rsm' help for examples of FO, TWI, etc 53 | 54 | library(rsm) 55 | ### Test LOF for a regression model 56 | ChemReact.lm <- lm(Yield ~ Time*Temp, data = ChemReact1) 57 | PureError.lm <- update (ChemReact.lm, . ~ PE(Time,Temp)) 58 | anova (ChemReact.lm, PureError.lm) 59 | } 60 | \references{ 61 | Lenth RV (2009) ``Response-Surface Methods in R, Using rsm'', 62 | \emph{Journal of Statistical Software}, 32(7), 1--17. 63 | \doi{10.18637/jss.v032.i07} 64 | } 65 | \author{Russell V. Lenth} 66 | \seealso{\code{\link{rsm}}} 67 | \keyword{regression} 68 | -------------------------------------------------------------------------------- /man/bbd.Rd: -------------------------------------------------------------------------------- 1 | % Copyright (c) 2008-2010, 2012-2025 Russell V. Lenth 2 | \name{bbd} 3 | \alias{bbd} 4 | \title{Generate a Box-Behnken design} 5 | \description{ 6 | This function can generate a Box-Behnken design in 3 to 7 factors, and optionally will block it orthogonally if there are 4 or 5 factors. It can also randomize the design. 7 | } 8 | \usage{ 9 | bbd(k, n0 = 4, block = (k == 4 | k == 5), randomize = TRUE, coding) 10 | } 11 | %- maybe also 'usage' for other objects documented here. 12 | \arguments{ 13 | \item{k}{A formula, or an integer giving the number of variables. If the formula has a left-hand side, the variables named there are appended to the design and initialized to \code{NA}.} 14 | \item{n0}{Number of center points in each block.} 15 | \item{block}{Logical value specifying whether or not to block the design; or a character string (taken as \code{TRUE}) giving the desired name for the blocking factor. 16 | Only BBDs with 4 or 5 factors can be blocked. A 4-factor BBD has three orthogonal blocks, and a 5-factor BBD has two.} 17 | \item{randomize}{Logical value determining whether or not to randomize the design. If \code{block} is \code{TRUE}, each block is randomized separately.} 18 | \item{coding}{Optional list of formulas. If this is provided, it overrides the default coding formulas.} 19 | } 20 | \details{ 21 | Box-Behnken designs (BBDs) are useful designs for fitting second-order response-surface models. They use only three levels of each factor (compared with 5 for central-composite designs) and sometimes fewer runs are required than a CCD. 22 | This function uses an internal table of BBDs; it only works for 3 to 7 factors. 23 | 24 | If \code{k} is specified as a formula, the names in the formula determine the names of the factors in the generated design. Otherwise, the names will be \code{x1, x2, ...}. If \code{coding} is not specified, default codings are created in the form \samp{x ~ x.as.is}. 25 | } 26 | \value{ 27 | A \code{\link{coded.data}} object with the generated design and the additional valiables \code{run.order} and \code{std.order}. The blocking variable, if present, will be a \code{\link{factor}}; all other variables will be numeric. 28 | } 29 | \note{ 30 | To avoid aliasing the pure-quadratic terms, you must use a positive value of \code{n0}. 31 | 32 | The non-exported function \code{rsm:::.bbd.1.41} is provided in case it is needed by other packages for compatibility with old versions of \pkg{rsm} (version 1.41 or earlier). Given the same seed, it will also reproduce the randomization as a previously generated design from an old version. 33 | } 34 | \references{ 35 | Lenth RV (2009) ``Response-Surface Methods in R, Using rsm'', 36 | \emph{Journal of Statistical Software}, 32(7), 1--17. 37 | \doi{10.18637/jss.v032.i07} 38 | 39 | Myers, RH, Montgomery, DC, and Anderson-Cook, CM (2009) 40 | \emph{Response Surface Methodology} (3rd ed.), Wiley. 41 | } 42 | \author{Russell V. Lenth} 43 | \seealso{\code{\link{ccd}}, \code{\link{coded.data}}} 44 | \examples{ 45 | library(rsm) 46 | 47 | ### Simple 3-factor case, not randomized so structure is evident 48 | bbd(3, randomize=FALSE) 49 | 50 | ### 5-factor BBD, divided between two plants 51 | bbd(y1 + y2 ~ A + B + C + D + E, n0 = 5, block = "Plant") 52 | } 53 | % Add one or more standard keywords, see file 'KEYWORDS' in the 54 | % R documentation directory. 55 | \keyword{design} 56 | -------------------------------------------------------------------------------- /man/djoin.Rd: -------------------------------------------------------------------------------- 1 | % Copyright (c) 2008-2010, 2012-2025 Russell V. Lenth 2 | \name{djoin} 3 | 4 | \alias{djoin} 5 | \alias{stdorder} 6 | 7 | \title{Join designs together into a blocked design} 8 | \description{ 9 | This implements the \pkg{rsm} package's building-block provisions for handling 10 | sequences of experiments. We often want to join two or more designs into one blocked design for purposes of analysis. 11 | } 12 | \usage{ 13 | djoin(design1, design2, \dots, blkname = "Block", blocklev) 14 | stdorder(design) 15 | } 16 | \arguments{ 17 | \item{design1}{A \code{coded.data} object (must have been created by \pkg{rsm} 2.00 or higher).} 18 | \item{design2}{A \code{data.frame} (or \code{coded.data}) to be appended; 19 | or a call to a function that will create a design} 20 | \item{\dots}{Additional designs to be appended} 21 | \item{blkname}{Name to give to the blocking variable that distinguishes the designs that are joined} 22 | \item{blocklev}{Label to use in the blocking variable for the added design} 23 | \item{design}{A \code{coded.data} object to be displayed.} 24 | } 25 | \details{ 26 | \code{djoin} may be used to augment a design with all manner of other designs, including regular designs generated by \code{\link{cube}} and its relatives, \code{data.frames}, and other \code{coded.data} objects. The underlying paradigm is that each design joined is a separate block, and the order in which they are joined could matter. 27 | 28 | It tries to do this in a smart way: The first design, \code{design1}, is required to be a \code{\link{coded.data}} object. If \code{design2} is a \code{\link{data.frame}}, and variables with the coded names are not present, it is automatically coded according to \code{design1}'s coding formulas. If \code{design2} is a \code{coded.data} object, and its coding formulas differ from those of \code{design1}, then \code{design1} is recoded with \code{design2}'s codings before the designs are joined. In both cases, any variables in \code{design2} not matched in \code{design1} are excluded, and any \code{design1} variables absent in \code{design2} are added with values of \code{NA}. 29 | } 30 | 31 | \value{ 32 | \code{djoin} returns a \code{\link{coded.data}} object with the combined designs, and coding formulas from the last \code{coded.data} object added. The generated blocking variable will be a \code{\link{factor}}. The designs are sorted by blocks and \code{run.order} within blocks; and its \code{row.names} will be integers corresponding to this ordering. 33 | 34 | The function \code{stdorder} sorts such data by block and \code{std.order} within block to display the designs in their pre-randomized order. 35 | } 36 | 37 | \author{Russell V. Lenth} 38 | 39 | \seealso{\code{\link{cube}}, \code{\link{coded.data}}, \code{\link{bbd}}} 40 | \examples{ 41 | # Some existing data 42 | CR1 <- coded.data(ChemReact1, x1 ~ (Time - 85)/5, x2 ~ (Temp - 175)/5) 43 | # add the second part of the experiment; it gets coded automagically 44 | djoin(CR1, ChemReact2) 45 | 46 | # A new experiment in a different part of the design space 47 | newdes <- cube(Yield ~ x1 + x2, n0 = 3, 48 | coding = c(x1 ~ (Time - 70)/10, x2 ~ (Temp - 180)/5)) 49 | # Time passes ... we do the experiment and plug-in the observed Yield values 50 | newdes$Yield <- rnorm(7, 75, 3) # these are our pretend results 51 | combined <- djoin(CR1, newdes) 52 | # Observe that the combined dataset is recoded to the new formulas 53 | print(combined, decode = FALSE) 54 | 55 | # List the new design in standard order 56 | stdorder(newdes) 57 | } 58 | % Add one or more standard keywords, see file 'KEYWORDS' in the 59 | % R documentation directory. 60 | \keyword{design} 61 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # non-base package imports: 2 | 3 | importFrom("grDevices", 4 | "contourLines", 5 | "rainbow", 6 | "terrain.colors", 7 | "trans3d") 8 | 9 | importFrom("stats", 10 | "anova", 11 | "as.formula", 12 | "coef", 13 | "delete.response", 14 | "formula", 15 | "lm", 16 | "model.frame", 17 | "model.matrix", 18 | "na.pass", 19 | "p.adjust", 20 | "p.adjust.methods", 21 | "pf", 22 | "predict", 23 | "printCoefmat", 24 | "reformulate", 25 | "rnorm", 26 | "runif", 27 | "sd", 28 | "terms", 29 | "uniroot", 30 | "update", 31 | "weights") 32 | 33 | import(graphics) 34 | 35 | 36 | # Methods 37 | 38 | S3method(print, coded.data) 39 | S3method(print, summary.rsm) 40 | S3method(summary, rsm) 41 | S3method("[", coded.data) 42 | S3method(codings, coded.data) 43 | S3method(codings, rsm) 44 | S3method("names<-", coded.data) 45 | S3method(truenames, coded.data) 46 | S3method("truenames<-", coded.data) 47 | 48 | S3method(contour, lm) 49 | S3method(image, lm) 50 | S3method(persp, lm) 51 | 52 | # emmeans support 53 | # if (requireNamespace("emmeans", quietly = TRUE)) { 54 | # importFrom("emmeans", "recover_data", "emm_basis") 55 | # importFrom("estimability", "all.estble", "nonest.basis") 56 | # S3method(recover_data, rsm) 57 | # S3method(emm_basis, rsm) 58 | # } 59 | # emmeans support -- 60 | # See zzz.R where we dynamically register these methods 61 | # export (recover_data.rsm, emm_basis.rsm) 62 | 63 | # lsmeans support -- important thing is not to import lsmeans stuff, 64 | # export (recover.data.rsm, lsm.basis.rsm) 65 | 66 | 67 | # Exports 68 | 69 | ### exportPattern("^[[:alpha:]]+") - using explicit exports below 70 | #--- export all that don't start with "." 71 | #exportPattern("^[^\\.]") 72 | 73 | # --- to make Ulrike's life easier... 74 | #export(.ccd.1.41, .bbd.1.41) 75 | 76 | export( 77 | # ".bbd.1.41", 78 | # ".ccd.1.41", 79 | # "[.coded.data", 80 | "as.coded.data", 81 | "bbd", 82 | "canonical", 83 | "canonical.path", 84 | "ccd", 85 | "ccd.pick", 86 | "ChemReact", 87 | "ChemReact1", 88 | "ChemReact2", 89 | "codata", 90 | "code2val", 91 | "coded.data", 92 | "codings", 93 | # "codings.coded.data", 94 | # "codings.rsm", 95 | "codings<-", 96 | "contour.lm", 97 | "cube", 98 | "decode.data", 99 | "djoin", 100 | "dupe", 101 | "FO", 102 | "foldover", 103 | "heli", 104 | "image.lm", 105 | "is.coded.data", 106 | "loftest", 107 | # "lsm.basis.rsm", 108 | "model.data", 109 | # "names<-.coded.data", 110 | "PE", 111 | "persp.lm", 112 | "PQ", 113 | # "print.coded.data", 114 | # "print.summary.rsm", 115 | "recode.data", 116 | # "recover.data.rsm", 117 | "rsm", 118 | "SO", 119 | "star", 120 | "stdorder", 121 | "steepest", 122 | "summary.rsm", 123 | "truenames", 124 | # "truenames.coded.data", 125 | "truenames<-", 126 | # "truenames<-.coded.data", 127 | "TWI", 128 | "val2code", 129 | "varfcn", 130 | "xs" 131 | ) 132 | -------------------------------------------------------------------------------- /R/emmeans-support.R: -------------------------------------------------------------------------------- 1 | ############################################################################## 2 | # Copyright (c) 2025 Russell V. Lenth # 3 | # # 4 | # This file is part of the rsm package for R (*rsm*) # 5 | # # 6 | # *rsm* is free software: you can redistribute it and/or modify # 7 | # it under the terms of the GNU General Public License as published by # 8 | # the Free Software Foundation, either version 2 of the License, or # 9 | # (at your option) any later version. # 10 | # # 11 | # *rsm* is distributed in the hope that it will be useful, # 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of # 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # 14 | # GNU General Public License for more details. # 15 | # # 16 | # A copy of the GNU General Public License is available at # 17 | # # 18 | ############################################################################## 19 | 20 | # emmeans support ... 21 | # We'll support a 'mode' argument with 3 possibilities: 22 | # - "asis" - just passes throu like an lm model, no matter what 23 | # - "coded" - do not decode predictors, even if coding is present 24 | # - "decoded" - if coding is present, decode the predictors and 25 | # present results working on the decoded scale. 26 | 27 | recover_data.rsm = function(object, data, mode = c("asis", "coded", "decoded"), ...) { 28 | mode = match.arg(mode) 29 | cod = codings(object) 30 | fcall = object$call 31 | if(is.null(data)) 32 | data = emmeans::recover_data(fcall, delete.response(terms(object)), 33 | object$na.action, weights = weights(object), ...) 34 | if (!is.null(cod) && (mode == "decoded")) { 35 | pred = cpred = attr(data, "predictors") 36 | trms = attr(data, "terms") 37 | data = decode.data(as.coded.data(data, formulas = cod)) 38 | for (form in cod) { 39 | vn = all.vars(form) 40 | if (!is.na(idx <- grep(vn[1], pred))) { 41 | pred[idx] = vn[2] 42 | cpred = setdiff(cpred, vn[1]) 43 | } 44 | } 45 | attr(data, "predictors") = pred 46 | new.trms = update(trms, reformulate(c("1", cpred))) # excludes coded variables 47 | attr(new.trms, "orig") = trms # save orig terms as an attribute 48 | attr(data, "terms") = new.trms 49 | } 50 | data 51 | } 52 | 53 | emm_basis.rsm = function(object, trms, xlev, grid, 54 | mode = c("asis", "coded", "decoded"), ...) { 55 | mode = match.arg(mode) 56 | cod = codings(object) 57 | if(!is.null(cod) && mode == "decoded") { 58 | grid = coded.data(grid, formulas = cod) 59 | trms = attr(trms, "orig") # get back the original terms we saved 60 | } 61 | 62 | m = model.frame(trms, grid, na.action = na.pass, xlev = xlev) 63 | X = model.matrix(trms, m, contrasts.arg = object$contrasts) 64 | bhat = as.numeric(object$coefficients) 65 | V = emmeans::.my.vcov(object, ...) 66 | 67 | if (sum(is.na(bhat)) > 0) 68 | nbasis = estimability::nonest.basis(object$qr) 69 | else 70 | nbasis = estimability::all.estble 71 | dfargs = list(df = object$df.residual) 72 | dffun = function(k, dfargs) dfargs$df 73 | 74 | list(X = X, bhat = bhat, nbasis = nbasis, V = V, 75 | dffun = dffun, dfargs = dfargs, misc = list()) 76 | } 77 | 78 | 79 | # ### For lsmeans 80 | # recover.data.rsm = function (...) 81 | # recover_data.rsm (...) 82 | # 83 | # lsm.basis.rsm = function (...) 84 | # emm_basis.rsm (...) -------------------------------------------------------------------------------- /man/varfcn.Rd: -------------------------------------------------------------------------------- 1 | % Copyright (c) 2008-2010, 2012-2025 Russell V. Lenth 2 | \name{varfcn} 3 | \alias{varfcn} 4 | \title{ 5 | Display the scaled variance function for a design 6 | } 7 | \description{ 8 | This function computes the scaled variance function for a design, based on a 9 | specified model. Options include plotting separate curves for each of several 10 | directions from the center, or a contour plot for two of the design factors. 11 | } 12 | \usage{ 13 | varfcn(design, formula, dist = seq(0, 2, by = 0.1), vectors, contour = FALSE, 14 | plot = TRUE, main, ...) 15 | } 16 | \arguments{ 17 | \item{design}{A \code{data.frame} or \code{coded.data} object} 18 | \item{formula}{The model formula for which to compute the variance function} 19 | \item{dist}{Vector of distances from the origin at which to compute the scaled variance} 20 | \item{vectors}{A \code{data.frame} of design variables. Each nonzero row specifies a direction in which to calculate the scaled variance.} 21 | \item{contour}{A logical variable. If \code{TRUE}, a contour plot is produced; if \code{FALSE}, curves are plotted for each direction in \code{vectors}.} 22 | \item{plot}{A logical variable. If \code{TRUE}, a plot is produced.} 23 | \item{main}{Title for the plot. The default is constructed based on the name of \code{design} and \code{formula}.} 24 | \item{\dots}{Other arguments passed to the \code{\link{plot}} or \code{\link{contour}} functions.} 25 | } 26 | \details{ 27 | The scaled prediction variance at a particular design point is the variance of the predicted value, multiplied by the sample size \emph{N}, and divided by the error variance. (See, for example, Montgomery \emph{et al.}, Section 8.2.1). It depends on the design point, but for a symmetric design, it depends only on the distance from the origin and the direction. This function provides a simple way to examine the variance function directly. (There are other more 28 | sophisticated methods available that integrate-out the direction, for example in the \pkg{vdg} package. 29 | 30 | If \code{vectors} is not specified and \code{contour==FALSE}, the function generates default directions along one axis, and on a diagonal through a corner in each dimension. For example, with four design variables, the default directions are (1,0,0,0), (1,1,0,0), (1,1,1,0), and (1,1,1,1). The graph produced shows how the scaled variance changes along each of these vectors, for the distances provided. In a rotatable design, these curves will all be the same. 31 | 32 | When \code{countour==TRUE}, only the ordering of columns in \code{vectors} matters. A grid is constructed over the distance range for the first two variables in \code{vectors}. The design points are also plotted for reference, with different symbol sizes depending on replications. When there are more than two response-surface predictors, the contour plot may be misleading, as it does not display what happens as one simultaneously varies three or more variables. 33 | } 34 | 35 | \value{The function invisibly returns a \code{data.frame} containing the data that was (or would have been) plotted.} 36 | 37 | \references{ 38 | Myers, RH Montgomery DC, and Anderson-Cook CM (2009) 39 | \emph{Response Surface Methodology} (3rd ed.), Wiley.} 40 | \author{Russell V. Lenth} 41 | 42 | %\note{} 43 | 44 | %% ~Make other sections like Warning with \section{Warning }{....} ~ 45 | 46 | \examples{ 47 | des = ccd(~ x1 + x2 + x3, alpha = 1.5, block = Phase ~ x1*x2*x3, randomize=FALSE) 48 | varfcn(des, ~ Phase + SO(x1, x2, x3)) 49 | varfcn(des, ~ Phase + SO(x1, x2, x3), contour=TRUE) 50 | 51 | # 10 random directions 52 | dirs = data.frame(x3=rnorm(10), x2=rnorm(10), x1=rnorm(10)) 53 | varfcn(des, ~ Phase + SO(x1, x2, x3), vectors = dirs) 54 | 55 | # exclude some points to make it more interesting 56 | lost = c(1,2,3,5,8,13,21) 57 | varfcn(des[-lost, ], ~ Phase + SO(x1, x2, x3), contour=TRUE) 58 | 59 | # different plot due to order of columns 60 | varfcn(des[-lost, ], ~ Phase + SO(x1, x2, x3), vectors = dirs, contour=TRUE) 61 | } 62 | % Add one or more standard keywords, see file 'KEYWORDS' in the 63 | % R documentation directory. 64 | \keyword{ design } 65 | -------------------------------------------------------------------------------- /man/steepest.Rd: -------------------------------------------------------------------------------- 1 | % Copyright (c) 2008-2010, 2012-2025 Russell V. Lenth 2 | \name{steepest} 3 | \alias{steepest} 4 | \alias{canonical.path} 5 | %- Also NEED an '\alias' for EACH other topic documented here. 6 | \title{Steepest-ascent methods for response surfaces} 7 | \description{ 8 | These functions provide the path of steepest ascent (or descent) 9 | for a fitted response surface produced by \code{\link{rsm}}. 10 | } 11 | \usage{ 12 | steepest (object, dist = seq(0, 5, by = .5), descent = FALSE) 13 | canonical.path(object, which = ifelse(descent, length(object$b), 1), 14 | dist = seq(-5, 5, by = 0.5), descent = FALSE, ...) 15 | } 16 | %- maybe also 'usage' for other objects documented here. 17 | \arguments{ 18 | \item{object}{\code{\link{rsm}} object to be analyzed.} 19 | \item{dist}{Vector of desired distances along the path of steepest ascent or descent. 20 | In \code{steepest}, these must all be non-negative; in \code{canonical.path}, 21 | you may want both positive and negative values, which specify opposite directions from the stationary point.} 22 | \item{descent}{Set this to \code{TRUE} to obtain the path of steepest descent, or 23 | \code{FALSE} to obtain the path of steepest ascent. This value is ignored in 24 | \code{canonical.path} if \code{which} is specified.} 25 | \item{which}{Which canonical direction (eigenvector) to use.} 26 | \item{...}{Optional arguments passed to \code{\link{canonical}}. 27 | Currently this includes only \code{threshold}.} 28 | } 29 | \details{ 30 | \code{steepest} returns the linear path of steepest ascent for first-order models, or a path obtained by ridge analysis (see Draper 1963) for second-order models. In either case, the path begins at the origin. 31 | 32 | \code{canonical.path} applies only to second-order models (at least a \code{TWI} term present). It determines a linear path along one of the canonical variables, originating at the stationary point (not the origin). We need to specify which canonical variable to use. 33 | The eigenvalues obtained in the canaonical analysis are always in decreasing order, so the first canonical direction will be the path of steepest ascent (or slowest descent, if all eigenvalues are negative) from the stationary point, and the last one will be the path of steepest descent (or slowest ascent, if all eigenvalues are positive). These are the defaults for \code{which} when \code{descent=FALSE} and \code{descent=TRUE} respectively. 34 | 35 | All eigenvalues less (in absolute value than) \code{threshold} are taken to be zero. Increasing this threshold may bring the stationary point, and hence the canonical path, much closer to the design center, and thus less extrapolation. 36 | 37 | With either function, the path in uncoded units depends on how the data are coded. Accordingly, it is important to code the predictor variables appropriately before fitting the response-surface model. See \code{\link{coded.data}} and its relatives for more information. 38 | } 39 | \value{ 40 | A \code{data.frame} of points along the path of steepest ascent (or descent). 41 | For \code{steepest}, this path originates from the center of the experiment; for \code{canonical.path}, 42 | it starts at the stationary point. 43 | If coding information is available, the data frame also includes the uncoded values of the variables. 44 | 45 | For first-order response surfaces, only \code{steepest} may be used; the path is linear in that case. 46 | For second-order surfaces, \code{steepest} uses ridge analysis, and the path may be curved. 47 | } 48 | \references{ 49 | Draper, NR (1963), ``Ridge analysis of response surfaces'', 50 | \emph{Technometrics}, 5, 469--479. 51 | 52 | Lenth RV (2009). ``Response-Surface Methods in R, Using rsm'', 53 | \emph{Journal of Statistical Software}, 32(7), 1--17. 54 | \doi{10.18637/jss.v032.i07} 55 | } 56 | \author{Russell V. Lenth} 57 | \note{ 58 | Take careful note of the fitted values along the outputted path (labeled \code{yhat}). For example, if the stationary point is a maximum 59 | (all eigenvalues negative), the fitted values from \code{steepest} will increase as far as the stationary point, then they will decrease as we proceed along what is now the path of slowest descent. 60 | } 61 | \seealso{\code{\link{rsm}}, \code{\link{coded.data}}} 62 | \examples{ 63 | library(rsm) 64 | heli.rsm = rsm (ave ~ block + SO(x1, x2, x3, x4), data = heli) 65 | 66 | steepest(heli.rsm) 67 | 68 | canonical.path(heli.rsm) 69 | } 70 | \keyword{regression} 71 | -------------------------------------------------------------------------------- /R/bbd.R: -------------------------------------------------------------------------------- 1 | ############################################################################## 2 | # Copyright (c) 2008-2010, 2012-2025 Russell V. Lenth # 3 | # # 4 | # This file is part of the rsm package for R (*rsm*) # 5 | # # 6 | # *rsm* is free software: you can redistribute it and/or modify # 7 | # it under the terms of the GNU General Public License as published by # 8 | # the Free Software Foundation, either version 2 of the License, or # 9 | # (at your option) any later version. # 10 | # # 11 | # *rsm* is distributed in the hope that it will be useful, # 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of # 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # 14 | # GNU General Public License for more details. # 15 | # # 16 | # A copy of the GNU General Public License is available at # 17 | # # 18 | ############################################################################## 19 | 20 | ### Generate a Box-Behnken design (up thru k=7) 21 | 22 | bbd = function(k, n0=4, block = (k==4|k==5), randomize=TRUE, coding) 23 | { 24 | reftbl = list(NULL, NULL, 25 | list(c(1,2),c(1,3),c(2,3)), # k=3 26 | list(c(1,2),c(3,4), c(1,4),c(2,3), c(1,3),c(2,4)), # k=4 27 | list(c(1,2),c(1,3),c(3,4),c(4,5),c(2,5), 28 | c(1,4),c(1,5),c(2,3),c(2,4),c(3,5)), # k=5 29 | list(c(1,2,4),c(2,3,5),c(3,4,6), 30 | c(1,4,5),c(2,5,6),c(1,3,6)), # k=6 31 | list(c(4,5,6),c(1,6,7),c(2,5,7),c(1,2,4), 32 | c(3,4,7),c(1,3,5),c(2,3,6)) # k=7 33 | ) 34 | 35 | CALL = match.call() 36 | yvars = NULL 37 | if (inherits(k, "formula")) { 38 | names = all.vars (k[[length(k)]]) 39 | if (length(k) > 2) yvars = all.vars(k[[2]]) 40 | k = length(names) 41 | } 42 | else 43 | names = paste("x", 1:k, sep="") 44 | 45 | if ((k<3) | (k>7)) 46 | stop("Box-Behnken designs are available only for k=3:7") 47 | 48 | clist = reftbl[[k]] 49 | if (length(clist[[1]])==2) 50 | tbl = expand.grid(c(-1,1),c(-1,1)) 51 | else 52 | tbl = expand.grid(c(-1,1),c(-1,1), c(-1,1)) 53 | n = nrow(tbl) 54 | des = as.data.frame(matrix(0, nrow=n*length(clist), ncol=k)) 55 | idx = 1:n - n 56 | for (i in 1:length(clist)) 57 | des[idx + i*n, clist[[i]]] = tbl 58 | 59 | if (is.character(block)) { 60 | blkname = block 61 | block = TRUE 62 | } 63 | else 64 | blkname = "Block" 65 | 66 | blk = 0 67 | if (block) { 68 | if (k==4) 69 | blk = c(rep(1:3, rep(2*n, 3)), rep(1:3, n0)) 70 | else if (k==5) 71 | blk = c(rep(1:2, rep(5*n, 2)), rep(1:2, n0)) 72 | else 73 | stop("Can only block when k=4 or k=5") 74 | nblk = ifelse(k==4, 3, 2) 75 | } 76 | else 77 | nblk = 1 78 | des = rbind(des, matrix(0, nrow=n0*nblk, ncol=k)) 79 | names(des) = names 80 | if (block) { 81 | des = cbind(factor(blk), des) 82 | names(des)[1] = blkname 83 | des = des[order(blk), ] 84 | } 85 | row.names(des) = 1:nrow(des) 86 | 87 | if (!is.null(yvars)) 88 | for (v in yvars) des[[v]] = NA 89 | 90 | if (missing(coding)) 91 | coding = sapply(names, function(v) as.formula(paste(v,"~",v,".as.is", sep=""))) 92 | des = as.coded.data (des, formulas=coding) 93 | 94 | # create design info as if each block is a CCD in one block 95 | N = nrow(des) / nblk 96 | rsd = list( 97 | primary = names, 98 | call = CALL 99 | # n0 = c(n0,0), 100 | # non0 = c(N-n0,0), 101 | # alpha = 1 102 | ) 103 | if (block) { 104 | # rsd$blk.info = rep(list(rsd), nblk) 105 | rsd$block = blkname 106 | } 107 | # rsd$call = CALL 108 | attr(des, "rsdes") = rsd 109 | 110 | des = .randomize(des, randomize=randomize) 111 | 112 | des 113 | } 114 | -------------------------------------------------------------------------------- /man/ccd.pick.Rd: -------------------------------------------------------------------------------- 1 | % Copyright (c) 2008-2010, 2012-2025 Russell V. Lenth 2 | \name{ccd.pick} 3 | \alias{ccd.pick} 4 | \title{Find a good central-composite design} 5 | \description{ 6 | This function looks at all combinations of specified design parameters 7 | for central-composite designs, calculates other quantities such as 8 | the \code{alpha} values for rotatability and orthogonal blocking, imposes 9 | specified restrictions, and outputs the best combinations in a specified order. 10 | This serves as an aid in identifying good designs. The design itself can 11 | then be generated using \code{\link{ccd}}, or in pieces using \code{\link{cube}}, \code{\link{star}}, etc. 12 | } 13 | \usage{ 14 | ccd.pick(k, n.c = 2^k, n0.c = 1:10, blks.c = 1, n0.s = 1:10, bbr.c = 1, 15 | wbr.s = 1, bbr.s = 1, best = 10, sortby = c("agreement", "N"), 16 | restrict) 17 | } 18 | %- maybe also 'usage' for other objects documented here. 19 | \arguments{ 20 | \item{k}{Number of factors in the design} 21 | \item{n.c}{Number(s) of factorial points in each cube block} 22 | \item{n0.c}{Numbers(s) of center points in each cube block} 23 | \item{blks.c}{Number(s) of cube blocks that together comprise one rep of the cube portion} 24 | \item{n0.s}{Numbers(s) of center points in each star (axis-point) block} 25 | \item{bbr.c}{Number(s) of copies of each cube block} 26 | \item{wbr.s}{Number(s) of replications of each star poit within a block} 27 | \item{bbr.s}{Number(s) of copies of each star block} 28 | \item{best}{How many designs to list. Use \code{best=NULL} to list them all} 29 | \item{sortby}{String(s) containing numeric expressions that are each evaluated and used as sorting key(s). 30 | Specify \code{sortby=NULL} if no sorting is desired.} 31 | \item{restrict}{Optional string(s) containing Boolean expressions that are each evaluated. Only combinations where all 32 | expressions are \code{TRUE} are retained.} 33 | } 34 | \details{ 35 | A grid is created with all combinations of \code{n.c}, \code{n0.c}, \dots, \code{bbr.s}. 36 | Then for each row of the grid, several additional variables 37 | are computed: 38 | \describe{ 39 | \item{\code{n.s}}{The total number of axis points in each star block} 40 | \item{\code{N}}{The total number of observations in the design} 41 | \item{\code{alpha.rot}}{The position of axis points that make the design rotatable. 42 | Rotatability is achieved when design moment [iiii] = 3[iijj] for i and j unequal.} 43 | \item{\code{alpha.orth}}{The position of axis points that make the blocks mutually orthogonal. 44 | This is achieved when design moments [ii] within each block are proprtional 45 | to the number of observations within the block.} 46 | \item{\code{agreement}}{The absolute value of the log of the ratio of 47 | \code{alpha.rot} and \code{alpha.orth}. This measures agreement between 48 | the two \code{alpha}s.} 49 | } 50 | If \code{restrict} is provided, only the cases where the expressions are all \code{TRUE} are kept. 51 | (Regardless of \code{restrict}, rows are eliminated where there are 52 | insufficient degrees of freedom to estimate all needed effects for a 53 | second-order model.) 54 | The rows are 55 | sorted according to the expressions in \code{sortby}; the default is to sort 56 | by \code{agreement} and \code{N}, which is suitable for finding designs 57 | that are both rotatable and orthogonally blocked. 58 | } 59 | \value{ 60 | A \code{data.frame} containing \code{best} or fewer rows, and variables 61 | \code{n.c}, \code{n0.c}, \code{blks.c}, \code{n.s}, \code{n0.s}, \code{bbr.c}, 62 | \code{wbr.s}, \code{bbr.s}, \code{N}, \code{alpha.rot}, and \code{alpha.orth}, 63 | as described above. 64 | } 65 | \references{ 66 | Lenth RV (2009) ``Response-Surface Methods in R, Using rsm'', 67 | \emph{Journal of Statistical Software}, 32(7), 1--17. 68 | \doi{10.18637/jss.v032.i07} 69 | 70 | Myers, RH, Montgomery, DC, and Anderson-Cook, CM (2009) 71 | \emph{Response Surface Methodology} (3rd ed.), Wiley. 72 | } 73 | \author{Russell V. Lenth} 74 | \seealso{\code{\link{ccd}}} 75 | \examples{ 76 | library(rsm) 77 | 78 | ### List CCDs in 3 factors with between 10 and 14 runs per block 79 | ccd.pick(3, n0.c=2:6, n0.s=2:8) 80 | # (Generate the design that is listed first:) 81 | # ccd(3, n0=c(6,4)) 82 | 83 | ### Find designs in 5 factors containing 1, 2, or 4 cube blocks 84 | ### of 8 or 16 runs, 1 or 2 reps of each axis point, 85 | ### and no more than 70 runs altogether 86 | ccd.pick(5, n.c=c(8,16), blks.c=c(1,2,4), wbr.s=1:2, restrict="N<=70") 87 | } 88 | % Add one or more standard keywords, see file 'KEYWORDS' in the 89 | % R documentation directory. 90 | \keyword{design} 91 | -------------------------------------------------------------------------------- /R/datasets.R: -------------------------------------------------------------------------------- 1 | # Chemical reactor data Table 7.6 of Myers et al. (2009), 2 | # Response Surface Methodology (3rd ed.), Wiley. 3 | 4 | #--- CCD in 2 blocks 5 | ChemReact <- 6 | structure(list(Time = c(80, 80, 90, 90, 85, 85, 85, 85, 85, 85, 7 | 92.07, 77.93, 85, 85), Temp = c(170, 180, 170, 180, 175, 175, 8 | 175, 175, 175, 175, 175, 175, 182.07, 167.93), Block = structure(c(1L, 9 | 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L), .Label = c("B1", 10 | "B2"), class = "factor"), Yield = c(80.5, 81.5, 82, 83.5, 83.9, 11 | 84.3, 84, 79.7, 79.8, 79.5, 78.4, 75.6, 78.5, 77)), .Names = c("Time", 12 | "Temp", "Block", "Yield"), class = "data.frame", row.names = c("1", 13 | "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", 14 | "14")) 15 | 16 | #--- Just the first block 17 | ChemReact1 <- 18 | structure(list(Time = c(80, 80, 90, 90, 85, 85, 85), Temp = c(170, 19 | 180, 170, 180, 175, 175, 175), Yield = c(80.5, 81.5, 82, 83.5, 20 | 83.9, 84.3, 84)), .Names = c("Time", "Temp", "Yield"), row.names = c("1", 21 | "2", "3", "4", "5", "6", "7"), class = "data.frame") 22 | 23 | #--- Just the 2nd block 24 | ChemReact2 <- 25 | structure(list(Time = c(85, 85, 85, 92.07, 77.93, 85, 85), Temp = c(175, 26 | 175, 175, 175, 175, 182.07, 167.93), Yield = c(79.7, 79.8, 79.5, 27 | 78.4, 75.6, 78.5, 77)), .Names = c("Time", "Temp", "Yield"), row.names = c("8", 28 | "9", "10", "11", "12", "13", "14"), class = "data.frame") 29 | 30 | 31 | # heli data -- CCD with 4 factors in 2 blocks 32 | # Table 12.5 of Box, GEP, Hunter, JS, and Hunter, WG (2005), 33 | # Statistics for Experimenters (2nd ed.), Wiley. 34 | # NOTE -- subsequent statements translate it to coded form 35 | heli <- 36 | structure(list(block = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 37 | 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 38 | 2L, 2L, 2L, 2L, 2L, 2L, 2L), .Label = c("1", "2"), class = "factor"), 39 | x1 = c(-1L, 1L, -1L, 1L, -1L, 1L, -1L, 1L, -1L, 1L, -1L, 40 | 1L, -1L, 1L, -1L, 1L, 0L, 0L, -2L, 2L, 0L, 0L, 0L, 0L, 0L, 41 | 0L, 0L, 0L, 0L, 0L), x2 = c(-1L, -1L, 1L, 1L, -1L, -1L, 1L, 42 | 1L, -1L, -1L, 1L, 1L, -1L, -1L, 1L, 1L, 0L, 0L, 0L, 0L, -2L, 43 | 2L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L), x3 = c(-1L, -1L, -1L, 44 | -1L, 1L, 1L, 1L, 1L, -1L, -1L, -1L, -1L, 1L, 1L, 1L, 1L, 45 | 0L, 0L, 0L, 0L, 0L, 0L, -2L, 2L, 0L, 0L, 0L, 0L, 0L, 0L), 46 | x4 = c(-1L, -1L, -1L, -1L, -1L, -1L, -1L, -1L, 1L, 1L, 1L, 47 | 1L, 1L, 1L, 1L, 1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, -2L, 48 | 2L, 0L, 0L, 0L, 0L), ave = c(367L, 369L, 374L, 370L, 372L, 49 | 355L, 397L, 377L, 350L, 373L, 358L, 363L, 344L, 355L, 370L, 50 | 362L, 377L, 375L, 361L, 364L, 355L, 373L, 361L, 360L, 380L, 51 | 360L, 370L, 368L, 369L, 366L), logSD = c(72L, 72L, 74L, 79L, 52 | 72L, 81L, 72L, 99L, 90L, 86L, 92L, 112L, 76L, 69L, 91L, 71L, 53 | 51L, 74L, 111L, 93L, 100L, 80L, 71L, 98L, 69L, 74L, 86L, 54 | 74L, 89L, 76L)), .Names = c("block", "x1", "x2", "x3", "x4", 55 | "ave", "logSD"), row.names = c(NA, -30L), class = c("data.frame")) 56 | # TRANSLATE TO CODED FORM 57 | heli = as.coded.data(heli, x1 ~ (A - 12.4)/0.6, x2 ~ (R - 2.52)/0.26, 58 | x3 ~ (W - 1.25)/0.25, x4 = x4 ~ (L - 2)/0.5) 59 | 60 | # CO emissions data - BH^2 2nd ed., Table 10.17, p.396. 61 | # See also sloping ridge discussion, pp 466-7 62 | codata <- 63 | structure(list(x1 = c(-1L, -1L, 0L, 0L, 1L, 1L, -1L, -1L, 0L, 0L, 1L, 1L, -1L, -1L, 0L, 0L, 1L, 1L), 64 | x2 = c(-1L, -1L, -1L, -1L, -1L, -1L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 1L, 1L, 1L, 1L, 1L), 65 | y = c(61.9, 65.6, 80.9, 78, 89.7, 93.8, 72.1, 67.3, 80.1, 81.4, 77.8, 74.8, 66.4, 68.2, 68.9, 66, 60.2, 57.9)), 66 | .Names = c("x1", "x2", "y"), class = "data.frame", row.names = c(NA, -18L)) 67 | 68 | # coded.data version - created via 69 | # CO <- as.coded.data(data = codata, x1 ~ (Ethanol - 0.2)/0.1, x2 ~ A.F.ratio - 15) 70 | # names(CO)[3] = "CO.conc" 71 | # CO <- 72 | # structure(list(x1 = c(-1L, -1L, 0L, 0L, 1L, 1L, -1L, -1L, 0L, 73 | # 0L, 1L, 1L, -1L, -1L, 0L, 0L, 1L, 1L), x2 = c(-1L, -1L, -1L, 74 | # -1L, -1L, -1L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 1L, 1L, 1L, 1L, 1L 75 | # ), CO.conc = c(61.9, 65.6, 80.9, 78, 89.7, 93.8, 72.1, 67.3, 76 | # 80.1, 81.4, 77.8, 74.8, 66.4, 68.2, 68.9, 66, 60.2, 57.9)), .Names = c("x1", 77 | # "x2", "CO.conc"), class = c("coded.data", "data.frame"), row.names = c(NA, 78 | # -18L), codings = structure(list(x1 = quote(x1 ~ (Ethanol - 0.2)/0.1), 79 | # x2 = quote(x2 ~ A.F.ratio - 15)), .Names = c("x1", "x2")), rsdes = structure(list( 80 | # primary = c("x1", "x2"), n0 = c(2L, NA), non0 = c(16L, NA 81 | # ), alpha = "NA", blk.info = list(structure(list(n0 = c(2L, 82 | # NA), non0 = c(16L, NA), alpha = NA), .Names = c("n0", "non0", 83 | # "alpha"))), call = quote(as.coded.data(data = co, x1 ~ (Ethanol - 84 | # 0.2)/0.1, x2 ~ A.F.ratio - 15))), .Names = c("primary", 85 | # "n0", "non0", "alpha", "blk.info", "call"))) 86 | 87 | 88 | -------------------------------------------------------------------------------- /R/varfcn.R: -------------------------------------------------------------------------------- 1 | ############################################################################## 2 | # Copyright (c) 2012-2025 Russell V. Lenth # 3 | # # 4 | # This file is part of the rsm package for R (*rsm*) # 5 | # # 6 | # *rsm* is free software: you can redistribute it and/or modify # 7 | # it under the terms of the GNU General Public License as published by # 8 | # the Free Software Foundation, either version 2 of the License, or # 9 | # (at your option) any later version. # 10 | # # 11 | # *rsm* is distributed in the hope that it will be useful, # 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of # 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # 14 | # GNU General Public License for more details. # 15 | # # 16 | # A copy of the GNU General Public License is available at # 17 | # # 18 | ############################################################################## 19 | 20 | # Variance function of a design 21 | 22 | # Note on default vectors: if model contains call to FO, SO, PQ, TWI, or poly, 23 | # we use variables listed in 1st such call. Else we use all non-factor predictors 24 | 25 | varfcn = function(design, formula, dist=seq(0,2,by=.1), 26 | vectors, contour=FALSE, plot=TRUE, main, ...) 27 | { 28 | tt = delete.response(terms(formula)) 29 | mf = model.frame(tt, design) 30 | mm = model.matrix(tt, mf) 31 | nxpxinv = nrow(mm) * solve(t(mm) %*% mm) 32 | 33 | if (missing(vectors)) { 34 | dc = attr(attr(mf, "terms"), "dataClasses") 35 | nm = names(dc) 36 | rsmterms = grep("FO\\(|SO\\(|TWI\\(|PQ\\(|poly\\(", nm) 37 | if (length(rsmterms) > 0) { 38 | nm = sapply(as.formula(paste("~",nm[rsmterms[1]]))[[2]], as.character)[-1] 39 | } 40 | else { 41 | facs = grep("factor|ordered", dc) 42 | if (length(facs)>0) 43 | nm = nm[-facs] 44 | } 45 | vectors = as.data.frame(matrix(1, nrow=length(nm), ncol=length(nm))) 46 | names(vectors) = nm 47 | if (length(nm)>1) for (i in 2:length(nm)) vectors[[i]] [1:(i-1)] = 0 48 | } 49 | else { 50 | # make sure there are no zero rows 51 | nz = apply(vectors, 1, function(x) sum(abs(x)>1e-4) > 0) 52 | vectors = vectors[nz, ] 53 | } 54 | 55 | if (missing(main)) 56 | main = paste(paste(as.character(substitute(design)),collapse=""), paste(formula, collapse=" "), sep=": ") 57 | 58 | if (contour) { 59 | temp = sort(c(-dist[-1], dist)) 60 | X = expand.grid(temp, temp) 61 | names(X) = names(vectors)[1:2] 62 | } 63 | else { 64 | if (ncol(vectors) > 1) 65 | temp = apply(vectors, 1, function(row) row / sqrt(sum(row^2))) 66 | else temp=t(as.matrix(vectors)) 67 | X = apply(temp, 1, function(vec) sapply(vec, function(v) v*dist)) 68 | X = as.data.frame(X) 69 | } 70 | 71 | # Typical observation of a given variable 72 | typical = function(var) { 73 | if (is.numeric(var)) mean(var, na.rm=TRUE) else var[1] 74 | } 75 | 76 | # assemble frame for predictions 77 | n = nrow(X) 78 | pd = lapply(names(design), function(nm) 79 | if (is.null(X[[nm]])) rep(typical(design[[nm]]), n) else X[[nm]]) 80 | pd = as.data.frame(pd) 81 | names(pd) = names(design) 82 | pf = model.frame(tt, pd) 83 | pm = model.matrix(tt, pf) 84 | X$VF = apply(pm, 1, function(x) sum(x * (nxpxinv %*% x))) 85 | if (contour && plot) { 86 | z = matrix(X$VF, nrow=length(temp)) 87 | nm = names(X)[1:2] 88 | contour(temp, temp, z, xlab=nm[1], ylab=nm[2], main=main, ...) 89 | tbl = with(design, do.call("table", list(get(nm[1]),get(nm[2])))) 90 | tmp = do.call("expand.grid", lapply(dimnames(tbl), as.numeric)) 91 | tmp$freq = as.numeric(tbl) 92 | tmp = tmp[tmp$freq > 0, ] 93 | points(tmp[[1]], tmp[[2]], pch=18, cex=sqrt(tmp$freq), col="red") 94 | } 95 | else { 96 | X = cbind(dir=rep(1:nrow(vectors), each=length(dist)), dist=rep(dist, nrow(vectors)), X) 97 | if(plot) { 98 | y = matrix(X$VF, nrow=length(dist)) 99 | mpargs = list(x=dist, y=y, type="l", xlab="Distance from center", 100 | ylab="Scaled prediction variance", main=main, lty=1) 101 | # Let user override my choice of lty 102 | if (!is.null(list(...)$lty)) 103 | mpargs$lty = list(...)$lty 104 | do.call(matplot, mpargs) 105 | } 106 | } 107 | invisible(X) 108 | } 109 | -------------------------------------------------------------------------------- /man/rsm.Rd: -------------------------------------------------------------------------------- 1 | % Copyright (c) 2008-2010, 2012-2025 Russell V. Lenth 2 | \name{rsm} 3 | \alias{rsm} 4 | \alias{summary.rsm} 5 | \alias{print.summary.rsm} 6 | \alias{loftest} 7 | \alias{codings.rsm} 8 | \alias{canonical} 9 | \alias{xs} 10 | \alias{recover_data.rsm} 11 | \alias{emm_basis.rsm} 12 | 13 | \title{Response-surface regression} 14 | \description{ 15 | Fit a linear model with a response-surface component, 16 | and produce appropriate analyses and summaries. 17 | } 18 | \usage{ 19 | rsm (formula, data, ...) 20 | 21 | \method{summary}{rsm}(object, adjust = rev(p.adjust.methods), ...) 22 | \method{print}{summary.rsm}(x, ...) 23 | 24 | \method{codings}{rsm}(object) 25 | 26 | loftest (object) 27 | 28 | canonical (object, threshold = 0.1*max.eigen) 29 | xs (object, ...) 30 | 31 | } 32 | \arguments{ 33 | \item{formula}{Formula to pass to \code{\link{lm}}. 34 | The model must include at least one \code{FO()}, \code{SO()}, \code{TWI()}, or \code{PQ()} term to 35 | define the response-surface portion of the model. 36 | } 37 | \item{data}{\code{data} argument to pass to \code{\link{lm}}.} 38 | \item{\dots}{In \code{rsm}, arguments that are passed to \code{\link{lm}}, 39 | \code{\link{summary.lm}}, or \code{canonical}, as appropriate. 40 | In \code{summary}, and \code{print}, additional arguments 41 | are passed to their generic methods.} 42 | 43 | \item{object}{An object of class \code{rsm}} 44 | \item{adjust}{Adjustment to apply to the P values in the coefficient matrix, chosen from among the available \code{\link[stats]{p.adjust}} methods in the \pkg{stats} package. The default is \code{"none"}.} 45 | \item{threshold}{Threshold for canonical analysis -- see "Canonical analysis" below.} 46 | \item{x}{An object produced by \code{summary}} 47 | } 48 | \details{ 49 | In \code{rsm}, the model formula must contain at least an \code{FO} term; optionally, you can add 50 | one or more \code{TWI()} terms and/or a \code{PQ()} term. All variables that appear 51 | in \code{TWI} or \code{PQ} \emph{must} be included in \code{FO}. 52 | For convenience, specifying \code{SO()} is the same as including \code{FO()}, \code{TWI()}, and \code{PQ()}, 53 | and is the safe, preferred way of specifying a full second-order model. 54 | 55 | The variables in \code{FO} comprise the variables to consider in response-surface methods. They need not all appear in \code{TWI} and \code{PQ} terms; and more than one \code{TWI} term is allowed. For example, the following two model formulas are equivalent: 56 | \preformatted{ 57 | resp ~ Oper + FO(x1,x2,x3,x4) + TWI(x1,x2,x3) + TWI(x2,x3,x4) + PQ(x1,x3,x4) 58 | resp ~ Oper + FO(x1,x2,x3,x4) + TWI(formula = ~x1*x2*x3 + x2*x3*x4) + PQ(x1,x3,x4) 59 | } 60 | The first version, however, creates duplicate \code{x2:x3} terms -- which \code{rsm} can handle but there may be warning messages if it is subsequently used for predictions or plotted in \code{\link{contour.lm}}. 61 | 62 | In \code{summary.rsm}, any \code{\dots} arguments are passed to \code{summary.lm}, except for \code{threshold}, which is passed to \code{canonical}. 63 | } 64 | \value{ 65 | \code{rsm} returns an \code{rsm} object, which is a \code{\link{lm}} object with 66 | additional members as follows: 67 | \item{order}{The order of the model: 1 for first-order, 1.5 for first-order plus interactions, 68 | or 2 for a model that contains square terms.} 69 | \item{b}{The first-order response-surface coefficients.} 70 | \item{B}{The matrix of second-order response-surface coefficients, if present.} 71 | \item{labels}{Labels for the response-surface terms. These make the summary much more readable.} 72 | \item{coding}{Coding formulas, if provided in the \code{codings} argument or 73 | if the \code{data} argument passed to \code{\link{lm}} is a \code{\link{coded.data}} object.} 74 | } 75 | 76 | \section{Summary and print methods}{ 77 | The \code{print} method for \code{rsm} objects just shows the call and the regression 78 | coefficints. 79 | 80 | The \code{summary}method for \code{rsm} objects returns an object of class 81 | \code{\link{summary.rsm}}, which is an extension of the \code{summary.lm} 82 | class with these additional list elements: 83 | \describe{ 84 | \item{sa}{Unit-length vector of the path of steepest ascent 85 | (first-order models only).} 86 | \item{canonical}{Canonical analysis (second-order models only) from \code{canonical}} 87 | \item{lof}{ANOVA table including lack-of-fit test.} 88 | \item{coding}{Coding formulas in parent \code{rsm} object.} 89 | Its \code{print} method shows the regression summary, 90 | followed by an ANOVA and lack-of-fit test. 91 | For first-order models, it shows the direction of 92 | steepest ascent (see \code{\link{steepest}}), and for second-order models, it shows the canonical analysis of the 93 | response surface. 94 | }} 95 | 96 | \section{Canonical analysis and stationary point}{ 97 | \code{canonical} returns a list with elements \code{xs}, the stationary point, and \code{eigen}, the eigenanalysis of the matrix \bold{B} of second-order coefficients. Any eigenvalues less than \code{threshold} are taken to be zero, and a message is displayed. 98 | If this happens, the stationary point is determined using only the surviving eigenvectors, 99 | and stationary ridges or valleys are assumed to exist in their 100 | corresponding canonical directions. The default threshold is one tenth 101 | of the maximum eigenvalue, internally named \code{max.eigen}. 102 | Setting a small \code{threshold} may move the stationary point much farther from the origin. 103 | 104 | When uncoded data are used, the canonical analysis and stationary point are not 105 | very meaningful and those results should probably be ignored. 106 | See \samp{vignette("rsm")} for more details. 107 | 108 | The function \code{xs} returns just the stationary point. 109 | } 110 | 111 | \section{Other functions}{ 112 | \code{loftest} returns an \code{\link{anova}} object that tests the fitted model against a model 113 | that interpolates the means of the response-surface-variable combinations. 114 | 115 | \code{codings} returns a \code{list} of coding formulas if the model was fitted to 116 | \code{\link{coded.data}}, or \code{NULL} otherwise. 117 | } 118 | 119 | 120 | 121 | \section{\pkg{emmeans} support}{ 122 | Support is provided for the \pkg{emmeans} package: its \code{\link[emmeans]{emmeans}} and related functions work with special provisions for models fitted to coded data. The optional \code{mode} argument can have values of \code{"asis"} (the default), \code{"coded"}, or \code{"decoded"}. The first two are equivalent and simply return LS means based on the original model formula and the variables therein (raw or coded), without any conversion. When coded data were used and the user specifies \code{mode = "decoded"}, the user must specify results in terms of the decoded variables rather than the coded ones. See the illustration in the Examples section. 123 | } 124 | \references{ 125 | Lenth RV (2009) ``Response-Surface Methods in R, Using rsm'', 126 | \emph{Journal of Statistical Software}, 32(7), 1--17. 127 | \doi{10.18637/jss.v032.i07} 128 | } 129 | \author{Russell V. Lenth} 130 | \seealso{\code{\link{FO}}, \code{\link{SO}}, 131 | \code{\link{lm}}, \code{\link[=lm-class]{summary}}, \code{\link{coded.data}}} 132 | \examples{ 133 | library(rsm) 134 | CR <- coded.data (ChemReact, x1~(Time-85)/5, x2~(Temp-175)/5) 135 | 136 | ### 1st-order model, using only the first block 137 | CR.rs1 <- rsm (Yield ~ FO(x1,x2), data=CR, subset=1:7) 138 | summary(CR.rs1) 139 | 140 | ### 2nd-order model, using both blocks 141 | CR.rs2 <- rsm (Yield ~ Block + SO(x1,x2), data=CR) 142 | summary(CR.rs2) 143 | 144 | ### Example of a rising-ridge situation from Montgomery et al, Table 6.2 145 | RRex <- ccd(Response ~ A + B, n0 = c(0, 3), alpha = "face", 146 | randomize = FALSE, oneblock = TRUE) 147 | RRex$Response <- c(52.3, 5.3, 46.7, 44.2, 58.5, 33.5, 32.8, 49.2, 49.3, 50.2, 51.6) 148 | RRex.rsm <- rsm(Response ~ SO(A,B), data = RRex) 149 | canonical(RRex.rsm) # rising ridge is detected 150 | canonical(RRex.rsm, threshold = 0) # xs is far outside of the experimental region 151 | 152 | \dontrun{ 153 | # Illustration of emmeans support 154 | emmeans::emmeans(CR.rs2, ~ x1 * x2, mode = "coded", 155 | at = list(x1 = c(-1, 0, 1), x2 = c(-2, 2))) 156 | 157 | # The following will yield the same results, but based on the decoded data 158 | emmeans::emmeans(CR.rs2, ~ Time * Temp, mode = "decoded", 159 | at = list(Time = c(80, 85, 90), Temp = c(165, 185))) 160 | } 161 | } 162 | \keyword{regression} 163 | -------------------------------------------------------------------------------- /R/old-ccd-bbd.R: -------------------------------------------------------------------------------- 1 | ############################################################################## 2 | # Copyright (c) 2008-2010, 2012-2014 Russell V. Lenth # 3 | # # 4 | # This file is part of the rsm package for R (*rsm*) # 5 | # # 6 | # *rsm* is free software: you can redistribute it and/or modify # 7 | # it under the terms of the GNU General Public License as published by # 8 | # the Free Software Foundation, either version 2 of the License, or # 9 | # (at your option) any later version. # 10 | # # 11 | # *rsm* is distributed in the hope that it will be useful, # 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of # 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # 14 | # GNU General Public License for more details. # 15 | # # 16 | # A copy of the GNU General Public License is available at # 17 | # # 18 | ############################################################################## 19 | 20 | ### This source file contains the versions of ccd and bbd from rsm version 1.41 21 | ### They are provided to allow for working around differences in rsm starting 22 | ### with 2.00, and to allow one to exactly reproduce a design that was created 23 | ### in an old version of rsm -- including the randomization if the same seed 24 | ### is used. The code here is NOT quite identical to the old code, due to 25 | ### changes in coded.data structure. We even reproduce the old coded structure. 26 | ### These functions are NOT exported. 27 | 28 | ### generate a CCD 29 | # basis - formula - lhs (opt): dep var name(s); rhs: var names for basic grid 30 | # 31 | 32 | .ccd.1.41 = function(basis, generators, blocks="Block", n0=4, alpha="orthogonal", 33 | wbreps=1, bbreps=1, randomize=TRUE, inscribed=FALSE, coding, 34 | new.style = FALSE) 35 | { 36 | if (inherits(basis, "formula")) 37 | xvars = all.vars(basis[[length(basis)]]) 38 | else if (is.numeric(basis)) 39 | xvars = paste("x", 1:basis, sep="") 40 | else 41 | stop("'basis' must be an integer or a formula") 42 | 43 | args = lapply(xvars, function(nm) c(-1,1)) 44 | names(args) = xvars 45 | cube = do.call(expand.grid, args) 46 | 47 | if (!missing(generators)) { 48 | if (!is.list(generators)) generators = list(generators) 49 | for (gen in generators) { 50 | gen = as.character(gen) 51 | cube[[gen[[2]]]] = with(cube, eval (parse (text = as.character(gen[[3]])))) 52 | } 53 | } 54 | 55 | k = ncol(cube) 56 | 57 | ### At first, star will be face-centered (as if alpha = 1); we'll scale it later 58 | star = as.data.frame (matrix(0, nrow = 2*k, ncol = k)) 59 | xvars = names(star) = names (cube) 60 | for (j in 1:k) star[c(2*j-1,2*j), j] = c(-1, 1) 61 | 62 | if (length(wbreps) == 1) wbreps = rep(wbreps, 2) 63 | if (length(bbreps) == 1) bbreps = rep(bbreps, 2) 64 | 65 | # within-block reps 66 | if (wbreps[1] > 1) cube = cube[rep(1:nrow(cube), wbreps[1]), ] 67 | if (wbreps[2] > 1) star = star[rep(1:nrow(star), wbreps[2]), ] 68 | 69 | # Fractional blocking 70 | if (is.character(blocks)) { 71 | blknm = blocks 72 | nblev = 1 73 | blk = rep(1, nrow(cube)) 74 | chkterm = "" 75 | } 76 | else if (inherits(blocks, "formula")) { 77 | blknm = as.character(blocks[[2]]) 78 | what = as.character(blocks[[3]][[1]]) 79 | if (what == "*") 80 | gens = as.character(blocks[3]) 81 | else 82 | gens = as.character(blocks[[3]])[-1] 83 | bgen = lapply(gens, function(g) with(cube, eval(parse(text=g)))) 84 | blk = as.numeric(factor(do.call(paste, bgen))) 85 | nblev = max(blk) 86 | chkterm = "factor(blk) + " 87 | } 88 | else 89 | stop("'blocks' must be a string or a formula") 90 | 91 | # Check for aliasing 92 | v = paste(names(cube), collapse=",") 93 | fake.resp = rnorm(nrow(cube)) 94 | fstg = paste("fake.resp ~", chkterm, "FO(", v, ") + TWI(", v, ")") 95 | modl = lm(formula(fstg), data=cube) 96 | if (any(is.na(coef(modl)))) 97 | warning("Some 1st or 2nd-order terms are aliased in the cube portion of this design") 98 | 99 | 100 | # center points 101 | zero = as.data.frame(matrix(rep(0, k), nrow=1)) 102 | names(zero) = names(cube) 103 | if (length(n0) == 1) n0 = c(n0, n0) 104 | if (n0[1] > 0) { 105 | cube = rbind(cube, zero[rep(1, nblev*n0[1]), ]) 106 | blk = c(blk, rep(unique(blk), n0[1])) 107 | } 108 | if (n0[2] > 0) 109 | star = rbind(star, zero[rep(1, n0[2]), ]) 110 | 111 | # Block reps 112 | nc = nrow(cube) 113 | if (bbreps[1] > 1) { 114 | cube = cube[rep(1:nc, bbreps[1]), ] 115 | blk = nblev*rep(0:(bbreps[1]-1), rep(nc, bbreps[1])) 116 | + rep(blk, bbreps[1]) 117 | nblev = max(blk) 118 | } 119 | ns = nrow(star) 120 | if (bbreps[2] > 1) star = star[rep(1:ns, bbreps[2]), ] 121 | sblk = rep( (1+nblev):(bbreps[2]+nblev), rep(ns, bbreps[2])) 122 | 123 | # Figure out alpha if given as criterion 124 | if (is.character(alpha)) { 125 | c.ii = sum(cube[[1]]^2) 126 | s.ii = sum(star[[1]]^2) 127 | what = pmatch(alpha, c("rotatable", "orthogonal")) 128 | if (is.na(what)) stop ("alpha must be 'rotatable', 'orthogonal', or a value") 129 | if (what==1) 130 | alpha = (2 * c.ii / s.ii) ^ .25 131 | else 132 | alpha = sqrt(nrow(star) / s.ii * c.ii / nrow(cube)) 133 | } 134 | if (inscribed) 135 | cube = cube / alpha 136 | else 137 | star = star * alpha 138 | 139 | # append blocking variable 140 | cube = cbind(blk, cube) 141 | star = cbind(sblk, star) 142 | names(cube)[1] = names(star)[1] = blknm 143 | 144 | # Figure out row names 145 | ord = order(blk, 1:nrow(cube)) 146 | cube = cube[ord, ] 147 | blk = blk[ord] 148 | row.names(cube) = paste("C", blk, ".", rep(1:(nrow(cube)/nblev), nblev), sep="") 149 | row.names(star) = paste("S", sblk, ".", rep(1:(nrow(star)/bbreps[2]), bbreps[2]), sep="") 150 | 151 | # assemble design 152 | des = rbind(cube, star) 153 | 154 | # Add vars from left-hand side, if any 155 | if (inherits(basis, "formula") & (length(basis) > 2)) { 156 | yvars = all.vars(basis[[2]]) 157 | for (v in yvars) des[[v]] = NA 158 | } 159 | 160 | 161 | stdord = 1:nrow(des) 162 | 163 | # Figure out sort order 164 | if (randomize) { 165 | ord = order(des[[1]] + runif(nrow(des))) 166 | des = des[ord, ] 167 | stdord = stdord[ord] 168 | } 169 | 170 | des[[1]] = factor(des[[1]]) 171 | 172 | if (!missing(coding)) { 173 | des = as.coded.data (des, formulas=coding) 174 | if (!new.style) 175 | attr(des, "rsdes") = NULL # remove rsm2.00-style attributes 176 | } 177 | 178 | if (new.style) { 179 | if (missing(coding)) 180 | coding = sapply(xvars, function(v) as.formula(paste(v,"~",v,".as.is", sep=""))) 181 | des = .randomize(as.coded.data(des, formulas=coding), randomize=FALSE) 182 | des$std.order = stdord 183 | } 184 | 185 | des 186 | } 187 | 188 | 189 | 190 | ### Generate a Box-Behnken design (up thru k=7) 191 | 192 | .bbd.1.41 = function(k, n0=4, block = (k==4|k==5), randomize=TRUE, coding, 193 | new.style=FALSE) 194 | { 195 | args = list(fcn=bbd, k=k, n0=n0, block=block, 196 | randomize=randomize, strip = !new.style) 197 | if (!missing(coding)) args$coding = coding 198 | des = do.call(.gen.des.old.way, args) 199 | 200 | if(!new.style) { 201 | attr(des, "rsdes") = NULL 202 | if (missing(coding)) { 203 | attr(des, "codings") = NULL 204 | class(des) = setdiff(class(des), "coded.data") 205 | } 206 | } 207 | 208 | des 209 | } 210 | 211 | ### Call a new design-generating function but randomize it the old way 212 | ### Returns new-style coded data if fcn does 213 | ### strip determines whether to strip std.order and run.order 214 | .gen.des.old.way = function(fcn, ..., randomize=TRUE, strip=FALSE) { 215 | des = fcn(..., randomize=FALSE) 216 | if (is.null(attr(des, "rsdes"))) # Not a new-style result 217 | return(des) 218 | if (randomize) { 219 | blknm = attr(des, "rsdes")$block 220 | if (is.null(blknm)) blks = 0 221 | else blks = as.numeric(des[[blknm]]) 222 | ord = order(blks + runif(nrow(des))) 223 | des = des[ord, ] 224 | if (!strip) 225 | row.names(des) = 1:nrow(des) 226 | ub = unique(blks) 227 | if (length(ub) == 1) 228 | des$run.order = 1:nrow(des) 229 | for (b in 1:length(ub)) 230 | des$run.order[blks==b] = 1:sum(blks==b) 231 | } 232 | if (strip) { 233 | xcols = match(c("run.order","std.order"), names(des)) 234 | if(length(xcols) > 0) des = des[, -xcols] 235 | } 236 | des 237 | } 238 | -------------------------------------------------------------------------------- /man/coded.data.Rd: -------------------------------------------------------------------------------- 1 | % Copyright (c) 2008-2010, 2012-2025 Russell V. Lenth 2 | \name{coded.data} 3 | \alias{coded.data} 4 | \alias{as.coded.data} 5 | \alias{decode.data} 6 | \alias{recode.data} 7 | \alias{is.coded.data} 8 | \alias{val2code} 9 | \alias{code2val} 10 | \alias{print.coded.data} 11 | \alias{[.coded.data} 12 | %%%\alias{.parse.coding} 13 | \alias{codings} 14 | \alias{codings.coded.data} 15 | \alias{codings<-} 16 | \alias{names<-.coded.data} 17 | \alias{truenames} 18 | \alias{truenames.coded.data} 19 | \alias{truenames<-} 20 | \alias{truenames<-.coded.data} 21 | 22 | 23 | \title{Functions for coded data} 24 | \description{ 25 | These functions facilitate the use of coded data in response-surface analysis. 26 | } 27 | \usage{ 28 | coded.data(data, \dots, formulas = list(\dots), block = "block") 29 | as.coded.data(data, \dots, formulas = list(\dots), block = "block") 30 | decode.data(data) 31 | recode.data(data, \dots, formulas = list(\dots)) 32 | 33 | val2code(X, codings) 34 | code2val(X, codings) 35 | 36 | \method{print}{coded.data}(x, \dots, decode = TRUE) 37 | 38 | ### --- Methods for managing coded data --- 39 | is.coded.data(x) 40 | 41 | \method{[}{coded.data}(x, \dots) 42 | 43 | codings(object) 44 | \method{codings}{coded.data}(object) 45 | codings(object) <- value 46 | 47 | \method{names}{coded.data}(x) <- value 48 | 49 | ## Generic method for true variable names (i.e. decoded names) 50 | truenames(x) 51 | \method{truenames}{coded.data}(x) 52 | ## Generic replacement method for truenames 53 | truenames(x) <- value 54 | \method{truenames}{coded.data}(x) <- value 55 | } 56 | \arguments{ 57 | \item{data}{A \code{data.frame}} 58 | \item{formulas}{List of coding formulas; see details} 59 | \item{block}{Name(s) of blocking variable(s). It is \code{pmatch}ed (case insensitively) with names in \code{data} to identify blocking factorss} 60 | \item{X}{A vector, matrix, or data.frame to be coded or decoded.} 61 | \item{codings}{A list of formulas; see Details} 62 | \item{decode}{Logical. If \code{TRUE}, the decoded values are displayed; if \code{FALSE}, the codings are displayed.} 63 | \item{object}{A \code{coded.data} object} 64 | \item{x}{A \code{coded.data} object} 65 | \item{value}{Replacement value for \code{<-} methods} 66 | \item{\dots}{In \code{coded.data}, \code{as.coded.data}, and \code{recode.data}, \code{\dots} allows specifying formulas as arguments rather than as a list. In other functions, \code{\dots} is passed to the parent methods.} 67 | } 68 | \details{ 69 | Typically, coding formulas are of the form \code{x ~ (var - center) / halfwd} 70 | where \code{x} and \code{var} are variable names, and \code{center} and 71 | \code{halfwd} are numbers. 72 | The left-hand side gives the name of the coded variable, and the right-hand side 73 | should be a linear expression in the uncoded variable (linearity is \emph{not} explicitly 74 | checked, but nonlinear expressions will not decode correctly.) If \code{coded.data} is called without formulas, automatic codings are created (along with a warning message). Automatic codings are based on transforming all non-block variables having five or fewer unique values to the interval [-1,1]. If no formulas are provided in \code{as.coded.data}, default coding formulas like those for \code{\link{cube}} are created all numeric variables with mean zero -- again with a warning message. 75 | 76 | An S3 \code{print} method is provided for the \code{coded.data} class; 77 | it displays the data.frame in either coded or 78 | decoded form, along with the coding formulas. Some users may prefer \code{print.data.frame} 79 | or \code{as.data.frame} in lieu of \code{print} with \samp{decode=FALSE}; they produce the 80 | same output without displaying the coding formulas. 81 | 82 | Use \code{coded.data} to convert a \code{data.frame} in which the variables 83 | are on their original scales. The variables named in the formulas are 84 | coded and replaced with their coded versions (and also renamed). 85 | 86 | In contrast, \code{as.coded.data} does not modify any of the data; it assumes the variables 87 | are already coded, and the coding information is simply added. In addition, if \code{data} is 88 | already a \code{coded.data} object from a pre-1.41 version of \pkg{rsm}, 89 | it is converted to 90 | be compatible with new capabilities such as \code{\link{djoin}} (no \code{formulas} argument 91 | is needed in this case). Any blocking factors should be specified in the \code{blocks} 92 | argument. 93 | 94 | \code{decode.data} converts a dataset of class \code{coded.data} and 95 | returns a \code{data.frame} containing the original variables. 96 | 97 | \code{recode.data} is used to convert a \code{coded.data} object to new codings. 98 | Important: this \emph{changes} the coded values to match the new coding formulas. If you want to keep the coded values the same, but change the levels they represent, use \samp{codings(object) <- \dots} or \code{\link{dupe}}. 99 | 100 | \code{code2val} converts coded values to the original scale using the codings provided, 101 | and returns an object of the same class as \code{X}. 102 | \code{val2code} converts the other direction. When using these functions, it is 103 | essential that the names (or column names in the case of matrices) match those of the 104 | corresponding coded or uncoded variables. 105 | 106 | \code{codings} is a generic function for accessing codings. It 107 | returns the list of coding formulas from a \code{coded.data} object. One may use an 108 | expression like \samp{codings(object) <- list(\dots)} to change the codings (without changing 109 | the coded values themselves). See also \code{\link{codings.rsm}}. 110 | 111 | \code{is.coded.data(x)} returns \code{TRUE} if \code{x} inherits from \code{coded.data}, and \code{FALSE otherwise.} 112 | 113 | The extraction function \code{x[\dots]} and the naming functions \code{names<-}, 114 | \code{truenames}, and \code{truenames<-} are provided to preserve the integrity of 115 | codings. For example, if \code{x[, 1:3]} excludes any coded columns, their coding formulas 116 | are also excluded. If all coded columns are excluded, the return value is unclassed 117 | from \code{coded.data}. When variable names are changed using \code{names(x) <- \dots}, the coding 118 | formulas are updated accordingly. The \code{truenames} function returns the names of the 119 | variables in the decoded dataset. We can change the decoded names using 120 | \code{truenames(x) <- \dots}, and the coding formulas are updated. Note that \code{truenames} 121 | and \code{truenames<-} work the same as \code{names} and \code{names<-} for 122 | unencoded variables in the object. 123 | 124 | Another convenient way to copy and change the coding formulas a coded dataset (and optionally re-randomize it) is to use the \code{\link{dupe}} function with a \code{coding} argument. 125 | 126 | When a design is created in another package, some of the variables may be \code{factor}s, in which case they are converted using \code{as.numeric} (values of 1, 2, ...). These levels may be regarded as a yet different coding of the variables, and so it may take two steps to get it in the desired form: one to convert the supplied levels to the desired range (often -1 to 1), and the other to replace the coding formulas to correspond to the real values of the variables to be used. See the examples. 127 | } 128 | \value{ 129 | \code{coded.data}, \code{as.coded.data}, and \code{recode.data} return an object of class 130 | \code{coded.data}, which inherits from \code{\link{data.frame}}. A \code{coded.data} 131 | object is stored in coded form, and its \code{names} attribute contains the coded names, 132 | where they apply. Thus, when fitting models in \code{\link{rsm}} or \code{\link{lm}} with 133 | coded data as the \code{data} argument, the model formula should be given in terms of the 134 | coded variables. 135 | } 136 | 137 | \note{Starting with \pkg{rsm} version 2.00, the \code{coded.data} class involves additional attributes to serve broader needs in design-generation. Because of this, old \code{coded.data} objects may need to be updated using \code{as.coded.data} if they are to be used with the newer functions such as \code{\link{djoin}}.} 138 | 139 | 140 | \seealso{\code{\link{data.frame}}, \code{\link{djoin}}, \code{\link{dupe}}, \code{\link{rsm}}} 141 | \references{ 142 | Lenth RV (2009). ``Response-Surface Methods in R, Using rsm'', 143 | \emph{Journal of Statistical Software}, 32(7), 1--17. 144 | \doi{10.18637/jss.v032.i07} 145 | } 146 | \author{Russell V. Lenth} 147 | \examples{ 148 | library(rsm) 149 | 150 | ### Existing dataset with variables on actual scale 151 | CR <- coded.data (ChemReact, x1 ~ (Time - 85)/5, x2 ~ (Temp - 175)/5) 152 | CR # same as print(CR, decode = TRUE) 153 | print(CR, decode = FALSE) # similar to as.data.frame(CR) 154 | code2val (c(x1=.5, x2=-1), codings = codings(CR)) 155 | 156 | ### Existing dataset, already in coded form 157 | CO <- as.coded.data(codata, x1 ~ (Ethanol - 0.2)/0.1, x2 ~ A.F.ratio - 15) 158 | truenames(CO) 159 | names(CO) 160 | 161 | # revert x2 to an uncoded variable 162 | codings(CO)[2] <- NULL 163 | truenames(CO) 164 | 165 | ### Import a design that is coded in a different way 166 | 167 | if (require(conf.design)) { # ----- This example requires conf.design ----- 168 | 169 | # First, generate a 3^3 in blocks and import it via coded.data 170 | des3 <- coded.data(conf.design(p=3, G=c(1,1,2))) 171 | # NOTE: This returns a warning message but does the right thing -- 172 | # It generates these names and coding formulas automatically: 173 | # x1 ~ (T1 - 2)/1 174 | # x2 ~ (T2 - 2)/1 175 | # x3 ~ (T3 - 2)/1 176 | # Now randomize and change the codings and variable names for the real situation: 177 | mydes <- dupe(des3, coding = c(x1 ~ (Dose - 20)/5, x2 ~ (Conc - 40)/10, 178 | x3 ~ (Time - 60)/15)) 179 | 180 | } # ----- end of example requiring package conf.design ----- 181 | 182 | } 183 | \keyword{regression} 184 | \keyword{design} 185 | -------------------------------------------------------------------------------- /man/contour.lm.Rd: -------------------------------------------------------------------------------- 1 | % Copyright (c) 2008-2010, 2012-2025 Russell V. Lenth 2 | \name{contour.lm} 3 | \alias{contour.lm} 4 | \alias{image.lm} 5 | \alias{persp.lm} 6 | \title{Surface plot(s) of a fitted linear model} 7 | \description{ 8 | \code{contour}, \code{image}, and \code{persp} methods that display the fitted surface for an \code{lm} object 9 | involving two or more numerical predictors. 10 | } 11 | \usage{ 12 | \method{contour}{lm}(x, form, at, bounds, zlim, xlabs, hook, 13 | plot.it = TRUE, atpos = 1, decode = TRUE, image = FALSE, 14 | img.col = terrain.colors(50), ...) 15 | 16 | \method{image}{lm}(x, form, at, bounds, zlim, xlabs, hook, 17 | atpos = 1, decode = TRUE, ...) 18 | 19 | \method{persp}{lm}(x, form, at, bounds, zlim, zlab, xlabs, 20 | col = "white", contours = NULL, hook, atpos = 3, decode = TRUE, 21 | theta = -25, phi = 20, r = 4, border = NULL, box = TRUE, 22 | ticktype = "detailed", ...) 23 | } 24 | \arguments{ 25 | \item{x}{A \code{lm} object.} 26 | \item{form}{A formula, or a list of formulas.} 27 | \item{at}{Optional \emph{named} list of fixed values to use for surface slices. 28 | For example, if the predictor variables are \code{x1}, \code{x2}, and \code{x3}, the contour plot of \code{x2} versus \code{x1} would be 29 | based on the fitted surface sliced at the \code{x3} value specified in \code{at}; the contour plot of \code{x3} versus \code{x1} would be sliced at the \code{at} value for \code{x2}; etc. 30 | If not provided, \code{at} defaults to the mean value of each numeric variable.} 31 | \item{bounds}{Optional \emph{named} list of bounds or grid values to use for 32 | the variables having the same names. See details.} 33 | \item{zlim}{\code{zlim} setting passed to parent methods \code{\link{contour}}, \code{\link{image}}, or \code{\link{persp}}. The same \code{zlim} is used in all plots when several are produced. 34 | If not provided, the range of values across all plotted surfaces is used.} 35 | \item{zlab}{Optional label for the vertical axis.} 36 | \item{xlabs}{Alternate labels for predictor axes (see Details).} 37 | \item{hook}{Optional list that can contain functions \code{pre.plot} and \code{post.plot}. 38 | May be used to add annotations or to re-route the graphs to separate files (see Details).} 39 | \item{atpos}{Determines where \code{at} values are displayed. A value of 1 (or 2) displays it as part of the \emph{x} (or \emph{y}) axis label. 40 | A value of 3 displays it as a subtitle below the plot. A value of 0 suppresses it. 41 | Any other nonzero value will cause the label to be generated but not displayed; it can be accessed via a \code{hook} function.} 42 | \item{decode}{This has an effect only if \code{x} is an \code{\link{rsm}} object or other model object that supports \code{\link{coded.data}}. In such cases, if \code{decode} is \code{TRUE}, the coordinate axes are transformed to their decoded values.} 43 | \item{image}{Set to \code{TRUE} if you want an image plot overlaid by contours.} 44 | \item{img.col}{Color map to use when \code{image=TRUE}.} 45 | \item{plot.it}{If \code{TRUE}, no plot is produced, just the return value.} 46 | \item{col}{Color or colors used for facets in the perspective plot (see details).} 47 | \item{contours}{If non-\code{NULL}, specifications for added contour lines in perspective plot.} 48 | \item{theta, phi}{Viewing angles passed to \code{\link{persp}} (different defaults).} 49 | \item{r}{Viewing distance passed to \code{\link{persp}} (different default).} 50 | \item{border, box}{Options passed to \code{\link{persp}}.} 51 | \item{ticktype}{Option passed to \code{\link{persp}} (different default).} 52 | \item{\dots}{Additional arguments passed to \code{\link{contour}}, \code{\link{image}}, or \code{\link{persp}}. Note, however, that a \code{ylab} is ignored, with a message to Use \code{xlabs} instead.} 53 | } 54 | \details{ 55 | \code{form} may be a single formula or a list of formulas. A simple formula like 56 | \code{x2 ~ x1} will produce a contour plot of the fitted regression surface 57 | for combinations of \code{x2} (vertical axis) and \code{x1} (horizontal axis). 58 | A list of several such simple formulas will produce a contour plot for each formula. 59 | A two-sided formula produces contour plots for each left-hand variable versus each 60 | right-hand variable (except when they are the same); for example, 61 | \code{x1+x3 ~ x2+x3} is equivalent to 62 | \code{list(x1~x2, x3~x2, x1~x3)}. 63 | A one-sided formula produces contour plots for each pair of variables. For example, 64 | \code{~ x1+x2+x3} is equivalent to 65 | \code{list(x2~x1, x3~x1, x3~x2)}. 66 | 67 | For any variables not in the \code{bounds} argument, a grid of 26 equally-spaced 68 | values in the observed range of that variable is used. If you specify a vector of 69 | length 2, it is interpreted as the desired range for that variable and a grid of 26 70 | equally-spaced points is generated. If it is a vector of length 3, the first two elements are used 71 | as the range, and the third as the number of grid points. 72 | If it is a vector of length 4 or more, those 73 | values are used directly as the grid values. 74 | 75 | The results are based on the predicted values of the linear model over the specified grid. If there are \code{factor}s among the predictors, the predictions are made over all levels (or combinations of levels) of those factors, and then averaged together. (However, the user may include factors in \code{at} to restrict this behavior.) 76 | 77 | By default, the predictor axes are labeled using the variable names in \code{form}, 78 | unless \code{x} is an \code{\link{rsm}} or other object that supports \code{\link{coded.data}}, in which case either the decoded variable names or the variable-coding formulas are used to generate axis labels, depending on whether \code{decode} is \code{TRUE} or \code{FALSE}. 79 | These axis labels are replaced by the entries in \code{xlabs} if provided. One must be careful using this 80 | to make sure that the names are mapped correctly. The entries in \code{xlabs} 81 | should match the respective unique variable names in \code{form}, \emph{after sorting them in 82 | (case-insensitive) alphabetical order} (not necessarily in order of appearance). Note that if \code{form} is changed, it may also 83 | be necessary to change \code{xlabs}. 84 | 85 | Please note that with models fitted to coded data, coded values should be used in \code{at} or \code{bounds}, regardless of whether \code{decode} is \code{TRUE} or \code{FALSE}. However, any elements that are added afterward via \code{\link{points}}, \code{\link{lines}}, etc., must be specified in terms of whatever coordinate system is present in the plots. 86 | 87 | In \code{persp}, contour lines may be added via the \code{contours} argument. It may be a boolean or character value, or a \code{list}. 88 | If boolean and \code{TRUE}, default black contour lines are added to the bottom surface of the box. Character values of \code{"top"}, \code{"bottom"} 89 | add black contour lines to the specified surface of the box. \code{contours = "colors"} puts contour lines on the bottom using the same colors as those 90 | at the same height on the surface. Other character values of \code{contours} are taken to be the desired color of the contour lines, plotted at the bottom. 91 | If \code{contours} is a named \code{list}, its elements (all are optional) are used as follows: 92 | \describe{ 93 | \item{\code{z}}{Height where the contour lines are plotted. May be \code{"bottom"} (default), \code{"top"}, or a numeric value.} 94 | \item{\code{col}}{Color of the lines. If not specified, they will be black. 95 | May be integer color values, color names, or \code{"colors"} to match the surface colors.} 96 | \item{\code{lwd}}{Line width; default is 1.} 97 | } 98 | 99 | Since these functions often produce several plots, the \code{hook} argument is provided if special setups or annotations are needed for each plot. It 100 | should be a list that defines one or both of the functions \code{pre.plot} and \code{post.plot}. Both of these functions have one argument, the character 101 | vector \code{labs} for that plot (see Value documentation). 102 | 103 | Additional examples and discussion of these plotting functions is available via \code{vignette("rsm-plots")}. 104 | } 105 | \value{ 106 | A \code{list} containing information that is plotted. 107 | Each list item is itself a \code{list} with the following components: 108 | \item{x, y}{The values used for the x and y axes} 109 | \item{z}{The matrix of fitted response values} 110 | \item{labs}{Character vector of length 5: Elements 1 and 2 are the x and y axis labels, 111 | elements 3 and 4 are their original variable names, 112 | and element 5 is the slice label (empty if \code{atpos} is 0)} 113 | \item{zlim}{The computed or provided \code{zlim} values} 114 | \item{transf}{(\code{persp} only) The 3D transformation for \code{\link{trans3d}}} 115 | } 116 | \references{ 117 | Lenth RV (2009) ``Response-Surface Methods in R, Using rsm'', 118 | \emph{Journal of Statistical Software}, 32(7), 1--17. 119 | \doi{10.18637/jss.v032.i07} 120 | } 121 | \author{Russell V. Lenth} 122 | \seealso{\code{\link{contour}}} 123 | \examples{ 124 | ### Basic example with a linear model: 125 | mpg.lm <- lm(mpg ~ poly(hp, disp, degree = 3), data = mtcars) 126 | contour(mpg.lm, hp ~ disp, image = TRUE) 127 | 128 | ### Extended example with an rsm model... 129 | heli.rsm <- rsm (ave ~ block + SO(x1, x2, x3, x4), data = heli) 130 | 131 | # Plain contour plots 132 | par (mfrow = c(2,3)) 133 | contour (heli.rsm, ~x1+x2+x3+x4, at = xs(heli.rsm)) 134 | 135 | # Same but with image overlay, slices at origin and block 2, 136 | # and no slice labeling 137 | contour (heli.rsm, ~x1+x2+x3+x4, at = list(block="2"), 138 | atpos = 0, image = TRUE) 139 | 140 | # Default perspective views 141 | persp (heli.rsm, ~x1+x2+x3+x4, at = xs(heli.rsm)) 142 | 143 | # Same plots, souped-up with facet coloring and axis labeling 144 | persp (heli.rsm, ~x1+x2+x3+x4, at = xs(heli.rsm), 145 | contours = "col", col = rainbow(40), zlab = "Flight time", 146 | xlabs = c("Wing area", "Wing length", "Body width", "Body length")) 147 | 148 | \dontrun{ 149 | ### Hints for creating graphics files for use in publications... 150 | 151 | # Save perspective plots in one PDF file (will be six pages long) 152 | pdf(file = "heli-plots.pdf") 153 | persp (heli.rsm, ~x1+x2+x3+x4, at = xs(heli.rsm)) 154 | dev.off() 155 | 156 | # Save perspective plots in six separate PNG files 157 | png.hook = list( 158 | pre.plot = function(lab) 159 | png(file = paste(lab[3], lab[4], ".png", sep = "")), 160 | post.plot = function(lab) 161 | dev.off()) 162 | persp (heli.rsm, ~x1+x2+x3+x4, at = xs(heli.rsm), hook = png.hook) 163 | } %--- end of dontrun 164 | } 165 | \keyword{ regression } 166 | \keyword{ hplot } 167 | -------------------------------------------------------------------------------- /vignettes/plots.rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Surface Plots in the rsm Package" 3 | author: "rsm package, Version `r packageVersion('rsm')`" 4 | output: emmeans::.emm_vignette 5 | vignette: > 6 | %\VignetteIndexEntry{Surface Plots in the rsm Package} 7 | %\VignetteKeywords{response-surface methods, regression, contour plots, perspective plots} 8 | %\VignetteEngine{knitr::rmarkdown} 9 | %\VignetteEncoding{UTF-8} 10 | --- 11 | ```{r, echo = FALSE, results = "hide", message = FALSE} 12 | require("rsm") 13 | knitr::opts_chunk$set(fig.width = 5.5, class.output = "ro") 14 | ``` 15 | 16 | 17 | ### Abstract 18 | This is a companion to the main vignette for the **rsm** package, 19 | providing more details on how to use the `contour`, 20 | `image`, and `persp` to visualize fitted response surfaces. While designed with `rsm` objects in mind, these methods work with any `lm` object and thus provide a quick way to graph a fitted surface. Enhancements include coloring, adding contour lines to perspective plots, and hooks that provide additional annotations. 21 | 22 | 23 | ## Introduction 24 | When a regression model is fitted using two or more continuous predictors, it is useful to present a graphical visualization of the fitted surface. 25 | To this end, the functions `contour.lm`, `persp.lm` and `image.lm` were developed and incorporated in the **rsm** package, inasmuch as surface visualization is especially important when using response-surface methods. The three functions are S3 methods for objects of class `lm`, or classes (such as `rsm`) that inherit from `lm`. 26 | 27 | This vignette is not meant to document the functions; please refer to the help pages for details. Our goal here is to illustrate their use. 28 | 29 | ## Models with two predictors 30 | Consider an example using the ubiquitous `swiss` dataset that is standard in R. Let us fit a model for `Fertility` as a polynomial function of `Agriculture` and `Education`: 31 | ```{r} 32 | swiss2.lm <- lm(Fertility ~ poly(Agriculture, Education, degree=2), data=swiss) 33 | ``` 34 | The following basic calls illustrate the default results from the three functions. 35 | ```{r, fig=TRUE, fig.width=8.5, fig.height=3} 36 | library(rsm) 37 | par(mfrow=c(1,3)) 38 | image(swiss2.lm, Education ~ Agriculture) 39 | contour(swiss2.lm, Education ~ Agriculture) 40 | persp(swiss2.lm, Education ~ Agriculture, zlab = "Fertility") 41 | ``` 42 | Note that we use a formula in the second argument to specify which variable goes on which axis. The `persp` plot uses a different viewpoint, distance, and tick type than the default; I feel that these new defaults are better for viewing response surfaces. 43 | 44 | Generally, perspective plots are best not displayed in too small a space. It also helps to enhance them with shading, colors, or contour lines. The following call illustrates how to create an enhanced version of the perspective plot with a different point of view, shading, a different surface color, and contour lines added to the top surface of the box. We also restrict the predictor values to narrower ranges. 45 | ```{r fig=TRUE, fig.height=5.5} 46 | persp(swiss2.lm, Education ~ Agriculture, col = "blue", 47 | bounds = list(Agriculture=c(20,70), Education=c(0,30)), 48 | zlab = "Predicted Fertility", 49 | contours = list(z="top", col="orange", shade = 1), 50 | theta = -135, phi = 35) 51 | ``` 52 | 53 | ## Three or more predictors 54 | When a regression model has more than two continuous predictors, some additional issues arise: 55 | 56 | 1. We can use only two predictors at a time in an image, contour, or surface plot. 57 | 2. For two given predictors, the surface plot will change depending on the values of the other predictors. (The defaults for `image`, `contour`, and `persp` is to use the average, but this can be changed.) 58 | 3. There will be more than one surface plot; it is desirable to keep the scaling and coloring consistent among all these plots. (This happens automatically in all three functions; there is no way to defeat it other than by manually plotting the retrieved surface data.) 59 | 60 | For illustration, we will use the data from a paper-helicopter experiment described in Box *et al. (2005), page 499, and provided in the **rsm** package as the dataset `heli`. The variables are coded variables $x_1$--$x_4$, which are, respectively, linear functions of wing area $A$, wing length ratio $R$, body width $W$, and body length $L$. the experiment was run in two blocks, and the response variable is `ave`, the average flight time in seconds. This dataset is analyzed in more detail in the \href{rsm.pdf}{main \rsm{} vignette}. A second-order response-surface model for these data is obtained using 61 | ```{r} 62 | heli.rsm <- rsm(ave ~ block + SO(x1,x2,x3,x4), data = heli) 63 | ``` 64 | An `rsm` object is an extension of a `lm` object with extra response-surface-related information included. 65 | To obtain contour plots with each of the 6 possible pairs of the variables $x_1$--$x_4$, simply specify the formula `~ x1 + x2 + x3 + x4` in the call to `contour`: 66 | ```{r fig=TRUE, fig.height=6, fig.width=8} 67 | par(mfrow = c(2,3)) 68 | contour (heli.rsm, ~ x1 + x2 + x3 + x4) 69 | ``` 70 | The `heli` dataset is an extension of `data.frame` that contains the coding information, and this information is retained in `heli.rsm`. When such coding is present, then by default, the coding formulas are used to decode the axis values $x_1,x_2,x_3,x_4$ to their original values $A,R,W,L$. 71 | 72 | Also, when variables other than those on the coordinate axes are involved, then what is displayed is a *slice* of the response surface, holding the other variables fixed at certain values. By default, we use the averages of numeric predictors, and the first levels of factors. This information is incorporated as part of the $x$-axis label in each contour plot. 73 | In this example, we are probably more interested in the behavior of the response surface in a neighborhood of the stationary point (where the gradient is zero). We show how to do this after a little bit more discussion in the next section. 74 | 75 | 76 | ## Annotations and hooks 77 | Suppose in the helicopter example, we want to add some annotations to the plots. Since there are several plots, we don't want to do this manually. The `contour` method for `lm` objects (as well as `image` and `persp`) allow one to specify a `hook` argument to take care of things like that. The hook should be a `list` containing function definitions for one or both of `pre.plot` and `post.plot`. Obviously, these are functions that are run just before, and just after, each plot is constructed. Each function is passed one argument, a character vector of length $4$; elements $1$ and~2 are the labels for the horizontal and vertical axes; elements $3$ and~$4$ are the corresponding variable names; and element 5 is a label describing the slice being plotted. 78 | 79 | In the following code, we set up a `post.plot` hook to plot the position of the stationary point in each graph. 80 | ```{r} 81 | xs <- canonical(heli.rsm)$xs # stat.pt. in coded units 82 | SP <- code2val(xs, codings(heli.rsm)) # in decoded units 83 | myhook <- list() 84 | myhook$post.plot <- function(lab) { 85 | idx <- sapply(lab[3:4], grep, names(xs)) 86 | points (SP[idx[1]], SP[idx[2]], pch = 2, col = "red") 87 | } 88 | ``` 89 | The coding is a bit tedious due to the need to match elements of `xs` with the variable names. And it gets trickier because `contour` is smart enough to decode the coordinates into original units, but it doesn't do any decoding with any `hook` functions; that is left to the user. 90 | 91 | To create an enhanced contour plot, use the `at` argument to specify that we want the plots sliced at the stationary point instead of the origin, the `image` argument to enhance the plots with a background color image, and use `hook` to incorporate the above hook function. 92 | ```{r fig=TRUE, fig.height=6, fig.width=8} 93 | par(mfrow = c(2,3)) 94 | contour (heli.rsm, ~ x1 + x2 + x3 + x4, image = TRUE, 95 | at = xs, hook = myhook) 96 | ``` 97 | Centering at the stationary point gives an entirely different view of the fitted surface than is seen in the previous figure. 98 | 99 | 100 | ## Saving graphs 101 | Sometimes we may want to access individual plots in a multi-panel frame. For PS and PDF, this is easy to handle. For example, 102 | consider this code: 103 | ``` 104 | pdf(file = "heli-cps.pdf") 105 | contour (heli.rsm, ~ x1 + x2 + x3 + x4, image = TRUE, at = xs, hook = myhook) 106 | dev.off() 107 | ``` 108 | The resulting file will have six pages, one per graph. We can then import, say, the fourth graph into a **pdflatex** source file using a command like 109 | ``` 110 | \includegraphics[width=.75\linewidth, page=4]{heli-cps.pdf} 111 | ``` 112 | 113 | For other formats, we can use hooks to create separate files based on variable names. For example, 114 | ```{r}{eval=FALSE} 115 | png.hook <- list() 116 | png.hook$pre.plot <- function(lab) 117 | png(file = paste(lab[3], lab[4], `.png`, sep = ``)) 118 | png.hook$post.plot = function(lab) 119 | dev.off() 120 | contour (heli.rsm, ~ x1 + x2 + x3 + x4, image = TRUE, at = xs, hook = png.hook) 121 | ``` 122 | 123 | ## More on perspective plots 124 | The `lm` method for `persp` handles its `col` argument differently than the default `persp` function. For other than a single color, it determines surface-facet colors based on the fitted response value (like is done in `image`) rather than requiring a matrix of facet colors. 125 | 126 | ### Adding contours 127 | To add contour lines to a perspective plot, use the `contours` argument. It may be a boolean value, character value, or a list. With `contours=TRUE` or equivalently, \verb|contours=`bottom`|, contour lines are drawn on the bottom surface of the box using the default foreground color. With `contours="top"`, they are drawn at the top. Bottom contours are drawn before the surface is drawn (so they may become partially obscured), and top contours are drawn afterward. 128 | A value of `contours="colors"` will draw the contours on the bottom, using the same colors as the corresponding contour levels on the surface (as illustrated in the prespective plot). Any other character value of `contours` will be taken as a color name for the contours, e.g., `contours="green"`. For more control, `contours` can be a list containing any or all of `col` (which may be either `"colors"` or a valid color), "z" (which may be `"top"`, `"bottom"`, or a numeric $z$ value), and `"lwd"` (to control the width of the lines). 129 | 130 | \begin{figure} 131 | ```{r fig=TRUE, fig.height = 5.5} 132 | persp (heli.rsm, x2 ~ x1, at = xs, col = rainbow(50), contours = "colors") 133 | persp (heli.rsm, x4 ~ x1, at = xs, col = rainbow(50), contours = "colors") 134 | ``` 135 | 136 | ## Doing it your own way 137 | If these functions do not produce exactly the plot you want, you may still be able to save yourself a lot of work by calling `contour` with the desired object and formula(s), and `plot.it=FALSE`. The returned object is a list of data for each plot---the $x$ and $y$ values, the $z$ matrix, the range of $z$ across all plots, and axis labels. 138 | 139 | ## References 140 | Box GEP, Hunter WG, Hunter JS (2005). *Statistics for Experimenters: An Introduction to Design, Data Analysis, and Model Building*. 2nd edition. John Wiley & Sons, New York. 141 | -------------------------------------------------------------------------------- /inst/NEWS: -------------------------------------------------------------------------------- 1 | NEWS for rsm package 2 | 3 | Changes in version 2.10.5 (24 March 2025) 4 | * Removes references to now-archived **Vdgraph** package, and 5 | replaces with **vdg**. 6 | 7 | 8 | Changes in version 2.10.5 (9 June 2024) 9 | * Re-did old Sweave/PDF vignettes in RMarkdown/HTML. 10 | This makes the whole package easier to maintain 11 | * Corrections to slice labels for contour and persp 12 | * Made pkgdown site 13 | 14 | 15 | Changes in version 2.10.4 (19 September 2023) 16 | * Removed formatting in Value list in rsm.Rd, per CRAN request 17 | * Allowed weights in recover_data.rsm 18 | 19 | 20 | Changes in version 2.10.3 (6 October 2021) 21 | * Changed URL links to JSS article to DOI:10.18637/jss.v032.i07 22 | 23 | 24 | Changes for version 2.10.2 (3 September 2020) 25 | * Updated to use new method registration support for emmeans package. 26 | * Warning message added to canonical() when eigenvalues < threshold 27 | * Change in default threshold to 10% of largest |eigenvalue| 28 | * Vignette changes related to these 29 | * Restored the vignette "rsm-plots" which for some reason had been 30 | suppressed 31 | 32 | 33 | Changes for version 2.10 (2 September 2018) ------ 34 | * Changes to avoid loss of significance in decode.data() 35 | * Informative error message in contour.lm() and relatives when 36 | non-existing variables are specified in 'form' 37 | * Some S3 methods (e.g. contour.lm) also exported visibly to save confusion 38 | * 'emmeans' support (recover_data.rsm, emm_basis.rsm) now dynamically registered 39 | 40 | 41 | Changes for version 2.9 (22 October 2017) 42 | * Changed license to ease interdependencies with other packages 43 | * Moved development codebase to github repository rvlenth/rsm 44 | * Added more robust model.data() function 45 | * Added support for emmeans package 46 | 47 | 48 | Changes for version 2.8 (14 October 2016) 49 | * Added 'adjust' argument to 'rsm()' 50 | * Added support for lsmeans package 51 | 52 | 53 | Changes for version 2.7-4 (6 October 2015) 54 | * Fixed error incurred when PQ() has only one argument 55 | 56 | 57 | Changes for version 2.7-3 (2 September 2015) 58 | * Added NAMESPACE imports of non-base packages referenced 59 | 60 | 61 | Changes for version 2.7-2 (12 May 2015) 62 | * Modified the "rs-illus" vignette slightly to make it less 63 | confusing 64 | 65 | 66 | Changes in version 2.07 (1 October 2014) 67 | * Including factors specified in 'at' in the slice labels 68 | 69 | 70 | Changes in version 2.06 (18 April 2014) 71 | * Fixed a bug in contour.lm wherein if xlabs is supplied, 72 | decoding was disabled 73 | * Additional messages from contour.lm for misspecified axis labels. 74 | 75 | Changes in version 2.05 (14 April 2014) 76 | 77 | * Added back some details (e.g. R^2, F) earlier omitted from 78 | summary. 79 | 80 | 81 | Changes in version 2.04 (5 February 2014) 82 | 83 | * Correction in bbd: Wrong design was generated when k = 6 84 | 85 | 86 | Changes in version 2.03 (21 February 2013) 87 | 88 | * Corrected error in slice labels present since 2.00 89 | (Thanks AGAIN go to Keith Ponting, Avaya) 90 | 91 | 92 | Changes in version 2.02 (9 February 2013) 93 | 94 | * Corrected deparse bug that occurs when model formula wraps a line. 95 | (Thanks go to Keith Ponting, Avaya) 96 | 97 | 98 | Changes in version 2.01 (29 December 2012) 99 | 100 | * Added .ccd.1.41 and .bbd.141 functions, so that given the random seed, 101 | one can reproduce a design that was generated in version 1.41 or earlier 102 | with the identical randomization. These functions are NOT exported. 103 | 104 | * Renamed 'join' to 'djoin' to avoid clashing with 'join' function in 105 | the package conf.design 106 | 107 | * coded.data and as.coded.data generate automatic codings if no formulas 108 | are provided. 109 | 110 | 111 | 112 | Changes in version 2.00 (7 December 2012) 113 | 114 | This is a major update of 'rsm'. It includes more pervasive and complete integration 115 | of coded.data, and improves flexibility in generating designs and RSM analysis. 116 | 117 | * Old coded.data objects created before this version may need to be updated 118 | (via as.coded.data) in order to use some new functions such as join 119 | 120 | * Allows more general rsm models, e.g. 121 | FO(x1,x2,x3,x4) + TWI(formula = ~x1:(x2+x3+x4)) + PQ(x1,x3) 122 | 123 | * Can deal with singular second-order effects (e.g. stationary ridge). New threshold 124 | option in canonical analysis to actually force singularity -- which likely will 125 | identify a stationary point nearer the design center. 126 | 127 | * All design-generating functions ALWAYS create coded.data objects, and they 128 | have columns for run.order and std.order. There are additional (under the hood) 129 | enhancements to coded.data to keep track of primary variables, blocks, etc. 130 | 131 | * New cube(), star(), foldover(), dupe(), and join() functions for creating and 132 | combining designs. These should usually be used in preference to ccd() when 133 | doing iterative response-surface experimentation 134 | 135 | * Added a oneblock argument to ccd() so we can create an un-blocked CCD 136 | 137 | * A star block may be added to ANY design, including ones imported from other 138 | packages. Options alpha = "orthogonal" and alpha = "rotatable" calculate the 139 | the design moments, check suitability and set alpha to meet the criterion, or 140 | raise an error condition if it cannot be met. 141 | 142 | * New 'block' argument in coded-data-generating functions. May be needed to 143 | identify blocking factor(s). 144 | 145 | * New varfcn() function for examining the scaled variance function for a design 146 | 147 | * contour.lm, persp.lm, image.lm now have "decode" argument (TRUE by default) 148 | that displays decoded values on the coordinate axes when codings are available 149 | 150 | * contour.lm et al. now average over any factor levels rather than picking the 151 | first level of each. (May still specify particular levels in 'at') 152 | 153 | * New vignette with a simulated example of a series of response-surface experiments 154 | 155 | * Fixed some scoping bugs so that rsm can be called within a function. (This should 156 | make it possible to retire the spotRsm function in the SPOT package) 157 | 158 | * parse.coding function replaced by .parse.coding (and not exported) 159 | 160 | * row.names attribute for a design is updated to 1:nrow(design) every time it is 161 | randomized. 'ccd' does not create the same weird row names that it used to 162 | 163 | * print.coded.data now has argument to decide whether to show coded values or 164 | actual values (actual is the default) 165 | 166 | * function "codings<-" to change the codings 167 | 168 | * function "[.coded.data" implemented for smarter handling of subsetted data; 169 | for example, if a coded column is excluded, so is its coding. 170 | 171 | * New functions "names<-.coded.data", "truenames.coded.data", "truenames<-.coded.data" 172 | for smart handling of variable names, keeping coding consistent with names 173 | 174 | * xs() function to obtain stationary point of an rsm object 175 | 176 | * TWI() function now has optional 'formula' argument to aid in specifying 177 | reduced version of second-order models 178 | 179 | 180 | Changes in version 1.41 (July 28, 2012) 181 | 182 | * Added a NAMESPACE so it will work in newer versions of R 183 | 184 | 185 | Changes in version 1.40 (July 28, 2010) 186 | 187 | * Fixed scoping bugs in 'model.data' (affects 'contour.lm' etc.) 188 | 189 | * Fixed scoping bugs in 'rsm' 190 | 191 | * Fix to 'rsm' -- coding worked incorrectly when 'data' keyword 192 | was not given explicitly. Side effect: 'data' is no longer a 193 | separate argument, it's just part of '...' 194 | 195 | * Added 'inscribed' optional argument to 'ccd' 196 | (Thanks to Ron Behlinger for suggesting this) 197 | 198 | * 'contour.lm' checks to ensure that elements of 'at' and 'bounds', 199 | if provided, are named. 200 | 201 | * New 'atlab' argument in 'contour.lm' and related functions. 202 | Now by default, the 'at' values are displayed for variables not on 203 | the coordinate axes; 'atlab' specifies where this information is 204 | shown, or suppresses it. 205 | 206 | 207 | Changes in version 1.31 (December 19, 2009) 208 | 209 | * Fixed logic bug in contour.lm - didn't handle xlabs correctly 210 | 211 | 212 | Changes in version 1.30 (December 16, 2009) 213 | 214 | * Enhanced contour.lm with hooks and improved axis labeling 215 | Also changed default to image=FALSE -- seems more "pure" 216 | 217 | * Added persp.lm for perspective plots akin to contour.lm 218 | 219 | * Added image.lm for image-only plots akin to contour.lm 220 | 221 | * Added 'codings' methods for coded.data and rsm objects 222 | 223 | * Added 'canonical' method for rsm for more convenient access 224 | 225 | * Updated references to 3rd ed. of Myers, Montgomery, Anderson-Cook 226 | (also corrected misspelling of Myers -- my apologies to Ray.) 227 | 228 | * Additional vignette "rsm-plots" describing contour, image, persp 229 | in more detail 230 | 231 | 232 | Changes in version 1.21 (October 30, 2009) 233 | 234 | * Bug fix in contour.lm (axis labeling was reversed whern image=FALSE) 235 | Thanks to Eduard Sturm for reporting this 236 | 237 | 238 | Changes in version 1.20 (October 20, 2009) 239 | 240 | * Replaced citation to point to paper published in JSS 241 | 242 | * Replaced vignette by JSS article 243 | 244 | 245 | Changes in version 1.13 (12 October, 2009) 246 | 247 | * Fixed one misused macro in documentation 248 | 249 | 250 | Changes in version 1.12 (5 May, 2009) 251 | 252 | * Modified CITATION file to conform to standards 253 | 254 | 255 | Changes in version 1.11 (6 March, 2009) 256 | 257 | * Changed last variable name to 'logSD' in 'heli' and clarified 258 | documentation for that dataset 259 | 260 | * Fixed bug in contour.lm relating to original use of model formula, 261 | e.g. it now works with for model fitted by 'lm(swiss)' 262 | 263 | 264 | Changes from version 1.10 (30 December, 2008) 265 | 266 | * Added functions ccd() and bbd() for generating RS designs 267 | 268 | * Added function ccd.pick() to help in choosing good CCDs 269 | 270 | * Added checks in rsm() for aliased parameters 271 | 272 | * Added NEWS and CITATION files. 273 | 274 | * Tweaks/corrections/additions to documentation and vignettes. 275 | 276 | 277 | Changes from version 1.01 (5 December 2008) 278 | 279 | * Added canonical.path function 280 | 281 | * Modified formula handling in coded.data and relatives so that any 282 | legal expression will work (as long as it's linear!) 283 | 284 | * Overhauled contour.lm, with different argument list. Now it is much 285 | easier to use, and can produce multiple plots with one call. 286 | 287 | * Provided a true vignette. Other improvements to documentation. 288 | -------------------------------------------------------------------------------- /R/coding.R: -------------------------------------------------------------------------------- 1 | ############################################################################## 2 | # Copyright (c) 2008-2010, 2012-2025 Russell V. Lenth # 3 | # # 4 | # This file is part of the rsm package for R (*rsm*) # 5 | # # 6 | # *rsm* is free software: you can redistribute it and/or modify # 7 | # it under the terms of the GNU General Public License as published by # 8 | # the Free Software Foundation, either version 2 of the License, or # 9 | # (at your option) any later version. # 10 | # # 11 | # *rsm* is distributed in the hope that it will be useful, # 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of # 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # 14 | # GNU General Public License for more details. # 15 | # # 16 | # A copy of the GNU General Public License is available at # 17 | # # 18 | ############################################################################## 19 | 20 | ### Functions for handling coded data 21 | 22 | # parse a coding formula. 23 | # Normally expects the form coded ~ (orig - center) / divisor, 24 | # But any linear expression in one variable is OK. 25 | .parse.coding = function(form) { 26 | if (!inherits(form, "formula")) 27 | stop("Coding formulas must be of class \"formula\"") 28 | if (length(form) < 3) 29 | stop("Formula lacks a left-hand-side") 30 | nm = all.vars(form) 31 | if (length(nm) < 2) 32 | stop(paste("Error in coding formula:", .form2str(form), 33 | "\nCoded and uncoded names must differ")) 34 | names(nm) = c("coded", "orig") 35 | rhs = as.character(form)[3] 36 | a = eval(parse(text = sub(nm[2], "0", rhs))) 37 | b = eval(parse(text = sub(nm[2], "1", rhs))) 38 | d = 1 / (b - a) 39 | c = -a * d 40 | dig = 3 + ceiling(log(abs(c), 10)) - floor(log(d, 10)) 41 | list(names = nm, const=c(center = signif(c, dig), divisor = signif(d, 4))) 42 | } 43 | 44 | ### figure out the "rsdes" attribute for given data 45 | # arguments data and primary are REQUIRED 46 | # block, if non-missing, is PROPOSED name(s) for blocks. If pmatched (case insensitively) 47 | # to variables in data, those columns are designated blocking factors 48 | .rsdesattr = function(data, primary, block, call) { 49 | rsd = list(primary=primary) 50 | if (!missing(block)) { 51 | bidx = pmatch(tolower(block), tolower(names(data))) 52 | bidx = bidx[!is.na(bidx)] 53 | if (length(bidx) > 0) { 54 | rsd$block = names(data)[bidx] 55 | blk = data[[bidx[1]]] 56 | if (length(bidx) > 1) 57 | for (i in bidx[-1]) blk = paste(blk, data[[i]], sep=".") 58 | bidxs = split(1:nrow(data), blk) 59 | } 60 | } 61 | 62 | if (!missing(call)) rsd$call = call 63 | rsd 64 | } 65 | 66 | ### Create a string that looks the same as a printed formula 67 | .form2str = function(formula) { 68 | if (inherits(formula, "formula")) { 69 | formula = as.character(formula) 70 | if (length(formula) == 3) 71 | formula = paste(formula[c(2,1,3)], collapse=" ") 72 | else 73 | formula = paste(formula, collapse=" ") 74 | } 75 | formula 76 | } 77 | 78 | 79 | # Code the data in a data.frame; may specify as arguments or in a list 80 | coded.data = function(data, ..., formulas=list(...), block="block") { 81 | CALL = match.call() 82 | nm = names(data) 83 | if (length(formulas) == 0) { 84 | # stop("must provide coding formulas") 85 | # auto-generated codings ... 86 | codables = nm[sapply(data, function(x) length(unique(x)) < 6)] 87 | if (any(!is.na(exc <- pmatch(tolower(block), tolower(codables))))) 88 | codables = codables[-exc] 89 | if (length(codables) == 0) 90 | stop("No codings supplied and no variables with 5 or fewer distinct values") 91 | for (i in 1:length(codables)) { 92 | rng = range(as.numeric(data[[codables[i]]])) 93 | ctr = round(mean(rng), 3) 94 | div = round(rng[2] - ctr, 3) 95 | formulas[[i]] = as.formula(paste( 96 | "x", i, "~(", codables[i], "-", ctr, ")/", div, sep="")) 97 | 98 | } 99 | warning("Automatic codings created -- may not be what you want") 100 | } 101 | 102 | codings = list() 103 | for (f in formulas) { 104 | attr(f, ".Environment") = .GlobalEnv # keeps it from showing env when printed 105 | info = .parse.coding(f) 106 | cod = info$names[["coded"]] 107 | org = info$names[["orig"]] 108 | codings[[cod]] = f 109 | if (!is.null(data[[org]])) { 110 | if (is.factor(data[[org]])) 111 | data[[org]] = as.numeric(data[[org]]) 112 | data[[org]] = (data[[org]] - info$const[["center"]]) / info$const[["divisor"]] 113 | nm[nm==org] = cod 114 | } 115 | } 116 | names(data) = nm 117 | attr(data, "design.info") = attr(data, "desnum") = attr(data, "run.order") = NULL # will no longer obey "design" class 118 | attr(data, "codings") = codings 119 | attr(data, "rsdes") = .rsdesattr(data, primary=names(codings), block=block, CALL) 120 | if (!is.coded.data(data)) 121 | class(data) = c("coded.data", "data.frame") 122 | data 123 | } 124 | 125 | # Add coding attributes to already-coded data 126 | as.coded.data = function(data, ..., formulas=list(...), block="block") { 127 | if (!is.data.frame(data)) 128 | stop("'data' must inherit from \"data.frame\"") 129 | CALL = match.call() 130 | if (length(formulas) == 0) { 131 | if (is.coded.data(data)) 132 | formulas = codings(data) 133 | else { 134 | codable = sapply(data, function(x) zapsmall(c(mean(x), max(x)))[1] == 0) 135 | if (sum(codable) == 0) 136 | stop("No codings supplied and no variables look like coded variables") 137 | formulas = sapply(names(data)[codable], function(nm) 138 | as.formula(paste(nm, "~", nm, ".as.is", sep=""))) 139 | warning("Default codings created -- may not be what you want") 140 | } 141 | } 142 | codings = list() 143 | for (f in formulas) { 144 | attr(f, ".Environment") = .GlobalEnv 145 | info = .parse.coding(f) 146 | cod = info$names[["coded"]] 147 | codings[[cod]] = f 148 | } 149 | mismatch = is.na(match(names(codings), names(data))) 150 | if (any(mismatch)) 151 | stop("mismatch between coded names and data names") 152 | attr(data, "design.info") = attr(data, "desnum") = attr(data, "run.order") = NULL # will no longer obey "design" class 153 | attr(data, "codings") = codings 154 | attr(data, "rsdes") = .rsdesattr(data, primary=names(codings), block=block, CALL) 155 | if (!is.coded.data(data)) 156 | class(data) = c("coded.data", "data.frame") 157 | data 158 | } 159 | 160 | is.coded.data = function(x) 161 | inherits(x, "coded.data") 162 | 163 | print.coded.data = function(x, ..., decode = TRUE) { 164 | if (!decode) { 165 | print.data.frame (x, ...) 166 | cat ("\nVariable codings ...\n") 167 | } 168 | else { 169 | print.data.frame(decode.data(x), ...) 170 | cat ("\nData are stored in coded form using these coding formulas ...\n") 171 | } 172 | sapply (attr(x, "codings"), print, showEnv=FALSE) 173 | invisible (x) 174 | } 175 | 176 | # Transform coded data back to original scale 177 | decode.data = function(data) { 178 | nm = names(data) 179 | codings = attr(data, "codings") 180 | if (!is.null(codings)) for (f in codings) { 181 | info = .parse.coding(f) 182 | cod = info$names[["coded"]] 183 | org = info$names[["orig"]] 184 | if (!is.null(data[[cod]])) { 185 | data[[cod]] = info$const[["divisor"]] * data[[cod]] + info$const[["center"]] 186 | nm[nm==cod] = org 187 | } 188 | } 189 | names(data) = nm 190 | attr(data, "codings") = NULL 191 | attr(data, "rsdes") = NULL 192 | cls = class(data) 193 | class(data) = cls[cls != "coded.data"] 194 | data 195 | } 196 | 197 | ### Recode a set of coded data, e.g. to a new center 198 | recode.data = function(data, ..., formulas = list(...)) { 199 | rsd = attr(data, "rsdes") 200 | ddc = decode.data(data) 201 | data = coded.data(ddc, formulas=formulas) 202 | rsd$primary = attr(data, "rsdes")$primary 203 | attr(data, "rsdes") = rsd 204 | data 205 | } 206 | 207 | # Convert values in X to original based on codings 208 | # Returns an object of the same type (data.frame, matrix, or vector) 209 | # names (or column names) of X must match those used in codings 210 | code2val = function(X, codings) { 211 | if (is.matrix(X)) 212 | Z = as.matrix (code2val(as.data.frame(X), codings)) 213 | else if (is.vector(X)) { 214 | nm = names(X) 215 | X = as.data.frame(as.list(X)) 216 | names(X) = nm 217 | X = code2val (X, codings) 218 | Z = as.numeric (as.matrix (X)) 219 | names(Z) = names(X) 220 | } 221 | else if (is.data.frame(X)) { 222 | attr(X, "codings") = codings 223 | Z = decode.data(X) 224 | } 225 | else stop ("Can't convert this object") 226 | Z 227 | } 228 | 229 | # Convert values in X to original based on codings 230 | # Returns an object of the same type (data.frame, matrix, or vector) 231 | # names (or column names) of X must match those used in codings 232 | val2code = function(X, codings) { 233 | if (is.matrix(X)) 234 | Z = as.matrix (val2code (as.data.frame(X), codings)) 235 | else if (is.vector(X)) { 236 | nm = names(X) 237 | X = as.data.frame(as.list(X)) 238 | names(X) = nm 239 | X = val2code (X, codings) 240 | Z = as.numeric (as.matrix (X)) 241 | names(Z) = names(X) 242 | } 243 | else if (is.data.frame(X)) { 244 | Z = coded.data(X, formulas=codings) 245 | attr(Z, "codings") = NULL 246 | cls = class(Z) 247 | class(Z) = cls[cls != "coded.data"] 248 | } 249 | else stop ("Can't convert this object") 250 | Z 251 | } 252 | 253 | # Primitive accessor methods 254 | codings = function(object) 255 | UseMethod("codings") 256 | 257 | # S3 method for codings in coded.data 258 | codings.coded.data = function(object) 259 | attr(object, "coding") 260 | 261 | "codings<-" = function(object, value) { 262 | as.coded.data(object, formulas = value) 263 | } 264 | 265 | # Needed because we lose some attributes when subsetting 266 | # Also we remove codings of variables that are lost 267 | "[.coded.data" = function(x, ...) { 268 | cod = attr(x, "codings") 269 | rsd = attr(x, "rsdes") 270 | cls = class(x) 271 | x = get("[.data.frame")(x, ...) 272 | if (!("coded.data" %in% cls)) 273 | return (x) 274 | lost = which(is.na(match(nm <- names(cod), names(x)))) 275 | for (i in lost) cod[[nm[i]]] <- NULL 276 | if (length(cod) > 0) { 277 | attr(x, "codings") = cod 278 | attr(x, "rsdes") = rsd 279 | } 280 | else { # no longer a coded dataset 281 | class(x) = cls[-1] 282 | attr(x, "codings") = attr(x, "rsdes") = NULL 283 | } 284 | x 285 | } 286 | 287 | # When renaming coded data, change the formulas accordingly 288 | "names<-.coded.data" = function(x, value) { 289 | if (!is.coded.data(x)) stop("not a coded.data object") 290 | oldnm = attr(x, "names") 291 | cod = codings(x) 292 | for (i in 1:length(oldnm)) { 293 | if (value[i] != oldnm[i]) { 294 | idx = match(oldnm[i], names(cod)) 295 | if (!is.na(idx)) { 296 | names(cod)[idx] = value[i] 297 | cod[[idx]][[2]] = as.name(value[i]) 298 | } 299 | } 300 | } 301 | attr(x, "names") = value 302 | attr(x, "codings") = cod 303 | x 304 | } 305 | 306 | 307 | # This is the flip side of names<-.coded.data: rename the original variables 308 | "truenames" = function(x) { 309 | UseMethod("truenames") 310 | } 311 | 312 | "truenames.coded.data" = function(x) { 313 | nm = names(x) 314 | if(is.coded.data(x)) { 315 | for (f in codings(x)) { 316 | vn = all.vars(f) 317 | if (!is.na(idx <- grep(vn[1], nm))) 318 | nm[idx] = vn[2] 319 | } 320 | } 321 | nm 322 | } 323 | 324 | "truenames<-" = function(x, value) { 325 | UseMethod("truenames<-") 326 | } 327 | 328 | "truenames<-.coded.data" = function(x, value) { 329 | if (!is.coded.data(x)) stop("not a coded.data object") 330 | oldnm = newnm = attr(x, "names") 331 | oldtrue = truenames(x) 332 | cod = codings(x) 333 | whichcoded = match(names(cod), oldnm) 334 | for (i in 1:length(oldnm)) { 335 | if (i %in% whichcoded) { # replace in coding formulas 336 | fstr = paste(as.character(cod[[oldnm[i]]])[c(2,1,3)], collapse=" ") 337 | cod[[oldnm[i]]] = as.formula(gsub(oldtrue[i], value[i], fstr)) 338 | } 339 | else 340 | newnm[i] = value[i] 341 | } 342 | 343 | attr(x, "names") = newnm 344 | attr(x, "codings") = cod 345 | x 346 | } 347 | -------------------------------------------------------------------------------- /man/ccd.Rd: -------------------------------------------------------------------------------- 1 | % Copyright (c) 2008-2010, 2012-2025 Russell V. Lenth 2 | \name{ccd} 3 | 4 | \alias{cube} 5 | \alias{star} 6 | \alias{dupe} 7 | \alias{foldover} 8 | \alias{ccd} 9 | \title{Generate central-composite designs and associated building blocks} 10 | \description{ 11 | These functions generate central-composite designs, or building blocks thereof. 12 | They allow for flexible choices of replications, aliasing of predictors and fractional blocks, and choices of axis or \sQuote{star} points. 13 | } 14 | \usage{ 15 | cube(basis, generators, n0 = 4, reps = 1, coding, randomize = TRUE, 16 | blockgen, bid = 1, inscribed = FALSE) 17 | star(basis, n0 = 4, alpha = "orthogonal", reps = 1, randomize = TRUE) 18 | dupe(design, randomize = TRUE, coding) 19 | foldover(basis, variables, bid, randomize = TRUE) 20 | ccd(basis, generators, blocks = "Block", n0 = 4, alpha = "orthogonal", 21 | wbreps = 1, bbreps = 1, randomize = TRUE, inscribed = FALSE, 22 | coding, oneblock = FALSE) 23 | } 24 | \arguments{ 25 | \item{basis}{In \code{cube} and \code{ccd}, a formula, or an integer giving the number of variables. If the formula has a left-hand side, the variables named there are appended to the design and initialized to \code{NA}. 26 | In \code{star}, \code{dupe}, and \code{foldover}, \code{basis} is a \code{coded.data} object to use as a reference.} 27 | \item{generators}{Optional formula or list of formulas to generate aliased variables} 28 | \item{n0}{Integer giving the number of center points. In \code{ccd}, this can be a vector of 29 | two numbers for the numbers of center points in the cube blocks and the star blocks, 30 | respectively.} 31 | \item{reps}{Integer number of replications of the cube or the star. (This does \emph{not} create replicate blocks; use \code{\link{djoin}} to do that.)} 32 | \item{coding}{List of coding formulas for the design variables (those in \code{basis} and \code{generators}). In \code{dupe}, \code{coding} may be used to change the coding formulas, e.g. in a situation where we want to use the same design as before but center it elsewhere.} 33 | \item{randomize}{Logical value determining whether or not to randomize the design. In \code{ccd}, each block is randomized separately.} 34 | \item{blockgen}{A formula, string, or list thereof. Each element is evaluated, and the distinct combinations define fractional blocks for the design. Unlike \code{ccd}, \code{cube} returns only one of these blocks.} 35 | \item{bid}{(For block ID.) An integer index (from 1 to number of blocks) of the fractional block to return. The indexes are defined by the standard ordering of the block generators; e.g. if \code{blockgen} is of length 2, the \code{bid} values of (1, 2, 3, 4) correspond to generated levels of \code{(--, +-, -+, ++)} respectively.} 36 | \item{inscribed}{Logical value; if \code{FALSE}, the cube points are at +/- 1 in each variable. If \code{TRUE}, the entire desgn is scaled down so that the axis points are at +/- 1 and the cube points are at interior positions. In \code{cube} only, \code{inscribed} may be given a numeric value: use the value of \code{alpha} anticipated when axis points are added; or use \samp{inscribed = TRUE} to scale in anticipation of \samp{alpha = "spherical"}.} 37 | \item{alpha}{If numeric, the position of the \sQuote{star} points. May also be a character string that matches or partially matches one of these: 38 | \describe{ 39 | \item{\code{"orthogonal"}}{the star points are positioned to block the design orthogonally} 40 | \item{\code{"rotatable"}}{the star points are chosen to make the design rotatable} 41 | \item{\code{"spherical"}}{the star points are the same distance as the corners of the design cube (alpha is the square root of the number of design factors)} 42 | \item{\code{"faces"}}{the star points are face-centered (same as \samp{alpha = 1})} 43 | } 44 | The user may specify a vector value of \code{alpha} if it is desired to vary them on different axes. The values are rotated cyclically as needed. 45 | } 46 | \item{design}{A \code{coded.data} object to be duplicated.} 47 | \item{blocks}{A string or a formula. If a character string, it is the name of the blocking factor; if a formula, the left-hand side is used as the name of the blocking factor. The formula(s) on the right-hand side are used to generate separate fractional blocks.} 48 | \item{variables}{Character vector of names of variables to fold over.} 49 | \item{wbreps}{Number(s) of within-block replications. If this is a vector of length 2, then separate numbers are used for the \sQuote{cube} and the \sQuote{star} blocks respectively.} 50 | \item{bbreps}{Number(s) of between-block replications (i.e., number of repeats of each block). If this is a vector of length 2, then separate numbers are used for the \sQuote{cube} and the \sQuote{star} blocks respectively.} 51 | \item{oneblock}{Logical. If \code{TRUE}, the blocking factor is removed and the whole design is randomized as a single block. Note that the default number of center points may be larger than you anticipated because they are combined.} 52 | } 53 | \details{ 54 | Central-composite designs (CCDs) are popular designs for use in response-surface exploration. They are blocked designs consisting of at least one \sQuote{cube} block (two-level factorial or fractional factorial, plus center points), and at least one \sQuote{star} block (points along each axis at positions \code{-alpha} and \code{+alpha}), plus center points. Everything is put on a coded scale, where the cube portion of the design has values of -1 and 1 for each variable, and the center points are 0. 55 | 56 | The \code{ccd} function creates an entire CCD design; however, in practice, we often start with just the cube portion and build from there. Therefore, the functions \code{cube}, \code{star}, \code{dupe}, and \code{foldover} are provided, and one may use \code{\link{djoin}} to combine them. 57 | 58 | In \code{cube} and \code{ccd}, the \code{basis} argument determines a basic design used to create cube blocks. 59 | For example, \samp{cube(basis = ~ A + B + C)} would generate a basic design of 8 factorial points plus center points. 60 | Use \code{generators} if you want additional variables in a fractional design; for example, \samp{generators = c(D ~ -A*B, E ~ B*C)} added to the above would generate a 5-factor design with defining relation \code{I = -ABD = BCE = -ACDE}. For convenience, \code{basis} may be an integer instead of a formula, in which case default variable names of \code{x1, x2, \dots} are used; for example, \samp{cube(3, ~ -x1*x2*x3)} generates a 1/2 fraction design with added center points. 61 | 62 | If you want the cube points divided into fractional blocks, give the formula(s) in the \code{blockgen} argument of \code{cube}, or the \code{blocks} argument of \code{ccd}. For instance, suppose we call \samp{cube(basis = A+B+C+D+E}, \samp{generators = F~-A*C*D)}. 63 | This design has 32 runs; but adding the argument \samp{blockgen = c("A*B*C","C*D*E")} will 64 | create a fractional block of 32/4 = 8 runs. (\code{cube} is flexible; we could have used a 65 | formula instead, either \samp{blockgen = ~ c(A*B*C, C*D*E)} or 66 | \samp{blockgen = c(~A*B*C, ~C*D*E)}.) Center points are added to each block as specified. 67 | In a call to \code{ccd} with the same \code{basis} and \code{generators}, adding 68 | \samp{blocks = Day ~ c(A*B*C, C*D*E)} would do the same thing, only all 4 blocks will be 69 | included, and a factor named \code{Day} distinguishes the blocks. 70 | 71 | The functions \code{star}, \code{dupe}, and \code{foldover} provide for creating new design blocks based on an existing design. They also provide for delayed evaluation: if the \code{basis} argument is missing, these functions simply return the call, \code{\link{djoin}} will fill-in \samp{basis = design1} and evaluate it. 72 | 73 | \code{dupe} simply makes a copy of the design, and re-randomizes it. Therefore it is also a convenient way to re-randomize a design. If \code{coding} is provided, the coding formulas are replaced as well -- for example, to re-center the design. 74 | 75 | Use \code{star} to generate star (axis) points, which consist of center points plus points at \code{+/- alpha} on each coordinate axis. You may specify the \code{alpha} you want, or a character argument to specify a certain criterion be met. For example, using delayed evaluation, \samp{ccd1 = djoin(cube1, star(alpha="sph"))} will return a CCD with \code{cube1} as the cube block, and with axis points at the same distance as the corners of the cube. Conditions for the criteria on \code{alpha} are described in detail in references such as Myers \emph{et al.} (2009). 76 | 77 | In \code{star}, determinations of orthogonality and rotatability are based on computed design moments of \code{basis}, rather than any assumptions about the structure of the design being augmented. Thus, it may be possible to augment an unusual design to obtain a rotatable design. Also, if an orthogonal star block is requested, the value of \code{alpha} may vary from axis to axis if that is required to satisfy the condition. 78 | 79 | \code{foldover} reverses the levels of one or more design variables (i.e., those that are coded). By default, it reverses them all. However, if the \code{bid} argument is supplied, it instead returns the \code{bid}th fractional block that \code{cube} would have generated. That is, \samp{foldover(des, bid=3)} is equivalent to \samp{cube(, bid=3)} -- only it does so much more efficiently by folding on the appropriate factors. 80 | 81 | In cases where there are constraints on the region of operability, you may want to specify \code{inscribed = TRUE}. This will scale-down the design so that no coded value exceeds 1. If using a building-block approach starting with a first-order design from \code{cube}, call \code{cube} with \code{inscribed} set to the anticipated value of \code{alpha}, or use \samp{inscribed = TRUE}, and then use \samp{alpha = "spherical"} in the subsequent call to \code{star}. 82 | 83 | \code{ccd} generates an entire CCD. In practice, the building-block approach with \code{cube}, \code{star}, etc. is usually preferable, but \code{ccd} exists for convenience and backward compatibility with pre-2.00 versions of \pkg{rsm}. Many of the arguments are the same as those in \code{cube}; however, \code{n0}, \code{wbreps}, \code{bbreps} may be single values or vectors; if vectors, the first element is for the cube portions and the second element is for the star portions. In \code{ccd}, specifying \code{wbreps} is equivalent to specifying \code{reps} in a call to \code{cube} or \code{star}. \code{bbreps} refers to replicate blocks in the experiment, so that \samp{bbreps = c(2,3)} specifies that we join two cube blocks and three blocks of star points. 84 | 85 | If \code{coding} is not specified in a new design, default identity codings are created, e.g. \samp{x1 ~ x1.as.is}. 86 | } 87 | 88 | \value{ 89 | A \code{\link{coded.data}} object with the generated design, with additional variables \code{run.order} and \code{std.order}. If a multi-block design, the generated blocking variable will be a \code{\link{factor}}; all other variables will be numeric. The designs are sorted by blocks and \code{run.order} within blocks; and (unlike pre-1.41 versions of \pkg{rsm}) the \code{row.names} will be integers corresponding to this ordering. The user may sort by block and \code{std.order} within block to display the designs in their pre-randomized order. 90 | } 91 | \references{ 92 | Lenth RV (2009) ``Response-Surface Methods in R, Using rsm'', 93 | \emph{Journal of Statistical Software}, 32(7), 1--17. 94 | \doi{10.18637/jss.v032.i07} 95 | 96 | Myers, RH, Montgomery, DC, and Anderson-Cook, CM (2009) 97 | \emph{Response Surface Methodology} (3rd ed.), Wiley. 98 | } 99 | \author{Russell V. Lenth} 100 | \note{ 101 | Poor choices of \code{generators} and/or \code{blocks} can alias or partially alias some effects needed to estimate a second-order response surface. It is a good idea to run \code{\link{varfcn}} before collecting data to examine the prediction capabilities of the design and to ensure that the desired model can be fitted. 102 | 103 | The function \code{\link{ccd.pick}} is available to help determine good choices for arguments to \code{cube}, \code{star}, and \code{ccd}. 104 | 105 | An alternative to a CCD when you want to go straight to second-order modeling is a Box-Behnken design, generated by \code{\link{bbd}}. These designs are not as various or flexible as CCDs, but they can require fewer runs. 106 | 107 | The non-exported function \code{rsm:::.ccd.1.41} is provided in case it is needed by other packages for compatibility with old versions of \pkg{rsm} (version 1.41 or earlier). Given the same seed, it will also reproduce the randomization as a previously generated design from an old version. 108 | } 109 | \seealso{\code{\link{ccd.pick}}, \code{\link{coded.data}}, \code{\link{varfcn}}, \code{\link{bbd}}} 110 | \examples{ 111 | library(rsm) 112 | 113 | ### Generate a standard 3-variable first-order design with 8 corner points and 4 center points 114 | ( FOdes <- cube (3, n0 = 4, coding = list ( 115 | x1 ~ (Temp - 150)/10, x2 ~ (Pres - 50)/5, x3 ~ Feedrate - 4)) ) 116 | 117 | ### Add an orthodonal star block with 12 runs to create a second-order CCD 118 | ( SOdes <- djoin(FOdes, star(n0=6)) ) 119 | 120 | ### Same as above, except make the whole CCD at once; and make it rotatable 121 | ### and inscribed so that no coded value exceeds 1 122 | SOdes2 <- ccd (3, n0 = c(4,6), alpha = "rotatable", inscribed = TRUE, coding = list ( 123 | x1 ~ (Temp - 150)/10, x2 ~ (Pres - 50)/5, x3 ~ Feedrate - 4)) 124 | 125 | ### Make two replicate blocks of FOdes (2nd one randomized differently) 126 | djoin(FOdes, dupe(FOdes)) 127 | 128 | ### Fractional blocking illustration (with no center points) 129 | # Basic design (bid = 1 ---> block generators b1 = -1, b2 = -1) 130 | block1 <- cube (~ x1 + x2 + x3 + x4, generators = x5 ~ x1 * x2 * x3 * x4, 131 | n0 = 0, blockgen = ~ c(x1 * x2, x1 * x3), bid = 1) 132 | block1 133 | 134 | # The foldover (on all variables) of block1, in the same order 135 | foldover(block1, randomize=FALSE) 136 | 137 | # The 4th fractional block: 138 | ( block4 <- foldover(block1, bid = 4) ) 139 | 140 | } 141 | 142 | % Add one or more standard keywords, see file 'KEYWORDS' in the 143 | % R documentation directory. 144 | \keyword{design} 145 | -------------------------------------------------------------------------------- /R/contour-lm.R: -------------------------------------------------------------------------------- 1 | ############################################################################## 2 | # Copyright (c) 2008-2010, 2012-2025 Russell V. Lenth # 3 | # # 4 | # This file is part of the rsm package for R (*rsm*) # 5 | # # 6 | # *rsm* is free software: you can redistribute it and/or modify # 7 | # it under the terms of the GNU General Public License as published by # 8 | # the Free Software Foundation, either version 2 of the License, or # 9 | # (at your option) any later version. # 10 | # # 11 | # *rsm* is distributed in the hope that it will be useful, # 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of # 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # 14 | # GNU General Public License for more details. # 15 | # # 16 | # A copy of the GNU General Public License is available at # 17 | # # 18 | ############################################################################## 19 | 20 | ### Reconstructs the data set used in a linear model, and 21 | ### returns it as a data.frame 22 | 23 | # # Old version -- had a couple of issues related to scoping 24 | # model.data = function (lmobj, lhs = FALSE) { 25 | # form = lmobj$call$formula 26 | # if (is.name(form)) { 27 | # lmobj$call$data = form 28 | # form = formula(lmobj) 29 | # } 30 | # if (lhs) 31 | # nm = all.vars(form) 32 | # else nm = all.vars(form[[3]]) 33 | # if (inherits(lmobj, "rsm") && !is.null(lmobj$data)) 34 | # lmobj$data[ ,nm] 35 | # else { 36 | # form = as.formula(paste("~", paste(nm, collapse = "+"))) 37 | # envir = attr(lmobj$terms, ".Environment") 38 | # model.frame(form, eval(lmobj$call$data, envir=envir), 39 | # subset = eval(lmobj$call$subset, envir=envir)) 40 | # } 41 | # } 42 | 43 | ### New version based on lsmeans:::recover.data.call 44 | model.data = function (lmobj, lhs = FALSE) { 45 | fcall = lmobj$call 46 | m = match(c("formula", "data", "subset", "weights"), names(fcall), 0L) 47 | fcall = fcall[c(1L, m)] 48 | fcall[[1L]] = as.name("model.frame") 49 | trms = terms(lmobj) 50 | if (!lhs) 51 | trms = delete.response(trms) 52 | vars = all.vars(trms) 53 | if(!is.null(dat <- lmobj$data)) 54 | dat[, vars, drop = FALSE] 55 | else { 56 | form = reformulate(vars) 57 | fcall$formula = update(trms, form) 58 | env = environment(trms) 59 | if (is.null(env)) 60 | env = parent.frame() 61 | eval(fcall, env, parent.frame()) 62 | } 63 | } 64 | 65 | ### contour plot(s) for a lm 66 | contour.lm = function(x, form, at, bounds, zlim, 67 | xlabs, hook, plot.it=TRUE, atpos = 1, decode=TRUE, 68 | image=FALSE, img.col=terrain.colors(50), ...) 69 | { 70 | if (!missing(at)) { 71 | if (is.null(names(at))) 72 | stop("'at' must be a NAMED list of values used for surface slices") 73 | } 74 | if (!missing(bounds)) { 75 | if (is.null(names(bounds))) 76 | stop("'bounds' must be a NAMED list of bounds for each variable") 77 | } 78 | 79 | # return decoded values from vector cval for coded variable named cname 80 | # made to be transparent to uncoded situations 81 | .decode.value = function(cname, cval) { 82 | if (decode && !is.null(forms)) { 83 | if (is.null(form <- forms[[cname]])) 84 | cval 85 | else { 86 | inf = .parse.coding(forms[[cname]]) 87 | inf$const[1] + cval * inf$const[2] 88 | } 89 | } 90 | else 91 | cval 92 | 93 | } 94 | 95 | lmobj = x # generic wants it named 'x', I don't! 96 | 97 | data = model.data(lmobj) 98 | 99 | # make list of formulas if not already 100 | if(inherits(form,"formula")) { 101 | if (length(form)==2) { # rhs only 102 | vars = all.vars(form[[2]]) 103 | n = length(vars) 104 | if (n < 2) stop("Need at least two variables") 105 | form = list() 106 | elt = 1 107 | for (i in 1:(n-1)) 108 | for (j in (i+1):n) { 109 | form[[elt]] = formula(paste(vars[j],vars[i],sep="~")) 110 | elt = elt + 1 111 | } 112 | } 113 | else { 114 | yvars = all.vars(form[[2]]) 115 | xvars = all.vars(form[[3]]) 116 | form = list() 117 | elt = 1 118 | for (i in 1:length(xvars)) 119 | for (j in 1:length(yvars)) { 120 | form[[elt]] = formula(paste(yvars[j],xvars[i],sep="~")) 121 | elt = elt + 1 122 | } 123 | } 124 | } 125 | vars = sort(unique(as.character(sapply(form, all.vars)))) 126 | 127 | dots = list(...) 128 | if (!is.null(dots$ylab)) 129 | message("'ylab' ignored. Specify axis labels using 'xlabs'") 130 | if(!missing(xlabs) && length(xlabs) < length(vars)) 131 | stop("'xlabs' does not contain enough labels" ) 132 | 133 | forms = NULL # for all non-rsm objects 134 | if (inherits(lmobj, "rsm")) { 135 | forms = codings(lmobj) 136 | if (missing(xlabs) && !is.null(forms)) { 137 | if(!decode) 138 | xlabs = sapply(vars, function(v) 139 | paste(as.character(forms[[v]][2:3]), collapse=" = ")) 140 | else { 141 | xlabs = sapply(vars, function(v) all.vars(forms[[v]][[3]])[1]) 142 | } 143 | } 144 | else if (missing(xlabs)) 145 | xlabs = vars 146 | } 147 | else if (missing(xlabs)) 148 | xlabs = vars 149 | 150 | 151 | # gather 'at' info 152 | tmp = lapply(data, function(var) { 153 | if (is.factor(var)) factor(levels(var)) ####NEW [1], levels=levels(var)) 154 | else mean(var) 155 | }) 156 | # remember original at list 157 | orig.atnm = NULL 158 | if (!missing(at)) { 159 | orig.atnm = names(at) 160 | for (nm in orig.atnm) { 161 | numflag = is.numeric(tmp[[nm]]) 162 | if (numflag) tmp[[nm]] = as.numeric(at[[nm]]) 163 | else tmp[[nm]] = at[[nm]] 164 | } 165 | } 166 | at = tmp 167 | 168 | # gather 'bounds' info -- elts can be vectors of length 2, 3, or n 169 | tmp = lapply(data, function(x) if (is.numeric(x)) range(x)) 170 | if (!missing(bounds)) 171 | for (nm in names(bounds)) 172 | if (length(bounds[[nm]]) > 1) 173 | tmp[[nm]] = bounds[[nm]] 174 | bounds = lapply(tmp, function(x) { 175 | if (length(x) == 2) seq(x[1], x[2], length=26) 176 | else if (length(x) == 3) seq(x[1], x[2], length=x[3]) 177 | else x 178 | }) 179 | 180 | # get names to use in slice labels 181 | isnum = sapply(at, is.numeric) # was commented-out 182 | allnum = names(at)[isnum] # ditto 183 | # allfac = names(at)[!isnum] 184 | 185 | ### Accumulate the z values 186 | plot.data = list() 187 | lbls = rep("", length(form)) 188 | z.rng = NULL 189 | for (i in 1:length(form)) { 190 | AT = at 191 | v = all.vars(form[[i]]) 192 | bad = which(!(v %in% names(data))) 193 | if (length(bad) > 0) 194 | stop("Unknown variable(s) encountered in 'form': ", 195 | paste(v[bad], collapse = ", "), call. = FALSE) 196 | if (length(unique(v)) == 1) next 197 | y = AT[[v[1]]] = bounds[[v[1]]] 198 | x = AT[[v[2]]] = bounds[[v[2]]] 199 | newdata = do.call(expand.grid, AT) 200 | ord = order(newdata[[v[1]]], newdata[[v[2]]]) 201 | newdata = newdata[ord, ] 202 | z = predict (lmobj, newdata = newdata) 203 | # NEW: average over factor levels... 204 | rep = length(z) / length(x) / length(y) # copies at each (x,y) pair 205 | if (rep > 1) 206 | z = apply(matrix(z, nrow=rep), 2, mean) 207 | 208 | 209 | z.rng = range (c (z.rng, z)) 210 | if (!missing(zlim)) { 211 | z[z > zlim[2]] = NA 212 | z[z < zlim[1]] = NA 213 | } 214 | vnames = c(x=v[2], y=v[1]) 215 | labs = c(xlabs[sapply(vnames, charmatch, vars)], vnames, "") 216 | lbls[i] = paste(labs[3], labs[4], sep=" ~ ") 217 | 218 | # figure out slice labels 219 | if (atpos != 0) { 220 | #atidx = - sapply(vnames, grep, allnum) 221 | #atidx = allnum[atidx] 222 | # REPLACEMENT: 223 | atidx = setdiff(allnum, vnames) ## was vnames in rsm2.0 -- NOT correct! 224 | if (length(atidx) > 0) { ###### || length(allfac) > 0) { 225 | atlabs = NULL 226 | if (length(atidx) > 0) { 227 | atvals = signif(sapply(atidx, function(v) .decode.value(v, at[[v]])), 2) 228 | if (decode && !is.null(forms)) { 229 | dclabs = sapply(atidx, function(x) { 230 | f = forms[[x]] 231 | if (is.null(f)) x 232 | else { 233 | info = .parse.coding(f) 234 | info[[1]][2] 235 | } 236 | }) 237 | atlabs = paste(dclabs, atvals, sep=" = ") 238 | } 239 | else 240 | atlabs = paste(atidx, atvals, sep = " = ") 241 | } 242 | # added for factors in 'at' 243 | facidx = setdiff(setdiff(orig.atnm, atidx), v) 244 | if(length(facidx) > 0) { 245 | facx = unlist(at[facidx]) 246 | fn = which(!is.na(suppressWarnings(as.numeric(facx)))) 247 | facx[fn] = signif(as.numeric(facx[fn]), digits = 2) 248 | faclabs = paste(facidx, facx, sep = " = ") 249 | atlabs = c(atlabs, faclabs) 250 | } 251 | atlabs = paste(atlabs, collapse = ", ") ### NEW 252 | labs[5] = paste("Slice at", atlabs) 253 | if (atpos < 3) 254 | labs[atpos] = paste(labs[atpos], "\n", labs[5], sep = "") 255 | 256 | } 257 | } 258 | y = .decode.value(v[1], y) 259 | x = .decode.value(v[2], x) 260 | 261 | plot.data[[i]] = list(x=x, y=y, 262 | z=matrix(z, nrow=length(x)), labs=labs) 263 | } 264 | names(plot.data) = lbls 265 | 266 | if (missing (zlim)) zlim = z.rng 267 | for (i in 1:length(lbls)) 268 | plot.data[[i]]$zlim = zlim 269 | 270 | ### If plots requested, do plots with a common image scale 271 | if (plot.it) for (i in 1:length(form)) { 272 | dat = plot.data[[i]] 273 | if (!missing(hook)) 274 | if (!is.null(hook$pre.plot)) hook$pre.plot(dat$labs) 275 | args = list(x=dat$x, y=dat$y, z=dat$z, col=img.col, zlim = dat$zlim, ...) 276 | args$xlab = dat$labs[1] 277 | args$ylab = dat$labs[2] 278 | if (image) { 279 | do.call("image", args) 280 | args$add = TRUE 281 | args$xlab = args$ylab = args$col = NULL 282 | do.call("contour", args) 283 | #image(dat$x, dat$y, dat$z, col=img.col, 284 | # xlab = dat$labs[1], ylab = dat$labs[2], zlim = dat$zlim, ...) 285 | #contour(dat$x, dat$y, dat$z, add=TRUE, ...) 286 | } 287 | else { 288 | args$col = NULL 289 | do.call("contour", args) 290 | #contour(dat$x, dat$y, dat$z, 291 | # xlab = dat$labs[1], ylab = dat$labs[2], zlim = dat$zlim, ...) 292 | if (atpos == 3) 293 | title(sub = labs[5]) 294 | } 295 | if (!missing(hook)) 296 | if (!is.null(hook$post.plot)) hook$post.plot(dat$labs) 297 | } 298 | 299 | invisible(plot.data) 300 | } 301 | 302 | 303 | # Image plot for a lm 304 | image.lm = function(x, form, at, bounds, zlim, xlabs, hook, atpos=1, decode=TRUE, ...) { 305 | plot.data = contour.lm(x, form, at, bounds, zlim, xlabs, atpos=atpos, decode=decode, plot.it=FALSE) 306 | for (i in 1:length(plot.data)) { 307 | dat = plot.data[[i]] 308 | if (!missing(hook)) 309 | if (!is.null(hook$pre.plot)) hook$pre.plot(dat$labs) 310 | 311 | image(dat$x, dat$y, dat$z, 312 | xlab = dat$labs[1], ylab = dat$labs[2], zlim = dat$zlim, ...) 313 | if (atpos == 3) 314 | title(sub = dat$labs[5]) 315 | 316 | if (!missing(hook)) 317 | if (!is.null(hook$post.plot)) hook$post.plot(dat$labs) 318 | } 319 | 320 | invisible(plot.data) 321 | } 322 | 323 | 324 | # Perspective plot(s) for 'lm' objects 325 | # arg notes: 326 | # col: facet colors; if null, default, else color palette based on z value 327 | # contours: if TRUE, black contours. Can also be a list with elements 328 | # z="bottom" (or "top" or value), col="black", lwd=1 329 | persp.lm = function(x, form, at, bounds, zlim, zlab, 330 | xlabs, col = "white", contours=NULL, hook, atpos=3, decode = TRUE, 331 | theta = -25, phi = 20, r = 4, border = NULL, box = TRUE, 332 | ticktype = "detailed", ...) 333 | { 334 | draw.cont.line = function(line) { 335 | if (cont.varycol) { 336 | cont.col = col 337 | if (length(col) > 1) cont.col = col[cut(c(line$level, dat$zlim), length(col))][1] 338 | } 339 | lines(trans3d(line$x, line$y, cont.z, transf), 340 | col=cont.col, lwd=cont.lwd) 341 | } 342 | plot.data = contour.lm(x, form, at, bounds, zlim, xlabs, atpos=atpos, plot.it=FALSE) 343 | transf = list() 344 | if (missing(zlab)) zlab = "" 345 | 346 | facet.col = col 347 | 348 | cont = !is.null(contours) 349 | if (mode(contours) == "logical") cont = contours 350 | cont.first = cont 351 | cont.z = cz = plot.data[[1]]$zlim[1] 352 | cont.col = 1 353 | cont.varycol = FALSE 354 | cont.lwd = 1 355 | if (is.character(contours)) { 356 | idx = charmatch(contours, c("top","bottom", "colors"), 0) 357 | if (idx == 1) { 358 | cont.first = FALSE 359 | cont.z = plot.data[[1]]$zlim[2] 360 | } 361 | else if (idx == 2) {} 362 | else if (idx == 3) { 363 | cont.varycol = TRUE 364 | if (length(col) < 2) col = rainbow(40) 365 | } 366 | else 367 | cont.col = contours 368 | } 369 | else if (is.list(contours)) { 370 | if(!is.null(contours$z)) cz = contours$z 371 | if (is.numeric(cz)) cont.z = cz 372 | else if (cz=="top") { 373 | cont.first = FALSE 374 | cont.z = plot.data[[1]]$zlim[2] 375 | } 376 | if(!is.null(contours$col)) cont.col = contours$col 377 | if(!is.null(contours$lwd)) cont.lwd = contours$lwd 378 | if(charmatch(cont.col, "colors", 0) == 1) { 379 | cont.varycol = TRUE 380 | if (length(col) < 2) col = rainbow(40) 381 | } 382 | } 383 | 384 | # Loop through the plots 385 | for (i in 1:length(plot.data)) { 386 | dat = plot.data[[i]] 387 | cont.lines = NULL 388 | if (!missing(hook)) 389 | if (!is.null(hook$pre.plot)) hook$pre.plot(dat$labs) 390 | if (cont) cont.lines = contourLines(dat$x, dat$y, dat$z) 391 | if (cont && cont.first) { 392 | transf = persp(dat$x, dat$y, dat$z, zlim=dat$zlim, theta=theta, phi=phi, r=r, col = NA, border=NA, box=FALSE, ...) 393 | lapply(cont.lines, draw.cont.line) 394 | par(new=TRUE) 395 | } 396 | if (length(col) > 1) { 397 | nrz = nrow(dat$z) 398 | ncz = ncol(dat$z) 399 | zfacet = dat$z[-1,-1] + dat$z[-1,-ncz] + dat$z[-nrz,-1] + dat$z[-nrz,-ncz] 400 | zfacet = c(zfacet/4, dat$zlim) 401 | facet.col = cut(zfacet, length(col)) 402 | facet.col = col[facet.col] 403 | } 404 | transf = persp(dat$x, dat$y, dat$z, 405 | xlab=dat$labs[1], ylab=dat$labs[2], zlab=zlab, 406 | zlim=dat$zlim, col=facet.col, border=border, box=box, theta=theta, phi=phi, r=r, ticktype=ticktype, ...) 407 | if (atpos == 3) 408 | title(sub = dat$labs[5], ...) 409 | 410 | if (cont && !cont.first) 411 | lapply(cont.lines, draw.cont.line) 412 | if (!missing(hook)) 413 | if (!is.null(hook$post.plot)) hook$post.plot(dat$labs) 414 | plot.data[[i]]$transf = transf 415 | } 416 | invisible(plot.data) 417 | } 418 | -------------------------------------------------------------------------------- /R/rsm.R: -------------------------------------------------------------------------------- 1 | ############################################################################## 2 | # Copyright (c) 2008-2010, 2012-2025 Russell V. Lenth # 3 | # # 4 | # This file is part of the rsm package for R (*rsm*) # 5 | # # 6 | # *rsm* is free software: you can redistribute it and/or modify # 7 | # it under the terms of the GNU General Public License as published by # 8 | # the Free Software Foundation, either version 2 of the License, or # 9 | # (at your option) any later version. # 10 | # # 11 | # *rsm* is distributed in the hope that it will be useful, # 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of # 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # 14 | # GNU General Public License for more details. # 15 | # # 16 | # A copy of the GNU General Public License is available at # 17 | # # 18 | ############################################################################## 19 | 20 | ### Functions to facilitate response-surface analysis 21 | 22 | # Nov 2012 mod: changed naming of effects... 23 | # FO(x1,x3) --> FO(x1,x3)x1, FO(x1,x3)x3 24 | # TWI(x1,x3) --> TWI(x1,x3)x1:x3 25 | # PQ(x1,x3) --> PQ(x1,x3)x1^2, PQ(x1,x3)x3^2 26 | 27 | # First-order model 28 | FO = function(...) { 29 | nm = as.character(substitute(list(...)))[-1] 30 | fo = sapply(list(...), I) 31 | if (is.null(nrow(fo))) fo = matrix(fo, nrow=1) 32 | dimnames(fo) = list(NULL, nm) 33 | fo 34 | } 35 | 36 | #### I tried developing a formula interface for FO, TWI, and SO. 37 | #### Decided it is NOT a good idea 38 | # # New version of FO that supports a formula 39 | # FO = function(...) { 40 | # env = parent.frame() 41 | # .make.matrix = function(vars) { 42 | # form = as.formula(paste("~", paste(vars, collapse="+"), "-1")) 43 | # model.matrix(form, data=env) 44 | # } 45 | # if(inherits(form <- list(...)[[1]], "formula")) 46 | # .make.matrix(all.vars(form)) 47 | # else 48 | # .make.matrix(sapply(match.call()[-1], as.character)) 49 | # } 50 | 51 | # Pure quadratic 52 | PQ = function(...) { 53 | X = FO(...)^2 54 | nm = dimnames(X)[[2]] 55 | if (is.null(nm)) nm = 1:ncol(X) 56 | dimnames(X) = list(NULL, paste(nm,"2",sep="^")) 57 | X 58 | } 59 | 60 | # # New version of PQ that supports a formula 61 | # # Identical to FO except for squaring and renaming 62 | # PQ = function(...) { 63 | # env = parent.frame() 64 | # .make.matrix = function(vars) { 65 | # form = as.formula(paste("~", paste(vars, collapse="+"), "-1")) 66 | # X = model.matrix(form, data=env)^2 67 | # dimnames(X)[[2]] = paste(vars,"2", sep="^") 68 | # X 69 | # } 70 | # if(inherits(form <- list(...)[[1]], "formula")) 71 | # .make.matrix(all.vars(form)) 72 | # else 73 | # .make.matrix(sapply(match.call()[-1], as.character)) 74 | # } 75 | 76 | 77 | # Two-way interactions 78 | # Nov 2012 -- aded formula argument 79 | TWI = function(..., formula) { 80 | if (missing(formula)) { 81 | fo = FO(...) 82 | k = ncol(fo) 83 | fon = dimnames(fo)[[2]] 84 | if (is.null(fon)) fon=1:k 85 | X = matrix(0, nrow=nrow(fo), ncol=k*(k-1)/2) 86 | nm = rep("", k*(k-1)/2) 87 | col = 1 88 | for (i in 1:(k-1)) { 89 | for (j in (i+1):k) { 90 | X[, col] = fo[ ,i] * fo[ ,j] 91 | nm[col] = paste(fon[i],fon[j],sep=":") 92 | col = col+1 93 | } 94 | } 95 | dimnames(X) = list(NULL,nm) 96 | X 97 | } 98 | else { # formula is provided 99 | if (!inherits(formula, "formula")) 100 | formula = as.formula(paste("~", formula)) 101 | trms = terms(formula) 102 | attr(trms, "intercept") = 0 103 | X = model.matrix(trms, data=parent.frame())[, attr(trms, "order")==2, drop=FALSE] 104 | if(ncol(X) == 0) 105 | stop("Formula yields no two-way interactions. Re-specify or omit 'TWI' term from model") 106 | else if (ncol(X) == 1) { 107 | new.expr = paste("TWI(", gsub(":", ",", dimnames(X)[[2]]), ")", sep="") 108 | stop(paste("Result is just one column. Revise the model using '", 109 | new.expr, "'", sep="")) 110 | } 111 | X 112 | } 113 | } 114 | 115 | # Second-order model. But in rsm(), this will get replaced by FO()+TWI()+PQ() 116 | SO = function(...) 117 | cbind(FO(...), TWI(...), PQ(...)) 118 | 119 | 120 | # Pure-error model 121 | PE = function(...) 122 | factor(paste(...)) 123 | 124 | 125 | 126 | # Fit a response-surface model 127 | rsm = function (formula, data, ...) { 128 | CALL = match.call(stats::lm) 129 | CALL[[1]] = as.name("lm") 130 | oc = paste(as.character(deparse(formula)), collapse = " ") 131 | nc = sub("SO\\(([a-zA-Z0-9, ._]+)\\)", "FO\\(\\1\\) + TWI\\(\\1\\) + PQ\\(\\1\\)", oc) 132 | # no comma -> only 1 var -> no TWI ... 133 | nc = sub("TWI\\([a-zA-Z0-9 ._]+\\)", "", nc) 134 | CALL$formula = formula(nc) 135 | LM = eval(CALL, parent.frame()) 136 | LM$call[[1]] = as.name("rsm") 137 | LM$call$formula = formula(oc) 138 | if (missing(data)) 139 | data = as.data.frame(sapply(all.vars(formula), get)) 140 | LM$data = data 141 | 142 | newlabs = nm = names(LM$coef) 143 | names(newlabs) = nm 144 | i.fo = grep("FO\\(", nm) 145 | if (length(i.fo) == 0) { 146 | warning("No FO() terms in model; cannot use RSM methods\nAn 'lm' object has been returned.") 147 | return(LM) 148 | } 149 | k = length(i.fo) 150 | LM$b = LM$coef[i.fo] 151 | LM$order = 1 152 | foterm = as.list(LM$terms[LM$assign[min(i.fo)]][[3]]) 153 | fonm = names(LM$b) = sapply(foterm, as.character)[-1] 154 | #-DEPR LM$labels = list(FO=list(idx=i.fo, lab=fonm)) 155 | newlabs[i.fo] = fonm 156 | #-depr names(LM$coef)[i.fo] = LM$labels 157 | 158 | LM$B = matrix(0, k, k) 159 | dimnames(LM$B) = list(fonm, fonm) 160 | 161 | i.twi = grep("TWI\\(", nm) 162 | if ((k > 1) & (length(i.twi) > 0)) { 163 | btwi = LM$coef[i.twi] 164 | LM$order = 1.5 165 | twi.lab = sapply(names(btwi), function(s) { 166 | # Below, usually "TWI(arguments)colname" --> lb = c("TWI", arguments, colname) 167 | # so that 3rd elt is colname. But if arguments has a formula with parens, could be longer 168 | # Messy part: If there is only one column in TWI result, colname will be missing 169 | # In TWI code, I force an error unless call is made w/o a formula so that 170 | # we can be sure to be able to parse "TWI(x1, x2)" into "x1:x2" 171 | lb = strsplit(s, "\\(|\\)")[[1]] 172 | if (length(lb) >= 3) rev(lb)[1] 173 | else { 174 | tmp = gsub(" ","", lb[2]) 175 | gsub(",", ":", tmp) 176 | } 177 | }) 178 | names(twi.lab) = NULL 179 | for (i in 1:length(twi.lab)) { 180 | vn = strsplit(twi.lab[i], ":")[[1]] 181 | idx = match(vn, fonm) 182 | if (!is.na(btwi[i])) 183 | LM$B[idx[1],idx[2]] = LM$B[idx[2],idx[1]] = btwi[i] / 2 184 | else 185 | twi.lab[i] = paste(twi.lab[i],"@", sep="") 186 | } 187 | #-DEPR LM$labels$TWI = list(idx=i.twi, lab=twi.lab) 188 | newlabs[i.twi] = twi.lab 189 | } 190 | 191 | i.pq = grep("PQ\\(", nm) 192 | if (length(i.pq) > 0) { 193 | LM$order = 2 194 | if(length(i.pq) > 1) 195 | pq.lab = sapply(names(LM$coef[i.pq]), function(s) strsplit(s, "\\)")[[1]][2]) 196 | else 197 | pq.lab = paste(strsplit(names(LM$coef[i.pq]), "\\(|\\)")[[1]][2], "^2", sep="") 198 | names(pq.lab) = NULL 199 | vn = sapply(pq.lab, function(s) substr(s, 1, nchar(s)-2)) 200 | for (i in 1:length(vn)) LM$B[vn[i],vn[i]] = LM$coef[i.pq[i]] 201 | #-DEPR LM$labels$PQ = list(idx=i.pq, lab=pq.lab) 202 | newlabs[i.pq] = pq.lab 203 | } 204 | LM$newlabs = newlabs 205 | 206 | if (LM$order==1) 207 | aliased = any(is.na(LM$b)) 208 | else 209 | aliased = any(is.na(cbind(LM$B, LM$b))) 210 | if (aliased) 211 | warning("Some coefficients are aliased - cannot use 'rsm' methods.\n Returning an 'lm' object.") 212 | else { 213 | if (!is.null(data)) 214 | if (inherits(data, "coded.data")) 215 | LM$coding = attr(data, "codings") 216 | class(LM) = c("rsm", "lm") 217 | } 218 | LM 219 | } 220 | 221 | # do a lack-of-fit test 222 | loftest = function (object) { 223 | cl = match.call(lm, call = object$call) 224 | cl[[1]] = as.name("lm") 225 | pieces = as.character(object$call$formula) 226 | pieces[3] = sub("(FO)|(SO)", "PE", pieces[3]) 227 | cl$formula = formula(paste(pieces[2], "~", pieces[3])) 228 | cl$data = object$data 229 | lof = anova(object, eval(cl)) 230 | df = c(lof[1,1], lof[2,3], lof[2,1]) 231 | ss = c(lof[1,2], lof[2,4], lof[2,2]) 232 | ans = data.frame ( 233 | df, ss, ss/df, c(NA, lof[2,5], NA), c(NA, lof[2,6], NA), 234 | row.names = c("Model residual", "Lack of fit", "Pure error")) 235 | names(ans) = c("Df","Sum Sq","Mean Sq", "F value","Pr(>F)") 236 | class(ans) = class(lof) 237 | ans 238 | } 239 | 240 | # Summary method 241 | summary.rsm = function (object, adjust = rev(p.adjust.methods), ...) { 242 | # figure out which dots to pass to summary.lm 243 | dots = list(...) 244 | adjust = match.arg(adjust) 245 | 246 | tidx = pmatch(names(dots), "threshold") 247 | if (!all(is.na(tidx))) { 248 | threshold = dots[!is.na(tidx)][1] 249 | dots[!is.na(tidx)] = NULL 250 | } 251 | else 252 | threshold = 1e-4 253 | 254 | dots$object = object 255 | SUM = do.call("summary.lm", dots) 256 | if (adjust != "none") { 257 | SUM$coefficients[, 4] = p.adjust(SUM$coefficients[, 4], adjust) 258 | attr(SUM$coefficients, "adjust") = adjust 259 | } 260 | if (object$order > 0) { 261 | if (!is.null(object$labels)) ### compatibility with old objects 262 | for (lst in object$labels) 263 | row.names(SUM$coefficients)[lst$idx] = lst$lab 264 | else { 265 | idx = match(row.names(SUM$coefficients), names(object$newlabs)) 266 | row.names(SUM$coefficients)[1:length(idx)] = object$newlabs[idx] 267 | } 268 | } 269 | if (object$order > 1) 270 | SUM$canonical = canonical(object, threshold=threshold) 271 | else SUM$sa = object$b/sqrt(sum(object$b^2)) 272 | SUM$lof = rbind(anova(object), loftest(object)[-1,]) 273 | SUM$coding = object$coding 274 | class(SUM) = c("summary.rsm", "summary.lm") 275 | SUM 276 | } 277 | 278 | # Print method for summary 279 | print.summary.rsm = function(x, ...) { 280 | ### --- replace: getS3method("print", "summary.lm") (x, ...) 281 | ### Just show the call and coefs; skip the resid summary 282 | cat("\nCall:\n", paste(deparse(x$call), sep = "\n", collapse = "\n"), 283 | "\n\n", sep = "") 284 | printCoefmat(x$coefficients, ...) 285 | adj = attr(x$coefficients, "adjust") 286 | if(!is.null(adj)) 287 | cat(paste0("P-value adjustment: \"", adj, "\"\n")) 288 | cat("\n") 289 | 290 | # This block is "borrowed" from print.summary.lm 291 | digits = list(...)$digits 292 | if (is.null(digits)) 293 | digits = max(3L, getOption("digits") - 3L) 294 | if (!is.null(x$fstatistic)) { 295 | cat("Multiple R-squared: ", formatC(x$r.squared, digits = digits)) 296 | cat(",\tAdjusted R-squared: ", formatC(x$adj.r.squared, digits = digits), 297 | "\nF-statistic:", formatC(x$fstatistic[1L], digits = digits), 298 | "on", x$fstatistic[2L], "and", x$fstatistic[3L], 299 | "DF, p-value:", format.pval(pf(x$fstatistic[1L], 300 | x$fstatistic[2L], x$fstatistic[3L], lower.tail = FALSE), 301 | digits = digits)) 302 | cat("\n") 303 | } 304 | cat("\n") 305 | print(x$lof, signif.stars=FALSE, ...) 306 | cat("\n") 307 | can = x$canonical 308 | if (!is.null(can)) { 309 | cat("Stationary point of response surface:\n") 310 | print(can$xs) 311 | if(!is.null(x$coding)) { 312 | cat("\nStationary point in original units:\n") 313 | print (code2val (can$xs, x$coding)) 314 | } 315 | cat("\nEigenanalysis:\n") 316 | print(can$eigen) 317 | } 318 | else { 319 | cat("Direction of steepest ascent (at radius 1):\n") 320 | print(x$sa) 321 | cat("\nCorresponding increment in original units:\n") 322 | temp = code2val (rbind(x$sa, 2*x$sa), x$coding) 323 | print (temp[2,] - temp[1,]) 324 | } 325 | cat("\n") 326 | } 327 | 328 | # Steepest ascent (and ridge analysis) 329 | steepest = function (object, dist=seq(0,5,by=.5), descent=FALSE) { 330 | goal = ifelse(descent, "descent", "ascent") 331 | dist = abs (dist) 332 | if (is.null(object$B)) { 333 | d = object$b / sqrt (sum (object$b^2)) 334 | if (descent) d = -d 335 | path = t(sapply(dist, function(x) d*x)) 336 | cat(paste("Linear path of steepest", goal, "\n")) 337 | } 338 | else { 339 | iden = diag (rep (1, length(object$b))) 340 | rng = range (eigen (object$B) $values) 341 | 342 | soln = function (gam) { 343 | -0.5 * solve (object$B - gam*iden, object$b) 344 | } 345 | deldist = function (gam, d) { 346 | xx = soln (gam) 347 | sqrt (sum (xx^2)) - d 348 | } 349 | find.pt = function(d, bd) { 350 | if (abs(d) < .01) return (0 * object$b) 351 | gamma = uniroot (deldist, bd, d)$root 352 | soln (gamma) 353 | } 354 | incr.out = function(bd, inc, mind) { 355 | while (deldist(bd, mind) > 0) { 356 | bd = bd + inc 357 | inc = 2*inc 358 | } 359 | bd 360 | } 361 | 362 | mind = min(dist[dist>.009]) 363 | if (descent) 364 | bds = c(incr.out(rng[1]-5, -2, mind), rng[1]-.001) 365 | else 366 | bds = c(rng[2]+.001, incr.out(rng[2]+5, 2, mind)) 367 | 368 | path = t(sapply(dist, find.pt, bds)) 369 | cat(paste("Path of steepest", goal, "from ridge analysis:\n")) 370 | } 371 | 372 | path = newdata = as.data.frame (round (path, 3)) 373 | md = model.data(object) 374 | for (vn in names(md)) 375 | if (is.null(newdata[[vn]])) { 376 | v = md[[vn]] 377 | if(is.factor(v)) 378 | newdata[[vn]] = factor(levels(v)[1], levels=levels(v)) 379 | else newdata[[vn]] = mean(v) 380 | } 381 | yhat = predict(object, newdata=newdata) 382 | 383 | path[["|"]] = factor("|") 384 | if (!is.null(object$coding)) { 385 | orig = code2val(path, object$coding) 386 | path = cbind(path, orig) 387 | } 388 | ans = cbind(data.frame(dist=dist), path, yhat=round(yhat,3)) 389 | ans 390 | } 391 | 392 | canonical.path = function(object, 393 | which = ifelse(descent, length(object$b), 1), 394 | dist = seq(-5, 5, by=.5), 395 | descent = FALSE, 396 | ...) 397 | { 398 | if (!inherits(object, "rsm")) 399 | stop(paste(as.character(substitute(object)),"is not an 'rsm' object")) 400 | if (object$order == 1) 401 | stop("Requires a seconnd-order response surface") 402 | args = list(object = object, ...) 403 | can = do.call(canonical, args) 404 | dir = can$eigen$vectors[ , which] 405 | path = t(sapply(dist, function(d) can$xs + d*dir)) 406 | 407 | path = newdata = as.data.frame(round(path, 3)) 408 | md = model.data(object) 409 | for (vn in names(md)) if (is.null(newdata[[vn]])) { 410 | v = md[[vn]] 411 | if (is.factor(v)) 412 | newdata[[vn]] = factor(levels(v)[1], levels = levels(v)) 413 | else newdata[[vn]] = mean(v) 414 | } 415 | yhat = predict(object, newdata = newdata) 416 | path[["|"]] = factor("|") 417 | if (!is.null(object$coding)) { 418 | orig = code2val(path, object$coding) 419 | path = cbind(path, orig) 420 | } 421 | ans = cbind(data.frame(dist = dist), path, yhat = round(yhat, 3)) 422 | ans 423 | } 424 | 425 | # Canonical analysis -- allows singular B matrix and may set a 426 | # higher threshold on e'vals considered to be zero 427 | canonical = function(object, threshold = 0.1*max.eigen) { 428 | if (!inherits(object, "rsm")) 429 | stop ("Not an 'rsm' object") 430 | if (object$order == 1) 431 | stop("Canonical analysis is not possible for first-order models") 432 | EA = eigen(object$B) 433 | max.eigen = max(abs(EA$values)) 434 | active = which(abs(EA$values) >= threshold) 435 | if (length(active) == 0) 436 | stop("threshold is greater than the largest |eigenvalue|") 437 | if ((nzero <- length(EA$values) - length(active)) > 0) 438 | message("Near-stationary-ridge situation detected -- stationary point altered\n", 439 | " Change 'threshold' if this is not what you intend") 440 | U = EA$vectors[, active, drop=FALSE] 441 | laminv = 1 / EA$values[active] 442 | xs = as.vector(-0.5 * U %*% diag(laminv, ncol=ncol(U)) %*% t(U) %*% object$b) 443 | names(xs) = names(object$b) 444 | dimnames(EA$vectors) = list(names(object$b), NULL) 445 | if (length(active) < nrow(U)) { 446 | ###EA$vectors[, -active] = 0 447 | EA$values[-active] = 0 448 | } 449 | list(xs=xs, eigen=EA) 450 | } 451 | 452 | xs = function(object, ...) { 453 | canonical(object, ...)$xs 454 | } 455 | 456 | 457 | # Unfortunately, it turns out that rsm's 'codings' member is named "coding". 458 | # Too late now, as people may have old rsm objects laying around. 459 | codings.rsm = function(object) 460 | object$coding 461 | 462 | -------------------------------------------------------------------------------- /vignettes/illus.rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Response-surface illustration" 3 | author: "rsm package, Version `r packageVersion('rsm')`" 4 | output: emmeans::.emm_vignette 5 | vignette: > 6 | %\VignetteIndexEntry{Response-surface illustration} 7 | %\VignetteKeywords{response-surface methods, regression, experimental design, first-order designs, second-order designs} 8 | %\VignetteEngine{knitr::rmarkdown} 9 | %\VignetteEncoding{UTF-8} 10 | --- 11 | ```{r, echo = FALSE, results = "hide", message = FALSE} 12 | require("rsm") 13 | knitr::opts_chunk$set(fig.width = 4.5, class.output = "ro") 14 | 15 | suppressWarnings(RNGversion("2.15.3")) ### This saved my bacon reproducing a very old vignette! 16 | set.seed(19482012) 17 | 18 | # basic generator 19 | simb = function(flour, sugar, butter, sd=0.58) { 20 | x1 = (flour - 1.2)/.1 21 | x2 = (sugar - .25)/.1 22 | x3 = (butter - .4)/.15 23 | y = 32 - x1^2 - .5*x3^2 - sqrt(abs(x2 + x3))^2 24 | rnorm(length(y), y, sd) 25 | } 26 | 27 | # requires DECODED data! 28 | simBake = function(data) { 29 | blkeff = rnorm(1, 0, 2.3) 30 | round(blkeff + simb(data$flour, data$sugar, data$butter), 1) 31 | } 32 | ``` 33 | 34 | ### Abstract 35 | In this vignette, we give an illustration, using simulated data, of a sequential-experimentation process to optimize a response surface. I hope that this is helpful for understanding both how to use the **rsm** package and RSM methodology in general. 36 | 37 | ## The scenario 38 | We will use simulated data from a hypothetical baking experiment. Our goal is to find the optimal amounts of flour, butter, and sugar in a recipe. The response variable is some rating of the texture and flavor of the product. The baking temperature, procedures, equipment, and operating environment will be held constant. 39 | 40 | ## Initial experiment 41 | Our current recipe calls for 1 cup of flour, 0.50 cups of sugar, and 0.25 cups of butter. Our initial experiment will center at this recipe, and we will vary each ingredient by $\pm0.1$ cup. Let's start with a minimal first-order experiment, a half-fraction of a $2^3$ design plus 4 center points. This is a total of 8 experimental runs, which is quite enough given the labor involved. The philosophy of RSM is to do minimal experiments that can be augmented later if necessary if more detail is needed. We'll generate and randomize the experiment using `cube`, in terms of coded variables $x_1,x_2,x_3$: 42 | ```{r} 43 | library(rsm) 44 | expt1 = cube(~ x1 + x2, x3 ~ x1 * x2, n0 = 4, 45 | coding = c(x1 ~ (flour - 1)/.1, x2 ~ (sugar - .5)/.1, x3 ~ (butter - .25)/.1)) 46 | ``` 47 | So here is the protocol for the first design. 48 | ```{r} 49 | expt1 50 | ``` 51 | It's important to understand that `cube` returns a *coded* dataset; this facilitates response-surface methodology in that analyses are best done on a coded scale. The above design is actually stored in coded form, as we can see by looking at it as an ordinary `data.frame`: 52 | ```{r} 53 | as.data.frame(expt1) 54 | ``` 55 | ```{r echo = FALSE} 56 | SAVESEED = .Random.seed 57 | ``` 58 | 59 | 60 | 61 | ## But hold on a minute... First, assess the strategy 62 | But wait! Before collecting any data, we really should plan ahead and make sure this is all going to work. 63 | 64 | ### First-order design capability 65 | First of all, will this initial design do the trick? One helpful tool in **rsm** is the `varfcn` function, which allows us to examine the variance of the predictions we will obtain. We don't have any data yet, so this is done in terms of a scaled variance, defined as $\frac N{\sigma^2}\mathrm{Var}(\hat{y}(\mathbf{x}))$, where $N$ is the number of design points, $\sigma^2$ is the error variance and $\hat{y}(\mathbf{x})$ is the predicted value at a design point $\mathbf{x}$. In turn, $\hat{y}(\mathbf{x})$ depends on the model as well as the experimental design. Usually, $\mathrm{Var}(\hat{y}(\mathbf{x}))$ depends most strongly on how far $\mathbf{x}$ is from the center of the design (which is $\mathbf{0}$ in coded units). Accordingly, the `varfcn` function requires us to supply the design and the model, and a few different directions to go from the origin along which to plot the scaled variance (some defaults are supplied if not specified). We can look either at a profile plot or a contour plot: 66 | ```{r fig=TRUE, fig.width=6, fig.height=3.5} 67 | par(mfrow=c(1,2)) 68 | varfcn(expt1, ~ FO(x1,x2,x3)) 69 | varfcn(expt1, ~ FO(x1,x2,x3), contour = TRUE) 70 | ``` 71 | 72 | Not surprisingly, the variance increases as we go farther out---that is, estimation is more accurate in the center of the design than in the periphery. This particular design has the same variance profile in all directions: this is called a *rotatable* design. 73 | 74 | Another important outcome of this is what do *not* see: there are no error messages. That means we can actually fit the intended model. If we intend to use this design to fit a second-order model, it's a different story: 75 | ```{r error = TRUE} 76 | varfcn(expt1, ~ SO(x1,x2,x3)) 77 | ``` 78 | The point is, `varfcn` is a useful way to make sure you can estimate the model you need to fit, *before* collecting any data. 79 | 80 | 81 | ### Looking further ahead {#lookahead2} 82 | As we mentioned, response-surface experimentation uses a building-block approach. It could be that we will want to augment this design so that we can fit a second-order surface. A popular way to do that is to do a followup experiment on axis or "star" points at locations $\pm\alpha$ so that the two experiments combined may be used to fit a second-order model. Will this work? And if so, what does the variance function look like? Let's find out. It turns out that a rotatable design is not achievable by adding star points: 83 | ```{r} 84 | try( 85 | djoin(expt1, star(n0 = 2, alpha = "rotatable")) 86 | ) 87 | ``` 88 | But here are the characteristics of a design with $\alpha = 1.5$: 89 | ```{r fig=TRUE, fig.height=3.5, fig.width=6} 90 | par(mfrow=c(1,2)) 91 | followup = djoin(expt1, star(n0 = 2, alpha = 1.5)) 92 | varfcn(followup, ~ Block + SO(x1,x2,x3), main = "Followup") 93 | varfcn(followup, ~ Block + SO(x1,x2,x3), contour = TRUE, main = "Block + SO(x1,x2,x3)") 94 | ``` 95 | 96 | From this we can tell that we can at least augment the design to fit a second-order model. The model includes a block effect to account for the fact that two separately randomized experiments are combined. 97 | 98 | 99 | 100 | ```{r echo = FALSE} 101 | .Random.seed = SAVESEED 102 | expt1$rating = simBake(decode.data(expt1)) 103 | ``` 104 | 105 | ## OK, *now* we can collect some data 106 | 107 | 108 | Now, pretend that you now go off and baked some cakes according to these recipes. 109 | 110 | Time passes... 111 | 112 | OK, the baking is over, and the results are in, and we entered them in a new `ratings` column in `expt1`: 113 | ```{r} 114 | expt1 115 | ``` 116 | We can now analyze the data using a first-order model (implemented in **rsm** by the `FO` function). The model is fitted in terms of the coded variables. 117 | ```{r} 118 | anal1 = rsm(rating ~ FO(x1,x2,x3), data=expt1) 119 | summary(anal1) 120 | ``` 121 | The take-home message here is that the first-order model does help explain the variations in the response (significant $F$ statistic for the model, as well as two of the three coefficients of $x_j$ are fairly significant); and also that there is no real evidence that the model does not fit (large P value for lack of fit). Finally, there is information on the direction of steepest ascent, which suggests that we could improve the ratings by increasing the flour and decreasing the sugar and butter (by smaller amounts in terms of coded units). 122 | 123 | ## Explore the path of steepest-ascent 124 | The direction of steepest ascent is our best guess for how we can improve the recipe. The `steepest` function provides an easy way to find some steps in the right direction, up to a distance of 5 (in coded units) by default: 125 | ```{r} 126 | ( sa1 = steepest(anal1) ) 127 | ``` 128 | The `yhat` values show what the fitted model anticipates for the rating; but as we move to further distances, these are serious extrapolations and can't be trusted. What we need is real data! So let's do a little experiment along this path, using the distances from 0.5 to 4.0, for a total of 8 runs. The `dupe` function makes a copy of these runs and re-randomizes the order. 129 | ```{r} 130 | expt2 = dupe(sa1[2:9, ]) 131 | ``` 132 | Now we need to do some more baking based on this design. Time passes... 133 | 134 | The data are now collected; and we have these results: 135 | ```{r echo = FALSE} 136 | expt2$rating = simBake(expt2) 137 | options(width=110) 138 | ``` 139 | ```{r} 140 | expt2 141 | ``` 142 | 143 | With a steepest-ascent path, the idea is to find the highest point along this path, and center the next experiment there. To that end, let's look at it graphically: 144 | ```{r fig = TRUE, scale=.46, fig.height=4.5} 145 | plot(rating ~ dist, data = expt2) 146 | anal2 = lm(rating ~ poly(dist, 2), data = expt2) 147 | with(expt2, { 148 | ord = order(dist) 149 | lines(dist[ord], predict(anal2)[ord]) 150 | }) 151 | ``` 152 | 153 | There is a fair amount of variation here, so the fitted quadratic curve provides useful guidance. It suggests that we do our next experiment at a distance of about $2.5$ in coded units, i.e., near point \#6 in the steepest-ascent path, `sa1`. Let's use somewhat rounder values: flour:~$1.25$~cups, sugar:~$0.45$~cups, and butter:~$0.25$~cups (unchanged from `expt1`). 154 | 155 | ## Relocated experiment 156 | We can run basically the same design we did the first time around, only with the new center. This is easily done using `dupe` and changing the codings: 157 | ```{r} 158 | expt3 = dupe(expt1) 159 | codings(expt3) = c(x1 ~ (flour - 1.25)/.1, x2 ~ (sugar - .45)/.1, x3 ~ (butter - .25)/.1) 160 | ``` 161 | 162 | Again, off to do more baking ... Once the data are collected, we have: 163 | ```{r echo = FALSE} 164 | expt3$rating = simBake(decode.data(expt3)) 165 | ``` 166 | ```{r} 167 | expt3 168 | ``` 169 | 170 | ... and we do the same analysis: 171 | ```{r} 172 | anal3 = rsm(rating ~ FO(x1,x2,x3), data=expt3) 173 | summary(anal3) 174 | ``` 175 | This may not seem too dissimilar to the `anal1` results, and if you think so, that would suggest we just do another steepest-ascent step. However, none of the linear (first-order) effects are statistically significant, nor are they even jointly significant ($P\approx0.30$ in the ANOVA table); so we don’t have a compelling case that we even know what that direction might be! It seems better to instead collect more data in this region and see if we get more clarity. 176 | 177 | ## Foldover experiment 178 | Recall that our first experiment was a half-fraction plus center points. We can get more information by doing the other fraction. This is accomplished using the `foldover` function, which reverses the signs of some or all of the coded variables (and also re-randomizes the experiment). In this case, the original experiment was generated using $x_3=x_1x_2$, so if we reverse $x_1$, we will have $x_3=-x_1x_2$, thus the other half of the experiment. 179 | ```{r} 180 | expt4 = foldover(expt3, variable = "x1") 181 | expt4$rating = NULL ### discard previous rating data 182 | expt4 # Here's the new protocol 183 | ``` 184 | Note that this experiment does indeed have different factor combinations (e.g., $(1.15,.35,.15))$ not present in `expt3`. 185 | 186 | Back to the kitchen again... 187 | 188 | Once the data are collected, we have: 189 | ```{r echo = FALSE} 190 | expt4$rating = simBake(decode.data(expt4)) 191 | ``` 192 | ```{r} 193 | expt4 194 | ``` 195 | 196 | For analysis, we will combine `expt3` and `expt4`, which is easily accomplished with the `djoin` function. Note that `djoin` creates an additional blocking factor: 197 | ```{r} 198 | names( djoin(expt3, expt4) ) 199 | ``` 200 | It's important to include this block effect in the model because we have two separately randomized experiments. In this particular case, it's especially important because `expt4` seems to have higher values overall than `expt3`; either the raters are in a better mood, or ambient conditions have changed. Here is our analysis: 201 | ```{r} 202 | anal4 = rsm(rating ~ Block + FO(x1,x2,x3), data = djoin(expt3, expt4)) 203 | summary(anal4) 204 | ``` 205 | Now one of the first-order terms is significant. The lack of fit test is also quite significant. Response-surface experimentation is different from some other kinds of experiments in that it's actually "ideal" in a way to have nonsignificant effects, especially first-order ones, because it would suggest we might be close to the peak. 206 | Well, we have one big first-order effect, but evidence of curvature; let's carry on. 207 | 208 | ### Augmenting further to estimate a second-order response surface 209 | Because there is lack of fit, it's now a good idea to collect data at the "star" or axis points so that we can fit a second-order model. As illustrated [earlier](#lookahead2), the `star` function does this for us. We will choose the parameter `alpha` ($\alpha$) so that the star block is orthogonal to the cube blocks; this seems like a good idea, given how strong we have observed the block effect to be. So here is the next experiment, using the six axis points and 2 center points (we already have 8 center points at this location), for 8 runs. The analysis will be based on combining the cube clock, its foldover, and the star block: 210 | ```{r fig = TRUE, fig.height=3.5, fig.width=6} 211 | expt5 = star(expt4, n0 = 2, alpha = "orthogonal") 212 | par(mfrow=c(1,2)) 213 | comb = djoin(expt3, expt4, expt5) 214 | varfcn(comb, ~ Block + SO(x1,x2,x3), main = "Further augmented") 215 | varfcn(comb, ~ Block + SO(x1,x2,x3), contour = TRUE, main = "2nd order") 216 | ``` 217 | 218 | This is not the second-order design we contemplated earlier, because it involves adding star points to the complete $2^3$ design; but it has reasonable prediction-variance properties. 219 | 220 | Time passes, more cakes are baked and rated, and we have these data: 221 | ```{r echo = FALSE} 222 | expt5$rating = simBake(decode.data(expt5)) 223 | ``` 224 | ```{r} 225 | expt5 226 | ``` 227 | We will fit a second-order model, accounting for the block effect. 228 | ```{r} 229 | anal5 = rsm(rating ~ Block + SO(x1,x2,x3), data = djoin(expt3, expt4, expt5)) 230 | summary(anal5) 231 | ``` 232 | There are significant first and second-order terms now, and nonsignificant lack of fit. The summary includes a canonical analysis which gives the coordinates of the estimated stationary point and the canonical directions (eigenvectors) from that point. That is, the fitted surface is characterized in the form $\hat{y}(v_1,v_2,v_3) = \hat{y}_s + \lambda_1v_1^2 + \lambda_2v_2^2 + \lambda_3v_3^2$ where $\hat{y}_s$ is the fitted value at the stationary point, the eigenvalues are denoted $\lambda_j$, and the eigenvectors are denoted $v_j$. Since all three eigenvalues are negative, the estimated surface decreases in all directions from its value at $\hat{y}_s$ and hence there is a maximum there. However, the stationary point is nowhere near the experiment, so this is an extreme extrapolation and not to be trusted at all. (In fact, in decoded units, the estimated optimum calls for a negative amount of sugar!) So the best bet now is to experiment on some path that leads us vaguely toward this distant stationary point. 233 | 234 | ## Ridge analysis (second-order steepest ascent) 235 | The `steepest` function again may be used; this time it computes a curved path of steepest ascent, based on ridge analysis: 236 | ```{r} 237 | steepest(anal5) 238 | ``` 239 | After a distance of about 3, it starts venturing into unreasonable combinations of design factors. So let's experiment at 8 distances spread 2/3 apart in coded units: 240 | ```{r} 241 | expt6 = dupe(steepest(anal5, dist = (2:9)/3)) 242 | ``` 243 | ```{r echo = FALSE} 244 | expt6$rating = simBake(expt6) 245 | ``` 246 | After the cakes have been baked and rated, we have 247 | ```{r} 248 | expt6 249 | ``` 250 | 251 | And let's do an analysis like that of `expt2`: 252 | ```{r fig = TRUE, fig.height=3.5} 253 | par(mar=c(4,4,0,0)+.1) 254 | plot(rating ~ dist, data = expt6) 255 | anal6 = lm(rating ~ poly(dist, 2), data = expt6) 256 | with(expt6, { 257 | ord = order(dist) 258 | lines(dist[ord], predict(anal6)[ord]) 259 | }) 260 | ``` 261 | 262 | It looks like we should center a new experiment at a distance of 1.5 or so---perhaps flour still at 1.25, and both sugar and butter at .30. 263 | 264 | ## Second-order design at the new location 265 | We are now in a situation where we already know we have curvature, so we might as well go straight to a second-order experiment. It is less critical to assess lack of fit, so we don't need as many center points. Note that each of the past experiments has 8 runs---that is the practical size for one block. All these things considered, we decide to run a central-composite design with the cube portion being a complete $2^3$ design (8 runs with no center points), and the star portion including two center points (another block of 8 runs). Let's generate the design, and magically do the cooking and the rating for these two 8-run experiments: 266 | ```{r} 267 | expt7 = ccd( ~ x1 + x2 + x3, n0 = c(0, 2), alpha = "orth", coding = c( 268 | x1 ~ (flour - 1.25)/.1, x2 ~ (sugar - .3)/.1, x3 ~ (butter - .3)/.1)) 269 | ``` 270 | ```{r echo = FALSE} 271 | expt7$rating = simBake(decode.data(expt7)) 272 | ``` 273 | ... and after the data are collected: 274 | ```{r} 275 | expt7 276 | ``` 277 | 278 | It turns out that to obtain orthogonal blocks, locating the star points at $\pm\alpha=\pm2$ is the correct choice for these numbers of center points; hence the nice round values. Here's our analysis; we'll go straight to the second-order model, and again, we need to include the block effect in the model. 279 | ```{r} 280 | anal7 = rsm(rating ~ Block + SO(x1,x2,x3), data = expt7) 281 | summary(anal7) 282 | ``` 283 | The model fits decently, and there are important second-order terms. The most exciting news is that the stationary point is quite close to the design center, and it is indeed a maximum since all three eigenvalues are negative. It looks like the best recipe is around $1.22$~c.~flour, $.28$~c.~sugar, and $.36$~c.~butter. Let's look at this graphically using the `contour` function, slicing the fitted surface at the stationary point. 284 | ```{r fig = TRUE, fig.width=8, fig.height=2.5} 285 | par(cex.lab=1.25, cex.axis=1, cex.sub=1.5, mar=.1+c(4.5,7,0,0)) 286 | par(mfrow=c(1,3)) 287 | contour(anal7, ~ x1 + x2 + x3, at = xs(anal7), image = TRUE) 288 | ``` 289 | 290 | It's also helpful to know how well we have estimated the stationary point. A simple bootstrap procedure helps us understand this. In the code below, we simulate 200 re-fits of the model, after scrambling the residuals and adding them back to the fitted values; then plot the their stationary points along with the one estimated from `anal7`. The `replicate` function returns a matrix with 3 rows and 200 columns (one for each bootstrap replication); so we need to transpose the result and decode the values. 291 | ```{r fig=TRUE, fig.width=7, fig.height=2.3} 292 | fits = predict(anal7) 293 | resids = resid(anal7) 294 | boot.raw = suppressMessages( 295 | replicate(200, xs(update(anal7, fits + sample(resids, replace=TRUE) ~ .)))) 296 | boot = code2val(as.data.frame(t(boot.raw)), codings=codings(anal7)) 297 | par(mar=.1+c(4,5,0,0), cex.lab=1.5) 298 | par(mfrow = c(1,3)) 299 | plot(sugar ~ flour, data = boot, col = "gray"); points(1.215, .282, col = "red", pch = 7) 300 | plot(butter ~ flour, data = boot, col = "gray"); points(1.215, .364, col = "red", pch = 7) 301 | plot(butter ~ sugar, data = boot, col = "gray"); points(.282, .364, col = "red", pch = 7) 302 | ``` 303 | 304 | These plots show something akin to a confidence region for the best recipe. Note they do not follow symmetrical elliptical patterns, as would a multivariate normal; this is due primarily to nonlinearity in estimating the stationary point. 305 | 306 | 307 | 308 | 309 | 310 | ## Summary 311 | For convenience, here is a tabular summary of what we did 312 | 313 | |Expt | Center |Type | Runs |Result | 314 | |:---|:---|:---|:--|:---| 315 | | 1 | $(1.00,.50,.25)$ | $2^{3-1} + 4\times0$ | 8 | Fit OK, but we're on a slope| 316 | | 2 | | SA path | 8 | Re-center at distance $\sim2.5$| 317 | | 3 | $(1.25,.45,.25)$ | $2^{3-1} + 4\times0$ | 8 | Need more data to say much| 318 | | 4 | same | Foldover | $+8$ | LOF; need second-order design| 319 | | 5 | same | Star block | $+8$ | Suggests move to a new center| 320 | | 6 | | SA path | 8 | Re center at distance $\sim1.5$| 321 | | 7 | $(1.25,.30,.30)$ | CCD: $2^3$; $\text{star}+2\times0$ | $8+8$ | Best recipe: (1.22,.28,.36) | 322 | 323 | It has required 64 experimental runs to find this optimum. For a home baker, 64 cakes is a lot. But for a commercial baker, that is not too bad considering how much variation there is in the response measures and the fact that now we have a better recipe. If we had just kept baking cakes with the same recipe, we can't gain knowledge. Only by varying the recipe in disciplined ways can we improve it. 324 | --------------------------------------------------------------------------------