correction labbé

diff --git a/Rscripts/distance-labbe.R b/Rscripts/distance-labbe.R
index eccb3ae..747332b 100644 (file)
--- 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
+
+}