Add R tab to randomness test design (Yahtzee)

content/code/R/yahtzee.R

@@ -0,0 +1,35 @@
+#' Roll a fair die num_dice times.
+#' Collect as many of the same dice side as possible.
+#'
+#' @return A vector of die throw results
+roll_dice <- function(num_dice) {
+  ceiling(runif(num_dice, 0, 6))
+}
+
+#' Play yahtzee with 5 6-sided dice and 3 throws.
+#' Collect as many of the same dice side as possible.
+#'
+#' @return The number of same sides
+yahtzee <- function() {
+  res <- roll_dice(5)
+  most_common_side <- as.numeric(names(table(res)[which.max(table(res))]))[1]
+  how_often <- as.vector(table(res)[which.max(table(res))])[1]
+
+  # we keep the most common side
+  target_side <- most_common_side
+  num_same_sides <- how_often
+  if (num_same_sides == 5) {
+    return(5)
+  }
+
+  # second and third throw
+  for (i in 2:3) {
+    throw <- roll_dice(5 - num_same_sides)
+    num_same_sides <- num_same_sides + sum(throw == target_side)
+
+    if (num_same_sides == 5) {
+      return(5)
+    }
+  }
+  return(num_same_sides)
+}

content/code/R/yahtzee_sol.R

@@ -0,0 +1,18 @@
+if (!require(testthat)) install.packages(testthat)
+
+test_that("dice is working", {
+  set.seed(42)
+  expect_equal(roll_dice(5), c(6, 6, 2, 5, 4))
+  expect_equal(roll_dice(5), c(4, 5, 1, 4, 5))
+  expect_equal(roll_dice(5), c(3, 5, 6, 2, 3))
+})
+
+
+test_that("yahtzee is working", {
+  n_games <- 1e6 #could be very slow, when in doubt change to 1e4
+
+  n_winning <- sum(replicate(n_games, yahtzee()) == 5)
+  res <- (n_winning / n_games)
+  expected <- 0.046
+  expect_lt(abs(res - expected), 0.003)
+})

content/test-design.md

@@ -607,6 +607,13 @@ many strategies exist:
       ```
    ````
 
+   ````{group-tab} R
+
+      ```{literalinclude} code/R/yahtzee.R
+      :language: R
+      ```
+   ````
+
    ````{group-tab} Julia
 
       ```{literalinclude} code/julia/yahtzee.jl
@@ -633,6 +640,13 @@ many strategies exist:
       ```
    ````
 
+   ````{group-tab} R
+
+      ```{literalinclude} code/R/yahtzee_sol.R
+      :language: R
+      ```
+   ````
+
    ````{group-tab} Julia
 
       ```{literalinclude} code/julia/yahtzee_sol.jl