Monte Carlo Club: Difference between revisions
Jump to navigation
Jump to search
imported>Weigang mNo edit summary |
imported>Weigang mNo edit summary |
||
Line 1: | Line 1: | ||
Title | |||
---- | ---- | ||
==Feb 10, 2017 "Dating" (Valentine's Day Special; Due 2/17/2017)== | ==Feb 10, 2017 "Dating" (Valentine's Day Special; Due 2/17/2017)== |
Revision as of 13:50, 11 February 2017
Title
Feb 10, 2017 "Dating" (Valentine's Day Special; Due 2/17/2017)
- Source: Paul Nahin (2008), "Digital Dice". Problem #20: "An Optimal Stopping Problem"
- Problem: What is the optimal time point when one should stop dating more people and settle on a mate choice (and live with the decision)
- Your best strategy is to date an initial sample of N individuals, rejecting all, and marry the next one ranked higher than any of your N individuals. The question is what is the optimal number for N.
- The problem could be investigated by simulating a pool of 100 individuals, ranked from 1-100 (most desirable being 1) and then take a sample of N
- You may only date one individual at a time
- You cannot go back to reach previously rejected candidates
- Simulate N from 0 to 10 (zero means marrying the first date, a sample size of zero)
- For each N, obtain the probability of finding the perfect mate (i.e., ranked 1st) by running simulation 1000 times
- Plot barplot of probability versus sample size N.
- Expected answer: N=4
Feb 3, 2017 "US Presidents" (Due 2/10/2017)
- Download : 1st column is the order, 2nd column is the name, the 3rd column is the year of inauguration; tab-separated
- Your job is to create an R, Perl, or Python script called “us-presidents”, which will
- Read the table
- Store the original/correct order
- Shuffle/permute the rows and record the new order
- Count the number of matching orders
- Repeat Steps 3-4 for a 1000 times
- Plot histogram or barplot (better) to show distribution of matching counts
- Hint: For R, use the sample() function. For Perl, use the rand() function.
Submitted Codes |
---|
pres.list <- lapply(1:1000, function(x) pres[sample(nrow(pres)),])
cts <- sapply(pres.list, function(x) {
ct.match <- 0;
for (i in 1:45){
if (pres$order[i] == x[i,1]){
#cat(as.character(x[i,2]), x[i,1], "\n") #as.character to avoid the factor info
ct.match <- ct.match + 1;
#cat(ct.match)
}
}
ct.match #return
})
barplot(table(cts),xlab = "Number of matches per shuffle", border = "hotpink", col = "pink", ylab = paste("Frequency total of:",length(pres.list)), main = "US Presidents")
p <- read.table("Presidents.txt", sep="\t", header=F)
colnames(p) <- c("order", "name", "inaug.year")
# Use "sapply" or "lapply" for loops: no need to pre-define a vector to store results
p.sim <- sapply(1:10000, function (x) {
length(which(sample(p$order) == p$order))
})
barplot(table(p.sim), las=1)
p.exp <- rpois(1e4, 1) # 1000 Poisson random deviates
mp <- barplot(table(p.exp), las=1, xlab = "Num of matching presidents") # mid-point on x-axis
lines(mp[1:7], table(p.sim), type="b", col=2) # add a line (Poisson-expected) to the barplot (simulated)
|
Feb 17, 2017 "Birthdays" (Due 2/24/2017)
- Randomly select N individuals and record their B-days
- Count the B-days shared by two or more individuals
- Repeat (for each N) 100 times
- Vary N from 10 to 100, increment by 10
- Plot matching counts (Y-axis) versus N (x-axis), with either a stripchart or boxplot, or both