[R] kronecker(... , make.dimnames=TRUE)

[Robin Hankin]

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