1#  File src/library/stats/R/expand.model.frame.R
2#  Part of the R package, https://www.R-project.org
3#
4#  Copyright (C) 1995-2012 The R Core Team
5#
6#  This program 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#  This program 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#  https://www.R-project.org/Licenses/
18
19expand.model.frame <- function(model, extras,
20                               envir=environment(formula(model)),
21                               na.expand=FALSE)
22{
23    ## don't use model$call$formula -- it might be a variable name
24    f <- formula(model)
25    data <- eval(model$call$data, envir)
26
27    # new formula (there must be a better way...)
28    ff <- foo ~ bar + baz
29    gg <- if(is.call(extras))
30              extras
31          else
32              str2lang(paste("~", paste(extras, collapse="+")))
33    ff[[2L]] <- f[[2L]]
34    ff[[3L]][[2L]] <- f[[3L]]
35    ff[[3L]][[3L]] <- gg[[2L]]
36
37    if (!na.expand){
38        naa <- model$call$na.action
39        subset <- model$call$subset
40        rval <- eval(call("model.frame", ff, data = data, subset = subset,
41                          na.action = naa), envir)
42    } else {
43        subset <- model$call$subset
44        rval <- eval(call("model.frame", ff, data = data, subset = subset,
45                          na.action = I), envir)
46        oldmf <- model.frame(model)
47        keep <- match(rownames(oldmf), rownames(rval))
48        rval <- rval[keep, ]
49        class(rval) <- "data.frame" # drop "AsIs"
50    }
51
52    return(rval)
53}
54