From e5d8b8e44a92885b2efee3dc748239d773146830 Mon Sep 17 00:00:00 2001 From: Pierre Ratinaud Date: Tue, 3 Jan 2017 11:35:40 +0100 Subject: [PATCH] Labbe's distance in R : need test --- Rscripts/distance-labbe.R | 59 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 59 insertions(+) create mode 100644 Rscripts/distance-labbe.R 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 +} + -- 2.7.4