"rweib" <- 
function(n, alpha = 1., beta = 1.)
{
	if(alpha < 0.5)
		stop(" Sorry you don't have a density if alpha is \nless than .5!"
			)
	(beta * ( - log(runif(n)))^(1./alpha))
}

"sd" <- 
function(x)
{
	sqrt(var(x))
}

"set.panel" <- 
function(m = 1., n = 1.)
{
	par(mfrow = c(m, n))
	cat("plot window will lay out plots in a", m, "by", n, "matrix ", fill
		 = T)
	invisible()
}

"setup.slab" <- 
function(plt = T, disk = F)
{
	cat("Welcome to Slab", slab.version, fill = T)
	if(disk)
		# counter keeps track of the number of setups
		disk.quota()
	if(!exists(".counter"))
		.counter <- 0.
	.counter <<- .counter + 1.
	unique.seed()
	#   open up a plot window
	options(prompt = "Slab> ")
	if(plt) {
		error <- plot.window()
	}
	masked.men(ignore = c("attach.local", "attach.slab", ".Random.seed"))
	cat("End of Slab setup ... ", fill = T)
	invisible()
}

"simulate.reg" <- 
function(x, nrep, alpha = 0., beta = 1., DIST = rnorm, ...)
{
	n <- length(x)
	X <- matrix(x, ncol = n, nrow = nrep, byrow = T)
	Y <- (X * beta + alpha) + matrix(DIST(nrep * n, ...), ncol = n, nrow = 
		nrep)
	xc <- x - mean(x)
	ssxx <- sum(xc^2.)
	ssxy <- (Y * rep(xc, rep(nrep, n))) %*% rep(1., n)
	my <- Y %*% rep(1./n, n)
	ssyy <- ((Y - rep(my, n))^2.) %*% rep(1., n)
	b <- c(ssxy/ssxx)
	a <- c(my - b * mean(x))
	s2 <- c((ssyy - b * ssxy)/(n - 2.))
	#	list(my = my, Y = Y, a = b, b = b, s2 = s2, ssxx = ssxx, ssyy = ssyy, 
	#		ssxy = ssxy)
	list(a = a, b = b, s = sqrt(s2), ssx = ssxx, df = n - 2., x = x)
}

"simulate.samples" <- 
function(nrep, n, DIST, data = F, ...)
{
	cat("Simulated", nrep, " data sets each with ", n, "obserations", fill
		 = T)
	temp <- matrix(DIST(n * nrep, ...), ncol = n, nrow = nrep)
	xbar <- c(temp %*% rep(1./n, n))
	s <- c(sqrt((1./(n - 1.)) * ((temp - matrix(xbar, nrow = nrep, ncol = n
		))^2.) %*% rep(1., n)))
	if((n * nrep > 1000.) && data) {
		cat("don't forget that the matrix of simluated samples is a fairly large dataset",
			fill = T)
		cat("( ", n * nrep, 
			" values total) and you should delete this data set when you are",
			fill = T)
		cat("finished analyzing it.", fill = T)
	}
	if(data)
		return(list(dat = temp, m = xbar, s = s))
	else return(list(m = xbar, s = s))
}

"simulate.sums" <- 
function(nrep, n, DIST, ...)
{
	temp <- matrix(DIST(n * nrep, ...), ncol = n, nrow = nrep)
	c(temp %*% rep(1., n))
}

"slab.version" <- 
c("Version 2.1  August 23,1996", "", "", "Fri Feb 21 15:36:45 EST 1997")

"spline.int" <- 
function(x, y, xgrid)
{
	predict(smooth.spline(x, y, spar = 1.0000000000000001e-15), xgrid)
}

"spline.interp" <- 
function(x, y, xgrid)
{
	predict(smooth.spline(x, y, spar = 1.0000000000000001e-15), xgrid)
}

"ss.surface" <- 
function(a, b, FUN, pr = c(0.5, 0.75, 0.90000000000000002, 0.94999999999999996,
	0.98999999999999999))
{
	if(missing(b) | is.function(b)) {
		one.d <- T
		pars <- matrix(a, ncol = 1.)
		N <- length(a)
		if(is.function(b))
			FUN <- b
	}
	else {
		one.d <- F
		ma <- length(a)
		mb <- length(b)
		pars <- cbind(rep(a, mb), rep(b, rep(ma, mb)))
		N <- mb * ma
	}
	z <- rep(NA, N)
	cat("looping to", N, fill = T)
	for(k in 1.:N) {
		z[k] <- sum(FUN(c(pars[k,  ]))^2.)
		if(k/10. == floor(k)/10.)
			cat(k, " ")
	}
	cat("done", fill = T)
	if(one.d) {
		return(x = a, y = z)
	}
	else {
		levels <- NA
		lse <- c(pars[z == max(z), 1.], pars[z == max(z), 2.])
		return(x = a, y = b, z = matrix(z, ncol = mb, nrow = ma), 
			levels, lse)
	}
}

"stats" <- 
function(x, by, no.print = F)
{
	# coerce into matrix or list format
	if(!missing(by)) {
		x <- cat.to.list(c(x), by)
		if(!no.print) {
			cat("Data from ", substitute(x), 
				"is grouped based on the categories in ", 
				substitute(by), fill = T)
		}
	}
	if(!is.list(x) & !is.matrix(x))
		x <- matrix(x, ncol = 1.)
	if(is.list(x)) {
		ncol <- length(names(x))
		out <- matrix(NA, ncol = ncol, nrow = length(describe()))
		dimnames(out) <- list(describe(), names(x))
		for(j in (1.:ncol)) {
			if(is.numeric(x[[j]])) {
				out[, j] <- describe(x[[j]])
			}
		}
		return(out)
	}
	if(is.matrix(x)) {
		nc <- ncol(x)
		out <- matrix(NA, ncol = nc, nrow = length(describe()))
		dimnames(out) <- list(describe(), dimnames(x)[[2.]])
		for(j in (1.:nc)) {
			out[, j] <- describe(x[, j])
		}
		return(out)
	}
}

"summary.unbalanced" <- 
function(aov.obj)
{
	ans <- summary(aov.obj)
	cl <- class(ans)
	ans <- unclass(ans)
	t3 <- drop1(aov.obj,  ~ .)
	rn <- match(row.names(t3)[-1.], row.names(ans))
	ss <- unclass(t3)$"Sum of Sq"[-1.]
	nterms <- length(ans$Df)
	ans$"Sum of Sq"[rn] <- ss
	ans$"Mean Sq" <- ans$"Sum of Sq"/ans$Df
	ans$"F Value" <- ans$"Mean Sq"/ans$"Mean Sq"[nterms]
	ans$"F Value"[nterms] <- NA
	ans$"Pr(F)" <- 1. - pf(ans$"F Value", ans$Df, ans$Df[nterms])
	ans$"Pr(F)"[nterms] <- NA
	class(ans) <- cl
	attr(ans, "heading") <- "Sigma-restriction sums of squares"
	ans
}

"t.table" <- 
function(alpha, n)
{
	qt(1. - alpha, n)
}

"ted" <- 
function(data, file)
{
	if(missing(data))
		ed(editor = "ted")
	else if(missing(file))
		ed(data, editor = "ted")
	else ed(data, file, editor = "ted")
}

"unique.seed" <- 
function()
{
	ss <- as.integer(unix("date +'%H%M%S'"))
	ss <- as.integer(ss) + .counter
	i1 <- ss %% 1000.
	i2 <- ss %/% 1000. + .counter
	set.seed(i1)
	#	cat(ss, i1, i2, fill = T)
	runif(i2)
	invisible()
}

"view" <- 
function(x, maxlines = 10., digits = NULL, quote = T, right = F, 
	abbreviate.labels = F, ...)
{
	if(is.matrix(x)) {
		if(class(x) == "data.frame")
			NR <- length(x[, 1.])
		else NR <- nrow(x)
		if(NR > maxlines) {
			x <- x[1.:maxlines,  ]
			cat(NR - maxlines, 
				" remaining rows have not been listed", fill = 
				T)
		}
	}
	x
}

"world" <- 
function(ylim = c(-90., 90.), xlim = c(-180., 180.), add = F, ...)
{
	if(!add) {
		plot(world.dat, ylim = ylim, xlim = xlim, xlab = "", ylab = "",
			type = "n", box = "n", xaxt = "n", yaxt = "n", ...)
	}
	lines(world.dat, err = -1., ...)
	invisible()
}

"write.data" <- 
function(x, file)
{
	length.old <- options()$length
	options(length = 10000.)
	if(missing(file)) {
		file <- paste(as.character(substitute(x)), ".output", sep = "")
		cat(" The data set is being written to the UNIX file: ", file,
			fill = T)
	}
	sink(file)
	print(x, quote = F)
	sink()
	options(length = length.old)
	invisible()
}

"xline" <- 
function(x, ...)
{
	abline(v = x, ...)
	invisible()
}

"yline" <- 
function(y, ...)
{
	abline(h = y, ...)
	invisible()
}