59 lines
1.4 KiB
R
59 lines
1.4 KiB
R
|
library(methods)
|
||
|
|
|
||
|
|
## Class definitions
|
||
|
|
|
||
|
|
#' Represents a circle shape
|
||
|
|
#'
|
||
|
|
#' @param r radius of the circle
|
||
|
|
#'
|
||
|
|
#' @returns S4 object
|
||
|
|
#' @export
|
||
|
|
circleS4 <- setClass("circleS4", slots = list(r = "numeric"))
|
||
|
|
|
||
|
|
#' Represents a rectangle shape
|
||
|
|
#'
|
||
|
|
#' @param w width of the rectangle
|
||
|
|
#' @param h height of the rectangle
|
||
|
|
#'
|
||
|
|
#' @returns S4 object
|
||
|
|
#' @export
|
||
|
|
rectangleS4 <- setClass("rectangleS4", slots = list(w = "numeric", h = "numeric"))
|
||
|
|
|
||
|
|
|
||
|
|
## setting class methods
|
||
|
|
# redefine generic methods
|
||
|
|
setMethod("show", "circleS4", function(object) {
|
||
|
|
cat("< circle r =", object@r, ">\n")
|
||
|
|
})
|
||
|
|
setMethod("show", signature="rectangleS4", function(object) {
|
||
|
|
cat("<rectangle w =", rect@w, ", h =", rect@h, ">\n", set="")
|
||
|
|
})
|
||
|
|
|
||
|
|
## define new generics for class assignement
|
||
|
|
# create a method to assign the value of a coordinate
|
||
|
|
setGeneric("area", def = function(object) standardGeneric("area") )
|
||
|
|
setGeneric(name = "diam", def = function(object) {
|
||
|
|
standardGeneric("diam")
|
||
|
|
})
|
||
|
|
|
||
|
|
## assigne (custom) generics implementation to classes
|
||
|
|
setMethod("area", "circleS4", function(object) pi * object@r^2)
|
||
|
|
setMethod("diam", "circleS4", function(object) 2 * object@r)
|
||
|
|
|
||
|
|
setMethod("area", signature=list(object = "rectangleS4"), function(object) {
|
||
|
|
object@w * object@h
|
||
|
|
})
|
||
|
|
setMethod("diam", signature=list(object = "rectangleS4"), function(object) {
|
||
|
|
sqrt(rect@w^2 + rect@h^2)
|
||
|
|
})
|
||
|
|
|
||
|
|
# usage
|
||
|
|
circ <- circleS4(r = 2)
|
||
|
|
rect <- rectangleS4(w = 1, h = 2)
|
||
|
|
|
||
|
|
print(area(circ))
|
||
|
|
print(diam(rect))
|
||
|
|
|
||
|
|
print(circ)
|
||
|
|
print(rect)
|