This brief tutorial illustrates how to combine S4 object oriented capabilities with function closures in order to develop classes with built in methods. Thanks to

Hadley Wickhamfor the great contribution of material and tutorials made available on the web and toBill VenablesandStefano Iacusfor their kind reviews.

## Regular polygons

As Wikipedia states:

In Euclidean geometry, a regular polygon is a polygon that is equiangular (all angles are equal in measure) and equilateral (all sides have the same length). Square, pentagon, hexagon are regular polygons.

In order to define a regular polygon we need to state the number of sides the polygon is made of (n) and the dimension of its side (s).

## S4

We want to define a define a simple S4 based system to create and plot of regular polygons.

As a first step we define a very simple class for regular polygons, say rolygon, as:

1 2 3 |
> setClass("rolygon", representation(n = "numeric", + s = "numeric")) |

In order to plot our rolygons we need a plot method for class rolygon. By mean of basic trigonometry we get:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 |
> setMethod(f = "plot", signature = "rolygon", + definition = function(x, y) { + object = x + s = object@s + n = object@n + rho = (2*pi)/n + h = .5*s*tan((pi/2)-(pi/n)) + r = sqrt(h^2+(s/2)^2) + sRho = ifelse(n %% 2 == 0, + (pi/2- rho/2), pi/2) + cumRho = cumsum(c(sRho, rep(rho, n))) + cumRho = ifelse(cumRho > 2*pi, + cumRho-2*pi, cumRho) + x = r*cos(cumRho) + y = r*sin(cumRho) + par(pty = "s") + plot(x, y, type = "n", xlab = "", ylab = "") + lines(x, y, col = "red", lwd = 2) + points(0, 0, pch = 16, col = "red") + grid() + invisible(NULL) + }) [1] "plot" |

And, as a result:

1 2 |
> plot(new("rolygon", n = 5, s = 2)) |

## Function Closures

The *R Language Definition* manual states:

Functions ... have three basic components: a formal argument list, a body and an environment. A function’s environment is the environment that was active at the time that the function was created. Any symbols bound in that environment are captured and available to the function. This combination of the code of the function and the bindings in its environment is called a 'function closure', a term from functional programming theory.

Moreover, any time a function is called, a new environment is created, whose enclosure is the environment where the function was defined. The computation, as expressed by the body of the function, occurs in the newly created environment. Thus, whenever we call a function we have at least two environments: the environment the function was defined in and the environment where the function evaluation takes place.

By using this idea, we can define a function `f()`

that returns a function `g()`

. As `g()`

is created within the evaluation environment of `f()`

, this last environment is the enclosure of `g()`

. Therefore, `g()`

remembers all symbols bound in that environment.

As a practical application of this idea consider this function:

1 2 3 4 5 |
> f <- function(x) { + g = function(y){x+y} + g } |

As `g()`

is created within the evaluation environment of `f()`

, `g()`

"remembers" the value of x. Therefore we can define a simple function `f1()`

that adds one to the given `y`

argument as:

1 2 3 |
> f1 <- f(x = 1) > f1(y = 3) |

Note that `f1()`

remembers the value of `x`

. As a result:

1 2 3 4 5 |
> ls(env=environment(f1)) [1] "g" "x" > get("x", env=environment(f1)) [1] 1 |

The environment of `f1()`

can be directly accessed and manipulated:

1 2 3 4 |
> environment(f1)$x <- 0 > f1(1) [1] 1 |

Clearly, the same exercise apply to any `fx()`

as:

1 2 3 4 |
> f99 <- f(99) > f99(y = 1) [1] 100 |

Clearly this is a good way to avoid code duplication.

## Putting all together

Finally, the combination of the two previous ideas allows quite interesting coding techniques.

In this case we want to generate a set of functions each of them returning a regular polygon: square, pentagon, etc ..., with a built in `plot`

method.

Thus, we first define a `rolygon()`

function that returns a generic `f()`

capable of generating specific regular polygons with plot method inherited from rolygon's environment:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 |
> rolygon <- function(n) { + + # Define rolygon class + setClass("rolygon", representation( + n = "numeric", s = "numeric")) + + # Define a plot method for object of class rolygon + setMethod(f = "plot", signature = "rolygon", + definition = function(x, y){ + object <- x + s <- object@s + n <- object@n + pi <- base::pi + rho <- (2*pi)/n + h <- .5*s*tan((pi/2)-(pi/n)) + r <- sqrt(h^2+(s/2)^2) + sRho <- ifelse(n %% 2 == 0, + (pi/2- rho/2), pi/2) + cumRho <- cumsum(c(sRho, rep(rho, n))) + cumRho <- ifelse(cumRho > 2*pi, + cumRho-2*pi, cumRho) + x <- r*cos(cumRho) + y <- r*sin(cumRho) + par(pty = "s") + plot(x, y, type = "n", xlab = "", + ylab = "") + lines(x, y, col = "red", lwd = 2) + points(0, 0, pch = 16, col = "red") + grid() + invisible(NULL) + }) + + # Define a function that returns an object + # of class rolygon + f <- function(s){new("rolygon", n = n, + s = s)} + + # Return the newly created function + return(f) + } |

Note that class `rolygon`

, its `plot`

method and `f()`

are all defined within the evaluation environment of `rolygon()`

. When `rolygon()`

is evaluated, `f()`

is returned and `f()`

remembers about class `rolygon`

and its plotting method.

As a result, we can define an `heptagon()`

function as:

1 2 |
> heptagon <- rolygon(n = 7) |

a specific heptagon of `side = 1`

becomes:

1 2 |
> e1 <- heptagon(1) |

as `heptagon()`

has a `plot`

method built in, we only need:

1 2 |
> plot(e1) |

Finally with a bit of imagination:

1 2 3 |
> circumference <- rolygon(n = 10^4) > plot(circumference(s = base::pi/10^4)) |

View (and download) the full code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 |
### Function Closures and S4 Methods ### Andrea Spano', andrea.spano@quantide.com ### www.milanor.net ### setClass setClass("rolygon", representation(n = "numeric", s = "numeric")) ### setMethod setMethod(f = "plot", signature = "rolygon", definition = function(x, y){ object = x s = object@s n = object@n rho = (2*pi)/n h = .5*s*tan((pi/2)-(pi/n)) r = sqrt(h^2+(s/2)^2) sRho = ifelse(n %% 2 == 0, (pi/2- rho/2), pi/2) cumRho = cumsum(c(sRho, rep(rho, n))) cumRho = ifelse(cumRho > 2*pi, cumRho-2*pi, cumRho) x = r*cos(cumRho) y = r*sin(cumRho) par(pty = "s") plot(x, y, type = "n", xlab = "", ylab = "") lines(x, y, col = "red", lwd = 2) points(0, 0, pch = 16, col = "red") grid() invisible(NULL) }) ### rolygon plot(new("rolygon", n = 5, s = 2)) ### f f <- function(x) { g = function(y){x+y} g } ### f1 f1 <- f(x = 1) f1(y = 3) ### ls ls(env=environment(f1)) get("x", env=environment(f1)) ### environment environment(f1)$x <- 0 f1(1) ### f99 f99 <- f(99) f99(y = 1) ### rolygon rolygon <- function(n) { # Define rolygon class setClass("rolygon", representation( n = "numeric", s = "numeric")) # Define a plot method for object of class rolygon setMethod(f = "plot", signature = "rolygon", definition = function(x, y){ object <- x s <- object@s n <- object@n pi <- base::pi rho <- (2*pi)/n h <- .5*s*tan((pi/2)-(pi/n)) r <- sqrt(h^2+(s/2)^2) sRho <- ifelse(n %% 2 == 0, (pi/2- rho/2), pi/2) cumRho <- cumsum(c(sRho, rep(rho, n))) cumRho <- ifelse(cumRho > 2*pi, cumRho-2*pi, cumRho) x <- r*cos(cumRho) y <- r*sin(cumRho) par(pty = "s") plot(x, y, type = "n", xlab = "", ylab = "") lines(x, y, col = "red", lwd = 2) points(0, 0, pch = 16, col = "red") grid() invisible(NULL) }) # Define a function that returns an object # of class rolygon f <- function(s){new("rolygon", n = n, s = s)} # Return the newly created function return(f) } ### heptagon heptagon <- rolygon(n = 7) e1 <- heptagon(1) plot(e1) ### circumference circumference <- rolygon(n = 10^4) plot(circumference(s = base::pi/10^4)) |

The "PDF" button below allows you to get a copy of this post. If you're looking for a nice and "R-style" formatted PDF version of this article, please click here.

Hi, there, you can use "rsplus", in the pre tag, and the source code can be highlighted as described in http://ygc.name/2010/10/11/highlight-r-syntax-in-wordpress/

Dear ygc, thanks for your suggestion. As you can see from the first code block, using "rsplus" in the pre tag highlight the R code but add some (wrong) links.

Yes, the plugin does not link keywords properly.

Maybe you like this one: http://ygc.name/2012/12/06/highlight-code-as-pretty-r/ . The modified version of rsplus that links the keywords to insideR. It works fine.

There are some caveats, which I found recently. Consider the following example:

f <- function(x) {

g = function(y){x+y}

g

}

aa <- vector("list", 4)

`for(i in 1:4) aa[[i]] <- f(i)`

Now what is the answer for aa[[1]](1)? You would think that 2, but it will be 5. The reason is that R evaluates x only when you call function. For all the 4 functions, x evaluates to i. When you call aa[[1]](1) R searches for i and founds it equal to 4, since that is the last value i had. So it makes sense to forcibly evaluate x before the definition of g:

f<-function(x) {

force(x)

g <- function(y) {x+y}

g

}

See the manual of force.