Chapter 6: Tail trees

Figure 1

```library(copula)

d<-2
family="clayton"
n<-2000
param<-4
c.cop<-archmCopula(family=family,param=param,dim=d)
set.seed(3)
dendat<-rcopula(c.cop, n)
df<-4
dendat<-qt(dendat, df=df)

mpoint<-matrix(0,1,d)
for (i in 1:d) mpoint[1,i]<-mean(dendat[,i])

dendat2<-matrix(0,n,d)
found<-0
for (i in 1:n){
point<-dendat[i,]
distan<-sqrt(sum((point-mpoint)^2))
found<-found+1
dendat2[found,]<-point
}
}
dendat2<-dendat2[1:found,]

dendat3<-matrix(0,n,d)
found<-0
for (i in 1:n){
point<-dendat[i,]
distan<-sqrt(sum((point-mpoint)^2))
found<-found+1
dendat3[found,]<-point
}
}
dendat3<-dendat3[1:found,]

# frame 1
ru<-11
rl<--7
plot(dendat,xlim=c(rl,ru),ylim=c(rl,ru),
xlab="coordinate 1",ylab="coordinate 2")

# frame 2
plot(dendat2,xlim=c(rl,ru),ylim=c(rl,ru),
xlab="coordinate 1",ylab="coordinate 2")

# frame 3
plot(dendat3,xlim=c(rl,ru),ylim=c(rl,ru),
xlab="coordinate 1",ylab="coordinate 2")
```

Figure 2

```library(copula)

d<-2
family="clayton"
n<-2000
param<-4
c.cop<-archmCopula(family=family,param=param,dim=d)
set.seed(3)
dendat<-rcopula(c.cop, n)
df<-4
dendat<-qt(dendat, df=df)

rho<-1.1
tt<-leafsfirst(dendat=dendat,rho=rho)

paletti<-c("red","blue","green",
"orange","navy","darkgreen",
"orchid","aquamarine","turquoise",
"pink","violet","magenta","chocolate","cyan",
colors()[50:657],colors()[50:657])

# frame 1
ru<-11
rl<--7
ts<-tree.segme(tt,paletti=paletti)
plot(dendat,col=ts,xlim=c(rl,ru),ylim=c(rl,ru),
xlab="coordinate 1",ylab="coordinate 2")
text(-4.8,-6,labels="T1",cex=1.5)
text(-0.3,9,labels="T2",cex=1.5)
text(10,3,labels="T3",cex=1.5)

# frame 2
plottree(tt,modelabel=TRUE,colo=TRUE,paletti=paletti,#col=col,linecol=col,
ptext=0.6,symbo="T",cex=1.5,
xmarginright=0.05,xmarginleft=0.05)
```

Figure 3

```d<-2
n<-11
dendat<-matrix(0,n,d)
dendat[1,]<-c(0,0)
# upper tail
dendat[2,]<-c(0,1)
dendat[3,]<-c(0,2)
dendat[4,]<-c(0,3)
# left ear
dendat[5,]<-c(-1,3.6)
# right ear
dendat[6,]<-c(1,4)
# lower tail
dendat[7,]<-c(-0.1,-1.2)
dendat[8,]<-c(-0.1,-2)
dendat[9,]<-c(-0.1,-2.8)
# nose
dendat[10,]<-c(0.8,0)
dendat[11,]<-c(2,0)

refe<-c(0,0)
rho2<-0.75
tt2<-leafsfirst(dendat=dendat,rho=rho2,refe=refe)
tt.illu<-tt2

paletti<-c("red","blue","green",
"orange","navy","darkgreen",
"orchid","aquamarine","turquoise",
"pink","violet","magenta","chocolate","cyan")
col<-colobary(tt2\$parent,paletti)

epsi<-0.0000001

ota1<-c(2,3,4,5,6,7,8,9,11)
ota2<-c(5,6)

# frame 1
plot(dendat[tt2\$infopoint,],col=col,xlab="coordinate 1",ylab="coordinate 2",
pch=19,cex=2) #,xlim=c(-3,3),ylim=c(-3,3))
for (i in 1:n){
z<-dendat[i,]
ala<-z[1]-rho2+epsi
yla<-z[1]+rho2-epsi
}

# frame 2
plot(dendat[tt2\$infopoint,],col=col,xlab="coordinate 1",ylab="coordinate 2",
pch=19,cex=2) #,xlim=c(-3,3),ylim=c(-3,3))
for (i in ota1){
z<-dendat[i,]
ala<-z[1]-rho2+epsi
yla<-z[1]+rho2-epsi
}

# frame 3
plot(dendat[tt2\$infopoint,],col=col,xlab="coordinate 1",ylab="coordinate 2",
pch=19,cex=2) #,xlim=c(-3,3),ylim=c(-3,3))
for (i in ota2){
z<-dendat[i,]
ala<-z[1]-rho2+epsi
yla<-z[1]+rho2-epsi
}

# frame 4
plottree(tt2,col=col,ptext=0.2,pch=19,linecol=col,
xmarginleft=0.1,xmarginright=0.1,symbo="T",
cex=1.5,nodemag=1.5,linemag=2)
```

Figure 4

```library(copula)

d<-2
family="clayton"
n<-2000
param<-4
c.cop<-archmCopula(family=family,param=param,dim=d)
set.seed(3)
dendat<-rcopula(c.cop, n)
df<-4
dendat<-qt(dendat, df=df)

rho<-1.1
tt<-leafsfirst(dendat=dendat,rho=rho)

# frame 1
plotbary(tt,coordi=1,modelabel=TRUE,symbo="T",ptext=0.6)

# frame 2
plotbary(tt,coordi=2,modelabel=TRUE,symbo="T",ptext=0.6)
```

Figure 5

```d<-2
n<-11
dendat<-matrix(0,n,d)
dendat[1,]<-c(0,0)
# upper tail
dendat[2,]<-c(0,1)
dendat[3,]<-c(0,2)
dendat[4,]<-c(0,3)
# left ear
dendat[5,]<-c(-1,3.6)
# right ear
dendat[6,]<-c(1,4)
# lower tail
dendat[7,]<-c(-0.1,-1.2)
dendat[8,]<-c(-0.1,-2)
dendat[9,]<-c(-0.1,-2.8)
# nose
dendat[10,]<-c(0.8,0)
dendat[11,]<-c(2,0)

refe<-c(0,0)
rho2<-0.75
tt2<-leafsfirst(dendat=dendat,rho=rho2,refe=refe)

# frame 1
plotbary(tt2,coordi=1,ptext=0.2,symbo="T")

# frame 2
plotbary(tt2,coordi=2,ptext=0.2,symbo="T")
```

Figure 6

```sympoli<-seq(20,25,1)

# ball slices
dendat.slice<-matrix(0,1000,2)
culot<-matrix(0,1000,1)
sympot<-matrix(0,1000,1)
level<-matrix(0,1000,1)
step<-0.1
yyt<-c(-0.9,-0.5,0,0.4,0.8)
cur<-0
for (i in 1:length(yyt)){
y<-yyt[i]
xbeg<--sqrt(1-y^2)
xend<-sqrt(1-y^2)
x<-seq(xbeg,xend,step)
dendat.slice[(cur+1):(cur+length(x)),1]<-x
dendat.slice[(cur+1):(cur+length(x)),2]<-y
culot[(cur+1):(cur+length(x))]<-i
sympot[(cur+1):(cur+length(x))]<-sympoli[i]
level[(cur+1):(cur+length(x))]<-sqrt(x^2+y^2)
cur<-cur+length(x)
}
dendat.slice<-dendat.slice[1:cur,]
culot<-culot[1:cur]
sympot<-sympot[1:cur]
level<-level[1:cur]

# frame 1
plot(dendat.slice,xlim=c(-1,1),ylim=c(-1,1),col=culot,pch=sympot,
xlab="coordinate 1",ylab="coordinate 2",cex=1.5)

# frame 2
plot(dendat.slice[,1],level,col=culot,pch=sympot,xlab="coordinate 1",cex=1.5)

# frame 3
plot(dendat.slice[,2],level,col=culot,pch=sympot,xlab="coordinate 2",cex=1.5)

```

Figure 7

```sympoli<-seq(20,25,1)

# ball spheres
r<-c(0.2,0.4,0.6,0.8,1)
theta<-seq(0.1,2*pi,0.2)
n<-length(r)*length(theta)
dendat.spheres<-matrix(0,n,2)
lavel<-matrix(0,n,1)
calot<-matrix(0,n,1)
sympot<-matrix(0,n,1)
ind<-0
for (i in 1:length(r)){
for (j in 1:length(theta)){
x<-r[i]*cos(theta[j])
y<-r[i]*sin(theta[j])
ind<-ind+1
dendat.spheres[ind,1]<-x
dendat.spheres[ind,2]<-y
lavel[ind]<-r[i]
calot[ind]<-i
sympot[ind]<-sympoli[i]

}
}

# frame 1
plot(dendat.spheres,col=calot,pch=sympot,cex=1.5,
xlab="coordinate 1",ylab="coordinate 2")

# frame 2
plot(dendat.spheres[,1],lavel,ylim=c(0,1),col=calot,pch=sympot,cex=1.5,
xlab="coordinate 1",ylab="level")

# frame 3
plot(dendat.spheres[,2],lavel,ylim=c(0,1),col=calot,pch=sympot,cex=1.5,
xlab="coordinate 2",ylab="level")
```

Figure 8

```library(copula)

g<-5
seed<-5
n<-2000

family="frank"
c.cop<-archmCopula(family, param=g, dim=2)
set.seed(seed)
dendat<-rcopula(c.cop, n=n)

dendat<-qnorm(dendat)
rl<-min(dendat)
ru<-max(dendat)

rho<-1.1
tt<-leafsfirst(dendat=dendat,rho=rho)

# frame 1
plotbary(tt,coordi=1)

# frame 2
plotbary(tt,coordi=1,lines=FALSE)
```

Figure 9

```seed<-1
type<-"cross"
n<-1000
d<-2
dendat<-sim.data(n=n,type=type,seed=seed)

cente<-c(mean(dendat[,1]),mean(dendat[,2]))
level2<-sqrt(pituus(dendat-cente))

rho<-0.65
tt<-leafsfirst(dendat=dendat,rho=rho)

# frame 1
i<-1
plot(dendat[,i],level2,ylab="level",xlab="")
title(sub=paste("coordinate",as.character(i)))

# frame 2
i<-2
plot(dendat[,i],level2,ylab="level",xlab="")
title(sub=paste("coordinate",as.character(i)))

# frame 3
plotbary(tt,modelabel=FALSE,paletti=seq(1:2000))

# frame 4
plotbary(tt,coordi=2,modelabel=FALSE,paletti=seq(1:2000))
```

Figure 10

```# Ball
seed<-1
n<-1000
d<-2
dendat.ball<-matrix(0,n,d)
set.seed(seed)
nolla<-rep(0,d)
saatu<-0
while (saatu

Figure 11

d<-2
mixnum<-1
M<-matrix(0,mixnum,d)
sig<-matrix(1,mixnum,d)
p<-matrix(1,mixnum,1)
p<-p/sum(p)
n<-2000
sig[1,1]<-2
dendat<-sim.data(n,M=M,sig=sig,p=p,seed=1,type="mixt")

rot45<-matrix(0,d,d)
basis1<-c(1,1)
basis2<-c(-1,1)
basis1<-basis1/sqrt(sum(basis1^2))
basis2<-basis2/sqrt(sum(basis2^2))
rot45[,1]<-basis1
rot45[,2]<-basis2

rho<-1.4

paletti<-c("red","blue","green",
"orange","navy","darkgreen",
"orchid","aquamarine","turquoise",
"pink","violet","magenta","chocolate","cyan",
colors()[50:657],colors()[50:657])

# frame 1
dendat.rot<-dendat%*%rot45
dendat<-dendat.rot
tt<-leafsfirst(dendat=dendat,rho=rho)
r<-7
ts<-tree.segme(tt,paletti=paletti)
plot(dendat,col=ts,xlim=c(-r,r),ylim=c(-r,r),
xlab="coordinate 1",ylab="coordinate 2")
text(5,-5,"T2");text(-5,5,"T1")

# frame 2
plotbary(tt,coordi=1,modelabel=TRUE,symbo="T",ptext=0.3)

# frame 3
plotbary(tt,coordi=2,modelabel=TRUE,symbo="T",ptext=0.3)

# frame 4
dendat.rot<-dendat%*%rot45
dendat<-dendat.rot
tt<-leafsfirst(dendat=dendat,rho=rho)
r<-7
ts<-tree.segme(tt,paletti=paletti)
plot(dendat,col=ts,xlim=c(-r,r),ylim=c(-r,r),
xlab="coordinate 1",ylab="coordinate 2")
text(0,-6.8,"T2");text(-0.1,6.8,"T1")

# frame 5
plotbary(tt,coordi=1,modelabel=TRUE,symbo="T",ptext=0.3)

# frame 6
plotbary(tt,coordi=2,modelabel=TRUE,symbo="T",ptext=0.3)

# frame 7
dendat.rot<-dendat%*%rot45
dendat<-dendat.rot
tt<-leafsfirst(dendat=dendat,rho=rho)
r<-7
ts<-tree.segme(tt,paletti=paletti)
plot(dendat,col=ts,xlim=c(-r,r),ylim=c(-r,r),
xlab="coordinate 1",ylab="coordinate 2")
text(-5,-5,"21");text(5,5,"T1")

# frame 8
plotbary(tt,coordi=1,modelabel=TRUE,symbo="T",ptext=0.3)

# frame 9
plotbary(tt,coordi=2,modelabel=TRUE,symbo="T",ptext=0.3)

Figure 12

r<-0
cova<-matrix(1,2,2)
cova[1,2]<-r
cova[2,1]<-r
t<-4
seed<-3
n<-1000
dendat<-sim.data(n=n,cova=cova,type="gauss",marginal="student",t=t,seed=seed)
rl<-min(dendat)
ru<-max(dendat)

rho<-1.5
tt<-leafsfirst(dendat=dendat,rho=rho)

ts<-tree.segme(tt)

# frame 1
plot(dendat,col=ts,xlim=c(rl,ru),ylim=c(rl,ru),
xlab="coordinate 1",ylab="coordinate 2")
#for (i in 1:dim(mc)[1]) text(mc[i,1],mc[i,2],"T1")
text(1,-6,"T4")
text(8,-0,"T2")
text(0,9,"T1")
text(-6,0,"T3")

# frame 2
plotbary(tt,coordi=1,modelabel=TRUE,symbo="T",ptext=0.3)

# frame 3
plotbary(tt,coordi=2,modelabel=TRUE,symbo="T",ptext=0.3)

Figure 13

r<-0.5
cova<-matrix(1,2,2)
cova[1,2]<-r
cova[2,1]<-r
t<-3
seed<-4
n<-1000
dendat<-sim.data(n=n,cova=cova,type="gauss",marginal="student",t=t,seed=seed)
rl<-min(dendat)
ru<-max(dendat)

rho<-1.6
tt<-leafsfirst(dendat=dendat,rho=rho)

ts<-tree.segme(tt)

# frame 1
plot(dendat,col=ts,xlim=c(rl,ru),ylim=c(rl,ru),
xlab="coordinate 1",ylab="coordinate 2")
text(1,-9,"T3")
text(9,-0,"T1")
text(0,9,"T2")
text(-9,0,"T4")

# frame 2
plotbary(tt,coordi=1,modelabel=TRUE,symbo="T",ptext=0.3)

# frame 3
plotbary(tt,coordi=2,modelabel=TRUE,symbo="T",ptext=0.3)

Figure 14

r<-0.6
cova<-matrix(1,2,2)
cova[1,2]<-r
cova[2,1]<-r
n<-1000
seed<-2
t<-2
dendat<-sim.data(n=n,cova=cova,type="student",marginal="gauss",df=t,seed=seed)
rl<-min(dendat)
ru<-max(dendat)

rho<-1
tt<-leafsfirst(dendat=dendat,rho=rho)

ts<-tree.segme(tt)

# frame 1
plot(dendat,col=ts,xlim=c(rl,ru),ylim=c(rl,ru),
xlab="coordinate 1",ylab="coordinate 2")
text(-3,-3,"T4")
text(3,-3,"T3")
text(3.3,3.3,"T1")
text(-3,3,"T2")

# frame 2
plotbary(tt,coordi=1,modelabel=TRUE,symbo="T",ptext=0.3)

# frame 3
plotbary(tt,coordi=2,modelabel=TRUE,symbo="T",ptext=0.3)

Figure 15

library(copula)

g<-4
seed<-2
n<-1000

family="clayton"
c.cop<-archmCopula(family, param=g, dim=2)
set.seed(seed)
dendat<-rcopula(c.cop, n=n)

dendat<-qnorm(dendat)
rl<-min(dendat)
ru<-max(dendat)

rho<-1
tt<-leafsfirst(dendat=dendat,rho=rho)

ts<-tree.segme(tt)

# frame 1
plot(dendat,col=ts,xlim=c(rl,ru),ylim=c(rl,ru),
xlab="coordinate 1",ylab="coordinate 2")
text(-3,-3.2,"T1")
text(3,3,"T2")

# frame 2
plotbary(tt,coordi=1,modelabel=TRUE,symbo="T",ptext=0.3)

# frame 3
plotbary(tt,coordi=2,modelabel=TRUE,symbo="T",ptext=0.3)

Figure 16

library(copula)

g<-3
seed<-2
n<-1000

family="gumbel"
c.cop<-archmCopula(family, param=g, dim=2)
set.seed(seed)
dendat<-rcopula(c.cop, n=n)
mean(dendat[,1])
mean(dendat[,2])

dendat<-qnorm(dendat)
rl<-min(dendat)
ru<-max(dendat)

rho<-1
tt<-leafsfirst(dendat=dendat,rho=rho)

ts<-tree.segme(tt)

# frame 1
plot(dendat,col=ts,xlim=c(rl,ru),ylim=c(rl,ru),
xlab="coordinate 1",ylab="coordinate 2")
text(-3,-3.2,"T2")
text(2.8,3.2,"T1")

# frame 2
plotbary(tt,coordi=1,modelabel=TRUE,symbo="T",ptext=0.3)

# frame 3
plotbary(tt,coordi=2,modelabel=TRUE,symbo="T",ptext=0.3)

Figure 17

library(copula)

g<-5
seed<-5
n<-2000

family="frank"
c.cop<-archmCopula(family, param=g, dim=2)
set.seed(seed)
dendat<-rcopula(c.cop, n=n)
mean(dendat[,1])
mean(dendat[,2])

dendat<-qnorm(dendat)
rl<-min(dendat)
ru<-max(dendat)

rho<-1.1
tt<-leafsfirst(dendat=dendat,rho=rho)

ts<-tree.segme(tt)

# frame 1
plot(dendat,col=ts,xlim=c(rl,ru),ylim=c(rl,ru),
xlab="coordinate 1",ylab="coordinate 2")
text(-3,-3.2,"T2")
text(2.8,3.2,"T1")

# frame 2
plotbary(tt,coordi=1,modelabel=TRUE,symbo="T",ptext=0.3)

# frame 3
plotbary(tt,coordi=2,modelabel=TRUE,symbo="T",ptext=0.3)

Figure 18

library(copula)

d<-2
family="clayton"
n<-2000
param<-4
c.cop<-archmCopula(family=family,param=param,dim=d)
set.seed(3)
dendat<-rcopula(c.cop, n)
df<-4
dendat<-qt(dendat, df=df)

rho<-1.1
tt<-leafsfirst(dendat=dendat,rho=rho)

# frame 1
plotvolu(tt,colo=TRUE,modelabel=TRUE,symbo="T",ptext=0.5,cex=1.5)

# frame 2
plotvolu(tt,colo=TRUE,modelabel=TRUE,xlim=c(1130,1170),
symbo="T",ptext=0.5,cex=1.5)

Figure 19

d<-2
n<-11
dendat<-matrix(0,n,d)
dendat[1,]<-c(0,0)
# upper tail
dendat[2,]<-c(0,1)
dendat[3,]<-c(0,2)
dendat[4,]<-c(0,3)
# left ear
dendat[5,]<-c(-1,3.6)
# right ear
dendat[6,]<-c(1,4)
# lower tail
dendat[7,]<-c(-0.1,-1.2)
dendat[8,]<-c(-0.1,-2)
dendat[9,]<-c(-0.1,-2.8)
# nose
dendat[10,]<-c(0.8,0)
dendat[11,]<-c(2,0)

refe<-c(0,0)
rho2<-0.75
tt2<-leafsfirst(dendat=dendat,rho=rho2,refe=refe)

# frame
plotvolu(tt2,ptext=0.2,symbo="T",colo=TRUE,modelabel=TRUE,cex=1.5)

Figure 20

# Ball
seed<-1
n<-1000
d<-2
dendat.ball<-matrix(0,n,d)
set.seed(seed)
nolla<-rep(0,d)
saatu<-0
while (saatu

Figure 21

r<-0
cova<-matrix(1,2,2)
cova[1,2]<-r
cova[2,1]<-r
t<-4
seed<-3
n<-1000
dendat<-sim.data(n=n,cova=cova,type="gauss",marginal="student",t=t,seed=seed)
rl<-min(dendat)
ru<-max(dendat)
rho<-1.5
tt.gaussr0<-leafsfirst(dendat=dendat,rho=rho)

r<-0.5
cova<-matrix(1,2,2)
cova[1,2]<-r
cova[2,1]<-r
t<-3
seed<-4
n<-1000
dendat<-sim.data(n=n,cova=cova,type="gauss",marginal="student",t=t,seed=seed)
rl<-min(dendat)
ru<-max(dendat)
rho<-1.6
tt.gaussr5<-leafsfirst(dendat=dendat,rho=rho)

r<-0.6
cova<-matrix(1,2,2)
cova[1,2]<-r
cova[2,1]<-r
n<-1000
seed<-2
t<-2
dendat<-sim.data(n=n,cova=cova,type="student",marginal="gauss",df=t,seed=seed)
rl<-min(dendat)
ru<-max(dendat)
rho<-1
tt.student<-leafsfirst(dendat=dendat,rho=rho)

# frame 1
plotvolu(tt.gaussr0,modelabel=FALSE,colo=TRUE)

# frame 2
plotvolu(tt.gaussr5,modelabel=FALSE,colo=TRUE)

# frame 3
plotvolu(tt.student,modelabel=FALSE,colo=TRUE)

# frame 4
plotvolu(tt.gaussr0,modelabel=FALSE,colo=TRUE,xlim=c(450,550))

# frame 5
plotvolu(tt.gaussr5,modelabel=FALSE,colo=TRUE,xlim=c(440,560))

# frame 6
plotvolu(tt.student,modelabel=FALSE,colo=TRUE,xlim=c(440,560))

Figure 22

library(copula)

g<-4
seed<-2
n<-1000
family="clayton"
c.cop<-archmCopula(family, param=g, dim=2)
set.seed(seed)
dendat<-rcopula(c.cop, n=n)
dendat<-qnorm(dendat)
rl<-min(dendat)
ru<-max(dendat)
rho<-1
tt<-leafsfirst(dendat=dendat,rho=rho)
tt.clayton<-tt

g<-3
seed<-2
n<-1000
family="gumbel"
c.cop<-archmCopula(family, param=g, dim=2)
set.seed(seed)
dendat<-rcopula(c.cop, n=n)
dendat<-qnorm(dendat)
rl<-min(dendat)
ru<-max(dendat)
rho<-1
tt.gumbel<-leafsfirst(dendat=dendat,rho=rho)

g<-5
seed<-5
n<-2000
family="frank"
c.cop<-archmCopula(family, param=g, dim=2)
set.seed(seed)
dendat<-rcopula(c.cop, n=n)
dendat<-qnorm(dendat)
rl<-min(dendat)
ru<-max(dendat)
rho<-1.1
tt.frank<-leafsfirst(dendat=dendat,rho=rho)

# frame 1
plotvolu(tt.clayton,modelabel=FALSE,colo=TRUE)

# frame 2
plotvolu(tt.gumbel,modelabel=FALSE,colo=TRUE)

# frame 3
plotvolu(tt.frank,modelabel=FALSE,colo=TRUE)

```