The R Project SVN R

Rev

Rev 52031 | Rev 58136 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 52031 Rev 52110
Line 1... Line 1...
1 
setClass("maybe")
 1 
setClass("maybe")
2 
 
 2 
 
3 
setClass("A", representation(x = "numeric"))
 3 
setClass("A", representation(x = "numeric"))
4 
 
 4 
 
- 
 
 5 
setIs("A", "maybe",
5 
setIs("A", "maybe", test = function(object)length(object@x) >= 1 && object@x[[1]]>0,
 6 
      test = function(object)length(object@x) >= 1 && object@x[[1]] > 0,
6 
      coerce = function(from)from,
 7 
      coerce = function(from)from,
- 
 
 8 
      replace = function(from, value)
7 
      replace = function(from, value) stop("meaningless to replace the \"maybe\" part of an object"))
 9 
      stop("meaningless to replace the \"maybe\" part of an object"))
8 
 
 10 
 
9 
aa = new("A", x=1)
 11 
aa <- new("A", x=1)
10 
 
 12 
 
11 
ff <- function(x)"default ff"
 13 
ff <- function(x)"default ff"
12 
 
 - 
 
13 
setGeneric("ff")
 14 
setGeneric("ff")
14 
 
 15 
 
15 
ffMaybe <- function(x) "ff maybe method"
 16 
ffMaybe <- function(x) "ff maybe method"
16 
 
 - 
 
17 
setMethod("ff", "maybe", ffMaybe)
 17 
setMethod("ff", "maybe", ffMaybe)
18 
 
 18 
 
19 
stopifnot(identical(ff(aa), "default ff"))
 - 
 
20 
 
 - 
 
21 
aa2 <- new("A", x = -1) # condition not TRUE
 19 
aa2 <- new("A", x = -1) # condition not TRUE
22 
 
 - 
 
23 
stopifnot(identical(ff(aa2), "default ff"))
 20 
stopifnot(identical(ff(aa),  "default ff"),
- 
 
 21 
	  identical(ff(aa2), "default ff"))# failed in R 2.11.0
24 
 
 22 
 
25 
## a method to test the condition
 23 
## a method to test the condition
26 
setMethod("ff", "A",
 24 
setMethod("ff", "A",
27 
          function(x) {
 25 
	  function(x) {
28 
              if(is(x, "maybe"))
 26 
	      if(is(x, "maybe"))
29 
                  ffMaybe(x)
 27 
		  ffMaybe(x)
30 
              else
 28 
	      else
31 
                callNextMethod()
 29 
		  callNextMethod()
32 
          })
 30 
	  })
33 
stopifnot(identical(ff(aa), "ff maybe method"))
 31 
stopifnot(identical(ff(aa), "ff maybe method"),
34 
stopifnot(identical(ff(aa2), "default ff"))
 32 
          identical(ff(aa2), "default ff"))
35 
 
 33 
 
36 
removeClass("A")
 34 
removeClass("A")
37 
removeClass("maybe")
 35 
removeClass("maybe")
38 
removeGeneric("ff")
 36 
removeGeneric("ff")