The R Project SVN R

Rev

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

Rev 52903 Rev 52904
Line 6... Line 6...
6 
 
 6 
 
7 
R is free software and comes with ABSOLUTELY NO WARRANTY.
 7 
R is free software and comes with ABSOLUTELY NO WARRANTY.
8 
You are welcome to redistribute it under certain conditions.
 8 
You are welcome to redistribute it under certain conditions.
9 
Type 'license()' or 'licence()' for distribution details.
 9 
Type 'license()' or 'licence()' for distribution details.
10 
 
 10 
 
11 
  Natural language support but running in an English locale
 - 
 
12 
 
 - 
 
13 
R is a collaborative project with many contributors.
 11 
R is a collaborative project with many contributors.
14 
Type 'contributors()' for more information and
 12 
Type 'contributors()' for more information and
15 
'citation()' on how to cite R or R packages in publications.
 13 
'citation()' on how to cite R or R packages in publications.
16 
 
 14 
 
17 
Type 'demo()' for some demos, 'help()' for on-line help, or
 15 
Type 'demo()' for some demos, 'help()' for on-line help, or
18 
'help.start()' for an HTML browser interface to help.
 16 
'help.start()' for an HTML browser interface to help.
19 
Type 'q()' to quit R.
 17 
Type 'q()' to quit R.
20 
 
 18 
 
21 
> pkgname <- "methods"
 19 
> #### Testing  UseMethod() and even more NextMethod()
22 
> source(file.path(R.home("share"), "R", "examples-header.R"))
 20 
> #### --------------------
23 
> options(warn = 1)
 21 
> #### i.e.,  S3 methods *only*. For S4, see  reg-S4.R
24 
> library('methods')
 22 
> ##                                          ~~~~~~~~
25 
>
23 
>
26 
> assign(".oldSearch", search(), pos = 'CheckExEnv')
 24 
> ###-- Group methods
27 
> cleanEx()
 25 
>
28 
> nameEx("GenericFunctions")
 26 
> ## previous versions used print() and hit an auto-printing bug.
29 
> ### * GenericFunctions
 27 
>
30 
>
28 
> ### Arithmetic "Ops" :
31 
> flush(stderr()); flush(stdout())
 29 
> ">.bar" <- function(...) {cat("using >.bar\n"); FALSE}
32 
>
30 
> ">.foo" <- function(...) {cat("using >.foo\n"); TRUE}
33 
> ### Name: GenericFunctions
 31 
> Ops.foo <- function(...) {
34 
> ### Title: Tools for Managing Generic Functions
 32 
+     cat("using Ops.foo\n")
35 
> ### Aliases: GenericFunctions isGeneric isGroup removeGeneric getGenerics
 33 
+     NextMethod()
36 
> ###   dumpMethod findFunction dumpMethods removeMethods signature
 34 
+ }
37 
> ###   setReplaceMethod
 35 
> Ops.bar <- function(...) {
38 
> ### Keywords: programming classes methods
 36 
+     cat("using Ops.bar\n")
39 
>
37 
+     TRUE
40 
> ### ** Examples
 38 
+ }
41 
>
39 
>
42 
> require(stats) # for lm
 40 
> x <- 2:4 ; class(x) <- c("foo", "bar")
43 
>
41 
> y <- 4:2 ; class(y) <- c("bar", "foo")
44 
> ## get the function "myFun" -- throw an error if 0 or > 1 versions visible:
 42 
>
45 
> findFuncStrict <- function(fName) {
 43 
> ## The next 4 give a warning each about incompatible methods:
46 
+   allF <- findFunction(fName)
 44 
> x > y
47 
+   if(length(allF) == 0)
 45 
[1] FALSE FALSE  TRUE
48 
+     stop("No versions of ",fName," visible")
 46 
Warning message:
49 
+   else if(length(allF) > 1)
 47 
Incompatible methods (">.foo", ">.bar") for ">"
50 
+     stop(fName," is ambiguous: ", length(allF), " versions")
 48 
> y < x # should be the same (warning msg not, however)
51 
+   else
 49 
[1] FALSE FALSE  TRUE
52 
+     get(fName, allF[[1]])
 50 
Warning message:
53 
+ }
 51 
Incompatible methods ("Ops.bar", "Ops.foo") for "<"
54 
>
52 
> x == y
55 
> try(findFuncStrict("myFun"))# Error: no version
 53 
[1] FALSE  TRUE FALSE
56 
Error in findFuncStrict("myFun") : No versions of myFun visible
 54 
Warning message:
57 
> lm <- function(x) x+1
 55 
Incompatible methods ("Ops.foo", "Ops.bar") for "=="
58 
> try(findFuncStrict("lm"))#    Error: 2 versions
 56 
> x <= y
59 
Error in findFuncStrict("lm") : lm is ambiguous: 2 versions
 57 
[1]  TRUE  TRUE FALSE
60 
> findFuncStrict("findFuncStrict")# just 1 version
 58 
Warning message:
61 
function (fName)
59 
Incompatible methods ("Ops.foo", "Ops.bar") for "<="
62 
{
 60 
>
63 
    allF <- findFunction(fName)
 61 
> x > 3 ##[1] ">.foo"
64 
    if (length(allF) == 0)
62 
using >.foo
65 
        stop("No versions of ", fName, " visible")
 63 
[1] TRUE
66 
    else if (length(allF) > 1)
64 
>
67 
        stop(fName, " is ambiguous: ", length(allF), " versions")
 65 
> rm(list=">.foo")
68 
    else get(fName, allF[[1]])
 66 
> x > 3 #-> "Ops.foo" and ">.bar"
69 
}
 67 
using Ops.foo
70 
> rm(lm)
 68 
using >.bar
71 
>
69 
[1] FALSE
72 
> ## Don't show:
70 
>
73 
> ## because nosegfault runs standardGeneric w/o the methods package, nothing
 71 
>
74 
> ## really gets tested.  The following check that it catches some errors
 72 
>
75 
> mustDie <- function(expr)
 73 
> ### ------------  was ./mode-methods.R till R ver. 1.0.x ----------------
76 
+    stopifnot(is(tryCatch(expr, error=function(e)e), "error"))
 74 
>
77 
>
75 
> ###-- Using Method Dispatch on "mode" etc :
78 
> mustDie(standardGeneric()) # 3 tests of requiring a single string
 76 
> ## Tests S3 dispatch with the class attr forced to be data.class
79 
> mustDie(standardGeneric(NULL))
 77 
> ## Not very relevant when S4 methods are around, but kept for historical interest
80 
> mustDie(standardGeneric(""))
 78 
> abc <- function(x, ...) {
81 
> mustDie(standardGeneric("notAGenericFunction"))
 79 
+     cat("abc: Before dispatching; x has class `", class(x), "':", sep="")
82 
> mustDie(standardGeneric("show"))  # a generic, but not called from its body
 80 
+     str(x)
83 
> ## End Don't show
 81 
+     UseMethod("abc", x) ## UseMethod("abc") (as in S) fails
84 
>
82 
+ }
85 
> ## method dumping ------------------------------------
 83 
>
86 
>
84 
> abc.default <- function(x, ...) sys.call()
87 
> setClass("A", representation(a="numeric"))
 85 
>
88 
[1] "A"
 86 
> "abc.(" <- function(x)
89 
> setMethod("plot", "A", function(x,y,...){ cat("A meth\n") })
 87 
+     cat("'(' method of abc:", deparse(sys.call(sys.parent())),"\n")
90 
Creating a new generic function for "plot" in ".GlobalEnv"
 88 
> abc.expression <- function(x)
91 
[1] "plot"
 89 
+     cat("'expression' method of abc:", deparse(sys.call(sys.parent())),"\n")
92 
> dumpMethod("plot","A", file="")
 90 
>
93 
setMethod("plot", "A",
 91 
> abc(1)
94 
function (x, y, ...)
92 
abc: Before dispatching; x has class `numeric': num 1
95 
{
 93 
abc.default(1)
96 
    cat("A meth\n")
 94 
> e0 <- expression((x))
97 
}
 95 
> e1 <- expression(sin(x))
98 
)
 96 
> abc(e0)
99 
> ## Not run:
97 
abc: Before dispatching; x has class `expression':  expression((x))
100 
> ##D setMethod("plot", "A",
 98 
'expression' method of abc: abc.expression(e0)
101 
> ##D function (x, y, ...)
 99 
> abc(e1)
102 
> ##D {
 100 
abc: Before dispatching; x has class `expression':  expression(sin(x))
103 
> ##D     cat("AAAAA\n")
 101 
'expression' method of abc: abc.expression(e1)
104 
> ##D }
 102 
> abc(e0[[1]])
105 
> ##D )
 103 
abc: Before dispatching; x has class `(': language, mode "(": (x)
106 
> ## End(Not run)
 104 
'(' method of abc: `abc.(`(e0[[1]])
107 
> tmp <- tempfile()
 105 
> abc(e1[[1]])
108 
> dumpMethod("plot","A", file=tmp)
 106 
abc: Before dispatching; x has class `call': language sin(x)
109 
> ## now remove, and see if we can parse the dump
 107 
abc.default(e1[[1]])
110 
> stopifnot(removeMethod("plot", "A"))
 - 
 
111 
> source(tmp)
 - 
 
112 
> stopifnot(is(getMethod("plot", "A"), "MethodDefinition"))
 - 
 
113 
>
- 
 
114 
> ## same with dumpMethods() :
 - 
 
115 
> setClass("B", contains="A")
 - 
 
116 
[1] "B"
 - 
 
117 
> setMethod("plot", "B", function(x,y,...){ cat("B ...\n") })
 - 
 
118 
[1] "plot"
 - 
 
119 
> dumpMethods("plot", file=tmp)
 - 
 
120 
> stopifnot(removeMethod("plot", "A"),
 - 
 
121 
+           removeMethod("plot", "B"))
 - 
 
122 
> source(tmp)
 - 
 
123 
> stopifnot(is(getMethod("plot", "A"), "MethodDefinition"),
 - 
 
124 
+           is(getMethod("plot", "B"), "MethodDefinition"))
 - 
 
125 
>
- 
 
126 
>
- 
 
127 
>
- 
 
128 
> cleanEx()
 - 
 
129 
> nameEx("Methods")
 - 
 
130 
> ### * Methods
 - 
 
131 
>
- 
 
132 
> flush(stderr()); flush(stdout())
 - 
 
133 
>
- 
 
134 
> ### Name: Methods
 - 
 
135 
> ### Title: General Information on Methods
 - 
 
136 
> ### Aliases: Methods
 - 
 
137 
> ### Keywords: programming classes methods
 - 
 
138 
>
- 
 
139 
> ### ** Examples
 - 
 
140 
>
- 
 
141 
>
- 
 
142 
>
- 
 
143 
> ## A class that extends a registered S3 class inherits that class' S3
 - 
 
144 
> ## methods.
 - 
 
145 
>
- 
 
146 
> setClass("myFrame", contains = "data.frame",
 - 
 
147 
+     representation(timestamps = "POSIXt"))
 - 
 
148 
[1] "myFrame"
 - 
 
149 
>
- 
 
150 
> df1 <- data.frame(x = 1:10, y = rnorm(10), z = sample(letters,10))
 - 
 
151 
>
- 
 
152 
> mydf1 <- new("myFrame", df1, timestamps = Sys.time())
 - 
 
153 
>
- 
 
154 
> ## "myFrame" objects inherit "data.frame" S3 methods; e.g., for `[`
 - 
 
155 
>
- 
 
156 
> mydf1[1:2, ] # a data frame object (with extra attributes)
 - 
 
157 
  x          y z
 - 
 
158 
1 1 -0.6264538 y
 - 
 
159 
2 2  0.1836433 f
 - 
 
160 
>
- 
 
161 
> ## a method explicitly for "myFrame" class
 - 
 
162 
>
- 
 
163 
>
- 
 
164 
> setMethod("[",
 - 
 
165 
+     signature(x = "myFrame"),
 - 
 
166 
+     function (x, i, j, ..., drop = TRUE)
- 
 
167 
+     {
 - 
 
168 
+         S3Part(x) <- callNextMethod()
 - 
 
169 
+         x@timestamps <- c(Sys.time(), as.POSIXct(x@timestamps))
 - 
 
170 
+         x
 - 
 
171 
+     }
 - 
 
172 
+ )
 - 
 
173 
[1] "["
 - 
 
174 
>
- 
 
175 
> mydf1[1:2, ]
 - 
 
176 
Object of class "myFrame"
 - 
 
177 
  x          y z
 - 
 
178 
1 1 -0.6264538 y
 - 
 
179 
2 2  0.1836433 f
 - 
 
180 
Slot "timestamps":
 - 
 
181 
[1] "2010-09-13 16:01:32 PDT" "2010-09-13 16:01:32 PDT"
 - 
 
182 
 
 - 
 
183 
>
- 
 
184 
>
- 
 
185 
> setClass("myDateTime", contains = "POSIXt")
 - 
 
186 
[1] "myDateTime"
 - 
 
187 
>
- 
 
188 
> now <- Sys.time() # class(now) is c("POSIXct", "POSIXt")
 - 
 
189 
> nowLt <- as.POSIXlt(now)# class(nowLt) is c("POSIXlt", "POSIXt")
 - 
 
190 
>
- 
 
191 
> mCt <- new("myDateTime", now)
 - 
 
192 
> mLt <- new("myDateTime", nowLt)
 - 
 
193 
>
- 
 
194 
> ## S3 methods for an S4 object will be selected using S4 inheritance
 - 
 
195 
> ## Objects mCt and mLt have different S3Class() values, but this is
 - 
 
196 
> ## not used.
 - 
 
197 
> f3 <- function(x)UseMethod("f3") # an S3 generic to illustrate inheritance
 - 
 
198 
>
- 
 
199 
> f3.POSIXct <- function(x) "The POSIXct result"
 - 
 
200 
> f3.POSIXlt <- function(x) "The POSIXlt result"
 - 
 
201 
> f3.POSIXt <- function(x) "The POSIXt result"
 - 
 
202 
>
- 
 
203 
> stopifnot(identical(f3(mCt), f3.POSIXt(mCt)))
 - 
 
204 
> stopifnot(identical(f3(mLt), f3.POSIXt(mLt)))
 - 
 
205 
>
- 
 
206 
>
- 
 
207 
>
- 
 
208 
> ## An S4 object selects S3 methods according to its S4 "inheritance"
 - 
 
209 
>
- 
 
210 
>
- 
 
211 
> setClass("classA", contains = "numeric",
 - 
 
212 
+    representation(realData = "numeric"))
 - 
 
213 
[1] "classA"
 - 
 
214 
>
- 
 
215 
> Math.classA <- function(x) {(getFunction(.Generic))(x@realData)}
 - 
 
216 
> setMethod("Math", "classA", Math.classA)
 - 
 
217 
[1] "Math"
 - 
 
218 
>
- 
 
219 
>
- 
 
220 
> x <- new("classA", log(1:10), realData = 1:10)
 - 
 
221 
>
- 
 
222 
> stopifnot(identical(abs(x), 1:10))
 - 
 
223 
>
- 
 
224 
> setClass("classB", contains = "classA")
 - 
 
225 
[1] "classB"
 - 
 
226 
>
- 
 
227 
> y <- new("classB", x)
 - 
 
228 
>
- 
 
229 
> stopifnot(identical(abs(y), 1:10)) # (version 2.9.0 or earlier fails here)
 - 
 
230 
>
- 
 
231 
> ## an S3 generic: just for demonstration purposes
 - 
 
232 
> f3 <- function(x, ...) UseMethod("f3")
 - 
 
233 
>
- 
 
234 
> f3.default <- function(x, ...) "Default f3"
 - 
 
235 
>
- 
 
236 
> ## S3 method (only) for classA
 - 
 
237 
> f3.classA <- function(x, ...) "Class classA for f3"
 - 
 
238 
>
- 
 
239 
> ## S3 and S4 method for numeric
 - 
 
240 
> f3.numeric <- function(x, ...) "Class numeric for f3"
 - 
 
241 
> setMethod("f3", "numeric", f3.numeric)
 - 
 
242 
Creating a generic function from function "f3"
 - 
 
243 
[1] "f3"
 - 
 
244 
>
- 
 
245 
> ## The S3 method for classA and the closest inherited S3 method for classB
 - 
 
246 
> ## are not found.
 - 
 
247 
>
- 
 
248 
> f3(x); f3(y) # both choose "numeric" method
 - 
 
249 
[1] "Class numeric for f3"
 - 
 
250 
[1] "Class numeric for f3"
 - 
 
251 
>
- 
 
252 
> ## to obtain the natural inheritance, set identical S3 and S4 methods
 - 
 
253 
> setMethod("f3", "classA", f3.classA)
 - 
 
254 
[1] "f3"
 - 
 
255 
>
- 
 
256 
> f3(x); f3(y) # now both choose "classA" method
 - 
 
257 
[1] "Class classA for f3"
 - 
 
258 
[1] "Class classA for f3"
 - 
 
259 
>
- 
 
260 
> ## Need to define an S3 as well as S4 method to use on an S3 object
 - 
 
261 
> ## or if called from a package without the S4 generic
 - 
 
262 
>
- 
 
263 
> MathFun <- function(x) { # a smarter "data.frame" method for Math group
 - 
 
264 
+   for (i in seq(length = ncol(x))[sapply(x, is.numeric)])
 - 
 
265 
+     x[, i] <- (getFunction(.Generic))(x[, i])
 - 
 
266 
+   x
 - 
 
267 
+ }
 - 
 
268 
> setMethod("Math", "data.frame", MathFun)
 - 
 
269 
[1] "Math"
 - 
 
270 
>
- 
 
271 
> ## S4 method works for an S4 class containing data.frame,
 - 
 
272 
> ## but not for data.frame objects (not S4 objects)
 - 
 
273 
>
- 
 
274 
> try(logIris <- log(iris)) #gets an error from the old method
 - 
 
275 
Error in Math.data.frame(structure(list(Sepal.Length = c(5.1, 4.9, 4.7,  :
- 
 
276 
  non-numeric variable in data frame: Species
 - 
 
277 
>
- 
 
278 
> ## Define an S3 method with the same computation
 - 
 
279 
>
- 
 
280 
> Math.data.frame <- MathFun
 - 
 
281 
>
- 
 
282 
> logIris <- log(iris)
 - 
 
283 
>
- 
 
284 
>
- 
 
285 
>
- 
 
286 
>
- 
 
287 
> ## Don't show:
- 
 
288 
> removeClass("classA"); removeClass("classB"); rm(x,y)
 - 
 
289 
[1] TRUE
 - 
 
290 
[1] TRUE
 - 
 
291 
> removeGeneric("f3")
 - 
 
292 
[1] TRUE
 - 
 
293 
> removeClass("myDateTime")
 - 
 
294 
[1] TRUE
 - 
 
295 
> removeMethod("Math", "data.frame"); rm(Math.data.frame, MathFun, logIris)
 - 
 
296 
[1] TRUE
 - 
 
297 
> ## End Don't show
 - 
 
298 
>
- 
 
299 
>
- 
 
300 
>
- 
 
301 
>
- 
 
302 
> cleanEx()
 - 
 
303 
> nameEx("NextMethod")
 - 
 
304 
> ### * NextMethod
 - 
 
305 
>
- 
 
306 
> flush(stderr()); flush(stdout())
 - 
 
307 
>
- 
 
308 
> ### Name: callNextMethod
 - 
 
309 
> ### Title: Call an Inherited Method
 - 
 
310 
> ### Aliases: callNextMethod
 - 
 
311 
> ### Keywords: programming classes methods
 - 
 
312 
>
- 
 
313 
> ### ** Examples
 - 
 
314 
>
- 
 
315 
>
- 
 
316 
> ## some class definitions with simple inheritance
 - 
 
317 
> setClass("B0" , representation(b0 = "numeric"))
 - 
 
318 
[1] "B0"
 - 
 
319 
>
- 
 
320 
> setClass("B1", representation(b1 = "character"), contains = "B0")
 - 
 
321 
[1] "B1"
 - 
 
322 
>
- 
 
323 
> setClass("B2", representation(b2 = "logical"), contains = "B1")
 - 
 
324 
[1] "B2"
 - 
 
325 
>
- 
 
326 
> ## and a rather silly function to illustrate callNextMethod
 - 
 
327 
>
- 
 
328 
> f <- function(x) class(x)
 - 
 
329 
>
- 
 
330 
> setMethod("f", "B0", function(x) c(x@b0^2, callNextMethod()))
 - 
 
331 
Creating a generic function from function "f"
 - 
 
332 
[1] "f"
 - 
 
333 
> setMethod("f", "B1", function(x) c(paste(x@b1,":"), callNextMethod()))
 - 
 
334 
[1] "f"
 - 
 
335 
> setMethod("f", "B2", function(x) c(x@b2, callNextMethod()))
 - 
 
336 
[1] "f"
 - 
 
337 
>
- 
 
338 
> b1 <- new("B1", b0 = 2, b1 = "Testing")
 - 
 
339 
>
- 
 
340 
> b2 <- new("B2", b2 = FALSE, b1 = "More testing", b0 = 10)
 - 
 
341 
>
- 
 
342 
> f(b2)
 - 
 
343 
[1] "FALSE"          "More testing :" "100"            "B2"
- 
 
344 
> stopifnot(identical(f(b2), c(b2@b2, paste(b2@b1,":"), b2@b0^2, "B2")))
 - 
 
345 
>
- 
 
346 
> f(b1)
 - 
 
347 
[1] "Testing :" "4"         "B1"
- 
 
348 
>
- 
 
349 
> ## a sneakier method: the *changed* x is used:
 - 
 
350 
> setMethod("f", "B2", function(x) {x@b0 <- 111; c(x@b2, callNextMethod())})
 - 
 
351 
[1] "f"
 - 
 
352 
> f(b2)
 - 
 
353 
[1] "FALSE"          "More testing :" "12321"          "B2"
- 
 
354 
> stopifnot(identical(f(b2), c(b2@b2, paste(b2@b1,":"), 111^2, "B2")))
 - 
 
355 
>
- 
 
356 
> ## Don't show:
- 
 
357 
> ## a version of the example with 1 more layer of nesting
 - 
 
358 
>
- 
 
359 
> ## next methods calling next methods, with arguments; using group generics
 - 
 
360 
> setMethod("Ops", "B2",
 - 
 
361 
+     function(e1, e2) callNextMethod())
 - 
 
362 
[1] "Ops"
 - 
 
363 
> setMethod("Ops", c("B0"),
 - 
 
364 
+     function(e1, e2) callNextMethod(e1@b0, e2))
 - 
 
365 
[1] "Ops"
 - 
 
366 
>
- 
 
367 
> b2 + 1 # 11
 - 
 
368 
[1] 11
 - 
 
369 
>
- 
 
370 
> b1 == 2 # TRUE
 - 
 
371 
[1] TRUE
 - 
 
372 
>
- 
 
373 
> removeClass("B2"); removeClass("B1"); removeClass("B0")
 - 
 
374 
[1] TRUE
 - 
 
375 
[1] TRUE
 - 
 
376 
[1] TRUE
 - 
 
377 
>
- 
 
378 
> removeGeneric("f")
 - 
 
379 
[1] TRUE
 - 
 
380 
>
- 
 
381 
> removeMethods("Ops")
 - 
 
382 
Warning in removeMethods("Ops") :
 - 
 
383 
  cannot remove methods for  "Ops" in locked environment/package "methods"
 - 
 
384 
[1] TRUE
 - 
 
385 
>
- 
 
386 
> ## tests of multiple callNextMethod
 - 
 
387 
> setClass("m1", representation(count = "numeric"), contains = "matrix",
 - 
 
388 
+          prototype = prototype(count = 0))
 - 
 
389 
[1] "m1"
 - 
 
390 
> mm1 <- new("m1", matrix(1:12, 3,4))
 - 
 
391 
> setMethod("[", "m1", function(x, i, j, ..., drop) callNextMethod())
 - 
 
392 
[1] "["
 - 
 
393 
>
- 
 
394 
> setClass("m2", representation(sum = "numeric"), contains = "m1")
 - 
 
395 
[1] "m2"
 - 
 
396 
>
- 
 
397 
> setMethod("Ops", c("m1", "m1"), function(e1, e2) {
 - 
 
398 
+     as(e1, "matrix") <- callNextMethod()
 - 
 
399 
+     e1@count <- max(e1@count, e2@count)+1
 - 
 
400 
+     e1})
 - 
 
401 
[1] "Ops"
 - 
 
402 
>
- 
 
403 
> mm2 <- new("m2", matrix(1:12, 3, 4), sum = sum(1:12))
 - 
 
404 
>
- 
 
405 
> stopifnot(identical(mm2[,2], 4:6))
 - 
 
406 
>
- 
 
407 
> setClass("m3", representation(rowtags = "character"),contains = "m2")
 - 
 
408 
[1] "m3"
 - 
 
409 
>
- 
 
410 
> setMethod("[", signature(x="m3", i = "character", j = "missing", drop = "missing"),
 - 
 
411 
+           function(x, i,j, ..., drop) {
 - 
 
412 
+               xx <- callNextMethod(x, match(i, x@rowtags),)
 - 
 
413 
+               x@.Data <- xx
 - 
 
414 
+               x@rowtags <- x@rowtags[match(i, x@rowtags)]
 - 
 
415 
+               x})
 - 
 
416 
[1] "["
 - 
 
417 
>
- 
 
418 
> tm = matrix(1:12, 4, 3)
 - 
 
419 
>
- 
 
420 
> mm3 = new("m3", tm, rowtags = letters[1:4])
 - 
 
421 
>
- 
 
422 
> mmm = mm3[c("b", "d")]
 - 
 
423 
>
- 
 
424 
> stopifnot(identical(mmm, new("m3", tm[c(2, 4),], rowtags = c("b", "d"))))
 - 
 
425 
>
- 
 
426 
> removeClass("m3")
 - 
 
427 
[1] TRUE
 - 
 
428 
> removeClass("m2")
 - 
 
429 
[1] TRUE
 - 
 
430 
> removeClass("m1")
 - 
 
431 
[1] TRUE
 - 
 
432 
>
- 
 
433 
> removeMethods("[")
 - 
 
434 
Warning in removeMethods("[") :
 - 
 
435 
  cannot remove methods for  "[" in locked environment/package "methods"
 - 
 
436 
[1] TRUE
 - 
 
437 
>
- 
 
438 
> ## End Don't show
 - 
 
439 
>
- 
 
440 
>
- 
 
441 
>
- 
 
442 
>
- 
 
443 
> cleanEx()
 - 
 
444 
> nameEx("RClassUtils")
 - 
 
445 
> ### * RClassUtils
 - 
 
446 
>
- 
 
447 
> flush(stderr()); flush(stdout())
 - 
 
448 
>
- 
 
449 
> ### Name: RClassUtils
 - 
 
450 
> ### Title: Utilities for Managing Class Definitions
 - 
 
451 
> ### Aliases: completeSubclasses newClassRepresentation
 - 
 
452 
> ###   print.classRepresentation setExtendsMetaData setSubclassMetaData
 - 
 
453 
> ###   subclassesMetaName extendsMetaName classPrototypeDef-class
 - 
 
454 
> ###   testVirtual makePrototypeFromClassDef newEmptyObject
 - 
 
455 
> ###   completeClassDefinition getAllSuperClasses superClassDepth
 - 
 
456 
> ###   isVirtualClass assignClassDef newBasic makeExtends
 - 
 
457 
> ###   reconcilePropertiesAndPrototype tryNew empty.dump showClass
 - 
 
458 
> ###   showExtends possibleExtends completeExtends classMetaName
 - 
 
459 
> ###   methodsPackageMetaName metaNameUndo requireMethods
 - 
 
460 
> ###   checkSlotAssignment defaultPrototype isClassDef validSlotNames
 - 
 
461 
> ###   getDataPart setDataPart .BasicClasses .BasicVectorClasses
 - 
 
462 
> ###   .InitBasicClasses .InitMethodsListClass .setCoerceGeneric
 - 
 
463 
> ###   conditionalExtension-class
 - 
 
464 
> ### Keywords: internal
 - 
 
465 
>
- 
 
466 
> ### ** Examples
 - 
 
467 
>
- 
 
468 
> typeof(defaultPrototype()) #-> "S4"
 - 
 
469 
[1] "S4"
 - 
 
470 
>
- 
 
471 
>
- 
 
472 
>
- 
 
473 
> cleanEx()
 - 
 
474 
> nameEx("RMethodUtils")
 - 
 
475 
> ### * RMethodUtils
 - 
 
476 
>
- 
 
477 
> flush(stderr()); flush(stdout())
 - 
 
478 
>
- 
 
479 
> ### Name: RMethodUtils
 - 
 
480 
> ### Title: Method Utilities
 - 
 
481 
> ### Aliases: asMethodDefinition standardGeneric-class
 - 
 
482 
> ###   standardGenericWithTrace-class nonstandardGeneric-class
 - 
 
483 
> ###   nonstandardGenericFunction-class
 - 
 
484 
> ###   nonstandardGroupGenericFunction-class OptionalFunction-class
 - 
 
485 
> ###   PossibleMethod-class optionalMethod-class derivedDefaultMethod-class
 - 
 
486 
> ###   substituteFunctionArgs makeGeneric makeStandardGeneric
 - 
 
487 
> ###   generic.skeleton defaultDumpName doPrimitiveMethod conformMethod
 - 
 
488 
> ###   getGeneric getGroup getGroupMembers getMethodsMetaData
 - 
 
489 
> ###   assignMethodsMetaData matchSignature findUnique MethodAddCoerce
 - 
 
490 
> ###   .saveImage cacheMetaData cacheGenericsMetaData setPrimitiveMethods
 - 
 
491 
> ###   missingArg balanceMethodsList sigToEnv rematchDefinition
 - 
 
492 
> ###   unRematchDefinition addNextMethod,MethodDefinition-method
 - 
 
493 
> ###   addNextMethod,MethodWithNext-method addNextMethod .valueClassTest
 - 
 
494 
> ###   .ShortPrimitiveSkeletons .EmptyPrimitiveSkeletons
 - 
 
495 
> ### Keywords: internal
 - 
 
496 
>
- 
 
497 
> ### ** Examples
 - 
 
498 
>
- 
 
499 
> getGroup("exp")
 - 
 
500 
[[1]]
 - 
 
501 
[1] "Math"
 - 
 
502 
 
 - 
 
503 
> getGroup("==", recursive = TRUE)
 - 
 
504 
[[1]]
 - 
 
505 
[1] "Compare"
 - 
 
506 
 
 - 
 
507 
[[2]]
 - 
 
508 
[1] "Ops"
 - 
 
509 
 
 - 
 
510 
>
- 
 
511 
> getGroupMembers("Arith")
 - 
 
512 
[1] "+"   "-"   "*"   "^"   "%%"  "%/%" "/"
- 
 
513 
> getGroupMembers("Math")
 - 
 
514 
 [1] "abs"      "sign"     "sqrt"     "ceiling"  "floor"    "trunc"
- 
 
515 
 [7] "cummax"   "cummin"   "cumprod"  "cumsum"   "exp"      "expm1"
- 
 
516 
[13] "log"      "log10"    "log2"     "log1p"    "cos"      "cosh"
- 
 
517 
[19] "sin"      "sinh"     "tan"      "tanh"     "acos"     "acosh"
- 
 
518 
[25] "asin"     "asinh"    "atan"     "atanh"    "gamma"    "lgamma"
- 
 
519 
[31] "digamma"  "trigamma"
 - 
 
520 
> getGroupMembers("Ops") # -> its sub groups
 - 
 
521 
[1] "Arith"   "Compare" "Logic"
- 
 
522 
>
- 
 
523 
>
- 
 
524 
>
- 
 
525 
> cleanEx()
 - 
 
526 
> nameEx("S3Part")
 - 
 
527 
> ### * S3Part
 - 
 
528 
>
- 
 
529 
> flush(stderr()); flush(stdout())
 - 
 
530 
>
- 
 
531 
> ### Name: S3Part
 - 
 
532 
> ### Title: S3-style Objects and S4-class Objects
 - 
 
533 
> ### Aliases: S3Part S3Part<- S3Class S3Class<- isXS3Class slotsFromS3 S4 S3
 - 
 
534 
> ###   coerce,ANY,S3-method coerce,oldClass,S3-method coerce,ANY,S4-method
 - 
 
535 
> ###   S3-class
 - 
 
536 
> ### Keywords: programming classes
 - 
 
537 
>
- 
 
538 
> ### ** Examples
 - 
 
539 
>
- 
 
540 
> ## two examples extending S3 class "lm", class "xlm"  directly and "ylm" indirectly
 - 
 
541 
> setClass("xlm", representation(eps = "numeric"), contains = "lm")
 - 
 
542 
[1] "xlm"
 - 
 
543 
> setClass("ylm", representation(header = "character"), contains = "xlm")
 - 
 
544 
[1] "ylm"
 - 
 
545 
> ## Don't show:
- 
 
546 
> ctl <- c(4.17,5.58,5.18,6.11,4.50,4.61,5.17,4.53,5.33,5.14)
 - 
 
547 
> trt <- c(4.81,4.17,4.41,3.59,5.87,3.83,6.03,4.89,4.32,4.69)
 - 
 
548 
> group <- gl(2,10,20, labels=c("Ctl","Trt"))
 - 
 
549 
> weight <- c(ctl, trt)
 - 
 
550 
> lm.D9 <- lm(weight ~ group)
 - 
 
551 
> ## End Don't show
 - 
 
552 
> ## lm.D9 is as computed in the example for stats::lm
 - 
 
553 
> y1 = new("ylm", lm.D9, header = "test", eps = .1)
 - 
 
554 
> xx = new("xlm", lm.D9, eps =.1)
 - 
 
555 
> y2 = new("ylm", xx, header = "test")
 - 
 
556 
> stopifnot(inherits(y2, "lm"))
 - 
 
557 
> stopifnot(identical(y1, y2))
 - 
 
558 
> stopifnot(identical(S3Part(y1, strict = TRUE), lm.D9))
 - 
 
559 
>
- 
 
560 
> ## note the these classes can insert an S3 subclass of "lm" as the S3 part:
 - 
 
561 
> myData <- data.frame(time = 1:10, y = (1:10)^.5)
 - 
 
562 
> myLm <- lm(cbind(y, y^3)  ~ time, myData) # S3 class: c("mlm", "lm")
 - 
 
563 
> ym1 = new("ylm", myLm, header = "Example", eps = 0.)
 - 
 
564 
>
- 
 
565 
> ##similar classes to "xlm" and "ylm", but extending S3 class c("mlm", "lm")
 - 
 
566 
> setClass("xmm", representation(eps = "numeric"), contains = "mlm")
 - 
 
567 
[1] "xmm"
 - 
 
568 
> setClass("ymm", representation(header="character"), contains = "xmm")
 - 
 
569 
[1] "ymm"
 - 
 
570 
>
- 
 
571 
> ym2 <- new("ymm", myLm, header = "Example2", eps = .001)
 - 
 
572 
>
- 
 
573 
> # but for class "ymm", an S3 part of class "lm" is an error:
 - 
 
574 
> try(new("ymm", lm.D9, header = "Example2", eps = .001))
 - 
 
575 
Error in initialize(value, ...) :
- 
 
576 
  unnamed argument must extend either the S3 class or the class of the data part; not true of class "lm"
 - 
 
577 
>
- 
 
578 
> setClass("dataFrameD", representation(date = "Date"), contains = "data.frame")
 - 
 
579 
[1] "dataFrameD"
 - 
 
580 
> myDD <- new("dataFrameD", myData, date = Sys.Date())
 - 
 
581 
>
- 
 
582 
> ## S3Part() applied to classes with a data part (.Data slot)
 - 
 
583 
>
- 
 
584 
> setClass("NumX", contains="numeric", representation(id="character"))
 - 
 
585 
[1] "NumX"
 - 
 
586 
> nn = new("NumX", 1:10, id="test")
 - 
 
587 
> stopifnot(identical(1:10, S3Part(nn, strict = TRUE)))
 - 
 
588 
>
- 
 
589 
> m1 = cbind(group, weight)
 - 
 
590 
> setClass("MatX", contains = "matrix", representation(date = "Date"))
 - 
 
591 
[1] "MatX"
 - 
 
592 
> mx1 = new("MatX", m1, date = Sys.Date())
 - 
 
593 
> stopifnot(identical(m1, S3Part(mx1, strict = TRUE)))
 - 
 
594 
>
- 
 
595 
> ## Don't show:
- 
 
596 
>
- 
 
597 
> for(cl in c("ylm", "xlm", "ymm", "xmm", "dataFrameD", "NumX", "MatX")) removeClass(cl)
 - 
 
598 
>
- 
 
599 
> ## End Don't show
 - 
 
600 
>
- 
 
601 
>
- 
 
602 
>
- 
 
603 
> cleanEx()
 - 
 
604 
> nameEx("S4groupGeneric")
 - 
 
605 
> ### * S4groupGeneric
 - 
 
606 
>
- 
 
607 
> flush(stderr()); flush(stdout())
 - 
 
608 
>
- 
 
609 
> ### Name: S4groupGeneric
 - 
 
610 
> ### Title: Group Generic Functions
 - 
 
611 
> ### Aliases: S4groupGeneric GroupGenericFunctions Math Ops Summary Arith
 - 
 
612 
> ###   Logic Compare Complex Math2
 - 
 
613 
> ### Keywords: methods
 - 
 
614 
>
- 
 
615 
> ### ** Examples
 - 
 
616 
>
- 
 
617 
> setClass("testComplex", representation(zz = "complex"))
 - 
 
618 
[1] "testComplex"
 - 
 
619 
> ## method for whole group "Complex"
 - 
 
620 
> setMethod("Complex", "testComplex",
 - 
 
621 
+           function(z) c("groupMethod", callGeneric(z@zz)))
 - 
 
622 
[1] "Complex"
 - 
 
623 
> ## exception for Arg() :
 - 
 
624 
> setMethod("Arg", "testComplex",
 - 
 
625 
+           function(z) c("ArgMethod", Arg(z@zz)))
 - 
 
626 
[1] "Arg"
 - 
 
627 
> z1 <- 1+2i
 - 
 
628 
> z2 <- new("testComplex", zz = z1)
 - 
 
629 
> stopifnot(identical(Mod(z2), c("groupMethod", Mod(z1))))
 - 
 
630 
> stopifnot(identical(Arg(z2), c("ArgMethod", Arg(z1))))
 - 
 
631 
> ## Don't show:
- 
 
632 
> removeMethods("Complex")
 - 
 
633 
Warning in removeMethods("Complex") :
 - 
 
634 
  cannot remove methods for  "Complex" in locked environment/package "methods"
 - 
 
635 
[1] TRUE
 - 
 
636 
> removeMethods("Arg")
 - 
 
637 
[1] TRUE
 - 
 
638 
> ## End Don't show
 - 
 
639 
>
- 
 
640 
>
- 
 
641 
> cleanEx()
 - 
 
642 
> nameEx("StructureClasses")
 - 
 
643 
> ### * StructureClasses
 - 
 
644 
>
- 
 
645 
> flush(stderr()); flush(stdout())
 - 
 
646 
>
- 
 
647 
> ### Name: StructureClasses
 - 
 
648 
> ### Title: Classes Corresponding to Basic Structures
 - 
 
649 
> ### Aliases: structure-class matrix-class array-class ts-class
 - 
 
650 
> ###   Math,structure-method Ops,structure,vector-method
 - 
 
651 
> ###   Ops,structure,structure-method Ops,structure,array-method
 - 
 
652 
> ###   Ops,vector,structure-method Ops,array,structure-method
 - 
 
653 
> ###   Ops,array,array-method initialize,array-method
 - 
 
654 
> ###   initialize,matrix-method initialize,ts-method initialize,mts-method
 - 
 
655 
> ###   show,ts-method
 - 
 
656 
> ### Keywords: classes
 - 
 
657 
>
- 
 
658 
> ### ** Examples
 - 
 
659 
>
- 
 
660 
> showClass("structure")
 - 
 
661 
Virtual Class "structure" [package "methods"]
 - 
 
662 
 
 - 
 
663 
No Slots, prototype of class "NULL"
 - 
 
664 
 
 - 
 
665 
Extends:
- 
 
666 
Class "vector", directly, with explicit coerce
 - 
 
667 
 
 - 
 
668 
Known Subclasses:
- 
 
669 
Class "array", directly
 - 
 
670 
Class "matrix", by class "array", distance 2
 - 
 
671 
Class "mts", by class "matrix", distance 3
 - 
 
672 
>
- 
 
673 
> ## explore a bit :
 - 
 
674 
> showClass("ts")
 - 
 
675 
Class "ts" [package "methods"]
 - 
 
676 
 
 - 
 
677 
Slots:
 - 
 
678
- 
 
679 
Name:      .Data       tsp  .S3Class
 - 
 
680 
Class:    vector   numeric character
 - 
 
681 
 
 - 
 
682 
Extends:
- 
 
683 
Class "structure", directly
 - 
 
684 
Class "oldClass", directly
 - 
 
685 
Class "vector", by class "structure", distance 2, with explicit coerce
 - 
 
686 
 
 - 
 
687 
Known Subclasses: "mts"
 - 
 
688 
> (ts0 <- new("ts"))
 - 
 
689 
Object of class "ts"
 - 
 
690 
Time Series:
 - 
 
691 
Start = 1
- 
 
692 
End = 1
- 
 
693 
Frequency = 1
- 
 
694 
[1] NA
 - 
 
695 
> str(ts0)
 - 
 
696 
Formal class 'ts' [package "methods"] with 3 slots
 - 
 
697 
  ..@ .Data   : logi NA
 - 
 
698 
  ..@ tsp     : num [1:3] 1 1 1
 - 
 
699 
  ..@ .S3Class: chr "ts"
 - 
 
700 
>
- 
 
701 
> showMethods("Ops") # six methods from these classes, but maybe many more
 - 
 
702 
Function: Ops (package base)
 - 
 
703 
e1="array", e2="array"
 - 
 
704 
e1="array", e2="structure"
 - 
 
705 
e1="m1", e2="m1"
 - 
 
706 
e1="nonStructure", e2="nonStructure"
 - 
 
707 
e1="nonStructure", e2="vector"
 - 
 
708 
e1="structure", e2="array"
 - 
 
709 
e1="structure", e2="structure"
 - 
 
710 
e1="structure", e2="vector"
 - 
 
711 
e1="vector", e2="nonStructure"
 - 
 
712 
e1="vector", e2="structure"
 - 
 
713 
 
 - 
 
714 
>
- 
 
715 
>
- 
 
716 
>
- 
 
717 
> cleanEx()
 - 
 
718 
> nameEx("as")
 - 
 
719 
> ### * as
 - 
 
720 
>
- 
 
721 
> flush(stderr()); flush(stdout())
 - 
 
722 
>
- 
 
723 
> ### Name: as
 - 
 
724 
> ### Title: Force an Object to Belong to a Class
 - 
 
725 
> ### Aliases: as as<- coerce coerce<- setAs coerce-methods
 - 
 
726 
> ###   coerce,ANY,array-method coerce,ANY,call-method
 - 
 
727 
> ###   coerce,ANY,character-method coerce,ANY,complex-method
 - 
 
728 
> ###   coerce,ANY,environment-method coerce,ANY,expression-method
 - 
 
729 
> ###   coerce,ANY,function-method coerce,ANY,integer-method
 - 
 
730 
> ###   coerce,ANY,list-method coerce,ANY,logical-method
 - 
 
731 
> ###   coerce,ANY,matrix-method coerce,ANY,name-method
 - 
 
732 
> ###   coerce,ANY,numeric-method coerce,ANY,single-method
 - 
 
733 
> ###   coerce,ANY,ts-method coerce,ANY,vector-method coerce,ANY,NULL-method
 - 
 
734 
> ### Keywords: programming classes methods
 - 
 
735 
>
- 
 
736 
> ### ** Examples
 - 
 
737 
>
- 
 
738 
> ## using the definition of class "track" from setClass
 - 
 
739 
>
- 
 
740 
> ## Don't show:
- 
 
741 
> setClass("track",
 - 
 
742 
+          representation(x="numeric", y="numeric"))
 - 
 
743 
[1] "track"
 - 
 
744 
> setClass("trackCurve",
 - 
 
745 
+          representation("track", smooth = "numeric"))
 - 
 
746 
[1] "trackCurve"
 - 
 
747 
> ## End Don't show
 - 
 
748 
>
- 
 
749 
> setAs("track", "numeric", function(from) from@y)
 - 
 
750 
>
- 
 
751 
> t1 <- new("track", x=1:20, y=(1:20)^2)
 - 
 
752 
>
- 
 
753 
> as(t1, "numeric")
 - 
 
754 
 [1]   1   4   9  16  25  36  49  64  81 100 121 144 169 196 225 256 289 324 361
 - 
 
755 
[20] 400
 - 
 
756 
>
- 
 
757 
> ## The next example shows:
 - 
 
758 
> ##  1. A virtual class to define setAs for several classes at once.
 - 
 
759 
> ##  2. as() using inherited information
 - 
 
760 
>
- 
 
761 
> setClass("ca", representation(a = "character", id = "numeric"))
 - 
 
762 
[1] "ca"
 - 
 
763 
>
- 
 
764 
> setClass("cb", representation(b = "character", id = "numeric"))
 - 
 
765 
[1] "cb"
 - 
 
766 
>
- 
 
767 
> setClass("id")
 - 
 
768 
[1] "id"
 - 
 
769 
> setIs("ca", "id")
 - 
 
770 
> setIs("cb", "id")
 - 
 
771 
>
- 
 
772 
>
- 
 
773 
> setAs("id", "numeric", function(from) from@id)
 - 
 
774 
>
- 
 
775 
> CA <- new("ca", a = "A", id = 1)
 - 
 
776 
> CB <- new("cb", b = "B", id = 2)
 - 
 
777 
>
- 
 
778 
> setAs("cb", "ca", function(from, to )new(to, a=from@b, id = from@id))
 - 
 
779 
>
- 
 
780 
> as(CB, "numeric")
 - 
 
781 
[1] 2
 - 
 
782 
>
- 
 
783 
> ## Don't show:
- 
 
784 
> ## should generate an error (should have been a function of one argument)
 - 
 
785 
> try(setAs("track", "numeric", function(x, y,z)x@y))
 - 
 
786 
Error in setAs("track", "numeric", function(x, y, z) x@y) :
- 
 
787 
  'as' method should have one argument, or match the arguments of coerce(): got  (x, y, z)
 - 
 
788 
> ## End Don't show
 - 
 
789 
>
- 
 
790 
>
- 
 
791 
>
- 
 
792 
> cleanEx()
 - 
 
793 
> nameEx("callGeneric")
 - 
 
794 
> ### * callGeneric
 - 
 
795 
>
- 
 
796 
> flush(stderr()); flush(stdout())
 - 
 
797 
>
- 
 
798 
> ### Name: callGeneric
 - 
 
799 
> ### Title: Call the Current Generic Function from a Method
 - 
 
800 
> ### Aliases: callGeneric
 - 
 
801 
> ### Keywords: programming classes methods
 - 
 
802 
>
- 
 
803 
> ### ** Examples
 - 
 
804 
>
- 
 
805 
> ## the method for group generic function Ops
 - 
 
806 
> ## for signature( e1="structure", e2="vector")
 - 
 
807 
> function (e1, e2)
 - 
 
808 
+ {
 - 
 
809 
+     value <- callGeneric(e1@.Data, e2)
 - 
 
810 
+     if (length(value) == length(e1)) {
 - 
 
811 
+         e1@.Data <- value
 - 
 
812 
+         e1
 - 
 
813 
+     }
 - 
 
814 
+     else value
 - 
 
815 
+ }
 - 
 
816 
function (e1, e2)
- 
 
817 
{
 - 
 
818 
    value <- callGeneric(e1@.Data, e2)
 - 
 
819 
    if (length(value) == length(e1)) {
 - 
 
820 
        e1@.Data <- value
 - 
 
821 
        e1
 - 
 
822 
    }
 - 
 
823 
    else value
 - 
 
824 
}
 - 
 
825 
>
- 
 
826 
> ## For more examples
 - 
 
827 
> ## Not run:
- 
 
828 
> ##D showMethods("Ops", includeDefs = TRUE)
 - 
 
829 
> ## End(Not run)
 - 
 
830 
>
- 
 
831 
>
- 
 
832 
>
- 
 
833 
>
- 
 
834 
> cleanEx()
 - 
 
835 
> nameEx("canCoerce")
 - 
 
836 
> ### * canCoerce
 - 
 
837 
>
- 
 
838 
> flush(stderr()); flush(stdout())
 - 
 
839 
>
- 
 
840 
> ### Name: canCoerce
 - 
 
841 
> ### Title: Can an Object be Coerced to a Certain S4 Class?
 - 
 
842 
> ### Aliases: canCoerce
 - 
 
843 
> ### Keywords: classes methods
 - 
 
844 
>
- 
 
845 
> ### ** Examples
 - 
 
846 
>
- 
 
847 
> m <- matrix(pi, 2,3)
 - 
 
848 
> canCoerce(m, "numeric") # TRUE
 - 
 
849 
[1] TRUE
 - 
 
850 
> canCoerce(m, "array")   # TRUE
 - 
 
851 
[1] TRUE
 - 
 
852 
>
- 
 
853 
>
- 
 
854 
>
- 
 
855 
> cleanEx()
 - 
 
856 
> nameEx("cbind2")
 - 
 
857 
> ### * cbind2
 - 
 
858 
>
- 
 
859 
> flush(stderr()); flush(stdout())
 - 
 
860 
>
- 
 
861 
> ### Name: cbind2
 - 
 
862 
> ### Title: Combine two Objects by Columns or Rows
 - 
 
863 
> ### Aliases: cbind2 rbind2 cbind2-methods cbind2,ANY,ANY-method
 - 
 
864 
> ###   cbind2,ANY,missing-method rbind2-methods rbind2,ANY,ANY-method
 - 
 
865 
> ###   rbind2,ANY,missing-method
 - 
 
866 
> ### Keywords: array manip
 - 
 
867 
>
- 
 
868 
> ### ** Examples
 - 
 
869 
>
- 
 
870 
> cbind2(1:3, 4)
 - 
 
871 
     [,1] [,2]
 - 
 
872 
[1,]    1    4
 - 
 
873 
[2,]    2    4
 - 
 
874 
[3,]    3    4
 - 
 
875 
> m <- matrix(3:8, 2,3, dimnames=list(c("a","b"), LETTERS[1:3]))
 - 
 
876 
> cbind2(1:2, m) # keeps dimnames from m
 - 
 
877 
    A B C
 - 
 
878 
a 1 3 5 7
 - 
 
879 
b 2 4 6 8
 - 
 
880 
>
- 
 
881 
> ### Note: Use the following activation if you want cbind() to work
 - 
 
882 
> ### ----  on S4 objects -- be careful otherwise!
 - 
 
883 
>
- 
 
884 
> methods:::bind_activation(on = TRUE)
 - 
 
885 
[1] FALSE
 - 
 
886 
> trace("cbind2")
 - 
 
887 
> cbind(a=1:3)# no call to cbind2()
 - 
 
888 
     a
 - 
 
889 
[1,] 1
 - 
 
890 
[2,] 2
 - 
 
891 
[3,] 3
 - 
 
892 
> cbind(a=1:3, four=4, 7:9)# calling cbind2() twice
 - 
 
893 
trace: cbind2(..1, r)
 - 
 
894 
trace: cbind2(..1, r)
 - 
 
895 
     a four
- 
 
896 
[1,] 1    4 7
 - 
 
897 
[2,] 2    4 8
 - 
 
898 
[3,] 3    4 9
 - 
 
899 
> untrace("cbind2")
 - 
 
900 
>
- 
 
901 
> ## Don't show:
- 
 
902 
> cbind(m,m+1,m+2)
 - 
 
903 
  A B C A B C A B  C
 - 
 
904 
a 3 5 7 4 6 8 5 7  9
 - 
 
905 
b 4 6 8 5 7 9 6 8 10
 - 
 
906 
> cbind(m,a=1, ch=c("D","E"))
 - 
 
907 
  A   B   C   a   ch
- 
 
908 
a "3" "5" "7" "1" "D"
 - 
 
909 
b "4" "6" "8" "1" "E"
 - 
 
910 
> cbind(1,a=1:3, m) # ok with a warning
 - 
 
911 
Warning in cbind2(..1, r) :
 - 
 
912 
  number of rows of result is not a multiple of vector length (arg 1)
 - 
 
913 
    a A B C
 - 
 
914 
a 1 1 3 5 7
 - 
 
915 
b 1 2 4 6 8
 - 
 
916 
> cbind(A=1, B=3, m, C=4)
 - 
 
917 
  A B A B C C
 - 
 
918 
a 1 3 3 5 7 4
 - 
 
919 
b 1 3 4 6 8 4
 - 
 
920 
> ## End Don't show
 - 
 
921 
>
- 
 
922 
> ## The following fails currently,
 - 
 
923 
> ## since cbind() works recursively from the tail:
 - 
 
924 
> try( cbind(m, a=1, b=3) )
 - 
 
925 
  A B C a b
 - 
 
926 
a 3 5 7 1 3
 - 
 
927 
b 4 6 8 1 3
 - 
 
928 
>
- 
 
929 
> ## turn off the `special cbind()' :
 - 
 
930 
> methods:::bind_activation(FALSE)
 - 
 
931 
[1] TRUE
 - 
 
932 
>
- 
 
933 
>
- 
 
934 
>
- 
 
935 
> cleanEx()
 - 
 
936 
> nameEx("classesToAM")
 - 
 
937 
> ### * classesToAM
 - 
 
938 
>
- 
 
939 
> flush(stderr()); flush(stdout())
 - 
 
940 
>
- 
 
941 
> ### Name: classesToAM
 - 
 
942 
> ### Title: Compute an Adjacency Matrix for Superclasses of Class
 - 
 
943 
> ###   Definitions
 - 
 
944 
> ### Aliases: classesToAM
 - 
 
945 
> ### Keywords: classes programming
 - 
 
946 
>
- 
 
947 
> ### ** Examples
 - 
 
948 
>
- 
 
949 
>
- 
 
950 
> ## the super- and subclasses of "standardGeneric" and "derivedDefaultMethod"
 - 
 
951 
> am <- classesToAM(list(class(show), class(getMethod(show))), TRUE)
 - 
 
952 
> am
 - 
 
953 
                              stnG gnrF fnct OptF PssM optM sGWT drDM MthD dDMW
 - 
 
954 
standardGeneric                  0    1    0    0    0    0    0    0    0    0
 - 
 
955 
genericFunction                  0    0    1    0    0    0    0    0    0    0
 - 
 
956 
function                         0    0    0    1    1    0    0    0    0    0
 - 
 
957 
OptionalFunction                 0    0    0    0    0    0    0    0    0    0
 - 
 
958 
PossibleMethod                   0    0    0    0    0    0    0    0    0    0
 - 
 
959 
optionalMethod                   0    0    0    0    0    0    0    0    0    0
 - 
 
960 
standardGenericWithTrace         1    0    0    0    0    0    0    0    0    0
 - 
 
961 
derivedDefaultMethod             0    0    0    0    0    0    0    0    1    0
 - 
 
962 
MethodDefinition                 0    0    1    0    1    0    0    0    0    0
 - 
 
963 
derivedDefaultMethodWithTrace    0    0    0    0    0    0    0    1    0    0
 - 
 
964 
>
- 
 
965 
> ## Not run:
- 
 
966 
> ##D ## the following function depends on the Bioconductor package Rgraphviz
 - 
 
967 
> ##D plotInheritance <- function(classes, subclasses = FALSE, ...) {
 - 
 
968 
> ##D     if(!require("Rgraphviz", quietly=TRUE))
 - 
 
969 
> ##D       stop("Only implemented if Rgraphviz is available")
 - 
 
970 
> ##D     mm <- classesToAM(classes, subclasses)
 - 
 
971 
> ##D     classes <- rownames(mm); rownames(mm) <- colnames(mm)
 - 
 
972 
> ##D     graph <-  new("graphAM", mm, "directed", ...)
 - 
 
973 
> ##D     plot(graph)
 - 
 
974 
> ##D     cat("Key:\n", paste(abbreviate(classes), " = ", classes, ", ",
 - 
 
975 
> ##D         sep = ""),  sep = "", fill = TRUE)
 - 
 
976 
> ##D     invisible(graph)
 - 
 
977 
> ##D }
 - 
 
978 
> ##D
- 
 
979 
> ##D ## The plot of the class inheritance of the package "graph"
 - 
 
980 
> ##D require(graph)
 - 
 
981 
> ##D plotInheritance(getClasses("package:graph"))
 - 
 
982 
> ##D
- 
 
983 
> ## End(Not run)
 - 
 
984 
>
- 
 
985 
>
- 
 
986 
>
- 
 
987 
> cleanEx()
 - 
 
988 
> nameEx("dotsMethods")
 - 
 
989 
> ### * dotsMethods
 - 
 
990 
>
- 
 
991 
> flush(stderr()); flush(stdout())
 - 
 
992 
>
- 
 
993 
> ### Name: dotsMethods
 - 
 
994 
> ### Title: The Use of "..." in Method Signatures
 - 
 
995 
> ### Aliases: dotsMethods
 - 
 
996 
> ### Keywords: programming classes methods
 - 
 
997 
>
- 
 
998 
> ### ** Examples
 - 
 
999 
>
- 
 
1000 
> cc <- function(...)c(...)
 - 
 
1001 
>
- 
 
1002 
> setGeneric("cc")
 - 
 
1003 
[1] "cc"
 - 
 
1004 
>
- 
 
1005 
> setMethod("cc", "character", function(...)paste(...))
 - 
 
1006 
[1] "cc"
 - 
 
1007 
>
- 
 
1008 
> setClassUnion("Number", c("numeric", "complex"))
 - 
 
1009 
[1] "Number"
 - 
 
1010 
>
- 
 
1011 
> setMethod("cc", "Number", function(...) sum(...))
 - 
 
1012 
[1] "cc"
 - 
 
1013 
>
- 
 
1014 
> setClass("cdate", contains = "character", representation(date = "Date"))
 - 
 
1015 
[1] "cdate"
 - 
 
1016 
>
- 
 
1017 
> setClass("vdate", contains = "vector", representation(date = "Date"))
 - 
 
1018 
[1] "vdate"
 - 
 
1019 
>
- 
 
1020 
> cd1 <- new("cdate", "abcdef", date = Sys.Date())
 - 
 
1021 
>
- 
 
1022 
> cd2 <- new("vdate", "abcdef", date = Sys.Date())
 - 
 
1023 
>
- 
 
1024 
> stopifnot(identical(cc(letters, character(), cd1), paste(letters, character(), cd1))) # the "character" method
 - 
 
1025 
>
- 
 
1026 
> stopifnot(identical(cc(letters, character(), cd2), c(letters, character(), cd2))) # the default, because "vdate" doesn't extend "character"
 - 
 
1027 
>
- 
 
1028 
> stopifnot(identical(cc(1:10, 1+1i), sum(1:10, 1+1i))) # the "Number" method
 - 
 
1029 
>
- 
 
1030 
> stopifnot(identical(cc(1:10, 1+1i, TRUE), c(1:10, 1+1i, TRUE))) # the default
 - 
 
1031 
>
- 
 
1032 
> stopifnot(identical(cc(), c())) # no arguments implies the default method
 - 
 
1033 
>
- 
 
1034 
> setGeneric("numMax", function(...)standardGeneric("numMax"))
 - 
 
1035 
[1] "numMax"
 - 
 
1036 
>
- 
 
1037 
> setMethod("numMax", "numeric", function(...)max(...)) # won't work for complex data
 - 
 
1038 
[1] "numMax"
 - 
 
1039 
> setMethod("numMax", "Number", function(...) paste(...)) # should not be selected w/o complex args
 - 
 
1040 
[1] "numMax"
 - 
 
1041 
>
- 
 
1042 
> stopifnot(identical(numMax(1:10, pi, 1+1i), paste(1:10, pi, 1+1i)))
 - 
 
1043 
> stopifnot(identical(numMax(1:10, pi, 1), max(1:10, pi, 1)))
 - 
 
1044 
>
- 
 
1045 
> try(numMax(1:10, pi, TRUE)) # should be an error:  no default method
 - 
 
1046 
Error in standardGeneric("numMax") :
- 
 
1047 
  No method or default matching the "..." arguments in numMax(1:10, pi, TRUE)
 - 
 
1048 
>
- 
 
1049 
> ## A generic version of paste(), dispatching on the "..." argument:
 - 
 
1050 
> setGeneric("paste", signature = "...")
 - 
 
1051 
Creating a generic for ‘paste’ in package ‘.GlobalEnv’
 - 
 
1052 
    (the supplied definition differs from and overrides the implicit generic
 - 
 
1053 
    in package ‘base’: Signatures differ:  (...), (sep, collapse))
 - 
 
1054 
[1] "paste"
 - 
 
1055 
>
- 
 
1056 
> setMethod("paste", "Number", function(..., sep, collapse) c(...))
 - 
 
1057 
[1] "paste"
 - 
 
1058 
>
- 
 
1059 
> stopifnot(identical(paste(1:10, pi, 1), c(1:10, pi, 1)))
 - 
 
1060 
>
- 
 
1061 
> ## Don't show:
- 
 
1062 
> for(gen in c("numMax", "cc", "paste")) removeGeneric(gen)
 - 
 
1063 
> for(cl in c("Number", "vdate", "cdate")) removeClass(cl)
 - 
 
1064 
> ## End Don't show
 - 
 
1065 
>
- 
 
1066 
>
- 
 
1067 
>
- 
 
1068 
> cleanEx()
 - 
 
1069 
> nameEx("evalSource")
 - 
 
1070 
> ### * evalSource
 - 
 
1071 
>
- 
 
1072 
> flush(stderr()); flush(stdout())
 - 
 
1073 
>
- 
 
1074 
> ### Name: evalSource
 - 
 
1075 
> ### Title: Use Function Definitions from a Source File without Reinstalling
 - 
 
1076 
> ###   a
 - 
 
1077 
> ### Aliases: evalSource insertSource sourceEnvironment-class
 - 
 
1078 
> ### Keywords: programming methods
 - 
 
1079 
>
- 
 
1080 
> ### ** Examples
 - 
 
1081 
>
- 
 
1082 
> ## Not run:
- 
 
1083 
> ##D ## Suppose package P0 has a source file "all.R"
 - 
 
1084 
> ##D ## First, evaluate the source, and from it
 - 
 
1085 
> ##D ## insert the revised version of methods for summary()
 - 
 
1086 
> ##D   env <- insertSource("./P0/R/all.R", package = "P0",
 - 
 
1087 
> ##D      methods = "summary")
 - 
 
1088 
> ##D ## now test one of the methods, tracing  the version from the source
 - 
 
1089 
> ##D   trace("summary", signature = "myMat", browser, edit = env)
 - 
 
1090 
> ##D ## After testing, remove the browser() call but keep the source
 - 
 
1091 
> ##D   trace("summary", signature = "myMat", edit = env)
 - 
 
1092 
> ##D ## Now insert all the (other) revised functions and methods
 - 
 
1093 
> ##D ## without re-evaluating the source file.
 - 
 
1094 
> ##D ## The package name is included in the object env.
 - 
 
1095 
> ##D   insertSource(env)
 - 
 
1096 
> ## End(Not run)
 - 
 
1097 
>
- 
 
1098 
>
- 
 
1099 
>
- 
 
1100 
> cleanEx()
 - 
 
1101 
> nameEx("findMethods")
 - 
 
1102 
> ### * findMethods
 - 
 
1103 
>
- 
 
1104 
> flush(stderr()); flush(stdout())
 - 
 
1105 
>
- 
 
1106 
> ### Name: findMethods
 - 
 
1107 
> ### Title: Description of the Methods Defined for a Generic Function
 - 
 
1108 
> ### Aliases: findMethods findMethodSignatures hasMethods getMethods
 - 
 
1109 
> ###   listOfMethods-class
 - 
 
1110 
> ### Keywords: programming classes methods
 - 
 
1111 
>
- 
 
1112 
> ### ** Examples
 - 
 
1113 
>
- 
 
1114 
> mm <-  findMethods("Ops")
 - 
 
1115 
> findMethodSignatures(methods = mm)
 - 
 
1116 
      e1             e2
- 
 
1117 
 [1,] "array"        "array"
- 
 
1118 
 [2,] "array"        "structure"
- 
 
1119 
 [3,] "m1"           "m1"
- 
 
1120 
 [4,] "nonStructure" "nonStructure"
 - 
 
1121 
 [5,] "nonStructure" "vector"
- 
 
1122 
 [6,] "structure"    "array"
- 
 
1123 
 [7,] "structure"    "structure"
- 
 
1124 
 [8,] "structure"    "vector"
- 
 
1125 
 [9,] "vector"       "nonStructure"
 - 
 
1126 
[10,] "vector"       "structure"
- 
 
1127 
>
- 
 
1128 
>
- 
 
1129 
>
- 
 
1130 
> cleanEx()
 - 
 
1131 
> nameEx("getClass")
 - 
 
1132 
> ### * getClass
 - 
 
1133 
>
- 
 
1134 
> flush(stderr()); flush(stdout())
 - 
 
1135 
>
- 
 
1136 
> ### Name: getClass
 - 
 
1137 
> ### Title: Get Class Definition
 - 
 
1138 
> ### Aliases: getClass getClassDef
 - 
 
1139 
> ### Keywords: programming classes
 - 
 
1140 
>
- 
 
1141 
> ### ** Examples
 - 
 
1142 
>
- 
 
1143 
> getClass("numeric") ## a built in class
 - 
 
1144 
Class "numeric" [package "methods"]
 - 
 
1145 
 
 - 
 
1146 
No Slots, prototype of class "numeric"
 - 
 
1147 
 
 - 
 
1148 
Extends: "vector"
 - 
 
1149 
 
 - 
 
1150 
Known Subclasses:
- 
 
1151 
Class "integer", directly
 - 
 
1152 
Class "ordered", by class "integer", distance 3
 - 
 
1153 
>
- 
 
1154 
> cld <- getClass("thisIsAnUndefinedClass", .Force = TRUE)
 - 
 
1155 
> cld ## a NULL prototype
 - 
 
1156 
Virtual Class "thisIsAnUndefinedClass" [package "base"]
 - 
 
1157 
 
 - 
 
1158 
No Slots, prototype of class "NULL"
 - 
 
1159 
> ## If you are really curious:
 - 
 
1160 
> utils::str(cld)
 - 
 
1161 
Formal class 'classRepresentation' [package "methods"] with 11 slots
 - 
 
1162 
  ..@ slots     : list()
 - 
 
1163 
  ..@ contains  : list()
 - 
 
1164 
  ..@ virtual   : logi TRUE
 - 
 
1165 
  ..@ prototype : NULL
 - 
 
1166 
  ..@ validity  : NULL
 - 
 
1167 
  ..@ access    : list()
 - 
 
1168 
  ..@ className : atomic [1:1] thisIsAnUndefinedClass
 - 
 
1169 
  .. ..- attr(*, "package")= chr "base"
 - 
 
1170 
  ..@ package   : chr "base"
 - 
 
1171 
  ..@ subclasses: list()
 - 
 
1172 
  ..@ versionKey:<externalptr>
- 
 
1173 
  ..@ sealed    : logi FALSE
 - 
 
1174 
> ## Whereas these generate errors:
 - 
 
1175 
> try(getClass("thisIsAnUndefinedClass"))
 - 
 
1176 
Error in getClass("thisIsAnUndefinedClass") :
- 
 
1177 
  "thisIsAnUndefinedClass" is not a defined class
 - 
 
1178 
> try(getClassDef("thisIsAnUndefinedClass"))
 - 
 
1179 
NULL
 - 
 
1180 
>
- 
 
1181 
>
- 
 
1182 
>
- 
 
1183 
> cleanEx()
 - 
 
1184 
> nameEx("getMethod")
 - 
 
1185 
> ### * getMethod
 - 
 
1186 
>
- 
 
1187 
> flush(stderr()); flush(stdout())
 - 
 
1188 
>
- 
 
1189 
> ### Name: getMethod
 - 
 
1190 
> ### Title: Get or Test for the Definition of a Method
 - 
 
1191 
> ### Aliases: getMethod findMethod existsMethod selectMethod hasMethod
 - 
 
1192 
> ### Keywords: programming classes methods
 - 
 
1193 
>
- 
 
1194 
> ### ** Examples
 - 
 
1195 
>
- 
 
1196 
> setGeneric("testFun", function(x)standardGeneric("testFun"))
 - 
 
1197 
[1] "testFun"
 - 
 
1198 
> setMethod("testFun", "numeric", function(x)x+1)
 - 
 
1199 
[1] "testFun"
 - 
 
1200 
> hasMethod("testFun", "numeric")
 - 
 
1201 
[1] TRUE
 - 
 
1202 
> ## Not run: [1] TRUE
 - 
 
1203 
> hasMethod("testFun", "integer") #inherited
 - 
 
1204 
[1] TRUE
 - 
 
1205 
> ## Not run: [1] TRUE
 - 
 
1206 
> existsMethod("testFun", "integer")
 - 
 
1207 
[1] FALSE
 - 
 
1208 
> ## Not run: [1] FALSE
 - 
 
1209 
> hasMethod("testFun") # default method
 - 
 
1210 
[1] FALSE
 - 
 
1211 
> ## Not run: [1] FALSE
 - 
 
1212 
> hasMethod("testFun", "ANY")
 - 
 
1213 
[1] FALSE
 - 
 
1214 
> ## Not run: [1] FALSE
 - 
 
1215 
> ## Don't show:
- 
 
1216 
> stopifnot(isGeneric("testFun"),
 - 
 
1217 
+           hasMethod("testFun", "numeric"),
 - 
 
1218 
+           hasMethod("testFun", "integer"),
 - 
 
1219 
+           !existsMethod("testFun", "integer"),
 - 
 
1220 
+           !hasMethod("testFun"),
 - 
 
1221 
+           !hasMethod("testFun", "ANY") )
 - 
 
1222 
> removeGeneric("testFun")
 - 
 
1223 
[1] TRUE
 - 
 
1224 
> ## End Don't show
 - 
 
1225 
>
- 
 
1226 
>
- 
 
1227 
>
- 
 
1228 
> cleanEx()
 - 
 
1229 
> nameEx("getPackageName")
 - 
 
1230 
> ### * getPackageName
 - 
 
1231 
>
- 
 
1232 
> flush(stderr()); flush(stdout())
 - 
 
1233 
>
- 
 
1234 
> ### Name: getPackageName
 - 
 
1235 
> ### Title: The Name associated with a Given Package
 - 
 
1236 
> ### Aliases: getPackageName setPackageName packageSlot packageSlot<-
 - 
 
1237 
> ### Keywords: programming
 - 
 
1238 
>
- 
 
1239 
> ### ** Examples
 - 
 
1240 
>
- 
 
1241 
> ## all the following usually return "base"
 - 
 
1242 
> getPackageName(length(search()))
 - 
 
1243 
[1] "base"
 - 
 
1244 
> getPackageName(baseenv())
 - 
 
1245 
[1] "base"
 - 
 
1246 
> getPackageName(asNamespace("base"))
 - 
 
1247 
[1] "base"
 - 
 
1248 
> getPackageName("package:base")
 - 
 
1249 
[1] "base"
 - 
 
1250 
>
- 
 
1251 
>
- 
 
1252 
>
- 
 
1253 
>
- 
 
1254 
> cleanEx()
 - 
 
1255 
> nameEx("hasArg")
 - 
 
1256 
> ### * hasArg
 - 
 
1257 
>
- 
 
1258 
> flush(stderr()); flush(stdout())
 - 
 
1259 
>
- 
 
1260 
> ### Name: hasArg
 - 
 
1261 
> ### Title: Look for an Argument in the Call
 - 
 
1262 
> ### Aliases: hasArg
 - 
 
1263 
> ### Keywords: programming
 - 
 
1264 
>
- 
 
1265 
> ### ** Examples
 - 
 
1266 
>
- 
 
1267 
> ftest <- function(x1, ...) c(hasArg(x1), hasArg(y2))
 - 
 
1268 
>
- 
 
1269 
> ftest(1) ## c(TRUE, FALSE)
 - 
 
1270 
[1]  TRUE FALSE
 - 
 
1271 
> ftest(1, 2)  ## c(TRUE, FALSE)
 - 
 
1272 
[1]  TRUE FALSE
 - 
 
1273 
> ftest(y2=2)   ## c(FALSE, TRUE)
 - 
 
1274 
[1] FALSE  TRUE
 - 
 
1275 
> ftest(y=2)    ## c(FALSE, FALSE) (no partial matching)
 - 
 
1276 
[1] FALSE FALSE
 - 
 
1277 
> ftest(y2 = 2, x=1)  ## c(TRUE, TRUE) partial match x1
 - 
 
1278 
[1] TRUE TRUE
 - 
 
1279 
>
- 
 
1280 
>
- 
 
1281 
>
- 
 
1282 
>
- 
 
1283 
>
- 
 
1284 
> cleanEx()
 - 
 
1285 
> nameEx("implicitGeneric")
 - 
 
1286 
> ### * implicitGeneric
 - 
 
1287 
>
- 
 
1288 
> flush(stderr()); flush(stdout())
 - 
 
1289 
>
- 
 
1290 
> ### Name: implicitGeneric
 - 
 
1291 
> ### Title: Manage Implicit Versions of Generic Functions
 - 
 
1292 
> ### Aliases: implicitGeneric setGenericImplicit prohibitGeneric
 - 
 
1293 
> ###   registerImplicitGenerics 'implicit generic'
 - 
 
1294 
> ### Keywords: programming methods
 - 
 
1295 
>
- 
 
1296 
> ### ** Examples
 - 
 
1297 
>
- 
 
1298 
>
- 
 
1299 
> ### How we would make the function with() into a generic:
 - 
 
1300 
>
- 
 
1301 
> ## Since the second argument, 'expr' is used literally, we want
 - 
 
1302 
> ## with() to only have "data" in the signature.
 - 
 
1303 
>
- 
 
1304 
> ## Note that 'methods'-internal code now has already extended  with()
 - 
 
1305 
> ## to do the equivalent of the following
 - 
 
1306 
> ## Not run:
- 
 
1307 
> ##D setGeneric("with", signature = "data")
 - 
 
1308 
> ##D ## Now we could predefine methods for "with" if we wanted to.
 - 
 
1309 
> ##D
- 
 
1310 
> ##D ## When ready, we store the generic as implicit, and restore the original
 - 
 
1311 
> ##D setGenericImplicit("with")
 - 
 
1312 
> ##D
- 
 
1313 
> ##D ## (This example would only work if we "owned" function with(),
 - 
 
1314 
> ##D ##  but it is in base.)
 - 
 
1315 
> ## End(Not run)
 - 
 
1316 
>
- 
 
1317 
> implicitGeneric("with")
 - 
 
1318 
standardGeneric for "with" defined from package "base"
 - 
 
1319 
 
 - 
 
1320 
function (data, expr, ...)
- 
 
1321 
standardGeneric("with")
 - 
 
1322 
<environment: 0x102858878>
 - 
 
1323 
Methods may be defined for arguments: data
 - 
 
1324 
Use  showMethods("with")  for currently available ones.
 - 
 
1325 
>
- 
 
1326 
>
- 
 
1327 
>
- 
 
1328 
> cleanEx()
 - 
 
1329 
> nameEx("inheritedSlotNames")
 - 
 
1330 
> ### * inheritedSlotNames
 - 
 
1331 
>
- 
 
1332 
> flush(stderr()); flush(stdout())
 - 
 
1333 
>
- 
 
1334 
> ### Name: inheritedSlotNames
 - 
 
1335 
> ### Title: Names of Slots Inherited From a Super Class
 - 
 
1336 
> ### Aliases: inheritedSlotNames
 - 
 
1337 
> ### Keywords: classes methods
 - 
 
1338 
>
- 
 
1339 
> ### ** Examples
 - 
 
1340 
>
- 
 
1341 
> .srch <- search()
 - 
 
1342 
> library(stats4)
 - 
 
1343 
> inheritedSlotNames("mle")
 - 
 
1344 
NULL
 - 
 
1345 
>
- 
 
1346 
> ## Not run:
- 
 
1347 
> ##D if(require("Matrix")) {
 - 
 
1348 
> ##D   print( inheritedSlotNames("Matrix") ) # NULL
 - 
 
1349 
> ##D   ## whereas
 - 
 
1350 
> ##D   print( inheritedSlotNames("sparseMatrix") ) # --> Dim & Dimnames
 - 
 
1351 
> ##D   ##  i.e. inherited from "Matrix" class
 - 
 
1352 
> ##D
- 
 
1353 
> ##D   print( cl <- getClass("dgCMatrix") ) # six slots, etc
 - 
 
1354 
> ##D
- 
 
1355 
> ##D   print( inheritedSlotNames(cl) ) # *all* six slots are inherited
 - 
 
1356 
> ##D }
 - 
 
1357 
> ##D
- 
 
1358 
> ##D
- 
 
1359 
> ##D ## detach package we've attached above:
 - 
 
1360 
> ##D for(n in rev(which(is.na(match(search(), .srch)))))
 - 
 
1361 
> ##D     detach(pos = n)
 - 
 
1362 
> ## End(Not run)
 - 
 
1363 
>
- 
 
1364 
>
- 
 
1365 
>
- 
 
1366 
> cleanEx()
 - 
 
1367 
 
 - 
 
1368 
detaching ‘package:stats4’
 - 
 
1369 
 
 - 
 
1370 
> nameEx("is")
 - 
 
1371 
> ### * is
 - 
 
1372 
>
- 
 
1373 
> flush(stderr()); flush(stdout())
 - 
 
1374 
>
- 
 
1375 
> ### Name: is
 - 
 
1376 
> ### Title: Is an Object from a Class?
 - 
 
1377 
> ### Aliases: is extends setIs
 - 
 
1378 
> ### Keywords: programming classes methods
 - 
 
1379 
>
- 
 
1380 
> ### ** Examples
 - 
 
1381 
>
- 
 
1382 
> ## Don't show:
- 
 
1383 
> ## A simple class with two slots
 - 
 
1384 
> setClass("track",
 - 
 
1385 
+          representation(x="numeric", y="numeric"))
 - 
 
1386 
[1] "track"
 - 
 
1387 
> ## A class extending the previous, adding one more slot
 - 
 
1388 
> ## End Don't show
 - 
 
1389 
> ## Two examples of setIs() with coerce= and replace= arguments
 - 
 
1390 
> ## The first one works fairly well, because neither class has many
 - 
 
1391 
> ## inherited methods do be disturbed by the new inheritance
 - 
 
1392 
>
- 
 
1393 
> ## The second example does NOT work well, because the new superclass,
 - 
 
1394 
> ## "factor", causes methods to be inherited that should not be.
 - 
 
1395 
>
- 
 
1396 
> ## First example:
 - 
 
1397 
> ## a class definition (see setClass for class "track")
 - 
 
1398 
> setClass("trackCurve", contains = "track",
 - 
 
1399 
+          representation( smooth = "numeric"))
 - 
 
1400 
[1] "trackCurve"
 - 
 
1401 
> ## A class similar to "trackCurve", but with different structure
 - 
 
1402 
> ## allowing matrices for the "y" and "smooth" slots
 - 
 
1403 
> setClass("trackMultiCurve",
 - 
 
1404 
+          representation(x="numeric", y="matrix", smooth="matrix"),
 - 
 
1405 
+          prototype = structure(list(), x=numeric(), y=matrix(0,0,0),
 - 
 
1406 
+
- 
 
1407 
+                                smooth= matrix(0,0,0)))
 - 
 
1408 
[1] "trackMultiCurve"
 - 
 
1409 
> ## Automatically convert an object from class "trackCurve" into
 - 
 
1410 
> ## "trackMultiCurve", by making the y, smooth slots into 1-column matrices
 - 
 
1411 
> setIs("trackCurve",
 - 
 
1412 
+       "trackMultiCurve",
 - 
 
1413 
+       coerce = function(obj) {
 - 
 
1414 
+         new("trackMultiCurve",
 - 
 
1415 
+             x = obj@x,
 - 
 
1416 
+             y = as.matrix(obj@y),
 - 
 
1417 
+             smooth = as.matrix(obj@smooth))
 - 
 
1418 
+       },
 - 
 
1419 
+       replace = function(obj, value) {
 - 
 
1420 
+         obj@y <- as.matrix(value@y)
 - 
 
1421 
+         obj@x <- value@x
 - 
 
1422 
+         obj@smooth <- as.matrix(value@smooth)
 - 
 
1423 
+         obj})
 - 
 
1424 
>
- 
 
1425 
>
- 
 
1426 
> ## Don't show:
- 
 
1427 
> removeClass("trackMultiCurve")
 - 
 
1428 
[1] TRUE
 - 
 
1429 
> removeClass("trackCurve")
 - 
 
1430 
[1] TRUE
 - 
 
1431 
> removeClass("track")
 - 
 
1432 
[1] TRUE
 - 
 
1433 
> ## End Don't show
 - 
 
1434 
>
- 
 
1435 
> ## Second Example:
 - 
 
1436 
> ## A class that adds a slot to "character"
 - 
 
1437 
> setClass("stringsDated", contains = "character", representation(stamp="POSIXt"))
 - 
 
1438 
[1] "stringsDated"
 - 
 
1439 
>
- 
 
1440 
> ## Convert automatically to a factor by explicit coerce
 - 
 
1441 
> setIs("stringsDated", "factor",
 - 
 
1442 
+       coerce = function(from) factor(from@.Data),
 - 
 
1443 
+       replace= function(from, value) {
 - 
 
1444 
+                   from@.Data <- as.character(value); from })
 - 
 
1445 
> ## Don't show:
- 
 
1446 
> set.seed(750)
 - 
 
1447 
> ## End Don't show
 - 
 
1448 
> ll <- sample(letters, 10, replace = TRUE)
 - 
 
1449 
> ld <- new("stringsDated", ll, stamp = Sys.time())
 - 
 
1450 
>
- 
 
1451 
> levels(as(ld, "factor"))
 - 
 
1452 
[1] "e" "i" "m" "n" "p" "q" "s" "y"
 - 
 
1453 
> levels(ld) # will be NULL--see comment in section on inheritance above.
 - 
 
1454 
NULL
 - 
 
1455 
>
- 
 
1456 
> ## In contrast, a class that simply extends "factor" has no such ambiguities
 - 
 
1457 
> setClass("factorDated", contains = "factor", representation(stamp="POSIXt"))
 - 
 
1458 
[1] "factorDated"
 - 
 
1459 
> fd <- new("factorDated", factor(ll), stamp = Sys.time())
 - 
 
1460 
> identical(levels(fd), levels(as(fd, "factor")))
 - 
 
1461 
[1] TRUE
 - 
 
1462 
>
- 
 
1463 
>
- 
 
1464 
>
- 
 
1465 
> cleanEx()
 - 
 
1466 
> nameEx("isSealedMethod")
 - 
 
1467 
> ### * isSealedMethod
 - 
 
1468 
>
- 
 
1469 
> flush(stderr()); flush(stdout())
 - 
 
1470 
>
- 
 
1471 
> ### Name: isSealedMethod
 - 
 
1472 
> ### Title: Check for a Sealed Method or Class
 - 
 
1473 
> ### Aliases: isSealedMethod isSealedClass
 - 
 
1474 
> ### Keywords: programming classes classes methods
 - 
 
1475 
>
- 
 
1476 
> ### ** Examples
 - 
 
1477 
>
- 
 
1478 
> ## these are both TRUE
 - 
 
1479 
> isSealedMethod("+", c("numeric", "character"))
 - 
 
1480 
[1] TRUE
 - 
 
1481 
> isSealedClass("matrix")
 - 
 
1482 
[1] TRUE
 - 
 
1483 
>
- 
 
1484 
> setClass("track",
 - 
 
1485 
+             representation(x="numeric", y="numeric"))
 - 
 
1486 
[1] "track"
 - 
 
1487 
> ## but this is FALSE
 - 
 
1488 
> isSealedClass("track")
 - 
 
1489 
[1] FALSE
 - 
 
1490 
> ## and so is this
 - 
 
1491 
> isSealedClass("A Name for an undefined Class")
 - 
 
1492 
[1] FALSE
 - 
 
1493 
> ## and so are these, because only one of the two arguments is basic
 - 
 
1494 
> isSealedMethod("+", c("track", "numeric"))
 - 
 
1495 
[1] FALSE
 - 
 
1496 
> isSealedMethod("+", c("numeric", "track"))
 - 
 
1497 
[1] FALSE
 - 
 
1498 
>
- 
 
1499 
> ## Don't show:
- 
 
1500 
> removeClass("track")
 - 
 
1501 
[1] TRUE
 - 
 
1502 
> ## End Don't show
 - 
 
1503 
>
- 
 
1504 
>
- 
 
1505 
>
- 
 
1506 
> cleanEx()
 - 
 
1507 
> nameEx("method.skeleton")
 - 
 
1508 
> ### * method.skeleton
 - 
 
1509 
>
- 
 
1510 
> flush(stderr()); flush(stdout())
 - 
 
1511 
>
- 
 
1512 
> ### Name: method.skeleton
 - 
 
1513 
> ### Title: Create a Skeleton File for a New Method
 - 
 
1514 
> ### Aliases: method.skeleton
 - 
 
1515 
> ### Keywords: programming methods
 - 
 
1516 
>
- 
 
1517 
> ### ** Examples
 - 
 
1518 
>
- 
 
1519 
> ## Don't show:
- 
 
1520 
> oWD <- setwd(tempdir())
 - 
 
1521 
> ## End Don't show
 - 
 
1522 
> setClass("track", representation(x ="numeric", y="numeric"))
 - 
 
1523 
[1] "track"
 - 
 
1524 
> method.skeleton("show", "track")            ## writes show_track.R
 - 
 
1525 
Skeleton of method written to show_track.R
 - 
 
1526 
> method.skeleton("Ops", c("track", "track")) ## writes "Ops_track_track.R"
 - 
 
1527 
Skeleton of method written to Ops_track_track.R
 - 
 
1528 
>
- 
 
1529 
> ## write multiple method skeletons to one file
 - 
 
1530 
> con <- file("./Math_track.R", "w")
 - 
 
1531 
> method.skeleton("Math", "track", con)
 - 
 
1532 
Skeleton of method written to connection
 - 
 
1533 
> method.skeleton("exp", "track", con)
 - 
 
1534 
Skeleton of method written to connection
 - 
 
1535 
> method.skeleton("log", "track", con)
 - 
 
1536 
Skeleton of method written to connection
 - 
 
1537 
> close(con)
 - 
 
1538 
> ## Don't show:
- 
 
1539 
> setwd(oWD)
 - 
 
1540 
> ## End Don't show
 - 
 
1541 
>
- 
 
1542 
>
- 
 
1543 
>
- 
 
1544 
> cleanEx()
 - 
 
1545 
> nameEx("new")
 - 
 
1546 
> ### * new
 - 
 
1547 
>
- 
 
1548 
> flush(stderr()); flush(stdout())
 - 
 
1549 
>
- 
 
1550 
> ### Name: new
 - 
 
1551 
> ### Title: Generate an Object from a Class
 - 
 
1552 
> ### Aliases: new initialize
 - 
 
1553 
> ### Keywords: programming classes
 - 
 
1554 
>
- 
 
1555 
> ### ** Examples
 - 
 
1556 
>
- 
 
1557 
> ## using the definition of class "track" from setClass
 - 
 
1558 
>
- 
 
1559 
> ## Don't show:
- 
 
1560 
> setClass("track",
 - 
 
1561 
+          representation(x="numeric", y="numeric"))
 - 
 
1562 
[1] "track"
 - 
 
1563 
> setClass("trackCurve",
 - 
 
1564 
+          representation("track", smooth = "numeric"))
 - 
 
1565 
[1] "trackCurve"
 - 
 
1566 
>
- 
 
1567 
> ydata <- stats::rnorm(10); ysmooth <- 1:10
 - 
 
1568 
> ## End Don't show
 - 
 
1569 
>
- 
 
1570 
> ## a new object with two slots specified
 - 
 
1571 
> t1 <- new("track", x = seq_along(ydata), y = ydata)
 - 
 
1572 
>
- 
 
1573 
> # a new object including an object from a superclass, plus a slot
 - 
 
1574 
> t2 <- new("trackCurve", t1, smooth = ysmooth)
 - 
 
1575 
>
- 
 
1576 
> ### define a method for initialize, to ensure that new objects have
 - 
 
1577 
> ### equal-length x and y slots.
 - 
 
1578 
>
- 
 
1579 
> setMethod("initialize",
 - 
 
1580 
+           "track",
 - 
 
1581 
+           function(.Object, x = numeric(0), y = numeric(0)) {
 - 
 
1582 
+             if(nargs() > 1) {
 - 
 
1583 
+               if(length(x) != length(y))
 - 
 
1584 
+                 stop("specified x and y of different lengths")
 - 
 
1585 
+               .Object@x <- x
 - 
 
1586 
+               .Object@y <- y
 - 
 
1587 
+             }
 - 
 
1588 
+             .Object
 - 
 
1589 
+           })
 - 
 
1590 
[1] "initialize"
 - 
 
1591 
>
- 
 
1592 
> ### the next example will cause an error (x will be numeric(0)),
 - 
 
1593 
> ### because we didn't build in defaults for x,
 - 
 
1594 
> ### although we could with a more elaborate method for initialize
 - 
 
1595 
>
- 
 
1596 
> try(new("track", y = sort(stats::rnorm(10))))
 - 
 
1597 
Error in .local(.Object, ...) : specified x and y of different lengths
 - 
 
1598 
>
- 
 
1599 
> ## a better way to implement the previous initialize method.
 - 
 
1600 
> ## Why?  By using callNextMethod to call the default initialize method
 - 
 
1601 
> ## we don't inhibit classes that extend "track" from using the general
 - 
 
1602 
> ## form of the new() function.  In the previous version, they could only
 - 
 
1603 
> ## use x and y as arguments to new, unless they wrote their own
 - 
 
1604 
> ## initialize method.
 - 
 
1605 
>
- 
 
1606 
> setMethod("initialize", "track", function(.Object, ...) {
 - 
 
1607 
+     .Object <- callNextMethod()
 - 
 
1608 
+     if(length(.Object@x) != length(.Object@y))
 - 
 
1609 
+      stop("specified x and y of different lengths")
 - 
 
1610 
+     .Object
 - 
 
1611 
+   })
 - 
 
1612 
[1] "initialize"
 - 
 
1613 
>
- 
 
1614 
>
- 
 
1615 
>
- 
 
1616 
>
- 
 
1617 
> cleanEx()
 - 
 
1618 
> nameEx("nonStructure-class")
 - 
 
1619 
> ### * nonStructure-class
 - 
 
1620 
>
- 
 
1621 
> flush(stderr()); flush(stdout())
 - 
 
1622 
>
- 
 
1623 
> ### Name: nonStructure-class
 - 
 
1624 
> ### Title: A non-structure S4 Class for basic types
 - 
 
1625 
> ### Aliases: nonStructure-class Math,nonStructure-method
 - 
 
1626 
> ###   Math2,nonStructure-method Ops,vector,nonStructure-method
 - 
 
1627 
> ###   Ops,nonStructure,vector-method Ops,nonStructure,nonStructure-method
 - 
 
1628 
> ### Keywords: classes
 - 
 
1629 
>
- 
 
1630 
> ### ** Examples
 - 
 
1631 
>
- 
 
1632 
> setClass("NumericNotStructure", contains = c("numeric","nonStructure"))
 - 
 
1633 
[1] "NumericNotStructure"
 - 
 
1634 
> xx <- new("NumericNotStructure", 1:10)
 - 
 
1635 
> xx + 1 # vector
 - 
 
1636 
 [1]  2  3  4  5  6  7  8  9 10 11
 - 
 
1637 
> log(xx) # vector
 - 
 
1638 
 [1] 0.0000000 0.6931472 1.0986123 1.3862944 1.6094379 1.7917595 1.9459101
 - 
 
1639 
 [8] 2.0794415 2.1972246 2.3025851
 - 
 
1640 
> sample(xx) # vector
 - 
 
1641 
 [1]  3  4  5  7  2  8  9  6 10  1
 - 
 
1642 
> ## Don't show:
- 
 
1643 
> removeClass("NumericNotStructure")
 - 
 
1644 
[1] TRUE
 - 
 
1645 
> ## End Don't show
 - 
 
1646 
>
- 
 
1647 
>
- 
 
1648 
>
- 
 
1649 
> cleanEx()
 - 
 
1650 
> nameEx("promptClass")
 - 
 
1651 
> ### * promptClass
 - 
 
1652 
>
- 
 
1653 
> flush(stderr()); flush(stdout())
 - 
 
1654 
>
- 
 
1655 
> ### Name: promptClass
 - 
 
1656 
> ### Title: Generate a Shell for Documentation of a Formal Class
 - 
 
1657 
> ### Aliases: promptClass
 - 
 
1658 
> ### Keywords: programming classes
 - 
 
1659 
>
- 
 
1660 
> ### ** Examples
 - 
 
1661 
>
- 
 
1662 
> ## Don't show:
- 
 
1663 
> ## from setClass
 - 
 
1664 
> ## A simple class with two slots
 - 
 
1665 
> setClass("track",
 - 
 
1666 
+          representation(x="numeric", y="numeric"))
 - 
 
1667 
[1] "track"
 - 
 
1668 
> ## A class extending the previous, adding one more slot
 - 
 
1669 
> setClass("trackCurve",
 - 
 
1670 
+          representation("track", smooth = "numeric"))
 - 
 
1671 
[1] "trackCurve"
 - 
 
1672 
> ## A class similar to "trackCurve", but with different structure
 - 
 
1673 
> ## allowing matrices for the "y" and "smooth" slots
 - 
 
1674 
> setClass("trackMultiCurve",
 - 
 
1675 
+          representation(x="numeric", y="matrix", smooth="matrix"),
 - 
 
1676 
+          prototype = list(x=numeric(), y=matrix(0,0,0), smooth= matrix(0,0,0)))
 - 
 
1677 
[1] "trackMultiCurve"
 - 
 
1678 
>
- 
 
1679 
> setIs("trackMultiCurve", "trackCurve",
 - 
 
1680 
+   test = function(obj) {ncol(slot(obj, "y")) == 1},
 - 
 
1681 
+   coerce = function(obj) { new("trackCurve", x = slot(obj, "x"),
 - 
 
1682 
+         y = as.numeric(slot(obj,"y")), smooth = as.numeric(slot(obj, "smooth")))})
 - 
 
1683 
Warning in makeExtends(class1, class2, coerce, test, replace, by, classDef1 = classDef,  :
 - 
 
1684 
  there is no automatic definition for as(object, "trackCurve") <- value when object has class "trackMultiCurve" and no 'replace' argument was supplied; replacement will be an error
 - 
 
1685 
>
- 
 
1686 
> ## from setMethod
 - 
 
1687 
> require(graphics)
 - 
 
1688 
>
- 
 
1689 
> setMethod("plot", "track",
 - 
 
1690 
+  function(x, y, ...) plot(slot(x, "y"), y,  ...)
 - 
 
1691 
+ )
 - 
 
1692 
Creating a new generic function for "plot" in ".GlobalEnv"
 - 
 
1693 
[1] "plot"
 - 
 
1694 
> setMethod("plot", c("trackCurve", "missing"),
 - 
 
1695 
+ function(x, y, ...) {
 - 
 
1696 
+   plot(as(x, "track"))
 - 
 
1697 
+   if(length(slot(x, "smooth") > 0))
 - 
 
1698 
+     lines(slot(x, "x"), slot(x, "smooth"))
 - 
 
1699 
+   }
 - 
 
1700 
+ )
 - 
 
1701 
[1] "plot"
 - 
 
1702 
>
- 
 
1703 
> promptClass("trackMultiCurve", stdout())
 - 
 
1704 
\name{trackMultiCurve-class}
 - 
 
1705 
\Rdversion{1.1}
 - 
 
1706 
\docType{class}
 - 
 
1707 
\alias{trackMultiCurve-class}
 - 
 
1708 
 
 - 
 
1709 
\title{Class "trackMultiCurve"}
 - 
 
1710 
\description{
 - 
 
1711 
%%  ~~ A concise (1-5 lines) description of what the class is. ~~
 - 
 
1712 
}
 - 
 
1713 
\section{Objects from the Class}{
 - 
 
1714 
Objects can be created by calls of the form \code{new("trackMultiCurve", ...)}.
 - 
 
1715 
%%  ~~ describe objects here ~~
- 
 
1716 
}
 - 
 
1717 
\section{Slots}{
 - 
 
1718 
  \describe{
 - 
 
1719 
    \item{\code{x}:}{Object of class \code{"numeric"} ~~ }
 - 
 
1720 
    \item{\code{y}:}{Object of class \code{"matrix"} ~~ }
 - 
 
1721 
    \item{\code{smooth}:}{Object of class \code{"matrix"} ~~ }
 - 
 
1722 
  }
 - 
 
1723 
}
 - 
 
1724 
\section{Extends}{
 - 
 
1725 
Class \code{"\linkS4class{trackCurve}"}, directly, with explicit test and coerce.
 - 
 
1726 
Class \code{"\linkS4class{track}"}, by class "trackCurve", distance 2, with explicit test and coerce.
 - 
 
1727 
}
 - 
 
1728 
\section{Methods}{
 - 
 
1729 
No methods defined with class "trackMultiCurve" in the signature.
 - 
 
1730 
}
 - 
 
1731 
\references{
 - 
 
1732 
%%  ~~put references to the literature/web site here~~
 - 
 
1733 
}
 - 
 
1734 
\author{
 - 
 
1735 
%%  ~~who you are~~
 - 
 
1736 
}
 - 
 
1737 
\note{
 - 
 
1738 
%%  ~~further notes~~
 - 
 
1739 
}
 - 
 
1740 
 
 - 
 
1741 
%% ~Make other sections like Warning with \section{Warning }{....} ~
 - 
 
1742 
 
 - 
 
1743 
\seealso{
 - 
 
1744 
%%  ~~objects to See Also as \code{\link{~~fun~~}}, ~~~
 - 
 
1745 
%%  ~~or \code{\linkS4class{CLASSNAME}} for links to other classes ~~~
 - 
 
1746 
}
 - 
 
1747 
\examples{
 - 
 
1748 
showClass("trackMultiCurve")
 - 
 
1749 
}
 - 
 
1750 
\keyword{classes}
 - 
 
1751 
A shell of class documentation has been written to the connection
 - 
 
1752 
‘stdout’.
 - 
 
1753 
>
- 
 
1754 
> promptClass("track", stdout())
 - 
 
1755 
\name{track-class}
 - 
 
1756 
\Rdversion{1.1}
 - 
 
1757 
\docType{class}
 - 
 
1758 
\alias{track-class}
 - 
 
1759 
\alias{plot,track,ANY-method}
 - 
 
1760 
 
 - 
 
1761 
\title{Class "track"}
 - 
 
1762 
\description{
 - 
 
1763 
%%  ~~ A concise (1-5 lines) description of what the class is. ~~
 - 
 
1764 
}
 - 
 
1765 
\section{Objects from the Class}{
 - 
 
1766 
Objects can be created by calls of the form \code{new("track", ...)}.
 - 
 
1767 
%%  ~~ describe objects here ~~
- 
 
1768 
}
 - 
 
1769 
\section{Slots}{
 - 
 
1770 
  \describe{
 - 
 
1771 
    \item{\code{x}:}{Object of class \code{"numeric"} ~~ }
 - 
 
1772 
    \item{\code{y}:}{Object of class \code{"numeric"} ~~ }
 - 
 
1773 
  }
 - 
 
1774 
}
 - 
 
1775 
\section{Methods}{
 - 
 
1776 
  \describe{
 - 
 
1777 
    \item{plot}{\code{signature(x = "track", y = "ANY")}: ... }
 - 
 
1778 
	 }
 - 
 
1779 
}
 - 
 
1780 
\references{
 - 
 
1781 
%%  ~~put references to the literature/web site here~~
 - 
 
1782 
}
 - 
 
1783 
\author{
 - 
 
1784 
%%  ~~who you are~~
 - 
 
1785 
}
 - 
 
1786 
\note{
 - 
 
1787 
%%  ~~further notes~~
 - 
 
1788 
}
 - 
 
1789 
 
 - 
 
1790 
%% ~Make other sections like Warning with \section{Warning }{....} ~
 - 
 
1791 
 
 - 
 
1792 
\seealso{
 - 
 
1793 
%%  ~~objects to See Also as \code{\link{~~fun~~}}, ~~~
 - 
 
1794 
%%  ~~or \code{\linkS4class{CLASSNAME}} for links to other classes ~~~
 - 
 
1795 
}
 - 
 
1796 
\examples{
 - 
 
1797 
showClass("track")
 - 
 
1798 
}
 - 
 
1799 
\keyword{classes}
 - 
 
1800 
A shell of class documentation has been written to the connection
 - 
 
1801 
‘stdout’.
 - 
 
1802 
> ## End Don't show
 - 
 
1803 
> ## Not run:
- 
 
1804 
> ##D > promptClass("track")
 - 
 
1805 
> ##D A shell of class documentation has been written to the
 - 
 
1806 
> ##D file "track-class.Rd".
 - 
 
1807 
> ## End(Not run)
 - 
 
1808 
> ## Don't show:
- 
 
1809 
> removeMethods("plot")
 - 
 
1810 
[1] TRUE
 - 
 
1811 
> ## End Don't show
 - 
 
1812 
>
- 
 
1813 
>
- 
 
1814 
> cleanEx()
 - 
 
1815 
> nameEx("refClass")
 - 
 
1816 
> ### * refClass
 - 
 
1817 
>
- 
 
1818 
> flush(stderr()); flush(stdout())
 - 
 
1819 
>
- 
 
1820 
> ### Name: ReferenceClasses
 - 
 
1821 
> ### Title: Creating Classes With Fields Treated by Reference (OOP-style)
 - 
 
1822 
> ### Aliases: ReferenceClasses setRefClass refClassFields refClassMethods
 - 
 
1823 
> ###   referenceMethods refClassRepresentation-class
 - 
 
1824 
> ###   refObjectGenerator-class refClass-class refObject-class
 - 
 
1825 
> ###   refMethodDef-class SuperClassMethod-class show,refMethodDef-method
 - 
 
1826 
> ###   show,refClassRepresentation-method
 - 
 
1827 
> ### Keywords: programming classes
 - 
 
1828 
>
- 
 
1829 
> ### ** Examples
 - 
 
1830 
>
- 
 
1831 
> ## a simple editor for matrix objects.  Method  edit() changes some
 - 
 
1832 
> ## range of values; method undo() undoes the last edit.
 - 
 
1833 
> mEditor <- setRefClass("matrixEditor",
 - 
 
1834 
+       fieldClasses = list( data = "matrix",
 - 
 
1835 
+         edits = "list"),
 - 
 
1836 
+       refMethods = list(
 - 
 
1837 
+         edit = function(i, j, value) {
 - 
 
1838 
+          "Replace the elements in rows i, columns j with value"
 - 
 
1839 
+           x <- getData()
 - 
 
1840 
+           backup <-
 - 
 
1841 
+             list(i, j, x[i,j])
 - 
 
1842 
+           setEdits(c(list(backup),
 - 
 
1843 
+             getEdits()))
 - 
 
1844 
+           x[i,j] <- value
 - 
 
1845 
+           setData(x)
 - 
 
1846 
+           invisible(value)
 - 
 
1847 
+         },
 - 
 
1848 
+         undo = function() {
 - 
 
1849 
+           "Undo the previous call to method edit()"
 - 
 
1850 
+           prev <- getEdits()
 - 
 
1851 
+           if(length(prev)) prev <- prev[[1]]
 - 
 
1852 
+           else stop("No more edits to undo")
 - 
 
1853 
+           edit(prev[[1]], prev[[2]], prev[[3]])
 - 
 
1854 
+           ## trim the edits list
 - 
 
1855 
+           setEdits(
 - 
 
1856 
+             getEdits()[-(1:2)])
 - 
 
1857 
+           invisible(prev)
 - 
 
1858 
+         },
 - 
 
1859 
+         save = function(file) {
 - 
 
1860 
+           base::save(.self, file = file)
 - 
 
1861 
+         }
 - 
 
1862 
+       )
 - 
 
1863 
+     )
 - 
 
1864 
> xMat <- matrix(1:12,4,3)
 - 
 
1865 
> xx <- mEditor$new(data = xMat)
 - 
 
1866 
> xx$edit(2, 2, 0)
 - 
 
1867 
> xx$data
 - 
 
1868 
     [,1] [,2] [,3]
 - 
 
1869 
[1,]    1    5    9
 - 
 
1870 
[2,]    2    0   10
 - 
 
1871 
[3,]    3    7   11
 - 
 
1872 
[4,]    4    8   12
 - 
 
1873 
> xx$undo()
 - 
 
1874 
> mEditor$help("undo")
 - 
 
1875 
Call: $undo()
 - 
 
1876
- 
 
1877 
Undo the previous call to method edit()
 - 
 
1878 
 
 - 
 
1879 
> stopifnot(all.equal(xx$data, xMat))
 - 
 
1880 
> ## Don't show:
- 
 
1881 
> tf <- tempfile()
 - 
 
1882 
> xx$save(tf) #$
 - 
 
1883 
> load(tf)
 - 
 
1884 
> unlink(tf)
 - 
 
1885 
> stopifnot(identical(xx$data, .self$data))
 - 
 
1886 
> ## End Don't show
 - 
 
1887 
> ## A version of the refMethods= argument above that
 - 
 
1888 
> ## is a little simpler and faster but only works with
 - 
 
1889 
> ## the implementation in R, not with interfaces:
 - 
 
1890 
> localMethods <- list(
 - 
 
1891 
+      edit = function(i, j, value) {
 - 
 
1892 
+          backup <-
 - 
 
1893 
+              list(i, j, data[i,j])
 - 
 
1894 
+          edits <<- c(list(backup),
 - 
 
1895 
+                      edits)
 - 
 
1896 
+          data[i,j] <<- value
 - 
 
1897 
+          invisible(value)
 - 
 
1898 
+      },
 - 
 
1899 
+      undo = function() {
 - 
 
1900 
+          prev <- getEdits()
 - 
 
1901 
+          if(length(prev)) prev <- prev[[1]]
 - 
 
1902 
+          else stop("No more edits to undo")
 - 
 
1903 
+          edit(prev[[1]], prev[[2]], prev[[3]])
 - 
 
1904 
+          ## trim the edits list
 - 
 
1905 
+          length(edits) <<- length(edits) - 2
 - 
 
1906 
+          invisible(prev)
 - 
 
1907 
+      },
 - 
 
1908 
+      save = function(file) {
 - 
 
1909 
+          base::save(.self, file = file)
 - 
 
1910 
+      }
 - 
 
1911 
+ )
 - 
 
1912 
> setRefClass("matrixEditor2",
 - 
 
1913 
+       fieldClasses = list( data = "matrix",
 - 
 
1914 
+         edits = "list"),
 - 
 
1915 
+       refMethods = localMethods)
 - 
 
1916 
An object of class "refObjectGenerator"
 - 
 
1917 
<environment: 0x10255cd90>
 - 
 
1918 
>
- 
 
1919 
> ## Inheriting a reference class:  a matrix viewer
 - 
 
1920 
> mv <- setRefClass("matrixViewer", contains = "matrixEditor",
 - 
 
1921 
+     refMethods = list( view = function() matplot(data),
 - 
 
1922 
+         edit = # invoke previous method, then replot
 - 
 
1923 
+           function(i, j, value) {
 - 
 
1924 
+             callSuper(i, j, value)
 - 
 
1925 
+             view()
 - 
 
1926 
+           }))
 - 
 
1927 
>
- 
 
1928 
> ## Don't show:
- 
 
1929 
> ff = new("matrixViewer", data = xMat)
 - 
 
1930 
> ff$edit(2,2,0)
 - 
 
1931 
> ff$data
 - 
 
1932 
     [,1] [,2] [,3]
 - 
 
1933 
[1,]    1    5    9
 - 
 
1934 
[2,]    2    0   10
 - 
 
1935 
[3,]    3    7   11
 - 
 
1936 
[4,]    4    8   12
 - 
 
1937 
> ff$undo()
 - 
 
1938 
> stopifnot(all.equal(ff$data, xMat))
 - 
 
1939 
> removeClass("matrixEditor")
 - 
 
1940 
[1] TRUE
 - 
 
1941 
> removeClass("matrixEditor2")
 - 
 
1942 
[1] TRUE
 - 
 
1943 
> removeClass("matrixViewer")
 - 
 
1944 
[1] TRUE
 - 
 
1945 
> ## End Don't show
 - 
 
1946 
>
- 
 
1947 
>
- 
 
1948 
>
- 
 
1949 
> cleanEx()
 - 
 
1950 
> nameEx("representation")
 - 
 
1951 
> ### * representation
 - 
 
1952 
>
- 
 
1953 
> flush(stderr()); flush(stdout())
 - 
 
1954 
>
- 
 
1955 
> ### Name: representation
 - 
 
1956 
> ### Title: Construct a Representation or a Prototype for a Class Definition
 - 
 
1957 
> ### Aliases: representation prototype
 - 
 
1958 
> ### Keywords: programming classes
 - 
 
1959 
>
- 
 
1960 
> ### ** Examples
 - 
 
1961 
>
- 
 
1962 
> ## representation for a new class with a directly define slot "smooth"
 - 
 
1963 
> ## which should be a "numeric" object, and extending class "track"
 - 
 
1964 
> representation("track", smooth ="numeric")
 - 
 
1965 
[[1]]
 - 
 
1966 
[1] "track"
 - 
 
1967 
 
 - 
 
1968 
$smooth
 - 
 
1969 
[1] "numeric"
 - 
 
1970 
 
 - 
 
1971 
> ## Don't show:
- 
 
1972 
> prev <- getClassDef("class3")
 - 
 
1973 
> setClass("class1", representation(a="numeric", b = "character"))
 - 
 
1974 
[1] "class1"
 - 
 
1975 
> setClass("class2", representation(a2 = "numeric", b = "numeric"))
 - 
 
1976 
[1] "class2"
 - 
 
1977 
> try(setClass("class3", representation("class1", "class2")))
 - 
 
1978 
Error in setIs(Class, class2, classDef = classDef, where = where) :
- 
 
1979 
  class "class3" cannot extend class "class2": slots in class "class3" must extend corresponding slots in class "class2": fails for b
 - 
 
1980 
Error in setClass("class3", representation("class1", "class2")) :
- 
 
1981 
  error in contained classes ("class2") for class "class3"; class definition removed from ".GlobalEnv"
 - 
 
1982 
> {if(is.null(prev))
 - 
 
1983 
+   stopifnot(!isClass("class3"))
 - 
 
1984 
+ else
 - 
 
1985 
+   stopifnot(identical(getClassDef("class3"), prev))}
 - 
 
1986 
> ## End Don't show
 - 
 
1987 
>
- 
 
1988 
> setClass("Character",representation("character"))
 - 
 
1989 
[1] "Character"
 - 
 
1990 
> setClass("TypedCharacter",representation("Character",type="character"),
 - 
 
1991 
+           prototype(character(0),type="plain"))
 - 
 
1992 
[1] "TypedCharacter"
 - 
 
1993 
> ttt <- new("TypedCharacter", "foo", type = "character")
 - 
 
1994 
> ## Don't show:
- 
 
1995 
> stopifnot(identical(as(ttt, "character"), "foo"))
 - 
 
1996 
> ## End Don't show
 - 
 
1997 
>
- 
 
1998 
> setClass("num1", representation(comment = "character"),
 - 
 
1999 
+          contains = "numeric",
 - 
 
2000 
+          prototype = prototype(pi, comment = "Start with pi"))
 - 
 
2001 
[1] "num1"
 - 
 
2002 
>
- 
 
2003 
> ## Don't show:
- 
 
2004 
> stopifnot(identical(new("num1"), new("num1", pi, comment = "Start with pi")))
 - 
 
2005 
> for(cl in c("num1", "TypedCharacter", "Character", "class2", "class1"))
 - 
 
2006 
+     removeClass(cl)
 - 
 
2007 
> ## End Don't show
 - 
 
2008 
>
- 
 
2009 
>
- 
 
2010 
>
- 
 
2011 
>
- 
 
2012 
> cleanEx()
 - 
 
2013 
> nameEx("selectSuperClasses")
 - 
 
2014 
> ### * selectSuperClasses
 - 
 
2015 
>
- 
 
2016 
> flush(stderr()); flush(stdout())
 - 
 
2017 
>
- 
 
2018 
> ### Name: selectSuperClasses
 - 
 
2019 
> ### Title: Super Classes (of Specific Kinds) of a Class
 - 
 
2020 
> ### Aliases: selectSuperClasses .selectSuperClasses
 - 
 
2021 
> ### Keywords: programming classes
 - 
 
2022 
>
- 
 
2023 
> ### ** Examples
 - 
 
2024 
>
- 
 
2025 
> setClass("Root")
 - 
 
2026 
[1] "Root"
 - 
 
2027 
> setClass("Base", contains = "Root", representation(length = "integer"))
 - 
 
2028 
[1] "Base"
 - 
 
2029 
> setClass("A", contains = "Base", representation(x = "numeric"))
 - 
 
2030 
[1] "A"
 - 
 
2031 
> setClass("B", contains = "Base", representation(y = "character"))
 - 
 
2032 
[1] "B"
 - 
 
2033 
> setClass("C", contains = c("A", "B"))
 - 
 
2034 
[1] "C"
 - 
 
2035 
>
- 
 
2036 
> extends("C")   #-->  "C"  "A" "B"  "Base" "Root"
 - 
 
2037 
[1] "C"    "A"    "B"    "Base" "Root"
 - 
 
2038 
> selectSuperClasses("C") # "A" "B"
 - 
 
2039 
[1] "A" "B"
 - 
 
2040 
> selectSuperClasses("C", direct=FALSE) # "A" "B"  "Base"  "Root"
 - 
 
2041 
[1] "A"    "B"    "Base" "Root"
 - 
 
2042 
> selectSuperClasses("C", dropVirt = TRUE, direct=FALSE)# ditto w/o "Root"
 - 
 
2043 
[1] "A"    "B"    "Base"
 - 
 
2044 
>
- 
 
2045 
>
- 
 
2046 
>
- 
 
2047 
> cleanEx()
 - 
 
2048 
> nameEx("setClass")
 - 
 
2049 
> ### * setClass
 - 
 
2050 
>
- 
 
2051 
> flush(stderr()); flush(stdout())
 - 
 
2052 
>
- 
 
2053 
> ### Name: setClass
 - 
 
2054 
> ### Title: Create a Class Definition
 - 
 
2055 
> ### Aliases: setClass
 - 
 
2056 
> ### Keywords: programming classes methods
 - 
 
2057 
>
- 
 
2058 
> ### ** Examples
 - 
 
2059 
>
- 
 
2060 
> ## Don't show:
- 
 
2061 
>  if(isClass("trackMultiCurve")) removeClass("trackMultiCurve")
 - 
 
2062 
Warning in removeClass("trackMultiCurve") :
 - 
 
2063 
  Class definition for "trackMultiCurve" not found  (no action taken)
 - 
 
2064 
[1] FALSE
 - 
 
2065 
>  if(isClass("trackCurve"))      removeClass("trackCurve")
 - 
 
2066 
Warning in removeClass("trackCurve") :
 - 
 
2067 
  Class definition for "trackCurve" not found  (no action taken)
 - 
 
2068 
[1] FALSE
 - 
 
2069 
>  if(isClass("track"))           removeClass("track")
 - 
 
2070 
Warning in removeClass("track") :
 - 
 
2071 
  Class definition for "track" not found  (no action taken)
 - 
 
2072 
[1] FALSE
 - 
 
2073 
> ## End Don't show
 - 
 
2074 
> ## A simple class with two slots
 - 
 
2075 
> setClass("track",
 - 
 
2076 
+          representation(x="numeric", y="numeric"))
 - 
 
2077 
[1] "track"
 - 
 
2078 
> ## A class extending the previous, adding one more slot
 - 
 
2079 
> setClass("trackCurve",
 - 
 
2080 
+     representation(smooth = "numeric"),
 - 
 
2081 
+     contains = "track")
 - 
 
2082 
[1] "trackCurve"
 - 
 
2083 
> ## A class similar to "trackCurve", but with different structure
 - 
 
2084 
> ## allowing matrices for the "y" and "smooth" slots
 - 
 
2085 
> setClass("trackMultiCurve",
 - 
 
2086 
+          representation(x="numeric", y="matrix", smooth="matrix"),
 - 
 
2087 
+          prototype = list(x=numeric(), y=matrix(0,0,0),
 - 
 
2088 
+                           smooth= matrix(0,0,0)))
 - 
 
2089 
[1] "trackMultiCurve"
 - 
 
2090 
> ##
 - 
 
2091 
> ## Suppose we want trackMultiCurve to be like trackCurve when there's
 - 
 
2092 
> ## only one column.
 - 
 
2093 
> ## First, the wrong way.
 - 
 
2094 
> try(setIs("trackMultiCurve", "trackCurve",
 - 
 
2095 
+     test = function(obj) {ncol(slot(obj, "y")) == 1}))
 - 
 
2096 
Warning in makeExtends(class1, class2, coerce, test, replace, by, classDef1 = classDef,  :
 - 
 
2097 
  there is no automatic definition for as(object, "trackCurve") <- value when object has class "trackMultiCurve" and no 'replace' argument was supplied; replacement will be an error
 - 
 
2098 
>
- 
 
2099 
> ## Why didn't that work?  You can only override the slots "x", "y",
 - 
 
2100 
> ## and "smooth" if you provide an explicit coerce function to correct
 - 
 
2101 
> ## any inconsistencies:
 - 
 
2102 
>
- 
 
2103 
> setIs("trackMultiCurve", "trackCurve",
 - 
 
2104 
+   test = function(obj) {ncol(slot(obj, "y")) == 1},
 - 
 
2105 
+   coerce = function(obj) {
 - 
 
2106 
+      new("trackCurve",
 - 
 
2107 
+          x = slot(obj, "x"),
 - 
 
2108 
+          y = as.numeric(slot(obj,"y")),
 - 
 
2109 
+          smooth = as.numeric(slot(obj, "smooth")))
 - 
 
2110 
+   })
 - 
 
2111 
Warning in makeExtends(class1, class2, coerce, test, replace, by, classDef1 = classDef,  :
 - 
 
2112 
  there is no automatic definition for as(object, "trackCurve") <- value when object has class "trackMultiCurve" and no 'replace' argument was supplied; replacement will be an error
 - 
 
2113 
>
- 
 
2114 
> ## A class that extends the built-in data type "numeric"
 - 
 
2115 
>
- 
 
2116 
> setClass("numWithId", representation(id = "character"),
 - 
 
2117 
+          contains = "numeric")
 - 
 
2118 
[1] "numWithId"
 - 
 
2119 
>
- 
 
2120 
> new("numWithId", 1:3, id = "An Example")
 - 
 
2121 
An object of class "numWithId"
 - 
 
2122 
[1] 1 2 3
 - 
 
2123 
Slot "id":
 - 
 
2124 
[1] "An Example"
 - 
 
2125 
 
 - 
 
2126 
>
- 
 
2127 
> ## inherit from reference object of type "environment"
 - 
 
2128 
> setClass("stampedEnv", contains = "environment",
 - 
 
2129 
+       representation(update = "POSIXct"))
 - 
 
2130 
[1] "stampedEnv"
 - 
 
2131 
>
- 
 
2132 
> e1 <- new("stampedEnv", new.env(), update = Sys.time())
 - 
 
2133 
>
- 
 
2134 
> setMethod("[[<-", c("stampedEnv", "character", "missing"),
 - 
 
2135 
+    function(x, i, j, ..., value) {
 - 
 
2136 
+        ev <- as(x, "environment")
 - 
 
2137 
+        ev[[i]] <- value  #update the object in the environment
 - 
 
2138 
+        x@update <- Sys.time() # and the update time
 - 
 
2139 
+        x})
 - 
 
2140 
[1] "[[<-"
 - 
 
2141 
>
- 
 
2142 
> e1[["noise"]] <- rnorm(10)
 - 
 
2143 
>
- 
 
2144 
> ## Don't show:
- 
 
2145 
> tMC <- new("trackMultiCurve")
 - 
 
2146 
> is.matrix(slot(tMC, "y"))
 - 
 
2147 
[1] TRUE
 - 
 
2148 
> is.matrix(slot(tMC, "smooth"))
 - 
 
2149 
[1] TRUE
 - 
 
2150 
> setClass("myMatrix", "matrix", prototype = matrix(0,0,0))
 - 
 
2151 
[1] "myMatrix"
 - 
 
2152 
> nrow(new("myMatrix")) # 0
 - 
 
2153 
[1] 0
 - 
 
2154 
> nrow(new("matrix")) # 1
 - 
 
2155 
[1] 0
 - 
 
2156 
> ## simple test of prototype data
 - 
 
2157 
> xxx <- stats::rnorm(3)
 - 
 
2158 
> setClass("xNum", representation(x = "numeric"), prototype = list(x = xxx))
 - 
 
2159 
[1] "xNum"
 - 
 
2160 
> stopifnot(identical(new("xNum")@x, xxx))
 - 
 
2161 
> ### tests of the C macros MAKE_CLASS and NEW
 - 
 
2162 
> ### FIXME:  there should be a separate man page for the C-level macros
 - 
 
2163 
> ### and the tests below should be there.
 - 
 
2164 
> stopifnot(identical(.Call("R_methods_test_MAKE_CLASS", "trackCurve",
 - 
 
2165 
+                           PACKAGE = "methods"),
 - 
 
2166 
+                     getClass("trackCurve")))
 - 
 
2167 
>
- 
 
2168 
> stopifnot(identical(.Call("R_methods_test_NEW", "track", PACKAGE = "methods"),
 - 
 
2169 
+                     new("track")))
 - 
 
2170 
>
- 
 
2171 
>
- 
 
2172 
> ## The following should not be needed.  But make check removes all files
 - 
 
2173 
> ## between example files, in a crude way that does not cause the class
 - 
 
2174 
> ## information to be reset.  There seems no way to detect this, so we
 - 
 
2175 
> ## have to remove classes ourselves
 - 
 
2176 
>
- 
 
2177 
> removeClass("withId")
 - 
 
2178 
Warning in removeClass("withId") :
 - 
 
2179 
  Class definition for "withId" not found  (no action taken)
 - 
 
2180 
[1] FALSE
 - 
 
2181 
> removeClass("maybeNumber")
 - 
 
2182 
Warning in removeClass("maybeNumber") :
 - 
 
2183 
  Class definition for "maybeNumber" not found  (no action taken)
 - 
 
2184 
[1] FALSE
 - 
 
2185 
> removeClass("xNum")
 - 
 
2186 
[1] TRUE
 - 
 
2187 
> removeClass("myMatrix")
 - 
 
2188 
[1] TRUE
 - 
 
2189 
> resetClass("integer")
 - 
 
2190 
Warning in resetClass("integer") :
 - 
 
2191 
  class "integer" is sealed; 'resetClass' will have no effect
 - 
 
2192 
Class "integer" [package "methods"]
 - 
 
2193 
 
 - 
 
2194 
No Slots, prototype of class "integer"
 - 
 
2195 
 
 - 
 
2196 
Extends: "numeric", "vector", "data.frameRowLabels"
 - 
 
2197 
 
 - 
 
2198 
Known Subclasses:
- 
 
2199 
Class "ordered", by class "factor", distance 2
 - 
 
2200 
Class "stringsDated", by class "factor", distance 2, with explicit coerce
 - 
 
2201 
Class "factorDated", by class "factor", distance 2
 - 
 
2202 
> resetClass("numeric")
 - 
 
2203 
Warning in resetClass("numeric") :
 - 
 
2204 
  class "numeric" is sealed; 'resetClass' will have no effect
 - 
 
2205 
Class "numeric" [package "methods"]
 - 
 
2206 
 
 - 
 
2207 
No Slots, prototype of class "numeric"
 - 
 
2208 
 
 - 
 
2209 
Extends: "vector"
 - 
 
2210 
 
 - 
 
2211 
Known Subclasses:
- 
 
2212 
Class "integer", directly
 - 
 
2213 
Class "numWithId", from data part
 - 
 
2214 
Class "ordered", by class "integer", distance 3
 - 
 
2215 
Class "stringsDated", by class "integer", distance 3, with explicit coerce
 - 
 
2216 
Class "factorDated", by class "integer", distance 3
 - 
 
2217 
> resetClass("logical")
 - 
 
2218 
Warning in resetClass("logical") :
 - 
 
2219 
  class "logical" is sealed; 'resetClass' will have no effect
 - 
 
2220 
Class "logical" [package "methods"]
 - 
 
2221 
 
 - 
 
2222 
No Slots, prototype of class "logical"
 - 
 
2223 
 
 - 
 
2224 
Extends: "vector"
 - 
 
2225 
> removeClass("trackMultiCurve")
 - 
 
2226 
[1] TRUE
 - 
 
2227 
> removeClass("trackCurve")
 - 
 
2228 
[1] TRUE
 - 
 
2229 
> removeClass("track")
 - 
 
2230 
[1] TRUE
 - 
 
2231 
> ## End Don't show
 - 
 
2232 
>
- 
 
2233 
>
- 
 
2234 
>
- 
 
2235 
> cleanEx()
 - 
 
2236 
> nameEx("setClassUnion")
 - 
 
2237 
> ### * setClassUnion
 - 
 
2238 
>
- 
 
2239 
> flush(stderr()); flush(stdout())
 - 
 
2240 
>
- 
 
2241 
> ### Name: setClassUnion
 - 
 
2242 
> ### Title: Classes Defined as the Union of Other Classes
 - 
 
2243 
> ### Aliases: setClassUnion isClassUnion ClassUnionRepresentation-class
 - 
 
2244 
> ### Keywords: programming classes
 - 
 
2245 
>
- 
 
2246 
> ### ** Examples
 - 
 
2247 
>
- 
 
2248 
> ## a class for either numeric or logical data
 - 
 
2249 
> setClassUnion("maybeNumber", c("numeric", "logical"))
 - 
 
2250 
Warning: subclass "numWithId" of class "numeric" is not local and cannot be updated for new inheritance information; consider setClassUnion()
 - 
 
2251 
Warning: subclass "stringsDated" of class "numeric" is not local and cannot be updated for new inheritance information; consider setClassUnion()
 - 
 
2252 
Warning: subclass "factorDated" of class "numeric" is not local and cannot be updated for new inheritance information; consider setClassUnion()
 - 
 
2253 
[1] "maybeNumber"
 - 
 
2254 
>
- 
 
2255 
> ## use the union as the data part of another class
 - 
 
2256 
> setClass("withId", representation("maybeNumber", id = "character"))
 - 
 
2257 
[1] "withId"
 - 
 
2258 
>
- 
 
2259 
> w1 <- new("withId", 1:10, id = "test 1")
 - 
 
2260 
> w2 <- new("withId", sqrt(w1)%%1 < .01, id = "Perfect squares")
 - 
 
2261 
>
- 
 
2262 
> ## add class "complex" to the union "maybeNumber"
 - 
 
2263 
> setIs("complex", "maybeNumber")
 - 
 
2264 
>
- 
 
2265 
> w3 <- new("withId", complex(real = 1:10, imaginary = sqrt(1:10)))
 - 
 
2266 
>
- 
 
2267 
> ## a class union containing the existing class  union "OptionalFunction"
 - 
 
2268 
> setClassUnion("maybeCode",
 - 
 
2269 
+     c("expression", "language", "OptionalFunction"))
 - 
 
2270 
[1] "maybeCode"
 - 
 
2271 
>
- 
 
2272 
> is(quote(sqrt(1:10)), "maybeCode")  ## TRUE
 - 
 
2273 
[1] TRUE
 - 
 
2274 
> ## Don't show:
- 
 
2275 
> ## The following test is less trivial than it looks.
 - 
 
2276 
> ## It depends on the assignment of the data part NOT performing a
 - 
 
2277 
> ## strict coerce to "numeric" on the way to satisfying
 - 
 
2278 
> ## is(ttt, "maybeNumber").
 - 
 
2279 
> stopifnot(identical(w1@.Data, 1:10))
 - 
 
2280 
> ## End Don't show
 - 
 
2281 
>
- 
 
2282 
>
- 
 
2283 
>
- 
 
2284 
>
- 
 
2285 
> cleanEx()
 - 
 
2286 
> nameEx("setGeneric")
 - 
 
2287 
> ### * setGeneric
 - 
 
2288 
>
- 
 
2289 
> flush(stderr()); flush(stdout())
 - 
 
2290 
>
- 
 
2291 
> ### Name: setGeneric
 - 
 
2292 
> ### Title: Define a New Generic Function
 - 
 
2293 
> ### Aliases: setGeneric setGroupGeneric
 - 
 
2294 
> ### Keywords: programming methods
 - 
 
2295 
>
- 
 
2296 
> ### ** Examples
 - 
 
2297 
>
- 
 
2298 
> ## Don't show:
- 
 
2299 
> setClass("track", representation(x="numeric", y="numeric"))
 - 
 
2300 
[1] "track"
 - 
 
2301 
> ## End Don't show
 - 
 
2302 
>
- 
 
2303 
> ## create a new generic function, with a default method
 - 
 
2304 
> props <- function(object) attributes(object)
 - 
 
2305 
> setGeneric("props")
 - 
 
2306 
[1] "props"
 - 
 
2307 
>
- 
 
2308 
> ## A new generic function with no default method
 - 
 
2309 
> setGeneric("increment",
 - 
 
2310 
+   function(object, step, ...)
 - 
 
2311 
+     standardGeneric("increment")
 - 
 
2312 
+ )
 - 
 
2313 
[1] "increment"
 - 
 
2314 
>
- 
 
2315 
>
- 
 
2316 
> ###   A non-standard generic function.  It insists that the methods
 - 
 
2317 
> ###   return a non-empty character vector (a stronger requirement than
 - 
 
2318 
> ###    valueClass = "character" in the call to setGeneric)
 - 
 
2319 
>
- 
 
2320 
> setGeneric("authorNames",
 - 
 
2321 
+     function(text) {
 - 
 
2322 
+       value <- standardGeneric("authorNames")
 - 
 
2323 
+       if(!(is(value, "character") && any(nchar(value)>0)))
 - 
 
2324 
+         stop("authorNames methods must return non-empty strings")
 - 
 
2325 
+       value
 - 
 
2326 
+       })
 - 
 
2327 
[1] "authorNames"
 - 
 
2328 
>
- 
 
2329 
> ## Don't show:
- 
 
2330 
> setMethod("authorNames", "character", function(text)text)
 - 
 
2331 
[1] "authorNames"
 - 
 
2332 
>
- 
 
2333 
> tryIt <- function(expr) tryCatch(expr, error = function(e) e)
 - 
 
2334 
> stopifnot(identical(authorNames(c("me", "you")), c("me", "you")),
 - 
 
2335 
+           is(tryIt(authorNames(character())), "error"), # empty value
 - 
 
2336 
+           is(tryIt(authorNames(NULL)), "error"))        # no default method
 - 
 
2337 
> ## End Don't show
 - 
 
2338 
>
- 
 
2339 
> ## An example of group generic methods, using the class
 - 
 
2340 
> ## "track"; see the documentation of setClass for its definition
 - 
 
2341 
>
- 
 
2342 
> ## define a method for the Arith group
 - 
 
2343 
>
- 
 
2344 
> setMethod("Arith", c("track", "numeric"),
 - 
 
2345 
+  function(e1, e2) {
 - 
 
2346 
+   e1@y <- callGeneric(e1@y , e2)
 - 
 
2347 
+   e1
 - 
 
2348 
+ })
 - 
 
2349 
[1] "Arith"
 - 
 
2350 
>
- 
 
2351 
> setMethod("Arith", c("numeric", "track"),
 - 
 
2352 
+  function(e1, e2) {
 - 
 
2353 
+   e2@y <- callGeneric(e1, e2@y)
 - 
 
2354 
+   e2
 - 
 
2355 
+ })
 - 
 
2356 
[1] "Arith"
 - 
 
2357 
>
- 
 
2358 
> ## now arithmetic operators  will dispatch methods:
 - 
 
2359 
>
- 
 
2360 
> t1 <- new("track", x=1:10, y=sort(stats::rnorm(10)))
 - 
 
2361 
>
- 
 
2362 
> t1 - 100
 - 
 
2363 
An object of class "track"
 - 
 
2364 
Slot "x":
 - 
 
2365 
 [1]  1  2  3  4  5  6  7  8  9 10
 - 
 
2366 
 
 - 
 
2367 
Slot "y":
 - 
 
2368 
 [1] -100.83563 -100.82047 -100.62645 -100.30539  -99.81636  -99.67049
 - 
 
2369 
 [7]  -99.51257  -99.42422  -99.26168  -98.40472
 - 
 
2370 
 
 - 
 
2371 
> 1/t1
 - 
 
2372 
An object of class "track"
 - 
 
2373 
Slot "x":
 - 
 
2374 
 [1]  1  2  3  4  5  6  7  8  9 10
 - 
 
2375 
 
 - 
 
2376 
Slot "y":
 - 
 
2377 
 [1] -1.1967039 -1.2188160 -1.5962869 -3.2745188  5.4453382  3.0348298
 - 
 
2378 
 [7]  2.0515806  1.7367704  1.3544176  0.6268489
 - 
 
2379 
 
 - 
 
2380 
>
- 
 
2381 
> ## Don't show:
- 
 
2382 
> removeGeneric("authorNames")
 - 
 
2383 
[1] TRUE
 - 
 
2384 
> removeClass("track")
 - 
 
2385 
[1] TRUE
 - 
 
2386 
> removeMethods("Arith")
 - 
 
2387 
Warning in removeMethods("Arith") :
 - 
 
2388 
  cannot remove methods for  "Arith" in locked environment/package "methods"
 - 
 
2389 
[1] TRUE
 - 
 
2390 
> removeGeneric("props")
 - 
 
2391 
[1] TRUE
 - 
 
2392 
> removeGeneric("increment")
 - 
 
2393 
[1] TRUE
 - 
 
2394 
> ## End Don't show
 - 
 
2395 
>
- 
 
2396 
>
- 
 
2397 
>
- 
 
2398 
> cleanEx()
 - 
 
2399 
> nameEx("setMethod")
 - 
 
2400 
> ### * setMethod
 - 
 
2401 
>
- 
 
2402 
> flush(stderr()); flush(stdout())
 - 
 
2403 
>
- 
 
2404 
> ### Name: setMethod
 - 
 
2405 
> ### Title: Create and Save a Method
 - 
 
2406 
> ### Aliases: setMethod removeMethod
 - 
 
2407 
> ### Keywords: programming classes methods
 - 
 
2408 
>
- 
 
2409 
> ### ** Examples
 - 
 
2410 
>
- 
 
2411 
> ## Don't show:
- 
 
2412 
>   require(stats)
 - 
 
2413 
>   setClass("track",
 - 
 
2414 
+     representation(x="numeric", y = "numeric"))
 - 
 
2415 
[1] "track"
 - 
 
2416 
>   setClass("trackCurve", representation("track",
 - 
 
2417 
+     smooth = "numeric"))
 - 
 
2418 
[1] "trackCurve"
 - 
 
2419 
>   setClass("trackMultiCurve", representation(x="numeric", y="matrix", smooth="matrix"),
 - 
 
2420 
+           prototype = list(x=numeric(), y=matrix(0,0,0), smooth=
 - 
 
2421 
+   matrix(0,0,0)))
 - 
 
2422 
[1] "trackMultiCurve"
 - 
 
2423 
> ## End Don't show
 - 
 
2424 
>
- 
 
2425 
> require(graphics)
 - 
 
2426 
> ## methods for plotting track objects (see the example for setClass)
 - 
 
2427 
> ##
 - 
 
2428 
> ## First, with only one object as argument:
 - 
 
2429 
> setMethod("plot", signature(x="track", y="missing"),
 - 
 
2430 
+   function(x,  y, ...) plot(slot(x, "x"), slot(x, "y"), ...)
 - 
 
2431 
+ )
 - 
 
2432 
Creating a new generic function for "plot" in ".GlobalEnv"
 - 
 
2433 
[1] "plot"
 - 
 
2434 
> ## Second, plot the data from the track on the y-axis against anything
 - 
 
2435 
> ## as the x data.
 - 
 
2436 
> setMethod("plot", signature(y = "track"),
 - 
 
2437 
+  function(x, y, ...) plot(x, slot(y, "y"), ...)
 - 
 
2438 
+ )
 - 
 
2439 
[1] "plot"
 - 
 
2440 
> ## and similarly with the track on the x-axis (using the short form of
 - 
 
2441 
> ## specification for signatures)
 - 
 
2442 
> setMethod("plot", "track",
 - 
 
2443 
+  function(x, y, ...) plot(slot(x, "y"), y,  ...)
 - 
 
2444 
+ )
 - 
 
2445 
[1] "plot"
 - 
 
2446 
> t1 <- new("track", x=1:20, y=(1:20)^2)
 - 
 
2447 
> tc1 <- new("trackCurve", t1)
 - 
 
2448 
> slot(tc1, "smooth") <- smooth.spline(slot(tc1, "x"), slot(tc1, "y"))$y #$
 - 
 
2449 
> plot(t1)
 - 
 
2450 
> plot(qnorm(ppoints(20)), t1)
 - 
 
2451 
> ## An example of inherited methods, and of conforming method arguments
 - 
 
2452 
> ## (note the dotCurve argument in the method, which will be pulled out
 - 
 
2453 
> ## of ... in the generic.
 - 
 
2454 
> setMethod("plot", c("trackCurve", "missing"),
 - 
 
2455 
+ function(x, y, dotCurve = FALSE, ...) {
 - 
 
2456 
+   plot(as(x, "track"))
 - 
 
2457 
+   if(length(slot(x, "smooth") > 0))
 - 
 
2458 
+     lines(slot(x, "x"), slot(x, "smooth"),
 - 
 
2459 
+          lty = if(dotCurve) 2 else 1)
 - 
 
2460 
+   }
 - 
 
2461 
+ )
 - 
 
2462 
[1] "plot"
 - 
 
2463 
> ## the plot of tc1 alone has an added curve; other uses of tc1
 - 
 
2464 
> ## are treated as if it were a "track" object.
 - 
 
2465 
> plot(tc1, dotCurve = TRUE)
 - 
 
2466 
> plot(qnorm(ppoints(20)), tc1)
 - 
 
2467 
>
- 
 
2468 
> ## defining methods for a special function.
 - 
 
2469 
> ## Although "[" and "length" are not ordinary functions
 - 
 
2470 
> ## methods can be defined for them.
 - 
 
2471 
> setMethod("[", "track",
 - 
 
2472 
+   function(x, i, j, ..., drop) {
 - 
 
2473 
+     x@x <- x@x[i]; x@y <- x@y[i]
 - 
 
2474 
+     x
 - 
 
2475 
+   })
 - 
 
2476 
[1] "["
 - 
 
2477 
> plot(t1[1:15])
 - 
 
2478 
>
- 
 
2479 
> setMethod("length", "track", function(x)length(x@y))
 - 
 
2480 
[1] "length"
 - 
 
2481 
> length(t1)
 - 
 
2482 
[1] 20
 - 
 
2483 
>
- 
 
2484 
> ## methods can be defined for missing arguments as well
 - 
 
2485 
> setGeneric("summary") ## make the function into a generic
 - 
 
2486 
[1] "summary"
 - 
 
2487 
>
- 
 
2488 
> ## A method for summary()
 - 
 
2489 
> ## The method definition can include the arguments, but
 - 
 
2490 
> ## if they're omitted, class "missing" is assumed.
 - 
 
2491 
>
- 
 
2492 
> setMethod("summary", "missing", function() "<No Object>")
 - 
 
2493 
[1] "summary"
 - 
 
2494 
>
- 
 
2495 
> ## Don't show:
- 
 
2496 
>
- 
 
2497 
> stopifnot(identical(summary(), "<No Object>"))
 - 
 
2498 
>
- 
 
2499 
> removeMethods("summary")
 - 
 
2500 
[1] TRUE
 - 
 
2501 
>
- 
 
2502 
> ## for the primitives
 - 
 
2503 
> ## inherited methods
 - 
 
2504 
>
- 
 
2505 
> length(tc1)
 - 
 
2506 
[1] 20
 - 
 
2507 
> tc1[-1]
 - 
 
2508 
An object of class "trackCurve"
 - 
 
2509 
Slot "smooth":
 - 
 
2510 
 [1]   1   4   9  16  25  36  49  64  81 100 121 144 169 196 225 256 289 324 361
 - 
 
2511 
[20] 400
 - 
 
2512 
 
 - 
 
2513 
Slot "x":
 - 
 
2514 
 [1]  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19 20
 - 
 
2515 
 
 - 
 
2516 
Slot "y":
 - 
 
2517 
 [1]   4   9  16  25  36  49  64  81 100 121 144 169 196 225 256 289 324 361 400
 - 
 
2518 
 
 - 
 
2519 
>
- 
 
2520 
> ## make sure old-style methods still work.
 - 
 
2521 
> t11 <- t1[1:15]
 - 
 
2522 
> identical(t1@y[1:15], t11@y)
 - 
 
2523 
[1] TRUE
 - 
 
2524 
>
- 
 
2525 
> ## S3 methods, with nextMethod
 - 
 
2526 
> form <- y ~ x
 - 
 
2527 
> form[1]
 - 
 
2528 
`~`()
 - 
 
2529 
>
- 
 
2530 
> ## S3 arithmetic methods
 - 
 
2531 
> ISOdate(1990, 12, 1)- ISOdate(1980, 12, 1)
 - 
 
2532 
Time difference of 3652 days
 - 
 
2533 
>
- 
 
2534 
> ## group methods
 - 
 
2535 
>
- 
 
2536 
> setMethod("Arith", c("track", "numeric"), function(e1, e2){e1@y <-
 - 
 
2537 
+   callGeneric(e1@y , e2); e1})
 - 
 
2538 
[1] "Arith"
 - 
 
2539 
>
- 
 
2540 
>
- 
 
2541 
> t1  - 100.
 - 
 
2542 
An object of class "track"
 - 
 
2543 
Slot "x":
 - 
 
2544 
 [1]  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19 20
 - 
 
2545 
 
 - 
 
2546 
Slot "y":
 - 
 
2547 
 [1] -99 -96 -91 -84 -75 -64 -51 -36 -19   0  21  44  69  96 125 156 189 224 261
 - 
 
2548 
[20] 300
 - 
 
2549 
 
 - 
 
2550 
>
- 
 
2551 
> t1/2
 - 
 
2552 
An object of class "track"
 - 
 
2553 
Slot "x":
 - 
 
2554 
 [1]  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19 20
 - 
 
2555 
 
 - 
 
2556 
Slot "y":
 - 
 
2557 
 [1]   0.5   2.0   4.5   8.0  12.5  18.0  24.5  32.0  40.5  50.0  60.5  72.0
 - 
 
2558 
[13]  84.5  98.0 112.5 128.0 144.5 162.0 180.5 200.0
 - 
 
2559 
 
 - 
 
2560 
>
- 
 
2561 
>
- 
 
2562 
> ## check it hasn't screwed up S3 methods
 - 
 
2563 
> ISOdate(1990, 12, 1)- ISOdate(1980, 12, 1)
 - 
 
2564 
Time difference of 3652 days
 - 
 
2565 
>
- 
 
2566 
> ## test the .Generic mechanism
 - 
 
2567 
>
- 
 
2568 
> setMethod("Compare", signature("track", "track"),
 - 
 
2569 
+   function(e1,e2) {
 - 
 
2570 
+   switch(.Generic,
 - 
 
2571 
+    "==" = e1@y == e2@y,
 - 
 
2572 
+   NA)
 - 
 
2573 
+  })
 - 
 
2574 
[1] "Compare"
 - 
 
2575 
>
- 
 
2576 
> #stopifnot(all(t1==t1))
 - 
 
2577 
> #stopifnot(identical(t1<t1, NA))
 - 
 
2578 
>
- 
 
2579 
>
- 
 
2580 
> ## A test of nested calls to "[" with matrix-style arguments
 - 
 
2581 
> ## applied to data.frames (S3 methods)
 - 
 
2582 
>
- 
 
2583 
> setMethod("[", c("trackMultiCurve", "numeric", "numeric"), function(x, i, j, ..., drop) {
 - 
 
2584 
+ ### FIXME:  a better version has only 1st arg in signature
 - 
 
2585 
+ ### and uses callNextMethod, when this works with primitives.
 - 
 
2586 
+     x@y <- x@y[i, j, drop=FALSE]
 - 
 
2587 
+     x@x <- x@x[i]
 - 
 
2588 
+     x
 - 
 
2589 
+ })
 - 
 
2590 
[1] "["
 - 
 
2591 
>
- 
 
2592 
>
- 
 
2593 
> "testFunc" <-
 - 
 
2594 
+ function(cur) {
 - 
 
2595 
+     sorted <- cur[order(cur[,1]),]
 - 
 
2596 
+     sorted[ !is.na(sorted[,1]), ]
 - 
 
2597 
+ }
 - 
 
2598 
>
- 
 
2599 
> Nrow <- 1000 # at one time, values this large triggered a bug in gc/protect
 - 
 
2600 
> ## the loop here was a trigger for the bug
 - 
 
2601 
> Niter <- 10
 - 
 
2602 
> for(i in 1:Niter)  {
 - 
 
2603 
+     yy <- matrix(stats::rnorm(10*Nrow), 10, Nrow)
 - 
 
2604 
+     tDF <- as.data.frame(yy)
 - 
 
2605 
+     testFunc(tDF)
 - 
 
2606 
+ }
 - 
 
2607 
>
- 
 
2608 
>
- 
 
2609 
> tMC <- new("trackMultiCurve", x=seq_len(Nrow), y = yy)
 - 
 
2610 
> ## not enough functions have methods for this class to use testFunc
 - 
 
2611 
>
- 
 
2612 
> stopifnot(identical(tMC[1:10, 1:10]@y, yy[1:10, 1:10]))
 - 
 
2613 
>
- 
 
2614 
>
- 
 
2615 
> ## verify we can remove methods and generic
 - 
 
2616 
>
- 
 
2617 
> removeMethods("-")
 - 
 
2618 
[1] FALSE
 - 
 
2619 
> removeMethod("length", "track")
 - 
 
2620 
[1] TRUE
 - 
 
2621 
> removeMethods("Arith")
 - 
 
2622 
Warning in removeMethods("Arith") :
 - 
 
2623 
  cannot remove methods for  "Arith" in locked environment/package "methods"
 - 
 
2624 
[1] TRUE
 - 
 
2625 
> removeMethods("Compare")
 - 
 
2626 
Warning in removeMethods("Compare") :
 - 
 
2627 
  cannot remove methods for  "Compare" in locked environment/package "methods"
 - 
 
2628 
[1] TRUE
 - 
 
2629 
>
- 
 
2630 
> ## repeat the test one more time on the primitives
 - 
 
2631 
>
- 
 
2632 
> length(ISOdate(1990, 12, 1)- ISOdate(1980, 12, 1))
 - 
 
2633 
[1] 1
 - 
 
2634 
>
- 
 
2635 
> removeMethods("length")
 - 
 
2636 
[1] TRUE
 - 
 
2637 
>
- 
 
2638 
> ## methods for %*%, which isn't done by the same C code as other ops
 - 
 
2639 
>
- 
 
2640 
> setClass("foo", representation(m="matrix"))
 - 
 
2641 
[1] "foo"
 - 
 
2642 
> m1 <- matrix(1:12,3,4)
 - 
 
2643 
> f1 = new("foo", m=m1)
 - 
 
2644 
> f2 = new("foo", m=t(m1))
 - 
 
2645 
>
- 
 
2646 
> setMethod("%*%", c("foo", "foo"),
 - 
 
2647 
+  function(x,y)callGeneric(x@m, y@m))
 - 
 
2648 
[1] "%*%"
 - 
 
2649 
>
- 
 
2650 
> stopifnot(identical(f1%*%f2, m1%*% t(m1)))
 - 
 
2651 
>
- 
 
2652 
> removeMethods("%*%")
 - 
 
2653 
[1] TRUE
 - 
 
2654 
>
- 
 
2655 
> removeMethods("plot")
 - 
 
2656 
[1] TRUE
 - 
 
2657 
>
- 
 
2658 
> ## Hold until removeMethods revised: stopifnot(existsFunction("plot", FALSE) && !isGeneric("plot", 1))
 - 
 
2659 
>
- 
 
2660 
> ## methods for plotData
 - 
 
2661 
> plotData <- function(x, y, ...) plot(x, y, ...)
 - 
 
2662 
>
- 
 
2663 
> setGeneric("plotData")
 - 
 
2664 
[1] "plotData"
 - 
 
2665 
>
- 
 
2666 
> setMethod("plotData", signature(x="track", y="missing"),
 - 
 
2667 
+   function(x,  y, ...) plot(slot(x, "x"), slot(x, "y"), ...)
 - 
 
2668 
+ )
 - 
 
2669 
[1] "plotData"
 - 
 
2670 
> ## and now remove the whole generic
 - 
 
2671 
> removeGeneric("plotData")
 - 
 
2672 
[1] TRUE
 - 
 
2673 
>
- 
 
2674 
> stopifnot(!exists("plotData", 1))
 - 
 
2675 
>
- 
 
2676 
> ##  Tests of method inheritance & multiple dispatch
 - 
 
2677 
> setClass("A0", representation(a0 = "numeric"))
 - 
 
2678 
[1] "A0"
 - 
 
2679 
>
- 
 
2680 
> setClass("A1", representation("A0", a1 = "character"))
 - 
 
2681 
[1] "A1"
 - 
 
2682 
>
- 
 
2683 
> setClass("B0" ,representation(b0 = "numeric"))
 - 
 
2684 
[1] "B0"
 - 
 
2685 
>
- 
 
2686 
> setClass("B1", "B0")
 - 
 
2687 
[1] "B1"
 - 
 
2688 
>
- 
 
2689 
> setClass("B2", representation("B1", b2 = "logical"))
 - 
 
2690 
[1] "B2"
 - 
 
2691 
>
- 
 
2692 
> setClass("AB0", representation("A1", "B2", ab0 = "matrix"))
 - 
 
2693 
[1] "AB0"
 - 
 
2694 
>
- 
 
2695 
> f1 <- function(x,  y)"ANY"
 - 
 
2696 
>
- 
 
2697 
> setGeneric("f1")
 - 
 
2698 
[1] "f1"
 - 
 
2699 
>
- 
 
2700 
> setMethod("f1", c("A0", "B1"), function(x, y)"A0 B1")
 - 
 
2701 
[1] "f1"
 - 
 
2702 
> setMethod("f1", c("B1", "A0"), function(x, y)"B1 A0")
 - 
 
2703 
[1] "f1"
 - 
 
2704 
>
- 
 
2705 
> a0 <- new("A0")
 - 
 
2706 
> a1 <- new("A1")
 - 
 
2707 
> b0 <- new("B0")
 - 
 
2708 
> b1 <- new("B1")
 - 
 
2709 
> b2 <- new("B2")
 - 
 
2710 
>
- 
 
2711 
> deparseText <- function(expr)
 - 
 
2712 
+     paste(deparse(expr), collapse = "\  ")
 - 
 
2713 
>
- 
 
2714 
> mustEqual <- function(e1, e2){
 - 
 
2715 
+     if(!identical(e1, e2))
 - 
 
2716 
+         stop(paste("!identical(", deparseText(substitute(e1)),
 - 
 
2717 
+                    ", ", deparseText(substitute(e2)), ")", sep=""))
 - 
 
2718 
+ }
 - 
 
2719 
>
- 
 
2720 
> mustEqual(f1(a0, b0), "ANY")
 - 
 
2721 
> mustEqual(f1(a1,b0), "ANY")
 - 
 
2722 
> mustEqual(f1(a1,b1), "A0 B1")
 - 
 
2723 
> mustEqual(f1(b1,a1), "B1 A0")
 - 
 
2724 
> mustEqual(f1(b1,b1), "ANY")
 - 
 
2725 
>
- 
 
2726 
> ## remove classes:  order matters so as not to undefine earlier classes
 - 
 
2727 
> for(.cl in c("AB0", "A1", "A0", "B2", "B1", "B0"))
 - 
 
2728 
+     removeClass(.cl)
 - 
 
2729 
>
- 
 
2730 
> removeGeneric("f1")
 - 
 
2731 
[1] TRUE
 - 
 
2732 
>
- 
 
2733 
> ## test of nonstandard generic definition
 - 
 
2734 
>
- 
 
2735 
> setGeneric("doubleAnything", function(x) {
 - 
 
2736 
+   methodValue <- standardGeneric("doubleAnything")
 - 
 
2737 
+   c(methodValue, methodValue)
 - 
 
2738 
+ })
 - 
 
2739 
[1] "doubleAnything"
 - 
 
2740 
>
- 
 
2741 
> setMethod("doubleAnything", "ANY", function(x)x)
 - 
 
2742 
[1] "doubleAnything"
 - 
 
2743 
>
- 
 
2744 
> setMethod("doubleAnything", "character",
 - 
 
2745 
+ function(x)paste("<",x,">",sep=""))
 - 
 
2746 
[1] "doubleAnything"
 - 
 
2747 
>
- 
 
2748 
> mustEqual(doubleAnything(1:10), c(1:10, 1:10))
 - 
 
2749 
> mustEqual(doubleAnything("junk"), rep("<junk>",2))
 - 
 
2750 
>
- 
 
2751 
> removeGeneric("doubleAnything")
 - 
 
2752 
[1] TRUE
 - 
 
2753 
>
- 
 
2754 
>
- 
 
2755 
> ## End Don't show
 - 
 
2756 
>
- 
 
2757 
>
- 
 
2758 
>
- 
 
2759 
> cleanEx()
 - 
 
2760 
> nameEx("setOldClass")
 - 
 
2761 
> ### * setOldClass
 - 
 
2762 
>
- 
 
2763 
> flush(stderr()); flush(stdout())
 - 
 
2764 
>
- 
 
2765 
> ### Name: setOldClass
 - 
 
2766 
> ### Title: Register Old-Style (S3) Classes and Inheritance
 - 
 
2767 
> ### Aliases: setOldClass .setOldIs POSIXct-class POSIXlt-class POSIXt-class
 - 
 
2768 
> ###   aov-class maov-class anova-class anova.glm-class anova.glm.null-class
 - 
 
2769 
> ###   Date-class data.frame-class data.frameRowLabels-class density-class
 - 
 
2770 
> ###   dump.frames-class factor-class formula-class glm-class glm.null-class
 - 
 
2771 
> ###   hsearch-class integrate-class libraryIQR-class lm-class logLik-class
 - 
 
2772 
> ###   mlm-class mtable-class mts-class ordered-class packageIQR-class
 - 
 
2773 
> ###   packageInfo-class recordedplot-class rle-class socket-class
 - 
 
2774 
> ###   summaryDefault-class summary.table-class oldClass-class
 - 
 
2775 
> ###   .OldClassesList table-class initialize,data.frame-method
 - 
 
2776 
> ###   initialize,factor-method initialize,ordered-method
 - 
 
2777 
> ###   initialize,table-method initialize,summary.table-method
 - 
 
2778 
> ### Keywords: programming methods
 - 
 
2779 
>
- 
 
2780 
> ### ** Examples
 - 
 
2781 
>
- 
 
2782 
> require(stats)
 - 
 
2783 
> setOldClass(c("mlm", "lm"))
 - 
 
2784 
> setGeneric("dfResidual", function(model)standardGeneric("dfResidual"))
 - 
 
2785 
[1] "dfResidual"
 - 
 
2786 
> setMethod("dfResidual", "lm", function(model)model$df.residual)
 - 
 
2787 
[1] "dfResidual"
 - 
 
2788 
>
- 
 
2789 
> ## dfResidual will work on mlm objects as well as lm objects
 - 
 
2790 
> myData <- data.frame(time = 1:10, y = (1:10)^.5)
 - 
 
2791 
> myLm <- lm(cbind(y, y^3)  ~ time, myData)
 - 
 
2792 
>
- 
 
2793 
> showClass("data.frame")# to see the predefined S4 "oldClass"
 - 
 
2794 
Class "data.frame" [package "methods"]
 - 
 
2795 
 
 - 
 
2796 
Slots:
 - 
 
2797
- 
 
2798 
Name:                .Data               names           row.names
 - 
 
2799 
Class:                list           character data.frameRowLabels
 - 
 
2800
- 
 
2801 
Name:             .S3Class
 - 
 
2802 
Class:           character
 - 
 
2803 
 
 - 
 
2804 
Extends:
- 
 
2805 
Class "list", from data part
 - 
 
2806 
Class "oldClass", directly
 - 
 
2807 
Class "vector", by class "list", distance 2
 - 
 
2808 
>
- 
 
2809 
> ## two examples extending S3 class "lm", class "xlm"  directly and "ylm" indirectly
 - 
 
2810 
> setClass("xlm", representation(eps = "numeric"), contains = "lm")
 - 
 
2811 
[1] "xlm"
 - 
 
2812 
> setClass("ylm", representation(header = "character"), contains = "xlm")
 - 
 
2813 
[1] "ylm"
 - 
 
2814 
> ym1 = new("ylm", myLm, header = "Example", eps = 0.)
 - 
 
2815 
> ## for more examples, see ?S3Class.
 - 
 
2816 
>
- 
 
2817 
> utils::str(.OldClassesList)
 - 
 
2818 
List of 27
 - 
 
2819 
 $ : chr [1:2] "anova" "data.frame"
 - 
 
2820 
 $ : chr [1:2] "mlm" "lm"
 - 
 
2821 
 $ : chr [1:2] "aov" "lm"
 - 
 
2822 
 $ : chr [1:3] "maov" "mlm" "lm"
 - 
 
2823 
 $ : chr [1:2] "POSIXct" "POSIXt"
 - 
 
2824 
 $ : chr [1:2] "POSIXlt" "POSIXt"
 - 
 
2825 
 $ : chr "Date"
 - 
 
2826 
 $ : chr "dump.frames"
 - 
 
2827 
 $ : chr [1:2] "ordered" "factor"
 - 
 
2828 
 $ : chr [1:3] "glm.null" "glm" "lm"
 - 
 
2829 
 $ : chr [1:2] "anova.glm.null" "anova.glm"
 - 
 
2830 
 $ : chr "hsearch"
 - 
 
2831 
 $ : chr "integrate"
 - 
 
2832 
 $ : chr "packageInfo"
 - 
 
2833 
 $ : chr "libraryIQR"
 - 
 
2834 
 $ : chr "packageIQR"
 - 
 
2835 
 $ : chr "mtable"
 - 
 
2836 
 $ : chr "table"
 - 
 
2837 
 $ : chr [1:2] "summaryDefault" "table"
 - 
 
2838 
 $ : chr "summary.table"
 - 
 
2839 
 $ : chr "recordedplot"
 - 
 
2840 
 $ : chr "socket"
 - 
 
2841 
 $ : chr "packageIQR"
 - 
 
2842 
 $ : chr "density"
 - 
 
2843 
 $ : chr "formula"
 - 
 
2844 
 $ : chr "logLik"
 - 
 
2845 
 $ : chr "rle"
 - 
 
2846 
>
- 
 
2847 
> ## Don't show:
- 
 
2848 
> stopifnot(identical(dfResidual(myLm), myLm$df.residual))
 - 
 
2849 
> removeClass("ylm"); removeClass("xlm")
 - 
 
2850 
[1] TRUE
 - 
 
2851 
[1] TRUE
 - 
 
2852 
> rm(myData, myLm)
 - 
 
2853 
> removeGeneric("dfResidual")
 - 
 
2854 
[1] TRUE
 - 
 
2855 
> ## End Don't show
 - 
 
2856 
>
- 
 
2857 
> ## Examples of S3 classes with guaranteed attributes
 - 
 
2858 
> ## an S3 class "stamped" with a vector and  a "date" attribute
 - 
 
2859 
> ## Here is a generator function and an S3 print method.
 - 
 
2860 
> ## NOTE:  it's essential that the generator checks the attribute classes
 - 
 
2861 
> stamped <- function(x, date = Sys.time()) {
 - 
 
2862 
+     if(!inherits(date, "POSIXt"))
 - 
 
2863 
+       stop("bad date argument")
 - 
 
2864 
+     if(!is.vector(x))
 - 
 
2865 
+       stop("x must be a vector")
 - 
 
2866 
+     attr(x, "date") <- date
 - 
 
2867 
+     class(x) <- "stamped"
 - 
 
2868 
+     x
 - 
 
2869 
+ }
 - 
 
2870 
>
- 
 
2871 
> print.stamped <- function(x, ...) {
 - 
 
2872 
+     print(as.vector(x))
 - 
 
2873 
+     cat("Date: ",  format(attr(x,"date")), "\n")
 - 
 
2874 
+ }
 - 
 
2875 
>
- 
 
2876 
> ## Now, an S4 class with the same structure:
 - 
 
2877 
> setClass("stamped4", contains = "vector", representation(date = "POSIXt"))
 - 
 
2878 
[1] "stamped4"
 - 
 
2879 
>
- 
 
2880 
> ## We can use the S4 class to register "stamped", with its attributes:
 - 
 
2881 
> setOldClass("stamped", S4Class = "stamped4")
 - 
 
2882 
> selectMethod("show", "stamped")
 - 
 
2883 
Method Definition:
 - 
 
2884 
 
 - 
 
2885 
function (object)
- 
 
2886 
{
 - 
 
2887 
    if (!isS4(object)) {
 - 
 
2888 
        print(object)
 - 
 
2889 
        return(invisible())
 - 
 
2890 
    }
 - 
 
2891 
    cl <- as.character(class(object))
 - 
 
2892 
    S3Class <- object@.S3Class
 - 
 
2893 
    if (length(S3Class))
- 
 
2894 
        S3Class <- S3Class[[1L]]
 - 
 
2895 
    else S3Class <- "oldClass"
 - 
 
2896 
    cat("Object of class \"", cl, "\"\n", sep = "")
 - 
 
2897 
    print(S3Part(object, strict = TRUE))
 - 
 
2898 
    otherSlots <- slotNames(cl)
 - 
 
2899 
    S3slots <- slotNames(S3Class)
 - 
 
2900 
    otherSlots <- otherSlots[is.na(match(otherSlots, S3slots))]
 - 
 
2901 
    for (what in otherSlots) {
 - 
 
2902 
        cat("Slot \"", what, "\":\n", sep = "")
 - 
 
2903 
        show(slot(object, what))
 - 
 
2904 
        cat("\n")
 - 
 
2905 
    }
 - 
 
2906 
    NULL
 - 
 
2907 
}
 - 
 
2908 
<environment: 0x102676c08>
 - 
 
2909 
 
 - 
 
2910 
Signatures:
 - 
 
2911 
        object
- 
 
2912 
target  "oldClass"
 - 
 
2913 
defined "oldClass"
 - 
 
2914 
> ## and then remove "stamped4" to clean up
 - 
 
2915 
> removeClass("stamped4")
 - 
 
2916 
[1] TRUE
 - 
 
2917 
> ## Don't show:
- 
 
2918 
> set.seed(113)
 - 
 
2919 
> ## End Don't show
 - 
 
2920 
> someLetters <- stamped(sample(letters, 10),  ISOdatetime(2008, 10, 15, 12, 0, 0))
 - 
 
2921 
>
- 
 
2922 
> st <- new("stamped", someLetters)
 - 
 
2923 
> st  # show() method prints the object's class, then calls the S3 print method.
 - 
 
2924 
Object of class "stamped"
 - 
 
2925 
 [1] "o" "p" "v" "i" "r" "w" "b" "m" "f" "s"
 - 
 
2926 
Date:  2008-10-15 12:00:00
- 
 
2927 
>
- 
 
2928 
> stopifnot(identical(S3Part(st, TRUE), someLetters))
 - 
 
2929 
>
- 
 
2930 
> # creating the S4 object directly from its data part and slots
 - 
 
2931 
> new("stamped", 1:10, date = ISOdatetime(1976, 5, 5, 15, 10, 0))
 - 
 
2932 
Object of class "stamped"
 - 
 
2933 
 [1]  1  2  3  4  5  6  7  8  9 10
 - 
 
2934 
Date:  1976-05-05 15:10:00
- 
 
2935 
>
- 
 
2936 
> ## Not run:
- 
 
2937 
> ##D ## The code in R that defines "ts" as an S4 class
 - 
 
2938 
> ##D setClass("ts", contains = "structure",
 - 
 
2939 
> ##D       representation(tsp = "numeric"),
 - 
 
2940 
> ##D       prototype(NA, tsp = rep(1,3))) # prototype to be a legal S3 time-series
 - 
 
2941 
> ##D ## and now registers it as an S3 class
 - 
 
2942 
> ##D     setOldClass("ts", S4Class = "ts", where = envir)
 - 
 
2943 
> ## End(Not run)
 - 
 
2944 
>
- 
 
2945 
> ## Don't show:
- 
 
2946 
>   removeClass("stamped")
 - 
 
2947 
[1] TRUE
 - 
 
2948 
>   rm(someLetters, st)
 - 
 
2949 
> ## End Don't show
 - 
 
2950 
>
- 
 
2951 
>
- 
 
2952 
>
- 
 
2953 
>
- 
 
2954 
> cleanEx()
 - 
 
2955 
> nameEx("show")
 - 
 
2956 
> ### * show
 - 
 
2957 
>
- 
 
2958 
> flush(stderr()); flush(stdout())
 - 
 
2959 
>
- 
 
2960 
> ### Name: show
 - 
 
2961 
> ### Title: Show an Object
 - 
 
2962 
> ### Aliases: show show-methods show,ANY-method show,traceable-method
 - 
 
2963 
> ###   show,ObjectsWithPackage-method show,MethodDefinition-method
 - 
 
2964 
> ###   show,MethodWithNext-method show,genericFunction-method
 - 
 
2965 
> ###   show,classRepresentation-method
 - 
 
2966 
> ### Keywords: programming
 - 
 
2967 
>
- 
 
2968 
> ### ** Examples
 - 
 
2969 
>
- 
 
2970 
> ## following the example shown in the setMethod documentation ...
 - 
 
2971 
> setClass("track",
 - 
 
2972 
+          representation(x="numeric", y="numeric"))
 - 
 
2973 
[1] "track"
 - 
 
2974 
> setClass("trackCurve",
- 
 
2975 
+          representation("track", smooth = "numeric"))
 - 
 
2976 
[1] "trackCurve"
 - 
 
2977 
>
- 
 
2978 
> t1 <- new("track", x=1:20, y=(1:20)^2)
 - 
 
2979 
>
- 
 
2980 
> tc1 <- new("trackCurve", t1)
 - 
 
2981 
>
- 
 
2982 
> setMethod("show", "track",
 - 
 
2983 
+   function(object)print(rbind(x = object@x, y=object@y))
 - 
 
2984 
+ )
 - 
 
2985 
[1] "show"
 - 
 
2986 
> ## The method will now be used for automatic printing of t1
 - 
 
2987 
>
- 
 
2988 
> t1
 - 
 
2989 
  [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13] [,14]
 - 
 
2990 
x    1    2    3    4    5    6    7    8    9    10    11    12    13    14
 - 
 
2991 
y    1    4    9   16   25   36   49   64   81   100   121   144   169   196
 - 
 
2992 
  [,15] [,16] [,17] [,18] [,19] [,20]
 - 
 
2993 
x    15    16    17    18    19    20
 - 
 
2994 
y   225   256   289   324   361   400
 - 
 
2995 
>
- 
 
2996 
> ## Not run:
- 
 
2997 
> ##D   [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12]
 - 
 
2998 
> ##D x    1    2    3    4    5    6    7    8    9    10    11    12
 - 
 
2999 
> ##D y    1    4    9   16   25   36   49   64   81   100   121   144
 - 
 
3000 
> ##D   [,13] [,14] [,15] [,16] [,17] [,18] [,19] [,20]
 - 
 
3001 
> ##D x    13    14    15    16    17    18    19    20
 - 
 
3002 
> ##D y   169   196   225   256   289   324   361   400
 - 
 
3003 
> ## End(Not run)
 - 
 
3004 
> ## and also for tc1, an object of a class that extends "track"
 - 
 
3005 
> tc1
 - 
 
3006 
  [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13] [,14]
 - 
 
3007 
x    1    2    3    4    5    6    7    8    9    10    11    12    13    14
 - 
 
3008 
y    1    4    9   16   25   36   49   64   81   100   121   144   169   196
 - 
 
3009 
  [,15] [,16] [,17] [,18] [,19] [,20]
 - 
 
3010 
x    15    16    17    18    19    20
 - 
 
3011 
y   225   256   289   324   361   400
 - 
 
3012 
>
- 
 
3013 
> ## Not run:
- 
 
3014 
> ##D   [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12]
 - 
 
3015 
> ##D x    1    2    3    4    5    6    7    8    9    10    11    12
 - 
 
3016 
> ##D y    1    4    9   16   25   36   49   64   81   100   121   144
 - 
 
3017 
> ##D   [,13] [,14] [,15] [,16] [,17] [,18] [,19] [,20]
 - 
 
3018 
> ##D x    13    14    15    16    17    18    19    20
 - 
 
3019 
> ##D y   169   196   225   256   289   324   361   400
 - 
 
3020 
> ## End(Not run)
 - 
 
3021 
>
- 
 
3022 
>
- 
 
3023 
>
- 
 
3024 
> cleanEx()
 - 
 
3025 
> nameEx("showMethods")
 - 
 
3026 
> ### * showMethods
 - 
 
3027 
>
- 
 
3028 
> flush(stderr()); flush(stdout())
 - 
 
3029 
>
- 
 
3030 
> ### Name: showMethods
 - 
 
3031 
> ### Title: Show all the methods for the specified function(s)
 - 
 
3032 
> ### Aliases: showMethods
 - 
 
3033 
> ### Keywords: methods
 - 
 
3034 
>
- 
 
3035 
> ### ** Examples
 - 
 
3036 
>
- 
 
3037 
> require(graphics)
 - 
 
3038 
> ## Don't show:
- 
 
3039 
>  setClass("track",
 - 
 
3040 
+           representation(x="numeric", y="numeric"))
 - 
 
3041 
[1] "track"
 - 
 
3042 
>  ## First, with only one object as argument:
 - 
 
3043 
>  setMethod("plot", signature(x="track", y="missing"),
 - 
 
3044 
+            function(x,  y, ...) plot(slot(x, "x"), slot(x, "y"), ...))
 - 
 
3045 
Creating a new generic function for "plot" in ".GlobalEnv"
 - 
 
3046 
[1] "plot"
 - 
 
3047 
>  ## Second, plot the data from the track on the y-axis against anything
 - 
 
3048 
>  ## as the x data.
 - 
 
3049 
>  setMethod("plot", signature(y = "track"),
 - 
 
3050 
+            function(x, y, ...) plot(x, slot(y, "y"), ...))
 - 
 
3051 
[1] "plot"
 - 
 
3052 
>  setMethod("plot", "track",
 - 
 
3053 
+            function(x, y, ...) plot(slot(x, "y"), y,  ...))
 - 
 
3054 
[1] "plot"
 - 
 
3055 
> ## End Don't show
 - 
 
3056 
> ## Assuming the methods for plot
 - 
 
3057 
> ## are set up as in the example of help(setMethod),
 - 
 
3058 
> ## print (without definitions) the methods that involve class "track":
 - 
 
3059 
> showMethods("plot", classes = "track")
 - 
 
3060 
Function: plot (package graphics)
 - 
 
3061 
x="ANY", y="track"
 - 
 
3062 
x="track", y="ANY"
 - 
 
3063 
x="track", y="missing"
 - 
 
3064 
 
 - 
 
3065 
> ## Not run:
- 
 
3066 
> ##D # Function "plot":
 - 
 
3067 
> ##D # x = ANY, y = track
 - 
 
3068 
> ##D # x = track, y = missing
 - 
 
3069 
> ##D # x = track, y = ANY
 - 
 
3070 
> ##D
- 
 
3071 
> ##D require("Matrix")
 - 
 
3072 
> ##D showMethods("%*%")# many!
 - 
 
3073 
> ##D     methods(class = "Matrix")# nothing
 - 
 
3074 
> ##D showMethods(class = "Matrix")# everything
 - 
 
3075 
> ##D showMethods(Matrix:::isDiagonal) # a non-exported generic
 - 
 
3076 
> ## End(Not run)
 - 
 
3077 
>
- 
 
3078 
> not.there <- !any("package:stats4" == search())
 - 
 
3079 
> if(not.there) library(stats4)
 - 
 
3080 
> showMethods(classes = "mle")
 - 
 
3081 
Function: coef (package stats)
 - 
 
3082 
object="mle"
 - 
 
3083 
 
 - 
 
3084 
Function: confint (package stats)
 - 
 
3085 
object="mle"
 - 
 
3086 
 
 - 
 
3087 
Function: logLik (package stats)
 - 
 
3088 
object="mle"
 - 
 
3089 
 
 - 
 
3090 
Function: profile (package stats)
 - 
 
3091 
fitted="mle"
 - 
 
3092 
 
 - 
 
3093 
Function: show (package methods)
 - 
 
3094 
object="mle"
 - 
 
3095 
 
 - 
 
3096 
Function: update (package stats)
 - 
 
3097 
object="mle"
 - 
 
3098 
 
 - 
 
3099 
Function: vcov (package stats)
 - 
 
3100 
object="mle"
 - 
 
3101 
 
 - 
 
3102 
> if(not.there) detach("package:stats4")
 - 
 
3103 
>
- 
 
3104 
>
- 
 
3105 
>
- 
 
3106 
> cleanEx()
 - 
 
3107 
> nameEx("slot")
 - 
 
3108 
> ### * slot
 - 
 
3109 
>
- 
 
3110 
> flush(stderr()); flush(stdout())
 - 
 
3111 
>
- 
 
3112 
> ### Name: slot
 - 
 
3113 
> ### Title: The Slots in an Object from a Formal Class
 - 
 
3114 
> ### Aliases: slot .hasSlot slot<- @<- slotNames .slotNames getSlots
 - 
 
3115 
> ### Keywords: programming classes
 - 
 
3116 
>
- 
 
3117 
> ### ** Examples
 - 
 
3118 
>
- 
 
3119 
> ## Don't show:
- 
 
3120 
> if(isClass("track")) removeClass("track")
 - 
 
3121 
Warning in removeClass("track") :
 - 
 
3122 
  Class definition for "track" not found  (no action taken)
 - 
 
3123 
[1] FALSE
 - 
 
3124 
> ## End Don't show
 - 
 
3125 
>
- 
 
3126 
> setClass("track", representation(x="numeric", y="numeric"))
 - 
 
3127 
[1] "track"
 - 
 
3128 
> myTrack <- new("track", x = -4:4, y = exp(-4:4))
 - 
 
3129 
> slot(myTrack, "x")
 - 
 
3130 
[1] -4 -3 -2 -1  0  1  2  3  4
 - 
 
3131 
> slot(myTrack, "y") <- log(slot(myTrack, "y"))
 - 
 
3132 
> utils::str(myTrack)
 - 
 
3133 
Formal class 'track' [package ".GlobalEnv"] with 2 slots
 - 
 
3134 
  ..@ x: int [1:9] -4 -3 -2 -1 0 1 2 3 4
 - 
 
3135 
  ..@ y: num [1:9] -4 -3 -2 -1 0 1 2 3 4
 - 
 
3136 
>
- 
 
3137 
> getSlots("track") # or
 - 
 
3138 
        x         y
- 
 
3139 
"numeric" "numeric"
- 
 
3140 
> getSlots(getClass("track"))
 - 
 
3141 
        x         y
- 
 
3142 
"numeric" "numeric"
- 
 
3143 
> slotNames(class(myTrack)) # is the same as
 - 
 
3144 
[1] "x" "y"
 - 
 
3145 
> slotNames(myTrack)
 - 
 
3146 
[1] "x" "y"
 - 
 
3147 
>
- 
 
3148 
> ## Don't show:
- 
 
3149 
> removeClass("track")##  should not be needed... see ./setClass.Rd
 - 
 
3150 
[1] TRUE
 - 
 
3151 
> ## End Don't show
 - 
 
3152 
>
- 
 
3153 
>
- 
 
3154 
>
- 
 
3155 
> cleanEx()
 - 
 
3156 
> nameEx("testInheritedMethods")
 - 
 
3157 
> ### * testInheritedMethods
 - 
 
3158 
>
- 
 
3159 
> flush(stderr()); flush(stdout())
 - 
 
3160 
>
- 
 
3161 
> ### Name: testInheritedMethods
 - 
 
3162 
> ### Title: Test for and Report about Selection of Inherited Methods
 - 
 
3163 
> ### Aliases: testInheritedMethods MethodSelectionReport-class .Other-class
 - 
 
3164 
> ### Keywords: programming classes methods
 - 
 
3165 
>
- 
 
3166 
> ### ** Examples
 - 
 
3167 
>
- 
 
3168 
> ## if no other attached  packages have methods for `+` or its group generic
- 
 
3169 
> ## functions, this returns a 16 by 2 matrix of selection patterns (in R 2.9.0)
 - 
 
3170 
> testInheritedMethods("+")
 - 
 
3171 
Warning in testInheritedMethods("+") :
 - 
 
3172 
  Undefined classes ("m1") will be ignored, for argument e1
 - 
 
3173 
Warning in testInheritedMethods("+") :
 - 
 
3174 
  Undefined classes ("m1") will be ignored, for argument e2
 - 
 
3175 
Reported 0 ambiguous selections out of 16 for function +
 - 
 
3176 
>
- 
 
3177 
>
- 
 
3178 
>
- 
 
3179 
> cleanEx()
 - 
 
3180 
> nameEx("validObject")
 - 
 
3181 
> ### * validObject
 - 
 
3182 
>
- 
 
3183 
> flush(stderr()); flush(stdout())
 - 
 
3184 
>
- 
 
3185 
> ### Name: validObject
 - 
 
3186 
> ### Title: Test the Validity of an Object
 - 
 
3187 
> ### Aliases: validObject getValidity setValidity
 - 
 
3188 
> ### Keywords: programming classes
 - 
 
3189 
>
- 
 
3190 
> ### ** Examples
 - 
 
3191 
>
- 
 
3192 
> setClass("track",
 - 
 
3193 
+           representation(x="numeric", y = "numeric"))
 - 
 
3194 
[1] "track"
 - 
 
3195 
> t1 <- new("track", x=1:10, y=sort(stats::rnorm(10)))
 - 
 
3196 
> ## A valid "track" object has the same number of x, y values
 - 
 
3197 
> validTrackObject <- function(object) {
 - 
 
3198 
+     if(length(object@x) == length(object@y)) TRUE
 - 
 
3199 
+     else paste("Unequal x,y lengths: ", length(object@x), ", ",
 - 
 
3200 
+                length(object@y), sep="")
 - 
 
3201 
+ }
 - 
 
3202 
> ## assign the function as the validity method for the class
 - 
 
3203 
> setValidity("track", validTrackObject)
 - 
 
3204 
Class "track" [in ".GlobalEnv"]
 - 
 
3205 
 
 - 
 
3206 
Slots:
 - 
 
3207
- 
 
3208 
Name:        x       y
 - 
 
3209 
Class: numeric numeric
 - 
 
3210 
> ## t1 should be a valid "track" object
 - 
 
3211 
> validObject(t1)
 - 
 
3212 
[1] TRUE
 - 
 
3213 
> ## Now we do something bad
 - 
 
3214 
> t2 <- t1
 - 
 
3215 
> t2@x <- 1:20
 - 
 
3216 
> ## This should generate an error
 - 
 
3217 
> ## Not run: try(validObject(t2))
 - 
 
3218 
> ## Don't show:
- 
 
3219 
> stopifnot(is(try(validObject(t2)), "try-error"))
 - 
 
3220 
Error in validObject(t2) :
- 
 
3221 
  invalid class "track" object: Unequal x,y lengths: 20, 10
 - 
 
3222 
> ## End Don't show
 - 
 
3223 
>
- 
 
3224 
> setClass("trackCurve",
 - 
 
3225 
+          representation("track", smooth = "numeric"))
 - 
 
3226 
[1] "trackCurve"
 - 
 
3227 
>
- 
 
3228 
> ## all superclass validity methods are used when validObject
 - 
 
3229 
> ## is called from initialize() with arguments, so this fails
 - 
 
3230 
> ## Not run: trynew("trackCurve", t2)
 - 
 
3231 
> ## Don't show:
- 
 
3232 
> stopifnot(is(try(new("trackCurve", t2)), "try-error"))
 - 
 
3233 
Error in validObject(.Object) :
- 
 
3234 
  invalid class "trackCurve" object: Unequal x,y lengths: 20, 10
 - 
 
3235 
> ## End Don't show
 - 
 
3236 
>
- 
 
3237 
> setClass("twoTrack", representation(tr1 = "track", tr2 ="track"))
 - 
 
3238 
[1] "twoTrack"
 - 
 
3239 
>
- 
 
3240 
> ## validity tests are not applied recursively by default,
 - 
 
3241 
> ## so this object is created (invalidly)
 - 
 
3242 
> tT  <- new("twoTrack", tr2 = t2)
 - 
 
3243 
>
- 
 
3244 
> ## A stricter test detects the problem
 - 
 
3245 
> ## Not run: try(validObject(tT, complete = TRUE))
 - 
 
3246 
> ## Don't show:
- 
 
3247 
> stopifnot(is(try(validObject(tT, complete = TRUE)), "try-error"))
 - 
 
3248 
Error in validObject(tT, complete = TRUE) :
- 
 
3249 
  invalid class "twoTrack" object: In slot "tr2" of class "track": Unequal x,y lengths: 20, 10
 - 
 
3250 
> ## End Don't show
 - 
 
3251 
>
- 
 
3252 
>
- 
 
3253 
>
108 
>
3254 
> ### * <FOOTER>
 - 
 
3255 
> ###
 - 
 
3256 
> cat("Time elapsed: ", proc.time() - get("ptime", pos = 'CheckExEnv'),"\n")
 - 
 
3257 
Time elapsed:  3.629 0.049 3.679 0 0
- 
 
3258 
> grDevices::dev.off()
 - 
 
3259 
null device
- 
 
3260 
          1
- 
 
3261 
> ###
 - 
 
3262 
> ### Local variables: ***
 - 
 
3263 
> ### mode: outline-minor ***
 - 
 
3264 
> ### outline-regexp: "\\(> \\)?### [*]+" ***
 - 
 
3265 
> ### End: ***
 - 
 
3266 
> quit('no')
 -