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