.packageName <- "gdTools"
#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/KMeans.R"
"KMeans" <-
function (x, centers, iter.max = 10, num.seeds = 10)
{
    if (mode(x) == "numeric")
        x <- data.frame(new.x = x)
    KM <- kmeans(x = x, centers = centers, iter.max = iter.max)
    for (i in 2:num.seeds) {
        newKM <- kmeans(x = x, centers = centers, iter.max = iter.max)
        if (sum(newKM$withinss) < sum(KM$withinss)) {
            KM <- newKM
        }
    }
    KM$tot.withinss <- sum(KM$withinss)
    xmean <- apply(x, 2, mean)
    centers <- rbind(KM$centers, xmean)
    bss1 <- as.matrix(dist(centers)^2)
    KM$betweenss <- sum(as.vector(bss1[nrow(bss1), ]) * c(KM$size,
        0))
    return(KM)
}

#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/aggregate.mv.R"
"aggregate.mv" <-
function(x, by, FUN, unlist=T, ...) {
    if (is.null(dim(x))) x<-matrix(x,ncol=1)
    nfun <- length(FUN)
    res <- list()
    for (i in 1:nfun)
    res[[i]] <- aggregate(x, by, FUN[[i]], ...)
    txt <- deparse(substitute(FUN))
    names(res) <- unlist(strsplit(substring(txt,6,nchar(txt)-1),", "))
    if (unlist) {
    nby <- length(by)
    df <- matrix(NA, nrow=nrow(res[[1]]), ncol=(ncol(x)*nfun))
    for (i in 1:nfun) {
    for (j in 1:ncol(x)) df[,i+(j-1)*nfun] <- res[[i]][,j+nby]
    }
    df <- data.frame(res[[1]][,1:nby],df)
    names(df)[-c(1:nby)] <- paste(rep(names(x),rep(nfun,ncol(x))),rep(names(res),ncol(x)),sep=".")
    }
    if (unlist) df else res
}

#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/anova.mixed.R"
anova.mixed <- function(fit, eterms) {
	if (missing(eterms)) anova(fit, test="F")
	else {
		nt <- length(eterms)
		end <- 1
		tab <- anova(fit, test="F")
		if (class(fit)[1]=="glm") {
			tab <- tab[-1,]
			fcol <- 5
			pcol <- 6
		}
		else {
			fcol <- 4
			pcol <- 5
		}
		for (i in 1:nt) {
			cat("et",eterms[i],"\n")
			if (eterms[i] > end) {
				tab[end:(eterms[i]-1),fcol] <- 
					tab[end:(eterms[i]-1),fcol]/tab[eterms[i],fcol]  
				tab[eterms[i],pcol] <- NA 
				for (k in (end:(eterms[i]-1)))	
					tab[k,pcol] <- 1 - pf(tab[k,fcol],tab[k,1],tab[eterms[i],1])
				end <- eterms[i] + 1
			}
		}
	rownames(tab)[eterms] <- paste(rownames(tab)[eterms],"(Error)",sep=" ")
	tab
	}
}


#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/bin.var.R"
"bin.var" <-
function (x, bins = 4, method = c("intervals", "proportions",
    "natural"), labels = FALSE)
{
    method <- match.arg(method)
    if (length(x) < bins) {
        stop("The number of bins exceeds the number of data values")
    }
    x <- if (method == "intervals")
        cut(x, bins, labels = labels)
    else if (method == "proportions")
        cut(x, quantile(x, probs = seq(0, 1, 1/bins), na.rm = TRUE),
            include.lowest = TRUE, labels = labels)
    else {
        xx <- na.omit(x)
        breaks <- c(min(xx), tapply(xx, KMeans(xx, bins)$cluster,
            max))
        cut(x, breaks, include.lowest = TRUE, labels = labels)
    }
    as.factor(x)
}

#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/capper.R"
"capper" <-
function (string, from = 1, to = 1){
   fn <- function(x){
     v <- unlist(strsplit(x, split = " "))
     u <- sapply(v, function(x){
            x <- tolower(x)
            substring(x, from, to) <- toupper(substring(x, from, to))
            x})
     paste(u, collapse = " ")
     }
   sapply(string, fn)
}

#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/check.RDatas.R"
"check.RDatas" <-
function() {
    RDatas <- list.files(patt=".RData")
        for (i in length(RDatas)) {
        rm(list=ls(all=T,envir=parent.frame()),envir=parent.frame())
        cat("\n",RDatas[i],"\n")
        load(RDatas[i],envir=parent.frame())
    }
    rm(list=ls(all=T,envir=parent.frame()),envir=parent.frame())
}

#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/cnvrt.coords.R"
"cnvrt.coords" <-
function(x,y=NULL,input=c('usr','plt','fig','dev','tdev')) {

  input <- match.arg(input)
  xy <- xy.coords(x,y)
  
  cusr <- par('usr')
  cplt <- par('plt')
  cfig <- par('fig')
  cdin <- par('din')
  comi <- par('omi')
  cdev <- c(comi[2]/cdin[1],(cdin[1]-comi[4])/cdin[1],
            comi[1]/cdin[2],(cdin[2]-comi[3])/cdin[2])
  
  if(input=='usr'){
    usr <- xy
    
    plt <- list()
    plt$x <- (xy$x-cusr[1])/(cusr[2]-cusr[1])
    plt$y <- (xy$y-cusr[3])/(cusr[4]-cusr[3])

    fig <- list()
    fig$x <- plt$x*(cplt[2]-cplt[1])+cplt[1]
    fig$y <- plt$y*(cplt[4]-cplt[3])+cplt[3]

    dev <- list()
    dev$x <- fig$x*(cfig[2]-cfig[1])+cfig[1]
    dev$y <- fig$y*(cfig[4]-cfig[3])+cfig[3]
    
    tdev <- list()
    tdev$x <- dev$x*(cdev[2]-cdev[1])+cdev[1]
    tdev$y <- dev$y*(cdev[4]-cdev[3])+cdev[3]
    
    return( list( usr=usr, plt=plt, fig=fig, dev=dev, tdev=tdev ) )
  }

  if(input=='plt') {

    plt <- xy

    usr <- list()
    usr$x <- plt$x*(cusr[2]-cusr[1])+cusr[1]
    usr$y <- plt$y*(cusr[4]-cusr[3])+cusr[3]

    fig <- list()
    fig$x <- plt$x*(cplt[2]-cplt[1])+cplt[1]
    fig$y <- plt$y*(cplt[4]-cplt[3])+cplt[3]

    dev <- list()
    dev$x <- fig$x*(cfig[2]-cfig[1])+cfig[1]
    dev$y <- fig$y*(cfig[4]-cfig[3])+cfig[3]

    tdev <- list()
    tdev$x <- dev$x*(cdev[2]-cdev[1])+cdev[1]
    tdev$y <- dev$y*(cdev[4]-cdev[3])+cdev[3]
    
    return( list( usr=usr, plt=plt, fig=fig, dev=dev, tdev=tdev ) )
  }

  if(input=='fig') {

    fig <- xy

    plt <- list()
    plt$x <- (fig$x-cplt[1])/(cplt[2]-cplt[1])
    plt$y <- (fig$y-cplt[3])/(cplt[4]-cplt[3])

    usr <- list()
    usr$x <- plt$x*(cusr[2]-cusr[1])+cusr[1]
    usr$y <- plt$y*(cusr[4]-cusr[3])+cusr[3]

    dev <- list()
    dev$x <- fig$x*(cfig[2]-cfig[1])+cfig[1]
    dev$y <- fig$y*(cfig[4]-cfig[3])+cfig[3]

    tdev <- list()
    tdev$x <- dev$x*(cdev[2]-cdev[1])+cdev[1]
    tdev$y <- dev$y*(cdev[4]-cdev[3])+cdev[3]
    
    return( list( usr=usr, plt=plt, fig=fig, dev=dev, tdev=tdev ) )
  }

  if(input=='dev'){
    dev <- xy

    fig <- list()
    fig$x <- (dev$x-cfig[1])/(cfig[2]-cfig[1])
    fig$y <- (dev$y-cfig[3])/(cfig[4]-cfig[3])

    plt <- list()
    plt$x <- (fig$x-cplt[1])/(cplt[2]-cplt[1])
    plt$y <- (fig$y-cplt[3])/(cplt[4]-cplt[3])

    usr <- list()
    usr$x <- plt$x*(cusr[2]-cusr[1])+cusr[1]
    usr$y <- plt$y*(cusr[4]-cusr[3])+cusr[3]

    tdev <- list()
    tdev$x <- dev$x*(cdev[2]-cdev[1])+cdev[1]
    tdev$y <- dev$y*(cdev[4]-cdev[3])+cdev[3]  

    return( list( usr=usr, plt=plt, fig=fig, dev=dev, tdev=tdev ) )
  }

  if(input=='tdev'){
    tdev <- xy

    dev <- list()
    dev$x <- (tdev$x-cdev[1])/(cdev[2]-cdev[1])
    dev$y <- (tdev$y-cdev[3])/(cdev[4]-cdev[3])
    
    fig <- list()
    fig$x <- (dev$x-cfig[1])/(cfig[2]-cfig[1])
    fig$y <- (dev$y-cfig[3])/(cfig[4]-cfig[3])

    plt <- list()
    plt$x <- (fig$x-cplt[1])/(cplt[2]-cplt[1])
    plt$y <- (fig$y-cplt[3])/(cplt[4]-cplt[3])

    usr <- list()
    usr$x <- plt$x*(cusr[2]-cusr[1])+cusr[1]
    usr$y <- plt$y*(cusr[4]-cusr[3])+cusr[3]

    tdev <- list()
    tdev$x <- dev$x*(cdev[2]-cdev[1])+cdev[1]
    tdev$y <- dev$y*(cdev[4]-cdev[3])+cdev[3]  

    return( list( usr=usr, plt=plt, fig=fig, dev=dev, tdev=tdev ) )
  }
  
}

#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/col2hex.R"
col2hex <- 
function (cname) 
{
    colMat <- col2rgb(cname)
    rgb(red = colMat[1, ]/255, green = colMat[2, ]/255, blue = colMat[3, 
        ]/255)
}

#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/colorpanel.R"
"colorpanel" <-
function (n = 100, low = "green", mid = "yellow", high = "brown")
{
    if (missing(mid) || missing(high)) {
        low <- col2rgb(low)
        if (missing(high))
            high <- col2rgb(mid)
        else high <- col2rgb(high)
        red <- seq(low[1, 1], high[1, 1], length = n)/255
        green <- seq(low[3, 1], high[3, 1], length = n)/255
        blue <- seq(low[2, 1], high[2, 1], length = n)/255
    }
    else {
        isodd <- odd(n)
        if (isodd) {
            n <- n + 1
        }
        low <- col2rgb(low)
        mid <- col2rgb(mid)
        high <- col2rgb(high)
        lower <- floor(n/2)
        upper <- n - lower
        red <- c(seq(low[1, 1], mid[1, 1], length = lower), seq(mid[1,
            1], high[1, 1], length = upper))/255
        green <- c(seq(low[3, 1], mid[3, 1], length = lower),
            seq(mid[3, 1], high[3, 1], length = upper))/255
        blue <- c(seq(low[2, 1], mid[2, 1], length = lower),
            seq(mid[2, 1], high[2, 1], length = upper))/255
        if (isodd) {
            red <- red[-(lower + 1)]
            green <- green[-(lower + 1)]
            blue <- blue[-(lower + 1)]
        }
    }
    rgb(red, blue, green)
}
#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/dat3err.R"
dat3err <- function(data,y=1,err=2,names=3) {
    n<-nrow(data)
    newdata<-data[rep(1:n,rep(3,n)),c(y,names)]
    newdata[,1]<-newdata[,1]+data[rep(1:n,rep(3,n)),err]*c(-1,0,1)
    newdata
}
#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/errbar.R"
"errbar" <-
function(x, y, erry, hi, lo, n, nse = 2, ci.cover = 0.95, pcheb = 1,
        col = 1, bg = 1, cexeb = 1, gap = 1, bar.ends = 1, texts = FALSE) {
        if (!missing(erry)){
            if(nse==0) erry <- erry * qt((1 + ci.cover)/2, n)
            else  erry <- nse * erry
        }
        if (texts)
            text(x, y, labels = texts, cex = cexeb, col = col)
        else points(x, y, type = "p", pch = pcheb, cex = cexeb,
            col = col, bg = bg)

        if (gap != 0)
            gap <- gap * 0.4 * par("cxy")[2]
        if (!missing(erry)){
            segments(x, pmin(y + gap, y + erry), x, y + erry, col = col)
            segments(x, pmax(y - gap, y - erry), x, y - erry, col = col)
        if (bar.ends != 0) {
                size.bar <- bar.ends * 0.1
                segments(x - size.bar, y + erry, x + size.bar, y +
                    erry, col = col)
                segments(x - size.bar, y - erry, x + size.bar, y -
                    erry, col = col)
            }
        }
        else if (!missing(hi) & !missing(lo)) {
            segments(x, pmin(y + gap, hi), x, hi, col = col)
            segments(x, pmax(y - gap, lo), x, lo, col = col)
            if (bar.ends != 0) {
                size.bar <- bar.ends * 0.1
                segments(x - size.bar, hi, x + size.bar, hi, col = col)
                segments(x - size.bar, lo, x + size.bar, lo, col = col)
               }
        }
}
#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/est.vcov.R"
"est.vcov" <-
function(obj, x) {
    vc <- vcov(obj)
    x<-matrix(x, nrow=1)
    if (length(x)!=nrow(vc)) stop("Length x not equal to size of vcov\n")
    else c(x %*% vc %*% t(x))
}

#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/even.R"
"even" <-
function (x)
x == as.integer(x/2) * 2

#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/ganova.R"
"ganova" <-
function (object, ...)
{
    if (length(list(object, ...)) > 1)
        return(ganova.list(object, ...))
    w <- object$weights
    n <- length(object$resid)
    ssr <- sum(if (is.null(w))
        object$resid^2
    else w * object$resid^2)
    dfr <- df.residual(object)
    p <- object$rank
    if (p > 0) {
        p1 <- 1:p
        comp <- object$effects[p1]
        asgn <- object$assign[object$qr$pivot][p1]
        nmeffects <- c("(Intercept)", attr(object$terms, "term.labels"))
        tlabels <- nmeffects[1 + unique(asgn)]
        ss <- c(unlist(lapply(split(comp^2, asgn), sum)), ssr)
        df <- c(unlist(lapply(split(asgn, asgn), length)), dfr)
    }
    else {
        ss <- ssr
        df <- dfr
        tlabels <- character(0)
    }
    ms <- ss/df
    f <- ms/(ssr/dfr)
    P <- pf(f, df, dfr, lower.tail = FALSE)
    table <- data.frame(df, ss, ms, f, P)
    np <- length(P)
    table[np, 4:5] <- NA
    dimnames(table) <- list(c(tlabels, "Residuals"), c("Df",
        "Sum Sq", "Mean Sq", "F value", "Pr(>F)"))
    sst <- rev(c(NA,cumsum(ss[np:2])))/ms[np]
    pp <- rev(c(NA,n-cumsum(df[np:2])))
    table$"AIC" <- sst + 2 * pp
    table$"AICC" <- sst + 2 * pp * (1 + (pp + 1)/(n - pp - 1))
    table$"BIC" <- sst + log(n) * pp
       if (attr(object$terms, "intercept"))
        table <- table[-1, ]
    structure(table, heading = c("Analysis of Variance Table",
        paste("Response:", deparse(formula(object)[[2]]))), class = c("anova",
        "data.frame"))
}

#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/ganova.list.R"
"ganova.list" <-
function (object, ..., scale = 0, test = c("F","Chi","Cp","IC","ICdev"))
{
    objects <- list(object, ...)
    responses <- as.character(lapply(objects, function(x) deparse(x$terms[[2]])))
    sameresp <- responses == responses[1]
    if (!all(sameresp)) {
        objects <- objects[sameresp]
        warning("Models with response ", deparse(responses[!sameresp]),
            " removed because response differs from ", "model 1")
    }
    ns <- sapply(objects, function(x) length(x$residuals))
    if (any(ns != ns[1]))
        stop("models were not all fitted to the same size of dataset")
    nmodels <- length(objects)
    test <- test[1]
    if (nmodels == 1)
        return(ganova.lm(object))
    resdf <- as.numeric(lapply(objects, df.residual))
    resdev <- as.numeric(lapply(objects, deviance))
    table <- data.frame(resdf, resdev, c(NA, -diff(resdf)), c(NA,
        -diff(resdev)))
    variables <- lapply(objects, function(x) paste(deparse(formula(x)),
        collapse = "\n"))
    dimnames(table) <- list(1:nmodels, c("Dev Df", "Deviance", "Diff Df",
        "Diff Dev"))
    title <- "Analysis of Variance Table"
    topnote <- paste("Model ", format(1:nmodels), ": ", variables,
        sep = "", collapse = "\n")
    attr(table,"n") <- length(objects[[1]]$residuals)
    if (!is.null(test)) {
        bigmodel <- order(resdf)[1]
        scale <- if (scale > 0)
            scale
        else resdev[bigmodel]/resdf[bigmodel]
        table <- stat.ganova(table = table, test = test, scale = scale,
            df.scale = resdf[bigmodel], n = length(objects[[1]]$residuals))
    }
    structure(table, heading = c(title, topnote), class = c("anova",
        "data.frame"))
}

#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/gd.theme.R"
"gd.theme" <-
function ()
    list(background = list(col = "transparent"), bar.fill = list(col = "blue"),
    box.rectangle = list(col = "darkgreen"), box.umbrella = list(col = "darkgreen", lty = 1),
    dot.line = list(col = "darkblue"), dot.symbol = list(col = "darkgray"),
    plot.line = list(col = "darkblue"), plot.symbol = list(col = "darkgray"),
    regions = list(col = heat.colors(100)), strip.shingle = list(col = c("#ff7f00",
        "#00ff00", "#00ffff", "#0080ff", "#ff00ff", "#ff0000",
        "#ffff00")), strip.background = list(col = c("#ffe5cc",
        "#ccffcc", "#ccffff", "#cce6ff", "#ffccff", "#ffcccc",
        "#ffffcc")), reference.line = list(col = "#e8e8e8"),
    superpose.line = list(col = c("red", "darkblue", "darkgreen",
        "brown", "orange", "turquoise", "orchid"), lty = rep(1,7)),
    superpose.symbol = list(pch = c(1, 3, 6, 0, 5, 16, 17), cex = rep(0.7,
        7), col = c("red", "darkblue", "darkgreen", "brown",
        "orange", "turquoise", "orchid")))

#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/gd2.theme.R"
"gd2.theme" <-
function ()
    list(background = list(col = "transparent"), bar.fill = list(col = "blue"),
    box.rectangle = list(col = "darkgreen"), box.umbrella = list(col = "darkgreen", lty = 1),
    dot.line = list(col = "#e8e8e8"), dot.symbol = list(col = "darkblue"),
    plot.line = list(col = "darkblue"), plot.symbol = list(col = "darkblue"),
    regions = list(col = heat.colors(100)), strip.shingle = list(col = c("#ff7f00",
        "#00ff00", "#00ffff", "#0080ff", "#ff00ff", "#ff0000",
        "#ffff00")), strip.background = list(col = c("#ffe5cc",
        "#ccffcc", "#ccffff", "#cce6ff", "#ffccff", "#ffcccc",
        "#ffffcc")), reference.line = list(col = "#e8e8e8"),
    superpose.line = list(col = c("red", "darkblue", "darkgreen",
        "brown", "orange", "turquoise", "orchid"), lty = rep(1,7)),
    superpose.symbol = list(pch = c(1, 3, 6, 0, 5, 16, 17), cex = rep(0.7,
        7), col = c("red", "darkblue", "darkgreen", "brown",
        "orange", "turquoise", "orchid")))

#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/gdset.R"
"gdset" <-
function() {
     lattice::trellis.par.set(gd.theme())
}

#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/gmatch.R"
gmatch <- function(x,y) {
    x[is.element(x,y)]
}
#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/gplot.factor.R"
"gplot.factor" <-
function(x, y, se.y = NULL, xlab, ylab, residuals = NULL, rugplot = F, scale = 0, se = F, nse = 2, xlim = NULL, ylim = NULL, fit = T,
    ...)
{
    if(length(x) != length(y)) stop("x and y do not have the same length; possibly a consequence of an na.action")
    nn <- as.numeric(table(x))
    nnx <- rep(1,length(nn))
    codex <- as.numeric(x)
    ucodex <- seq(nn)[nn > 0]
    o <- match(ucodex, codex, 0)
    uy <- as.numeric(y[o])
    ylim <- range(ylim, uy)
    xlim <- range(c(0, seq(nn), xlim))
    rightx <- cumsum(nnx)
    leftx <- c(0, rightx[ - length(nnx)])
    ux <- ((leftx + rightx)/2)
    delta <- (rightx - leftx)/4
    jx <- runif(length(codex), (ux - delta)[codex], (ux + delta)[codex])
    nnajx <- jx[!is.na(jx)]
    if(rugplot)
        xlim <- range(c(xlim, nnajx))
    if(se && !is.null(se.y)) {
        se.upper <- uy + nse * se.y[o]
        se.lower <- uy - nse * se.y[o]
        ylim <- range(c(ylim, se.upper, se.lower))
    }
    if(!is.null(residuals)) {
        if(length(residuals) == length(y)) {
            residuals <- y + residuals
            ylim <- range(c(ylim, residuals))
        }
        else {
            residuals <- NULL
            warning(paste("Residuals do not match x in \"", ylab, "\" preplot object", sep = ""))
        }
    }
    ylim <- ylim.scale(ylim, scale)
    Levels <- levels(x)
    if(!all(nn)) {
        keep <- nn > 0
        ux <- ux[keep]
        delta <- delta[keep]
        leftx <- leftx[keep]
        rightx <- rightx[keep]
        Levels <- Levels[keep]
    }
    plot(ux, uy, ylim = ylim, xlim = xlim, xlab = "", type = "n", ylab = ylab, xaxt = "n", ...)
    mtext(xlab, 1, 2.5)
    axis(side = 1, at = ux, labels = Levels, ...)
    if(fit)
        segments(leftx + delta, uy, rightx - delta, uy, ...)
    if(!is.null(residuals))
        points(jx, residuals, ...)
    if(rugplot)
        rug(nnajx)
    if(se) {
        segments(ux + delta, se.upper, ux - delta, se.upper, ...)
        segments(ux + delta, se.lower, ux - delta, se.lower, ...)
        segments(ux, se.lower, ux, se.upper, ...)
    }
    invisible(diff(ylim))
}

#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/gplot.numeric.R"
"gplot.numeric" <-
function(x, y, se.y = NULL, xlab, ylab, residuals = NULL, rugplot = F, scale = 0, se = F, xlim = NULL, ylim = NULL, fit = T,
    nse = 2, ...)
{
    if(length(x) != length(y))
        stop("x and y do not have the same length; possibly a consequence of an na.action")
    ux <- unique(sort(x))
    o <- match(ux, x)
    uy <- y[o]
    xlim <- range(xlim, ux)
    ylim <- range(ylim, uy)
    if(rugplot) {
        jx <- jitter(x[!is.na(x)])
        xlim <- range(c(xlim, jx))
    }
    if(se && !is.null(se.y)) {
        se.upper <- uy + nse * se.y[o]
        se.lower <- uy - nse * se.y[o]
        ylim <- range(c(ylim, se.upper, se.lower))
    }
    if(!is.null(residuals)) {
        if(length(residuals) == length(y)) {
            residuals <- y + residuals
            ylim <- range(c(ylim, residuals))
        }
        else {
            residuals <- NULL
            warning(paste("Residuals do not match x in \"", ylab, "\" preplot object", sep = ""))
        }
    }
    ylim <- ylim.scale(ylim, scale)
    if(!is.null(residuals)) {
        plot(x, residuals, type = "n", xlim = xlim, ylim = ylim, xlab = xlab, ylab = ylab, ...)
        if(se) {
            polygon(c(ux, rev(ux)), c(se.upper, rev(se.lower)), dens = -1, col = 8)
        }
        points(x, residuals, ...)
        if(fit)
            lines(ux, uy, ...)
    }
    else {
        plot(ux, uy, type = "n", xlim = xlim, ylim = ylim, xlab = xlab, ylab = ylab, ...)
        if(se) {
            polygon(c(ux, rev(ux)), c(se.upper, rev(se.lower)), dens = -1, col = 8)
        }
        if(fit)
            lines(ux, uy, ...)
    }
    if(rugplot)
        rug(jx)
    invisible(diff(ylim))
}

#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/gwin.R"
"gwin" <-
function(w=8, h=8, ...) {
  grDevices::windows(wid=w, hei=h, ...)
  graphics::par(las=1)
  grDevices::bringToTop(-1)
}

#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/hs.R"
`hs` <-
function (gui = "irrelevant", browser = getOption("browser"), 
    remote = NULL) 
{
    if (is.null(browser)) 
        stop("invalid browser name, check options(\"browser\").")
    if (browser != getOption("browser")) {
        msg <- gettext("Changing the default browser (as specified by the 'browser' option) to the given browser so that it gets used for all future help requests.")
        writeLines(strwrap(msg, exdent = 4))
        options(browser = browser)
    }
    cat(gettext("Making links in per-session dir ...\n"))
    .Script("sh", "help-links.sh", paste(tempdir(), paste(.libPaths(), 
        collapse = " ")))
    make.packages.html()
    tmpdir <- paste("file://", URLencode(tempdir()), "/.R", sep = "")
    url <- paste(if (is.null(remote)) 
        tmpdir
    else remote, "/doc/html/index.html", sep = "")
    writeLines(strwrap(gettextf("If '%s' is already running, it is *not* restarted, and you must switch to its window.", 
        browser), exdent = 4))
    writeLines(gettext("Otherwise, be patient ..."))
    browseURL(url)
    options(htmlhelp = TRUE)
}
#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/lag.fun.R"
lag.fun <- function(x,lags=0:1,FUN=mean,...) {
	shift <- function(x,n) {
		nx <- length(x)
		na <- abs(n)
		if (nx<=na) x <- rep(NA,nx)
		else if (n<0) x <- c(x[(na+1):nx],rep(NA,na))
		else if (n>0) x <- c(rep(NA,na),x[1:(nx-na)])
		x
	}
	n <- length(x)
	nlags <- length(lags)
	xmat <- matrix(NA,nrow=n,ncol=nlags)
	for (i in 1:nlags) {
		xmat[,i] <- shift(x,lags[i])
	}
	apply(xmat,1,FUN,...)
}
#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/libs.R"
"libs" <-
function() {
    winMenuAdd("PackageLoads")
    winMenuAddItem("PackageLoads","acrossAlong","library(acrossAlong)")
    winMenuAddItem("PackageLoads","foreign","library(foreign)")
    winMenuAddItem("PackageLoads","gbmplus","library(gbmplus)")
    winMenuAddItem("PackageLoads","gbmMV","library(gbmMV)")
    winMenuAddItem("PackageLoads","gdDataSets","library(gdDataSets)")
    winMenuAddItem("PackageLoads","gdTools","library(gdTools)")
    winMenuAddItem("PackageLoads","gisTools","library(gisTools)")
    winMenuAddItem("PackageLoads","mars","library(mars)")
    winMenuAddItem("PackageLoads","MASS","library(MASS)")
    winMenuAddItem("PackageLoads","mgcv","library(mgcv)")
    winMenuAddItem("PackageLoads","mvpart","library(mvpart)")
    winMenuAddItem("PackageLoads","nlme","library(nlme)")
    winMenuAddItem("PackageLoads","splines","library(splines)")
    winMenuAddItem("PackageLoads","vegan","{library(vegan);library(veganFuns)}")
}
#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/little-funs.R"
lf <- function(...) list.files(...)

si <- function(...) save.image(...)

hs <- function(...) help.start(...)

hf <- function(...) help.search(...)

asch <- function(...) as.character(...)

sh <- function(...) savehistory(...)

cep <- function(name="fig1", ...) {
    feps <- paste(name, "eps", sep = ".")
    fpdf <- paste(name, "pdf", sep = ".")
    dev.copy2eps(file = feps, ...)
    dev.copy2pdf(file = fpdf, ...)
}

copyFig <- function(name = "fig1", size = 3, eps = TRUE, pdf = FALSE, png = TRUE, ...) 
{
    feps <- paste(name, "eps", sep = ".")
    fpng <- paste(name, "png", sep = ".")
    fpdf <- paste(name, "pdf", sep = ".")
    if (eps|png) dev.copy2eps(file = feps, ...)
    if (pdf) dev.copy2eps(file = fpdf, ...)
	if (png) {
		size <- paste(round(size * 12 * par()$din[1]), round(size * 12 * par()$din[2]), sep="x")
		system(paste("convert -density", size, feps, fpng, sep = " "))
		if (!eps) 
		    system(paste("rm", feps, sep = " "))
    }
}

cpng.big <- function(name = "fig1", size = 3, rm.eps = FALSE, ...) 
{
    feps <- paste(name, "eps", sep = ".")
    fpng <- paste(name, "png", sep = ".")
    dev.copy2eps(file = feps, ...)
	size <- paste(round(size * 12 * par()$din[1]), round(size * 12 * par()$din[2]), sep="x")
	system(paste("convert -density", size, feps, fpng, sep = " "))
    if (rm.eps) 
        system(paste("rm", feps, sep = " "))
}

cpng <- function(file = "fig", type = "Xlib", size=72, ...) 
{
    dev.copy(png, file = paste(file,".png",sep=""), type = type, width = round(size * 
        par()$din[1]), height = round(size * par()$din[2]), ...)
    dev.off()
}

cpdf <- function(file = "fig", ...) 
{
    dev.copy(pdf, file = paste(file,".pdf",sep=""), width = par()$din[1], 
	height = par()$din[2], ...)
    dev.off()
}

x11g <- X11g <- 
function (wid = 6, hei = 6, pts = 12, xpos = 1175, ypos = 0, las = 1,...) {
    X11(width = wid, height = hei, point = pts, xpos = xpos, ypos = ypos,
        bg = "white", ...)
    par(las = las)
}


go <- function() graphics.off()

cut2 <- function(x,n) cut(x,breaks=seq(min(x),max(x),length=n),include=T)

ipkgs <- function(pkgs) install.packages(pkgs,lib="/usr/lib/R/library", repos="http://cran.ms.unimelb.edu.au")

upkgs <- function() update.packages(lib.loc="/usr/lib/R/library", repos="http://cran.ms.unimelb.edu.au")



#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/lm.gd.R"
lm.gd <- 
function (form, data, se = 2,  add.pts = TRUE,  xlab, ylab, 
    pch = 1, cex = 1, main = NULL, xlim, ylim, summary = F, ...) 
{
    fit <- lm(form, data, ...)
	if (summary) print(summary(fit))
    pred <- predict(fit, se = T)
    if (missing(xlab)) 
        xlab <- fit$xnames[[1]]
    if (missing(ylab)) 
        ylab <- form[[2]]
    if (missing(xlim)) 
        xlim <- range(fit$x)
    if (missing(ylim)) 
        ylim <- range(c(fit$y, pred$fit + se * pred$se.fit, 
            pred$fit - se * pred$se.fit))
    plot(fit, xlab = xlab, ylab = ylab, xlim = xlim, ylim = ylim, 
        pch = pch, cex = cex, main = main)
    ord <- order(fit$x)
    lines(fit$x[ord], fit$fit[ord], col = "red", lwd = 2)
    lines(fit$x[ord], pred$fit[ord] + se * pred$se.fit[ord], 
        col = "darkblue", lwd = 1)
    lines(fit$x[ord], pred$fit[ord] - se * pred$se.fit[ord], 
        col = "darkblue", lwd = 1)
	invisible(fit)
}

#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/lm.qf.R"
"lm.qf" <-
function(x,rows) {
    nr <- nrow(x)
    if (length(rows)!=(nr-1)) stop("length rows ne to nrows(x)-1\n")
    if (any(rows)>nr) stop("rows gt nrows(x)\n")
    x[1:(nr-1),4] <- x[1:(nr-1),3]/x[rows,3]
    x[1:(nr-1),5] <- 1-pf(x[1:(nr-1),4],x[1:(nr-1),1],x[rows,1])
    x
}

#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/loess.gd.R"
"loess.gd" <-
function (form, data, se = 2, ptype = c("image", "persp"), np = 50,
    add.pts = TRUE, add.cont = TRUE, ncolors = np, xlab, ylab, pch=1,
    cex=1, main=NULL, xlim, ylim, ...)
{
    fit <- loess(form, data, ...)
    if (length(fit$xnames) == 1) {
        pred <- predict(fit, se = T)
        if (missing(xlab)) xlab<-fit$xnames[[1]]
        if (missing(ylab)) ylab<-form[[2]]
        if (missing(xlim)) xlim<-range(fit$x)
        if (missing(ylim)) ylim<-range(c(fit$y,pred$fit+se*pred$se.fit,pred$fit-se*pred$se.fit))
        plot(fit, xlab = xlab, ylab = ylab, xlim=xlim, ylim=ylim, pch=pch, cex=cex,main=main)
        ord <- order(fit$x)
        lines(fit$x[ord], fit$fit[ord], col = "red", lwd = 2)
        lines(fit$x[ord], pred$fit[ord] + se * pred$se.fit[ord],
            col = "darkblue", lwd = 1)
        lines(fit$x[ord], pred$fit[ord] - se * pred$se.fit[ord],
            col = "darkblue", lwd = 1)
    }
    else if (length(fit$xnames) == 2) {
        pred <- predict(fit, se = T)
        int <- interp(fit$x[, 1], fit$x[, 2], pred$fit, xo = seq(min(fit$x[,
            1]), max(fit$x[, 1]), length = np), yo = seq(min(fit$x[,
            2]), max(fit$x[, 2]), length = np), duplicate = "mean")
        if (ptype[1] == "image") {
            image(int, col = heat.colors(n = ncolors),...)
            if (add.cont)
                contour(int, add = T,...)
            if (add.pts)
                points(fit$x[, 1], fit$x[, 2],...)
        }
        else persp(int, ...)
    }
    else cat("Only handles 1D and 2D plots\n")
	invisible(fit)
}

#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/lsa.R"
"lsa" <-
function() objects(all=T,envir=parent.frame())

#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/luni.R"
"luni" <-function(x) length(unique(x))
#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/m2u.R"
"m2u" <-
function(data, responses, carrys, drop0 = F, collab = "time",
                 idlab = "id", ylab = "response")
{
#
# converts multivariate RM data to univariate Rm format
# data is the data frame in MV format
# responses defines response columns and carrys the cols to be expanded
#
#
    nr <- nrow(data)
    gnames <- names(data)[responses]
    ny <- length(responses)
    if(!missing(carrys)) {
        xx <- data[rep(1:nr, rep(ny, nr)), carrys, drop = F]
        xx <- cbind(xx, ordered(rep(gnames, nr)), factor(rep(1:nr, rep(ny, nr))), as.vector(t(data[, responses])))
    }
    else xx <- data.frame(cbind(ordered(rep(gnames, nr)), factor(rep(1:nr, rep(ny, nr))), as.vector(t(data[, responses]))
            ))
    names(xx)[(ncol(xx) - 2):ncol(xx)] <- c(collab, idlab, ylab)
    row.names(xx) <- c(1:(ny * nr))
    if(drop0)
        xx <- xx[xx[, ylab] != 0,  ]
    xx
}

#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/matFunWgt.R"
matFunWgt <- function(x) {
    n <- ncol(x) 
    ns <- n-1
    wgts <- x/apply(x,1,sum)
    scores <- (0:ns)/ns
    xwmn <- t(t(wgts)*scores)
    xwgt.mn <- apply(xwmn,1,sum)
    xwgt.sd <- sqrt(16*n)*apply(wgts*(xwmn-xwgt.mn),1,sd)
    res <- cbind(xwgt.mn,xwgt.sd)
    colnames(res) <- c("mean","sd")
    res
}
#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/mcars.R"
mcars <-
structure(list(mpg = c(16.9, 19.4, 26.4, 27.4, 36, 27.9, 36, 
22.4, 36, 19.2, 33.5, 16.5, 37.3, 26, 15.5, 22.3, 25.8, 23.5, 
17.7, 18.2, 39.1, 36.4, 28.8, 38, 19.1, 18.5, 29.9, 19.2, 40.8, 
20.2, 23.9, 31.8, 23.9, 31.5, 31, 37.7, 43.4, 36, 33, 28, 34.2, 
34.5, 32.9, 25.4, 32.4, 37, 21.5, 16.2, 18.1, 20.8, 35.7, 34, 
18.6, 31.6, 28, 34, 38, 30, 44, 34.1, 30.7, 34.7, 29, 27.2, 32, 
23, 37, 24.3, 31.3, 23.7, 23.2, 37, 32, 37.2, 19.4, 34.4, 43.1, 
27, 44.3, 17.6, 20.2, 31.9, 28.4, 32, 44.6, 24.2, 24, 27.2, 30.4, 
21.1, 33.8, 19.8, 17, 20.2, 20.5, 32.1, 27.2, 30, 41.5, 32.2, 
36.1, 20.5, 30.9, 36.1, 17.6, 26.6, 20.2, 17, 32.8, 20.6, 19.9, 
27, 23.8, 25.4, 17.5, 22, 32.4, 21.6, 46.6, 27, 33.7, 31, 39.4, 
25, 29.8, 27, 20.3, 26.8, 31, 32.7, 18.1, 28, 38, 28.1, 36, 19.2, 
29.5, 26.6, 38.1, 35.1, 34.3, 25.1, 20.6, 27.5, 39, 34.1, 38, 
35, 29.8), cyl = structure(c(5L, 4L, 2L, 2L, 2L, 2L, 2L, 4L, 
2L, 5L, 2L, 5L, 2L, 2L, 5L, 2L, 2L, 4L, 4L, 5L, 2L, 3L, 4L, 2L, 
4L, 5L, 2L, 4L, 2L, 4L, 2L, 2L, 5L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 3L, 2L, 2L, 4L, 4L, 4L, 4L, 2L, 2L, 4L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L, 4L, 2L, 2L, 2L, 2L, 5L, 2L, 2L, 2L, 1L, 2L, 2L, 
2L, 2L, 5L, 2L, 2L, 2L, 2L, 4L, 4L, 2L, 2L, 2L, 2L, 4L, 2L, 2L, 
2L, 2L, 2L, 4L, 4L, 4L, 4L, 2L, 2L, 2L, 2L, 2L, 2L, 4L, 2L, 2L, 
5L, 5L, 5L, 5L, 2L, 4L, 5L, 2L, 2L, 4L, 5L, 4L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 4L, 2L, 2L, 3L, 4L, 2L, 4L, 5L, 2L, 4L, 2L, 2L, 5L, 
2L, 2L, 2L, 2L, 2L, 2L, 4L, 2L, 2L, 2L, 2L, 2L, 2L), .Label = c("3", 
"4", "5", "6", "8"), class = "factor"), dsp = c(350L, 232L, 140L, 
121L, 98L, 156L, 120L, 231L, 107L, 305L, 151L, 351L, 91L, 156L, 
351L, 140L, 156L, 173L, 231L, 318L, 79L, 121L, 173L, 91L, 225L, 
360L, 98L, 231L, 85L, 200L, 119L, 85L, 260L, 89L, 112L, 89L, 
90L, 135L, 105L, 120L, 105L, 105L, 119L, 183L, 108L, 91L, 231L, 
163L, 258L, 200L, 98L, 112L, 225L, 120L, 151L, 108L, 105L, 98L, 
97L, 86L, 145L, 105L, 135L, 135L, 91L, 350L, 85L, 151L, 120L, 
70L, 156L, 119L, 135L, 86L, 318L, 98L, 90L, 151L, 90L, 225L, 
200L, 89L, 151L, 144L, 91L, 146L, 140L, 141L, 146L, 134L, 97L, 
200L, 163L, 232L, 200L, 98L, 119L, 135L, 98L, 108L, 98L, 225L, 
105L, 91L, 302L, 350L, 302L, 305L, 78L, 231L, 260L, 140L, 151L, 
168L, 318L, 232L, 107L, 121L, 86L, 112L, 107L, 91L, 85L, 181L, 
89L, 151L, 131L, 173L, 119L, 168L, 302L, 112L, 262L, 141L, 105L, 
267L, 98L, 151L, 89L, 81L, 97L, 140L, 225L, 134L, 86L, 91L, 91L, 
122L, 134L), hp = c(155L, 90L, 88L, 80L, 70L, 105L, 88L, 110L, 
75L, 145L, 90L, 138L, 69L, 92L, 142L, 88L, 92L, 110L, 165L, 135L, 
58L, 67L, 115L, 67L, 90L, 150L, 65L, 105L, 65L, 85L, 97L, 65L, 
90L, 71L, 85L, 62L, 48L, 84L, 74L, 79L, 70L, 70L, 100L, 77L, 
75L, 68L, 115L, 133L, 120L, 85L, 80L, 88L, 110L, 74L, 90L, 70L, 
63L, 68L, 52L, 65L, 76L, 63L, 84L, 84L, 67L, 125L, 65L, 90L, 
75L, 100L, 105L, 92L, 84L, 65L, 140L, 65L, 48L, 90L, 48L, 85L, 
88L, 71L, 90L, 96L, 67L, 120L, 92L, 71L, 67L, 95L, 67L, 85L, 
125L, 90L, 95L, 70L, 97L, 84L, 76L, 75L, 66L, 100L, 75L, 60L, 
129L, 105L, 139L, 130L, 52L, 105L, 110L, 86L, 85L, 116L, 140L, 
112L, 72L, 115L, 65L, 88L, 75L, 68L, 70L, 110L, 62L, 90L, 103L, 
115L, 82L, 132L, 139L, 88L, 85L, 80L, 74L, 125L, 68L, 84L, 60L, 
60L, 78L, 88L, 110L, 95L, 64L, 68L, 67L, 88L, 90L), acc = c(14.9, 
17.2, 18.1, 15, 17.3, 14.4, 14.5, 15.8, 14.5, 13.2, 13.2, 13.2, 
14.7, 14.5, 14.3, 17.3, 14.4, 12.6, 13.4, 15.2, 16.9, 19.9, 11.3, 
16.2, 18.7, 13, 20.7, 19.2, 19.2, 15.8, 14.9, 19.2, 22.2, 14.9, 
16.2, 17.3, 23.7, 13, 14.2, 18.6, 13.2, 14.9, 14.8, 20.1, 16.8, 
18.2, 15.4, 15.8, 15.1, 16.7, 14.4, 18, 18.7, 18.3, 16.5, 16.9, 
14.7, 16.5, 24.6, 15.2, 19.6, 14.9, 16, 15.7, 15.7, 17.4, 19.4, 
20.1, 17.5, 12.5, 16.7, 15, 11.6, 16.4, 13.2, 16.2, 21.5, 17.3, 
21.7, 16.6, 17.1, 14, 16, 13.9, 13.8, 13.8, 16.4, 24.8, 21.8, 
14.8, 18, 18.2, 13.6, 18.2, 18.2, 15.5, 14.7, 12.9, 14.7, 15.2, 
14.4, 17.2, 14.5, 16.4, 13.4, 19, 12.8, 15.4, 19.4, 15.8, 15.5, 
15.6, 17.6, 12.6, 13.7, 14.7, 17, 15.7, 17.9, 18.6, 14.4, 17.6, 
18.6, 16.4, 15.3, 18, 15.9, 12.9, 19.4, 11.4, 11.2, 19.6, 17, 
20.4, 15.3, 15, 16.6, 16.4, 18.8, 16.1, 15.8, 15.4, 16.6, 14.2, 
16.4, 16, 15, 15.1, 15.5), yr = structure(c(2L, 1L, 3L, 2L, 5L, 
3L, 5L, 4L, 5L, 1L, 2L, 2L, 2L, 5L, 2L, 2L, 4L, 4L, 1L, 2L, 4L, 
3L, 2L, 5L, 3L, 2L, 4L, 1L, 3L, 1L, 1L, 2L, 2L, 1L, 5L, 4L, 3L, 
5L, 4L, 5L, 2L, 2L, 4L, 2L, 4L, 5L, 2L, 1L, 1L, 1L, 2L, 5L, 1L, 
4L, 3L, 5L, 5L, 1L, 5L, 2L, 4L, 4L, 5L, 4L, 5L, 2L, 4L, 3L, 3L, 
3L, 1L, 3L, 5L, 3L, 1L, 4L, 1L, 5L, 3L, 4L, 4L, 2L, 2L, 5L, 3L, 
4L, 5L, 2L, 3L, 1L, 3L, 2L, 1L, 2L, 1L, 3L, 1L, 4L, 3L, 3L, 1L, 
1L, 1L, 1L, 2L, 4L, 1L, 2L, 1L, 1L, 1L, 5L, 1L, 4L, 1L, 5L, 3L, 
1L, 3L, 5L, 4L, 5L, 1L, 5L, 3L, 5L, 1L, 2L, 5L, 3L, 1L, 5L, 5L, 
4L, 5L, 2L, 1L, 4L, 3L, 4L, 3L, 1L, 2L, 1L, 4L, 4L, 5L, 3L, 3L
), .Label = c("78", "79", "80", "81", "82"), class = "factor"), 
    wgt = c(4360L, 3210L, 2870L, 2670L, 2125L, 2800L, 2160L, 
    3415L, 2205L, 3425L, 2556L, 3955L, 2130L, 2585L, 4054L, 2890L, 
    2620L, 2725L, 3445L, 3830L, 1755L, 2950L, 2595L, 1995L, 3381L, 
    3940L, 2380L, 3535L, 2110L, 2965L, 2405L, 2020L, 3420L, 1990L, 
    2575L, 2050L, 2335L, 2370L, 2190L, 2625L, 2200L, 2150L, 2615L, 
    3530L, 2350L, 2025L, 3245L, 3410L, 3410L, 3070L, 1915L, 2395L, 
    3620L, 2635L, 2678L, 2245L, 2125L, 2155L, 2130L, 1975L, 3160L, 
    2215L, 2525L, 2490L, 1965L, 3900L, 1975L, 3003L, 2542L, 2420L, 
    2745L, 2434L, 2295L, 2019L, 3735L, 2045L, 1985L, 2950L, 2085L, 
    3465L, 3060L, 1925L, 2670L, 2665L, 1850L, 2930L, 2865L, 3190L, 
    3250L, 2515L, 2145L, 2990L, 3140L, 3265L, 3155L, 2120L, 2300L, 
    2385L, 2144L, 2265L, 1800L, 3430L, 2230L, 1800L, 3725L, 3725L, 
    3570L, 3840L, 1985L, 3380L, 3365L, 2790L, 2855L, 2900L, 4080L, 
    2835L, 2290L, 2795L, 2110L, 2640L, 2210L, 1970L, 2070L, 2945L, 
    1845L, 2735L, 2830L, 2700L, 2720L, 2910L, 3205L, 2605L, 3015L, 
    3230L, 1980L, 3605L, 2135L, 2635L, 1968L, 1760L, 2188L, 2720L, 
    3360L, 2560L, 1875L, 1985L, 1965L, 2500L, 2711L), ori = structure(c(3L, 
    3L, 3L, 3L, 3L, 3L, 2L, 3L, 2L, 3L, 3L, 3L, 1L, 3L, 3L, 3L, 
    3L, 3L, 3L, 3L, 2L, 1L, 3L, 2L, 3L, 3L, 3L, 3L, 2L, 3L, 2L, 
    2L, 3L, 1L, 3L, 2L, 1L, 3L, 1L, 3L, 3L, 3L, 2L, 1L, 2L, 2L, 
    3L, 1L, 3L, 3L, 3L, 3L, 3L, 2L, 3L, 2L, 3L, 3L, 1L, 2L, 1L, 
    3L, 3L, 3L, 2L, 3L, 2L, 3L, 2L, 2L, 3L, 2L, 3L, 2L, 3L, 3L, 
    1L, 3L, 1L, 3L, 3L, 1L, 3L, 2L, 2L, 2L, 3L, 1L, 1L, 2L, 2L, 
    3L, 1L, 3L, 3L, 3L, 2L, 3L, 1L, 2L, 3L, 3L, 3L, 2L, 3L, 3L, 
    3L, 3L, 2L, 3L, 3L, 3L, 3L, 2L, 3L, 3L, 2L, 1L, 2L, 3L, 2L, 
    2L, 2L, 3L, 1L, 3L, 1L, 3L, 3L, 2L, 3L, 3L, 3L, 1L, 1L, 3L, 
    2L, 3L, 2L, 2L, 1L, 3L, 3L, 2L, 3L, 2L, 2L, 1L, 2L), .Label = c("Europe", 
    "Japan", "USA"), class = "factor"), make = structure(c(3L, 
    1L, 10L, 1L, 14L, 8L, 15L, 3L, 11L, 5L, 19L, 14L, 9L, 6L, 
    10L, 10L, 8L, 5L, 3L, 8L, 22L, 2L, 5L, 7L, 8L, 6L, 10L, 19L, 
    7L, 10L, 7L, 7L, 16L, 24L, 19L, 22L, 24L, 8L, 24L, 10L, 18L, 
    18L, 7L, 13L, 22L, 12L, 19L, 17L, 1L, 14L, 8L, 5L, 8L, 12L, 
    5L, 22L, 18L, 5L, 24L, 12L, 25L, 18L, 8L, 18L, 11L, 4L, 7L, 
    1L, 12L, 12L, 18L, 7L, 8L, 7L, 8L, 10L, 24L, 5L, 24L, 6L, 
    10L, 24L, 3L, 22L, 11L, 7L, 10L, 17L, 13L, 22L, 21L, 14L, 
    25L, 1L, 5L, 5L, 7L, 18L, 24L, 22L, 10L, 18L, 8L, 11L, 10L, 
    16L, 14L, 5L, 12L, 3L, 16L, 10L, 16L, 22L, 8L, 10L, 11L, 
    20L, 12L, 5L, 11L, 12L, 7L, 3L, 24L, 19L, 2L, 16L, 5L, 7L, 
    10L, 5L, 16L, 17L, 24L, 5L, 11L, 3L, 22L, 11L, 2L, 10L, 8L, 
    22L, 18L, 12L, 11L, 23L, 22L), .Label = c("AMC", "Audi", 
    "Buick", "Cadillac", "Chevrolet", "Chrysler", "Datsun", "Dodge", 
    "Fiat", "Ford", "Honda", "Mazda", "Mercedes", "Mercury", 
    "Nissan", "Oldsmobile", "Peugeot", "Plymouth", "Pontiac", 
    "Saab", "Subaru", "Toyota", "Triumph", "Volkswagen", "Volvo"
    ), class = "factor"), mod = structure(c(67L, 48L, 68L, 116L, 
    90L, 46L, 118L, 35L, 22L, 95L, 99L, 81L, 121L, 86L, 55L, 
    69L, 25L, 40L, 108L, 117L, 120L, 13L, 40L, 10L, 26L, 87L, 
    65L, 99L, 4L, 70L, 2L, 4L, 57L, 113L, 1L, 122L, 60L, 38L, 
    85L, 107L, 82L, 84L, 3L, 8L, 51L, 76L, 88L, 18L, 49L, 125L, 
    47L, 32L, 26L, 19L, 40L, 51L, 82L, 39L, 100L, 78L, 61L, 83L, 
    24L, 109L, 41L, 64L, 4L, 48L, 19L, 110L, 112L, 17L, 106L, 
    9L, 62L, 66L, 104L, 29L, 104L, 86L, 79L, 103L, 115L, 34L, 
    45L, 20L, 68L, 14L, 5L, 34L, 63L, 126L, 6L, 50L, 92L, 39L, 
    16L, 109L, 102L, 51L, 72L, 124L, 98L, 42L, 89L, 59L, 94L, 
    30L, 78L, 35L, 57L, 96L, 119L, 56L, 91L, 80L, 22L, 21L, 74L, 
    33L, 101L, 77L, 28L, 36L, 102L, 99L, 12L, 97L, 111L, 7L, 
    73L, 31L, 58L, 15L, 105L, 93L, 23L, 114L, 52L, 44L, 11L, 
    71L, 27L, 53L, 37L, 75L, 43L, 123L, 54L), .Label = c("1200_Hatch", 
    "200_SX", "200SX", "210", "240D", "264GL", "280_ZX", "300D", 
    "310", "310_GX", "4000", "5000", "5000S_Dl", "504", "505S_Dl", 
    "510", "510_Hatch", "604SL", "626", "810_Maxima", "99GLE", 
    "Accord", "Accord_LX", "Aries_SE", "Aries_SW", "Aspen", "Aspen_6", 
    "B210_GX", "Camaro", "Caprice_Cl", "Cavalier", "Cavalier2D", 
    "CavalierSW", "Celica_GT", "Century", "CenturyLmt", "Champ", 
    "Charger2_2", "Chevette", "Citation", "Civic_A", "Civic_CVCC", 
    "Civic_M", "Civic1300", "Civic1500G", "Colt", "Colt_Hatch", 
    "Concord", "Concord_D1", "ConcordDL6", "Corolla", "CorollaTer", 
    "Corona", "Corona_LB", "Country_SW", "Cressida", "Cutlass", 
    "Cutlass_Dl", "Cutlass_LS", "Dasher_Dl", "Diesel", "Diplomat", 
    "DL", "Eldorado", "Escort_2H", "Escort_4W", "Estate_SW", 
    "Fairmont", "Fairmont_4", "Fairmont_A", "Fairmont_M", "Fiesta", 
    "Futura", "GLC", "GLC_4", "GLC_Cust_l", "GLC_Custom", "GLC_Deluxe", 
    "Granada_GL", "Granada_l", "GrandMarqs", "Horizon", "Horizon_4", 
    "HorizonTC3", "Jetta", "Lebaron", "Lebaron_SW", "Lemans_V6", 
    "LTD_Landau", "Lynx_l", "Magnum_XE", "Malibu", "Malibu_SW", 
    "Monarch", "MonteCarlo", "MustangGL", "Omega", "Omni", "Phoenix", 
    "Pickup", "Prelude", "Rabbit", "Rabbit_Cus", "Rabbit_Dl", 
    "Rabbit_L", "Rampage", "Ranger", "RegalTurbo", "Reliant", 
    "RX_7_GS", "S_10", "Sapporo", "Scirocco", "Skylark", "SkylarkLim", 
    "Spirit_DL", "St__Regis", "Stanza_XE", "Starfire", "Starlet", 
    "Strada_Cus", "Tercel", "TR7_Coupe", "Volare", "Zephyr", 
    "Zephyr_6"), class = "factor"), prc = c(5225L, 2300L, 3525L, 
    2725L, 4550L, 3200L, 6350L, 6675L, 6500L, 3900L, 3325L, 5725L, 
    2275L, 6000L, 4825L, 2975L, 4950L, 4550L, 4400L, 4025L, 4400L, 
    7975L, 3625L, 5075L, 3700L, 4725L, 4100L, 2800L, 3300L, 2375L, 
    2975L, 2750L, 4050L, 3675L, 5650L, 4475L, 3825L, 5475L, 5650L, 
    4925L, 2625L, 2775L, 5825L, 15475L, 4650L, 4900L, 3925L, 
    5450L, 2425L, 2425L, 2700L, 5175L, 2700L, 5650L, 3625L, 5425L, 
    4350L, 2100L, 5075L, 2750L, 8550L, 3450L, 6250L, 5100L, 4875L, 
    9900L, 3775L, 3625L, 4675L, 7250L, 3200L, 4050L, 5650L, 3525L, 
    3125L, 3850L, 2400L, 8400L, 3900L, 5625L, 5450L, 3100L, 3525L, 
    7700L, 3925L, 8375L, 5225L, 4675L, 14275L, 3700L, 3625L, 
    3200L, 5875L, 3150L, 3275L, 2900L, 2775L, 4900L, 7000L, 3975L, 
    1900L, 2700L, 2250L, 2250L, 4850L, 6875L, 2850L, 4650L, 2200L, 
    3300L, 3300L, 5975L, 2400L, 9475L, 3000L, 6100L, 4700L, 4200L, 
    3350L, 5500L, 5550L, 5100L, 2725L, 7300L, 7000L, 5650L, 4475L, 
    3525L, 6050L, 8150L, 2525L, 5275L, 7450L, 8500L, 5200L, 4100L, 
    3425L, 5175L, 3850L, 4000L, 5900L, 2275L, 3325L, 2975L, 3600L, 
    3975L, 4625L, 5000L, 5500L)), .Names = c("mpg", "cyl", "dsp", 
"hp", "acc", "yr", "wgt", "ori", "make", "mod", "prc"), class = "data.frame", row.names = c("1", 
"2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", 
"14", "15", "16", "17", "18", "19", "20", "21", "22", "23", "24", 
"25", "26", "27", "28", "29", "30", "31", "32", "33", "34", "35", 
"36", "37", "38", "39", "40", "41", "42", "43", "44", "45", "46", 
"47", "48", "49", "50", "51", "52", "53", "54", "55", "56", "57", 
"58", "59", "60", "61", "62", "63", "64", "65", "66", "67", "68", 
"69", "70", "71", "72", "73", "74", "75", "76", "77", "78", "79", 
"80", "81", "82", "83", "84", "85", "86", "87", "88", "89", "90", 
"91", "92", "93", "94", "95", "96", "97", "98", "99", "100", 
"101", "102", "103", "104", "105", "106", "107", "108", "109", 
"110", "111", "112", "113", "114", "115", "116", "117", "118", 
"119", "120", "121", "122", "123", "124", "125", "126", "127", 
"128", "129", "130", "131", "132", "133", "134", "135", "136", 
"137", "138", "139", "140", "141", "142", "143", "144", "145", 
"146", "147", "148", "149"))
#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/mergeRfiles.R"
"mergeRfiles" <- function (from = getwd(), ext = "R", name) 
{
    cat("Merging files of type .",ext,"from", from, "\n")
    cat("Continue: (y/n) >>  ")
    z <- readLines(n=1)
    if (z=="y" || z=="Y") rm(list=ls(pos=parent.frame()),envir=parent.frame())
    else return()
    if (missing (name)) name <- "ALL"
    shell(paste("ls *.",ext,sep=""),invis=T,intern=T)
    shell(paste("copy *.",ext," all.", ext,sep=""),invis=T,intern=T)
    shell(paste("rm *.",ext,sep=""),invis=T,intern=T)  
    shell(paste("rename all.",ext," ",name,".",ext,sep=""),invis=T,intern=T)  

}
#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/model.cv.R"
"model.cv" <-
function (formula = formula(data), data = list(), FUN = lm,
    seed = 0, ngrp = 5, grp.col = 0, silent = TRUE, type = c("mse",
        "missclass"), ...)
{
    cv.var <- function(x, cv = 10) {
        x <- number(x)
        maxx <- max(x)
        if (maxx >= cv) {
            x <- match(x, sample(maxx))
            grps <- ceiling((cv * cumsum(table(x)))/length(x))
            x <- number(grps[x])
        }
        x
    }
    lst <- list()
    nrows <- nrow(data)
    if (seed > 0)
        set.seed(seed)
    if (grp.col == 0)
        nsamps <- sample(rep(1:ngrp, length = nrows))
    else {
        nsamps <- cv.var(data[, grp.col], ngrp)
        if (!silent)
            print(table(nsamps, data[, grp.col]))
    }
    preds <- rep(NA, length = nrows)
    for (i in 1:ngrp) {
        nTrain <- length(trainees <- (1:nrows)[nsamps != i])
        non.trainees <- (1:nrows)[is.na(match(1:nrows, trainees))]
        if (grp.col == 0) {
            temp.data <- data[trainees, ]
            lst[[i]] <- FUN(formula, data = temp.data, ...)
        }
        else {
            temp.data <- data[trainees, -grp.col]
            lst[[i]] <- FUN(formula, data = temp.data, ...)
        }
        preds[non.trainees] <- predict(lst[[i]], newdata = data[non.trainees,
            ])
    }
    lst[[1]]$nsamps <- nsamps
    lst[[1]]$preds <- preds
    resp <- eval(formula[[2]],data)
    if (type[1] == "mse")
         lst[[1]]$pmse <- mean((resp - lst[[1]]$preds)^2,
                na.rm = T)
    else {
            tab <- table(resp, lst[[1]]$preds > 0)
            lst[[1]]$pmse <- 1 - sum(diag(tab))/sum(tab)
    }
    lst
}

#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/model.cv.lst.R"
"model.cv.lst" <-
function(form.lst, data = list(), nsims = 5,  FUN = lm, seed = 0,
     ngrp = 5, grp.col = 0, ret.preds = FALSE, silent = TRUE, prn=FALSE, ...)
{
    nf <- length(form.lst)
    res <- matrix(NA, nrow = nsims, ncol = nf)
    seeds <- sample(1e5,nsims)
    for (i in 1:nf){
    for (j in 1:nsims){
    res[j,i] <- model.cv(form.lst[[i]], data=data, seed = seeds[j], ...)
    }
    }
    ress <- apply(res,2,mean)
    ress <- matrix(ress,ncol=1)
    dimnames(ress) <-list(form.lst,"MSPE")
    cat("Mean square predicted errors : \n")
    print(signif(ress,4))
    invisible(ress)
}

#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/model.cv.ss.R"
"model.cv.ss" <-
function(formula = formula(data), data = list(), FUN = lm, seed = 0,
    ngrp = 5, grp.col = 0, ret.preds = FALSE, silent = TRUE, prn=FALSE, ...)
    {
    cv.var <- function(x, cv = 10)
    {
        x <- number(x)
        maxx <- max(x)
        if(maxx >= cv) {
            x <- match(x, sample(maxx))
            grps <- ceiling((cv * cumsum(table(x)))/length(x))
            x <- number(grps[x])
        }
        x
    }
    fit <- FUN(formula, data, y = TRUE)
    if (prn) print(anova(fit))
    y <- fit$y
    nrows <- nrow(data)
    if(seed > 0)
        set.seed(seed)
    if(grp.col == 0)
        nsamps <- sample(rep(1:ngrp, length = nrows))
    else {
        nsamps <- cv.var(data[, grp.col], ngrp)
        if(!silent)
            print(table(nsamps, data[, grp.col]))
    }
    preds <- rep(NA, length = nrows)
    for(i in 1:ngrp) {
        nTrain <- length(trainees <- (1:nrows)[nsamps != i])
        non.trainees <- (1:nrows)[is.na(match(1:nrows, trainees))]
        if(grp.col == 0) {
            temp.data <- data[trainees,  ]
            lst <- FUN(formula, data = temp.data, singular=TRUE)
        }
        else {
            temp.data <- data[trainees,  - grp.col]
            lst <- FUN(formula, data = temp.data, singular=TRUE)
        }
        preds[non.trainees] <- predict(lst, newdata = data[non.trainees,  ])
    }
    perr<-mean((y-preds)^2)
    if (prn) cat("Mean square predicted error = ",signif(perr,4),"\n")
    if (ret.preds) data.frame(y,preds) else perr
}

#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/mpoly.in.R"
"mpoly.in" <-
function(xys, polys) {
      ids <- cumsum(nas <- is.na(polys[,1])) + 1
      polys <-polys[!nas,]
      ids <- ids[!nas]
      nids <- max(ids)
      polys.lst <- lapply(split(polys,ids),matrix,ncol=2)
      res <- matrix(NA, nrow=nrow(xy), ncol=nids)
      for (i in 1:nids) {
      res[,i] <- poly.in(xys,polys.lst[[i]])
      }
      odd(apply(res,1,sum))
}

#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/mvdata.sim.R"
mvdata.sim <- 
function (n = 1000, nvar = 4, mu = 10, Sig = runif(length(nvar)^2), 
    degree = 4, coefs = seq(1, 0.1, length = degree), scale = T, 
    err = 0.1, noise.vars = 0, b.scale = 1, binary = FALSE) 
{
    if (length(mu) == 1) 
        mu <- rep(mu, nvar)
    Sig <- matrix(Sig, ncol = nvar, nrow = nvar)
    diag(Sig) <- rep(1, nvar)
    x <- mvrunif(n, mu, Sig)
    x <- poly(x, degree = degree)
    deg <- attr(x, "degree")
    if (scale) 
        x <- scale(x)
    y <- x %*% (runif(length(deg), -1, 1) * coefs[deg])
    x <- x[, deg == 1, drop = F]
    if (noise.vars) 
        x <- cbind(x, matrix(rnorm(noise.vars * n), nrow = n))
    colnames(x) <- paste("x", 1:(nvar + noise.vars), sep = "")
    if (binary) {
        y <- y/sd(y) * b.scale
        ye <- rbinom(length(y), 1, 1/(1 + exp(-y)))
        data.frame(ye, y, x)
    }
    else {
        if (err) {
            err <- 1/(1/err - 1)
            y <- y/(sqrt(err) * sqrt(var(drop(y))))
            ye <- y + rnorm(n)
            data.frame(ye, y, x)
        }
        else data.frame(y, x)
    }
}
#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/mvdata.sim2.R"
"mvdata.sim2" <-
function (n = 1000, nvar = 4, degree = 2,
    coefs = seq(1, 0.1, length = degree), scale = T, 
    err = 0.1, noise.vars = 0, b.scale = 1, binary = FALSE) 
{
    x <- matrix(runif(n*nvar),ncol=nvar)
    x <- poly(x, degree = degree)
    deg <- attr(x, "degree")
    if (scale) 
        x <- scale(x)
    y <- x %*% (runif(length(deg), -1, 1) * coefs[deg])
    x <- x[, deg == 1]
    if (noise.vars) 
        x <- cbind(x, matrix(rnorm(noise.vars * n), nrow = n))
    colnames(x) <- paste("x", 1:(nvar + noise.vars), sep = "")
    if (binary) {
        y <- y/sd(y) * b.scale
        ye <- rbinom(length(y), 1, 1/(1 + exp(-y)))
        data.frame(ye, y, x)
    }
    else {
        if (err) {
            err <- 1/(1/err - 1)
            y <- y/(sqrt(err) * sqrt(var(drop(y))))
            ye <- y + rnorm(n)
            data.frame(ye, y, x)
        }
        else data.frame(y, x)
    }
}

#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/mvrunif.R"
"mvrunif" <-
function (n = 1, mu, Sigma, tol = 1e-06, empirical = FALSE) 
{
    p <- length(mu)
    if (!all(dim(Sigma) == c(p, p))) 
        stop("incompatible arguments")
    eS <- eigen(Sigma, sym = TRUE, EISPACK = TRUE)
    ev <- eS$values
    if (!all(ev >= -tol * abs(ev[1]))) 
        stop("Sigma is not positive definite")
    X <- matrix(runif(p * n), n)
    if (empirical) {
        X <- scale(X, TRUE, FALSE)
        X <- X %*% svd(X, nu = 0)$v
        X <- scale(X, FALSE, TRUE)
    }
    X <- drop(mu) + eS$vectors %*% diag(sqrt(pmax(ev, 0)), p) %*% 
        t(X)
    nm <- names(mu)
    if (is.null(nm) && !is.null(dn <- dimnames(Sigma))) 
        nm <- dn[[1]]
    dimnames(X) <- list(nm, NULL)
    if (n == 1) 
        drop(X)
    else t(X)
}

#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/n.plt.R"
"n.plt" <-
function(n) {
        if (n == 1)
            m <- c(1, 1)
        else if (n == 2)
            m <- c(1, 2)
        else if (n <= 4)
            m <- c(2, 2)
        else if ((n > 4) & (n <= 6))
            m <- c(2, 3)
        else if ((n > 6) & (n <= 9))
            m <- c(3, 3)
        else if ((n > 9) & (n <= 12))
            m <- c(3, 4)
        else if ((n > 9) & (n <= 16))
            m <- c(4, 4)
        else m <- c(5, 5)
        m
}
#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/narrowMatrix.R"
`narrowMatrix` <-
function (data, ccols, cols, new.col.names, strip0 = T) 
{
    ncols <- length(cols)
    nrows <- nrow(data)
    X <- data[rep(1:nrows, rep(ncols, nrows)),ccols, drop = F]
    Y <- rep(colnames(data)[cols], nrows)
    V <- c(t(as.matrix(data[, cols])))
    M <- data.frame(X, Y, V)
    if (strip0) 
        M <- M[M[, ncol(M)] != 0, ]
    if (!missing(new.col.names)) 
        names(M) <- new.col.names
    else names(M) <- c(colnames(data)[ccols],"y","vals")
    M
}
#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/nearGeo.R"
nearGeo <- function (xx, yy) {
    require(sp)
    x <- as.matrix(xx[, c("long","lat"),drop=F])
    y <- as.matrix(yy[, c("long","lat"),drop=F])
    nx <- nrow(x)
    ny <- nrow(y)
    pos <- rep(NA, nx)
    min.dist <- rep(NA, nx)
    for (i in 1:nx) {
		dist <- spDistsN1(y, x[i,,drop=F], longlat=TRUE)
        min.dist[i] <- min(dist, na.rm = T)
        pos[i] <- ((1:ny)[dist == min.dist[i]])[1]
    }
    cat("Summary of min distances :\n")
    print(summary(min.dist))
    data.frame(xx, yy[pos, ,drop=F], min.dist)
}



#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/nearest.R"
"nearest" <-
function(xx, yy, mindsq = 0.1)
{
    x <- xx[, c("lat", "long")]
    y <- yy[, c("lat", "long")]
    mindsq <- mindsq^2
    nx <- nrow(x)
    ny <- nrow(y)
    pos <- rep(NA, nx)
    min.dist <- rep(NA, nx)
    for(i in 1:nx) {
        distsq <- signif((x[i, 1] - y[, 1])^2 + (x[i, 2] - y[, 2])^2, 5)
        min.dist[i] <- min(distsq, na.rm = T)
        if(min.dist[i] < mindsq)
            pos[i] <- ((1:ny)[distsq == min.dist[i]])[1]
    }
    mindist <- sqrt(min.dist)
    cat("Summary of min distances :\n")
    print(summary(min.dist))
    data.frame(xx, yy[pos,  ], min.dist)
}

#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/number.R"
"number" <-
function (x) {
    match(x, sort(unique(x)))
}

#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/obsizes.R"
"obsizes" <- function () {
    sapply(ls(pos = 1), function(x) object.size(get(x)))
}
#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/odd.R"
"odd" <-
function (x)
x != as.integer(x/2) * 2

#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/pcsim.xx.R"
"pcsim.xx" <-
function (p = 10, n = 100, nx = 5, FUN = apply(x, 1, sum), strip0 = T, 
    extreme = 0, complex = F, ret = T, d.rand = T, mu.rand = T, 
    s = (4:8)/10, amp = c(15, 20, 10, 5, 25), lst = F, err = 1, 
    err.type = "p", f = 0.25, eps = 1e-05, beta.div = 1, plotit = T, 
    ptype = "l", invert = 0, sd = 3, trim = F, add.rug = F, lin = F, 
    as.df = T, ...) 
{
    if (!missing(s) && length(s) == 1) 
        s <- rep(s, 5)
    s <- s * beta.div
    if (!missing(amp) && length(amp) == 1) 
        amp <- rep(amp, 5)
    x <- matrix(NA, nrow = n, ncol = p + nx)
    xs <- matrix(NA, nrow = n, ncol = p + nx)
    rowins <- rep(T, p + 1)
    colins <- rep(T, p + 1)
    if (d.rand) 
        dd <- matrix(runif(nx * n, 0, 1), nrow = n)
    else dd <- matrix((0:(nx - 1))/(nx - 1), nrow = n)
    d <- FUN(dd)
    if (mu.rand) {
        if (!extreme) 
            mu <- runif(p, 0, 1)
        else mu <- runif(p, -0.1, 1.1)
    }
    else if (!extreme) 
        mu <- (0:(p - 1))/(p - 1)
    else mu <- (0:(p - 1))/(p - 1) * extreme - extreme/2 + 0.5
    k <- sample(1:5, p, replace = T)
    l <- sample(1:5, p, replace = T)
    if (complex) {
        invert <- 0.5
        ni <- round(invert * p)
        inv <- c(rep(1, ni), rep(0, p - ni))[sample(p)]
    }
    else inv <- rep(0, p)
    for (i in 1:p) {
        if (!err) {
            x[, i + nx] <- amp[l[i]] * exp(-0.5 * ((d - mu[i])/s[k[i]])^2)
            if (trim) 
                x[abs((d - mu[i])/s[k[i]]) > sd, i + nx] <- 0
            if (inv[i] == 1) 
                x[, i + nx] <- max(x[, i + nx]) - x[, i + nx]
        }
        else {
            xs[, i + nx] <- amp[l[i]] * exp(-0.5 * ((d - mu[i])/s[k[i]])^2 + 
                eps)
            if (inv[i] == 1) 
                xs[, i + nx] <- max(xs[, i + nx]) - xs[, i + 
                  nx] + eps
            if (err.type == "p") 
                x[, i + nx] <- rpois(n, xs[, i + nx])
            else if (err.type == "n") 
                x[, i + nx] <- xs[, i + nx] + err * rnorm(n, 
                  0, 1)
        }
        NULL
    }
    if (lin) {
        for (i in 1:p) {
            x[, i + nx] <- 10 + rnorm(1, 0, 3) * d
            if (err) 
                x[, i + nx] <- x[, i + nx] + err * rnorm(n, 0, 
                  1)
            NULL
        }
    }
    if (complex) {
        yfit <- diag(ifelse(apply(x[, -c(1:nx)], 1, sum) == 0, 
            1, 50/apply(x[, -c(1:nx)], 1, sum)))
        x[, -c(1:nx)] <- yfit %*% x[, -c(1:nx)]
    }
    x[, 1:nx] <- d
    if (strip0) {
        rowins <- apply(x[, -c(1:nx)], 1, sum) != 0
        x <- x[rowins, ]
        xs <- xs[rowins, ]
        colins <- c(T, (apply(x[, c(1:nx)], 2, sum) != 0))
        x <- x[, colins]
        xs <- xs[, colins]
    }
    x <- cbind(d, x)
    xs <- cbind(d, xs)
    ord <- order(x[, 1])
    x <- x[ord, ]
    xs <- xs[ord, ]
    dimnames(x) <- list(as.character(1:length(x[, 1])), c("Gradient", 
        paste("Env", 1:nx, sep = "."), paste("Taxa", 1:p, sep = ".")))
    dimnames(xs) <- dimnames(x)
    if (plotit) {
        z <- rev(order(x[, 1]))
        matplot(x[z, 1], as.matrix(x[z, -c(1:(nx + 1))]), type = ptype, 
            lty = 1, col = 1:5, xlab = "Locations", ylab = "Response", 
            main = "Simulated Data")
        if (add.rug) 
            rug(x[z, 1], side = 3)
    }
    if (ret) {
        if (lst) 
            list(x = x, xs = xs, sigma = s[k[1:p]][colins[-1]], 
                amp = amp[l[1:p]][colins[-1]], mu = mu[1:p][colins[-1]])
        else if (as.df) 
            data.frame(x)
        else x
    }
}
#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/pintol.R"
`pintol` <-
function (formula, data, outer = TRUE, pts = T, xlab, ylab, log = "", 
    amany = 4, bmany = 4, reset.par = TRUE, bolap = 0.25, rc, nint = 50,
    omar = c(5, 5, 1, 1), mgap = 3, texts, col = rep(2:16,10), 
	cext = 1, cexl = 1, cexm = rep(1, length(y)), cexbub = 1, 
    bg = rep(2:16,10), delta = 0.2, reg = F, regz = F, 
	regtype = c("glm", "loess", "gam")[1], cvreg = T, se = 0, ci.cov = 0.95, 
    df = 1, minpts = 4, lo.span = 0.75, lo.degree = 1, lin = F, 
    linz = F, means = F, test.type = c("F", "Chi", "Cp")[1], 
    xaxis.all = F, yaxis.all = F, meansz = F, grid = F, ngrid = 4, 
    hline, vline, line = F, leg = F, leg.auto = F, leg.loc = c(0,1), 
	pch = 1, main = "", bty = "o", xlim, ylim, xlim.free = FALSE, 
    ylim.free = FALSE, ylim.adj = c(0, 0), xlim.adj = c(0, 0), 
    ylim.wide = 1, xlim.wide = 1, plot.gap = c(0, 0), lwd = 1, 
    lwdf = 1, jit = F, jit.factor = 1, ucol = T, ulinecol = 11, 
    err = F, hi, lo, use.spread = F, spread = 0, gap = 1, bar.ends = 1, 
    fit.linear = F, fit.smooth = F, ret.fit = F, diag.fit = F, head, 
    ...) 
{

	require(splines)
	require(mgcv)

	sem <- function (y, na.rm = TRUE) {
		if (na.rm) 
		    y <- y[!is.na(y)]
		if (length(y)) 
		    sqrt(var(y)/length(y))
	    else NA
	}

    mean.na <- function(x) mean(x, na.rm=T)

    xpand <- function(x, delta = 0.05) {
        xrnge <- range(as.numeric(x))
        xdiff <- delta * diff(xrnge)
        xrnge + xdiff * c(-1, 1)
    }

    deparen <- function(expr) {
        while (is.language(expr) && !is.name(expr) && deparse(expr[[1]]) == 
            "(") expr <- expr[[2]]
        expr
    }

	equal.count <- function(x, ...) {
		attr(x, "levels") <- make.list.from.intervals(co.intervals(x,  ...))
		class(attr(x, "levels")) <- "shingleLevel"
		class(x) <- "shingle"
		x
	}
	make.list.from.intervals <- function (x) {
		if (ncol(x) != 2) 
		    stop("x must be matrix with 2 columns")
		ans <- vector(mode = "list", length = nrow(x))
		for (i in seq_len(nrow(x))) ans[[i]] <- x[i, ]
    ans
	}

    bad.formula <- function() stop("invalid conditioning formula")
    bad.lengths <- function() stop("incompatible variable lengths")

    old.par <- par(no.readonly = TRUE)
    if (reset.par) 
        on.exit(par(old.par))

    if (is.null(dev.list())) {
		if (.Platform$OS.type == "unix") x11()
		else windows()
	}
    formula <- deparen(formula)
    if (!inherits(formula, "formula")) 
        bad.formula()
    y <- deparen(formula[[2]])
    rhs <- deparen(formula[[3]])
    if (length(rhs) == 1) {
        x <- deparen(rhs)
        have.a <- have.b <- FALSE
    }
    else {
        x <- deparen(rhs[[2]])
        rhs <- deparen(rhs[[3]])
        if (is.language(rhs) && !is.name(rhs) && (deparse(rhs[[1]]) == 
            "*" || deparse(rhs[[1]]) == "+")) {
            have.b <- TRUE
            have.a <- TRUE
            a <- deparen(rhs[[2]])
            b <- deparen(rhs[[3]])
        }
        else if (outer) {
            have.a <- FALSE
            have.b <- TRUE
            b <- rhs
        }
        else {
            have.b <- FALSE
            have.a <- TRUE
            a <- rhs
        }
    }
    if (missing(data)) 
        data <- parent.frame()
    x.name <- deparse(x)
    x <- eval(x, data, parent.frame())
    nobs <- length(x)
    y.name <- deparse(y)
    y <- eval(y, data, parent.frame())
    if (length(y) != nobs) 
        bad.lengths()
    if (have.a) {
        a.name <- deparse(a)
        a <- eval(a, data, parent.frame())
        if (length(a) != nobs) 
            bad.lengths()
        if (is.character(a)) 
            a <- as.factor(a)
    }
    if (have.b) {
        b.name <- deparse(b)
        b <- eval(b, data, parent.frame())
        if (length(b) != nobs) 
            bad.lengths()
        if (is.character(b)) 
            b <- as.factor(b)
        if (have.a) 
            missingrows <- which(is.na(x) | is.na(y) | is.na(a) | 
                is.na(b))
        else {
            missingrows <- which(is.na(x) | is.na(y) | is.na(b))
            a <- NULL
            a.name <- ""
        }
    }
    else if (have.a) {
        missingrows <- which(is.na(x) | is.na(y) | is.na(a))
        b <- NULL
        b.name <- ""
    }
    else {
        missingrows <- which(is.na(x) | is.na(y))
        a <- NULL
        a.name <- ""
        b <- NULL
        b.name <- ""
    }
    if (is.character(y)) 
        y <- as.factor(y)
    if (is.character(x)) 
        x <- as.factor(x)
    if (delta <= 0) {
        delta <- 0.1
        cat("\n delta must be > 0 : delta set to 0.1\n\n")
    }
    if (delta > 1) {
        delta <- 0.5
        cat("\n delta must be <= 1 : delta set to 0.5\n\n")
    }
    rtype <- c("gam", "glm", "loess")
    regtype <- rtype[pmatch(regtype, rtype)]
    fitted <- F
    blen <- 1
    bshing <- F
    if (have.b) {
        if (!is.factor(b) & is.numeric(b)) {
            ms <- equal.count(b, bmany, bolap)
            bshing <- T
            mainlabs <- rep("", bmany)
            for (i in 1:bmany) mainlabs[i] <- paste(b.name, " : ", 
                signif(attributes(ms)$levels[[i]][1], 3), " - ", 
                signif(attributes(ms)$levels[[i]][2], 3), sep = "")
            blen <- bmany
        }
        else {
            mainlabs <- buni <- levels(b)
            blen <- length(buni)
        }
    }
    if (length(cexm) == length(y)) 
        cexm <- sc01(cexm, cexbub, delta)
    if (length(cexm) == 1) 
        cexm <- rep(cexm, length(y))
    cexm <- cexm * par()$cex * 1.5
    cext <- cext * par()$cex
    cexl <- cexl * par()$cex
    if (have.a && (!is.factor(a)) && (is.numeric(a)) && length(unique(a)) >= 
        amany) 
        a <- cut(a, quantile(a, probs = seq(0, 1, 1/amany)), 
            include.lowest = T)
    if (outer & have.a & have.b) {
        na <- length(levels(a))
        nb <- length(levels(b))
        if (missing(rc)) 
            rc <- c(nb, na)
        b <- interaction(a, b)
        blen <- na * nb
        have.a <- FALSE
        a <- NULL
        a.name <- ""
        mainlabs <- buni <- levels(b)
    }
    if (have.b) {
        if (missing(rc)) 
            rc <- n.plt(blen)
        if (length(plot.gap) == 1) 
            plot.gap <- rep(plot.gap, 2)
        par(mfrow = rc, oma = omar, mar = c(0, 0, plot.gap[1], 
            plot.gap[2]))
        nrows <- rc[1]
        ncols <- rc[2]
    }
    else {
        nrows <- ncols <- 1
    }
    if (!is.null(a)) {
        if (missing(spread) & err) 
            spread <- 1
        lz <- length(auni <- levels(a))
        offset <- (spread * (0.5 * ((1:lz) - (lz + 1)/2)))/lz
        if (length(pch) == 1) 
            pch <- rep(pch, lz)
        if (length(col) == 1) 
            col <- rep(col, lz)
        if (length(bg) == 1) 
            bg <- rep(bg, lz)
        if (length(cexm) == 1) 
            cexm <- rep(cexm, lz)
    }
    if (missing(xlim)) 
        xlim <- xpand(x)
    if (missing(ylim)) {
        if (err & !missing(hi) & !missing(lo)) 
            ylim <- xpand(c(hi, lo))
        else if (err) 
            ylim <- xpand(c(y + err, y - err))
        else ylim <- xpand(y)
    }
    if (is.factor(x)) 
        xlim <- xlim + xlim.wide * c(-0.5, 0.5)
    if (is.factor(y)) 
        ylim <- ylim + ylim.wide * c(-0.5, 0.5)
    for (i in 1:blen) {
        if (nrows == 1 | xaxis.all) 
            row.axis <- T
        else row.axis <- ifelse(i > (nrows - 1) * ncols, T, F)
        if (ncols == 1 | yaxis.all) 
            col.axis <- T
        else col.axis <- ifelse((i%%ncols) == 1, T, F)
        if (blen != 1) {
            if (bshing) {
                limits <- attributes(ms)$levels[[i]]
                subset2 <- (b >= limits[1]) & (b <= limits[2])
                main <- mainlabs[i]
            }
            else {
                subset2 <- (b == buni[i])
                main <- mainlabs[i]
            }
        }
        else subset2 <- rep(T, length(y))
        yy <- y[subset2]
        if (length(yy) != 0) {
            if (is.factor(y)) 
                yy <- as.numeric(yy)
            xx <- x[subset2]
            if (is.factor(x)) 
                xx <- as.numeric(xx)
            cexmsub <- cexm[subset2]
            if (!is.null(a)) 
                zz <- a[subset2]
            ox <- order(xx)
            xx <- xx[ox]
            yy <- yy[ox]
            if (!missing(hi) & !missing(lo)) {
                hhi <- hi[subset2]
                llo <- lo[subset2]
                hhi <- hhi[ox]
                llo <- llo[ox]
            }
            cexmsub <- cexmsub[ox]
            if (!is.null(a)) 
                zz <- zz[ox]
            if (!is.null(a)) 
                ww <- zz
            if (xlim.free) 
                xlim <- range(as.numeric(xx)) + xlim.adj
            if (ylim.free) 
                ylim <- range(as.numeric(yy)) + ylim.adj
            plot(xx, yy, xlab = "", ylab = "", axes = F, type = "n", 
                bty = "none", cex.axis = cext, ylim = ylim, xlim = xlim, 
                log = log)
        }
        else {
            plot(0, 0, xlab = "", ylab = "", axes = F, type = "n", 
                bty = "none", cex.axis = cext, ylim = ylim, xlim = xlim, 
                log = log)
            cat("\n No data for this group \n\n")
        }
        box(bty = bty)
        if (grid) {
            if (missing(hline)) 
                hline <- pretty(ylim, ngrid)
            if (missing(vline)) 
                vline <- pretty(xlim, ngrid)
        }
        if (!missing(hline) || grid) 
            abline(h = hline, lty = 2, col = "grey")
        if (!missing(vline) || grid) 
            abline(v = vline, lty = 2, col = "grey")
        if (col.axis) {
            if (is.factor(y)) 
                axis(2, at = unique(sort(as.numeric(y))), labels = paste(levels(y), 
                  paste(rep(" ", max(nchar(levels(y)))), collapse = "")), 
                  cex.axis = cext)
            else axis(2, cex.axis = cext)
        }
        if (row.axis) {
            if (is.factor(x)) 
                axis(1, at = unique(sort(as.numeric(x))), labels = levels(x), 
                  cex.axis = cext)
            else axis(1, cex.axis = cext)
        }
        mtext(main, side = 3, -1.25, cex = cext)
        if (length(yy) != 0) {
            if (!is.null(a)) {
                for (i in 1:length(auni)) {
                  ins <- (zz == auni[i])
                  if (any(ins)) {
                    xxx <- xx[ins] + offset[i]
                    if (!err) 
                      if (!line & pts) 
                        if (!missing(texts)) 
                          if (jit) 
                            text(jitter(xxx, jit.factor), yy[ins], 
                              labels = pch[i], col = ifelse(ucol, 
                                col[i], ulinecol), cex = cexmsub[ins])
                          else text(xxx, yy[ins], labels = texts, 
                            col = ifelse(ucol, col[i], ulinecol), 
                            cex = cexmsub[ins])
                        else if (jit) 
                          points(jitter(xxx, jit.factor), yy[ins], 
                            col = ifelse(ucol, col[i], ulinecol), 
                            pch = pch[i], cex = cexmsub[ins], 
                            bg = bg)
                        else points(xxx, yy[ins], col = ifelse(ucol, 
                          col[i], ulinecol), pch = pch[i], cex = cexmsub[ins], 
                          bg = bg)
                      else if (line) 
                        lines(xxx, yy[ins], col = ifelse(ucol, 
                          col[i], ulinecol))
                    if (regz & (length(xxx) >= minpts)) {
					  if (regtype == "loess") 
                        pintol.loess(xxx, yy[ins], nse = se, nint = nint,
                          col = col[i], span = lo.span, degree = lo.degree, 
                          ...)
                      else if (regtype == "glm") 
                        pintol.glm(xxx, yy[ins], df = df, nse = se, nint = nint,
                          col = col[i], ...)
                      else if (regtype == "gam") 
                        pintol.gam(xxx, yy[ins], df = df, nse = se, nint = nint,
                          col = col[i], ...)
                    }
                    if (meansz & (length(xxx) >= minpts)) {
                      ym <- sapply(split(yy[ins], xxx), mean.na)
                      lines(unique(xxx), ym, col = col[i], lwd = lwdf)
                    }
                    if (err) {
                      if (missing(hi) & missing(lo)) {
                        errbar(unique(xxx), sapply(split(yy[ins], 
                          xxx), mean.na), sapply(split(yy[ins], 
                          xxx), sem), n = length(xxx), nse = se, 
                          ci.cover = ci.cov, pcheb = pch[i], bg = bg[i],
                          col = col[i], cexeb = cexm, gap = gap, 
                          bar.ends = bar.ends, texts = FALSE)
                      }
                      else {
                        errbar(xxx, yy[ins], hi = hhi[ins], lo = llo[ins], 
                          pcheb = pch[1], bg = bg[i], col = col[i], ci.cover = ci.cov, 
                          nse = se, cexeb = cexm, gap = gap, 
                          bar.ends = (10 * bar.ends)/length(unique(x)), 
                          texts = FALSE)
                      }
                    }
                  }
                }
            }
            else if (is.null(a)) {
                if (!err) 
                  if (!line & pts) 
                    if (!missing(texts)) {
                      if (jit) 
                        text(jitter(xx, jit.factor), yy, labels = texts, 
                          col = col[1], cex = cexm)
                      else text(xx, yy, labels = pch[1], col = col[1], 
                        cex = cexm)
                    }
                    else {
                      if (jit) 
                        points(jitter(xx, jit.factor), yy, pch = pch[1], 
                          col = col[1], cex = cexm, bg = bg)
                      else points(xx, yy, pch = pch[1], col = col[1], 
                        cex = cexm, bg = bg)
                    }
                  else if (line) {
                    lines(xx, yy, col = ifelse(ucol, col[i], 
                      ulinecol), lwd = lwd)
                  }
            }
            if (means & (length(xx) >= minpts)) {
                ym <- sapply(split(yy, xx), mean.na)
                lines(unique(xx), ym, lwd = lwdf)
            }
            if (err & is.null(a)) {
                if (missing(hi) & missing(lo)) {
                  errbar(unique(xx), sapply(split(yy, xx), mean.na), 
                    sapply(split(yy, xx), sem), pcheb = pch[1], bg = bg, 
                    n = length(xx), ci.cover = ci.cov, nse = se, 
                    cexeb = cexm, gap = gap, bar.ends = (10 * 
                      bar.ends)/length(unique(x)), texts = F)
                }
                else {
                  errbar(xx, yy, hi = hhi, lo = llo, pcheb = pch[1], 
                    bg = bg, ci.cover = ci.cov, nse = se, cexeb = cexm, 
                    gap = gap, bar.ends = (10 * bar.ends)/length(unique(x)), 
                    texts = FALSE)
                }
            }
            if (reg & (length(xx) >= minpts)) {
				if (regtype == "loess") 
                  pintol.loess(xx, yy, nse = se, span = lo.span, 
					 degree = lo.degree, nint = nint,  ...)
                else if (regtype == "glm") 
                  pintol.glm(xx, yy, df = df, nse = se, nint = nint, ...)
                else if (regtype == "gam") 
                  pintol.gam(xx, yy, cv = cvreg, df = df, nse = se, nint = nint, 
                    ...)
            }
            if (leg & leg.auto & !is.null(a)) 
                legend(xlim[1] * (1 - leg.loc[1]) + xlim[2] * 
                  leg.loc[1], ylim[1] * (1 - leg.loc[2]) + ylim[2] * 
                  leg.loc[2], legend = levels(zz), bty = "n", 
                  pch = pch, col = col, cex = cexl)
        }
    }
    if (missing(xlab)) 
        xlab <- x.name
    if (missing(ylab)) 
        ylab <- deparse(formula)
    if (blen > 1) {
        mtext(ylab, 2, outer = T, line = mgap, las = 0, cex = cext)
        mtext(xlab, 1, outer = T, line = mgap, las = 0, cex = cext)
		if (!missing(head)) mtext(head, 3, outer = T, line = mgap/2, las = 0, cex = 1.2*cext)    
	}
    else {
        mtext(ylab, 2, line = mgap, las = 0, cex = cext)
        mtext(xlab, 1, line = mgap, las = 0, cex = cext)
		if (!missing(head)) mtext(head, 3, line = mgap/2, las = 0, cex = 1.2*cext)    
    }
    if (fit.linear | fit.smooth) 
        pintol.fit(x = x, y = y, a = a, b = b,
            test = test.type, df = df, fit.linear = fit.linear, 
            fit.smooth = fit.smooth, diag.fit = diag.fit)
    if (leg & !leg.auto & !is.null(a)) 
        legend(locator(1), legend = levels(zz), bty = "n", pch = pch, 
            col = col, cex = cexl)
    invisible()
    if (ret.fit & fitted) 
        lmfit
}
#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/pintol.dem.R"
"pintol.dem" <-
function(cars, rats)
{
	if (.Platform$OS.type == "unix") x11()
	else windows()
    par(mar = c(5, 4, 2, 2) + 0.1)
    pintol(mpg~wgt, data=mcars, reg = T, df=3, se = 2)
    locator(1)
    pintol(mpg~wgt|ori, data=mcars, reg = T, regtype="gam", se=2, leg = T, leg.auto = T)
    locator(1)
    pintol(mpg~wgt|ori*yr, data=mcars, cexm = mcars$hp, text.true = T, cexbub = 0.9, regz =
        T, pch = letters)
    locator(1)
    pintol(mpg~wgt|ori, data=mcars, cexm=mcars$acc, reg = T, text = F, pch = 1:10)
    locator(1)
    pintol(mpg~yr|ori, data=mcars, means = T, spread = 1)
    locator(1)
    pintol(mpg~yr|ori, data=mcars, meansz = T, err = T, pch = 0)
    locator(1)
    pintol(mpg~yr|ori, data=mcars, outer=F, meansz = T, err = T, pch = 21, col=1, 
	bg=c("yellow","orange","green"))
    locator(1)
    pintol(mpg~yr|ori, data=mcars, err = T, bar = 0, spread = 0.2, gap = 0, pch = 3)
    locator(1)
	pintol(wgt~vtime|grp, data=rats, line = F, ucol = F, means = T, lwdf = 2)
    locator(1)
	pintol(wgt~time|id*grp, data=rats,outer=F,line=T,means=T,pts=F,lwdf=4)
    detach("rats")
    invisible()
}

#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/pintol.fit.R"
"pintol.fit" <-
function(x=x, y=y, a=a, b=b, df = df, test=test.type,
        fit.linear=fit.linear, fit.smooth=fit.smooth, diag.fit = diag.fit) {
    if (fit.linear & !fit.smooth) {
        print(anova(lmfit <- lm(y ~ x),test=test))
        if (is.null(b)) {
            if (!is.null(a))
                print(anova(lmfit <- lm(terms(y ~ x + a + x:a,
                  keep.order = T)),test=test))
        }
        else {
            print(anova(lmfit <- lm(terms(y ~ x + b + x:b,
                keep.order = T)),test=test))
            if (!is.null(a))
                print(anova(lmfit <- lm(terms(y ~ x + b +
                  x:b + a + a:x + a:b:x, keep.order = T)),test=test))
        }
        fitted <- T
    }
    if (fit.smooth & !fit.linear) {
        if (is.factor(x)) {
            cat("\n\n Spline fit specified when x is a factor : fit declined !!\n\n")
        }
        else {
            if (df < 3)
                cat("\n\n Warning : specified df < 3, df = 3 used in ANOVAS\n\n")
            print(anova(lmfit <- lm(y ~ splines::ns(x, df = df)),test=test))
            if (is.null(b)) {
                if (!is.null(a))
                  print(anova(lmfit <- lm(terms(y ~ splines::ns(x, df = df) +
                    a + splines::ns(x, df = df):a, keep.order = T)),test=test))
            }
            else {
                print(anova(lmfit <- lm(terms(y ~ splines::ns(x, df = df) +
                  b + splines::ns(x, df = df):b, keep.order = T)),test=test))
                if (!is.null(a))
                  print(anova(lmfit <- lm(terms(y ~ splines::ns(x, df = df) +
                    b + splines::ns(x, df = df):b + a + a:splines::ns(x,
                    df = df) + a:b + a:b:splines::ns(x, df = df),
                    keep.order = T)),test=test))
            }
            fitted <- T
        }
    }
    if (fit.smooth & fit.linear) {
        if (is.factor(x)) {
            cat("\n\n Spline fit specified when x is a factor : fit declined !!\n\n")
        }
        else {
            if (df < 3)
                cat("\n\n Warning : specified df < 3, df = 3 used in ANOVAS\n\n")
            print(anova(lmfit <- lm(y ~ x + splines::ns(x, df = df)),test=test))
            if (is.null(b)) {
                if (!is.null(a))
                  print(anova(lmfit <- lm(terms(y ~ x + splines::ns(x,
                    df = df) + a + x:a + splines::ns(x, df = df):a, keep.order = T)),test=test))
            }
            else {
                print(lmfit <- anova(lmfit <- lm(terms(y ~ x +
                  splines::ns(x, df = df) + b + x:b + splines::ns(x, df = df):b,
                  keep.order = T)),test=test))
                if (!is.null(a))
                  print(anova(lmfit <- lm(terms(y ~ x + splines::ns(x,
                    df = df) + b + x:b + splines::ns(x, df = df):b +
                    a + a:x + a:splines::ns(x, df = df) + a:b:x + a:b:splines::ns(x,
                    df = df), keep.order = T)),test=test))
            }
            fitted <- T
        }
    }
    if (diag.fit & fitted) {
        par(mfrow = c(2, 2))
        locator(1)
        pint.plt(lmfit)
    }
}

#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/pintol.fit2.R"
"pintol.fit2" <-
function(x=x, y=y, a=a, b=b, subset = subset, df = df, test=test.type,
        fit.linear=fit.linear, fit.smooth=fit.smooth, diag.fit = diag.fit) {
    if (fit.linear | fit.smooth) {
        y <- y[subset]
        x <- x[subset]
        if (!is.null(a))
            a <- a[subset]
        if (!is.null(b))
            b <- b[subset]
    }
    if (fit.linear & !fit.smooth) {
        print(anova(lmfit <- lm(y ~ x),test=test))
        if (is.null(b)) {
            if (!is.null(a))
                print(anova(lmfit <- lm(terms(y ~ x + a + x:a,
                  keep.order = T)),test=test))
        }
        else {
            print(anova(lmfit <- lm(terms(y ~ x + b + x:b,
                keep.order = T)),test=test))
            if (!is.null(a))
                print(anova(lmfit <- lm(terms(y ~ x + b +
                  x:b + a + a:x + a:b:x, keep.order = T)),test=test))
        }
        fitted <- T
    }
    if (fit.smooth & !fit.linear) {
        if (is.factor(x)) {
            cat("\n\n Spline fit specified when x is a factor : fit declined !!\n\n")
        }
        else {
            if (df < 3)
                cat("\n\n Warning : specified df < 3, df = 3 used in ANOVAS\n\n")
            print(anova(lmfit <- lm(y ~ splines::ns(x, df = df)),test=test))
            if (is.null(b)) {
                if (!is.null(a))
                  print(anova(lmfit <- lm(terms(y ~ splines::ns(x, df = df) +
                    a + splines::ns(x, df = df):a, keep.order = T)),test=test))
            }
            else {
                print(anova(lmfit <- lm(terms(y ~ splines::ns(x, df = df) +
                  b + splines::ns(x, df = df):b, keep.order = T)),test=test))
                if (!is.null(a))
                  print(anova(lmfit <- lm(terms(y ~ splines::ns(x, df = df) +
                    b + splines::ns(x, df = df):b + a + a:splines::ns(x,
                    df = df) + a:b + a:b:splines::ns(x, df = df),
                    keep.order = T)),test=test))
            }
            fitted <- T
        }
    }
    if (fit.smooth & fit.linear) {
        if (is.factor(x)) {
            cat("\n\n Spline fit specified when x is a factor : fit declined !!\n\n")
        }
        else {
            if (df < 3)
                cat("\n\n Warning : specified df < 3, df = 3 used in ANOVAS\n\n")
            print(anova(lmfit <- lm(y ~ x + splines::ns(x, df = df)),test=test))
            if (is.null(b)) {
                if (!is.null(a))
                  print(anova(lmfit <- lm(terms(y ~ x + splines::ns(x,
                    df = df) + a + x:a + splines::ns(x, df = df):a, keep.order = T)),test=test))
            }
            else {
                print(lmfit <- anova(lmfit <- lm(terms(y ~ x +
                  splines::ns(x, df = df) + b + x:b + splines::ns(x, df = df):b,
                  keep.order = T)),test=test))
                if (!is.null(a))
                  print(anova(lmfit <- lm(terms(y ~ x + splines::ns(x,
                    df = df) + b + x:b + splines::ns(x, df = df):b +
                    a + a:x + a:splines::ns(x, df = df) + a:b:x + a:b:splines::ns(x,
                    df = df), keep.order = T)),test=test))
            }
            fitted <- T
        }
    }
    if (diag.fit & fitted) {
        par(mfrow = c(2, 2))
        locator(1)
        pint.plt(lmfit)
    }
}

#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/pintol.gam.R"
"pintol.gam" <-
function (x, y, family = "gaussian", cv = T, df = 4, nse = 2,
    nint = 50, use.mean.dev = T, lwd = 1, lty = 1, col = 1, ...)
{
    x <- as.numeric(x)
    y <- as.numeric(y)
        fit <- gam(y ~ s(x, k = df, fx = !cv), family = family)
        pred <- predict(fit, se = T, type = "link")
 		dat <- data.frame(x=seq(min(x),max(x),length=nint))
		if (!nse) yp <- predict(fit,newdata=dat,se=F,type = "link")
		else {
			fitted <- predict(fit,newdata=dat,se=T,type = "link")
			yp <- fitted$fit
			se.yp <- fitted$se.fit			
		}
        if (use.mean.dev & family != "gaussian")
            se.yp <- se.yp * sqrt(fit$dev/fit$df.res)
        if (family == "poisson")
            yp <- exp(yp)
        else if (family == "binomial")
            yp <- 1/(1 + exp(-yp))
        else yp <- yp
        lines(x = dat$x, y = yp, col = col, lty = lty, lwd = lwd)
        if (nse) {
            if (family == "poisson") {
                yp.hi <- exp(yp + nse * se.yp)
                yp.lo <- exp(yp - nse * se.yp)
            }
            else if (family == "binomial") {
                yp.hi <- 1/(1 + exp(-yp - nse * se.yp))
                yp.lo <- 1/(1 + exp(-yp + nse * se.yp))
            }
            else {
                yp.hi <- yp + nse * se.yp
                yp.lo <- yp - nse * se.yp
            }
            lines(x = dat$x, y = yp.hi, col = col, lty = lty, lwd = lwd)
            lines(x = dat$x, y = yp.lo, col = col, lty = lty, lwd = lwd)
        }
}

#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/pintol.glm.R"
"pintol.glm" <-
function (x, y, family = "gaussian", df = 4, nse = 2, use.mean.dev = T,
    nint = 50, lwd = 1, lty = 1, col = 1, ...)
{
    x <- as.numeric(x)
    y <- as.numeric(y)
    if (length(x) > 0) {
        fit <- glm(y ~ ns(x, df), family = family)
		dat <- data.frame(x=seq(min(x),max(x),length=nint))
		if (!nse) yp <- predict(fit,newdata=dat,se=F,type = "link")
		else {
			fitted <- predict(fit,newdata=dat,se=T,type = "link")
			yp <- fitted$fit
			se.yp <- fitted$se.fit			
		}
        if (use.mean.dev & family != "gaussian")
            se.yp <- se.yp * sqrt(fit$dev/fit$df.res)
        if (family == "poisson")
            yp <- exp(yp)
        else if (family == "binomial")
            yp <- 1/(1 + exp(-yp))
        else yp <- yp
        lines(x = dat$x, y = yp, col = col, lty = lty, lwd = lwd)
        if (nse) {
            if (family == "poisson") {
                yp.hi <- exp(yp + nse * se.yp)
                yp.lo <- exp(yp - nse * se.yp)
            }
            else if (family == "binomial") {
                yp.hi <- 1/(1 + exp(-yp - nse * se.yp))
                yp.lo <- 1/(1 + exp(-yp + nse * se.yp))
            }
            else {
                yp.hi <- yp + nse * se.yp
                yp.lo <- yp - nse * se.yp
            }
            lines(x = dat$x, y = yp.hi, col = col, lty = lty, lwd = lwd)
            lines(x = dat$x, y = yp.lo, col = col, lty = lty, lwd = lwd)
        }
    }
}

#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/pintol.loess.R"
"pintol.loess" <-
function (x, y, span = 0.75, degree = 1, nse = 2, nint = 50,
    family = c("symmetric", "gaussian")[1], evaluation = 50, lwd = 1, lty = 1,
    col = 1, ...)
    {
    x <- as.numeric(x)
    y <- as.numeric(y)
    fit <- loess(y~x, span = span, family = "symmetric",
		degree = degree, evaluation = evaluation)
	dat <- data.frame(x=seq(min(x),max(x),length=nint))
	if (!nse) yp <- predict(fit,newdata=dat,se=F,type = "link")
	else {
		fitted <- predict(fit,newdata=dat,se=T,type = "link")
		yp <- fitted$fit
		se.yp <- fitted$se.fit			
	}
    lines(x = dat$x, y = yp, col = col, lty = lty, lwd = lwd)
    if (nse) {
        if (family == "poisson") {
            yp.hi <- exp(yp + nse * se.yp)
            yp.lo <- exp(yp - nse * se.yp)
        }
        else if (family == "binomial") {
            yp.hi <- 1/(1 + exp(-yp - nse * se.yp))
            yp.lo <- 1/(1 + exp(-yp + nse * se.yp))
        }
        else {
            yp.hi <- yp + nse * se.yp
            yp.lo <- yp - nse * se.yp
        }
        lines(x = dat$x, y = yp.hi, col = col, lty = lty, lwd = lwd)
        lines(x = dat$x, y = yp.lo, col = col, lty = lty, lwd = lwd)
    }
}

#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/plop.R"
plop <- function(x,margin=1,base=exp(1)) {
	x <- as.matrix(x)
	totx <- apply(z,1,sum)
	x <- x/totx
	x <- -x*log(x)
	apply(x,margin,sum,na.rm=T)
}

#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/plot.gam.gd.R"
plot.gam.gd <- function(gam.fit, ...) {
	plot(z,trans=function(x) gam.fit$family$linkinv(x+mean(gam.fit$family$linkfun(gam.fit$fitted))),...)
}


#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/plot.gam2.R"
"plot.gam2" <-
function (x, which = NULL, residuals = NULL, rugplot = TRUE, se = FALSE, scale = 0,
    ask = FALSE, ...)
{
    if (!is.null(x$na.action))
        x$na.action <- NULL
    preplot.object <- x$preplot
    if (is.null(preplot.object))
        preplot.object <- preplot.gam(x)
    x$preplot <- preplot.object
    Residuals <- resid(x)
    if (!is.null(residuals)) {
        if (length(residuals) == 1)
            if (residuals)
                residuals <- Residuals
            else residuals <- NULL
        else Residuals <- residuals
    }
    if (!ask) {
        if (!is.null(which) && which <= length(preplot.object))
            plot.preplot.gam(preplot.object[[which]], residuals = residuals,
            rugplot = rugplot, scale = scale, se = se, fit = TRUE,
            ...)
        else plot.preplot.gam(preplot.object, residuals = residuals,
            rugplot = rugplot, scale = scale, se = se, fit = TRUE,
            ...)
        invisible(x)
    }
    else {
        nterms <- names(preplot.object)
        tterms <- substring(nterms, 1, 40)
        residualsmenu <- if (!is.null(residuals))
            "residuals off"
        else "residuals on"
        rugmenu <- if (rugplot)
            "rug off"
        else "rug on"
        semenu <- if (se)
            "se off"
        else "se on"
        scalemenu <- paste("scale (", round(scale, 1), ")", sep = "")
        scales <- numeric()
        tmenu <- c(paste("plot:", tterms), "plot all terms",
            residualsmenu, rugmenu, semenu, scalemenu)
        tnames <- character()
        pick <- 1
        while (pick > 0 && pick <= length(tmenu)) {
            pick <- menu(tmenu, title = "Make a plot selection (or 0 to exit):\n")
            if (pick > 0 && pick <= length(nterms)) {
                tscale <- plot.preplot.gam(preplot.object[[pick]],
                  residuals = residuals, rugplot = rugplot, scale = scale,
                  se = se, fit = TRUE, ...)
                names(tscale) <- nterms[pick]
                scales <- c(scales, tscale)
                cat("Plots performed:\n ")
                print(scales)
            }
            else switch(pick - length(nterms), {
                scales <- plot.preplot.gam(preplot.object, residuals = residuals,
                  rugplot = rugplot, scale = scale, se = se,
                  fit = TRUE, ...)
                print(scales)
            }, {
                residuals <- if (is.null(residuals))
                  Residuals
                else NULL
                residualsmenu <- if (!is.null(residuals))
                  "residuals off"
                else "residuals on"
            }, {
                rugplot <- !rugplot
                rugmenu <- if (rugplot)
                  "rug off"
                else "rug on"
            }, {
                se <- !se
                semenu <- if (se)
                  "se off"
                else "se on"
            }, {
                cat("Type in a new scale\n")
                scale <- eval(parse())
                scalemenu <- paste("scale (", round(scale, 1),
                  ")", sep = "")
            }, invisible(return(x)))
            tmenu <- c(paste("plot:", tterms), "plot all terms",
                residualsmenu, rugmenu, semenu, scalemenu)
        }
        invisible(x)
    }
}

#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/poly.in.R"
"poly.in" <-
function(xy, poly)
{
    if(ncol(poly) == 2)
        poly <- poly.tst(poly)
    n <- nrow(xy)
    np <- nrow(poly)
    nnp <- rep(n, np)
    check1 <- xor(xy[, 1] >= rep(poly[, 1], nnp), xy[, 1] > rep(poly[, 3], nnp))
    check2 <- rep(poly[, 2], nnp) + rep(poly[, 4], nnp) * xy[, 1] > xy[, 2]
    as.vector(matrix(check1 & check2, n, np) %*% rep.int(1, np) %% 2 > 0)
}

#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/poly.tst.R"
"poly.tst" <-
function(xy)
{
    if(is.list(xy))
        xy <- as.data.frame(xy)
    if(!is.matrix(xy) || ncol(xy) != 2 || !is.numeric(xy[, 1]) || !is.numeric(xy[, 2]))
    stop("xy must by nX2 numeric matrix or data.frame")
    #
    # Columns of poly are start.x, a, end.x, b
    xy <- as.matrix(xy)
    poly <- matrix(c(xy, xy[c(2:nrow(xy), 1),  ]), ncol = 4)
    poly <- poly[poly[, 1] != poly[, 3],  ]
    poly[, 4] <- (poly[, 4] - poly[, 2])/(poly[, 3] - poly[, 1])
    poly[, 2] <- poly[, 2] - poly[, 1] * poly[, 4]
    poly
}

#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/putText.R"
putText <- function(x, y, txt, ...) {

#
# Puts text on a graphics in given location defined by the unit square
# Useful for repeated locations legends etc in the EXACT SAME place
# e.g. x=0.05,y=0.95 gives the top-left corner
# 	   x=0.05,y=1.05 gives the top-left corner outside the box	
# txt is the text to add and ... ALL parameters passed to text;
# that includes font size, type, colour, format, justification  etc 
#

	pu <- par()$usr
	tl <- c(pu[1]*(1-x)+pu[2]*x,pu[3]*(1-y)+pu[4]*y)
	text(tl[1], tl[2], txt, ...)
}
#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/qq.plot.R"
"qq.plot" <-
function (x, ...) 
{
    UseMethod("qq.plot")
}
"qq.plot.default" <-
function (x, distribution = "norm", ylab = deparse(substitute(x)), 
    xlab = paste(distribution, "quantiles"), main = NULL, las = par("las"), 
    envelope = 0.95, labels = FALSE, col = palette()[2], lwd = 2, 
    pch = 1, cex = 1, line = c("quartiles", "robust", "none"), 
    ...) 
{
    result <- NULL
    line <- match.arg(line)
    good <- !is.na(x)
    ord <- order(x[good])
    ord.x <- x[good][ord]
    q.function <- eval(parse(text = paste("q", distribution, 
        sep = "")))
    d.function <- eval(parse(text = paste("d", distribution, 
        sep = "")))
    n <- length(ord.x)
    P <- ppoints(n)
    z <- q.function(P, ...)
    plot(z, ord.x, xlab = xlab, ylab = ylab, main = main, las = las, 
        col = col, pch = pch, cex = cex)
    if (line == "quartiles") {
        Q.x <- quantile(ord.x, c(0.25, 0.75))
        Q.z <- q.function(c(0.25, 0.75), ...)
        b <- (Q.x[2] - Q.x[1])/(Q.z[2] - Q.z[1])
        a <- Q.x[1] - b * Q.z[1]
        abline(a, b, col = col, lwd = lwd)
    }
    if (line == "robust") {
        if (!require("MASS")) 
            stop("MASS package not available")
        coef <- coefficients(rlm(ord.x ~ z))
        a <- coef[1]
        b <- coef[2]
        abline(a, b)
    }
    if (line != "none" & envelope != FALSE) {
        zz <- qnorm(1 - (1 - envelope)/2)
        SE <- (b/d.function(z, ...)) * sqrt(P * (1 - P)/n)
        fit.value <- a + b * z
        upper <- fit.value + zz * SE
        lower <- fit.value - zz * SE
        lines(z, upper, lty = 2, lwd = lwd/2, col = col)
        lines(z, lower, lty = 2, lwd = lwd/2, col = col)
    }
    if (labels[1] == TRUE & length(labels) == 1) 
        labels <- seq(along = z)
    if (labels[1] != FALSE) {
        selected <- identify(z, ord.x, labels[good][ord])
        result <- seq(along = x)[good][ord][selected]
    }
    if (is.null(result)) 
        invisible(result)
    else sort(result)
}
"qq.plot.lm" <-
function (x, main = NULL, xlab = paste(distribution, "Quantiles"), 
    ylab = paste("Studentized Residuals(", deparse(substitute(x)), 
        ")", sep = ""), distribution = c("t", "norm"), line = c("quartiles", 
        "robust", "none"), las = par("las"), simulate = FALSE, 
    envelope = 0.95, labels = names(rstudent), reps = 100, col = palette()[2], 
    lwd = 2, pch = 1, cex = 1, ...) 
{
    result <- NULL
    distribution <- match.arg(distribution)
    line <- match.arg(line)
    rstudent <- rstudent(x)
    sumry <- summary.lm(x)
    res.df <- sumry$df[2]
    if (!simulate) {
        if (distribution == "t") 
            result <- qq.plot.default(rstudent, distribution = "t", 
                df = res.df - 1, line = line, main = main, xlab = xlab, 
                ylab = ylab, las = las, envelope = envelope, 
                labels = labels, col = col, lwd = lwd, pch = pch, 
                cex = cex, ...)
        else result <- qq.plot.default(rstudent, distribution = "norm", 
            line = line, main = main, xlab = xlab, ylab = ylab, 
            las = las, envelope = envelope, labels = labels, 
            col = col, lwd = lwd, pch = pch, cex = cex, ...)
    }
    else {
        good <- !is.na(rstudent)
        n <- length(rstudent)
        rstudent <- na.omit(rstudent)
        ord <- order(rstudent)
        ord.x <- rstudent[ord]
        n <- length(ord)
        P <- ppoints(n)
        z <- if (distribution == "t") 
            qt(P, df = res.df - 1)
        else qnorm(P)
        plot(z, ord.x, xlab = xlab, ylab = ylab, main = main, 
            las = las, pch = pch, col = col, cex = cex)
        yhat <- na.omit(fitted.values(x))
        S <- sumry$sigma
        Y <- matrix(yhat, n, reps) + matrix(rnorm(n * reps, sd = S), 
            n, reps)
        X <- model.matrix(x)
        rstud <- apply(rstudent(lm(Y ~ X - 1)), 2, sort)
        lower <- apply(rstud, 1, quantile, prob = (1 - envelope)/2)
        upper <- apply(rstud, 1, quantile, prob = (1 + envelope)/2)
        lines(z, upper, lty = 2, lwd = lwd/2, col = col)
        lines(z, lower, lty = 2, lwd = lwd/2, col = col)
        if (line == "quartiles") {
            Q.x <- quantile(rstudent, c(0.25, 0.75))
            Q.z <- if (distribution == "t") 
                qt(c(0.25, 0.75), df = res.df - 1)
            else qnorm(c(0.25, 0.75))
            b <- (Q.x[2] - Q.x[1])/(Q.z[2] - Q.z[1])
            a <- Q.x[1] - b * Q.z[1]
            abline(a, b, col = col, lwd = lwd)
        }
        if (line == "robust") {
            if (!require("MASS")) 
                stop("MASS package not available")
            coef <- coefficients(rlm(ord.x ~ z))
            a <- coef[1]
            b <- coef[2]
            abline(a, b, col = col, lwd = lwd)
        }
        if (labels[1] == TRUE & length(labels) == 1) 
            labels <- seq(along = z)
        if (labels[1] != FALSE) {
            selected <- identify(z, ord.x, labels[ord])
            result <- (1:n)[good][ord][selected]
        }
    }
    if (is.null(result)) 
        invisible(result)
    else sort(result)
}
#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/rats.R"
rats <-
structure(list(grp = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 3L, 3L, 
3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 
3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 
3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L
), .Label = c("1", "2", "3"), class = "factor"), time = structure(c(1L, 
2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 
3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 
4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 
5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 
1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 
2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 
3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 
4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 
5L, 1L, 2L, 3L, 4L, 5L), .Label = c("w1", "w2", "w3", "w4", "w5"
), class = c("ordered", "factor")), id = structure(c(1L, 1L, 
1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 4L, 4L, 4L, 
4L, 4L, 5L, 5L, 5L, 5L, 5L, 6L, 6L, 6L, 6L, 6L, 7L, 7L, 7L, 7L, 
7L, 8L, 8L, 8L, 8L, 8L, 9L, 9L, 9L, 9L, 9L, 10L, 10L, 10L, 10L, 
10L, 11L, 11L, 11L, 11L, 11L, 12L, 12L, 12L, 12L, 12L, 13L, 13L, 
13L, 13L, 13L, 14L, 14L, 14L, 14L, 14L, 15L, 15L, 15L, 15L, 15L, 
16L, 16L, 16L, 16L, 16L, 17L, 17L, 17L, 17L, 17L, 18L, 18L, 18L, 
18L, 18L, 19L, 19L, 19L, 19L, 19L, 20L, 20L, 20L, 20L, 20L, 21L, 
21L, 21L, 21L, 21L, 22L, 22L, 22L, 22L, 22L, 23L, 23L, 23L, 23L, 
23L, 24L, 24L, 24L, 24L, 24L, 25L, 25L, 25L, 25L, 25L, 26L, 26L, 
26L, 26L, 26L, 27L, 27L, 27L, 27L, 27L), .Label = c("1", "2", 
"3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", 
"15", "16", "17", "18", "19", "20", "21", "22", "23", "24", "25", 
"26", "27"), class = "factor"), wgt = c(57, 86, 114, 139, 172, 
60, 93, 123, 146, 177, 52, 77, 111, 144, 185, 49, 67, 100, 129, 
164, 56, 81, 104, 121, 151, 46, 70, 102, 131, 153, 51, 71, 94, 
110, 141, 63, 91, 112, 130, 154, 49, 67, 90, 112, 140, 57, 82, 
110, 139, 169, 59, 85, 121, 146, 181, 54, 71, 90, 110, 138, 56, 
75, 108, 151, 189, 59, 85, 116, 148, 177, 57, 72, 97, 120, 144, 
52, 73, 97, 116, 140, 52, 70, 105, 138, 171, 61, 86, 109, 120, 
129, 59, 80, 101, 111, 122, 53, 79, 100, 106, 133, 59, 88, 100, 
111, 122, 51, 75, 101, 123, 140, 51, 75, 92, 100, 119, 56, 78, 
95, 103, 108, 58, 69, 93, 116, 140, 46, 61, 78, 90, 107, 53, 
72, 89, 104, 122), vtime = c(1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 
4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 
5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 
1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 
2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 
3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 
4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 
5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 
1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L)), .Names = c("grp", 
"time", "id", "wgt", "vtime"), row.names = c(NA, 135L), class = "data.frame")
#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/rd.R"
rd <- function(dir=getwd(),clean = T) {
	.lfs <- list.files(dir,all=TRUE)
	if (length(.lfs)) .lfs <- .lfs[grep("RData$",.lfs)]
	if (length(.lfs)) {
		cat("RData files: ",.lfs,"\n")
		if (clean) cat("Select from ","1 :",length(.lfs),"to replace current objects\n")
		else cat("Select from ","1 :",length(.lfs),"to add to current objects\n")
		cat("or ENTER to retain current .RData\n")
		.wfile <- scan(n = 1, quiet = TRUE)
		if (length(.wfile) && (.wfile>0 & .wfile<=length(.lfs))) {
			if (clean)  rm(list=ls(all=T,pos=".GlobalEnv"),pos=".GlobalEnv")
			cat(paste(dir,.lfs[.wfile],sep="/"),"\n")
			load(paste(dir,.lfs[.wfile],sep="/"),.GlobalEnv)
			cat("File loaded:",.lfs[.wfile],"\n")
			print(ls(all=T,pos=".GlobalEnv"))
		}
	}	
	else (cat("No objects available\n"))
}


#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/read.excel.R"
"read.excel" <-
function(file) {
    require("RODBC")
    if (missing (file)) print(con <- odbcConnectExcel())
    else print(con <- odbcConnectExcel(file))
    print(datasets <- apply(sqlTables(con)[,3,drop=F],1,function (x) substring(x,1,nchar(x)-1)))
    which <- readline(paste("Select data set:",paste(as.character(1:length(datasets)),collapse=" "),">  ",sep=" "))
    sqlFetch(con, datasets[which])
}

#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/reset.vscale.R"
reset.vscale <- function(ylim, exp=TRUE) {
	ylim <- ylim + 0.04 * c(-1, 1) * diff(ylim)
	par(usr=c(par()$usr[1:2],ylim))
}

#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/rm.lsa.R"
"rm.lsa" <- function(x) {
	if (missing(x)) x <- 1:length(objects(all=T,envir=parent.frame()))
	rm(list=objects(all=T,envir=parent.frame())[x],envir=parent.frame())
}
#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/rr.R"
rr <- function(dir=getwd()) {
	.lfs <- list.files(dir,all=TRUE)
	if (length(.lfs)) .lfs <- .lfs[grep("R$",.lfs)]
	if (length(.lfs)) {
		print(.lfs)
		.wfile <- scan(n=1,quiet=TRUE)
		if (.wfile>0 & .wfile<=length(.lfs)) {
			cat(paste(dir,.lfs[.wfile],sep="/"),"\n")
			source(paste(dir,.lfs[.wfile],sep="/"))
			cat("File loaded:",.lfs[.wfile],"\n")
			print(ls(all=T,envir=.GlobalEnv))
		}
	}	
	else (cat("No objects available\n"))
}


#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/save.RDatas.R"
"save.RDatas" <- function(lst = ls(envir=parent.frame(n=1)), dir = getwd()) {
    cat("Saving Rdatas: Directory =",dir,": Files:\n")
    for (i in lst) {
    save(list = i, file = paste(dir,"/",i,".RData",sep=""))
    cat(paste(dir,"/",i,".Rdata",sep=""),"\n")
    }
}

#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/sc01.R"
"sc01" <-
function(x, cexbub = 2, delta = 0.2) {
        d <- diff(range(as.numeric(x)))
        if (d != 0)
            x <- 2 * cexbub * (((1 - delta) * (x - min(x)))/diff(range(as.numeric(x))) +
                delta)
        x
}

#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/see.R"
"see" <- function() search()
#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/sem.R"
sem <- function (y, na.rm = TRUE) 
{
    if (na.rm) 
        y <- y[!is.na(y)]
    if (length(y)) sqrt(var(y)/length(y))
    else NA
}    

#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/smooth.spline.gd.R"
"smooth.spline.gd" <-
function (x, y = NULL, w = NULL, df, spar = NULL, cv = FALSE,
    all.knots = FALSE, nknots = NULL, df.offset = 0, penalty = 1,
    control.spar = list())
{
    sknotl <- function(x, nk = NULL) {
        n.kn <- function(n) {
            if (n < 50)
                n
            else trunc({
                a1 <- log(50, 2)
                a2 <- log(100, 2)
                a3 <- log(140, 2)
                a4 <- log(200, 2)
                if (n < 200) 2^(a1 + (a2 - a1) * (n - 50)/150) else if (n <
                  800) 2^(a2 + (a3 - a2) * (n - 200)/600) else if (n <
                  3200) 2^(a3 + (a4 - a3) * (n - 800)/2400) else 200 +
                  (n - 3200)^0.2
            })
        }
        n <- length(x)
        if (is.null(nk))
            nk <- n.kn(n)
        else if (!is.numeric(nk))
            stop("`nknots' must be numeric <= n")
        else if (nk > n)
            stop("can't use more inner knots than unique x values")
        c(rep(x[1], 3), x[seq(1, n, len = nk)], rep(x[n], 3))
    }
    contr.sp <- list(low = -1.5, high = 1.5, tol = 1e-04, eps = 2e-08,
        maxit = 500, trace = getOption("verbose"))
    contr.sp[(names(control.spar))] <- control.spar
    if (!all(sapply(contr.sp[1:4], is.double)) || contr.sp$tol <
        0 || contr.sp$eps <= 0 || contr.sp$maxit <= 0)
        stop("invalid `control.spar'")
    xy <- xy.coords(x, y)
    y <- xy$y
    x <- xy$x
    n <- length(x)
    w <- if (is.null(w))
        rep(1, n)
    else {
        if (n != length(w))
            stop("lengths of x and w must match")
        if (any(w < 0))
            stop("all weights should be non-negative")
        if (all(w == 0))
            stop("some weights should be positive")
        (w * sum(w > 0))/sum(w)
    }
    x <- signif(x, 6)
    ux <- unique(sort(x))
    ox <- match(x, ux)
    tmp <- matrix(unlist(tapply(seq(along = y), ox, function(i,
        y, w) c(sum(w[i]), sum(w[i] * y[i]), sum(w[i] * y[i]^2)),
        y = y, w = w)), ncol = 3, byrow = TRUE)
    wbar <- tmp[, 1]
    ybar <- tmp[, 2]/ifelse(wbar > 0, wbar, 1)
    yssw <- sum(tmp[, 3] - wbar * ybar^2)
    nx <- length(ux)
    if (nx <= 3)
        stop("need at least four unique `x' values")
#    if (cv && nx < n)
#        warning("crossvalidation with non-unique `x' seems doubtful")
    r.ux <- ux[nx] - ux[1]
    xbar <- (ux - ux[1])/r.ux
    if (all.knots) {
        knot <- c(rep(xbar[1], 3), xbar, rep(xbar[nx], 3))
        nk <- nx + 2
    }
    else {
        knot <- sknotl(xbar, nknots)
        nk <- length(knot) - 4
    }
    ispar <- if (is.null(spar) || missing(spar)) {
        if (contr.sp$trace)
            -1
        else 0
    }
    else 1
    spar <- if (ispar == 1)
        as.double(spar)
    else double(1)
    icrit <- if (cv)
        2
    else 1
    dofoff <- df.offset
    if (!missing(df)) {
        if (df > 1 && df <= nx) {
            icrit <- 3
            dofoff <- df
        }
        else warning("you must supply 1 < df <= n,  n = #{unique x} = ",
            nx)
    }
    iparms <- as.integer(c(icrit, ispar, contr.sp$maxit))
    names(iparms) <- c("icrit", "ispar", "iter")
    fit <- .Fortran("qsbart", as.double(penalty), as.double(dofoff),
        x = as.double(xbar), y = as.double(ybar), w = as.double(wbar),
        ssw = as.double(yssw), as.integer(nx), as.double(knot),
        as.integer(nk), coef = double(nk), ty = double(nx), lev = double(nx),
        crit = double(1), iparms = iparms, spar = spar, parms = unlist(contr.sp[1:4]),
        isetup = as.integer(0), scrtch = double((17 + 0) * nk +
            1), ld4 = as.integer(4), ldnk = as.integer(1), ier = integer(1),
        DUP = FALSE, PACKAGE = "stats")[c("coef", "ty", "lev",
        "spar", "parms", "crit", "iparms", "ier")]
    lev <- fit$lev
    df <- sum(lev)
    if (is.na(df))
        stop("NA lev[]; probably smoothing parameter `spar' way too large!")
    if (fit$ier > 0) {
        sml <- fit$spar < 0.5
        wtxt <- paste("smoothing parameter value too", if (sml)
            "small"
        else "large")
        if (sml) {
            stop(wtxt)
        }
        else {
            fit$ty <- rep(mean(y), nx)
            df <- 1
            warning(wtxt, "\nsetting df = 1  __use with care!__")
        }
    }
    cv.crit <- if (cv) {
        ww <- wbar
        ww[!(ww > 0)] <- 1
        weighted.mean(((y - fit$ty[ox])/(1 - (lev[ox] * w)/ww[ox]))^2,
            w)
    }
    else weighted.mean((y - fit$ty[ox])^2, w)/(1 - (df.offset +
        penalty * df)/n)^2
    pen.crit <- sum(wbar * (ybar - fit$ty) * ybar)
    fit.object <- list(knot = knot, nk = nk, min = ux[1], range = r.ux,
        coef = fit$coef)
    class(fit.object) <- "smooth.spline"
    object <- list(x = ux, y = fit$ty, w = wbar, yin = ybar,
        lev = lev, cv.crit = cv.crit, pen.crit = pen.crit, crit = fit$crit,
        df = df, spar = fit$spar, lambda = unname(fit$parms["low"]),
        iparms = fit$iparms, fit = fit.object, call = match.call())
    class(object) <- "smooth.spline"
    object
}

#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/spline.gd.R"
"spline.gd" <-
function(x, y, df = 7, cv = T, conf = 2, penalty = 1, pts = T, pch = 1, ret = T, cexpch = 1, r2 = F,
     ylim, xlim, ...)
{
    xyna <- is.na(x) | is.na(y)
    if(any(xyna)) {
        x <- x[!xyna]
        y <- y[!xyna]
        cat(sum(xyna), " cases missing\n")
    }
    if(!missing(df))
        fit <- smooth.spline.gd(x, y, df = df)
    else if(!missing(penalty))
        fit <- smooth.spline.gd(x, y, cv = F, penalty = penalty)
    else fit <- smooth.spline.gd(x, y, cv = T)
    len <- length(fit$x)
    ins <- rep(1:len, fit$w)
    fit$x <- fit$x[ins]
    fit$y <- fit$y[ins]
    y <- y[order(x)]
    x <- x[order(x)]
    fit$yin <- fit$yin[ins]
    fit$lev <- (fit$lev/fit$w)[ins]
    res <- (y - fit$y)
    sres <- res/(1 - fit$lev)
    totss <- sum((y - mean(y))^2)
    sigma <- sqrt(var(sres))
    err <- conf * sigma * sqrt(fit$lev)
    if(missing(ylim))
        ylim <- range(c(fit$y + err, fit$y - err, y))
    if(missing(xlim))
        xlim <- range(fit$x)
    plot(fit$x, fit$y, ylim = ylim, xlim = xlim, type = "n")
    if(pts)
        points(x, y, pch = pch, cex = cexpch)
    lines(fit$x, fit$y, col = 2, lwd = 1)
    if(r2)
        mtext(paste("R2 = ", round(100 * (1 - sum(res^2)/totss), 1), "%"), side = 3, line = 1)
    if(conf) {
        lines(fit$x, fit$y + err, lty = 1, col = 4, lwd = 1)
        lines(fit$x, fit$y - err, lty = 1, col = 4, lwd = 1)
    }
    fit$yin <- y
    list(fit = fit, y = fit$y, se = err/conf)
}

#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/splitRfiles.R"
"splitRfiles" <- function (from = "d:/rwork/rw221src", to = from, lib, warn = FALSE) 
{
    if (warn & length(ls(pos=parent.frame()))) {
        cat("There are objects in this workspace -- Remove them (y/n) >  ")
        z <- readLines(n=1)
        if (z=="y" || z=="Y") rm(list=ls(pos=parent.frame()),envir=parent.frame())
        else return()
    }
    else rm(list=ls(pos=parent.frame()),envir=parent.frame())

    if (missing(lib)) {
        from <- choose.files(from, multi=F)
        to <- paste(dirname(from),"/",sep="")
    }
    else {
        from <- paste(from,lib,"R",paste(lib,".R",sep=""),sep="/")
        to <- paste(to,lib,"R/",sep="/")
    }

    cat("Sourcing files from ", from, "\n")
    source(from)
    print(files <- ls(pos = parent.frame()))
    nf <- length(files)  
    cat("Dumping files to ", to, "\n")
    for (i in 1:nf) {
        dump(ls(pos = parent.frame())[i], file = paste(to, files[i], ".R",sep = ""))
    }
    file.remove(from)
    rm(list=ls(pos=parent.frame()),envir=parent.frame())
}
#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/splitter.R"
splitter <- function(x,xlabs) {
	x <- x[order(as.character(x))]
	lst <- do.call("rbind",lapply(strsplit(as.character(x),"\\."),unlist))
	if (!missing(xlabs)) names(lst) <- xlabs
	data.frame(x,lst)
}
#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/stat.ganova.R"
"stat.ganova" <-
function (table, test = c("Chisq", "F", "Cp", "IC*", "IC"), scale, df.scale, n)
{
    test <- match.arg(test)
    dev.col <- match("Diff Dev", colnames(table))
    for (i in length(test))
    switch(test, Chisq = {
        cbind(table, "P(>|Chi|)" = pchisq(abs(table[, dev.col]/scale),
            abs(table[, "Diff Df"]), lower.tail = FALSE))
    }, F = {
        Fvalue <- abs((table[, dev.col]/table[, "Diff Df"])/scale)
        Fvalue[table[, "Diff Df"] == 0] <- NA
        cbind(table, F = Fvalue, "Pr(>F)" = pf(Fvalue, abs(table[,
            "Diff Df"]), abs(df.scale), lower.tail = FALSE))
    }, Cp = {
        cbind(table[,1:2], "Mean Dev." = table[,2]/table[,1],
        Cp = table[, "Deviance"] + 2 * scale * (n - table[, "Dev Df"]))
    }, "IC*" = {
        cat("IC* -- Using unscaled IC\n")
        resid.dev <- table[,"Deviance"]
        p <- (n - table[,"Dev Df"])
        table <- table[,1:2]
        table$"Mean Dev." <- table[,2]/table[,1]
        table$"AIC*" <- resid.dev + 2 * p
        table$"AICC*" <- resid.dev + 2 * p * (1 + (p + 1)/(n - p - 1))
        table$"BIC*" <- resid.dev + log(n) * p
        table
    }, "IC" = {
        cat("IC -- Using scaled IC\n")
        resid.dev <- table[,"Deviance"]
        p <- (n - table[,"Dev Df"])
        table <- table[,1:2]
        table$"Mean Dev." <- table[,2]/table[,1]
        table$"AIC" <- resid.dev/scale + 2 * p
        table$"AICC" <- resid.dev/scale + 2 * p * (1 + (p + 1)/(n - p - 1))
        table$"BIC" <- resid.dev/scale + log(n) * p
        table
    })
}

#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/stepAICc.R"
stepAICc <- function (object, scope, scale = 0, direction = c("both", "backward", "forward"), trace = 1, keep = NULL, steps = 1000, use.start = FALSE, k = 2, ...) {
    mydeviance <- function(x, ...) {
        dev <- deviance(x)
        if (!is.null(dev))
            dev
        else extractAIC(x, k = 0)[2L]
    }
    cut.string <- function(string) {
        if (length(string) > 1L)
            string[-1L] <- paste("\n", string[-1L], sep = "")
        string
    }
    re.arrange <- function(keep) {
        namr <- names(k1 <- keep[[1L]])
        namc <- names(keep)
        nc <- length(keep)
        nr <- length(k1)
        array(unlist(keep, recursive = FALSE), c(nr, nc), list(namr, namc))
    }
    step.results <- function(models, fit, object, usingCp = FALSE) {
        change <- sapply(models, "[[", "change")
        rd <- sapply(models, "[[", "deviance")
        dd <- c(NA, abs(diff(rd)))
        rdf <- sapply(models, "[[", "df.resid")
        ddf <- c(NA, abs(diff(rdf)))
        AICc <- sapply(models, "[[", "AICc")
        heading <- c("Stepwise Model Path \nAnalysis of Deviance Table", "\nInitial Model:", deparse(as.vector(formula(object))), "\nFinal Model:", deparse(as.vector(formula(fit))), "\n")
        aod <- if (usingCp)
            data.frame(Step = change, Df = ddf, Deviance = dd, `Resid. Df` = rdf, `Resid. Dev` = rd, Cp = AICc, check.names = FALSE)
        else data.frame(Step = change, Df = ddf, Deviance = dd, `Resid. Df` = rdf, `Resid. Dev` = rd, AICc = AICc, check.names = FALSE)
        attr(aod, "heading") <- heading
        class(aod) <- c("Anova", "data.frame")
        fit$anova <- aod
        fit
    }
    Terms <- terms(object)
    object$formula <- Terms
    if (inherits(object, "lme"))
        object$call$fixed <- Terms
    else if (inherits(object, "gls"))
        object$call$model <- Terms
    else object$call$formula <- Terms
    if (use.start)
        warning("'use.start' cannot be used with R's version of glm")
    md <- missing(direction)
    direction <- match.arg(direction)
    backward <- direction == "both" | direction == "backward"
    forward <- direction == "both" | direction == "forward"
    if (missing(scope)) {
        fdrop <- numeric(0)
        fadd <- attr(Terms, "factors")
        if (md)
            forward <- FALSE
    }
    else {
        if (is.list(scope)) {
            fdrop <- if (!is.null(fdrop <- scope$lower))
                attr(terms(update.formula(object, fdrop)), "factors")
            else numeric(0)
            fadd <- if (!is.null(fadd <- scope$upper))
                attr(terms(update.formula(object, fadd)), "factors")
        }
        else {
            fadd <- if (!is.null(fadd <- scope))
                attr(terms(update.formula(object, scope)), "factors")
            fdrop <- numeric(0)
        }
    }
    models <- vector("list", steps)
    if (!is.null(keep))
        keep.list <- vector("list", steps)
    if (is.list(object) && (nmm <- match("nobs", names(object), 0)) > 0)
        n <- object[[nmm]]
    else n <- length(residuals(object))
    fit <- object
    bAIC<- extractAIC(fit, scale, k = k, ...)
    edf <- bAIC[1L] #extracts the number of parameters, k=edf

    bAIC <- bAIC[2L] + ((2 * edf * (edf + 1)) / (n - edf - 1))

    if (is.na(bAIC))
        stop("AICc is not defined for this model, so stepAIC cannot proceed")
    nm <- 1
    Terms <- terms(fit)
    if (trace) {
        cat("Start:  AICc=", format(round(bAIC, 2)), "\n", cut.string(deparse(as.vector(formula(fit)))), "\n\n", sep = "")
        utils::flush.console()
    }
    models[[nm]] <- list(deviance = mydeviance(fit), df.resid = n - edf, change = "", AICc = bAIC)
    if (!is.null(keep))
        keep.list[[nm]] <- keep(fit, bAIC)
    usingCp <- FALSE
    while (steps > 0) {
        steps <- steps - 1
        AICc <- bAIC
        ffac <- attr(Terms, "factors")
        if (!is.null(sp <- attr(Terms, "specials")) && !is.null(st <- sp$strata))
            ffac <- ffac[-st, ]
        scope <- factor.scope(ffac, list(add = fadd, drop = fdrop))
        aod <- NULL
        change <- NULL
        if (backward && length(scope$drop)) {

            aod <- dropterm.AICc(fit, scope$drop, scale = scale, trace = max(0, trace - 1), k = k, ...)

            rn <- row.names(aod)
            row.names(aod) <- c(rn[1L], paste("-", rn[-1L], sep = " "))
            if (any(aod$Df == 0, na.rm = TRUE)) {
                zdf <- aod$Df == 0 & !is.na(aod$Df)
                nc <- match(c("Cp", "AICc"), names(aod))
                nc <- nc[!is.na(nc)][1L]
                ch <- abs(aod[zdf, nc] - aod[1, nc]) > 0.01
                if (any(ch)) {
                  warning("0 df terms are changing AICc")
                  zdf <- zdf[!ch]
                }
                if (length(zdf) > 0L)
                  change <- rev(rownames(aod)[zdf])[1L]
            }
        }
        if (is.null(change)) {
            if (forward && length(scope$add)) {

                aodf <- addterm.AICc(fit, scope$add, scale = scale, trace = max(0, trace - 1), k = k, ...)

                rn <- row.names(aodf)
                row.names(aodf) <- c(rn[1L], paste("+", rn[-1L], sep = " "))
                aod <- if (is.null(aod))
                  aodf
                else rbind(aod, aodf[-1, , drop = FALSE])
            }
            attr(aod, "heading") <- NULL
            if (is.null(aod) || ncol(aod) == 0)
                break
            nzdf <- if (!is.null(aod$Df))
                aod$Df != 0 | is.na(aod$Df)
            aod <- aod[nzdf, ]
            if (is.null(aod) || ncol(aod) == 0)
                break
            nc <- match(c("Cp", "AICc"), names(aod))
            nc <- nc[!is.na(nc)][1L]
            o <- order(aod[, nc])
            if (trace) {
                print(aod[o, ])
                utils::flush.console()
            }
            if (o[1L] == 1)
                break
            change <- rownames(aod)[o[1L]]
        }
        usingCp <- match("Cp", names(aod), 0) > 0
        fit <- update(fit, paste("~ .", change), evaluate = FALSE)
        fit <- eval.parent(fit)
        if (is.list(fit) && (nmm <- match("nobs", names(fit), 0)) > 0)
            nnew <- fit[[nmm]]
        else nnew <- length(residuals(fit))
        if (nnew != n)
            stop("number of rows in use has changed: remove missing values?")
        Terms <- terms(fit)

        bAIC <- extractAIC(fit, scale, k = k, ...)
        edf <- bAIC[1L]

        bAIC <- bAIC[2L] + ((2 * edf * (edf + 1)) / (nnew - edf - 1))

        if (trace) {
            cat("\nStep:  AICc=", format(round(bAIC, 2)), "\n", cut.string(deparse(as.vector(formula(fit)))), "\n\n", sep = "")
            utils::flush.console()
        }
        if (bAIC >= AICc + 1e-07)

            break
        nm <- nm + 1
        models[[nm]] <- list(deviance = mydeviance(fit), df.resid = n - edf, change = change, AICc = bAIC)
        if (!is.null(keep))
            keep.list[[nm]] <- keep(fit, bAIC)
    }
    if (!is.null(keep))
        fit$keep <- re.arrange(keep.list[seq(nm)])
    step.results(models = models[seq(nm)], fit, object, usingCp)
}

dropterm.AICc <- function (object, scope, scale = 0, test = c("none", "Chisq"), k = 2, sorted = FALSE, trace = FALSE, ...)
{
    tl <- attr(terms(object), "term.labels")

    if (missing(scope))
        scope <- drop.scope(object)
    else {
        if (!is.character(scope))
            scope <- attr(terms(update.formula(object, scope)), "term.labels")
        if (!all(match(scope, tl, 0L)))
            stop("scope is not a subset of term labels")
    }

    ns <- length(scope)

    ans <- matrix(nrow = ns + 1L, ncol = 2L, dimnames = list(c("<none>", scope), c("df", "AICc")))

    n <- length(object$residuals)
    edf <- extractAIC(object, scale, k = k, ...)[1L]

    ans[1, ] <- rbind(
	edf,
	extractAIC(object, scale, k = k, ...)[2L] + ((2 * edf * (edf + 1)) / (n - edf - 1)) #calculate AICc
    )

    env <- environment(formula(object))
    n0 <- length(object$residuals)

    for (i in seq(ns)) {
        tt <- scope[i]
        if (trace) {
            message("trying -", tt)
            utils::flush.console()
        }

        nfit <- update(object, as.formula(paste("~ . -", tt)), evaluate = FALSE)
        nfit <- eval(nfit, envir = env)

	n <- length(nfit$residuals)
	edf <- extractAIC(nfit, scale, k = k, ...)[1L]

        ans[i+1, ] <- rbind(edf, extractAIC(nfit, scale, k = k, ...)[2L] + ((2 * edf * (edf + 1)) / (n - edf - 1))) #calculate AICc

        if (length(nfit$residuals) != n0)
            stop("number of rows in use has changed: remove missing values?")
    }

    dfs <- ans[1L, 1L] - ans[, 1L]
    dfs[1L] <- NA

    aod <- data.frame(Df = dfs, AICc = ans[, 2])
    o <- if (sorted) {
        order(aod$AICc)
    }
    else seq_along(aod$AICc)

    test <- match.arg(test)
    if (test == "Chisq") {
        dev <- ans[, 2L] - k * ans[, 1L]
        dev <- dev - dev[1L]
        dev[1L] <- NA
        nas <- !is.na(dev)
        P <- dev
        P[nas] <- safe_pchisq(dev[nas], dfs[nas], lower.tail = FALSE)
        aod[, c("LRT", "Pr(Chi)")] <- list(dev, P)
    }
    aod <- aod[o, ]
    head <- c("Single term deletions", "\nModel:", deparse(as.vector(formula(object))))
    if (scale > 0) {
        head <- c(head, paste("\nscale: ", format(scale), "\n"))
    }
    class(aod) <- c("anova", "data.frame")
    attr(aod, "heading") <- head
    aod
}

addterm.AICc <- function (object, scope, scale = 0, test = c("none", "Chisq"), k = 2, sorted = FALSE, trace = FALSE, ...) {
    if (missing(scope) || is.null(scope))
        stop("no terms in scope")
    if (!is.character(scope))
        scope <- add.scope(object, update.formula(object, scope))
    if (!length(scope))
        stop("no terms in scope for adding to object")
    ns <- length(scope)
    ans <- matrix(nrow = ns + 1L, ncol = 2L, dimnames = list(c("<none>", scope), c("df", "AICc")))
    n <- length(residuals(object))
    edf <- extractAICc(object, scale, k = k, ...)[1L]
    ans[1, ] <- rbind(edf, extractAICc(object, scale, k = k, ...)[2L] + ((2 * edf * (edf + 1)) / (n - edf - 1))) #calculate AICc

    n0 <- length(object$residuals)
    env <- environment(formula(object))
    for (i in seq(ns)) {
        tt <- scope[i]
        if (trace) {
            message("trying +", tt)
            utils::flush.console()
        }
        nfit <- update(object, as.formula(paste("~ . +", tt)), evaluate = FALSE)
        nfit <- eval(nfit, envir = env)
        edf <- extractAICc(nfit, scale, k = k, ...)[1L]
        ans[i+1, ] <- rbind(edf, extractAICc(nfit, scale, k = k, ...)[2L] + ((2 * edf * (edf + 1)) / (n - edf - 1))) #calculate AICc

        if (length(nfit$residuals) != n0)
            stop("number of rows in use has changed: remove missing values?")
    }
    dfs <- ans[, 1L] - ans[1L, 1L]
    dfs[1L] <- NA

    aod <- data.frame(Df = dfs, AICc = ans[, 2])

    o <- if (sorted) {
        order(aod$AICc)
    }
    else seq_along(aod$AICc)

    test <- match.arg(test)
    if (test == "Chisq") {
        dev <- ans[, 2L] - k * ans[, 1L]
        dev <- dev[1L] - dev
        dev[1L] <- NA
        nas <- !is.na(dev)
        P <- dev
        P[nas] <- safe_pchisq(dev[nas], dfs[nas], lower.tail = FALSE)
        aod[, c("LRT", "Pr(Chi)")] <- list(dev, P)
    }
    aod <- aod[o, ]
    head <- c("Single term additions", "\nModel:", deparse(as.vector(formula(object))))
    if (scale > 0) {
        head <- c(head, paste("\nscale: ", format(scale), "\n"))
    }
    class(aod) <- c("anova", "data.frame")
    attr(aod, "heading") <- head
    aod
}
#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/subplot.R"
subplot <- function(fun, x, y=NULL, size=c(1,1), vadj=0.5, hadj=0.5, pars=NULL) {

  old.par <- par(no.readonly=TRUE)
  on.exit(par(old.par))

  if(missing(x)) x <- locator(2)
  xy <- xy.coords(x,y)

  if(length(xy$x) != 2){
    pin <- par('pin')
    tmp <- cnvrt.coords(xy$x[1],xy$y[1],'usr')$plt

    x <- c( tmp$x - hadj*size[1]/pin[1],
            tmp$x + (1-hadj)*size[1]/pin[1] )
    y <- c( tmp$y - vadj*size[2]/pin[2],
            tmp$y + (1-vadj)*size[2]/pin[2] )

    xy <- cnvrt.coords(x,y,'plt')$fig
  } else {
    xy <- cnvrt.coords(xy,,'usr')$fig
  }

  par(pars)
  par(plt=c(xy$x,xy$y), new=TRUE)
  fun
  tmp.par <- par(no.readonly=TRUE)
  
  return(invisible(tmp.par))
}
#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/termplot.gd.R"
"termplot.gd" <-
function (model, data = NULL, envir = environment(formula(model)), 
    partial.resid = FALSE, rug = FALSE, terms = NULL, se = FALSE, 
    xlabs = NULL, ylabs = NULL, main = NULL, col.term = 2, lwd.term = 1.5, 
    col.se = "orange", lty.se = 2, lwd.se = 1, col.res = "gray", 
    cex = 1, pch = par("pch"), col.smth = "darkred", lty.smth = 2, 
    span.smth = 2/3, ask = interactive() && nb.fig < n.tms && 
        .Device != "postscript", use.factor.levels = TRUE, smooth = NULL, 
    ...) 
{
	if (!is.null(model$family)) {
		if (model$family$link == "log") FUN <- exp
		else if (model$family$link == "logit") FUN <- 1/(1+exp(-x))
	}
	else FUN <- function(x) x
	
    which.terms <- terms
    terms <- if (is.null(terms)) 
        predict(model, type = "terms", se = se)
    else predict(model, type = "terms", se = se, terms = terms)
    n.tms <- ncol(tms <- as.matrix(if (se) 
        terms$fit
    else terms))
    mf <- model.frame(model)
    if (is.null(data)) 
        data <- eval(model$call$data, envir)
    if (is.null(data)) 
        data <- mf
    if (NROW(tms) < NROW(data)) {
        use.rows <- match(rownames(tms), rownames(data))
    }
    else use.rows <- NULL
    nmt <- colnames(tms)
    cn <- parse(text = nmt)
    if (!is.null(smooth)) 
        smooth <- match.fun(smooth)
    if (is.null(ylabs)) 
        ylabs <- paste("Partial for", nmt)
    if (is.null(main)) 
        main <- ""
    else if (is.logical(main)) 
        main <- if (main) 
            deparse(model$call, 500)
        else ""
    else if (!is.character(main)) 
        stop("'main' must be TRUE, FALSE, NULL or character (vector).")
    main <- rep(main, length = n.tms)
    pf <- envir
    carrier <- function(term) {
        if (length(term) > 1) 
            carrier(term[[2]])
        else eval(term, data, enclos = pf)
    }
    carrier.name <- function(term) {
        if (length(term) > 1) 
            carrier.name(term[[2]])
        else as.character(term)
    }
    if (is.null(xlabs)) 
        xlabs <- unlist(lapply(cn, carrier.name))
    if (partial.resid || !is.null(smooth)) {
        pres <- residuals(model, "partial")
        if (!is.null(which.terms)) 
            pres <- pres[, which.terms, drop = FALSE]
    }
    is.fac <- sapply(nmt, function(i) is.factor(mf[, i]))
    se.lines <- function(x, iy, i, ff = 2) {
        tt <- ff * terms$se.fit[iy, i]
        lines(x, tms[iy, i] + tt, lty = lty.se, lwd = lwd.se, 
            col = col.se)
        lines(x, tms[iy, i] - tt, lty = lty.se, lwd = lwd.se, 
            col = col.se)
    }
    nb.fig <- prod(par("mfcol"))
    if (ask) {
        op <- par(ask = TRUE)
        on.exit(par(op))
    }
    for (i in 1:n.tms) {
        ylims <- range(tms[, i], na.rm = TRUE)
        if (se) 
            ylims <- range(ylims, tms[, i] + 1.05 * 2 * terms$se.fit[, 
                i], tms[, i] - 1.05 * 2 * terms$se.fit[, i], 
                na.rm = TRUE)
        if (partial.resid) 
            ylims <- range(ylims, pres[, i], na.rm = TRUE)
        if (rug) 
            ylims[1] <- ylims[1] - 0.07 * diff(ylims)
        if (is.fac[i]) {
            ff <- mf[, nmt[i]]
            if (!is.null(model$na.action)) 
                ff <- naresid(model$na.action, ff)
            ll <- levels(ff)
            xlims <- range(seq_along(ll)) + c(-0.5, 0.5)
            xx <- as.numeric(ff)
            if (rug) {
                xlims[1] <- xlims[1] - 0.07 * diff(xlims)
                xlims[2] <- xlims[2] + 0.03 * diff(xlims)
            }
            plot(1, 0, type = "n", xlab = xlabs[i], ylab = ylabs[i], 
                xlim = xlims, ylim = ylims, main = main[i], xaxt = "n", 
                ...)
            if (use.factor.levels) 
                axis(1, at = seq_along(ll), labels = ll, ...)
            else axis(1)
            for (j in seq_along(ll)) {
                ww <- which(ff == ll[j])[c(1, 1)]
                jf <- j + c(-0.4, 0.4)
                lines(jf, tms[ww, i], col = col.term, lwd = lwd.term, 
                  ...)
                if (se) 
                  se.lines(jf, iy = ww, i = i)
            }
        }
        else {
            xx <- carrier(cn[[i]])
            if (!is.null(use.rows)) 
                xx <- xx[use.rows]
            xlims <- range(xx, na.rm = TRUE)
            if (rug) 
                xlims[1] <- xlims[1] - 0.07 * diff(xlims)
            oo <- order(xx)
            plot(xx[oo], tms[oo, i], type = "l", xlab = xlabs[i], 
                ylab = ylabs[i], xlim = xlims, ylim = ylims, 
                main = main[i], col = col.term, lwd = lwd.term, 
                ...)
            if (se) 
                se.lines(xx[oo], iy = oo, i = i)
        }
        if (partial.resid) {
            if (!is.fac[i] && !is.null(smooth)) {
                smooth(xx, pres[, i], lty = lty.smth, cex = cex, 
                  pch = pch, col = col.res, col.smooth = col.smth, 
                  span = span.smth)
            }
            else points(xx, pres[, i], cex = cex, pch = pch, 
                col = col.res)
        }
        if (rug) {
            n <- length(xx)
            lines(rep.int(jitter(xx), rep.int(3, n)), rep.int(ylims[1] + 
                c(0, 0.05, NA) * diff(ylims), n))
            if (partial.resid) 
                lines(rep.int(xlims[1] + c(0, 0.05, NA) * diff(xlims), 
                  n), rep.int(pres[, i], rep.int(3, n)))
        }
    }
    invisible(n.tms)
}

#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/termsplot.R"
`termsplot` <-
function (model, data = NULL, envir = environment(formula(model)), 
    partial.resid = TRUE, rug = FALSE, terms = NULL, se = TRUE, nse = 2,
    se.vbars = TRUE, se.gap = 0.015, se.hbars = TRUE, se.hbars.wid = 0.2,
    pts.factor = TRUE, pch.factor = par("pch"), cex.factor = 1.5 * par("cex"),
    xlabs = NULL, ylabs = NULL, main = NULL, col.term = "darkblue", lwd.term = 1.5, 
    col.se = "blue", lty.se = 1, lwd.se = 1, col.res = "gray75", 
    cex.res = par("cex"), pch.res = par("pch"), col.smth = "darkred", lty.smth = 2, 
    span.smth = 2/3, ask = interactive() && nb.fig < n.tms && .Device != "postscript",
    use.factor.levels = TRUE, smooth = NULL, ...) 
{
    which.terms <- terms
    terms <- if (is.null(terms)) 
        predict(model, type = "terms", se = se)
    else predict(model, type = "terms", se = se, terms = terms)
    n.tms <- ncol(tms <- as.matrix(if (se) 
        terms$fit
    else terms))
    mf <- model.frame(model)
    if (is.null(data)) 
        data <- eval(model$call$data, envir)
    if (is.null(data)) 
        data <- mf
    if (NROW(tms) < NROW(data)) {
        use.rows <- match(rownames(tms), rownames(data))
    }
    else use.rows <- NULL
    nmt <- colnames(tms)
    cn <- parse(text = nmt)
    if (!is.null(smooth)) 
        smooth <- match.fun(smooth)
    if (is.null(ylabs)) 
        ylabs <- paste("Partial for", nmt)
    if (is.null(main)) 
        main <- ""
    else if (is.logical(main)) 
        main <- if (main) 
            deparse(model$call, 500)
        else ""
    else if (!is.character(main)) 
        stop("'main' must be TRUE, FALSE, NULL or character (vector).")
    main <- rep(main, length = n.tms)
    pf <- envir
    carrier <- function(term) {
        if (length(term) > 1) 
            carrier(term[[2]])
        else eval(term, data, enclos = pf)
    }
    carrier.name <- function(term) {
        if (length(term) > 1) 
            carrier.name(term[[2]])
        else as.character(term)
    }
    if (is.null(xlabs)) 
        xlabs <- unlist(lapply(cn, carrier.name))
    if (partial.resid || !is.null(smooth)) {
        pres <- residuals(model, "partial")
        if (!is.null(which.terms)) 
            pres <- pres[, which.terms, drop = FALSE]
    }
    is.fac <- sapply(nmt, function(i) is.factor(mf[, i]))
    plot.se.hbars <- function(x, iy, i, ff = 2) {
        tt <- ff * terms$se.fit[iy, i]
        lines(x, tms[iy, i] + tt, lty = lty.se, lwd = lwd.se, 
            col = col.se)
        lines(x, tms[iy, i] - tt, lty = lty.se, lwd = lwd.se, 
            col = col.se)
    }
    plot.se.vbars <- function(x, iy, i, ff = 2) {
        tt <- ff * terms$se.fit[iy, i]
        gap <- se.gap * diff(par()$usr[3:4])
        if (gap < tt) {
	        lines(x, tms[iy, i] + c(tt,gap), lty = lty.se, lwd = lwd.se, 
	            col = col.se)
	        lines(x, tms[iy, i] - c(tt,gap), lty = lty.se, lwd = lwd.se, 
	            col = col.se)
        }
    }

    nb.fig <- prod(par("mfcol"))
    if (ask) {
        op <- par(ask = TRUE)
        on.exit(par(op))
    }
    for (i in 1:n.tms) {
        ylims <- range(tms[, i], na.rm = TRUE)
        if (se) 
            ylims <- range(ylims, tms[, i] + 1.05 * 2 * terms$se.fit[, 
                i], tms[, i] - 1.05 * 2 * terms$se.fit[, i], na.rm = TRUE)
        if (partial.resid) 
            ylims <- range(ylims, pres[, i], na.rm = TRUE)
        if (rug) 
            ylims[1] <- ylims[1] - 0.07 * diff(ylims)

        if (is.fac[i]) {
            ff <- mf[, nmt[i]]
            if (!is.null(model$na.action)) 
                ff <- naresid(model$na.action, ff)
            ll <- levels(ff)
            xlims <- range(seq_along(ll)) + c(-0.5, 0.5)
            xx <- as.numeric(ff)
            if (rug) {
                xlims[1] <- xlims[1] - 0.07 * diff(xlims)
                xlims[2] <- xlims[2] + 0.03 * diff(xlims)
            }
            plot(1, 0, type = "n", xlab = xlabs[i], ylab = ylabs[i], 
                xlim = xlims, ylim = ylims, main = main[i], xaxt = "n", ...)
            if (use.factor.levels) 
                axis(1, at = seq_along(ll), labels = ll, ...)
            else axis(1)
            for (j in seq_along(ll)) {
                ww <- which(ff == ll[j])[c(1,1)]
	              jf <- j + c(-1, 1) * se.hbars.wid
                if (pts.factor) {
	                points(j, tms[ww[1], i], col = col.term, cex=cex.factor, 
	                pch = pch.factor, ...)
                } 
                else {  
	                lines(jf, tms[ww, i], col = col.term, lwd = lwd.term, ...)
                }
                if (se) {
                   if (se.hbars) plot.se.hbars(jf, iy = ww, i = i, ff = nse)
            			if (se.vbars) plot.se.vbars(j[c(1,1)], iy = ww[1], i = i, ff = nse)
            		}
            }
        }
        else {
            xx <- carrier(cn[[i]])
            if (!is.null(use.rows)) 
                xx <- xx[use.rows]
            xlims <- range(xx, na.rm = TRUE)
            if (rug) 
                xlims[1] <- xlims[1] - 0.07 * diff(xlims)
            oo <- order(xx)
            plot(xx[oo], tms[oo, i], type = "l", xlab = xlabs[i], 
                ylab = ylabs[i], xlim = xlims, ylim = ylims, 
                main = main[i], col = col.term, lwd = lwd.term, 
                ...)
            if (se) 
                plot.se.hbars(xx[oo], iy = oo, i = i, ff = nse)
        }


        if (partial.resid) {
            if (!is.fac[i] && !is.null(smooth)) {
                smooth(xx, pres[, i], lty = lty.smth, cex = cex.res, 
                  pch = pch.res, col = col.res, col.smooth = col.smth, 
                  span = span.smth)
            }
            else points(jitter(xx), pres[, i], cex = cex.res, pch = pch.res, 
                col = col.res)
        }
        if (rug) {
            n <- length(xx)
            lines(rep.int(jitter(xx), rep.int(3, n)), rep.int(ylims[1] + 
                c(0, 0.05, NA) * diff(ylims), n))
            if (partial.resid) 
                lines(rep.int(xlims[1] + c(0, 0.05, NA) * diff(xlims), 
                  n), rep.int(pres[, i], rep.int(3, n)))
        }



    }
    invisible(n.tms)
}
#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/toRfiles.R"
"toRfiles" <-
function (from = "d:/rwork/infile.R", to = "d:/aaa/dump/")
{
    cat("Sourcing files from ",from,"\n")
    source(from)
    print(files <- ls(pos=1,all=TRUE))
    nf <- length(files)
    cat("Dumping files to ",to,"\n")
    for (i in 1:nf)     {
    dump(ls(pos=1,all=TRUE)[i], file = paste(to, files[i], ".R", sep = ""))
    }
}
#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/treeform.R"
treeform <-
function (data, ycol, xcol, FUN, maxy = 20, gam = F, cbind = F, extra) 
{
    ny <- length(ycol)
    nx <- ifelse(xcol[1] != 0, length(xcol), 0)
    dnames <- colnames(data)
    if (gam) {
        for (i in 1:nx) if (is.numeric(data[,xcol[i]])) 
       		dnames[xcol[i]] <- paste("s(",dnames[xcol[i]],")")
    }
    if (ny > maxy) {
        yy <- deparse(substitute(ycol))
        ty <- paste("as.matrix(", deparse(substitute(data)), 
            "[,", yy, "])", collapse = "", sep = "")
        if (!missing(FUN)) 
            ty <- paste(deparse(substitute(FUN)), "(", ty, ")", 
                sep = "")
        if (nx > 1) 
            tx <- paste(dnames[xcol], collapse = "+")
        else if (nx == 1) 
            tx <- dnames[xcol]
        else tx <- "1"
        form <- paste(ty, tx, collapse = "", sep = "~")
    }
    else {
        if (ny > 1) {
            if (cbind) {
                ty <- paste(dnames[ycol], collapse = ",")
                ty <- paste("cbind(", ty, ")", collapse = "", 
                  sep = "")
            }
            else ty <- paste(dnames[ycol], collapse = "+")
        }
        else if (ny == 1) 
            ty <- dnames[ycol]
        else ty <- ""
        if (!missing(FUN)) 
            ty <- paste(deparse(substitute(FUN)), "(", ty, ")", 
                sep = "")
        if (nx > 1) 
            tx <- paste(dnames[xcol], collapse = "+")
        else if (nx == 1) 
            tx <- dnames[xcol]
        else tx <- "1"
        if (missing(extra)) 
            form <- paste(ty, "~", tx, collapse = "", sep = "")
        else form <- paste(ty, "~", extra, tx, collapse = "", 
            sep = "")
    }
    formula(form)
}
#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/u2m.R"
"u2m" <-
function (data, new.rows, new.cols, response, carrys, missings = 0,
    check.grps = T, check.carrys = T)
{

#
# new.rows are the col numbers that define the new rows (OUs)
# new.cols is the col number that defines the new cols ("times")
# response is the col number of the response
# carrys are the col numbers to be carried (ie converted to non-time varying covariates)
# missings is the value filled into non entries in the new response matrix
# check.grps checks if duplicates entries exist in the new response matrix
# check.carrys checkd for time varying carried variables
#
#  Fixed order bug -- GD -- 18-8-04
#
    number <- function(x) {
        match(x, sort(unique(x)))
    }
    if (length(new.rows) > 1)
        pmat <- do.call("paste", as.data.frame(data[,
            new.rows]))
    else pmat <- data[, new.rows]
    if (!missing(carrys))
        uxx <- data[!duplicated(pmat), unique(c(new.rows, carrys)),
            drop = F]
    else uxx <- data[!duplicated(pmat), new.rows, drop = F]
    uni.pmat <- unique(pmat)
    uxx <- uxx[order(uni.pmat),]
    nr <- nrow(uxx)
    if (check.carrys & !missing(carrys))
        if ((zln <- length(z <- unique(do.call("paste", data.frame(pmat,
            data[, carrys]))))) != nr)
            cat(" Warning -- carry column values vary over 'time'\n")
    gnames <- sort(unique(as.character(data[, new.cols])))
    grp <- number(data[, new.cols])
    y <- data[, response, drop=F]
    nc <- max(grp)
    xx <- matrix(missings, nrow = nr, ncol = nc)
    lsty <- split(y, pmat)
    lstg <- split(grp, pmat)
    if (check.grps)
        if (any(table(pmat, grp) > 1))
            cat(" Warning -- duplicates of y values in groups\n")
    for (i in 1:nr) xx[i, match(lstg[[i]], 1:nc)] <- lsty[[i]]
    colnames(xx) <- gnames
    xx <- data.frame(uxx, xx)
    xx
}

#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/unfactor.R"
"unfactor" <-
function(df)
{
    fact.cols <- sapply(df, is.factor)
    change.cols <- seq(along = fact.cols)[!is.na(match(fact.cols,T))]
    if(length(change.cols) == 0)
        cat(paste("No factors to change in", as.character(substitute(df)), "\n"))
    else {
        options(warn = -1)
        on.exit(options(warn = 0))
        for(i in change.cols) {
            levels.i <- levels(df[[i]])
            level.nos <- as.numeric(levels.i)
            numbers <- ifelse(any(is.na(level.nos)), F, T)
            if(numbers)
                df[, i] <- as.numeric(I(as.character(df[, i])))
            else df[, i] <- I(as.character(df[, i]))
        }
    }
    df
}

#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/unique.within.R"
unique.within <- function(outer,inner) {
	number <- function(x) match(x, sort(unique(x)))
	unlist(sapply(split(inner,outer),number))
}


#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/varcomp.R"
"varcomp" <- 
function (x, scale = FALSE, cum = FALSE) 
{
    if (!("lme" %in% class(x))) 
        stop("Object \"x\" is not of class \"lme\"")
    res <- seq(along = x$modelStruct$reStruct)
    var <- vector(length = length(res) + 1)
    for (i in res) {
        var[length(var) - i] <- attr(summary(x$modelStruct$reStruct[[i]]), 
            "stdDev")[1] * x$sigma
    }
    var[length(var)] <- x$sigma
    var <- var^2
    if (scale) 
        var <- var/sum(var)
    if (cum) 
        var <- cumsum(var)
    names(var) <- c(rev(names(x$modelStruct$reStruct)), "Within")
    class(var) <- "varcomp"
    return(var)
}

"plot.varcomp" <-
function (x, xlab = "Levels", ylab = "Variance", type = "b", 
    ...) 
{
    if (!("varcomp" %in% class(x))) 
        stop("Object \"x\" is not of class \"varcomp\"")
    return(xyplot(x ~ ordered(names(x), levels = rev(names(x))), 
        xlab = xlab, ylab = ylab, type = type, ...))
}
#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/wideMat.R"
wideMat <-
function (data, rows, cols, values, mval = 0, add.rows = T) 
{
	splitter <- function(x,xlabs) {
		lst <- do.call("rbind",lapply(strsplit(as.character(x),"\\."),unlist))
		if (!missing(xlabs)) names(lst) <- xlabs
		data.frame(x,lst)
	}
    if (add.rows) 
        name.row <- colnames(data)[rows]
    rrows <- rows
    if (length(rows)>1) rows <- interaction(data[, rrows])
    else rows <- data[, rrows]
    cols <- data[, cols]
    values <- data[, values]
    if (any(d <- duplicated(paste(rows, cols)))) 
        warning(paste("Entry", which(d), "is a duplicate\n"))
    rows <- rows[!d]
    cols <- cols[!d]
    values <- values[!d]
    rl <- sort(unique(rows))
    cl <- sort(unique(cols))
    M <- array(mval, dim = c(length(rl), length(cl)), dimnames = list(rl, cl))
    M[cbind(match(rows, rl), match(cols, cl))] <- values
    if (add.rows) {
        x <- splitter(rl,xlabs=name.row)
        M <- data.frame(x, M)
    }
    M
}

#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/wideMatrix.R"
wideMatrix <-
function (data, rows, cols, values, mval = 0, add.rows = T) 
{
    if (add.rows) 
        name.row <- colnames(data)[rows]
    rows <- data[, rows]
    cols <- data[, cols]
    values <- data[, values]
    if (any(d <- duplicated(paste(rows, cols)))) 
        warning(paste("Entry", which(d), "is a duplicate\n"))
    rows <- rows[!d]
    cols <- cols[!d]
    values <- values[!d]
    rl <- sort(unique(rows))
    cl <- sort(unique(cols))
    M <- array(mval, dim = c(length(rl), length(cl)), dimnames = list(rl, 
        cl))
    M[cbind(match(rows, rl), match(cols, cl))] <- values
    if (add.rows) {
        M <- data.frame(rl, M)
        colnames(M)[1] <- name.row
    }
    M
}

#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/wmat.R"
wmat <- function(data, rows, cols, values, mval = 0, add.rows = T) 
{
    if (add.rows) 
        name.row <- colnames(data)[rows]
    rrows <- rows
    if (length(rows)>1) rows <- interaction(data[, rrows])
    else rows <- data[, rrows]
    cols <- data[, cols]
    values <- data[, values]
    if (any(d <- duplicated(paste(rows, cols)))) 
        warning(paste("Entry", which(d), "is a duplicate\n"))
    rows <- rows[!d]
    cols <- cols[!d]
    values <- values[!d]
    rl <- sort(unique(rows))
    cl <- sort(unique(cols))
    M <- array(mval, dim = c(length(rl), length(cl)), dimnames = list(rl, cl))
    M[cbind(match(rows, rl), match(cols, cl))] <- values
    if (add.rows) {
        M <- data.frame(rl,expand.grid(lapply(data[, rrows],unique)), M)
        colnames(M)[1] <- "groups"
    }
    M
}

#line 1 "C:/DOCUME~1/Omni/LOCALS~1/Temp/Rtmp5Mo1DU/R.INSTALL49562c7f/gdTools/R/xpdf.R"
xpdf <- function(df) {
    mf <- function(x) {
        n <- length(x)
        uni <-sort(unique(x))
        nuni <- length(uni)
        xx<-matrix(0,nrow=length(x),ncol=nuni)
        for (i in 1:nuni) xx[,i] <- x==uni[i]
        colnames(xx)<-as.character(uni)
        xx
    }
    ncols <- ncol(df)
    for (i in 1:ncols) 
        if (is.factor(df[,i])|is.character(df[,i])|is.logical(df[,i])) 
            df[[i]] <- mf(df[[i]])
    df
}
