Formula.R
In Formula: Extended Model Formulas

## ---- include = FALSE---------------------------------------------------------
library("Formula")
knitr::opts_chunk$set(
  engine = "R",
  collapse = TRUE,
  comment = "##",
  message = FALSE,
  warning = FALSE,
  echo = TRUE
)

## ----example-data-------------------------------------------------------------
set.seed(1090)
dat <- as.data.frame(matrix(round(runif(21), digits = 2), ncol = 7))
colnames(dat) <- c("y1", "y2", "y3", "x1", "x2", "x3", "x4")
for(i in c(2, 6:7)) dat[[i]] <- factor(dat[[i]] < 0.5,
  labels = c("a", "b"))
dat$y2[1] <- NA
dat

## ----multi-part1--------------------------------------------------------------
F1 <- Formula(log(y1) ~ x1 + x2 | I(x1^2))
length(F1)

## ----multi-part2--------------------------------------------------------------
mf1 <- model.frame(F1, data = dat)
mf1

## ----multi-part3--------------------------------------------------------------
model.response(mf1)

## ----multi-part4--------------------------------------------------------------
model.matrix(F1, data = mf1, rhs = 1)
model.matrix(F1, data = mf1, rhs = 2)

## ----multi-response1----------------------------------------------------------
F2 <- Formula(y1 + y2 ~ x3)
length(F2)

## ----multi-response2----------------------------------------------------------
mf2 <- model.frame(F2, data = dat)
mf2

## ----multi-response3----------------------------------------------------------
model.response(mf2)

## ----multi-response4----------------------------------------------------------
model.part(F2, data = mf2, lhs = 1)

## ----single-response----------------------------------------------------------
model.part(F1, data = mf1, lhs = 1, drop = TRUE)

## ----details1-----------------------------------------------------------------
F3 <- Formula(y1 + y2 | log(y3) ~ x1 + I(x2^2) | 0 + log(x1) | x3 / x4)
F3
length(F3)

## ----details2-----------------------------------------------------------------
attr(F3, "lhs")

## ----formula-method-----------------------------------------------------------
formula(F3)
formula(F3, lhs = 2, rhs = -2)
formula(F3, lhs = c(TRUE, FALSE), rhs = 0)

## ----terms-method1------------------------------------------------------------
terms(F3)

## ----terms-method-------------------------------------------------------------
formula(terms(F3))
formula(terms(F3, lhs = 2, rhs = -2))
formula(terms(F3, lhs = c(TRUE, FALSE), rhs = 0))

## ----model.frame-method-------------------------------------------------------
mf3 <- model.frame(F3, data = dat, subset = y1 < 0.75, weights = x1)
mf3

## ----model.matrix-method------------------------------------------------------
model.matrix(F3, data = mf3, rhs = 2)

## ----model.response-substitute------------------------------------------------
model.part(F3, data = mf3, lhs = 1)
model.part(F3, data = mf3, lhs = 2)

## ----model.foo-methods--------------------------------------------------------
model.weights(mf3)

## ----update-method------------------------------------------------------------
update(F1, . ~ . - x1 | . + x1)
update(F1, . + y2 | y3 ~ .)

## ----as.Formula-method--------------------------------------------------------
as.Formula(y1 ~ x1, y2 ~ x2, ~ x3)

## ----ivcoef-------------------------------------------------------------------
ivcoef <- function(formula, data, subset, na.action, ...)
{
  mf <- match.call(expand.dots = FALSE)
  m <- match(c("formula", "data", "subset", "na.action"), names(mf), 0)
  mf <- mf[c(1, m)]
  
  f <- Formula(formula)
  mf[[1]] <- as.name("model.frame")
  mf$formula <- f
  mf <- eval(mf, parent.frame())
  
  y <- model.response(mf)
  x <- model.matrix(f, data = mf, rhs = 1)
  z <- model.matrix(f, data = mf, rhs = 2)

  xz <- as.matrix(lm.fit(z, x)$fitted.values)
  lm.fit(xz, y)$coefficients
}

## ----ivcoef-example-----------------------------------------------------------
ivcoef(log(y1) ~ x1 | x2, data = dat)

## ---- eval=FALSE--------------------------------------------------------------
#    f <- if(!is.null(instruments)) as.Formula(formula, instruments)
#      else as.Formula(formula)
#    stopifnot(isTRUE(all.equal(length(f), c(1, 2))))