SCM

SCM Repository

[matrix] Diff of /pkg/R/diagMatrix.R
ViewVC logotype

Diff of /pkg/R/diagMatrix.R

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1616, Thu Oct 5 17:44:11 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),]))
49        add1 <- matrix(1:0, 2,2)
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.1616  
changed lines
  Added in v.1617

root@r-forge.r-project.org
ViewVC Help
Powered by ViewVC 1.0.0  
Thanks to:
Vienna University of Economics and Business Powered By FusionForge