correction for ape 5.1
[iramuteq] / Rscripts / distance-labbe.R
1 #Author: Pierre Ratinaud
2 #Copyright (c) 2015-2016 Pierre Ratinaud
3 #License: GNU/GPL
4
5 #Distance de Labbe
6 ###########
7 #NEED TEST#
8 ###########
9
10
11 compute.labbe <- function(x, y, tab) {
12
13     mini.tab <- tab[,c(x, y)]
14
15     cs <- colSums(mini.tab)
16
17     N1 <- cs[1]
18     N2 <- cs[2]
19
20     plus.grand <- ifelse(N1>N2, 1,2)
21     plus.petit <- ifelse(N1>N2, 2,1)
22
23     if (plus.grand == 1) {
24         U <- N2/N1
25         mini.tab[,1] <- mini.tab[,1] * U
26                 col.plusgrand <- mini.tab[,1]
27                 cs.plus.grand <- sum(col.plusgrand[col.plusgrand>=1])
28     } else {
29         U <- N1/N2
30         mini.tab[,2] <- mini.tab[,2] * U
31                 col.plusgrand <- mini.tab[,2]
32                 cs.plus.grand <- sum(col.plusgrand[col.plusgrand>1])
33     }
34     commun <- which((mini.tab[,1] > 0) & (mini.tab[,2] > 0))
35     deA <- which((mini.tab[,plus.petit] > 0) & (mini.tab[,plus.grand] == 0))
36     deB <- which((mini.tab[,plus.petit] == 0)  & (mini.tab[,plus.grand] >= 1))
37
38     dist.commun <- abs(mini.tab[commun, plus.petit] - mini.tab[commun, plus.grand])
39     dist.deA <- abs(mini.tab[deA, plus.petit] - mini.tab[deA, plus.grand])
40     dist.deB <- abs(mini.tab[deB, plus.petit] - mini.tab[deB, plus.grand])
41     dist.labbe <- sum(dist.commun) + sum(dist.deA) + sum(dist.deB)
42
43     indice.labbe <- dist.labbe/(cs[plus.petit] + cs.plus.grand)
44     indice.labbe
45 }
46
47 #calcul pour distance texte 1 et 2
48 #compute.labbe(1,2,tab)
49
50 dist.labbe <- function(tab) {
51         mat <- matrix(NA, ncol=ncol(tab), nrow=ncol(tab))
52         rownames(mat) <- colnames(tab)
53         colnames(mat) <- colnames(tab)
54         for (i in 1:(ncol(tab)-1)) {
55                 for (j in (1+i):ncol(tab)) {
56                         #lab <- compute.labbe(i,j,tab)
57                         mat[j,i] <- compute.labbe(i,j,tab)
58                 }
59         }
60     mat
61 }
62