SCM

SCM Repository

[matrix] Annotation of /pkg/R/Tsparse.R
ViewVC logotype

Annotation of /pkg/R/Tsparse.R

Parent Directory Parent Directory | Revision Log Revision Log


Revision 928 - (view) (download)

1 : maechler 925 #### "TsparseMatrix" : Virtual class of sparse matrices in triplet-format
2 : maechler 867
3 : maechler 875 ### "[" :
4 :     ### -----
5 :    
6 : maechler 886 ## Want to allow 'numeric', 'logical' and 'character' indices
7 : maechler 875
8 : maechler 886 ## Test for numeric/logical/character
9 :     ## method-*internally* ; this is not strictly OO, but allows to use
10 :     ## the following utility and hence much more compact code.
11 : maechler 875
12 : maechler 886 .ind.prep <- function(xi, i, margin, di, dn)
13 :     {
14 :     ## Purpose: do the ``common things'' for "*gTMatrix" indexing
15 : maechler 892 ## for 1 dimension, 'margin' ,
16 : maechler 886 ## and return match(.,.) + li = length of corresponding dimension
17 :     ##
18 :     ## i is "index"; xi = "x@i"; margin in {1,2};
19 : maechler 892 ## di = dim(x) { used when i is "logical" }
20 :     ## dn = dimnames(x) { used when i is character }
21 : maechler 886
22 :     dn <- dn[[margin]]
23 :     has.dn <- is.character(dn)
24 :     if(is(i, "numeric")) {
25 :     storage.mode(i) <- "integer"
26 : maechler 925 if(any(ineg <- i < 0:0)) {
27 :     if(any(i > 0:0))
28 :     stop("you cannot mix negative and positive indices")
29 :     i0 <- (0:(di[margin]-1:1))[i]
30 :     } else {
31 :     i0 <- i - 1:1 # transform to 0-indexing
32 :     }
33 :     if(has.dn) dn <- dn[i]
34 : maechler 886 }
35 :     else if (is(i, "logical")) {
36 :     i0 <- (0:(di[margin]-1:1))[i]
37 :     if(has.dn) dn <- dn[i]
38 :     } else { ## character
39 :     if(!has.dn)
40 : maechler 925 stop(gettextf("no 'dimnames[[%d]]': cannot use character indexing"),
41 : maechler 886 margin, domain = NA)
42 :     i0 <- match(i, dn, nomatch=0)
43 :     dn <- dn[i0]
44 :     i0 <- i0 - 1:1
45 :     }
46 :     list(m = match(xi, i0, nomatch=0), li = length(i0), dn = dn)
47 :     }
48 :    
49 :    
50 :     ## Otherwise have to write methods for all possible combinations of
51 :     ## (i , j) \in
52 :     ## (numeric, logical, character, missing) x (numeric, log., char., miss.)
53 :    
54 :    
55 : maechler 867 ## Select rows
56 : bates 923 setMethod("[", signature(x = "TsparseMatrix", i = "index", j = "missing",
57 : maechler 867 drop = "logical"),
58 :     function (x, i, j, ..., drop) { ## select rows
59 : maechler 886 ip <- .ind.prep(x@i, i, 1, dim(x), dimnames(x))
60 :     x@Dim[1] <- ip$li
61 :     x@Dimnames[1] <- ip$dn
62 :     sel <- ip$m > 0
63 :     x@i <- ip$m[sel] - 1:1
64 :     x@j <- x@j[sel]
65 : bates 923 if (!is(x, "lsparseMatrix")) x@x <- x@x[sel]
66 : maechler 886 if (drop && any(x@Dim == 1:1)) drop(as(x,"matrix")) else x
67 : maechler 867 })
68 :    
69 :    
70 :     ## Select columns
71 : bates 923 setMethod("[", signature(x = "TsparseMatrix", i = "missing", j = "index",
72 : maechler 867 drop = "logical"),
73 :     function (x, i, j, ..., drop) { ## select columns
74 : maechler 886 ip <- .ind.prep(x@j, j, 2, dim(x), dimnames(x))
75 :     x@Dim[2] <- ip$li
76 :     x@Dimnames[2] <- ip$dn
77 :     sel <- ip$m > 0
78 :     x@i <- x@i[sel]
79 :     x@j <- ip$m[sel] - 1:1
80 : bates 923 if (!is(x, "lsparseMatrix")) x@x <- x@x[sel]
81 : maechler 886 if (drop && any(x@Dim == 1:1)) drop(as(x,"matrix")) else x
82 : maechler 867 })
83 :    
84 :    
85 :     ## [.data.frame has : drop = if (missing(i)) TRUE else length(cols) == 1)
86 :    
87 : bates 923 setMethod("[", signature(x = "TsparseMatrix",
88 : maechler 886 i = "index", j = "index", drop = "logical"),
89 : maechler 867 function (x, i, j, ..., drop)
90 :     {
91 :     ## (i,j, drop) all specified
92 : maechler 886 di <- dim(x)
93 :     dn <- dimnames(x)
94 :     ip1 <- .ind.prep(x@i, i, 1, di, dn)
95 :     ip2 <- .ind.prep(x@j, j, 2, di, dn)
96 :     x@Dim <- nd <- c(ip1$li, ip2$li)
97 :     x@Dimnames <- list(ip1$dn, ip2$dn)
98 :     sel <- ip1$m > 0:0 & ip2$m > 0:0
99 :     x@i <- ip1$m[sel] - 1:1
100 :     x@j <- ip2$m[sel] - 1:1
101 : bates 923 if (!is(x, "lsparseMatrix")) x@x <- x@x[sel]
102 : maechler 886 if (drop && any(nd == 1)) drop(as(x,"matrix")) else x
103 : maechler 867 })
104 : bates 923
105 :     setMethod("crossprod", signature(x = "TsparseMatrix", y = "missing"),
106 :     function(x, y = NULL)
107 : bates 928 .Call("Csparse_crossprod", x, FALSE, TRUE, PACKAGE = "Matrix"))
108 : bates 923
109 :     setMethod("tcrossprod", signature(x = "TsparseMatrix"),
110 :     function(x)
111 : bates 928 .Call("Csparse_crossprod", x, TRUE, TRUE, PACKAGE = "Matrix"))
112 :    

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