# SCM Repository

[matrix] Diff of /pkg/Matrix/R/diagMatrix.R
 [matrix] / pkg / Matrix / R / diagMatrix.R

# Diff of /pkg/Matrix/R/diagMatrix.R

revision 1592, Thu Sep 28 15:31:17 2006 UTC revision 1617, Fri Oct 6 15:42:12 2006 UTC
# Line 1  Line 1
1    #### All methods for "diagonalMatrix" and its subclasses,
2    ####  currently "ddiMatrix", "ldiMatrix"
3
4  ## Purpose: Constructor of diagonal matrices -- ~= diag() ,  ## Purpose: Constructor of diagonal matrices -- ~= diag() ,
5  ##          but *not* diag() extractor!  ##          but *not* diag() extractor!
6  Diagonal <- function(n, x = NULL)  Diagonal <- function(n, x = NULL)
# Line 27  Line 30
30      }      }
31  }  }
32
33    ### This is modified from a post of Bert Gunter to R-help on  1 Sep 2005.
34    ### Bert's code built on a post by Andy Liaw who most probably was influenced
35    ### by earlier posts, notably one by Scott Chasalow on S-news, 16 Jan 2002
36    ### who posted his bdiag() function written in December 1995.
37
38    bdiag <- function(...) {
39        if(nargs() == 0) return(new("dgCMatrix"))
40        ## else :
41        mlist <- if (nargs() == 1) as.list(...) else list(...)
42        dims <- sapply(mlist, dim)
43        ## make sure we had all matrices:
44        if(!(is.matrix(dims) && nrow(dims) == 2))
45            stop("some arguments are not matrices")
46        csdim <- rbind(rep.int(0:0, 2),
47                       apply(sapply(mlist, dim), 1, cumsum))
48        ret <- new("dgTMatrix", Dim = as.integer(csdim[nrow(csdim),]))
50        for(i in seq(along = mlist)) {
51            indx <- apply(csdim[i:(i+1),] + add1, 2, function(n) n[1]:n[2])
52            if(is.null(dim(indx))) ## non-square matrix
53                ret[indx[[1]],indx[[2]]] <- mlist[[i]]
54            else ## square matrix
55                ret[indx[,1],indx[,2]] <- mlist[[i]]
56        }
57        ## slightly debatable if we really should return Csparse.. :
58        as(ret, "CsparseMatrix")
59    }
60
61  setAs("diagonalMatrix", "triangularMatrix",  setAs("diagonalMatrix", "triangularMatrix",
62        function(from) {        function(from) {
63            n <- from@Dim[1]            n <- from@Dim[1]
# Line 123  Line 154
154                x = if(uni) x[FALSE] else x)                x = if(uni) x[FALSE] else x)
155        })        })
156
157    ## When you assign to a diagonalMatrix, the result should be
158    ## diagonal or sparse
159    setReplaceMethod("[", signature(x = "diagonalMatrix",
160                                    i = "ANY", j = "ANY", value = "ANY"),
161                     function(x, i, j, value) {
162                         r <- callGeneric(x = as(x,"sparseMatrix"),
163                                          i=i, j=j, value=value)
164                         if(isDiagonal(r)) as(r, "diagonalMatrix") else r
165                     })
166
167
168  setMethod("t", signature(x = "diagonalMatrix"),  setMethod("t", signature(x = "diagonalMatrix"),
169            function(x) { x@Dimnames <- x@Dimnames[2:1] ; x })            function(x) { x@Dimnames <- x@Dimnames[2:1] ; x })
170

Legend:
 Removed from v.1592 changed lines Added in v.1617