[R] looking for a smarter way

[Laurent Gautier]

----------------------
> I have two problems where I've come up with some code that will do the
> analysis that I want, but it looks pretty clumsy.  In the first case, I
> calculate the variance on five different columns for each of 14 clusters and
> get them into one matrix.  I get the job done, but I would have thought that
> it could be done in one or two lines, not six, and be generalized so that it
> didn't matter how many columns I had.  Any suggestions?
> 
> xtap1<-tapply(xcmd[,1],xclu$clustering,var)
> xtap2<-tapply(xcmd[,2],xclu$clustering,var)
> xtap3<-tapply(xcmd[,3],xclu$clustering,var)
> xtap4<-tapply(xcmd[,4],xclu$clustering,var)
> xtap5<-tapply(xcmd[,5],xclu$clustering,var)
> xtap<-cbind(xtap1,xtap2,xtap3,xtap4,xtap5)







..got it in one line...

> apply(xcmd,2,function(x) {tapply(x,xclu$clustering,var)})


...the other one can be done this way too





regards,



Laurent






> The next example is somewhat similar, but I'm trying to calculate a
> Shannon-weaver information index for each cluster based on the proportion of
> objects with each "local.name".  I start by tabulating the frequency of
> presence of each local.name in each cluster.  The code does what I want, but
> I have other examples where I have hundreds of clusters and I would prefer
> not to have to type in a line for each cluster.  Again, there must be a way
> and I would appreciate any suggestions:
> 
> xtab<-table(x$LOCAL.NAME,xclu$clustering)
> xshw1<--sum((xtab[,1]+0.000001)/sum(xtab[,1])*(log((xtab[,1]+0.000001)/sum(x
> tab[,1]))))
> xshw2<--sum((xtab[,2]+0.000001)/sum(xtab[,2])*(log((xtab[,2]+0.000001)/sum(x
> tab[,2]))))
> xshw3<--sum((xtab[,3]+0.000001)/sum(xtab[,3])*(log((xtab[,3]+0.000001)/sum(x
> tab[,3]))))
> xshw4<--sum((xtab[,4]+0.000001)/sum(xtab[,4])*(log((xtab[,4]+0.000001)/sum(x
> tab[,4]))))
> xshw5<--sum((xtab[,5]+0.000001)/sum(xtab[,5])*(log((xtab[,5]+0.000001)/sum(x
> tab[,5]))))
> xshw6<--sum((xtab[,6]+0.000001)/sum(xtab[,6])*(log((xtab[,6]+0.000001)/sum(x
> tab[,6]))))
> xshw7<--sum((xtab[,7]+0.000001)/sum(xtab[,7])*(log((xtab[,7]+0.000001)/sum(x
> tab[,7]))))
> xshw8<--sum((xtab[,8]+0.000001)/sum(xtab[,8])*(log((xtab[,8]+0.000001)/sum(x
> tab[,8]))))
> xshw9<--sum((xtab[,9]+0.000001)/sum(xtab[,9])*(log((xtab[,9]+0.000001)/sum(x
> tab[,9]))))
> xshw10<--sum((xtab[,10]+0.000001)/sum(xtab[,10])*(log((xtab[,10]+0.000001)/s
> um(xtab[,10]))))
> xshw11<--sum((xtab[,11]+0.000001)/sum(xtab[,11])*(log((xtab[,11]+0.000001)/s
> um(xtab[,11]))))
> xshw12<--sum((xtab[,12]+0.000001)/sum(xtab[,12])*(log((xtab[,12]+0.000001)/s
> um(xtab[,12]))))
> xshw13<--sum((xtab[,13]+0.000001)/sum(xtab[,13])*(log((xtab[,13]+0.000001)/s
> um(xtab[,13]))))
> xshw14<--sum((xtab[,14]+0.000001)/sum(xtab[,14])*(log((xtab[,14]+0.000001)/s
> um(xtab[,14]))))
> xshw<-rbind(xshw1,xshw2,xshw3,xshw4,xshw5,xshw6,xshw7,xshw8,xshw9,xshw10,xsh
> w11,xshw12,xshw13,xshw14)
> xtap<-cbind(xtap1,xtap2,xtap3,xtap4,xtap5,(xtapx<-(xtap1+xtap2+xtap3+xtap4+x
> tap5)),xshw)
> 
> Thanks a lot in advance!!
> 
> Mikkel
> 
> Mikkel Grum, PhD
> Genetic Diversity Scientist
> International Plant Genetic Resources Institute (IPGRI)
> Sub-Saharan Africa Group
> ***
> c/o ICRAF
> PO Box 30677 Nairobi, Kenya
> m.grum at cgiar.org
> ipgri-kenya at cgiar.org
> www.ipgri.cgiar.org
> 
> -.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-
> r-help mailing list -- Read http://www.ci.tuwien.ac.at/~hornik/R/R-FAQ.html
> Send "info", "help", or "[un]subscribe"
> (in the "body", not the subject !)  To: r-help-request at stat.math.ethz.ch
> _._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._
> -.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-
> r-help mailing list -- Read http://www.ci.tuwien.ac.at/~hornik/R/R-FAQ.html
> Send "info", "help", or "[un]subscribe"
> (in the "body", not the subject !)  To: r-help-request at stat.math.ethz.ch
> _._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._

-- 
Laurent Gautier			CBS, Building 208, DTU
PhD. Student			D-2800 Lyngby,Denmark	
tel: +45 45 25 24 85		http://www.cbs.dtu.dk/laurent
-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-
r-help mailing list -- Read http://www.ci.tuwien.ac.at/~hornik/R/R-FAQ.html
Send "info", "help", or "[un]subscribe"
(in the "body", not the subject !)  To: r-help-request at stat.math.ethz.ch
_._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._