Rui, thank you very much. I keep forgetting about the rowSum and friends. (precalculating the powers just slipped my attention).
And, yes, a factor of will of course do. Do you see a further improvement in this case? Best, Simon On Fri, Jun 15, 2012 at 12:25 PM, Rui Barradas <ruipbarra...@sapo.pt> wrote: > 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.