kronecker(... , make.dimnames=TRUE)
Not sure whether or not this is a good idea but note that
the techniques discussed in the recent thread:
"Change labels of x-axes in Plot of stl() function?"
can be used here too. e.g.
library(proto)
kronecker <- function(...) {
outer <- function(x, y, FUN, sep) {
sepchar <- if(any(nchar(x)>0) & any(nchar(y)>0)) ":" else ""
base::outer(x, y, FUN, sep = sepchar)
}
with( proto(kronecker = base:::kronecker), kronecker(...) )
}
# test
a <- structure(1:6, .Dim = 3:2, .Dimnames = list(letters[1:3], LETTERS[1:2]))
b <- c(x=1,y=2)
kronecker(a,b,make.dimnames=TRUE)
or slightly longer and somewhat awkward since it involves explicit
manipulation of environments (but with the advantage of no dependence
on another package):
kronecker <- function(...) {
outer <- function(x, y, FUN, sep) {
sepchar <- if(any(nchar(x)>0) & any(nchar(y)>0)) ":" else ""
base::outer(x, y, FUN, sep = sepchar)
}
kronecker <- base::kronecker
environment(kronecker) <- environment()
kronecker(...)
}
On 12/8/05, Robin Hankin <r.hankin at noc.soton.ac.uk> wrote:
Hi I'm using kronecker() with a matrix and a vector. I'm interested in the column names that kronecker() returns:
> a <- matrix(1:9,3,3) > rownames(a) <- letters[1:3] > colnames(a) <- LETTERS[1:3] > b <- c(x=1,y=2) > kronecker(a,b,make.dimnames=TRUE)
A: B: C: a:x 1 4 7 a:y 2 8 14 b:x 2 5 8 b:y 4 10 16 c:x 3 6 9 c:y 6 12 18
>
The column names are undesirable for me as I don't want the extra colon.
The following code is a version of kronecker() that does not exhibit
this behaviour.
It tests nchar() of the dimnames and sets the separator to ":" or ""
depending
on the existence of a nontrivial string.
"kronecker" <-
function (X, Y, FUN = "*", make.dimnames = FALSE, ...)
{
X <- as.array(X)
Y <- as.array(Y)
if (make.dimnames) {
dnx <- dimnames(X)
dny <- dimnames(Y)
}
dX <- dim(X)
dY <- dim(Y)
ld <- length(dX) - length(dY)
if (ld < 0)
dX <- dim(X) <- c(dX, rep.int(1, -ld))
else if (ld > 0)
dY <- dim(Y) <- c(dY, rep.int(1, ld))
opobj <- outer(X, Y, FUN, ...)
dp <- as.vector(t(matrix(1:(2 * length(dX)), ncol = 2)[,
2:1]))
opobj <- aperm(opobj, dp)
dim(opobj) <- dX * dY
if (make.dimnames && !(is.null(dnx) && is.null(dny))) {
if (is.null(dnx))
dnx <- vector("list", length(dX))
else if (ld < 0)
dnx <- c(dnx, vector("list", -ld))
tmp <- which(sapply(dnx, is.null))
dnx[tmp] <- lapply(tmp, function(i) rep.int("", dX[i]))
if (is.null(dny))
dny <- vector("list", length(dY))
else if (ld > 0)
dny <- c(dny, vector("list", ld))
tmp <- which(sapply(dny, is.null))
dny[tmp] <- lapply(tmp, function(i) rep.int("", dY[i]))
k <- length(dim(opobj))
dno <- vector("list", k)
for (i in 1:k) {
# !!!!! !!!!! NEW TEXT STARTS !!!!!!
if(any(nchar(dnx[[i]])>0) & any(nchar(dny[[i]])>0)){
sepchar <- ":"
} else {
sepchar <- ""
}
tmp <- outer(dnx[[i]], dny[[i]], FUN = "paste", sep = sepchar)
# !!!! NEW TEXT ENDS !!!!!
# tmp <- outer(dnx[[i]], dny[[i]], FUN = "paste", sep = ":")
dno[[i]] <- as.vector(t(tmp))
}
dimnames(opobj) <- dno
}
opobj
}
Then
> kronecker(a,b,make=T)
A B C a:x 1 4 7 a:y 4 16 28 b:x 2 5 8 b:y 8 20 32 c:x 3 6 9 c:y 12 24 36
>
as desired. comments anyone? -- Robin Hankin Uncertainty Analyst National Oceanography Centre, Southampton European Way, Southampton SO14 3ZH, UK tel 023-8059-7743
______________________________________________ R-help at stat.math.ethz.ch mailing list https://stat.ethz.ch/mailman/listinfo/r-help PLEASE do read the posting guide! http://www.R-project.org/posting-guide.html