add r this week

sose2021/r/w07/P07-1.R

@@ -0,0 +1,14 @@
+# Josua Kugler, Christian Merten
+
+mem_near <- function(f_in) {
+    memo <- list(input=c(), value=c())
+    function(x, nearest) {
+        if (!nearest) {
+            memo$input <<- c(memo$input, x)
+            y <- f_in(x)
+            memo$value <<- c(memo$value, y)
+            return(y)
+        }
+        memo$value[apply(outer(memo$input, x, function(a, b)  abs(a-b)), 2, which.min)]
+    }
+}

sose2021/r/w07/P07-2.R

@@ -0,0 +1,79 @@
+# Josua Kugler, Christian Merten
+
+poly1 <- structure(
+  list(sides = c(2, 2, 2, 2), angles = c(pi/3, 2*pi/3, pi/3, 2*pi/3)),
+  class = c("Quadrilateral", "Polygon"))
+poly2 <- structure(
+  list(sides = c(3, 4, 3, 4), angles = rep(pi/2, 4)),
+  class = c("Rectangle", "Quadrilateral", "Polygon"))
+poly3 <- structure(
+  list(sides = c(2, 2, 2), angles = rep(pi/3, 3)),
+  class = c("Triangle", "Polygon"))
+poly4 <- structure(
+  list(sides = rep(1, 5), angles = rep(3/5*pi, 5)),
+  class = c("Polygon"))
+
+get_corners <- function(x) {
+  n <- length(x$sides)
+  if (n < 3) return(invisible(NULL))
+  out <- matrix(ncol = 2, nrow = length(x$sides))
+  direction <- c(1, 0)
+  point <- c(0, 0)
+  out[1, ] <- point
+  for (i in 1:(n-1)) {
+    point <- point + direction * x$sides[i]
+    out[i+1, ] <- point
+    a <- pi - x$angles[i]
+    direction <- matrix(c(cos(a), sin(a), -sin(a), cos(a)), ncol=2) %*% direction
+  }
+  out
+}
+
+plot_polygon <- function(x) {
+  corners <- get_corners(x)
+  plot(range(corners[,1]), range(corners[,2]), type = 'n', axes=FALSE, ann=FALSE, asp=1)
+  polygon(corners[,1], corners[,2], lwd = 3)
+}
+
+# a)
+plot.Polygon <- plot_polygon
+
+# b)
+Rectangle <- function(w, h) structure(
+    list(sides = c(w, h, w, h), angles = rep(pi/2, 4)),
+    class = c("Rectangle", "Quadrilateral", "Polygon"))
+
+Triangle <- function(s1, s2, a1) {
+    b <- sqrt(s1^2 + s2^2 - 2*s1*s2*cos(a1))
+    a2 <- acos((b^2 + s2^2 - s1^2)/(2 * s2 * b))
+    structure(list(sides = c(s1, s2, b),
+                   angles = c(a1, a2, 2*pi-a1-a2)),
+              class = c("Triangle", "Polygon"))
+}
+
+# c)
+validate_Triangle <- function(x) {
+    stopifnot("no triangle" = "Triangle" %in% class(x))
+    tri <- Triangle(x$sides[1], x$sides[2], x$angles[1])
+    stopifnot("side and angles do not fit" = identical(c(tri$angles, tri$sides), c(x$angles, x$sides)))
+}
+
+# d)
+circumference <- function(obj) {
+    UseMethod("circumference")
+}
+
+circumference.Polygon <- function(p) sum(p$sides)
+
+# e)
+area <- function(obj) {
+    UseMethod("area")
+}
+
+area.Triangle <- function(p) {
+    h <- p$sides[1] * sin(p$angles[1])
+    p$sides[2]*h*0.5
+}
+
+area.Quadrilateral <- function(p)
+    1/2 * (p$sides[1]*p$sides[4]*sin(p$angles[4]) + p$sides[2]*p$sides[3]*sin(p$angles[2]))

sose2021/r/w07/P07-3.R

@@ -0,0 +1,58 @@
+# Josua Kugler, Christian Merten
+
+library(R6)
+
+compass <- c("N", "E", "S", "W")
+movement <- list(N = c(0, 1), S = c(0, -1), W = c(-1, 0), E = c(1, 0))
+
+# helper because R indexing beginning at 1 is stupid
+get_dir <- function(k) {
+    compass[(k-1) %% 4 + 1]
+}
+
+arrow_coords <- function(n, coord) {
+    (coord + 0.5) / n
+}
+
+GridPath <- R6Class("GridPath", list(
+    path = matrix(c(0,0), nrow=1),
+    dir = character(0),
+    initialize = function(dir) {
+        self$dir <- dir
+    },
+    move = function(steps) {
+        if (steps == 0) return(invisible(self))
+        n <- nrow(self$path)
+        self$path <- rbind(self$path,
+                           self$path[n,] + movement[[self$dir]])
+        self$move(steps-1)
+    },
+    rotate_right = function() {
+        self$dir <- get_dir(which(self$dir == compass) + 1)
+        invisible(self)},
+    rotate_left = function() {
+        self$dir <- get_dir(which(self$dir == compass) - 1)
+        invisible(self)
+    },
+    print = function() {
+        n <- max(self$path)+1
+        grid <- matrix(rep(F, n^2), nrow=n)
+        apply(self$path, 1, function(r) grid[r[1]+1, r[2]+1] <<- T)
+        image(grid, useRaster=T, asp=T, col=c("white", "black"),
+              axes=F)
+        final <- self$path[nrow(self$path),]
+        print(final)
+        mv <- movement[[self$dir]]
+        coords <- c((final)/(n-1),
+                    (final + mv) / (n-1))
+        arrows(coords[1], coords[2], coords[3], coords[4], col="red")
+    }))
+
+gpath3 <- GridPath$new("N")
+gpath3$move(7)$
+    rotate_right()$move(8)$
+    rotate_right()$move(7)$
+    rotate_right()$move(6)$
+    rotate_right()$move(5)
+
+gpath3