R : Copyright 2005, The R Foundation for Statistical Computing Version 2.1.1 (2005-06-20), ISBN 3-900051-07-0 R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for a HTML browser interface to help. Type 'q()' to quit R. > ### *
> ### > attach(NULL, name = "CheckExEnv") > assign(".CheckExEnv", as.environment(2), pos = length(search())) # base > ## add some hooks to label plot pages for base and grid graphics > setHook("plot.new", ".newplot.hook") > setHook("persp", ".newplot.hook") > setHook("grid.newpage", ".gridplot.hook") > > assign("cleanEx", + function(env = .GlobalEnv) { + rm(list = ls(envir = env, all.names = TRUE), envir = env) + RNGkind("default", "default") + set.seed(1) + options(warn = 1) + delayedAssign("T", stop("T used instead of TRUE"), + assign.env = .CheckExEnv) + delayedAssign("F", stop("F used instead of FALSE"), + assign.env = .CheckExEnv) + sch <- search() + newitems <- sch[! sch %in% .oldSearch] + for(item in rev(newitems)) + eval(substitute(detach(item), list(item=item))) + missitems <- .oldSearch[! .oldSearch %in% sch] + if(length(missitems)) + warning("items ", paste(missitems, collapse=", "), + " have been removed from the search path") + }, + env = .CheckExEnv) > assign("..nameEx", "__{must remake R-ex/*.R}__", env = .CheckExEnv) # for now > assign("ptime", proc.time(), env = .CheckExEnv) > grDevices::postscript("proto-Examples.ps") > assign("par.postscript", graphics::par(no.readonly = TRUE), env = .CheckExEnv) > options(contrasts = c(unordered = "contr.treatment", ordered = "contr.poly")) > options(warn = 1) > library('proto') > > assign(".oldSearch", search(), env = .CheckExEnv) > assign(".oldNS", loadedNamespaces(), env = .CheckExEnv) > cleanEx(); ..nameEx <- "dot.proto" > > ### * dot.proto > > flush(stderr()); flush(stdout()) > > ### Name: dot.proto > ### Title: Proto graphviz interface > ### Aliases: dot.proto name.proto > ### Keywords: programming > > ### ** Examples > > > oo <- proto(..Name = "root") > oo2 <- oo$proto() > oo3 <- oo$proto() > oo4 <- oo$proto() > dot.proto() digraph G { graph [rankdir=BT]; "oo4" -> "root" ; "oo3" -> "root" ; "oo2" -> "root" ; "root" -> "R_GlobalEnv" ; } > > # different appearance > dot.proto(control = list(include = "") ) digraph G { "oo4" -> "root" ; "oo3" -> "root" ; "oo2" -> "root" ; "root" -> "R_GlobalEnv" ; } > > # just oo, oo2, oo3. Display dot commands on console. > dot.proto(proto(oo = oo, oo2 = oo2, oo3 = oo3)) digraph G { graph [rankdir=BT]; "oo3" -> "root" ; "oo2" -> "root" ; "root" -> "R_GlobalEnv" ; } > > # same since oo is parent of oo2 and oo3 > dot.proto(proto(oo2 = oo2, oo3 = oo3)) digraph G { graph [rankdir=BT]; "oo3" -> "root" ; "oo2" -> "root" ; } > > # In R, output dot commands to a file: > # dot.proto(file = "example.dot") > # Assuming GraphViz is installed, at > # the operating system command line level: > # dot -Tps example.dot -o example.ps > # or > # dot -Tjpg example.dot -o example.jpg > > > > cleanEx(); ..nameEx <- "proto" > > ### * proto > > flush(stderr()); flush(stdout()) > > ### Name: proto > ### Title: Prototype object-based programming > ### Aliases: proto as.proto as.proto.environment as.proto.list > ### as.proto.proto isnot.function is.proto $.proto $<-.proto . this .that > ### that .super super > ### Keywords: programming > > ### ** Examples > > oo <- proto(expr = {x = c(10, 20, 15, 19, 17) + location <- function(.) mean(.$x) # 1st arg is object + rms <- function(.) + sqrt(mean((.$x - .$location())^2)) + bias <- function(., b) .$x <- .$x + b + }) > > debug(oo$with(rms)) # cannot use oo$rms to pass method as a value > undebug(oo$with(rms)) # cannot use oo$rms to pass method as a value > > oo2 <- oo$proto( location = function(.) median(.$x) ) > oo2$rms() # note that first argument is omitted. [1] 3.633180 > oo2$ls() # list components of oo2 [1] "location" > oo2$as.list() # contents of oo2 as a list $location function (.) median(.$x) > oo2 # oo2 itself attr(,"class") [1] "proto" "environment" > oo2$parent.env() # same attr(,"class") [1] "proto" "environment" > oo2$parent.env()$as.list() # contents of parent of oo2 $bias function (., b) .$x <- .$x + b $rms function (.) sqrt(mean((.$x - .$location())^2)) $location function (.) mean(.$x) $x [1] 10 20 15 19 17 > oo2$print() attr(,"class") [1] "proto" "environment" > oo2$ls() [1] "location" > oo2$str() Classes 'proto', 'environment' length 3 > oo3 <- oo2 > oo2$identical(oo3) [1] TRUE > oo2$identical(oo) [1] FALSE > > # start off with Root to avoid problem cited in Note > Root <- proto() > oop <- Root$proto(a = 1, incr = function(.) .$a <- .$a+1) > ooc <- oop$proto(a = 3) # ooc is child of oop but with a=3 > ooc$incr() > ooc$a # 4 [1] 4 > > # same but proto overridden to force a to be specified > oop$proto <- function(., a) { .super$proto(., a=a) } > ## Not run: > ##D ooc2 <- oop$proto() # Error. Argument "a" is missing, with no default. > ## End(Not run) > ooc2 <- oop$proto(a = 10) > ooc2$incr() > ooc2$a # 11 [1] 11 > > o2 <- proto(a = 1, incr = function(.) .$a <- .$a+1) > o2c <- as.proto(o2$as.list()) # o2c is a clone of o2 > o2d <- o2$proto() # o2d is a delegate of o2 > o2$a <- 2 > o2c$a # a not changed by assignment in line above [1] 1 > o2d$a # a is changed since a not found in o2d so found in o2 [1] 2 > > > > > ### *