"glass"<-
function(x, ps.intervals = NULL, lambda = 0, x.signal = NULL, signal.index = 
	NULL, varying.index = NULL, degree = 3, order = 3, ridge.adj = 1e-005, 
	ridge.inv = 0.0001)
{
# NOTE: see Instructions and Examples
# x: regressor of interest (also see signal.index and varying.index below) 
# ps.intervals: number of equally spaced B-spline intervals 
#	(the number of knots is equal to ps.int+2*degree+1
# lambda: non-negative regularization parameter for difference penalty
# x.signal: if SIGNAL Component, this is the n X p signal matrix (p >> n possible)
# signal.index: if SIGNAL Component, this is the axis where B-splines are 
#	constructed (specify above x as 1:ncol(x.signal))
# varying.index: if VARYING Component, this is the indexing variable where B-splines 
#	are constructed (e.g. time)
# degree: degree of B-spline basis
# order: order of difference penalty (0 is the ridge penalty)
# ridge.adj, ridge.inv: small positive numbers to stabilize 
#	linear dependencies among B-spline bases 
#
# Support functions: glass.wam(), gam.slist(), gam.wlist(), plot.glass()
#
# Reference: 
# Eilers, P.H.C. and Marx, B.D. (2002). Generalized Linear Additive Smooth Structures. 
#	Journal of Compuational and Graphical Statistics, 11(4): 758-783.
# Marx, B.D. and Eilers, P.H.C. (1998). Direct generalized linear modeling with 
#	penalized likelihood. CSDA, 28(2): 193-209.	
# Eilers, P.H.C. and Marx, B.D. (1996). Flexible smoothing with B-splines and penalties 
#	(with comments and rejoinder). Statistical Science, 11(2): 89-121.
#
#
# (c) 1998, 2003 Brian D. Marx
#
	number.knots <- ps.intervals + 2 * degree + 1
	smooth.dummy <- F
	if(!missing(x.signal)) {
		x.signal <- as.matrix(x.signal)
		x.index <- signal.index
		if(length(x) != nrow(x.signal)) {
			warning(paste(
				"\nThe x argument needs to have the same length as nrow(x.signal)"
				))
			if(missing(signal.index)) {
				signal.index <- 1:ncol(x.signal)
			}
		}
	}
	if(!missing(varying.index)) {
		x.index <- varying.index
		if(length(x) != length(x.index)) {
			warning(paste(
				"length of x and varying.index should be equal"
				))
		}
	}
	else if(missing(x.signal) && missing(varying.index)) {
		x.index <- x
		smooth.dummy <- T
	}
	if(!missing(x.signal) && !missing(varying.index)) {
		warning(paste("varying coef models should not be used with signal/curve\nregression"
			))
	}
	xl <- min(x.index)
	xr <- max(x.index)
	xmax <- xr + 0.01 * (xr - xl)
	xmin <- xl - 0.01 * (xr - xl)
	dx <- (xmax - xmin)/ps.intervals
	nx <- names(x.index)
	x.index <- as.vector(x.index)
	nax <- is.na(x.index)
	if(nas <- any(nax))
		x.index <- x[!nax]
	sorder <- degree + 1
	if(!missing(ps.intervals)) {
		nAknots <- ps.intervals - 1
		if(nAknots < 1) {
			nAknots <- 1
			warning(paste("ps.intervals was too small; have used 2"
				))
		}
		if(nAknots > 0) {
			Aknots <- seq(from = xmin - degree * dx, to = xmax + 
				degree * dx, by = dx)
		}
		else knots <- NULL
	}
	sbasis <- spline.des(Aknots, x.index, sorder, 0 * x.index)$design
	if(!missing(x.signal) && missing(varying.index)) {
		signal.basis <- sbasis
		basis <- x.signal %*% sbasis
	}
	if(!missing(varying.index) && missing(x.signal)) {
		varying.basis <- sbasis
		basis <- x * sbasis
	}
	if(missing(x.signal) && missing(varying.index)) {
		basis <- sbasis
		sbasis <- NULL
	}
	n.col <- ncol(basis)
	if(nas) {
		nmat <- matrix(NA, length(nax), n.col)
		nmat[!nax,  ] <- basis
		basis <- nmat
	}
	dimnames(basis) <- list(1:nrow(basis), 1:n.col)
	if((order - n.col + 1) > 0) {
		order <- n.col - 1
		warning(paste("order was too large; have used ", n.col - 1))
	}
	if(lambda < 0) {
		lambda <- 0
		warning(paste("lambda was negative; have used ", lambda))
	}
	if(lambda > 10000) {
		lambda <- 10000
		warning(paste("lambda was >10000; for stability have used", 
			lambda))
	}
	aug <- diag(n.col)
	if(order != 0) {
		for(tt in 1:order) {
			aug <- diff(aug)
		}
	}
	pen.aug <- sqrt(lambda) * aug
	attr(basis, "knots") <- Aknots
	if(ridge.adj == 0) {
		attr(basis, "pen.augment") <- pen.aug
	}
	if(ridge.adj != 0) {
		attr(basis, "pen.augment") <- rbind(pen.aug, sqrt(ridge.adj) * 
			diag(n.col))
	}
	attr(basis, "lambda") <- lambda
	attr(basis, "order") <- order
	signal.dummy <- varying.dummy <- F
	attr(basis, "signal.basis") <- attr(basis, "varying.basis") <- NULL
	if(!missing(x.signal)) {
		attr(basis, "signal.basis") <- signal.basis
		signal.dummy <- T
	}
	attr(basis, "signal.dummy") <- signal.dummy
	if(!missing(varying.index)) {
		attr(basis, "varying.basis") <- varying.basis
		varying.dummy <- T
	}
	attr(basis, "smooth.dummy") <- smooth.dummy
	attr(basis, "varying.dummy") <- varying.dummy	
	#	attr(basis, "ridge.gam") <- ridge.gam
	attr(basis, "ridge.inv") <- ridge.inv
	attr(basis, "ps.int") <- ps.intervals
	attr(basis, "degree") <- degree
	basis
}
"gam.slist"<-
c("s", "lo", "ps", "glass")
"gam.wlist"<-
c("s", "lo", "ps", "glass")
"glass.wam"<-
function(x, y, w, s, which, smooth.frame, maxit = 20, tol = 1e-008, trace = F, 
	se = T, ...)
{
# first call to wam; set up some things
#on first entry, smooth.frame is a data frame with elements the terms to be
#smoothed in which
	if(is.data.frame(smooth.frame)) {
		first <- T
		data <- smooth.frame[, names(which), drop = F]
	}
	else first <- F
	if(first) {
		dx <- as.integer(dim(x))
		p <- dx[2]
		attr(data, "class") <- NULL
		pen <- lapply(data, attr, "pen.augment")
		signal.basis <- signal.coef.index <- NULL
		ridge.inv <- unlist(lapply(data, attr, "ridge.inv"))[1]	
	#ridge.gam <- unlist(lapply(data, attr, "ridge.gam"))[1]
		signal.dummy <- lapply(data, attr, "signal.dummy")
		smooth.dummy <- lapply(data, attr, "smooth.dummy")
		varying.dummy <- lapply(data, attr, "varying.dummy")
		signal.basis <- lapply(data, attr, "signal.basis")
		varying.basis <- lapply(data, attr, "varying.basis")
		ps.int <- lapply(data, attr, "ps.int")
		ps.degree <- lapply(data, attr, "degree")
		signal.basis <- signal.basis[unlist(signal.dummy)]
		varying.basis <- varying.basis[unlist(varying.dummy)]
		smooth.index <- which[unlist(smooth.dummy)]
		signal.index <- which[unlist(signal.dummy)]
		varying.index <- which[unlist(varying.dummy)]
		pendim <- sapply(pen, dim)
		n <- dx[1]
		nrow.p <- sum(pendim[1,  ])
		p.augm <- matrix(0, nrow.p, p)
		num.ps <- length(which)
		startt <- 0
		for(i in 1:num.ps) {
			index <- seq(pendim[1, i]) + startt
			p.augm[unlist(index), unlist(which[i])] <- pen[[i]]
			startt <- max(index)
		}
		zeros <- rep(0, nrow.p)	
	#if(length(which) > 1 & ridge.gam > 0) {
#	p.augm <- rbind(p.augm, sqrt(ridge.gam) * diag(p))
#	zeros <- rep(0, nrow.p + p)
#}
		lin.dim <- ncol(as.matrix(x[,  - c(unlist(which))]))
		smooth.frame <- list(lin.dim = lin.dim, pendim = pendim, num.ps
			 = num.ps, p = p, n = n, p.augm = p.augm, zeros = zeros,
			signal.basis = signal.basis, varying.basis = 
			varying.basis, signal.index = signal.index, 
			smooth.index = smooth.index, varying.index = 
			varying.index, ridge.inv = ridge.inv, ps.int = ps.int, 
			ps.degree = ps.degree, gsmooth.dummy = unlist(
			smooth.dummy), signal.dummy = unlist(signal.dummy), 
			varying.dummy = unlist(varying.dummy))
		first <- F
	}
	storage.mode(tol) <- "double"
	storage.mode(maxit) <- "integer"
	storage.mode(y) <- "double"
	storage.mode(w) <- "double"
	gsmooth.dummy <- smooth.frame$gsmooth.dummy
	varying.dummy <- smooth.frame$varying.dummy
	signal.dummy <- smooth.frame$signal.dummy
	ridge.inv <- smooth.frame$ridge.inv
	lin.dim <- smooth.frame$lin.dim
	num.ps <- smooth.frame$num.ps
	ps.int <- smooth.frame$ps.int
	ps.degree <- smooth.frame$ps.degree
	smooth.index <- smooth.frame$smooth.index
	signal.basis <- smooth.frame$signal.basis
	signal.index <- smooth.frame$signal.index
	varying.basis <- smooth.frame$varying.basis
	varying.index <- smooth.frame$varying.index
	p <- smooth.frame$p
	pendim <- smooth.frame$pendim
	p.augm <- smooth.frame$p.augm
	zeros <- smooth.frame$zeros
	n <- smooth.frame$n
	yaug <- as.vector(c(y, zeros))
	waug <- as.vector(c(w, (zeros + 1)))
	xaug <- as.matrix(rbind(x, p.augm))
	nl.dim <- rep(0, num.ps)
	startt <- 0
	for(i in 1:num.ps) {
		index <- seq(pendim[1, i]) + startt
		xaugi <- xaug[, unlist(which[i])]
		xi <- x[, unlist(which[i])]
		nl.dim[i] <- sum(diag(solve(t(xaugi) %*% (waug * xaugi)) %*% (t(
			xi) %*% (waug[1:n] * xi))))
		startt <- max(index)
	}
	fit <- lsfit(xaug, yaug, wt = waug, intercept = F)
	names(fit$df) <- dimnames(glass)[[2]]
	names(fit$coef) <- labels(x)[[2]]
	Rridge <- ridge.inv * diag(p)
	Bbread <- t(xaug) %*% (waug * xaug)
	Ccheese <- t(x) %*% (w * x)
	iBbread <- solve(Bbread + Rridge)
	iCcheese <- solve(Ccheese + Rridge)
	SW <- Bbread %*% iCcheese %*% Bbread
	iSW <- iBbread %*% Ccheese %*% iBbread
	SW1 <- SW
	SW1[lower.tri(SW1)] <- 0
	SW2 <- t(SW1)
	Ddiag <- diag(diag(SW))
	SW <- SW1 + SW2 - Ddiag
	CH <- chol(SW, pivot = T)
	PP <- order(attr(CH, "pivot"))
	Half <- CH[, PP]
	Rqr <- qr(Half)
	R <- qr.R(Rqr)
	dimnames(R)[[1]] <- dimnames(R)[[2]] <- c(Rqr$pivot)[1:Rqr$rank]
	hatt <- hat(sqrt(waug) * xaug, intercept = F)[1:n]
	rl <- list(coefficients = fit$coef, residuals = fit$residuals[1:n], 
		lin.dim = lin.dim, fitted.values = y - fit$residuals[1:n], rank
		 = Rqr$rank, pivot = Rqr$pivot, R = R, qraux = Rqr$qraux, iSW
		 = iSW, hat = hatt, df.residual = n - sum(nl.dim) - lin.dim, 
		nl.dim = nl.dim, signal.basis = signal.basis, varying.basis = 
		varying.basis, signal.index = signal.index, gsmooth.index = 
		smooth.index, varying.index = varying.index, ridge.inv = 
		ridge.inv, ps.int = ps.int, ps.degree = ps.degree, 
		gsmooth.dummy = gsmooth.dummy, varying.dummy = varying.dummy, 
		signal.dummy = signal.dummy)
	c(list(smooth.frame = smooth.frame), rl)
}
"plot.glass"<-
function(glass.object, type = "smooth", index = 1, t.domain, se.bands = T, 
	scale = T, rug.on = T, Resol = 80)
{
# glass.object: object from glass.object <- gam(y~glass(.)+...)
# type: "smooth", "varying", "signal"
# index: component number of the specified type (e.g. 1 if first smooth term, 2 if second)
# t.domain: variable that B-spline basis is computed from 
#	(eg: regressor for smooth, time for varying, freq for signal)
# scale: T (unbiased est of scale param RSS/df) or F (set to 1)
# rug: T for t.domain ticks on x-axis, F otherwise
# Resol: resolution of plot (number of equally space points to generate smooth)
	obj <- glass.object
	if(type != "smooth" && type != "varying" && type != "signal")
		warning(paste("Only use type: smooth, varying or signal, not ", 
			type))
	if(type == "smooth") {
		iindex <- as.vector(unlist(obj$gsmooth.index[index]))
		ps.intervals <- unlist(obj$ps.int[(obj$gsmooth.dummy) == T])
		degree <- unlist(obj$ps.degree[(obj$gsmooth.dummy) == T])
	}
	if(type == "varying") {
		iindex <- as.vector(unlist(obj$varying.index[index]))
		ps.intervals <- unlist(obj$ps.int[(obj$varying.dummy) == T])
		degree <- unlist(obj$ps.degree[(obj$varying.dummy) == T])
	}
	if(type == "signal") {
		iindex <- as.vector(unlist(obj$signal.index[index]))
		ps.intervals <- unlist(obj$ps.int[(obj$signal.dummy) == T])
		degree <- unlist(obj$ps.degree[(obj$signal.dummy) == T])
	}
	if(length(ps.intervals) < index) {
		warning(paste("Error: index argument too large"))
	}
	ps.intervals <- ps.intervals[index]
	degree <- degree[index]
	mmin <- min(iindex)
	mmax <- max(iindex)
	tt.domain <- seq(min(t.domain), max(t.domain), length = Resol)
	psm. <- glass(tt.domain, ps.intervals, degree = degree)
	ccoef <- obj$coef[mmin:mmax]
	ssmooth <- psm. %*% ccoef
	if(type == "smooth") {
		ssmooth <- ssmooth - mean(ssmooth)
	}
	if(!se.bands) {
		plot(tt.domain, ssmooth, type = "l", xlab = " ", ylab = " ")
	}
	ssigma <- NULL
	if(se.bands) {
		ssigma <- 1
		R <- obj$R
		if(scale) {
#			ssigma <- sqrt(obj$dev/obj$df.r)
#			ssigma <- summary.lm(obj)$sigma
			ssigma <- sqrt(sum((obj$resid * sqrt(obj$weights))^2)/
				obj$df.r)
		}
		icwhole <- obj$iSW
		icwhole. <- icwhole[mmin:mmax, mmin:mmax]
		var.p <- psm. %*% icwhole. %*% t(psm.)
		se <- ssigma * (sqrt(diag(var.p)))
		upper <- ssmooth + 2 * se
		lower <- ssmooth - 2 * se
		ssmooth <- cbind(lower, ssmooth, upper)
		matplot(tt.domain, ssmooth, type = "l", lty = c(3, 1, 3), xlab
			 = " ", ylab = " ")
	}
	if(rug.on) {
		rug(t.domain)
	}
	list(smooth.grid = ssmooth, scale = ssigma, degree = degree)
}