From 0a7f13920eb517e3483cd8c8f9bd9d2fecfd66e0 Mon Sep 17 00:00:00 2001
From: daniel <daniel@kapla.at>
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("<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)
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("<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)