Suppose I have the following data:

tmp <- data.frame(var1 = sample(c(0:10), 3, replace = TRUE), var2 = 
sample(c(0:10), 3, replace = TRUE), var3 = sample(c(0:10), 3, replace = TRUE))

I can run the following double loop and yield what I want in the end (rr1) as:

library(statmod)
Q <- 2
b <- runif(3)
qq <- gauss.quad.prob(Q, dist = 'normal', mu = 0, sigma=1)
rr1 <- matrix(0, nrow = Q, ncol = nrow(tmp))
L <- nrow(tmp)
                for(j in 1:Q){
                                                for(i in 1:L){
                                                                rr1[j,i] <- 
exp(sum(log((exp(tmp[i,]*(qq$nodes[j]-b))) / (factorial(tmp[i,]) * 
exp(exp(qq$nodes[j]-b)))))) *
                                                                
((1/(s*sqrt(2*pi)))  * exp(-((qq$nodes[j]-0)^2/(2*s^2))))/dnorm(qq$nodes[j]) * 
qq$weights[j]
                                                }
                                }
rr1

But, I think this is so inefficient for large Q and nrow(tmp). The function I 
am looping over is:

fn <- function(x, nodes, weights, s, b) {
                exp(sum(log((exp(x*(nodes-b))) / (factorial(x) * 
exp(exp(nodes-b)))))) *
                ((1/(s*sqrt(2*pi)))  * 
exp(-((nodes-0)^2/(2*s^2))))/dnorm(nodes) * weights
                }

I've tried using apply in a few ways, but I can't replicate rr1 from the double 
loop. I can go through each value of Q one step at a time and get matching 
values in the rr1 table, but this would still require a loop and that I think 
can be avoided.

apply(tmp, 1, fn, nodes = qq$nodes[1], weights = qq$weights[1], s = 1, b = b)

Does anyone see an efficient way to compute rr1 without a loop?

Harold

> sessionInfo()
R version 2.10.1 (2009-12-14)
i386-pc-mingw32

locale:
[1] LC_COLLATE=English_United States.1252  LC_CTYPE=English_United States.1252  
  LC_MONETARY=English_United States.1252
[4] LC_NUMERIC=C                           LC_TIME=English_United States.1252

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base

other attached packages:
[1] minqa_1.1.9     Rcpp_0.8.6      MiscPsycho_1.6  statmod_1.4.6   
lattice_0.17-26 gdata_2.8.0

loaded via a namespace (and not attached):
[1] grid_2.10.1  gtools_2.6.2 tools_2.10.1

        [[alternative HTML version deleted]]

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

Reply via email to