50 lines
1.2 KiB
ArmAsm
50 lines
1.2 KiB
ArmAsm
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)
|
|
}
|