SCM

SCM Repository

[matrix] Diff of /pkg/tests/Class+Meth.R
ViewVC logotype

Diff of /pkg/tests/Class+Meth.R

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

revision 1757, Sat Feb 3 00:21:11 2007 UTC revision 1758, Sat Feb 3 16:34:51 2007 UTC
# Line 5  Line 5 
5  #### possibly augmented with methods  #### possibly augmented with methods
6    
7  allCl <- getClasses("package:Matrix")  allCl <- getClasses("package:Matrix")
8    cat("actual and virtual classes:\n")
9    table( sapply(allCl, isVirtualClass) )
10    
11  ## Really nice would be to construct an inheritance graph and display  ## Really nice would be to construct an inheritance graph and display
12  ## it.  The following is just a cheap first step.  ## it.  The following is just a cheap first step.
13    
14    ## We use a version of  canCoerce()  that works with two *classes* instead of
15    ## canCoerce <- function (object, Class)
16    classCanCoerce <- function (class1, class2)
17    {
18        extends(class1, class2) ||
19        !is.null(selectMethod("coerce", optional = TRUE,
20                              signature    = c(from = class1, to = class2),
21                              useInherited = c(from = TRUE,   to = FALSE)))
22    }
23    .dq <- function(ch) paste0('"', ch, '"')
24    for(n in allCl) {
25        if(isVirtualClass(n))
26            cat("Virtual class", .dq(n),"\n")
27        else {
28            cat("\"Actual\" class", .dq(n),":\n")
29            x <- new(n)
30            for(m in allCl)
31                if(classCanCoerce(n,m)) {
32                    ext <- extends(n, m)
33                    if(ext) {
34                        cat(sprintf("   extends  %20s %20s \n", "", .dq(m)))
35                    } else {
36                        cat(sprintf("   can coerce: %20s -> %20s: ", .dq(n), .dq(m)))
37                        tt <- try(as(x, m), silent = TRUE)
38                        if(inherits(tt, "try-error")) {
39                            cat("\t *ERROR* !!\n")
40                        } else {
41                            cat("as() ok; validObject: ")
42                            vo <- validObject(tt, test = TRUE)
43                            cat(if(isTRUE(vo)) "ok" else paste("OOOOOOPS:", vo), "\n")
44                        }
45                    }
46                }
47            cat("---\n")
48        }
49    }
50    
51  if(!interactive()) { # don't want to see on source()  if(!interactive()) { # don't want to see on source()
52    
53  cat("All classes in the 'Matrix' package:\n")  cat("All classes in the 'Matrix' package:\n")

Legend:
Removed from v.1757  
changed lines
  Added in v.1758

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