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 923 - (view) (download)

1 : maechler 875 #### "gTMatrix" : Virtual class of general 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 892 i0 <- i - 1:1 # transform to 0-indexing
27 : maechler 886 if(has.dn) dn <- dn[i]
28 :     }
29 :     else if (is(i, "logical")) {
30 :     i0 <- (0:(di[margin]-1:1))[i]
31 :     if(has.dn) dn <- dn[i]
32 :     } else { ## character
33 :     if(!has.dn)
34 :     stop(gettextf(
35 :     "no 'dimnames[[%d]]': cannot use character indexing"),
36 :     margin, domain = NA)
37 :     i0 <- match(i, dn, nomatch=0)
38 :     dn <- dn[i0]
39 :     i0 <- i0 - 1:1
40 :     }
41 :     list(m = match(xi, i0, nomatch=0), li = length(i0), dn = dn)
42 :     }
43 :    
44 :    
45 :     ## Otherwise have to write methods for all possible combinations of
46 :     ## (i , j) \in
47 :     ## (numeric, logical, character, missing) x (numeric, log., char., miss.)
48 :    
49 :    
50 : maechler 867 ## Select rows
51 : bates 923 setMethod("[", signature(x = "TsparseMatrix", i = "index", j = "missing",
52 : maechler 867 drop = "logical"),
53 :     function (x, i, j, ..., drop) { ## select rows
54 : maechler 886 ip <- .ind.prep(x@i, i, 1, dim(x), dimnames(x))
55 :     x@Dim[1] <- ip$li
56 :     x@Dimnames[1] <- ip$dn
57 :     sel <- ip$m > 0
58 :     x@i <- ip$m[sel] - 1:1
59 :     x@j <- x@j[sel]
60 : bates 923 if (!is(x, "lsparseMatrix")) x@x <- x@x[sel]
61 : maechler 886 if (drop && any(x@Dim == 1:1)) drop(as(x,"matrix")) else x
62 : maechler 867 })
63 :    
64 :    
65 :     ## Select columns
66 : bates 923 setMethod("[", signature(x = "TsparseMatrix", i = "missing", j = "index",
67 : maechler 867 drop = "logical"),
68 :     function (x, i, j, ..., drop) { ## select columns
69 : maechler 886 ip <- .ind.prep(x@j, j, 2, dim(x), dimnames(x))
70 :     x@Dim[2] <- ip$li
71 :     x@Dimnames[2] <- ip$dn
72 :     sel <- ip$m > 0
73 :     x@i <- x@i[sel]
74 :     x@j <- ip$m[sel] - 1:1
75 : bates 923 if (!is(x, "lsparseMatrix")) x@x <- x@x[sel]
76 : maechler 886 if (drop && any(x@Dim == 1:1)) drop(as(x,"matrix")) else x
77 : maechler 867 })
78 :    
79 :    
80 :     ## [.data.frame has : drop = if (missing(i)) TRUE else length(cols) == 1)
81 :    
82 : bates 923 setMethod("[", signature(x = "TsparseMatrix",
83 : maechler 886 i = "index", j = "index", drop = "logical"),
84 : maechler 867 function (x, i, j, ..., drop)
85 :     {
86 :     ## (i,j, drop) all specified
87 : maechler 886 di <- dim(x)
88 :     dn <- dimnames(x)
89 :     ip1 <- .ind.prep(x@i, i, 1, di, dn)
90 :     ip2 <- .ind.prep(x@j, j, 2, di, dn)
91 :     x@Dim <- nd <- c(ip1$li, ip2$li)
92 :     x@Dimnames <- list(ip1$dn, ip2$dn)
93 :     sel <- ip1$m > 0:0 & ip2$m > 0:0
94 :     x@i <- ip1$m[sel] - 1:1
95 :     x@j <- ip2$m[sel] - 1:1
96 : bates 923 if (!is(x, "lsparseMatrix")) x@x <- x@x[sel]
97 : maechler 886 if (drop && any(nd == 1)) drop(as(x,"matrix")) else x
98 : maechler 867 })
99 : bates 923
100 :     setMethod("crossprod", signature(x = "TsparseMatrix", y = "missing"),
101 :     function(x, y = NULL)
102 :     callGeneric(.Call("Tsparse_to_Csparse", x, PACKAGE = "Matrix"), y))
103 :    
104 :     setMethod("tcrossprod", signature(x = "TsparseMatrix"),
105 :     function(x)
106 :     callGeneric(.Call("Tsparse_to_Csparse", x, PACKAGE = "Matrix")))

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