From: pierre <ratinaud@univ-tlse2.fr>
Date: Mon, 20 Jun 2022 16:29:29 +0000 (+0200)
Subject: correction labbé
X-Git-Url: http://iramuteq.org/git?a=commitdiff_plain;ds=sidebyside;p=iramuteq

correction labbé
---

diff --git a/Rscripts/distance-labbe.R b/Rscripts/distance-labbe.R
index eccb3ae..747332b 100644
--- a/Rscripts/distance-labbe.R
+++ b/Rscripts/distance-labbe.R
@@ -29,8 +29,10 @@ compute.labbe <- function(x, y, tab) {
         U <- N1/N2
         mini.tab[,2] <- mini.tab[,2] * U
 		col.plusgrand <- mini.tab[,2]
-		cs.plus.grand <- sum(col.plusgrand[col.plusgrand>1])
+		cs.plus.grand <- sum(col.plusgrand[col.plusgrand>=1])
     }
+    #print(U)
+    #print(cs.plus.grand)
     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))
@@ -39,9 +41,12 @@ compute.labbe <- function(x, y, tab) {
     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)
+    #print(cs[plus.petit])
+    #print(dist.labbe)
 
     indice.labbe <- dist.labbe/(cs[plus.petit] + cs.plus.grand)
-    indice.labbe
+    res = list(indice.labbe = indice.labbe, commun=commun, deA=deA, deB=deB, dist.commun=dist.commun, dist.deA=dist.deA, dist.deB=dist.deB)
+	res
 }
 
 #calcul pour distance texte 1 et 2
@@ -54,9 +59,59 @@ dist.labbe <- function(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[j,i] <- compute.labbe(i,j,tab)$indice.labbe
 		}
 	}
     mat
 }
 
+dist.labbe2 <- function(tab) {
+    distance_from_idxs <- function (idxs) {
+        i1 <- idxs[1]
+        i2 <- idxs[2]
+        compute.labbe(i1, i2, tab)$indice.labbe
+    }
+
+    size <- ncol(tab)
+    d <- apply(utils::combn(size, 2), 2, distance_from_idxs)
+    attr(d, "Size") <- size
+    xnames <- colnames(tab)
+    if (!is.null(xnames)) {
+        attr(d, "Labels") <- xnames
+    }
+    attr(d, "Diag") <- FALSE
+    attr(d, "Upper") <- FALSE
+    class(d) <- "dist"
+    d
+	#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)$indice.labbe
+	#	}
+	#}
+    #mat
+}
+
+dist.labbe3 <- function(tab) {
+    distance_from_idxs <- function (idxs) {
+        i1 <- tab[,idxs[1]]
+        i2 <- tab[,idxs[2]]
+        labbe(i1, i2)
+    }
+
+    size <- ncol(tab)
+    d <- apply(utils::combn(size, 2), 2, distance_from_idxs)
+    attr(d, "Size") <- size
+    xnames <- colnames(tab)
+    if (!is.null(xnames)) {
+        attr(d, "Labels") <- xnames
+    }
+    attr(d, "Diag") <- FALSE
+    attr(d, "Upper") <- FALSE
+    class(d) <- "dist"
+    d
+
+}