This is an R Markdown Notebook. When you execute code within the notebook, the results appear beneath the code.

Try executing this chunk by clicking the Run button within the chunk or by placing your cursor inside it and pressing Ctrl+Shift+Enter.

Run Sequentially

# Stat 6401
# Example 1.4.19
# Newton-Pepys problem
B <- 1000000  # number of replications of the experiment
# A : At least one 6 appears when 6 fair dice are rolled.
n <- 6  # number of dice
k <- 1  # number of time 6 appears in the n dice
r <- replicate(B,sum(sample(1:6, n, replace = TRUE) == 6))
sum(r >= k)/B  # estimate probability
[1] 0.66503
# B : At least two 6's appears when 12 fair dice are rolled.
n <- 12  # number of dice
k <- 2  # number of time 6 appears in the n dice
r <- replicate(B,sum(sample(1:6, n, replace = TRUE) == 6))
sum(r >= k)/B  # estimate probability
[1] 0.618667
# C : At least two 6's appears when 18 fair dice are rolled.
n <- 18  # number of dice
k <- 3  # number of time 6 appears in the n dice
r <- replicate(B,sum(sample(1:6, n, replace = TRUE) == 6))
sum(r >= k)/B  # estimate probability
[1] 0.596521

As the number of dice increases the chance of winning decreases.

Run using a sequential for loop

# using loop
#start time
strt <- Sys.time()
games <- 3  # number of times 6 appears
B <- 1000000  # number of replications of the experiment
n <- 6  # number of dice
r <- numeric(games)
for(k in 1:games){
  r[k] <- sum(replicate(B,sum(sample(1:6, n*k, replace = TRUE) == 6)) >= k)/B
}
prob.est <- r
prob.est
[1] 0.664172 0.619559 0.597354
#end time
print(Sys.time()-strt)
Time difference of 27.44176 secs

Run in parallel

# parallel code
#start time
strt <- Sys.time()
games <- 3  # number of times 6 appears
library(foreach)
library(doParallel)
cl <- makeCluster(games)
registerDoParallel(cl)
B <- 1000000  # number of replications of the experiment
n <- 6  # number of dice
r <- numeric(games)
prob.est <- foreach(k = 1:games, .combine=rbind) %dopar% {
  r[k] <- sum(replicate(B,sum(sample(1:6, n*k, replace = TRUE) == 6)) >= k)/B
}
prob.est
             [,1]
result.1 0.665022
result.2 0.617407
result.3 0.597322
stopCluster(cl)
#end time
print(Sys.time()-strt)
Time difference of 12.46573 secs
# parallel code for linux or OSX
#start time
strt <- Sys.time()
games <- 3  # number of times 6 appears
library(foreach)
library(doMC)
registerDoMC(games) 
B <- 1000000  # number of replications of the experiment
n <- 6  # number of dice
r <- numeric(games)
prob.est <- foreach(k = 1:games, .combine=rbind) %dopar% {
  r[k] <- sum(replicate(B,sum(sample(1:6, n*k, replace = TRUE) == 6)) >= k)/B
}
prob.est
             [,1]
result.1 0.664976
result.2 0.618620
result.3 0.597547
#end time
print(Sys.time()-strt)
Time difference of 10.65973 secs
# parallel code for Windows
#start time
strt <- Sys.time()
games <- 3  # number of times 6 appears
library(foreach)
library(doSNOW)
cl <- makeCluster(games)
B <- 1000000  # number of replications of the experiment
n <- 6  # number of dice
r <- numeric(games)
prob.est <- foreach(k = 1:games, .combine=rbind) %dopar% {
  r[k] <- sum(replicate(B,sum(sample(1:6, n*k, replace = TRUE) == 6)) >= k)/B
}
prob.est
             [,1]
result.1 0.665028
result.2 0.618497
result.3 0.597397
stopCluster(cl)
#end time
print(Sys.time()-strt)
Time difference of 11.41324 secs

Using parallel processing reduces the overall time to run the simulations.

Add a new chunk by clicking the Insert Chunk button on the toolbar or by pressing Ctrl+Alt+I.

When you save the notebook, an HTML file containing the code and output will be saved alongside it (click the Preview button or press Ctrl+Shift+K to preview the HTML file).

The preview shows you a rendered HTML copy of the contents of the editor. Consequently, unlike Knit, Preview does not run any R code chunks. Instead, the output of the chunk when it was last run in the editor is displayed.

LS0tCnRpdGxlOiAiTmV3dG9uLVBlcHlzIHZlcjIiCm91dHB1dDogaHRtbF9ub3RlYm9vawotLS0KClRoaXMgaXMgYW4gW1IgTWFya2Rvd25dKGh0dHA6Ly9ybWFya2Rvd24ucnN0dWRpby5jb20pIE5vdGVib29rLiBXaGVuIHlvdSBleGVjdXRlIGNvZGUgd2l0aGluIHRoZSBub3RlYm9vaywgdGhlIHJlc3VsdHMgYXBwZWFyIGJlbmVhdGggdGhlIGNvZGUuIAoKVHJ5IGV4ZWN1dGluZyB0aGlzIGNodW5rIGJ5IGNsaWNraW5nIHRoZSAqUnVuKiBidXR0b24gd2l0aGluIHRoZSBjaHVuayBvciBieSBwbGFjaW5nIHlvdXIgY3Vyc29yIGluc2lkZSBpdCBhbmQgcHJlc3NpbmcgKkN0cmwrU2hpZnQrRW50ZXIqLiAKCioqUnVuIFNlcXVlbnRpYWxseSoqCgpgYGB7cn0KIyBTdGF0IDY0MDEKCiMgRXhhbXBsZSAxLjQuMTkKIyBOZXd0b24tUGVweXMgcHJvYmxlbQoKQiA8LSAxMDAwMDAwICAjIG51bWJlciBvZiByZXBsaWNhdGlvbnMgb2YgdGhlIGV4cGVyaW1lbnQKCiMgQSA6IEF0IGxlYXN0IG9uZSA2IGFwcGVhcnMgd2hlbiA2IGZhaXIgZGljZSBhcmUgcm9sbGVkLgoKbiA8LSA2ICAjIG51bWJlciBvZiBkaWNlCgprIDwtIDEgICMgbnVtYmVyIG9mIHRpbWUgNiBhcHBlYXJzIGluIHRoZSBuIGRpY2UKCnIgPC0gcmVwbGljYXRlKEIsc3VtKHNhbXBsZSgxOjYsIG4sIHJlcGxhY2UgPSBUUlVFKSA9PSA2KSkKCnN1bShyID49IGspL0IgICMgZXN0aW1hdGUgcHJvYmFiaWxpdHkKYGBgCgpgYGB7cn0KIyBCIDogQXQgbGVhc3QgdHdvIDYncyBhcHBlYXJzIHdoZW4gMTIgZmFpciBkaWNlIGFyZSByb2xsZWQuCgpuIDwtIDEyICAjIG51bWJlciBvZiBkaWNlCgprIDwtIDIgICMgbnVtYmVyIG9mIHRpbWUgNiBhcHBlYXJzIGluIHRoZSBuIGRpY2UKCnIgPC0gcmVwbGljYXRlKEIsc3VtKHNhbXBsZSgxOjYsIG4sIHJlcGxhY2UgPSBUUlVFKSA9PSA2KSkKCnN1bShyID49IGspL0IgICMgZXN0aW1hdGUgcHJvYmFiaWxpdHkKYGBgCgpgYGB7cn0KIyBDIDogQXQgbGVhc3QgdHdvIDYncyBhcHBlYXJzIHdoZW4gMTggZmFpciBkaWNlIGFyZSByb2xsZWQuCgpuIDwtIDE4ICAjIG51bWJlciBvZiBkaWNlCgprIDwtIDMgICMgbnVtYmVyIG9mIHRpbWUgNiBhcHBlYXJzIGluIHRoZSBuIGRpY2UKCnIgPC0gcmVwbGljYXRlKEIsc3VtKHNhbXBsZSgxOjYsIG4sIHJlcGxhY2UgPSBUUlVFKSA9PSA2KSkKCnN1bShyID49IGspL0IgICMgZXN0aW1hdGUgcHJvYmFiaWxpdHkKYGBgCgpBcyB0aGUgbnVtYmVyIG9mIGRpY2UgaW5jcmVhc2VzIHRoZSBjaGFuY2Ugb2Ygd2lubmluZyBkZWNyZWFzZXMuCgoqKlJ1biB1c2luZyBhIHNlcXVlbnRpYWwgZm9yIGxvb3AqKgoKYGBge3J9CiMgdXNpbmcgbG9vcAoKI3N0YXJ0IHRpbWUKc3RydCA8LSBTeXMudGltZSgpCgpnYW1lcyA8LSAzICAjIG51bWJlciBvZiB0aW1lcyA2IGFwcGVhcnMKCkIgPC0gMTAwMDAwMCAgIyBudW1iZXIgb2YgcmVwbGljYXRpb25zIG9mIHRoZSBleHBlcmltZW50CgpuIDwtIDYgICMgbnVtYmVyIG9mIGRpY2UKCnIgPC0gbnVtZXJpYyhnYW1lcykKCmZvcihrIGluIDE6Z2FtZXMpewogIHJba10gPC0gc3VtKHJlcGxpY2F0ZShCLHN1bShzYW1wbGUoMTo2LCBuKmssIHJlcGxhY2UgPSBUUlVFKSA9PSA2KSkgPj0gaykvQgp9Cgpwcm9iLmVzdCA8LSByCnByb2IuZXN0CgojZW5kIHRpbWUKcHJpbnQoU3lzLnRpbWUoKS1zdHJ0KQoKYGBgCgoKCioqUnVuIGluIHBhcmFsbGVsKioKCmBgYHtyfQojIHBhcmFsbGVsIGNvZGUKCiNzdGFydCB0aW1lCnN0cnQgPC0gU3lzLnRpbWUoKQoKZ2FtZXMgPC0gMyAgIyBudW1iZXIgb2YgdGltZXMgNiBhcHBlYXJzCgpsaWJyYXJ5KGZvcmVhY2gpCmxpYnJhcnkoZG9QYXJhbGxlbCkKY2wgPC0gbWFrZUNsdXN0ZXIoZ2FtZXMpCnJlZ2lzdGVyRG9QYXJhbGxlbChjbCkKCkIgPC0gMTAwMDAwMCAgIyBudW1iZXIgb2YgcmVwbGljYXRpb25zIG9mIHRoZSBleHBlcmltZW50CgpuIDwtIDYgICMgbnVtYmVyIG9mIGRpY2UKCnIgPC0gbnVtZXJpYyhnYW1lcykKCnByb2IuZXN0IDwtIGZvcmVhY2goayA9IDE6Z2FtZXMsIC5jb21iaW5lPXJiaW5kKSAlZG9wYXIlIHsKICByW2tdIDwtIHN1bShyZXBsaWNhdGUoQixzdW0oc2FtcGxlKDE6NiwgbiprLCByZXBsYWNlID0gVFJVRSkgPT0gNikpID49IGspL0IKfQoKcHJvYi5lc3QKCnN0b3BDbHVzdGVyKGNsKQoKI2VuZCB0aW1lCnByaW50KFN5cy50aW1lKCktc3RydCkKYGBgCgpgYGB7cn0KIyBwYXJhbGxlbCBjb2RlIGZvciBsaW51eCBvciBPU1gKCiNzdGFydCB0aW1lCnN0cnQgPC0gU3lzLnRpbWUoKQoKZ2FtZXMgPC0gMyAgIyBudW1iZXIgb2YgdGltZXMgNiBhcHBlYXJzCgpsaWJyYXJ5KGZvcmVhY2gpCmxpYnJhcnkoZG9NQykKcmVnaXN0ZXJEb01DKGdhbWVzKSAKCkIgPC0gMTAwMDAwMCAgIyBudW1iZXIgb2YgcmVwbGljYXRpb25zIG9mIHRoZSBleHBlcmltZW50CgpuIDwtIDYgICMgbnVtYmVyIG9mIGRpY2UKCnIgPC0gbnVtZXJpYyhnYW1lcykKCnByb2IuZXN0IDwtIGZvcmVhY2goayA9IDE6Z2FtZXMsIC5jb21iaW5lPXJiaW5kKSAlZG9wYXIlIHsKICByW2tdIDwtIHN1bShyZXBsaWNhdGUoQixzdW0oc2FtcGxlKDE6NiwgbiprLCByZXBsYWNlID0gVFJVRSkgPT0gNikpID49IGspL0IKfQoKcHJvYi5lc3QKCiNlbmQgdGltZQpwcmludChTeXMudGltZSgpLXN0cnQpCmBgYAoKYGBge3J9CiMgcGFyYWxsZWwgY29kZSBmb3IgV2luZG93cwoKI3N0YXJ0IHRpbWUKc3RydCA8LSBTeXMudGltZSgpCgpnYW1lcyA8LSAzICAjIG51bWJlciBvZiB0aW1lcyA2IGFwcGVhcnMKCmxpYnJhcnkoZm9yZWFjaCkKbGlicmFyeShkb1NOT1cpCgpjbCA8LSBtYWtlQ2x1c3RlcihnYW1lcykKCkIgPC0gMTAwMDAwMCAgIyBudW1iZXIgb2YgcmVwbGljYXRpb25zIG9mIHRoZSBleHBlcmltZW50CgpuIDwtIDYgICMgbnVtYmVyIG9mIGRpY2UKCnIgPC0gbnVtZXJpYyhnYW1lcykKCnByb2IuZXN0IDwtIGZvcmVhY2goayA9IDE6Z2FtZXMsIC5jb21iaW5lPXJiaW5kKSAlZG9wYXIlIHsKICByW2tdIDwtIHN1bShyZXBsaWNhdGUoQixzdW0oc2FtcGxlKDE6NiwgbiprLCByZXBsYWNlID0gVFJVRSkgPT0gNikpID49IGspL0IKfQoKcHJvYi5lc3QKCnN0b3BDbHVzdGVyKGNsKQoKI2VuZCB0aW1lCnByaW50KFN5cy50aW1lKCktc3RydCkKCmBgYAoKVXNpbmcgcGFyYWxsZWwgcHJvY2Vzc2luZyByZWR1Y2VzIHRoZSBvdmVyYWxsIHRpbWUgdG8gcnVuIHRoZSBzaW11bGF0aW9ucy4KCgpBZGQgYSBuZXcgY2h1bmsgYnkgY2xpY2tpbmcgdGhlICpJbnNlcnQgQ2h1bmsqIGJ1dHRvbiBvbiB0aGUgdG9vbGJhciBvciBieSBwcmVzc2luZyAqQ3RybCtBbHQrSSouCgpXaGVuIHlvdSBzYXZlIHRoZSBub3RlYm9vaywgYW4gSFRNTCBmaWxlIGNvbnRhaW5pbmcgdGhlIGNvZGUgYW5kIG91dHB1dCB3aWxsIGJlIHNhdmVkIGFsb25nc2lkZSBpdCAoY2xpY2sgdGhlICpQcmV2aWV3KiBidXR0b24gb3IgcHJlc3MgKkN0cmwrU2hpZnQrSyogdG8gcHJldmlldyB0aGUgSFRNTCBmaWxlKS4KClRoZSBwcmV2aWV3IHNob3dzIHlvdSBhIHJlbmRlcmVkIEhUTUwgY29weSBvZiB0aGUgY29udGVudHMgb2YgdGhlIGVkaXRvci4gQ29uc2VxdWVudGx5LCB1bmxpa2UgKktuaXQqLCAqUHJldmlldyogZG9lcyBub3QgcnVuIGFueSBSIGNvZGUgY2h1bmtzLiBJbnN0ZWFkLCB0aGUgb3V0cHV0IG9mIHRoZSBjaHVuayB3aGVuIGl0IHdhcyBsYXN0IHJ1biBpbiB0aGUgZWRpdG9yIGlzIGRpc3BsYXllZC4K