2
0
Fork 0

add: sample Package

This commit is contained in:
Daniel Kapla 2019-06-21 11:40:57 +02:00
parent c948843817
commit 0a7f13920e
5 changed files with 118 additions and 0 deletions

1
LICENSE Normal file
View File

@ -0,0 +1 @@
GDPv2, GDPv3, MIT ????

14
samplePackage/DESCRIPTION Normal file
View File

@ -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

5
samplePackage/NAMESPACE Normal file
View File

@ -0,0 +1,5 @@
# Generated by roxygen2: do not edit by hand
export(area.circle)
exportClasses(circleS4)
exportClasses(rectangleS4)

40
samplePackage/R/S3.R Normal file
View File

@ -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)

58
samplePackage/R/S4.R Normal file
View File

@ -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)