[R] sapply and loop

[Zhen Pang]

Below is my code. myfunction is the myfunction I mentioned in my last email.

p0<-.2
rho0<-.2

nl<-200
simu<-200
set.seed(135)
setwd("d:/r")
options(warn=1)
ns<-rep(1,nl)
configuration<-runif(nl)
frequency<-c(0.0046,0.0057,0.0099,0.0139,0.0147,0.0148,0.0225,0.0321,0.0475,0.0766,0.1179,0.1529,0.1605,0.1424,0.0975,0.0542,0.0207,0.0086,0.0030)

for (i in 1:nl)
    {if (configuration[i]<=frequency[1]) {ns[i]<-1
         } else {for (j in 2:length(frequency))
                      {if (sum(frequency[1:(j-1)])<configuration[i] & 
configuration[i]<=sum(frequency[1:j]))       {ns[i]<-j}
                       }
                 }
     }

nu<-unique(ns)
k<-max(nu)
a<-vector(simu,mode="list")

for (si in 1:simu)
{
print ("si")
print (si)
data<-c(0,0,0)
for (iu in 1:length(nu))
   {fr<-length(ns[ns==nu[iu]])
    y<-rep(0,fr)
    for (ju in 1:fr)
       
{y[ju]<-rbinom(1,nu[iu],rbeta(1,(1-rho0)*p0/rho0,(1-rho0)*(1-p0)/rho0))
        }
    yu<-sort(unique(y))
    yy<-rep(0,length(yu))
    for (ku in 1:length(yu))
       {yy[ku]<-length(y[y==yu[ku]])
        }
    ma<-cbind(rep(nu[iu],length(yu)),yu,yy)
    data<-rbind(data,ma)
    }
data<-data[-1,]
a[[si]]<-data
}

myfunction<-function(data)
{
llb<-function(theta)
{
s <- apply(data, 1, function(data) {
n<-data[1]; y<-data[2] ; re<-data[3]
	p<-1/(1+exp(-theta[1]))
        t <- exp(theta[2])
	s <- log(choose(n,y))
	r<-c(0:(n-1))
	s <- s-sum(log(1+r*t))
	if (n-y-1>=0)
	{
	r<-c(0:(n-y-1))
	s <- s+sum(log(1-p+r*t))
	}
        if (y-1>=0)
        {r<-c(0:(y-1))
	 s<- s+sum(log(p+r*t))
	}
s*re
})
-sum(s)
}
est2<-optim(c(log(p0/(1-p0)),log(rho0/(1-rho0))),llb,hessian=T,control = 
list(maxit=5000000))
est2$par
}

zz<-sapply(a,myfunction)


If we move the myfucntion to the for(si in 1:simu) loop, results are the 
same and there are no time spare. Can you improve a little? Thanks.

Zhen



>From: "Liaw, Andy" <andy_liaw at merck.com>
>To: "'Zhen Pang'" <nusbj at hotmail.com>, r-help at stat.math.ethz.ch
>Subject: RE: [R] sapply and loop
>Date: Sat, 16 Oct 2004 08:23:54 -0400
>
>Without seeing what myfunction is, it's almost impossible to tell.
>
>In addition to system.time(), you might want to profile your code.  e.g.,
>
>Rprof()
>zz <- sapply(ma, myfunction)
>Rprof(NULL)
>summaryRprof()
>
>HTH,
>Andy
>
> > From: Zhen Pang
> >
> > Dear all,
> >
> > I am doing 200 times simulation. For each time, I generate a
> > matrix and
> > define some function on this matrix to get a 6 dimension vector as my
> > results.
> >
> > As the loop should be slow, I generate 200 matrice first, and
> > save them into
> > a list named ma,
> > then I define zz<-sapply(ma, myfunction)
> >
> > To my surprise, It almost costs me the same time to get my
> > results if I
> > directly use a loop from 1 to 200. Is it common? Can I
> > improve any further?
> >
> > Ps, how to count the exact time to finish my code?
> >
> > Thanks.
> >
> > Zhen
> >
> > ______________________________________________
> > R-help at stat.math.ethz.ch mailing list
> > https://stat.ethz.ch/mailman/listinfo/r-help
> > PLEASE do read the posting guide!
> > http://www.R-project.org/posting-guide.html
> >
> >
>
>______________________________________________
>R-help at stat.math.ethz.ch mailing list
>https://stat.ethz.ch/mailman/listinfo/r-help
>PLEASE do read the posting guide! 
>http://www.R-project.org/posting-guide.html