SCM

SCM Repository

[matrix] Diff of /pkg/Matrix/tests/group-methods.R
ViewVC logotype

Diff of /pkg/Matrix/tests/group-methods.R

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

revision 2812, Mon Jul 16 16:04:26 2012 UTC revision 2813, Wed Jul 18 16:02:38 2012 UTC
# Line 147  Line 147 
147                      crossprod(as(lm1, "dMatrix"))                      crossprod(as(lm1, "dMatrix"))
148                      ))                      ))
149    
150    D3 <- Diagonal(x=4:2)  # for the checks below, also want a *diagonal*
151    
152    
153  ## Systematically look at all "Ops" group generics for "all" Matrix classes  ## Systematically look at all "Ops" group generics for "all" Matrix classes
154  ## -------------- Main issue: Detect infinite recursion problems  ## -------------- Main issue: Detect infinite recursion problems
155  cl <- sapply(ls(), function(.) class(get(.)))  cl <- sapply(ls(), function(.) class(get(.)))
156  Mcl <- c(grep("Matrix$", cl, value=TRUE),  Mcl <- c(grep("Matrix$", cl, value=TRUE),
157           grep("sparseVector", cl, value=TRUE))           grep("sparseVector", cl, value=TRUE))
158  table(Mcl)  table(Mcl)
159    ## choose *one* of each class:
160  M.objs <- names(Mcl[!duplicated(Mcl)])  M.objs <- names(Mcl[!duplicated(Mcl)])
161    Mat.objs <- M.objs[vapply(M.objs, function(nm) is(get(nm), "Matrix"), NA)]
162    (MatDims <- t(vapply(Mat.objs, function(nm) dim(get(nm)), 0:1)))
163    mDims <- MatDims %*% (d.sig <- c(1, 1000)) # "dim-signature" to match against
164    
165    m2num <- function(m) { if(is.integer(m)) storage.mode(m) <- "double" ; m }
166  cat("Checking all group generics for a set of arguments:\n",  cat("Checking all group generics for a set of arguments:\n",
167      "---------------------------------------------------\n", sep='')      "---------------------------------------------------\n", sep='')
168  for(gr in getGroupMembers("Ops")) {  for(gr in getGroupMembers("Ops")) {
# Line 178  Line 186 
186              cat("s.")              cat("s.")
187              validObject(r3 <- do.call(f, list(M, sv)))              validObject(r3 <- do.call(f, list(M, sv)))
188              stopifnot(dim(r3) == dim(M))              stopifnot(dim(r3) == dim(M))
189                if(is(M, "Matrix")) { ## M  o <Matrix>
190                    d <- dim(M)
191                    ds <- sum(d * d.sig)
192                    if(any(match. <- ds == mDims)) {
193                        cat("\nM o M:")
194                        for(oM in Mat.objs[match.]) {
195                            M2 <- get(oM)
196                            validObject(R4 <- do.call(f, list(M, M2)))
197                            cat(".")
198                            r4 <- m2num(do.call(f, list(as.mat(M), as.mat(M2))))
199                            ## stopifnot(identical(r4, as.mat(R4)))
200                            if(!identical(r4, as.mat(R4))) {
201                                cat("\n  ** not identical:  r4 \\ R4 :\n")
202                                print(r4); print(R4)
203                            }
204                            cat("i")
205                        }
206                    }
207                }
208          }          }
209          cat("\n")          cat("\n")
210      }      }
211  }  }
212    
213  if(FALSE) {## These are not yet there  stopifnot(identical(lm2, lm1 & lm2),
214  lm1 & lm2            identical(lm1, lm1 | lm2))
 lm1 | lm2  
 }  
215    
216    
217  cat('Time elapsed: ', proc.time(),'\n') # for ``statistical reasons''  cat('Time elapsed: ', proc.time(),'\n') # for ``statistical reasons''

Legend:
Removed from v.2812  
changed lines
  Added in v.2813

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