SCM

SCM Repository

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

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

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

revision 2496, Sat Nov 14 17:24:42 2009 UTC revision 2508, Thu Dec 24 09:47:57 2009 UTC
# Line 32  Line 32 
32      }      }
33  }  }
34    
35  .sparseDiagonal <- function(n, x = rep.int(1,n), uplo = "U", shape = "t") {  .sparseDiagonal <- function(n, x = rep.int(1,m), uplo = "U",
36                                shape = if(missing(cols)) "t" else "g",
37                                kind, cols = if(n) 0:(n - 1L) else integer(0))
38    {
39      stopifnot(n == (n. <- as.integer(n)), (n <- n.) >= 0)      stopifnot(n == (n. <- as.integer(n)), (n <- n.) >= 0)
40      if((lx <- length(x)) == 1) x <- rep.int(x, n)      if(!missing(cols))
41      else if(lx != n) stop("length(x) must be 1 or n")          stopifnot(0 <= (cols <- as.integer(cols)), cols < n)
42      stopifnot(is.character(shape), nchar(shape) == 1,      m <- length(cols)
43                any(shape == c("t","s","g"))) # triangular / symmetric / general      if(missing(kind))
44      kind <-      kind <-
45          if(is.double(x)) "d"          if(is.double(x)) "d"
46          else if(is.logical(x)) "l"          else if(is.logical(x)) "l"
# Line 45  Line 48 
48              storage.mode(x) <- "double"              storage.mode(x) <- "double"
49              "d"              "d"
50          }          }
51      ii <- if(n) 0:(n - 1L) else integer(0)      else stopifnot(any(kind == c("d","l","n")))
52        if(kind != "n") {
53            if((lx <- length(x)) == 1) x <- rep.int(x, m)
54            else if(lx != m) stop("length(x) must be either 1 or #{cols}")
55        }
56        stopifnot(is.character(shape), nchar(shape) == 1,
57                  any(shape == c("t","s","g"))) # triangular / symmetric / general
58        if(kind == "n") {
59      if(shape == "g")      if(shape == "g")
60          new(paste0(kind, "gCMatrix"), Dim = c(n,n),              new("ngCMatrix", Dim = c(n,m), i = cols, p = 0:m)
61              x = x, i = ii, p = 0:n)          else new(paste0("n", shape, "CMatrix"), Dim = c(n,m), uplo = uplo,
62      else new(paste0(kind, shape, "CMatrix"), Dim = c(n,n), uplo = uplo,                   i = cols, p = 0:m)
63               x = x, i = ii, p = 0:n)      }
64        ## kind != "n" -- have x slot :
65        else if(shape == "g")
66            new(paste0(kind, "gCMatrix"), Dim = c(n,m),
67                x = x, i = cols, p = 0:m)
68        else new(paste0(kind, shape, "CMatrix"), Dim = c(n,m), uplo = uplo,
69                 x = x, i = cols, p = 0:m)
70  }  }
71    
72  ## Pkg 'spdep' had (relatively slow) versions of this as_dsCMatrix_I()  ## Pkg 'spdep' had (relatively slow) versions of this as_dsCMatrix_I()
# Line 339  Line 355 
355            function(x = 1, nrow, ncol) .diag.x(x))            function(x = 1, nrow, ncol) .diag.x(x))
356    
357  subDiag <- function(x, i, j, ..., drop) {  subDiag <- function(x, i, j, ..., drop) {
358      x <- as(x, "TsparseMatrix")      x <- as(x, "CsparseMatrix") ## << was "TsparseMatrix" (Csparse is faster now)
359      x <- if(missing(i))      x <- if(missing(i))
360          x[, j, drop=drop]          x[, j, drop=drop]
361      else if(missing(j))      else if(missing(j))

Legend:
Removed from v.2496  
changed lines
  Added in v.2508

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