[R] Looking for Speed in a Toy Simulation Example

[Simon Knos]

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))