diff --git a/sose2021/algebra/alg2.pdf b/sose2021/algebra/alg2.pdf new file mode 100644 index 0000000..202f6c1 Binary files /dev/null and b/sose2021/algebra/alg2.pdf differ diff --git a/sose2021/algebra/alg2.xopp b/sose2021/algebra/alg2.xopp new file mode 100644 index 0000000..09a470d Binary files /dev/null and b/sose2021/algebra/alg2.xopp differ diff --git a/sose2021/algebra/alg3.pdf b/sose2021/algebra/alg3.pdf new file mode 100644 index 0000000..267caee Binary files /dev/null and b/sose2021/algebra/alg3.pdf differ diff --git a/sose2021/algebra/alg3.xopp b/sose2021/algebra/alg3.xopp new file mode 100644 index 0000000..0425c7d Binary files /dev/null and b/sose2021/algebra/alg3.xopp differ diff --git a/sose2021/funktheo/funk2.pdf b/sose2021/funktheo/funk2.pdf new file mode 100644 index 0000000..ea5c13f Binary files /dev/null and b/sose2021/funktheo/funk2.pdf differ diff --git a/sose2021/funktheo/funk2.xopp b/sose2021/funktheo/funk2.xopp new file mode 100644 index 0000000..6a0fc41 Binary files /dev/null and b/sose2021/funktheo/funk2.xopp differ diff --git a/sose2021/r/w02/P02-1-exerc.R b/sose2021/r/w02/P02-1-exerc.R new file mode 100644 index 0000000..9a0ad24 --- /dev/null +++ b/sose2021/r/w02/P02-1-exerc.R @@ -0,0 +1,31 @@ +NUMERIC_TYPES <- c("double", "integer") + +lsq <- function(X, y) { + # TODO + stopifnot("X may not be empty" = length(X) > 0) + stopifnot("y may not be empty" = length(y) > 0) + stopifnot("X must be numeric" = typeof(X) %in% NUMERIC_TYPES) + stopifnot("y must be numeric" = typeof(y) %in% NUMERIC_TYPES) + stopifnot("X must be matrix" = is.matrix(X)) + stopifnot("y must be vector or matrix with one column" = is.vector(y) || (is.matrix(y) && ncol(y) == 1)) + stopifnot("dimensions of X and y do not fit" = (is.vector(y) && nrow(X) == length(y)) || (is.matrix(y) && nrow(y) == nrow(X))) + stopifnot("y may not contain NA" = all(!is.na(y))) + stopifnot("X may not contain NA" = all(!is.na(X))) + A <- t(X) %*% X + stopifnot("det(t(X) %*% X) must not be zero" = det(A) != 0) + solve(A, t(X) %*% y) +} + +lsq(matrix(1:6, nrow=3), 1:3) +lsq(matrix(runif(6), nrow=3), matrix(runif(3), ncol=1)) +lsq(matrix(letters[1:6] , nrow=2), 1:3) +lsq(matrix(1:6, nrow=3), list(1,2,3)) +lsq(1:6, 1:3) +lsq(matrix(1:6, nrow=3), array(1:3, dim=c(1,1,3))) +lsq(matrix(1:6, nrow=3), 1:4) +lsq(matrix(1:6, nrow=3), matrix(1:3, nrow=1)) +lsq(matrix(1:6, nrow=3), matrix(1:6, nrow=3)) +lsq(matrix(double(0), nrow=0, ncol=0), matrix(double(0), nrow=0, ncol=0)) +lsq(matrix(1:6, nrow=3), c(1,NA,3)) +lsq(matrix(c(1:5, NA), nrow=3), 1:3) +lsq(matrix(c(1,1,2,1,1,2), nrow=3), 1:3) diff --git a/sose2021/r/w02/P02-2-exerc.R b/sose2021/r/w02/P02-2-exerc.R new file mode 100644 index 0000000..a0e25b8 --- /dev/null +++ b/sose2021/r/w02/P02-2-exerc.R @@ -0,0 +1,35 @@ +my_matrix <- function(vec, nrow=NULL, ncol=NULL, colnames=NULL, rownames=NULL) { + stopifnot("at least one of nrow or ncol has to be specified" = !is.null(nrow) || !is.null(ncol)) + if (is.null(nrow)) { + stopifnot("incompatible length" = length(vec) %% ncol == 0) + nrow <- length(vec) / ncol + } else if (is.null(ncol)) { + stopifnot("incompatible length" = length(vec) %% nrow == 0) + ncol <- length(vec) / nrow + } else if (length(vec) == 1) { + vec <- rep(vec, nrow * ncol) + } else stopifnot("incompatible length" = length(vec) == nrow * ncol) + + dim(vec) <- c(nrow, ncol) + stopifnot("lenght of colnames must be ncol" = is.null(colnames) || length(colnames) == ncol) + stopifnot("lenght of rownames must be nrow" = is.null(rownames) || length(rownames) == nrow) + dimnames(vec) <- list(rownames, colnames) + return(vec) +} + +my_matrix(1:6) +my_matrix(1:6, ncol=1) +my_matrix(1:6, ncol=2) +my_matrix(1:6, ncol=3) +my_matrix(1:6, ncol=6) +my_matrix(1:6, ncol=4) +my_matrix(1:6, nrow=2) +my_matrix(1:6, nrow=7) +my_matrix(1:6, ncol=2, nrow=2) +my_matrix(1:6, ncol=2, nrow=3) +my_matrix(1:6, ncol=2, nrow=1) +my_matrix(0, ncol=3, nrow=2) +my_matrix(1:6, ncol=3, colnames=LETTERS[1:3]) +my_matrix(1:6, ncol=3, colnames=LETTERS[1:2]) +my_matrix(1:6, ncol=3, rownames=letters[24 + 1:2]) +my_matrix(1:6, ncol=3, colnames=LETTERS[1:3], rownames=letters[24 + 1:2]) diff --git a/sose2021/r/w02/P02-3-exerc.R b/sose2021/r/w02/P02-3-exerc.R new file mode 100644 index 0000000..1467fe6 --- /dev/null +++ b/sose2021/r/w02/P02-3-exerc.R @@ -0,0 +1,22 @@ +my_tibble <- function(data) { + attr(data, "row.names") <- (1:lengths(data)[1]) + attr(data, "class") <- c("tbl_df", "tbl", "data.frame") + return(data) +} + +library(tibble) +my_tb <- my_tibble(list(x=1:3, y=letters[1:3])) +tb <- tibble(x=1:3 , y=letters[1:3]) +identical(tb, my_tb) + +my_factor <- function(data) { + lvls <- unique(data) + vec <- sapply(data, function(x) match(x, lvls), USE.NAMES=FALSE) + attr(vec, "levels") <- lvls + attr(vec, "class") <- "factor" + return(vec) +} + +my_fac <- my_factor (c("a", "b", "a", "a", "c", "c")) +fac <- factor(c("a", "b", "a", "a", "c", "c")) +identical(fac, my_fac) diff --git a/sose2021/r/w02/P02-4-exerc.R b/sose2021/r/w02/P02-4-exerc.R new file mode 100644 index 0000000..496ed94 --- /dev/null +++ b/sose2021/r/w02/P02-4-exerc.R @@ -0,0 +1,56 @@ +collatz <- function(raw_x, max_iter) { + stopifnot("Length of x must be 1" = length(raw_x) == 1) + x <- as.integer(raw_x) + stopifnot("Cannot interprete x as integer" = !is.na(x)) + sequ <- c(x) + len <- NA + for (n in (1:(max_iter-1))) { + if (x == 1) { + len <- n + break + } else if (x %% 2 == 0) { + x <- x / 2 + } else { + x <- 3*x+1 + } + sequ <- c(sequ, x) + } + return(list(seq=sequ, len=len)) +} + +str(collatz(1, 1e4)) +## List of 2 +## $ seq: int 1 +## $ len: int 1 +str(collatz(2, 1e4)) +## List of 2 +## $ seq: int [1:2] 2 1 +## $ len: int 2 +str(collatz(3, 1e4)) +## List of 2 +## $ seq: int [1:8] 3 10 5 16 8 4 2 1 +## $ len: int 8 +str(collatz(3, 5)) +## List of 2 +## $ seq: int [1:5] 3 10 5 16 8 +str(collatz("4", 1e4)) +## List of 2 +## $ seq: int [1:3] 4 2 1 +## $ len: int 3 +str(collatz("four", 1e4)) +## Warning in collatz("four", 10000): NAs introduced by coercion +## Error in collatz("four", 10000): Cannot interprete x as integer +str(collatz(1:5, 1e4)) +## Error in collatz(1:5, 10000): Length of x must be 1 +str(collatz(5.0, 1e4)) +## List of 2 +## $ seq: int [1:6] 5 16 8 4 2 1 +## $ len: int 6 +str(collatz(5.1, 1e4)) +## List of 2 +## $ seq: int [1:6] 5 16 8 4 2 1 +## $ len: int 6 +str(collatz(5.9, 1e4)) +## List of 2 +## $ seq: int [1:6] 5 16 8 4 2 1 +## $ len: int 6 diff --git a/sose2021/r/w03/P03-1.R b/sose2021/r/w03/P03-1.R new file mode 100644 index 0000000..54ef103 --- /dev/null +++ b/sose2021/r/w03/P03-1.R @@ -0,0 +1,8 @@ +# Josua Kugler, Christian Merten + +`%o%` <- function(f, g) { + comp <- function(...) { + return(f(g(...))) + } + return(comp) +} diff --git a/sose2021/r/w03/P03-2.R b/sose2021/r/w03/P03-2.R new file mode 100644 index 0000000..790c821 --- /dev/null +++ b/sose2021/r/w03/P03-2.R @@ -0,0 +1,37 @@ +# Josua Kugler, Christian Merten + +n_diag <- function(mat, n) { + stopifnot("Matrix not quadratic" = nrow(mat) == ncol(mat)) + stopifnot("Matrix does not have such a (sub)diagonal" = abs(n) < nrow(mat)) + dg <- c() + for (i in (1:(nrow(mat)-abs(n)))) { + elem <- if (n > 0) { + mat[i, i+n] + } else { + mat[i+abs(n), i] + } + dg <- c(dg, elem) + } + return(dg) +} + +`n_diag<-` <- function(x, value, n) { + stopifnot("Matrix not quadratic" = nrow(mat) == ncol(mat)) + stopifnot("Matrix does not have such a (sub)diagonal" = abs(n) < nrow(mat)) + stopifnot("Subdiagonal length and replacement do not match" = length(value) == nrow(mat) - abs(n)) + for (i in (1:(nrow(mat)-abs(n)))) { + elem <- if (n > 0) { + mat[i, i+n] <- value[i] + } else { + mat[i+abs(n), i] <- value[i] + } + } + return(mat) +} + +mat <- matrix(1:16, nrow=4) +print(mat) +print(n_diag(mat, 2)) + +n_diag(mat, -3) <- 1 +print(mat) diff --git a/sose2021/r/w03/P03-3.R b/sose2021/r/w03/P03-3.R new file mode 100644 index 0000000..2549c08 --- /dev/null +++ b/sose2021/r/w03/P03-3.R @@ -0,0 +1,172 @@ +# Josua Kugler, Christian Merten + +## 1. + +size <- function(mat) { + return(attr(mat, "size")) +} + +`size<-` <- function(x, value) { + attributes(x)$size <- value + return(x) +} + + +## 2. + +sudoku <- function(mat, n=NULL, m=NULL) { + attributes(mat)$class <- "sudoku" + if (!is.matrix(mat)) { + stopifnot("If mat is not a matrix, at n and m have to be specified" = !is.null(n) && !is.null(m)) + mat <- matrix(mat, nrow=n*m) + } else if (is.null(n)) { + n <- nrow(mat) / m + } else if (is.null(m)) { + m <- nrow(mat) / n + } + size(mat) <- c(n, m) + return(mat) +} + + +## 3. + +is_sudoku <- function(s) { + if (is.null(size(s))) { + return(FALSE) + } + n <- size(s)[1] + m <- size(s)[2] + checks <- c(nrow(s) == ncol(s), + nrow(s) == n*m, + attr(s, "class") == "sudoku", + s %in% c(NA, (1:(n*m)))) + return(all(checks)) +} + + + +## 4. + +is_sub_valid <- function(x) { + dups <- any(duplicated(x)) + in_range <- all(x %in% c(NA, (1:length(x)))) + return(in_range && !dups) +} + + + +## 5. + +partition_index <- function(n, m) { + m1 <- matrix(rep(1:(n*m), each=n), nrow=n*m) + m2 <- m1[, rep(1:n, each=m)] + return(m2) +} +partition_index(3,2) + + + +## 6. + +is_valid <- function(s) { + stopifnot("s is not a sudoku!" = is_sudoku(s)) + n <- size(s)[1] + m <- size(s)[2] + rows_valid <- sapply(1:(n*m), function(r) is_sub_valid(s[r,])) + cols_valid <- sapply(1:(n*m), function(c) is_sub_valid(s[,c])) + part <- partition_index(n, m) + fields_valid <- sapply(1:(n*m), function(i) is_sub_valid(s[part == i])) + return(all(c(fields_valid, cols_valid, fields_valid))) +} + +is_filled_in <- function(s) { + return(!any(is.na(s))) +} + +is_solved <-function(s) { + return(is_valid(s) && is_filled_in(s)) +} + + +## 7. + +is_solution_of <- function(s, s_star) { + return(is_solved(s_star) && all(s == s_star, na.rm=TRUE)) +} + + +## 8. + +print_non_valid <- function(s, print_missing=T) { + stopifnot("s is not a sudoku!" = is_sudoku(s)) + if (print_missing) { + apply(which(is.na(s), arr.ind=T), 1, function(x) cat("missing value at ", x[1], ",", x[2], "\n", sep="")) + } + n <- size(s)[1] + m <- size(s)[2] + rows_invalid <- which(sapply(1:(n*m), function(r) !is_sub_valid(s[r,]))) + sapply(rows_invalid, function(x) cat("row ", + x, + " is invalid\n", + sep="")) + cols_invalid <- which(sapply(1:(n*m), function(c) !is_sub_valid(s[,c]))) + sapply(cols_invalid, function(x) cat("column ", + x, + " is invalid\n", + sep="")) + part <- partition_index(n, m) + fields <- matrix(1:(n*m), nrow=m) + fields_invalid <- which(apply(fields, c(1,2), function(i) !is_sub_valid(s[part == i])), arr.ind=T) + if (length(fields_invalid) > 0) { + sapply(1:nrow(fields_invalid), function(r) cat("field ", + fields_invalid[r,1], + ",", + fields_invalid[r,2], + " is invalid\n", + sep="")) + } + invisible(NULL) +} + + + +## TEST + +x <- matrix( + c(5,2,6,4,3,1,6,1,3,2,5,4,3,4,1,5,2,6,2,6,4,3,1,5,1,3,5,6,4,2,4,5,2,1,6,3), + ncol = 6) +is_sudoku(x) + +s <- sudoku(x, 3, 2) +s +size(s) +is_sudoku(s) +is_filled_in(s) +is_valid(s) +is_solved(s) +print_non_valid(s) + +size(s) <- c(2, 3) +is_sudoku(s) +is_filled_in(s) +is_valid(s) +is_solved(s) + +s_na <- s +s_na[sample(36, 18)] <- NA +s_na +is_sudoku(s_na) +is_filled_in(s_na) +is_valid(s_na) +is_solved(s_na) +print_non_valid(s_na) + +s_not <- sudoku(sample(1:6, 36, replace=T), 2, 3) +s_not[sample(36, 18)] <- NA +s_not +is_sudoku(s_not) +is_filled_in(s_not) +is_valid(s_not) +is_solved(s_not) +print_non_valid(s_not, print_missing=FALSE) diff --git a/sose2021/tut-ana/praesenz-2.pdf b/sose2021/tut-ana/praesenz-2.pdf new file mode 100644 index 0000000..5866787 Binary files /dev/null and b/sose2021/tut-ana/praesenz-2.pdf differ diff --git a/sose2021/tut-ana/praesenz-2.xopp b/sose2021/tut-ana/praesenz-2.xopp new file mode 100644 index 0000000..905b314 Binary files /dev/null and b/sose2021/tut-ana/praesenz-2.xopp differ