Considering the probability distribution associated with rolling 3 fair dice labelled d1, d2 and d3, calculate the probability of the following:
The problem is from the following stackoverflow post
#[1] "1 6 6"
#[1] "2 5 6"
#[1] "2 6 5"
#[1] "2 6 6"
#[1] "3 4 6"
#[1] "3 5 5"
#[1] "3 5 6"
# compute theroetical probs
actual.probs <- rep(0,3)
# all points in the sample space
for (d1 in 1:6)
for (d2 in 1:6)
for (d3 in 1:6) {
s <- d1 + d2 + d3
actual.probs[1] <- actual.probs[1] + ((s > 12) && (s /span> 18))
actual.probs[2] <- actual.probs[2] + ((s %% 2) == 0)
actual.probs[3] <- actual.probs[3] + ((s / 3) == 4)
}
actual.probs <- actual.probs / 6^3 # theoretical probs
# compute simulated probs
num.repeat <- 100
num.trials <- 10^3sim.probs <- vector("list", 3)
for (j in 1:num.repeat) {
res <- .rowMeans(replicate(num.trials, {
#dice dice <- sample(1:6, 3, replace=TRUE)
s <- sum(dice)
p1 <- ((s > 12) && (s /span> 18))
p2 <- (s %% 2 == 0)
p3 <- ((s/3) == 4)
c(p1, p2, p3) }), 3, num.trials)
#print(res)
for (i in 1:3) {
sim.probs[[i]] <- c(sim.probs[[i]], res[i])
}
}
Here is a visual comparison between the simulated and the actual (theoretical) probabilities for each of the 3 cases, the theoretical probabilities are represented as dotted lines. As can be seen, in general, as the number of trials increase, the simulated probability tends to more accurately estimate the theoretical probabilities.
Now let’s find the impact of the number of trials on the mean and absolute difference from the theoretical probabilities w.r.t. the computed probabilities with simulation.
Let Θ be an unknown constant. Let W1,W2,…,Wn be independent exponential random variables each with parameter 1.
Let Xi=Θ+Wi. It can be shown that Θ^ML=mini Xi. Now, we have been asked to construct a confidence interval of the particular form [Θ^−c,Θ^], where Θ^=mini Xi and c is a constant that we need to choose.
For n=10, how should the constant be chosen so that we have a 95% confidence interval? (Give the smallest possible value of c.) Your answer should be accurate to 3 decimal places.
This problem appeared in the final exam of the edX course MITx: 6.041x Introduction to Probability – The Science of Uncertainty.
n <- 10 th <- 100 exp.samp <- function() { w <- rexp(n, 1) x <- th + w th.hat <- min(x) th.hat } ntrial <- 10^6 th.hat <- replicate(ntrial, exp.samp()) #c #print(c) c <- quantile(th.hat - th, probs=0.95) print(c)
## 95% ## 0.3002047
print(mean(th.hat - c <= th)) # & (th <= th.hat))
## [1] 0.95
hist(th.hat - th, xlab=expression(hat(theta)-theta), main=expression(hat(theta)-theta))
Find the area of the following regions with Monte-Carlo Simulation.
n <- 10^6 df <- data.frame(x = runif(n), y = runif(n))
indices <- which(((df$y)^2<=df$x)&((df$x)^2<=df$y))
print(paste('Area with Monte-Carlo Integration = ', length(indices) / n))
## [1] "Area with Monte-Carlo Integration = 0.332888"
res <- integrate(function(x) sqrt(x) - x^2,0,1)
print(paste('Actual Area = ', res$value, ' with absolute error', res$abs.err))
## [1] "Actual Area = 0.333333408167678 with absolute error 7.80933322530327e-05"
eq <- 10^6 xmax <- 3 df <- data.frame(x = runif(n,-xmax,xmax), y = runif(n,-0.25,1)) indices <- which((df$y>0)&(abs(df$x)<=xmax)&(df$y/span>eq(df$x))) print(paste('Area with Monte-Carlo Integration = ', 6*1.25*length(indices)/n))
## [1] "Area with Monte-Carlo Integration = 3.700785"
res <- integrate(eq,-3,3) print(paste('Actual Area = ', res$value, ' with absolute error', res$abs.err))
## [1] "Actual Area = 3.69730505599894 with absolute error 4.1048332022e-14"
Comment
Got it. Thanks!
@Norberto J. Sanchez: Please refer to this blog here: https://sandipanweb.wordpress.com/2016/10/26/solving-simple-probabi...
@Norberto J. Sanchez: you are right, it's a typo created because of html copy paste, it should be (s < 18) instead of (s /span> 18) as stated in the problem.
Hi. I got an error on "span" in the following line:
> actual.probs[1] <- actual.probs[1] + ((s > 12) && (s /span> 18))
Was that a typo or do I need an R package to run this code? If so, please provide the name of the package.
Thanks in advance.
Norberto
© 2020 Data Science Central ® Powered by
Badges | Report an Issue | Privacy Policy | Terms of Service
Upcoming DSC Webinar
Most Popular Content on DSC
To not miss this type of content in the future, subscribe to our newsletter.
Other popular resources
Archives: 2008-2014 | 2015-2016 | 2017-2019 | Book 1 | Book 2 | More
Upcoming DSC Webinar
Most popular articles
You need to be a member of Data Science Central to add comments!
Join Data Science Central