[R] Ternary plots

[Daniel Chessel]

At 18:08 19/03/01 +0000, David Lucy wrote:
>Hi everyone,
>
>Sorry about last message, the send key slipped. 
>
>Does anybody know about ternary (tertiary?) plotting functions for R -
>they're triangular things used much beloved by chemists for plotting
>compositional data.

You can try plot.triangle :

> euro78
              pri   sec   ter
Belgique    0.032 0.359 0.609
Danemark    0.079 0.319 0.602
Espagne     0.206 0.372 0.422
France      0.092 0.368 0.540
Grèce       0.320 0.297 0.383
Irlande     0.206 0.320 0.474
Italie      0.155 0.381 0.464
Luxembourg  0.062 0.392 0.546
Pays-Bas    0.054 0.330 0.616
Portugal    0.313 0.348 0.339
Allemagne   0.061 0.444 0.495
Royaume-Uni 0.028 0.390 0.582

> plot.triangle(euro78)

triangle_function(ta) {
 	if (ncol(ta)!=3) stop ("Non convenient data")
	if (min(ta)<0) stop ("Non convenient data")

	cal_matrix(0,9,3)
	tb_t(apply(ta,1,function(x) x/sum(x)))
	mini_apply(tb,2,min)
	maxi_apply(tb,2,max)
	mini_(floor(mini/.1))/10
	maxi_(floor(maxi/.1)+1)/10
	ampli_maxi-mini
	amplim_max(ampli)
	for (j in 1:3) {
		k_amplim-ampli[j]
		while (k>0) {
			if ((k>0) & (maxi[j]<1)) {
				maxi[j]_maxi[j]+0.1
				k_k-1
			}	
			if ((k>0) & (mini[j]>0)) {
				mini[j]_mini[j]-0.1
				k_k-1
			}	
		}
	}
	cal[1,1]_mini[1]; cal[1,2]_mini[2]; cal[1,3]_1-cal[1,1]-cal[1,2]
	cal[2,1]_mini[1]; cal[2,2]_maxi[2]; cal[2,3]_1-cal[2,1]-cal[2,2]
	cal[3,1]_maxi[1]; cal[3,2]_mini[2]; cal[3,3]_1-cal[3,1]-cal[3,2]

	cal[4,1]_mini[1]; cal[4,3]_mini[3]; cal[4,2]_1-cal[4,1]-cal[4,3]
	cal[5,1]_mini[1]; cal[5,3]_maxi[3]; cal[5,2]_1-cal[5,1]-cal[5,3]
	cal[6,1]_maxi[1]; cal[6,3]_mini[3]; cal[6,2]_1-cal[6,1]-cal[6,3]

	cal[7,2]_mini[2]; cal[7,3]_mini[3]; cal[7,1]_1-cal[7,2]-cal[7,3]
	cal[8,2]_mini[2]; cal[8,3]_maxi[3]; cal[8,1]_1-cal[8,2]-cal[8,3]
	cal[9,2]_maxi[2]; cal[9,3]_mini[3]; cal[9,1]_1-cal[9,2]-cal[9,3]
	mini_apply(cal,2,min)
	maxi_apply(cal,2,max)
	ampli_maxi-mini
	
	A_c(-1/sqrt(2),-1/sqrt(6));B_c(1/sqrt(2),-1/sqrt(6));C_c(0,2/sqrt(6))
	xy_t(apply(tb,1,FUN=posipoint,mini=mini,maxi=maxi))
	return (list(A=A,B=B,C=C, xy=xy, mini=mini, maxi=maxi))
}


plot.triangle_ function (ta,label=as.character(1:nrow(ta)),draw.line=T,
addaxes=F) {
	d_triangle(ta)
	op <- par(no.readonly = TRUE)# the whole list of settable par's
	par(mar=c(0,0,0,0))
	A_d$A; B_d$B; C_d$C; xy_d$xy; mini_d$mini; maxi_d$maxi
	A_d$A; B_d$B; C_d$C; xy_d$xy; mini_d$mini; maxi_d$maxi

plot(0,0,type="n",xlim=c(-.8,.8),ylim=c(-.6,1),xlab="",ylab="",xaxt="n",yaxt
="n")
	seg(A,B);seg(B,C);seg(C,A)
	points(xy)
	text(xy,label,pos=4)
	text(C[1],C[2],labels=paste(mini[1]),pos=2)
	text(C[1],C[2],labels=paste(maxi[3]),pos=4)
	text((A+C)[1]/2,(A+C)[2]/2,labels=names(ta)[1],cex=2,pos=2)

	text(A[1],A[2],labels=paste(maxi[1]),pos=2)
	text(A[1],A[2],labels=paste(mini[2]),pos=1)
	text((A+B)[1]/2,(A+B)[2]/2,labels=names(ta)[2],cex=2,pos=1)

	text(B[1],B[2],labels=paste(maxi[2]),pos=1)
	text(B[1],B[2],labels=paste(mini[3]),pos=4)
	text((B+C)[1]/2,(B+C)[2]/2,labels=names(ta)[3],cex=2,pos=4)

	if (draw.line) {
		nlg_10*(maxi[1]-mini[1])
		for (i in 1:(nlg-1)) {
			x1_A+(i/nlg)*(B-A) ; x2_C+(i/nlg)*(B-C) ; seg(x1,x2,lty=2)
			x1_A+(i/nlg)*(B-A) ; x2_A+(i/nlg)*(C-A) ; seg(x1,x2,lty=2)
			x1_C+(i/nlg)*(A-C) ; x2_C+(i/nlg)*(B-C) ; seg(x1,x2,lty=2)
		}
	}

	if (addaxes) {
		pr0_prcomp(ta)
		w1_posipoint (apply(ta,2,mean),mini,maxi)
		points(w1[1],w1[2],pch=16,cex=2)
		a1_pr0$rotation[,1];x1_a1[1]*A+a1[2]*B+a1[3]*C
		seg(w1-x1,w1+x1)
		a1_pr0$rotation[,2];x1_a1[1]*A+a1[2]*B+a1[3]*C
		seg(w1-x1,w1+x1)
	}
	par(op)
}

posipoint_function(x,mini,maxi) {
	x_(x-mini)/(maxi-mini)
	x_x/sum(x)
	x1_(x[2]-x[1])/sqrt(2)
	y1_(2*x[3]-x[2]-x[1])/sqrt(6)
	return(c(x1,y1))
}

seg_function(a,b, lty=1) {
	segments(a[1],a[2],b[1],b[2],lty=lty)
}

Daniel Chessel
Universite Lyon 1 - Biométrie et Biologie Evolutive - Bât 741
69622 Villeurbanne CEDEX
Tel : 04 72 44 82 77 - (33) 4 72 44 82 77

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