[[pro:relc:tol]]
Table of Contents
Tolerant
- Ferligoj, A, Batagelj, V: Some Types of Clustering with Relational Constraints. Psychometrika, vol. 48, no. 4, (1983), 541-552.
- Ferligoj, A, Batagelj, V: Clustering with relational constraint. Psychometrika 47 (4): 413-426 1982
- Batagelj, V, Doreian, P, Ferligoj, A and Kejžar, N: Understanding Large Temporal Networks and Spatial Networks: Exploration, Pattern Searching, Visualization and Network Evolution. Wiley Series in Computational and Quantitative Social Science. Wiley, 2014. see Pages 353-381
- Bodlaj, J., Batagelj, V.: Hierarchical link clustering algorithm in networks. Phys. Rev. E 91, 062814 (2015).
Read and prepare data
> wdir <- "C:/Users/batagelj/work/R/RelCon"
> setwd(wdir)
> a <- scan("C:/Users/batagelj/work/Delphi/Cluse/Cluse/data/RelCon/SomeTy.dis")
Read 55 items
> s <- length(a); n <- round((-1+sqrt(1+8*s))/2); nm <- n-1
> D <- matrix(0, nrow=n, ncol=n); D[lower.tri(D,diag=TRUE)] <- a; D <- D+t(D)
> netRel <- "C:/Users/batagelj/work/Delphi/Cluse/Cluse/data/RelCon/SomeTyXY.net"
> R <- read_Pajek_net(netRel,3)
> rownames(D) <- colnames(D) <- names(R); print(D)
a b c d e f g h i j
a 0 5 7 4 6 6 2 4 2 3
b 5 0 8 1 3 4 4 5 3 4
c 7 8 0 4 5 7 9 3 2 5
d 4 1 4 0 3 2 4 8 6 3
e 6 3 5 3 0 6 4 6 5 7
f 6 4 7 2 6 0 6 8 5 7
g 2 4 9 4 4 6 0 4 8 2
h 4 5 3 8 6 8 4 0 3 4
i 2 3 2 6 5 5 8 3 0 5
j 3 4 5 3 7 7 2 4 5 0
> DD <- as.dist(D); print(DD)
a b c d e f g h i
b 5
c 7 8
d 4 1 4
e 6 3 5 3
f 6 4 7 2 6
g 2 4 9 4 4 6
h 4 5 3 8 6 8 4
i 2 3 2 6 5 5 8 3
j 3 4 5 3 7 7 2 4 5
>
> Ro <- R
> Ri <- vector("list",length(R))
> names(Ri)<-names(R)
> for(i in 1:length(R)) for(j in R[[i]]) Ri[[j]] <- union(Ri[[j]],i)
> d <- vector("list",length(R))
> names(d)<-names(R)
> for(i in 1:length(R)) for(j in R[[i]])
+ d[[i]] <- append(d[[i]],list(ind=j,dis=D[i,j]))
> d
> D > Ro > d
a b c d e f g h i j $a 1: NULL $a 1: NULL
a 0 5 7 4 6 6 2 4 2 3 $b 2: 1 4 $b 2:
b 5 0 8 1 3 4 4 5 3 4 $c 3: 1 2 5 6 $b$ind 1 $b$dis 5
c 7 8 0 4 5 7 9 3 2 5 $d 4: 8 $b$ind 4 $b$dis 1
d 4 1 4 0 3 2 4 8 6 3 $e 5: 7 $c 3:
e 6 3 5 3 0 6 4 6 5 7 $f 6: 4 5 7 $c$ind 1 $c$dis 7
f 6 4 7 2 6 0 6 8 5 7 $g 7: 10 $c$ind 2 $c$dis 8
g 2 4 9 4 4 6 0 4 8 2 $h 8: 6 9 10 $c$ind 5 $c$dis 5
h 4 5 3 8 6 8 4 0 3 4 $i 9: 4 $c$ind 6 $c$dis 7
i 2 3 2 6 5 5 8 3 0 5 $j 10: 7 $d 4:
j 3 4 5 3 7 7 2 4 5 0 $d$ind 8 $d$dis 8
> Ri $e 5:
$a 1: 2 3 $e$ind 7 $e$dis 4
$b 2: 3 $f 6:
$c 3: NULL $f$ind 4 $f$dis 2
$d 4: 2 6 9 $f$ind 5 $f$dis 6
$e 5: 3 6 $f$ind 7 $f$dis 6
$f 6: 3 8 $g 7:
$g 7: 5 6 10 $g$ind 10 $g$dis 2
$h 8: 4 $h 8:
$i 9: 8 $h$ind 6 $h$dis 8
$j 10: 7 8 $h$ind 9 $h$dis 3
> $h$ind 10 $h$dis 4
$i 9:
$i$ind 4 $i$dis 6
$j 10:
$j$ind 7 $j$dis 2
>
Clustering
5. March 2018
C:\Users\batagelj\work\R\RelCon\Tolerant.R
listRel <- function(R){
for(i in seq_along(R)) cat(names(R)[i],i,":",R[[i]],"\n")
}
Tolerant <- function(D,method="max"){
orDendro <- function(i){if(i<0) return(-i)
return(c(orDendro(m[i,1]),orDendro(m[i,2])))}
numL <- nrow(D); numLm <- numL-1
# each unit is a cluster; compute inter-cluster dissimilarity matrix
diag(D) <- Inf
print(D); flush.console()
active <- 1:numL; m <- matrix(nrow=numLm,ncol=2)
node <- rep(0,numL); h <- numeric(numLm); w <- rep(1,numL)
for(k in 1:numLm){
# determine the closest pair of clusters (p,q)
# ind <- toVector(sapply(active,function(i){S<-intersect(active,Ro[[i]]); S[which.min(D[i,S])]}))
# dd <- toVector(sapply(active,function(i) D[i,ind[i]]))
n <- length(active); ind <- rep(Inf,n); dd <- rep(Inf,n)
for(a in seq_along(active)) {i <- active[a]
for(j in Ro[[i]]) if(j>0) if(D[i,j] < dd[a]) {dd[a] <- D[i,j]; ind[a] <- j}}
pq <- which.min(dd)
str(pq)
if((length(pq)==0)|is.null(pq)) break
dpq <- dd[pq]
cat(k,":",pq,dpq,">",active,"\n",ind,"\n",dd,"\n")
# join the closest pair of clusters
p<-active[pq]; q <- ind[pq]; h[k] <- dpq
cat('join ',p,' and ',q,' at level ',dpq,'\n')
if(node[p]==0) m[k,1] <- -p else m[k,1] <- node[p]
if(node[q]==0) m[k,2] <- -q else m[k,2] <- node[q]
active <- setdiff(active,q)
Rop <- setdiff(Ro[[p]],q); Rip <- setdiff(Ri[[p]],q)
Roq <- setdiff(Ro[[q]],p); Riq <- setdiff(Ri[[q]],p)
for(s in Riq) if(s>0) Ro[[s]] <- setdiff(Ro[[s]],q)
r <- p; Ror <- Rop; Rir <- Rip
Ror <- union(Ror,Roq)
Rir <- union(Rir,Riq)
for(s in Roq) if(s>0) Ri[[s]] <- setdiff(union(Ri[[s]],r),q)
for(s in Riq) if(s>0) Ro[[s]] <- union(Ro[[s]],r)
Ro[[r]] <- Ror; Ri[[r]] <- Rir
Ro[[q]] <- 0; Ri[[q]] <- 0
cat("] o:",Ror," i:",Rir,"\n")
listRel(Ro); listRel(Ri); flush.console()
# determine dissimilarities to the new cluster
for(s in setdiff(active,p)){
if(method=="max") D[p,s] <- max(D[p,s],D[q,s]) else
if(method=="min") D[p,s] <- min(D[p,s],D[q,s]) else
if(method=="ward") { ww <- w[p]+w[q]+w[s]
D[p,s] <- ((w[q]+w[s])*D[q,s] + (w[p]+w[s])*D[p,s] - w[s]*dpq)/ww
} else {cat('unknown method','\n'); return(NULL)}
D[s,p] <- D[p,s]
}
w[p] <- w[q]+w[p]; node[[p]] <- k
print(D); flush.console()
}
hc <- list(merge=m,height=h,order=orDendro(numLm),labels=rownames(D),
method=NULL,call=NULL,dist.method=method,leaders=NULL)
class(hc) <- "hclust"
return(hc)
}
# sRi <- Ri; sRo <- Ro; sd <- d; sD <- D
# Ri <- sRi; Ro <- sRo; d <- sd; D <- sD
# res <- Tolerant(D)
> source("C:\\Users\\batagelj\\work\\R\\RelCon\\Tolerant.R")
> Ri <- sRi; Ro <- sRo; d <- sd; D <- sD
> res <- Tolerant(D)
a b c d e f g h i j
a Inf 5 7 4 6 6 2 4 2 3
b 5 Inf 8 1 3 4 4 5 3 4
c 7 8 Inf 4 5 7 9 3 2 5
d 4 1 4 Inf 3 2 4 8 6 3
e 6 3 5 3 Inf 6 4 6 5 7
f 6 4 7 2 6 Inf 6 8 5 7
g 2 4 9 4 4 6 Inf 4 8 2
h 4 5 3 8 6 8 4 Inf 3 4
i 2 3 2 6 5 5 8 3 Inf 5
j 3 4 5 3 7 7 2 4 5 Inf
int 2
1 : 2 1 > 1 2 3 4 5 6 7 8 9 10
Inf 4 5 8 7 4 10 9 4 7
Inf 1 5 8 4 2 2 3 6 2
join 2 and 4 at level 1
] o: 1 8 i: 3 6 9
a 1 : 0
b 2 : 1 8
c 3 : 1 2 5 6
d 4 : 0
e 5 : 7
f 6 : 5 7 2
g 7 : 10
h 8 : 6 9 10
i 9 : 2
j 10 : 7
a 1 : 2 3
b 2 : 3 6 9
c 3 : 0
d 4 : 0
e 5 : 3 6
f 6 : 3 8
g 7 : 5 6 10
h 8 : 2
i 9 : 8
j 10 : 7 8
a b c d e f g h i j
a Inf 5 7 4 6 6 2 4 2 3
b 5 Inf 8 1 3 4 4 8 6 4
c 7 8 Inf 4 5 7 9 3 2 5
d 4 1 4 Inf 3 2 4 8 6 3
e 6 3 5 3 Inf 6 4 6 5 7
f 6 4 7 2 6 Inf 6 8 5 7
g 2 4 9 4 4 6 Inf 4 8 2
h 4 8 3 8 6 8 4 Inf 3 4
i 2 6 2 6 5 5 8 3 Inf 5
j 3 4 5 3 7 7 2 4 5 Inf
int 6
2 : 6 2 > 1 2 3 5 6 7 8 9 10
Inf 1 5 7 2 10 9 2 7
Inf 5 5 4 4 2 3 6 2
join 7 and 10 at level 2
] o: i: 5 6 8
a 1 : 0
b 2 : 1 8
c 3 : 1 2 5 6
d 4 : 0
e 5 : 7
f 6 : 5 7 2
g 7 :
h 8 : 6 9 7
i 9 : 2
j 10 : 0
a 1 : 2 3
b 2 : 3 6 9
c 3 : 0
d 4 : 0
e 5 : 3 6
f 6 : 3 8
g 7 : 5 6 8
h 8 : 2
i 9 : 8
j 10 : 0
a b c d e f g h i j
a Inf 5 7 4 6 6 3 4 2 3
b 5 Inf 8 1 3 4 4 8 6 4
c 7 8 Inf 4 5 7 9 3 2 5
d 4 1 4 Inf 3 2 4 8 6 3
e 6 3 5 3 Inf 6 7 6 5 7
f 6 4 7 2 6 Inf 7 8 5 7
g 3 4 9 4 7 7 Inf 4 8 2
h 4 8 3 8 6 8 4 Inf 3 4
i 2 6 2 6 5 5 8 3 Inf 5
j 3 4 5 3 7 7 2 4 5 Inf
int 7
3 : 7 3 > 1 2 3 5 6 7 8 9
Inf 1 5 7 2 Inf 9 2
Inf 5 5 7 4 Inf 3 6
join 8 and 9 at level 3
] o: 6 7 2 i: 2
a 1 : 0
b 2 : 1 8
c 3 : 1 2 5 6
d 4 : 0
e 5 : 7
f 6 : 5 7 2
g 7 :
h 8 : 6 7 2
i 9 : 0
j 10 : 0
a 1 : 2 3
b 2 : 3 6 8
c 3 : 0
d 4 : 0
e 5 : 3 6
f 6 : 3 8
g 7 : 5 6 8
h 8 : 2
i 9 : 0
j 10 : 0
a b c d e f g h i j
a Inf 5 7 4 6 6 3 4 2 3
b 5 Inf 8 1 3 4 4 8 6 4
c 7 8 Inf 4 5 7 9 3 2 5
d 4 1 4 Inf 3 2 4 8 6 3
e 6 3 5 3 Inf 6 7 6 5 7
f 6 4 7 2 6 Inf 7 8 5 7
g 3 4 9 4 7 7 Inf 8 8 2
h 4 8 3 8 6 8 8 Inf 3 4
i 2 6 2 6 5 5 8 3 Inf 5
j 3 4 5 3 7 7 2 4 5 Inf
int 5
4 : 5 4 > 1 2 3 5 6 7 8
Inf 1 5 7 2 Inf 6
Inf 5 5 7 4 Inf 8
join 6 and 2 at level 4
] o: 5 7 1 8 i: 3 8
a 1 : 0
b 2 : 0
c 3 : 1 5 6
d 4 : 0
e 5 : 7
f 6 : 5 7 1 8
g 7 :
h 8 : 6 7
i 9 : 0
j 10 : 0
a 1 : 3 6
b 2 : 0
c 3 : 0
d 4 : 0
e 5 : 3 6
f 6 : 3 8
g 7 : 5 6 8
h 8 : 6
i 9 : 0
j 10 : 0
a b c d e f g h i j
a Inf 5 7 4 6 6 3 4 2 3
b 5 Inf 8 1 3 4 4 8 6 4
c 7 8 Inf 4 5 8 9 3 2 5
d 4 1 4 Inf 3 2 4 8 6 3
e 6 3 5 3 Inf 6 7 6 5 7
f 6 4 8 2 6 Inf 7 8 5 7
g 3 4 9 4 7 7 Inf 8 8 2
h 4 8 3 8 6 8 8 Inf 3 4
i 2 6 2 6 5 5 8 3 Inf 5
j 3 4 5 3 7 7 2 4 5 Inf
int 2
5 : 2 5 > 1 3 5 6 7 8
Inf 5 7 5 Inf 6
Inf 5 7 6 Inf 8
join 3 and 5 at level 5
] o: 1 6 7 i: 0 6
a 1 : 0
b 2 : 0
c 3 : 1 6 7
d 4 : 0
e 5 : 0
f 6 : 7 1 8 3
g 7 :
h 8 : 6 7
i 9 : 0
j 10 : 0
a 1 : 3 6
b 2 : 0
c 3 : 0 6
d 4 : 0
e 5 : 0
f 6 : 3 8
g 7 : 6 8 3
h 8 : 6
i 9 : 0
j 10 : 0
a b c d e f g h i j
a Inf 5 7 4 6 6 3 4 2 3
b 5 Inf 8 1 3 4 4 8 6 4
c 7 8 Inf 4 5 8 9 6 2 5
d 4 1 4 Inf 3 2 4 8 6 3
e 6 3 5 3 Inf 6 7 6 5 7
f 6 4 8 2 6 Inf 7 8 5 7
g 3 4 9 4 7 7 Inf 8 8 2
h 4 8 6 8 6 8 8 Inf 3 4
i 2 6 2 6 5 5 8 3 Inf 5
j 3 4 5 3 7 7 2 4 5 Inf
int 3
6 : 3 6 > 1 3 6 7 8
Inf 1 1 Inf 6
Inf 7 6 Inf 8
join 6 and 1 at level 6
] o: 7 8 3 0 i: 3 8
a 1 : 0
b 2 : 0
c 3 : 6 7
d 4 : 0
e 5 : 0
f 6 : 7 8 3 0
g 7 :
h 8 : 6 7
i 9 : 0
j 10 : 0
a 1 : 0
b 2 : 0
c 3 : 0 6
d 4 : 0
e 5 : 0
f 6 : 3 8
g 7 : 6 8 3
h 8 : 6
i 9 : 0
j 10 : 0
a b c d e f g h i j
a Inf 5 7 4 6 6 3 4 2 3
b 5 Inf 8 1 3 4 4 8 6 4
c 7 8 Inf 4 5 8 9 6 2 5
d 4 1 4 Inf 3 2 4 8 6 3
e 6 3 5 3 Inf 6 7 6 5 7
f 6 4 8 2 6 Inf 7 8 5 7
g 3 4 9 4 7 7 Inf 8 8 2
h 4 8 6 8 6 8 8 Inf 3 4
i 2 6 2 6 5 5 8 3 Inf 5
j 3 4 5 3 7 7 2 4 5 Inf
int 2
7 : 2 7 > 3 6 7 8
6 7 Inf 6
8 7 Inf 8
join 6 and 7 at level 7
] o: 8 3 0 i: 3 8
a 1 : 0
b 2 : 0
c 3 : 6
d 4 : 0
e 5 : 0
f 6 : 8 3 0
g 7 : 0
h 8 : 6
i 9 : 0
j 10 : 0
a 1 : 0
b 2 : 0
c 3 : 0 6
d 4 : 0
e 5 : 0
f 6 : 3 8
g 7 : 0
h 8 : 6
i 9 : 0
j 10 : 0
a b c d e f g h i j
a Inf 5 7 4 6 6 3 4 2 3
b 5 Inf 8 1 3 4 4 8 6 4
c 7 8 Inf 4 5 9 9 6 2 5
d 4 1 4 Inf 3 2 4 8 6 3
e 6 3 5 3 Inf 6 7 6 5 7
f 6 4 9 2 6 Inf 7 8 5 7
g 3 4 9 4 7 7 Inf 8 8 2
h 4 8 6 8 6 8 8 Inf 3 4
i 2 6 2 6 5 5 8 3 Inf 5
j 3 4 5 3 7 7 2 4 5 Inf
int 2
8 : 2 8 > 3 6 8
6 8 6
9 8 8
join 6 and 8 at level 8
] o: 3 0 i: 3
a 1 : 0
b 2 : 0
c 3 : 6
d 4 : 0
e 5 : 0
f 6 : 3 0
g 7 : 0
h 8 : 0
i 9 : 0
j 10 : 0
a 1 : 0
b 2 : 0
c 3 : 0 6
d 4 : 0
e 5 : 0
f 6 : 3
g 7 : 0
h 8 : 0
i 9 : 0
j 10 : 0
a b c d e f g h i j
a Inf 5 7 4 6 6 3 4 2 3
b 5 Inf 8 1 3 4 4 8 6 4
c 7 8 Inf 4 5 9 9 6 2 5
d 4 1 4 Inf 3 2 4 8 6 3
e 6 3 5 3 Inf 6 7 6 5 7
f 6 4 9 2 6 Inf 7 8 5 7
g 3 4 9 4 7 7 Inf 8 8 2
h 4 8 6 8 6 8 8 Inf 3 4
i 2 6 2 6 5 5 8 3 Inf 5
j 3 4 5 3 7 7 2 4 5 Inf
int 1
9 : 1 9 > 3 6
6 3
9 9
join 3 and 6 at level 9
] o: 0 i: 0
a 1 : 0
b 2 : 0
c 3 : 0
d 4 : 0
e 5 : 0
f 6 : 0
g 7 : 0
h 8 : 0
i 9 : 0
j 10 : 0
a 1 : 0
b 2 : 0
c 3 : 0
d 4 : 0
e 5 : 0
f 6 : 0
g 7 : 0
h 8 : 0
i 9 : 0
j 10 : 0
a b c d e f g h i j
a Inf 5 7 4 6 6 3 4 2 3
b 5 Inf 8 1 3 4 4 8 6 4
c 7 8 Inf 4 5 9 9 6 2 5
d 4 1 4 Inf 3 2 4 8 6 3
e 6 3 5 3 Inf 6 7 6 5 7
f 6 4 9 2 6 Inf 7 8 5 7
g 3 4 9 4 7 7 Inf 8 8 2
h 4 8 6 8 6 8 8 Inf 3 4
i 2 6 2 6 5 5 8 3 Inf 5
j 3 4 5 3 7 7 2 4 5 Inf
> plot(res,hang=-1,main="Tolerant/Maximum")
Test
Pajek
- read SomeTyRel.net as First
- read someTyDis.net as Second
- Networks/Cross-Intersection/Second
- Networks/Create Hierarchy/Clustering with RC/Run [max,tolerant]
Except where otherwise noted, content on this wiki is licensed under the following license: CC Attribution-Noncommercial-Share Alike 3.0 Unported
