The R Project SVN R-packages

Rev

Rev 4483 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 4483 Rev 4501
Line 3... Line 3...
3 
 
 3 
 
4 
# atomicVector : classUnion (logical,integer,double,....)
 4 
# atomicVector : classUnion (logical,integer,double,....)
5 
setAs("atomicVector", "sparseVector",
 5 
setAs("atomicVector", "sparseVector",
6 
      function(from) {
 6 
      function(from) {
7 
	  n <- length(from)
 7 
	  n <- length(from)
8 
	  if(is.numeric(from) && !is.double(from))
 - 
 
9 
	      from <- as.double(from)
 - 
 
10 
	  r <- new(paste(.M.kind(from), "sparseVector", sep=''), length = n)
 8 
	  r <- new(paste(.V.kind(from), "sparseVector", sep=''), length = n)
11 
	  ii <- from != 0
 9 
	  ii <- from != 0
12 
	  r@x <- from[ii]
 10 
	  r@x <- from[ii]
13 
	  r@i <- seq_len(n)[ii]
 11 
	  r@i <- seq_len(n)[ii]
14 
	  r
 12 
	  r
15 
      })
 13 
      })
16 
 
 14 
 
- 
 
 15 
 
- 
 
 16 
for(T in c("d","i","l","z")) {
- 
 
 17 
    setAs("xsparseVector", paste(T, "sparseVector", sep=''),
- 
 
 18 
          function(from) {
- 
 
 19 
              from@x <- as(from@x, .type.kind[T])
- 
 
 20 
              ## and now "the hack":
- 
 
 21 
              class(from) <- paste(T, "sparseVector", sep='')
- 
 
 22 
              from
- 
 
 23 
          })
- 
 
 24 
}
- 
 
 25 
 
- 
 
 26 
setAs("sparseVector", "nsparseVector",
- 
 
 27 
      function(from) {
- 
 
 28 
          if(any(is.na(from@x)))
- 
 
 29 
              stop("cannot coerce 'NA's to \"nsparseVector\"")
- 
 
 30 
          new("nsparseVector", i = from@i, length = from@length)
- 
 
 31 
      })
- 
 
 32 
 
17 
sp2vec <- function(x, mode = .type.kind[substr(cl, 1,1)]) {
 33 
sp2vec <- function(x, mode = .type.kind[substr(cl, 1,1)]) {
18 
    cl <- class(x)
 34 
    cl <- class(x)
19 
    r <- vector(mode, x@length)
 35 
    r <- vector(mode, x@length)
20 
    r[x@i] <-
 36 
    r[x@i] <-
21 
	if(cl != "nsparseVector") { # cheap test for 'has x slot'
 37 
	if(cl != "nsparseVector") { # cheap test for 'has x slot'