Re: [R] R scripts to plot Taylor Diagram

From: Olivier ETERRADOSSI <olivier.eterradossi_at_ema.fr>
Date: Tue 09 Jan 2007 - 10:17:52 GMT


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

______________________________________________
R-help@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
and provide commented, minimal, self-contained, reproducible code.
Received on Wed Jan 10 07:23:43 2007

Archive maintained by Robert King, hosted by the discipline of statistics at the University of Newcastle, Australia.
Archive generated by hypermail 2.1.8, at Tue 09 Jan 2007 - 20:30:32 GMT.

Mailing list information is available at https://stat.ethz.ch/mailman/listinfo/r-help. Please read the posting guide before posting to the list.