sprd-grd.s

as.grade <- function(x)
{
	if (inherits(x,"grade")) return(x)
	if (match("sum",dimnames(x)[[2]],0) == 0) {
		dx  <- dim(x)
		dnx <- dimnames(x)
		if (length(dim(x)) == 2) {
			if (length(dnx) != 2) dimnames(x) <- list(NULL, 1:dx[2])
			tmp <- cbind(x,sum=0)
		}
		if (length(dim(x)) == 3) {
			dimnames(x) <- NULL
			tmp <- aperm(x,c(1,3,2))
			dim(tmp) <- c(dim(tmp)[1]*dim(tmp)[3], dim(tmp)[2])
			tmp <- cbind(tmp, sum=0)
			dim(tmp) <- (dx + c(0,1,0))[c(1,3,2)]
			tmp <- aperm(tmp,c(1,3,2))
			if (length(dnx) != 3) dnx <- list(NULL, 1:dx[2], NULL)
			dnx[[2]] <- c(dnx[[2]], "sum")
			dimnames(tmp) <- dnx
		}
		if (length(dim(x)) > 3) stop("grade requires 2d or 3d")
	}
	x <- as.spread(tmp)
	sum.col <- match("sum",dimnames(x)[[2]],0)
	tmp.expr <- paste(
		"x[,",
		sum.col,
		if (length(dim(x))==3) ",",
		"] <- apply(x[,",
		-sum.col,
		if (length(dim(x))==3) ",",
		 "],",
		deparse(if (length(dim(x))==3) c(1,3) else 1),
		",sum)"
	)
	after(x)["sum"] <- parse(text=tmp.expr)
	class(x) <- c("grade", class(x))
	update.spread(x)
}

	expr.rc.grade <- function(x, acpab)
{
	if (sapply(acpab,nchar)[[2]] == 0) {
		j <- -match("sum", dimnames(x)[[2]], 0)
		acpab[2] <- j
	}
	expr.rc.default(x,acpab)
}