# tests/testthat/test_payouts.R In obfuscatoR: Obfuscation Game Designs

```testthat::test_that("Payouts are calculated correctly", {
#   Validated input matrix
ra_mat <- matrix(c(-1, -1, -1, -1,  1,
-1,  0,  0, -1,  0,
-1,  0, -1,  0,  0,
0,  0, -1,  0, -1), nrow = 4L, byrow = TRUE)

#   Define the goal vectors
payout_obs_goal <- c(10, 3.3333333333, 10, 5, 6)
pr_guess_F_goal <- c(0.99330715, 0.15886910, 0.99330715, 0.5, 0.73105858)
pr_guess_T_goal <- c(1, 0, 1, 0.5, 1)
payout_dm_F_goal <- c(0.03346425, 4.20565448, 0.03346425, 2.5, 1.34470711)
payout_dm_T_goal <- c(0, 5, 0, 2.5, 0)

#   Calculate the entropy and retrieve Pr(r_k|a_j)
entropy <- calc_entropy(ra_mat)
pr_rk_aj <- attr(entropy, "pr_rk_aj")

#   Calculate the expected payout to the observer
pay_obs <- 10
payout_obs <- calc_payout_obs(pr_rk_aj, pay_obs)
attributes(payout_obs) <- NULL

#   Calculate the probabilities of guessing
pay_obs_no_guess <- pay_dm <- 5

pr_guess_F <- calc_pr_guess(payout_obs, pay_obs_no_guess, FALSE)
attributes(pr_guess_F) <- NULL

pr_guess_T <- calc_pr_guess(payout_obs, pay_obs_no_guess, TRUE)
attributes(pr_guess_T) <- NULL

#   Calculate the payout to the decision maker
payout_dm_F <- calc_payout_dm(pr_guess_F, pay_dm)
attributes(payout_dm_F) <- NULL
payout_dm_T <- calc_payout_dm(pr_guess_T, pay_dm)
attributes(payout_dm_T) <- NULL

expect_equal(payout_obs, payout_obs_goal)
expect_equal(pr_guess_F, pr_guess_F_goal)
expect_equal(pr_guess_T, pr_guess_T_goal)
expect_equal(payout_dm_F, payout_dm_F_goal)
expect_equal(payout_dm_T, payout_dm_T_goal)
})
```

## Try the obfuscatoR package in your browser

Any scripts or data that you put into this service are public.

obfuscatoR documentation built on Aug. 1, 2019, 5:07 p.m.