line <- function(x, y=NULL)
{
    xy <- xy.coords(x, y)
    ok <- complete.cases(xy$x,xy$y)
    n <- length(ok)
    if(n <= 1) stop("insufficient observations")
    z <- .C("tukeyline",
	    as.double(xy$x[ok]),
	    as.double(xy$y[ok]),
	    double(n),
	    double(n),
	    n,
	    double(2),
	    DUP=FALSE, PACKAGE="eda")
    value <- list(call=sys.call(), coefficients = z[[6]],
                  residuals = z[[3]], fitted.values = z[[4]])
    class(value) <- "tukeyline"
    value
}
coef.tukeyline <- coef.lm
residuals.tukeyline <- residuals.lm
fitted.tukeyline <- fitted.lm
print.tukeyline <- print.lm
medpolish <- function (x, eps=0.01, maxiter=10, trace.iter = TRUE)
{
    z <- as.matrix(x)
    nr <- nrow(z)
    nc <- ncol(z)
    t <- 0
    r <- numeric(nr)
    c <- numeric(nc)
    oldsum <- 0
    for(iter in 1:maxiter) {
	rdelta <- apply(z, 1, median)
	z <- z - matrix(rdelta, nr=nr, nc=nc)
	r <- r + rdelta
	delta <- median(c)
	c <- c - delta
	t <- t + delta
	cdelta <- apply(z, 2, median)
	z <- z - matrix(cdelta, nr=nr, nc=nc, byrow=TRUE)
	c <- c + cdelta
	delta <- median(r)
	r <- r - delta
	t <- t + delta
	newsum <- sum(abs(z))
	converged <- newsum==0 || abs(1-oldsum/newsum) < eps
        if(converged) break
	oldsum <- newsum
	if(trace.iter) cat(iter,":", newsum,"\n")
    }
    if(converged) { if(trace.iter) cat("Final:", newsum,"\n")
    } else warning(paste("medpolish() not converged in",maxiter,"iterations"))
    names(r) <- rownames(z)
    names(c) <- colnames(z)
    ans <- list(overall=t, row=r, col=c, residuals=z,
		name=deparse(substitute(x)))
    class(ans) <- "medpolish"
    ans
}

print.medpolish <- function(x, digits=getOption("digits"), ...)
{
    cat("\nMedian Polish Results (Dataset: \"", x$name, "\")\n", sep="")
    cat("\nOverall:", x$overall, "\n\nRow Effects:\n")
    print(x$row, digits=digits, ...)
    cat("\nColumn Effects:\n")
    print(x$col, digits=digits, ...)
    cat("\nResiduals:\n")
    print(x$residuals, digits=max(2, digits-2), ...)
    cat("\n")
    invisible(x)
}

plot.medpolish <- function(x, main="Tukey Additivity Plot", ...) {
    plot(outer(x$row,x$col)/x$overall, x$residuals,
	 main=main, xlab="Diagnostic Comparison Values",
	 ylab="Residuals", ...)
    abline(h=0, v=0, lty="dotted")
}
## do.ends = TRUE  is compatible with older behavior in R
## --------------  but *NOT*  with Colin Goodalls "smoother" "spl()"

smooth <- function(x, kind = c("3RS3R", "3RSS", "3RSR", "3R", "3", "S"),
                   twiceit = FALSE,
                   endrule = "Tukey", do.ends = FALSE)
{
    if(!is.numeric(x))
	stop("attempt to smooth non-numeric values")
    if(any(is.na(x)))
	stop("attempt to smooth NA values")
    rules <- c("copy","Tukey")#- exact order matters!
    if(is.na(iend <- pmatch(endrule, rules)))
        stop("wrong endrule")
    n <- length(x)
    kind <- match.arg(kind)
    if(substr(kind,1,3) == "3RS" && !do.ends)
        iend <- -iend
    else if(kind == "S")
        iend <- as.logical(do.ends)
    ## same number and type of arguments for all:
    smo <- .C(paste("Rsm", kind, sep="_"),
              as.double(x),
              y = double(n),
              n, iend,
              iter = integer(1),
              DUP=FALSE, PACKAGE="eda")[c("y","iter")]

    if(any(kind == c("R", "S"))) { # `iter' really was `changed'
        smo$iter <- as.logical(smo$iter)
        names(smo)[names(smo) == "iter"] <- "changed"
    }

    if(twiceit) {
        ## c2 <- match.call() and re-call with twiceit = FALSE
        r <- smooth(x - smo$y, kind = kind, twiceit = FALSE,
                    endrule = endrule, do.ends = do.ends)
        smo$y <- smo$y + r
        if(!is.null(smo$iter))
            smo$iter <- smo$iter + attr(r,"iter")
        if(!is.null(smo$changed))
            smo$changed <- smo$changed || attr(r,"changed")
    }
    if(is.ts(x))
	smo$y <- ts(smo$y, start=start(x), freq=frequency(x))

    structure(smo$y, kind = kind, twiced = twiceit,
              iter = smo$iter, changed = smo$changed,
              endrule = if(substr(kind,1,1) == "3") rules[iend],
              call = match.call(),
              class = c("tukeysmooth",if(is.ts(x)) "ts"))
}

print.tukeysmooth <- function(x, ...) {
    cat(attr(x,"kind"), "Tukey smoother resulting from ",
	deparse(attr(x, "call")),"\n")
    if(twiced <- attr(x,"twiced"))		cat(" __twiced__ ")
    if(!is.null(it <- attr(x,"iter")))		cat(" used", it, "iterations\n")
    if(!is.null(ch <- attr(x,"changed")))	cat(if(!ch)"NOT", "changed\n")
    if(length(class(x)) > 1)
	NextMethod()
    else {
	y <- x 
	attributes(y) <- NULL
	print(y, ...)
	invisible(x)
    }
}

summary.tukeysmooth <- function(object, ...) {
    cat(attr(object,"kind"), "Tukey smoother resulting from\n",
	deparse(attr(object, "call")),";  n =", length(object),"\n")
    if(twiced <- attr(object,"twiced"))		cat(" __twiced__ ")
    if(!is.null(it <- attr(object,"iter")))	cat(" used", it, "iterations\n")
    if(!is.null(ch <- attr(object,"changed")))	cat(if(!ch)" NOT", "changed\n")
    if(length(class(object)) > 1)
	NextMethod()
    else {
	y <- object
	attributes(y) <- NULL
	summary(y, ...)
    }
}


.First.lib <- function(lib, pkg) library.dynam("eda", pkg, lib)
