add: sample Package
This commit is contained in:
parent
c948843817
commit
0a7f13920e
|
@ -0,0 +1,14 @@
|
|||
Package: samplePackage
|
||||
Title: A Sample for creating R Packages
|
||||
Version: 0.0.0.0001
|
||||
Authors@R:
|
||||
person(given = "First",
|
||||
family = "Last",
|
||||
role = c("aut", "cre"),
|
||||
email = "first.last@example.com",
|
||||
comment = structure("YOUR-ORCID-ID", .Names = "ORCID"))
|
||||
Description: What the package does (one paragraph).
|
||||
License: What license it uses
|
||||
Encoding: UTF-8
|
||||
LazyData: true
|
||||
RoxygenNote: 6.1.1
|
|
@ -0,0 +1,5 @@
|
|||
# Generated by roxygen2: do not edit by hand
|
||||
|
||||
export(area.circle)
|
||||
exportClasses(circleS4)
|
||||
exportClasses(rectangleS4)
|
|
@ -0,0 +1,40 @@
|
|||
|
||||
# Constructors
|
||||
circle <- function(r) structure(list(r=r), class="circle")
|
||||
rectangle <- function(a, b) {
|
||||
# equivalent to > structure(list(a=a, b=b), class="rectangle")
|
||||
x <- list(a=a, b=b)
|
||||
class(x) <- "rectangle"
|
||||
x # return
|
||||
}
|
||||
|
||||
# generics (custom)
|
||||
area <- function(shape) UseMethod("area")
|
||||
diam <- function(shape) UseMethod("diam")
|
||||
|
||||
# methods (implementation)
|
||||
print.circle <- function(circle, ...) with(circle, cat("< circle r =", r, ">\n"))
|
||||
#' Computes area of a circle object
|
||||
#'
|
||||
#' @param circle Instance of a circle.
|
||||
#'
|
||||
#' @returns Area of the given \code{circle}.
|
||||
#' @export
|
||||
area.circle <- function(circle) with(circle, pi * r^2)
|
||||
diam.circle <- function(circle) with(circle, 2 * r)
|
||||
|
||||
print.rectangle <- function(rect, ...) {
|
||||
cat("<rectangle a =", rect$a, ", b =", rect$b, ">\n", set="")
|
||||
}
|
||||
area.rectangle <- function(rect) rect$a * rect$b
|
||||
diam.rectangle <- function(rect) sqrt(rect$a^2 + rect$b^2)
|
||||
|
||||
# usage
|
||||
circ <- circle(2)
|
||||
rect <- rectangle(a = 1, b = 2)
|
||||
|
||||
print(area(circ))
|
||||
print(diam(rect))
|
||||
|
||||
print(circ)
|
||||
print(rect)
|
|
@ -0,0 +1,58 @@
|
|||
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)
|
Loading…
Reference in New Issue