SCM

SCM Repository

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

Diff of /pkg/R/sparseMatrix.R

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

revision 2311, Tue Jan 6 14:56:04 2009 UTC revision 2312, Sat Jan 10 14:01:26 2009 UTC
# Line 27  Line 27 
27          j = as.integer(j - 1L))          j = as.integer(j - 1L))
28  }  }
29    
30    sparseMatrix <- function(i, j, p, x, dims, dimnames, index0 = FALSE)
31    {
32      ## Purpose: user-level substitute for most  new(<sparseMatrix>, ..) calls
33      ## Author: Martin Maechler, Date: 6 Jan 2009, based on Doug Bates' idea
34        if((m.i <- missing(i)) + (m.j <- missing(j)) + (m.p <- missing(p)) != 1)
35            stop("exactly one of 'i', 'j', or 'p' must be missing from call")
36        if(!m.p) {
37            ## we *could* let  validObject() / .validateCsparse() check later ...
38            p <- as.integer(p)
39            if((lp <- length(p)) < 1 || p[1] != 0 || any((dp <- p[-1] - p[-lp]) < 0))
40                stop("'p' must be a non-decreasing vector (0, ...)")
41        }
42        isPat <- missing(x) ## <-> patter"n" Matrix
43        ## "minimal dimensions" from (i,j,p) :
44        dims.min <- c(if(m.i) lp - 1L else max(i <- as.integer(i)),
45                      if(m.j) lp - 1L else max(j <- as.integer(j)))
46        if(any(is.na(dims.min))) stop("NA's in (i,j) are not allowed")
47        if(missing(dims)) {
48            dims <- dims.min
49        } else { ## check dims
50            stopifnot(all(dims >= dims.min))
51            dims <- as.integer(dims)
52        }
53        kx <- if(isPat) "n" else .M.kind(x)
54        if(m.j) { ## -> Csparse
55            r <- new(paste(kx, "gCMatrix", sep=''))
56            r@Dim <- dims
57            r@p <- as.integer(p)
58            if(!isPat) r@x <- if(kx == "d" && !is.double(x)) as.double(x) else x
59            r@i <- as.integer(if(index0) i else i - 1L)
60            vv <- .validateCsparse(r, sort.if.needed=TRUE)## modify 'r' in-place !!!
61            if(is.character(vv)) stop(vv)
62        }
63        else if(m.i) { ## -> Rsparse
64            stop("(j,p) --> RsparseMatrix :  not yet implemented")
65        }
66        else if(m.p) { ## -> Tsparse
67            r <- new(paste(kx, "gTMatrix", sep=''))
68            r@Dim <- dims
69            if(!isPat) r@x <- if(kx == "d" && !is.double(x)) as.double(x) else x
70            r@i <- as.integer(if(index0) i else i - 1L)
71            r@j <- as.integer(if(index0) j else j - 1L)
72            validObject(r)
73            r
74        }
75        if(!missing(dimnames)) {
76            ## FIXME: should we check here, or validObject(r) or ??
77            r@Dimnames <- dimnames
78        }
79        r
80    }
81    
82    
83  ## "graph" coercions -- this needs the graph package which is currently  ## "graph" coercions -- this needs the graph package which is currently
84  ##  -----               *not* required on purpose  ##  -----               *not* required on purpose

Legend:
Removed from v.2311  
changed lines
  Added in v.2312

R-Forge@R-project.org
ViewVC Help
Powered by ViewVC 1.0.0  
Thanks to:
Vienna University of Economics and Business University of Wisconsin - Madison Powered By FusionForge