[R] R scripts to plot Taylor Diagram

[Olivier ETERRADOSSI]

Happy New Year, dear useRs...and Linda.
I have a small toy-script that plots Taylor Diagrams for vectors, it is 
not wonderful but may help...
perhaps you can change some details for your own needs.
It is far from optimization,... perhaps someone can do this and put it 
into a package ?
Hope this helps.
Regards. Olivier
> # fonction TAYLOR
> # construction d'un diagramme de Taylor
> # Taylor K.E. "Summarizing multiple aspects of model performance in a 
> single diagram"
> # J. Geophys. Res., 106, 7183-7192, 2001
>
> # version 1.0
> # progr. Olivier.Eterradossi, 12/2007
>
> Taylor<-function(ref,batch,add=F,couleur="red"){ # ref, batch : vecteurs
> x<- ref
> y<- batch
>
> grad.corr.full<-c(0,0.2,0.4,0.6,0.8,0.9,0.95,0.99,1)
> grad.corr.lines<-c(0.2,0.4,0.6,0.8,0.9)
>
> R<-cor(x,y,use="pairwise")
>
> sd.r<-sd(x)
> sd.f<-sd(y)
>
> if (add==F) {
> # pourtour du diagramme
> maxray<-1.5*max(sd.f,sd.r)
> plot(c(-maxray,maxray),c(0,maxray),type="n",asp=1,bty="n",xaxt="n",yaxt="n",xlab="",ylab="",main="Taylor 
> Diagram")
> discrete<-seq(180,0,by=-1)
> listepoints<-NULL
> for (i in discrete){
> listepoints<-cbind(listepoints,maxray*cos(i*pi/180),maxray*sin(i*pi/180))
> }
> listepoints<-matrix(listepoints,2,length(listepoints)/2)
> listepoints<-t(listepoints)
> lines(listepoints[,1],listepoints[,2])
>
> # axes x,y
> lines(c(-maxray,maxray),c(0,0))
> lines(c(0,0),c(0,maxray))
>
> # lignes radiales jusqu'à R = +/- 0.8
> for (i in grad.corr.lines){
> lines(c(0,maxray*i),c(0,maxray*sqrt(1-i^2)),lty=3)
> lines(c(0,-maxray*i),c(0,maxray*sqrt(1-i^2)),lty=3)
> }
>
> # texte radial
> for (i in grad.corr.full){
>
> text(1.05*maxray*i,1.05*maxray*sqrt(1-i^2),i,cex=0.6)
> text(-1.05*maxray*i,1.05*maxray*sqrt(1-i^2),-i,cex=0.6)
> }
>
> # sd concentriques autour de la reference
>
> seq.sd<-seq.int(0,2*maxray,by=(maxray/10))
> for (i in seq.sd){
> xcircle<-sd.r+(cos(discrete*pi/180)*i)
> ycircle<-sin(discrete*pi/180)*i
> for (j in 1:length(xcircle)){
> if 
> ((xcircle[j]^2+ycircle[j]^2)<(maxray^2)){points(xcircle[j],ycircle[j], 
> col="darkgreen",pch=".")
> if 
> (j==10){text(xcircle[j],ycircle[j],signif(i,2),cex=0.5,col="darkgreen")}}
> }
> }
>
>
> # sd concentriques autour de l'origine
>
> seq.sd<-seq.int(0,maxray,length.out=5)
> for (i in seq.sd){
> xcircle<-(cos(discrete*pi/180)*i)
> ycircle<-sin(discrete*pi/180)*i
>
> lines(xcircle,ycircle,lty=3,col="blue")
> text(min(xcircle),-0.03*maxray,signif(i,2),cex=0.5,col="blue")
> text(max(xcircle),-0.03*maxray,signif(i,2),cex=0.5,col="blue")
> }
>
> text(0,-0.08*maxray,"Standard Deviation",cex=0.7,col="blue")
> text(0,-0.12*maxray,"Centered RMS Difference",cex=0.7,col="darkgreen")
> points(sd.r,0,pch=22,bg="darkgreen",cex=1.1)
>
> text(0,1.1*maxray,"Correlation Coefficient",cex=0.7)
> }
>
>
> # placer les points
> points(sd.f*cos(acos(R)),sd.f*sin(acos(R)),pch=21,bg=couleur,cex=0.8)
> }
-- 

Olivier ETERRADOSSI
Maître-Assistant
CMGD / Equipe "Propriétés Psycho-Sensorielles des Matériaux"
Ecole des Mines d'Alès
Hélioparc, 2 av. P. Angot, F-64053 PAU CEDEX 9
tel std: +33 (0)5.59.30.54.25
nouveau tel direct: +33 (0)5.59.30.90.35 
fax: +33 (0)5.59.30.63.68
http://www.ema.fr