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 886 - (view) (download)
Original Path: pkg/R/gTMatrix.R

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 :     ## and return match(.,.) + li = length of corresponding dimension
16 :     ##
17 :     ## i is "index"; xi = "x@i"; margin in {1,2};
18 :     ## di = dim(x) { when i is "logical" }
19 :     ## dn = dimnames(x)
20 :    
21 :     dn <- dn[[margin]]
22 :     has.dn <- is.character(dn)
23 :     if(is(i, "numeric")) {
24 :     storage.mode(i) <- "integer"
25 :     i0 <- i - 1:1 # tranform to 0-indexing
26 :     if(has.dn) dn <- dn[i]
27 :     }
28 :     else if (is(i, "logical")) {
29 :     i0 <- (0:(di[margin]-1:1))[i]
30 :     if(has.dn) dn <- dn[i]
31 :     } else { ## character
32 :     if(!has.dn)
33 :     stop(gettextf(
34 :     "no 'dimnames[[%d]]': cannot use character indexing"),
35 :     margin, domain = NA)
36 :     i0 <- match(i, dn, nomatch=0)
37 :     dn <- dn[i0]
38 :     i0 <- i0 - 1:1
39 :     }
40 :     list(m = match(xi, i0, nomatch=0), li = length(i0), dn = dn)
41 :     }
42 :    
43 :    
44 :     ## Otherwise have to write methods for all possible combinations of
45 :     ## (i , j) \in
46 :     ## (numeric, logical, character, missing) x (numeric, log., char., miss.)
47 :    
48 :    
49 : maechler 867 ## Select rows
50 : maechler 886 setMethod("[", signature(x = "gTMatrix", i = "index", j = "missing",
51 : maechler 867 drop = "logical"),
52 :     function (x, i, j, ..., drop) { ## select rows
53 : maechler 886 ip <- .ind.prep(x@i, i, 1, dim(x), dimnames(x))
54 :     x@Dim[1] <- ip$li
55 :     x@Dimnames[1] <- ip$dn
56 :     sel <- ip$m > 0
57 :     x@i <- ip$m[sel] - 1:1
58 :     x@j <- x@j[sel]
59 :     x@x <- x@x[sel]
60 :     if (drop && any(x@Dim == 1:1)) drop(as(x,"matrix")) else x
61 : maechler 867 })
62 :    
63 :    
64 :     ## Select columns
65 : maechler 886 setMethod("[", signature(x = "gTMatrix", i = "missing", j = "index",
66 : maechler 867 drop = "logical"),
67 :     function (x, i, j, ..., drop) { ## select columns
68 : maechler 886 ip <- .ind.prep(x@j, j, 2, dim(x), dimnames(x))
69 :     x@Dim[2] <- ip$li
70 :     x@Dimnames[2] <- ip$dn
71 :     sel <- ip$m > 0
72 :     x@i <- x@i[sel]
73 :     x@j <- ip$m[sel] - 1:1
74 :     x@x <- x@x[sel]
75 :     if (drop && any(x@Dim == 1:1)) drop(as(x,"matrix")) else x
76 : maechler 867 })
77 :    
78 :    
79 :     ## [.data.frame has : drop = if (missing(i)) TRUE else length(cols) == 1)
80 :    
81 :     setMethod("[", signature(x = "gTMatrix",
82 : maechler 886 i = "index", j = "index", drop = "logical"),
83 : maechler 867 function (x, i, j, ..., drop)
84 :     {
85 :     ## (i,j, drop) all specified
86 : maechler 886 di <- dim(x)
87 :     dn <- dimnames(x)
88 :     ip1 <- .ind.prep(x@i, i, 1, di, dn)
89 :     ip2 <- .ind.prep(x@j, j, 2, di, dn)
90 :     x@Dim <- nd <- c(ip1$li, ip2$li)
91 :     x@Dimnames <- list(ip1$dn, ip2$dn)
92 :     sel <- ip1$m > 0:0 & ip2$m > 0:0
93 :     x@i <- ip1$m[sel] - 1:1
94 :     x@j <- ip2$m[sel] - 1:1
95 : maechler 867 x@x <- x@x[sel]
96 : maechler 886 if (drop && any(nd == 1)) drop(as(x,"matrix")) else x
97 : maechler 867 })

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