From f436e6ce1870d34258291d4232f9b1d966741c31 Mon Sep 17 00:00:00 2001
From: pierre <ratinaud@univ-tlse2.fr>
Date: Mon, 20 Jun 2022 18:29:29 +0200
Subject: [PATCH] =?utf8?q?correction=20labb=C3=A9?=
MIME-Version: 1.0
Content-Type: text/plain; charset=utf8
Content-Transfer-Encoding: 8bit
---
Rscripts/distance-labbe.R | 61 ++++++++++++++++++++++++++++++++++++++++++++---
1 file changed, 58 insertions(+), 3 deletions(-)
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
+
+}
--
2.7.4