Wald <- function(object,
                 formula=NULL,
                 names=NULL,
                 pattern=NULL,
                 test=c("Chisq","F"),
                 dendf=NULL,
                 ...,all=FALSE){
    cl <- match.call()
    test <- match.arg(test)
    if(all(c(missing(formula),missing(names),missing(pattern)))){
        all <- TRUE
        multiple <- TRUE
    }
    else if(!missing(formula) && is.list(formula)){
        multiple <- TRUE
    }
    else
        multiple <- FALSE
    if(multiple){
        if(all){
            terms <- terms(object)
            formulae <- attr(terms,"term.labels")
            formulae <- paste("~",formulae)
            formulae <- lapply(formulae,as.formula)
        }
        else {
            formulae <- formula
        }
        cl <- match.call()
        cl[c("formula","names","pattern")] <- NULL
        cl$all <- FALSE
        res <- list()
        if(test=="F"){
            if(length(dendf)){
                length(dendf) <- length(formulae)
                dendf[is.na(dendf)] <- 0
            }
            else
                dendf <- numeric(length(formulae))
        }
        for(i in seq_along(formulae)){
            cl$formula <- formulae[[i]]
            if(test == "F"){
                dendf.i <- dendf[i]
                if(dendf.i == 0)
                    cl$dendf <- NULL
                else
                    cl$dendf <- dendf.i
            }
            res[[i]] <- eval(cl,parent.frame())
        }
        cf_ <- lapply(res,attr,"coef")
        V_ <- lapply(res,attr,"vcov")
        test <- lapply(res,attr,"test")
        res <- do.call(rbind,res)
        heading <- "Wald tests for terms in model"
        heading <- c(heading,deparse(object$call),"")
        structure(
            res,
            call=cl,
            coef=cf_,
            vcov=V_,
            heading=heading,
            class=c("WaldTest","anova","data.frame"))
    }
    else UseMethod("Wald")
}

Wald.default <- function(object,
                 formula=NULL,
                 names=NULL,
                 pattern=NULL,
                 glob=FALSE,
                 fixed=TRUE,
                 test=c("Chisq","F"),
                 vcov.fun,
                 vcov.mat,
                 dendf=NULL,
                 R = NULL,
                 ...
                 ){

    test <- match.arg(test)
    
    cl <- match.call()
    if(exists(".Generic"))
        cl[[1]] <- as.symbol(.Generic)

    if(!missing(vcov.mat))
        V <- vcov.mat
    if(!missing(vcov.fun))
        V <- vcov.fun(object)
    else
        V <- vcov(object)
    cf <- coef(object)
    nms <- names(cf)

    ii <- 0
    if(!missing(formula)){
        names <- formula2names(object,formula)
        ii <- match(names,nms,nomatch=0L)
        label <- sub("~","",deparse(formula))
    }
    else if(!missing(names)){
        ii <- match(names,nms,nomatch=0L)
        label <- paste0(names,collapse=",")
    }
    else if(!missing(pattern)) {
        if(glob)
            pattern <- glob2rx(pattern)
        ii <- grep(pattern,nms,fixed=fixed && !glob)
        label <- pattern
    }
    else stop("need exactly one of the following arguments: 'formula', 'names', or 'pattern")
    
    cf_ <- cf[ii]
    if(!missing(R)) {
        if(!is.matrix(R)) R <- rbind(R)
        cf_ <- R%*%cf_
    }
    if(length(cf_) > 0) {
        V_ <- V[ii,ii,drop=FALSE]
        if(!missing(R) && is.matrix(R) && ncol(R) == nrow(V_)){
            V_ <- R%*%V_%*%t(R)
        }
        df <- length(cf_)
        Chisq <- drop(crossprod(cf_,solve(V_,cf_)))
        if(test=="Chisq"){
            res <- data.frame(Chisq=Chisq,
                              df = df,
                              row.names = label)
            res[["Pr(>Chisq)"]] <- pchisq(Chisq,df=df,lower.tail=FALSE)
        }
        else{
            F <- Chisq/df
            if(!missing(dendf))
                rdf <- dendf
            else
                rdf <- df.residual(object)
            res <- data.frame(F=F,
                              df = df,
                              dendf = rdf,
                              row.names = label)
            res[["Pr(>F)"]] <- pf(F,df1=df,df2=rdf,lower.tail=FALSE)
        }
        heading <- "Wald tests for term(s) in model"
        heading <- c(heading,deparse(object$call),"")
        structure(res,
            call=cl,
            test=test,
            coef=cf_,
            vcov=V_,
            heading=heading,
            class=c("WaldTest","anova","data.frame"))
    } else {
        warning("no terms found",immediate.=TRUE)
        invisible(NULL)
    }
}

Wald.mblogit <- function(object,
                 formula=NULL,
                 names=NULL,
                 pattern=NULL,
                 glob=FALSE,
                 fixed=TRUE,
                 vcov.fun,
                 vcov.mat,
                 test=c("Chisq","F"),
                 dendf=NULL,
                 R = NULL,
                 ...
                 ){

    test <- match.arg(test)

    cl <- match.call()
    if(exists(".Generic"))
        cl[[1]] <- as.symbol(.Generic)
    
    if(!missing(vcov.mat))
        V <- vcov.mat
    if(!missing(vcov.fun))
        V <- vcov.fun(object)
    else
        V <- vcov(object)
    cf <- coef(object)
    nms <- names(cf)

    ii <- 0
    if(!missing(formula)){
        fnames <- formula2names(object,formula)
        respnames <- respnames_mblogit(object)
        names <- as.vector(outer(respnames,fnames,paste,sep="~"))
        ii <- match(names,nms,nomatch=0L)
        ii <- sort(unique(ii))
        label <- sub("~","",deparse(formula))
    }
    else if(!missing(names)){
        ii <- match(names,nms,nomatch=0L)
        label <- paste0(names,collapse=",")
    }
    else if(!missing(pattern)) {
        if(glob)
            pattern <- glob2rx(pattern)
        ii <- grep(pattern,nms,fixed=fixed && !glob)
        label <- pattern
    }
    else stop("need exactly one of the following arguments: 'formula', 'names', or 'pattern")
    
    cf_ <- cf[ii]
    if(length(cf_) > 0) {
        V_ <- V[ii,ii,drop=FALSE]
        df <- length(cf_)
        if(test=="Chisq"){
            Chisq <- drop(crossprod(cf_,solve(V_,cf_)))
            res <- data.frame(Chisq = Chisq,
                              df = df,
                              row.names = label)
            res[["Pr(>Chisq)"]] <- pchisq(Chisq,df=df,lower.tail=FALSE)
        }
        else {
            Chisq <- drop(crossprod(cf_,solve(V_,cf_)))
            F <- Chisq/df
            if(!missing(dendf))
                rdf <- dendf
            else
                rdf <- df.residual(object)
            res <- data.frame(F=F,
                              df = df,
                              dendf = rdf,
                              row.names = label)
            res[["Pr(>F)"]] <- pf(F,df1=df,df2=rdf,lower.tail=FALSE)
        }
        heading <- "Wald tests for terms in model"
        heading <- c(heading,deparse(object$call),"")
        structure(
            res,
            call=cl,
            test=test,
            coef=cf_,
            vcov=V_,
            heading=heading,
            class=c("WaldTest","anova","data.frame"))

    } else {
        warning("no terms found",immediate.=TRUE)
        invisible(NULL)
    }
}





formula2names <- function(obj,fo){
    if(length(fo)>2)
        rhs <- fo[-2]
    else
        rhs <- fo
    xlevels <- obj$xlevels
    tm <- terms(rhs)
    termlabs <- attr(tm,"term.labels")
    o.tm <- terms(obj)
    o.termlabs <- attr(o.tm,"term.labels")
    if(!all(termlabs%in%o.termlabs)){
        sdf <- setdiff(termlabs,o.termlabs)
        warning(paste(paste(sdf,collapse=", "),"not in model"))
        termlabs <- intersect(termlabs,o.termlabs)
    }
    names <- lapply(termlabs,tl2names,xlevels=xlevels)
    names <- unlist(names)
    names <- unique(names)
    return(names)
}

tl2names <- function(tl,xlevels){
    tl <- unlist(strsplit(tl,":"))
    nms <- lapply(tl,tl2names_,xlevels=xlevels)
    if(length(tl)>1)
        nms <- Reduce(internames,nms)
    return(nms)
}

tl2names_ <- function(tl,xlevels){
    if(!(tl %in% names(xlevels)))
        return(tl)
    else {
        levs <- xlevels[[tl]]
        return(paste0(tl,levs))
    }
}

internames <- function(x,y){
    outer(x,y,paste,sep=":")
}

coef.WaldTest <- function(object,...){
    attr(object,"coef")
}

vcov.WaldTest <- function(object,...){
    attr(object,"vcov")
}

respnames_mblogit <- function(object){
    cf <- coef(object)
    ncf <- strsplit(names(cf),"~")
    nms <- sapply(ncf,"[[",1)
    unique(nms)
}
