[R] Looking for Speed in a Toy Simulation Example

[Rui Barradas]

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 at 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.
>