# 6張一費, 6張二費, 5張3費
cards <- c(rep(1, 6), rep(2, 6), rep(3, 5))
# 補滿30張
cards <- c(cards, rep("X", 30 - length(cards)))
# 每張取名字
names(cards) <- seq_along(cards)
 
# 起手一張二費與三張高費
init.cards <- cards[c(7, 18, 19, 20)]
# 牌庫剩下的牌。重洗的時候只會從這邊抽
left.cards <- cards[setdiff(names(cards), names(init.cards))]
 
roger <- function() {
  # 換四張牌
  init.new <- sample(left.cards, 4, FALSE)
  # 燙兩次
  tom <- sample(cards[setdiff(names(cards), names(init.new))], 2, FALSE)
  # 第一回合的牌（前五張），與第二回合抽到的牌
  c(init.new, tom)
}
 
shadesea <- function() {
  # 換三張牌保留二費
  init.new <- c(init.cards[1], head(sample(left.cards, 3, FALSE)))
  # 燙兩次
  tom <- sample(cards[setdiff(names(cards), names(init.new))], 2, FALSE)
  # 第一回合的牌（前五張），與第二回合抽到的牌
  c(init.new, tom)
}
checker <- list(
  has.1 = function(x) {
    "1" %in% head(x, 5)
  },
  has.2 = function(x) {
    "2" %in% head(x, 5)
  },
  has.12 = function(x) {
    ("1" %in% head(x, 5)) | ("2" %in% head(x, 5))
  },
  # 2+2
  has.2.2 = function(x) {
    sum(x == "2") >= 2
  },
  # 1+2
  has.1.2 = function(x) {
    ("1" %in% head(x, 5)) & ("2" %in% x)
  },
  has.2.1 = function(x) {
    ("2" %in% head(x, 5)) & ("1" %in% x)
  },
  has.2.11 = function(x) {
    ("2" %in% head(x, 5)) & (sum("1" == x) >= 2)
  },
  has.1.1 = function(x) {
    sum(x == "1") >= 2
  },
  has.1.11 = function(x) {
    sum(x == "1") >= 3
  },
  has.11.11 = function(x) {
    sum(x == "1") >= 4
  },
  has.1.3 = function(x) {
    ("1" %in% head(x, 5)) & ("3" %in% x)
  },
  has.1.12 = function(x) {
    ("1" %in% head(x, 5)) & (sum(x =="1") >= 2) & ("2" %in% x)
  },
  # 滿水晶
  crystal.full = function(x) {
    checker$has.1.2(x) | checker$has.2.2(x) | checker$has.1.11(x) | checker$has.11.11(x) | checker$has.1.3(x) | checker$has.1.12(x)
  },
  # 有做事
  no.idle = function(x) {
    checker$crystal.full(x) | checker$has.2.1(x) | checker$has.1.1(x)
  }
)
tasks <- expand.grid(sample = c("roger", "shadesea"), fname = names(checker))
task.name <- apply(tasks, 1, paste, collapse = "-")
result <- sapply(1:20, function(i, n) {
  sample <- list(
    roger = lapply(seq_len(n), function(i) roger()),
    shadesea = lapply(seq_len(n), function(i) shadesea())
  )
  result <- apply(tasks, 1, function(x) {
    mean(sapply(sample[[x[1]]], checker[[x[2]]]))
  })
  names(result) <- task.name
  result
}, n = 100) # 免費的計算資源有限，所以調降樣本數
# result
result2 <- apply(result, 1, function(x) {
  c(mean(x) - 2 * sd(x), mean(x), mean(x) + 2 * sd(x))
})
rownames(result2) <- c("95% Confidence Interval(lower)", "Estimated Probability", "95% Confidence Interval(upper)")
result2
 
 
 
 

CiMgNuW8teS4gOiyuywgNuW8teS6jOiyuywgNeW8tTPosrsKY2FyZHMgPC0gYyhyZXAoMSwgNiksIHJlcCgyLCA2KSwgcmVwKDMsIDUpKQojIOijnOa7vzMw5by1CmNhcmRzIDwtIGMoY2FyZHMsIHJlcCgiWCIsIDMwIC0gbGVuZ3RoKGNhcmRzKSkpCiMg5q+P5by15Y+W5ZCN5a2XCm5hbWVzKGNhcmRzKSA8LSBzZXFfYWxvbmcoY2FyZHMpCgojIOi1t+aJi+S4gOW8teS6jOiyu+iIh+S4ieW8temrmOiyuwppbml0LmNhcmRzIDwtIGNhcmRzW2MoNywgMTgsIDE5LCAyMCldCiMg54mM5bqr5Ymp5LiL55qE54mM44CC6YeN5rSX55qE5pmC5YCZ5Y+q5pyD5b6e6YCZ6YKK5oq9CmxlZnQuY2FyZHMgPC0gY2FyZHNbc2V0ZGlmZihuYW1lcyhjYXJkcyksIG5hbWVzKGluaXQuY2FyZHMpKV0KCnJvZ2VyIDwtIGZ1bmN0aW9uKCkgewogICMg5o+b5Zub5by154mMCiAgaW5pdC5uZXcgPC0gc2FtcGxlKGxlZnQuY2FyZHMsIDQsIEZBTFNFKQogICMg54eZ5YWp5qyhCiAgdG9tIDwtIHNhbXBsZShjYXJkc1tzZXRkaWZmKG5hbWVzKGNhcmRzKSwgbmFtZXMoaW5pdC5uZXcpKV0sIDIsIEZBTFNFKQogICMg56ys5LiA5Zue5ZCI55qE54mM77yI5YmN5LqU5by177yJ77yM6IiH56ys5LqM5Zue5ZCI5oq95Yiw55qE54mMCiAgYyhpbml0Lm5ldywgdG9tKQp9CgpzaGFkZXNlYSA8LSBmdW5jdGlvbigpIHsKICAjIOaPm+S4ieW8teeJjOS/neeVmeS6jOiyuwogIGluaXQubmV3IDwtIGMoaW5pdC5jYXJkc1sxXSwgaGVhZChzYW1wbGUobGVmdC5jYXJkcywgMywgRkFMU0UpKSkKICAjIOeHmeWFqeasoQogIHRvbSA8LSBzYW1wbGUoY2FyZHNbc2V0ZGlmZihuYW1lcyhjYXJkcyksIG5hbWVzKGluaXQubmV3KSldLCAyLCBGQUxTRSkKICAjIOesrOS4gOWbnuWQiOeahOeJjO+8iOWJjeS6lOW8te+8ie+8jOiIh+esrOS6jOWbnuWQiOaKveWIsOeahOeJjAogIGMoaW5pdC5uZXcsIHRvbSkKfQpjaGVja2VyIDwtIGxpc3QoCiAgaGFzLjEgPSBmdW5jdGlvbih4KSB7CiAgICAiMSIgJWluJSBoZWFkKHgsIDUpCiAgfSwKICBoYXMuMiA9IGZ1bmN0aW9uKHgpIHsKICAgICIyIiAlaW4lIGhlYWQoeCwgNSkKICB9LAogIGhhcy4xMiA9IGZ1bmN0aW9uKHgpIHsKICAgICgiMSIgJWluJSBoZWFkKHgsIDUpKSB8ICgiMiIgJWluJSBoZWFkKHgsIDUpKQogIH0sCiAgIyAyKzIKICBoYXMuMi4yID0gZnVuY3Rpb24oeCkgewogICAgc3VtKHggPT0gIjIiKSA+PSAyCiAgfSwKICAjIDErMgogIGhhcy4xLjIgPSBmdW5jdGlvbih4KSB7CiAgICAoIjEiICVpbiUgaGVhZCh4LCA1KSkgJiAoIjIiICVpbiUgeCkKICB9LAogIGhhcy4yLjEgPSBmdW5jdGlvbih4KSB7CiAgICAoIjIiICVpbiUgaGVhZCh4LCA1KSkgJiAoIjEiICVpbiUgeCkKICB9LAogIGhhcy4yLjExID0gZnVuY3Rpb24oeCkgewogICAgKCIyIiAlaW4lIGhlYWQoeCwgNSkpICYgKHN1bSgiMSIgPT0geCkgPj0gMikKICB9LAogIGhhcy4xLjEgPSBmdW5jdGlvbih4KSB7CiAgICBzdW0oeCA9PSAiMSIpID49IDIKICB9LAogIGhhcy4xLjExID0gZnVuY3Rpb24oeCkgewogICAgc3VtKHggPT0gIjEiKSA+PSAzCiAgfSwKICBoYXMuMTEuMTEgPSBmdW5jdGlvbih4KSB7CiAgICBzdW0oeCA9PSAiMSIpID49IDQKICB9LAogIGhhcy4xLjMgPSBmdW5jdGlvbih4KSB7CiAgICAoIjEiICVpbiUgaGVhZCh4LCA1KSkgJiAoIjMiICVpbiUgeCkKICB9LAogIGhhcy4xLjEyID0gZnVuY3Rpb24oeCkgewogICAgKCIxIiAlaW4lIGhlYWQoeCwgNSkpICYgKHN1bSh4ID09IjEiKSA+PSAyKSAmICgiMiIgJWluJSB4KQogIH0sCiAgIyDmu7/msLTmmbYKICBjcnlzdGFsLmZ1bGwgPSBmdW5jdGlvbih4KSB7CiAgICBjaGVja2VyJGhhcy4xLjIoeCkgfCBjaGVja2VyJGhhcy4yLjIoeCkgfCBjaGVja2VyJGhhcy4xLjExKHgpIHwgY2hlY2tlciRoYXMuMTEuMTEoeCkgfCBjaGVja2VyJGhhcy4xLjMoeCkgfCBjaGVja2VyJGhhcy4xLjEyKHgpCiAgfSwKICAjIOacieWBmuS6iwogIG5vLmlkbGUgPSBmdW5jdGlvbih4KSB7CiAgICBjaGVja2VyJGNyeXN0YWwuZnVsbCh4KSB8IGNoZWNrZXIkaGFzLjIuMSh4KSB8IGNoZWNrZXIkaGFzLjEuMSh4KQogIH0KKQp0YXNrcyA8LSBleHBhbmQuZ3JpZChzYW1wbGUgPSBjKCJyb2dlciIsICJzaGFkZXNlYSIpLCBmbmFtZSA9IG5hbWVzKGNoZWNrZXIpKQp0YXNrLm5hbWUgPC0gYXBwbHkodGFza3MsIDEsIHBhc3RlLCBjb2xsYXBzZSA9ICItIikKcmVzdWx0IDwtIHNhcHBseSgxOjIwLCBmdW5jdGlvbihpLCBuKSB7CiAgc2FtcGxlIDwtIGxpc3QoCiAgICByb2dlciA9IGxhcHBseShzZXFfbGVuKG4pLCBmdW5jdGlvbihpKSByb2dlcigpKSwKICAgIHNoYWRlc2VhID0gbGFwcGx5KHNlcV9sZW4obiksIGZ1bmN0aW9uKGkpIHNoYWRlc2VhKCkpCiAgKQogIHJlc3VsdCA8LSBhcHBseSh0YXNrcywgMSwgZnVuY3Rpb24oeCkgewogICAgbWVhbihzYXBwbHkoc2FtcGxlW1t4WzFdXV0sIGNoZWNrZXJbW3hbMl1dXSkpCiAgfSkKICBuYW1lcyhyZXN1bHQpIDwtIHRhc2submFtZQogIHJlc3VsdAp9LCBuID0gMTAwKSAjIOWFjeiyu+eahOioiOeul+izh+a6kOaciemZkO+8jOaJgOS7peiqv+mZjeaoo+acrOaVuAojIHJlc3VsdApyZXN1bHQyIDwtIGFwcGx5KHJlc3VsdCwgMSwgZnVuY3Rpb24oeCkgewogIGMobWVhbih4KSAtIDIgKiBzZCh4KSwgbWVhbih4KSwgbWVhbih4KSArIDIgKiBzZCh4KSkKfSkKcm93bmFtZXMocmVzdWx0MikgPC0gYygiOTUlIENvbmZpZGVuY2UgSW50ZXJ2YWwobG93ZXIpIiwgIkVzdGltYXRlZCBQcm9iYWJpbGl0eSIsICI5NSUgQ29uZmlkZW5jZSBJbnRlcnZhbCh1cHBlcikiKQpyZXN1bHQyCgoKCg==