.packageName <- "mblm"
"confint.mblm" <-
function (object, parm, level = 0.95, ...) 
{
	res = c(0,0,0,0); dim(res) = c(2,2);
	rownames(res) = names(object$coefficients)
	colnames(res) = as.character(c((1-level)/2,1-(1-level)/2))	
	res[2,] = wilcox.test(object$slopes,conf.int=TRUE,conf.level=level)$conf.int
	res[1,] = wilcox.test(object$intercepts,conf.int=TRUE,conf.level=level)$conf.int

res

}

"mblm" <-
function (formula,dataframe,repeated=TRUE) 
{
 if (missing(dataframe)) 
        dataframe <- environment(formula)

term<-as.character(attr(terms(formula),"variables")[-1]);
x=dataframe[[term[2]]];
y=dataframe[[term[1]]];

if(length(term) > 2) { stop("Only linear models are accepted"); }

xx = sort(x)
yy = y[order(x)]
n = length(xx)

slopes = c()
intercepts = c()
smedians = c()
imedians = c()

if (repeated) {

for (i in 1:n) {
	slopes = c()
	intercepts = c()
	for (j in 1:n) {
		if (xx[j] != xx[i]) { slopes = c(slopes,(yy[j]-yy[i])/(xx[j]-xx[i]));
					    intercepts = c(intercepts,(xx[j]*yy[i]-xx[i]*yy[j])/(xx[j]-xx[i])); }
	}
		smedians = c(smedians,median(slopes));
		imedians = c(imedians,median(intercepts));
	}

	slope = median(smedians);
	intercept = median(imedians);
	}

else	{

	for (i in 1:(n-1)) {
		for (j in i:n) {
			if (xx[j] != xx[i]) { slopes = c(slopes,(yy[j]-yy[i])/(xx[j]-xx[i])); }
		}
	}

	slope = median(slopes);
	intercepts = yy - slope*xx;
	intercept = median(intercepts);

}


res=list();

res$coefficients=c(intercept,slope);
names(res$coefficients)=c("(Intercept)",term[2]);

res$residuals=y-slope*x-intercept;
names(res$residuals)=as.character(1:length(res$residuals));

res$fitted.values=x*slope+intercept;
names(res$fitted.values)=as.character(1:length(res$fitted.values));

if (repeated) {
	res$slopes = smedians;
	res$intercepts = imedians;
	}
	else	{
	res$slopes = slopes;
	res$intercepts = intercepts;
	}

res$df.residual=n-2;
res$rank=2;
res$terms=terms(formula);
res$call=match.call();
res$model=data.frame(y,x);

res$assign=c(0,1);

res$effects=lm(formula)$effects;
res$qr=lm(formula)$qr;
res$effects[2]=sqrt(sum((res$fitted-mean(res$fitted))^2));

res$xlevels=list();

names(res$model)=term;
attr(res$model,"terms")=terms(formula);

class(res)=c("mblm","lm");

res
			
}

"summary.mblm" <-
function (object, ...) 
{
    z <- object
    p <- z$rank
    Qr <- object$qr
    if (is.null(z$terms) || is.null(Qr)) 
        stop("invalid 'lm' object:  no 'terms' nor 'qr' component")
    n <- NROW(Qr$qr)
    rdf <- n - p
    if (is.na(z$df.residual) || rdf != z$df.residual) 
        warning("residual degrees of freedom in object suggest this is not an \"lm\" fit")
    p1 <- 1:p
    r <- z$residuals
    f <- z$fitted
    w <- z$weights
    if (is.null(w)) {
        mss <- if (attr(z$terms, "intercept")) 
            sum((f - mean(f))^2)
        else sum(f^2)
        rss <- sum(r^2)
    }
    else {
        mss <- if (attr(z$terms, "intercept")) {
            m <- sum(w * f/sum(w))
            sum(w * (f - m)^2)
        }
        else sum(w * f^2)
        rss <- sum(w * r^2)
        r <- sqrt(w) * r
    }
    resvar <- rss/rdf
    R <- chol2inv(Qr$qr[p1, p1, drop = FALSE])
    madval <- c(mad(z$intercepts),mad(z$slopes));
    est <- z$coefficients[Qr$pivot[p1]]
    vval <- c(wilcox.test(z$intercepts)$statistic,wilcox.test(z$slopes)$statistic);
    pval <- c(wilcox.test(z$intercepts)$p.value,wilcox.test(z$slopes)$p.value);
    ans <- z[c("call", "terms")]
    ans$residuals <- r;
    ans$coefficients <- cbind(est, madval, vval, pval)
    dimnames(ans$coefficients) <- list(names(z$coefficients)[Qr$pivot[p1]], 
        c("Estimate", "MAD", "V value", "Pr(>|V|)"))
    ans$aliased <- is.na(coef(object))
    ans$sigma <- sqrt(resvar)
    ans$df <- c(p, rdf, NCOL(Qr$qr))
    class(ans) <- "summary.lm"
    ans
}

