From 0a7f13920eb517e3483cd8c8f9bd9d2fecfd66e0 Mon Sep 17 00:00:00 2001 From: daniel Date: Fri, 21 Jun 2019 11:40:57 +0200 Subject: [PATCH] add: sample Package --- LICENSE | 1 + samplePackage/DESCRIPTION | 14 ++++++++++ samplePackage/NAMESPACE | 5 ++++ samplePackage/R/S3.R | 40 +++++++++++++++++++++++++++ samplePackage/R/S4.R | 58 +++++++++++++++++++++++++++++++++++++++ 5 files changed, 118 insertions(+) create mode 100644 LICENSE create mode 100644 samplePackage/DESCRIPTION create mode 100644 samplePackage/NAMESPACE create mode 100644 samplePackage/R/S3.R create mode 100644 samplePackage/R/S4.R diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..d4a44af --- /dev/null +++ b/LICENSE @@ -0,0 +1 @@ +GDPv2, GDPv3, MIT ???? diff --git a/samplePackage/DESCRIPTION b/samplePackage/DESCRIPTION new file mode 100644 index 0000000..9d8025a --- /dev/null +++ b/samplePackage/DESCRIPTION @@ -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 diff --git a/samplePackage/NAMESPACE b/samplePackage/NAMESPACE new file mode 100644 index 0000000..0131a61 --- /dev/null +++ b/samplePackage/NAMESPACE @@ -0,0 +1,5 @@ +# Generated by roxygen2: do not edit by hand + +export(area.circle) +exportClasses(circleS4) +exportClasses(rectangleS4) diff --git a/samplePackage/R/S3.R b/samplePackage/R/S3.R new file mode 100644 index 0000000..118d12d --- /dev/null +++ b/samplePackage/R/S3.R @@ -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("\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) diff --git a/samplePackage/R/S4.R b/samplePackage/R/S4.R new file mode 100644 index 0000000..e2c3607 --- /dev/null +++ b/samplePackage/R/S4.R @@ -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("\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)