#' Create Model Frame from \code{multiple} Object
#'
#' This method creates a \code{model.frame} from a \code{multiple} object. This
#' method will be deprecated as the development of Zelig 4 progresses.
#' @usage \method{model.frame}{multiple}(formula,data,eqn=NULL,...)
#' @S3method model.frame multiple
#' @param formula an object of both type \code{formula} and \code{multiple}
#' @param data a \code{data.frame}
#' @param eqn the number of equations in the formula
#' @param ... ignored parameters
#' @return a \code{model.frame} object
#' @author Kosuke Imai, Olivia Lau, Gary King and Ferdinand Alimadhi
model.frame.multiple <- function (formula,data,eqn=NULL,...){
if(class(formula)[[1]]=="terms"){
terms <-formula
}else{
terms<-terms(formula)
}
#is multilevel?
if(!(is.logical(attr(terms,"subs"))))
return(multilevel(tt=terms,data=data,eqn=eqn,mode=2))
"%w/o%" <- function(x,y) x[!x %in% y]
eqns<-names(formula)
eqns<-attr(terms,"systEqns")
nrEquations<-length(eqns)
termlabels<-attr(terms,"term.labels")
depVars<-attr(terms,"depVars")
Xs<-Ys<-tlNew<-dvNew<-list()
for (i in 1:nrEquations){
rhs<-toBuildFormula(termlabels[[eqns[[i]]]])
if(!(is.null(rhs))){
rhs<-paste(rhs,"-1")
rhs<-as.formula(paste("~",rhs))
Xs[[eqns[[i]]]]<-model.matrix.default(rhs,data=data)
tlNew[[eqns[[i]]]]<-colnames(Xs[[eqns[[i]]]])
tlNew[[eqns[[i]]]]<-gsub("as.factor\\(.*\\)","",tlNew[[eqns[[i]]]])
colnames(Xs[[eqns[[i]]]])<-tlNew[[eqns[[i]]]]
}
}
depFactors<-attr(terms,"depFactors")
if(!(is.logical(depFactors)))
depVars<- paste("as.factor(",depFactors[[1]],")",sep="")
#print(depVars)
lhs<-toBuildFormula(unique(unlist(depVars)))
if(!(is.null(lhs))){
lhs<-paste(lhs,"-1")
lhs<-as.formula(paste("~",lhs))
Ys<-model.matrix.default(lhs,data=data)
dvNew<-colnames(Ys)
dvNew<-gsub("as.factor\\(.*\\)","",dvNew)
colnames(Ys)<-dvNew
}
attr(terms,"term.labels")[names(tlNew)]<-tlNew
attr(terms,"depVars")[names(dvNew)]<-dvNew
ronames<-rownames(data)
ronr<-nrow(data)
Xnames<-unique(unlist(tlNew))
Ynames<-unique(unlist(dvNew))
if(!(is.logical(depFactors)))
Ynames<-c(depFactors[[2]],Ynames %w/o% depFactors[[2]])
X<-matrix(0,nrow=ronr,ncol=length(Xnames),dimnames=list(ronames,Xnames))
Y<-matrix(0,nrow=ronr,ncol=length(Ynames),dimnames=list(ronames,Ynames))
if(length(tlNew)>0)
for(i in 1:length(tlNew)){
xtmp<-intersect(tlNew[[i]],Xnames)
X[,xtmp]<-Xs[[i]][,xtmp]
}
Y<-Ys
my.data.frame<-as.data.frame(cbind(Y,X))
rhs<-toBuildFormula(Xnames)
if(!(is.null(rhs)))
rhs<-(paste("~",rhs))
else
rhs<-"~1"
cb<-FALSE
if(length(Ynames)>1){
lhs<-toBuildFormula(Ynames,",")
if (!(is.null(lhs))){
lhs<-paste("cbind(",lhs)
lhs<-paste(lhs,")")
cb<-TRUE
}
}else{
lhs=Ynames
}
lhs<-as.formula(paste(lhs,rhs))
Y<-model.frame.default(lhs,data=my.data.frame)
result=Y
if(cb)
names(result)[[1]]<-"response"
new.response<-attr(attr(result,"terms"),"response")
attr(terms,"response")<-new.response
attr(result,"terms")<-terms
class(result)<-c(class(result),"multiple")
return(result)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.