Re: [R] expand.grid game

[Robin Hankin]

Hello again everybody.

I fired off my reply before reading the correspondence about
the leading zeros.

You can also assume that there is at least one block
at the leading position, [so that position can take  0,1,2,...,8 additional
blocks] and distribute the remaining 16 blocks amongst all 8
places:

system.time(dim(blockparts(c(8,rep(9,7)),16)))
  user  system elapsed
 0.056   0.016   0.069
>

this is faster!  :-)

best wishes

rksh





baptiste auguie wrote:

Wow!

system.time({
all = blockparts(rep(9,8),17)
print( dim(all[,all[1,]!=0])[2] ) # remove leading 0s
})

## 229713
   user  system elapsed
  0.160   0.068   0.228

In some ways I think this is close to Hadley's suggestion, though I
didn't know how to implement it.

Thanks a lot to everybody who participated, I have learned interesting
things from a seemingly innocuous question.

Best regards,

baptiste


2009/12/21 Robin Hankin <rk...@cam.ac.uk>:

Hi

library(partitions)
jj <- blockparts(rep(9,8),17)
dim(jj)

gives 318648


HTH

rksh



baptiste auguie wrote:

Dear list,

In a little numbers game, I've hit a performance snag and I'm not sure
how to code this in C.

The game is the following: how many 8-digit numbers have the sum of
their digits equal to 17?
The brute-force answer could be:

maxi <- 9 # digits from 0 to 9
N <- 5 # 8 is too large
test <- 17 # for example's sake

sum(rowSums(do.call(expand.grid, c(list(1:maxi), rep(list(0:maxi),
N-1)))) == test)
## 3675

Now, if I make N = 8, R stalls for some time and finally gives up with:
Error: cannot allocate vector of size 343.3 Mb

I thought I could get around this using Reduce() to recursively apply
rowSum to intermediate results, but it doesn't seem to help,


a=list(1:maxi)
b=rep(list(0:maxi), N-1)

foo <- function(a, b, fun="sum", ...){
 switch(fun,
        'sum' =  rowSums(do.call(expand.grid, c(a, b))),
        'mean' =  rowMeans(do.call(expand.grid, c(a, b))),
        apply(do.call(expand.grid, c(a, b)), 1, fun, ...)) # generic case
}

sum(Reduce(foo, list(b), init=a) == test)
## 3675 # OK

Same problem with N=8.

Now, if N was fixed I could write a little C code to do this
calculation term-by-term, something along those lines,

test = 0;

for (i1=1, i1=9, i1++) {
 for (i2=0, i2=9, i2++) {

 [... other nested loops ]

 test = test + (i1 + i2 + [...] == 17);

 } [...]
}

but here the number of for loops, N, should remain a variable.

In despair I coded this in R as a wicked eval(parse()) construct, and
it does produce the expected result after an awfully long time.

makeNestedLoops <- function(N=3){

 startLoop <- function(ii, start=1, end=9){
   paste("for (i", ii, " in seq(",start,", ",end,")) {\n", sep="")
 }

 first <- startLoop(1)
 inner.start <- lapply(seq(2, N), startLoop, start=0)
 calculation <- paste("test <- test + (", paste("i", seq(1, N),
sep="", collapse="+"), "==17 )\n")
 end <- replicate(N, "}\n")
 code.to.run <- do.call(paste, c(list(first), inner.start, calculation,
end))
 cat(code.to.run)
 invisible(code.to.run)
}

test <- 0
eval(parse(text = makeNestedLoops(8)) )
## 229713

I hope I have missed a better way to do this in R. Otherwise, I
believe what I'm after is some kind of C or C++ macro expansion,
because the number of loops should not be hard coded.

Thanks for any tips you may have!

Best regards,

baptiste

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

--
Robin K. S. Hankin
Uncertainty Analyst
University of Cambridge
19 Silver Street
Cambridge CB3 9EP
01223-764877

--
Robin K. S. Hankin
Uncertainty Analyst
University of Cambridge
19 Silver Street
Cambridge CB3 9EP
01223-764877

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