From: Pierre Ratinaud <ratinaud@univ-tlse2.fr>
Date: Tue, 3 Jan 2017 10:35:40 +0000 (+0100)
Subject: Labbe's distance in R : need test
X-Git-Url: http://iramuteq.org/git?p=iramuteq;a=commitdiff_plain;h=e5d8b8e44a92885b2efee3dc748239d773146830

Labbe's distance in R : need test
---

diff --git a/Rscripts/distance-labbe.R b/Rscripts/distance-labbe.R
new file mode 100644
index 0000000..3ca73fe
--- /dev/null
+++ b/Rscripts/distance-labbe.R
@@ -0,0 +1,59 @@
+#Author: Pierre Ratinaud
+#Copyright (c) 2015-2016 Pierre Ratinaud
+#License: GNU/GPL
+
+#Distance de Labbe
+###########
+#NEED TEST#
+###########
+
+
+compute.labbe <- function(x, y, tab) {
+
+    mini.tab <- tab[,c(x, y)]
+
+    cs <- colSums(mini.tab)
+
+    N1 <- cs[1]
+    N2 <- cs[2]
+
+    plus.grand <- ifelse(N1>N2, 1,2)
+    plus.petit <- ifelse(N1>N2, 2,1)
+
+    if (plus.grand == 1) {
+        U <- N2/N1
+        mini.tab[,1] <- mini.tab[,1] * U
+    } else {
+        U <- N1/N2
+        mini.tab[,2] <- mini.tab[,2] * U
+    }
+
+    commun <- which((mini.tab[,1] > 0) & (mini.tab[,2] > 0))
+    deA <- which((mini.tab[,plus.petit] > 0) & (mini.tab[,plus.grand] == 0))
+    deB <- which((mini.tab[,plus.petit] == 0)  & (mini.tab[,plus.grand] >= 1))
+
+    dist.commun <- abs(mini.tab[commun, plus.petit] - mini.tab[commun, plus.grand])
+    dist.deA <- abs(mini.tab[deA, plus.petit] - mini.tab[deA, plus.grand])
+    dist.deB <- abs(mini.tab[deB, plus.petit] - mini.tab[deB, plus.grand])
+    dist.labbe <- sum(dist.commun) + sum(dist.deA) + sum(dist.deB)
+
+    indice.labbe <- dist.labbe/(cs[plus.petit] + sum(mini.tab[,plus.grand]))
+    indice.labbe
+}
+
+#calcul pour distance texte 1 et 2
+#compute.labbe(1,2,tab)
+
+dist.labbe <- function(tab) {
+	mat <- matrix(NA, ncol=ncol(tab), nrow=ncol(tab))
+	rownames(mat) <- colnames(tab)
+	colnames(mat) <- colnames(tab)
+	for (i in 1:(ncol(tab)-1)) {
+		for (j in (1+i):ncol(tab)) {
+			#lab <- compute.labbe(i,j,tab)
+			mat[j,i] <- compute.labbe(i,j,tab)
+		}
+	}
+    mat
+}
+