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
>