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))
Dear R Users,
I have struggled with the following problem for days, which I thought was
simple, although it would likely be basic to most of you.
I am working with time series data.
In my script, my intention is to create first differences of the variables in
the file so that I end up estimating an equation of the form:
DCred(t) =c +
DCred(t-1)+DCred(t-2)+...+DBoB(t)+DBoB(t-1)+DBoB(t-2)+...+Drvr(t)+Drvr(t-1)+Drvr(t-2)+...+e(t)
Where D at the beginning of each variable represents 'change', for first
difference and e(t) is the error term.
Now I am trying to use loops to calculate 5 lagged first-differences of each
variable in the dataset - e.g., DCred(t-1), DCred(t-2), ..., DCred(t-5).
Example:
# Differences of Cred
DCred<- diff(Cred, difference=1)
DCred
for(i in 1:5){
print(DCred[i]<- diff(DCred, lag=i, difference=1))
}
After I calculated the contemporaneous first difference DCred, this loop is
meant to compute the subsequent first differences of the same variable; i.e.,
DCred(t-1) and call it DCred1, DCred(t-2) and call it DCred2, ... and DCred(t-5)
and call it DCred5.
The loop works, at least I think so. But now after the loop has executed, when I
type DCred1[1] (which I thought would give me the first value in the series for
DCred(t-1)), called DCred1, I get a message "object 'DCred1' not
found". Similarly typing Dcred1[2] (which I thought would give the second
value of DCred(t-1)), ie., the second value of DCred1, gives "object
DCred1[2] not found", etc.
A copy of the commands and error messages is below:> DCred1[1]
Error: object 'DCred1' not found> DCred1[2]
Error: object 'DCred1' not found
How can I solve this problem? Thank you kindly for your time.
[[alternative HTML version deleted]]
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.
>