SCM

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 925 - (download) (annotate)
Mon Sep 19 19:01:31 2005 UTC (13 years, 11 months ago) by maechler
File size: 2924 byte(s)
too many changes: rbind2 for dM*, cbind2(), "Math", "Arith" for sparse ones; more  "s/gTMatrix/TsparseMatrix/" fixes; quite a few more tests, incl some for *all* classes
library(Matrix)

#### Automatically display the class inheritance structure
#### possibly augmented with methods

allCl <- getClasses("package:Matrix")

## Really nice would be to construct an inheritance graph and display
## it.  The following is just a cheap first step.

cat("All classes in the 'Matrix' package:\n")
for(cln in allCl) {
    cat("\n-----\n\nClass", dQuote(cln),":\n      ",
        paste(rep("~",nchar(cln)),collapse=''),"\n")
    ## A smarter version would use  getClass() instead of showClass(),
    ## build the "graph" and only then display.

    showClass(cln)
}

cat("\n\n")

## One could extend the `display' by using (something smarter than)
## are the "coerce" methods showing more than the 'Extends' output above?
cat("All (S4) methods in the 'Matrix' package:\n")
showMethods(where="package:Matrix")


### Sparse Logical:
m <- Matrix(c(0,0,2:0), 3,5)
mT <- as(mC <- as(m, "dgCMatrix"), "dgTMatrix")
stopifnot(identical(as(mT,"dgCMatrix"), mC))
(mlC <- as(as(mT[1:2, 2:3], "dgCMatrix"), "lgCMatrix"))

if(FALSE) ## ltC no longer extends lgC -- but need coercion possibility FIXME
as(mlC,"ltCMatrix")


### Test all classes:  validObject(new( * )) should be fulfilled -----------

## need stoplist for now:
not.ok.classes <- paste(c("lgR", # only stub implementation
			  "lsR", # dito
			  "ltR", # dito

			  "ltT", # ltTMatrix_validate missing; as(*,"matrix")
			  "lsT", # lsTMatrix_validate  "	"

			  ""), "Matrix", sep='')
## From the rest, those that don't show :
no.show.classes <- paste(c("dgR", # only stub implementation
			   "dsR", # dito
			   "dtR", #  "
                           ## if(!is.R22) # format(<0-length-matrix>) bug
                           ## c("dtr", "dtp"),
                           ## FIXME: since 2005-09-18 inheritance change;
                           ## as(*, "matrix") gives infinite recursion :
                           "lsC",
                           "ltC",
			   ), "Matrix", sep='')

mM <- Matrix(1:4 >= 4, 2,2)
mm <- as(mM, "matrix")
for(cl in getClass("Matrix")@subclasses) {
    clNam <- cl@subClass
    cat(clNam)
    if(isVirtualClass(clNam)) {
	cat(" - is virtual\n")
    }
    else {
	cat("; new(..):")
	m <- new(clNam)
	if(any(clNam == not.ok.classes)) {
	    cat(" in 'stop list' - no validity\n")
	}
	else {
	    cat("valid: ", validObject(m), "\n")

	    ## The show() method implicitly tests
	    ##	as( <obj> , "matrix")
	    if(all(clNam != no.show.classes))
		show(m)
	    else cat("	-- no show() yet \n")

	    if(is(m, "dMatrix")) {
                if(FALSE) { ## (FIXME) ?
                    cat("as(dge*, <class>): ")
                    m2 <- as(mM, clNam)
                    cat("valid:", validObject(m2), "\n")
                }
		if(FALSE) { ## FIXME or use another stoplist; fails for 'dsy'
		    cat("as(matrix, <class>): ")
		    m3 <- as(mm, clNam)
		    cat("valid:", validObject(m3), "\n")
		}
	    }
	}
    }
}

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