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