SCM

SCM Repository

[matrix] Diff of /pkg/Matrix/tests/indexing.Rout.save
ViewVC logotype

Diff of /pkg/Matrix/tests/indexing.Rout.save

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

revision 2676, Sat Jun 25 19:14:05 2011 UTC revision 2677, Sat Jun 25 19:18:12 2011 UTC
# Line 1  Line 1 
1    
2  R version 2.12.1 Patched (2011-02-12 r54356)  R version 2.13.0 Patched (2011-06-19 r56184)
3  Copyright (C) 2011 The R Foundation for Statistical Computing  Copyright (C) 2011 The R Foundation for Statistical Computing
4  ISBN 3-900051-07-0  ISBN 3-900051-07-0
5  Platform: x86_64-unknown-linux-gnu (64-bit)  Platform: x86_64-unknown-linux-gnu (64-bit)
# Line 126  Line 126 
126  +         )  +         )
127  >  >
128  > showProc.time()  > showProc.time()
129  Time elapsed:  0.45 0.01 0.457  Time elapsed:  0.353 0.011 0.365
130  >  >
131  > ## Printing sparse colnames:  > ## Printing sparse colnames:
132  > ms[sample(28, 20)] <- 0  > ms[sample(28, 20)] <- 0
# Line 183  Line 183 
183  +         identical3(m[!sel],  m[!ssel], as.matrix(m)[as.matrix(!ssel)])  +         identical3(m[!sel],  m[!ssel], as.matrix(m)[as.matrix(!ssel)])
184  +         )  +         )
185  > showProc.time()  > showProc.time()
186  Time elapsed:  0.1 0 0.098  Time elapsed:  0.092 0 0.092
187  >  >
188  > ## more sparse Matrices --------------------------------------  > ## more sparse Matrices --------------------------------------
189  >  >
190    > ##' @title Check sparseMatrix sub-assignment   m[i,j] <- v
191    > ##' @param ms sparse Matrix
192    > ##' @param mm its [traditional matrix]-equivalent
193    > ##' @param k  (approximate) length of index vectors (i,j)
194    > ##' @param n.uniq (approximate) number of unique values in  i,j
195    > ##' @param show logical; if TRUE, it will not stop on error
196    > ##' @return
197    > ##' @author Martin Maechler
198    > chkAssign <- function(ms, mm = as(ms, "matrix"),
199    +                       k = min(20,dim(mm)), n.uniq = k %/% 3, show=FALSE)
200    + {
201    +     stopifnot(is(ms,"sparseMatrix"))
202    +     s1 <- function(n) sample(n, pmin(n, pmax(1, rpois(1, n.uniq))))
203    +     i <- sample(s1(nrow(ms)), k/2+ rpois(1, k/2), replace = TRUE)
204    +     j <- sample(s1(ncol(ms)), k/2+ rpois(1, k/2), replace = TRUE)
205    +     assert.EQ.mat(ms[i,j], mm[i,j])
206    +     ## now sub*assign* to these repeated indices, and then compare -----
207    +     x <- rpois(length(i) * length(j), lambda= 0.75)#- about 47% zeros
208    +     ms[i,j] <- x
209    +     mm[i,j] <- x
210    +     if(!show) { op <- options(error = recover); on.exit(options(op)) }
211    +     assert.EQ.mat(ms, mm, show=show)
212    + }
213    >
214  > m <- 1:800  > m <- 1:800
215  > set.seed(101) ; m[sample(800, 600)] <- 0  > set.seed(101) ; m[sample(800, 600)] <- 0
216  > m0 <- Matrix(m, nrow = 40)  > m0 <- Matrix(m, nrow = 40)
217  > m1 <- add.simpleDimnames(m0)  > m1 <- add.simpleDimnames(m0)
218  > for(m in list(m0,m1)) { ## -- with and without dimnames  > for(m in list(m0,m1)) { ## -- with and without dimnames -------------------------
219  + mm <- as(m, "matrix")  + mm <- as(m, "matrix")
220  + str(mC <- as(m, "dgCMatrix"))  + str(mC <- as(m, "dgCMatrix"))
221  + str(mT <- as(m, "dgTMatrix"))  + str(mT <- as(m, "dgTMatrix"))
# Line 203  Line 227 
227  +         identical(unname(mT[,0]), new("dgTMatrix", Dim = c(40L,0L))),  +         identical(unname(mT[,0]), new("dgTMatrix", Dim = c(40L,0L))),
228  +         identical(mC[0,], as(mT[FALSE,], "dgCMatrix")),  +         identical(mC[0,], as(mT[FALSE,], "dgCMatrix")),
229  +         identical(mC[,0], as(mT[,FALSE], "dgCMatrix")),  +         identical(mC[,0], as(mT[,FALSE], "dgCMatrix")),
230  +         sapply(c(0:2, 5:10), function(k) {i <- seq_len(k); all(mC[i,i] == mT[i,i])}),  +         sapply(c(0:2, 5:10),
231    +                  function(k) {i <- seq_len(k); all(mC[i,i] == mT[i,i])}),
232  +         TRUE)  +         TRUE)
233  + cat("ok\n")  + cat("ok\n")
234  + show(mC[,1])  + show(mC[,1])
# Line 224  Line 249 
249  + assert.EQ.mat(mC[c(4,1,2:1), j], mm[c(4,1,2:1), j])  + assert.EQ.mat(mC[c(4,1,2:1), j], mm[c(4,1,2:1), j])
250  + assert.EQ.mat(mC[i,j], mm[i,j])  + assert.EQ.mat(mC[i,j], mm[i,j])
251  +  +
 + ##' @title Check sparseMatrix sub-assignment   m[i,j] <- v  
 + ##' @param ms sparse Matrix  
 + ##' @param mm its [traditional matrix]-equivalent  
 + ##' @param k  (approximate) length of index vectors (i,j)  
 + ##' @param n.uniq (approximate) number of unique values in  i,j  
 + ##' @param show logical; if TRUE, it will not stop on error  
 + ##' @return  
 + ##' @author Martin Maechler  
 + chkAssign <- function(ms, mm = as(ms, "matrix"),  
 +                       k = min(20,dim(mm)), n.uniq = k %/% 3, show=FALSE)  
 + {  
 +     stopifnot(is(ms,"sparseMatrix"))  
 +     s1 <- function(n) sample(n, pmin(n, pmax(1, rpois(1, n.uniq))))  
 +     i <- sample(s1(nrow(ms)), k/2+ rpois(1, k/2), replace = TRUE)  
 +     j <- sample(s1(ncol(ms)), k/2+ rpois(1, k/2), replace = TRUE)  
 +     assert.EQ.mat(ms[i,j], mm[i,j])  
 +     ## now sub*assign* to these repeated indices, and then compare -----  
 +     x <- rpois(length(i) * length(j), lambda= 0.75)#- about 47% zeros  
 +     ms[i,j] <- x  
 +     mm[i,j] <- x  
 +     if(!show) { op <- options(error = recover); on.exit(options(op)) }  
 +     assert.EQ.mat(ms, mm, show=show)  
 + }  
252  + set.seed(7)  + set.seed(7)
253  + cat(" for(): ")  + cat(" for(): ")
254  + for(n in 1:50) {  + for(n in 1:50) {
# Line 255  Line 257 
257  +     cat(".")  +     cat(".")
258  + }  + }
259  + cat("ok\n----\n")  + cat("ok\n----\n")
260  + }## end{for}  + }## end{for}---------------------------------------------------------------
261  Formal class 'dgCMatrix' [package "Matrix"] with 6 slots  Formal class 'dgCMatrix' [package "Matrix"] with 6 slots
262    ..@ i       : int [1:200] 2 6 11 21 24 29 37 38 1 4 ...    ..@ i       : int [1:200] 2 6 11 21 24 29 37 38 1 4 ...
263    ..@ p       : int [1:21] 0 8 22 28 37 41 50 63 71 81 ...    ..@ p       : int [1:21] 0 8 22 28 37 41 50 63 71 81 ...
# Line 316  Line 318 
318   for(): ..................................................ok   for(): ..................................................ok
319  ----  ----
320  > showProc.time()  > showProc.time()
321  Time elapsed:  2.05 0 2.051  Time elapsed:  1.876 0.015 1.895
322  >  >
323  > ##---- Symmetric indexing of symmetric Matrix ----------  > ##---- Symmetric indexing of symmetric Matrix ----------
324  > m. <- mC  > m. <- mC
# Line 388  Line 390 
390  +     assert.EQ.mat(T[i,i], ss[i,i])  +     assert.EQ.mat(T[i,i], ss[i,i])
391  + }  + }
392  > showProc.time()  > showProc.time()
393  Time elapsed:  1.74 0.01 1.761  Time elapsed:  1.811 0.017 1.831
394  >  >
395  > stopifnot(all.equal(mC[,3], mm[,3]),  > stopifnot(all.equal(mC[,3], mm[,3]),
396  +         identical(mC[ij], mC[ij + 0.4]),  +         identical(mC[ij], mC[ij + 0.4]),
# Line 592  Line 594 
594  +         all(sm[,-(1:3)] == 0)  +         all(sm[,-(1:3)] == 0)
595  +         )  +         )
596  > showProc.time()  > showProc.time()
597  Time elapsed:  0.36 0 0.355  Time elapsed:  0.35 0.005 0.356
598  >  >
599  > m0 <- Diagonal(5)  > m0 <- Diagonal(5)
600  > stopifnot(identical(m0[2,], m0[,2]),  > stopifnot(identical(m0[2,], m0[,2]),
# Line 748  Line 750 
750  as(<triangular (ge)matrix>, dtCMatrix): valid: TRUE  as(<triangular (ge)matrix>, dtCMatrix): valid: TRUE
751  > stopifnot(is(T, "dtCMatrix"), identical(T[,3], c(10,10,10,0,0)))  > stopifnot(is(T, "dtCMatrix"), identical(T[,3], c(10,10,10,0,0)))
752  > showProc.time()  > showProc.time()
753  Time elapsed:  1.4 0 1.399  Time elapsed:  1.333 0.002 1.341
754  >  >
755  >  >
756  > ## "Vector indices" -------------------  > ## "Vector indices" -------------------
# Line 856  Line 858 
858  > ## mixing of negative and positive must give error  > ## mixing of negative and positive must give error
859  > assertError(mT[-1:1,])  > assertError(mT[-1:1,])
860  > showProc.time()  > showProc.time()
861  Time elapsed:  0.18 0 0.181  Time elapsed:  0.273 0 0.274
862  >  >
863  > ## Sub *Assignment* ---- now works (partially):  > ## Sub *Assignment* ---- now works (partially):
864  > mt0 <- mt  > mt0 <- mt
# Line 983  Line 985 
985  r3  3  r3  3
986  r5  1  r5  1
987  > showProc.time()  > showProc.time()
988  Time elapsed:  0.98 0.01 1.008  Time elapsed:  0.925 0.007 0.933
989  > options(Matrix.verbose = TRUE)  > options(Matrix.verbose = TRUE)
990  >  >
991  > mc # no longer has non-structural zeros  > mc # no longer has non-structural zeros
# Line 1204  Line 1206 
1206  > assert.EQ.mat(t2, m)# ok  > assert.EQ.mat(t2, m)# ok
1207  > assert.EQ.mat(s2, m)# failed in 0.9975-8  > assert.EQ.mat(s2, m)# failed in 0.9975-8
1208  > showProc.time()  > showProc.time()
1209  Time elapsed:  1.29 0 1.282  Time elapsed:  1.216 0.007 1.225
1210  >  >
1211  >  >
1212  > ## m[cbind(i,j)] <- value: (2-column matrix subassignment):  > ## m[cbind(i,j)] <- value: (2-column matrix subassignment):
# Line 1347  Line 1349 
1349  >  >
1350  > cc <- capture.output(show(dLrg))# show(<diag>) used to error for large n  > cc <- capture.output(show(dLrg))# show(<diag>) used to error for large n
1351  > showProc.time()  > showProc.time()
1352  Time elapsed:  1.37 0.01 1.386  Time elapsed:  1.379 0.011 1.392
1353  >  >
1354  > ## Large Matrix indexing / subassignment  > ## Large Matrix indexing / subassignment
1355  > ## ------------------------------------- (from ex. by Imran Rashid)  > ## ------------------------------------- (from ex. by Imran Rashid)
# Line 1405  Line 1407 
1407  +         identical(thCol,  fx[,5762]))  +         identical(thCol,  fx[,5762]))
1408  >  >
1409  > showProc.time()  > showProc.time()
1410  Time elapsed:  5.96 0.7 6.679  Time elapsed:  7.588 0.777 8.38
1411  > ##  > ##
1412  > cat("checkMatrix() of all: \n---------\n")  > cat("checkMatrix() of all: \n---------\n")
1413  checkMatrix() of all:  checkMatrix() of all:
# Line 1582  Line 1584 
1584  suboptimal 'Arith' implementation of  'dsC*  o  dsC*'  suboptimal 'Arith' implementation of  'dsC*  o  dsC*'
1585  zz  zz
1586  > showProc.time()  > showProc.time()
1587  Time elapsed:  11.62 0.28 11.929  Time elapsed:  12.19 0.309 12.511
1588  >  >
1589  > if(!interactive()) warnings()  > if(!interactive()) warnings()
1590  NULL  NULL

Legend:
Removed from v.2676  
changed lines
  Added in v.2677

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