SCM

SCM Repository

[matrix] Diff of /pkg/tests/validObj.R
ViewVC logotype

Diff of /pkg/tests/validObj.R

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

revision 516, Sat Feb 5 13:54:20 2005 UTC revision 544, Mon Feb 14 21:04:03 2005 UTC
# Line 2  Line 2 
2    
3  ### Do all kinds of object creation and coercion  ### Do all kinds of object creation and coercion
4    
   
5  chk.matrix <- function(M) {  chk.matrix <- function(M) {
6      ## check if "matrix" coercion looks ok      ## check object; including coercion to "matrix" :
7      cl <- class(M)      cl <- class(M)
8      d <- dim(M)      cat("class ", dQuote(cl), " [",nrow(M)," x ",ncol(M),"]; slots (",
     cat("class ", dQuote(cl), " [",d[1]," x ",d[2],"]; slots (",  
9          paste(slotNames(M), collapse=","), ")\n", sep='')          paste(slotNames(M), collapse=","), ")\n", sep='')
10      stopifnot(validObject(M),      stopifnot(validObject(M),
11                  dim(M) == c(nrow(M), ncol(M)),
12                identical(dim(m <- as(M,"matrix")), dim(M))                identical(dim(m <- as(M,"matrix")), dim(M))
13                )                )
14  }  }
15    
16    ## Make sure errors are signaled
17    assertError <- function(expr) {
18        d.expr <- deparse(substitute(expr))
19        t.res <- try(expr, silent = TRUE)
20        if(!inherits(t.res, "try-error"))
21            stop(d.expr, "\n\t did not give an error", call. = FALSE)
22        invisible(t.res)
23    }
24    
25    ## "dMatrix"
26    str(new("Matrix"))
27    
28  ## "dge"  ## "dge"
29    assertError( new("dgeMatrix", Dim = c(2,2), x= 1:4) )# double 'Dim'
30    if(FALSE)## FIXME: this creates an integer '@ x' !
31    assertError( new("dgeMatrix", Dim = as.integer(c(2,2)), x= 1:4) )# int 'x'
32    assertError( new("dgeMatrix", Dim = 2:2, x=as.double(1:4)) )# length(Dim) !=2
33    assertError( new("dgeMatrix", Dim = as.integer(c(2,2)), x= as.double(1:5)))
34    
35  chk.matrix(m1 <- Matrix(1:6, ncol=2))  chk.matrix(m1 <- Matrix(1:6, ncol=2))
36  chk.matrix(m2 <- Matrix(1:7, ncol=3)) # a warning  chk.matrix(m2 <- Matrix(1:7, ncol=3)) # a warning
37    
38  ## "dpo"  ## "dpo"
39  chk.matrix(cm <- crossprod(m1))  chk.matrix(cm <- crossprod(m1))
40  chk.matrix(as(cm, "dsyMatrix"))  chk.matrix(as(cm, "dsyMatrix"))
# Line 28  Line 46 
46  ## FIXME:  ## FIXME:
47  try( chk.matrix(ch2 <- chol(as(cm, "dsyMatrix"))) ) # should not give an error  try( chk.matrix(ch2 <- chol(as(cm, "dsyMatrix"))) ) # should not give an error
48  try( chk.matrix(ch3 <- chol(as(cm, "dgeMatrix"))) ) # nor that one  try( chk.matrix(ch3 <- chol(as(cm, "dgeMatrix"))) ) # nor that one
49    
50    ### Very basic  triangular matrix stuff
51    
52    assertError( new("dtrMatrix", Dim = c(2,2), x= 1:4) )# double 'Dim'
53    if(FALSE)## FIXME: this creates an integer '@ x' !
54    assertError( new("dtrMatrix", Dim = as.integer(c(2,2)), x= 1:4) )# int 'x'
55    if(FALSE)## FIXME: should produce an error not a segmentation fault
56    assertError( new("dtrMatrix", Dim = 2:2, x=as.double(1:4)) )# length(Dim) !=2
57    assertError( new("dtrMatrix", Dim = as.integer(c(2,2)), x= as.double(1:5)))
58    
59    tr22 <- new("dtrMatrix", Dim = as.integer(c(2,2)), x=as.double(1:4))
60    try( t(tr22) ) # fails -- FIXME
61    
62    ## non-square
63    tru <- new("dtrMatrix", Dim = 2:3, x=as.double(1:6), uplo="L", diag="U")
64    trn <- new("dtrMatrix", Dim = 2:3, x=as.double(1:6), uplo="L", diag="N")
65    try( tru + trn ) # not yet
66    
67    try( t(tru) ) ## FIXME !
68    try( t(trn) ) ## FIXME
69    

Legend:
Removed from v.516  
changed lines
  Added in v.544

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