.packageName <- "hwde"
"decode.genotypes" <-
function (genotype) 
{
    gname <- deparse(substitute(genotype))
    genotype <- factor(genotype)
    gtypes <- levels(genotype)
    charswide <- nchar(gtypes)
    nabc <- length(gtypes)
    if ((nabc != 3) | any(charswide != 2)) 
        stop(paste("Illegal codes", paste(gtypes, collapse = ", "), 
            "at locus", gname))
    ch1 <- substring(gtypes, 1, 1)
    ch2 <- substring(gtypes, 2, 2)
    AA <- gtypes[ch2 == ch1][1]
    Aa <- gtypes[ch1 != ch2]
    aa <- gtypes[ch2 == ch1][2]
    ord <- match(c(AA, Aa, aa), gtypes)
    id <- c(2, 1, 0)
    names(id) <- c(AA, Aa, aa)
    n <- length(genotype)
    idloc <- c(1, 2, 1)
    names(idloc) <- c(AA, Aa, aa)
    oset <- idloc[as.character(genotype)]
    ma <- id[as.character(genotype)]
    idaa <- c(1, 0, 0)
    names(idaa) <- c(AA, Aa, aa)
    maa <- idaa[as.character(genotype)]
    list(oset = oset, ma = ma, maa = maa, types = c(AA, Aa, aa))
}
"hwde" <-
function (data = IndianIrish, gp = "Population", termlist = NULL, 
              refmodel = NULL, loci = paste("locus", 1:(dim(data)[2] - 
                               1), sep = ""), observed = "Observed", keep.models = FALSE, 
              aovtable.print = TRUE, group.terms = TRUE, allele.chars = letters) 
{
    tmaker <- function(trms = c("ma", "mb"), currbase = 1, group.terms = TRUE, 
                       pref = "") {
        if (length(trms) == 1) {
            refmodel <- currbase
            plus <- trms
        }
        else if (group.terms) {
            plus <- paste("(", paste(trms, collapse = "+"), ")", 
                          sep = "")
            refmodel <- currbase
        }
        else {
            plus <- paste(pref, c(trms, paste("(", paste(trms, 
                                                         collapse = "+"), ")", sep = "")), sep = "")
            refmodel <- rep(currbase, length(plus))
        }
        list(plus, refmodel)
    }
    nloci <- length(loci)
    colnames <- names(data)
    for (i in 1:length(loci)) if (!(loci[i]%in%colnames)) {
        nloci <- i - 1
        loci <- loci[1:nloci]
        break
    }
    obs <- data[, observed]
    nobs <- length(obs)
    gploc <- loci
    contrasts.info <- make.contrasts(data = data[, loci], allele.chars = allele.chars)
    contr.df <- contrasts.info$contrasts.df
    list.columns <- contrasts.info$list.columns
    if (gp%in%colnames) 
        data.df <- cbind(data.frame(obs = obs, gp = data[, gp]), 
                         contr.df)
    else data.df <- cbind(data.frame(obs = obs), contr.df)
    gpslot <- as.numeric("gp" %in% names(data.df))
    if (is.null(termlist)) {
        addterms <- NULL
        newbase <- 1
        refmodel <- NULL
        for (colvec in list.columns) {
            trms <- tmaker(colvec, currbase = newbase, group.terms = group.terms)
            addterms <- c(addterms, trms[[1]])
            newbase <- newbase + length(trms[[1]])
            refmodel <- c(refmodel, trms[[2]])
        }
        if (gpslot) {
            addtermsg <- paste("gp:", addterms, sep = "")
            addterms <- c("gp", addterms, addtermsg)
            refmodel <- c(1, refmodel + 1, refmodel + newbase)
        }
        addterms <- paste("+", addterms, sep = "")
    }
    else {
        addterms <- termlist
    }
    form1 <- formula(paste("obs", "~", "1"))
    m1 <- glm(form1, family = poisson, offset = log(oset), data = data.df)
    n <- length(addterms)
    firstchar <- rep(" ", n)
    currmod <- m1
    mlist <- list(m1)
    for (i in 1:n) {
        modi <- paste("m", i + 1, sep = "")
        updi <- formula(paste(".~.", addterms[i], sep = ""))
        newmod <- update(currmod, updi)
        if ((i < n) & (refmodel[i + 1] > refmodel[i])) {
            if (!group.terms) 
                firstchar[i] <- "r"
            else firstchar <- " "
            currmod <- newmod
        }
        assign(paste("m", i + 1, sep = ""), newmod)
        mlist <- c(mlist, list(newmod))
    }
    anovatab <- do.call("anova", mlist)
    nam <- c("m", paste(firstchar, addterms, sep = ""))
    if (!group.terms) 
        nam[1] <- paste("r", nam[1], sep = "")
    anovatab[2:(n + 1), "Deviance"] <- anovatab[refmodel, "Resid. Dev"] - 
        anovatab[2:(n + 1), "Resid. Dev"]
    anovatab[2:(n + 1), "Df"] <- anovatab[refmodel, "Resid. Df"] - 
        anovatab[2:(n + 1), "Resid. Df"]
    aovtab.terms <- attributes(anovatab)$heading[2]
    attributes(anovatab)$heading <- NULL
    if (aovtable.print == TRUE) {
        print("Analysis of Deviance Table")
        print(anovatab, rowlab = nam)
    }
    if (!keep.models) 
        invisible(list(anovatab = anovatab, data.df = data.df, 
                       aovtab.terms = aovtab.terms))
    else invisible(list(anovatab = anovatab, data.df = data.df, 
                        aovtab.terms = aovtab.terms, models = mlist))
}
"make.contrasts" <-
function(data=data[,loci], allele.chars=letters){ 
       subsets <- function(n, r, v = 1:n) # Due to W N Venables
            if(r <= 0) vector(mode(v), 0) else 
            if(r >= n) v[1:n] else { 
            rbind(cbind(v[1], Recall(n-1, r-1, v[-1])), 
            Recall(n-1, r, v[-1]))
            }  
       data <- data.frame(data)
        loci <- names(data)
        nobs <- dim(data)[1]
        nloci <- length(loci)
        oset <- rep(1,nobs)
        contr.df <- cbind(data.frame(data, oset=oset),
                          matrix(0, nrow=nobs, ncol=2*nloci^2))
        aterms <- paste(allele.chars[1:nloci],sep="")
        aaterms <- paste(aterms,allele.chars[1:nloci],sep="")
        k <- nloci+2
        n1 <- length(aterms)+length(aaterms)
        list.columns <- list(aterms=aterms, aaterms=aaterms)
        names(contr.df)[k:(k+n1-1)] <- c(aterms,aaterms)
        if(nloci>1){
        all2 <- apply(matrix(subsets(nloci,2),ncol=2),1,
                      function(x)allele.chars[x])
        ab <- apply(all2, 2, function(x)paste(x,collapse=""))
        sabterms <- paste("s",ab,sep="")
        qabterms <- paste("q",ab,sep="")
        abbaabterms <- c(paste(ab,all2[2,],sep=""), paste(all2[1,],ab,sep=""))
        list.columns <- c(list.columns, list(sabterms=sabterms,
                                             qabterms=qabterms,
                                             abbaabterms=abbaabterms)) 
        n2 <- 4*length(sabterms)
        names(contr.df)[(k+n1):(k+n1+n2-1)] <- c(sabterms,qabterms,
                                                 abbaabterms)
    }
        for(i in 1:nloci)
        {
           setup <- decode.genotypes(contr.df[,loci[i]])
           char2 <- allele.chars[i]
           n.mb <- paste(char2,sep="")
           n.mbb <- paste(char2,char2,sep="")
           contr.df[,n.mb] <- mb <- setup$ma
           contr.df[,n.mbb] <- mbb <- setup$maa
           contr.df[,"oset"] <- setup$oset*contr.df[,"oset"]
            if(i>1)for(j in 1:(i-1)){
                char1 <- allele.chars[j]
                n.ma <- char1
                n.maa <- paste(char1,char1,sep="")
                ma <- contr.df[,n.ma]
                maa <- contr.df[,n.maa]
                ab <- paste(char1,char2,sep="")
                nsab <- paste("s",ab,sep="")
                nqab <- paste("q",ab,sep="")
                nmabb <- paste(ab,char2,sep="")
                nmaab <- paste(char1,ab,sep="")
                contr.df[,nsab] <-  as.numeric(ma==1 & mb==1)
                contr.df[,nqab] <- (ma>0 & mb>0)+(maa*mbb)-((ma==1)*(mb==1))
                contr.df[,nmabb] <- ma * (mb==2)
                contr.df[,nmaab] <- mb * (ma==2)
       }
       }
        list(contrasts.df=contr.df, list.columns=list.columns)
    }
