Hello,
Will a factor of 4 do?
This is variant 3, revised.
#################################################
## Variant 3.b ##
#################################################
## Initialize matrix to hold results
singlecolor <- matrix(NA, simlength, noplayer)
## construct the deck to sample from
basedeck <- rep(10^(1:4), 13)
## Pre-compute this vector, don't re-compute inside a loop
pow10x5 <- 5*10^(1:4)
## This one uses matrix(...,5) to create the individual hands
## but it's created in advance
currentdeck <- matrix(nrow = 5, ncol=noplayer)
## comparison by using %in%
set.seed(7777)
system.time({
singlecolor[] <- sapply(1:simlength, function(i){
currentdeck[] <- sample(basedeck, decklength)
colSums(currentdeck) %in% pow10x5
})
})
apply(singlecolor, 2, mean) ## colMeans()
mean(apply(singlecolor, 2, mean))
Note that the real speed gain is in colSums, all the rest gave me around
1.5 secs or 5% only.
Rui Barradas
Em 15-06-2012 09:40, Simon Knos escreveu:
Dear List Members
I used to play around with R to answer the following question by
simulation (I am aware there is an easy explicit solution, but this is
intended to serve as instructional example).
Suppose you have a poker game with 6 players and a deck of 52 cards.
Compute the empirical frequencies of having a single-suit hand. The
way I want the result structured is a boolean nosimulation by noplayer
matrix containing true or false
depending whether the specific player was dealt a single-suit hand.
The code itself is quite short: 1 line to "deal the cards", 1 line to
check whether any of the six players has single-suit hand.
I played around with different variants (all found below) and managed
to gain some speed, however, I subjectively still find it quite slow.
I would thus very much appreciate if anybody could point me to
a) speed improvments in general
b) speed improvements using the compiler package: At what level is
cmpfun best used in this particular example?
Thank you very much,
Simon
###################################Code#########################################
noplayer <- 6
simlength <- 1e+05
decklength <- 5 * noplayer
#################################################
## Variant 1 ##
#################################################
## Initialize matrix to hold results
singlecolor <- matrix(NA, simlength, noplayer)
## construct the deck to sample from
basedeck <- rep(1:4, 13)
## This one uses split to create the individual hands
set.seed(7777)
system.time({
for (i in 1:simlength) {
currentdeck <- split(sample(basedeck, decklength), rep(1:noplayer, 5))
singlecolor[i, ] <- sapply(currentdeck, function(inv) {
length(unique(inv)) == 1 })
}
})
apply(singlecolor, 2, mean)
mean(apply(singlecolor, 2, mean))
#################################################
## Variant 2 ##
#################################################
## Initialize matrix to hold results
singlecolor <- matrix(NA, simlength, noplayer)
## construct the deck to sample from
basedeck <- rep(10^(1:4), 13)
## This one uses matrix(...,5) to create the individual hands
## comparison by using powers of ten
set.seed(7777)
system.time({
for (i in 1:simlength) {
sampledeck <- sample(basedeck, decklength)
currentdeck <- matrix(sampledeck, nrow = 5)
singlecolor[i, ] <- apply(currentdeck, 2, function(inv) {
any(sum(inv) == (5 * 10^(1:4))) })
}
})
apply(singlecolor, 2, mean)
mean(apply(singlecolor, 2, mean))
#################################################
## Variant 3 ##
#################################################
## Initialize matrix to hold results
singlecolor <- matrix(NA, simlength, noplayer)
## construct the deck to sample from
basedeck <- rep(10^(1:4), 13)
## This one uses matrix(...,5) to create the individual hands
## comparison by using %in%
set.seed(7777)
system.time({
for (i in 1:simlength) {
sampledeck <- sample(basedeck, decklength)
currentdeck <- matrix(sampledeck, nrow = 5)
singlecolor[i, ] <- apply(currentdeck, 2, sum) %in% (5 * 10^(1:4))
}
})
apply(singlecolor, 2, mean)
mean(apply(singlecolor, 2, mean))
#################################################
## Variant 4 ##
#################################################
## Initialize matrix to hold results
singlecolor <- matrix(NA, simlength, noplayer)
## construct the deck to sample from
basedeck <- rep(1:4, 13)
## This one uses matrix(...,5) to create the individual hands
## comparison by using length(unique(...))
set.seed(7777)
system.time({
for (i in 1:simlength) {
sampledeck <- sample(basedeck, decklength)
currentdeck <- matrix(sampledeck, nrow = 5)
singlecolor[i, ] <- apply(currentdeck, 2, function(inv) {
length(unique(inv)) == 1 })
}
})
apply(singlecolor, 2, mean)
mean(apply(singlecolor, 2, mean))
______________________________________________
R-help@r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-help
PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
and provide commented, minimal, self-contained, reproducible code.
______________________________________________
R-help@r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-help
PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
and provide commented, minimal, self-contained, reproducible code.
