R

setClass("shape",
   representation(x="numeric", y="numeric"),
   prototype(x=0, y=0)
)

# accessors for x & y
setGeneric("getX", function(this) standardGeneric("getX"))
setMethod("getX", "shape",
   function(this) {
      this@x
   }
)
setGeneric("getY", function(this) standardGeneric("getY"))
setMethod("getY", "shape",
   function(this) {
      this@y
   }
)
setGeneric("setX<-", function(this, value) standardGeneric("setX<-"))
setReplaceMethod("setX", "shape",
   function(this, value) {
      this@x <- value
      this
   }
)
setGeneric("setY<-", function(this, value) standardGeneric("setY<-"))
setReplaceMethod("setY", "shape",
   function(this, value) {
      this@y <- value
      this
   }
)

# move the x & y position of the object
setGeneric("moveTo<-", function(this, value) standardGeneric("moveTo<-"))
setReplaceMethod("moveTo", "shape",
   function(this, value) {
      setX(this) <- value[1]
      setY(this) <- value[2]
      this
   }
)
setGeneric("rMoveTo<-", function(this, value) standardGeneric("rMoveTo<-"))
setReplaceMethod("rMoveTo", "shape",
   function(this, value) {
      moveTo(this) <- value + c(getX(this), getY(this))
      this
   }
)

# virtual draw method
setGeneric("draw", function(this) standardGeneric("draw"))

setClass("rectangle",
   representation(width="numeric", height="numeric"),
   prototype(width=0, height=0),
   contains=("shape")
)

# accessors for the width & height
setGeneric("getWidth",  function(this) standardGeneric("getWidth"))
setMethod("getWidth",  "rectangle",
   function(this) {
      this@width
   }
)
setGeneric("getHeight", function(this) standardGeneric("getHeight"))
setMethod("getHeight", "rectangle",
   function(this) {
      this@height
   }
)
setGeneric("setWidth<-", function(this, value) standardGeneric("setWidth<-"))
setReplaceMethod("setWidth", "rectangle",
   function(this, value) {
      this@width <- value
      this
   }
)
setGeneric("setHeight<-", function(this, value) standardGeneric("setHeight<-"))
setReplaceMethod("setHeight", "rectangle",
   function(this, value) {
      this@height <- value
      this
   }
)

# draw the rectangle
setMethod("draw", "rectangle",
   function(this) {
      print(sprintf("Drawing a Rectangle at:(%g,%g), width %g, height %g",
         getX(this), getY(this), getWidth(this), getHeight(this)))
   }
)

setClass("circle",
   representation(radius="numeric"),
   prototype(radius=0),
   contains=("shape")
)

# accessors for the radius
setGeneric("getRadius", function(this) standardGeneric("getRadius"))
setMethod("getRadius", "circle",
   function(this) {
      this@radius
   }
)
setGeneric("setRadius<-", function(this, value) standardGeneric("setRadius<-"))
setReplaceMethod("setRadius", "circle",
   function(this, value) {
      this@radius <- value
      this
   }
)

# draw the circle
setMethod("draw", "circle",
   function(this) {
      print(sprintf("Drawing a Circle at:(%g,%g), radius %g",
         getX(this), getY(this), getRadius(this)))
   }
)

tryMe <- function() {
   # set up some shape instances
   scribble <- list(new("rectangle", x=10, y=20, width=5, height=6),
                    new("circle", x=15, y=25, radius=8))

   # iterate through the array and handle shapes polymorphically
   for (each in scribble) {
      draw(each)
      rMoveTo(each) <- c(100, 100)
      draw(each)
   }

   # access a rectangle specific function
   arect <- new("rectangle", x=0, y=0, width=15, height=15)
   setWidth(arect) <- 30
   draw(arect)
}
tryMe()

source("shape.r")
source("rectangle.r")
source("circle.r")
source("polymorph.r")

[1] "Drawing a Rectangle at:(10,20), width 5, height 6"
[1] "Drawing a Rectangle at:(110,120), width 5, height 6"
[1] "Drawing a Circle at:(15,25), radius 8"
[1] "Drawing a Circle at:(115,125), radius 8"
[1] "Drawing a Rectangle at:(0,0), width 30, height 15"