iramuteq.org Git - iramuteq/blob - Rscripts/distance-labbe.R

   1 #Author: Pierre Ratinaud
   2 #Copyright (c) 2015-2016 Pierre Ratinaud
   3 #License: GNU/GPL
   4
   5 #Distance de Labbe
   6 ###########
   7 #NEED TEST#
   8 ###########
   9
  10
  11 compute.labbe <- function(x, y, tab) {
  12
  13     mini.tab <- tab[,c(x, y)]
  14
  15     cs <- colSums(mini.tab)
  16
  17     N1 <- cs[1]
  18     N2 <- cs[2]
  19
  20     plus.grand <- ifelse(N1>N2, 1,2)
  21     plus.petit <- ifelse(N1>N2, 2,1)
  22
  23     if (plus.grand == 1) {
  24         U <- N2/N1
  25         mini.tab[,1] <- mini.tab[,1] * U
  26     } else {
  27         U <- N1/N2
  28         mini.tab[,2] <- mini.tab[,2] * U
  29     }
  30
  31     commun <- which((mini.tab[,1] > 0) & (mini.tab[,2] > 0))
  32     deA <- which((mini.tab[,plus.petit] > 0) & (mini.tab[,plus.grand] == 0))
  33     deB <- which((mini.tab[,plus.petit] == 0)  & (mini.tab[,plus.grand] >= 1))
  34
  35     dist.commun <- abs(mini.tab[commun, plus.petit] - mini.tab[commun, plus.grand])
  36     dist.deA <- abs(mini.tab[deA, plus.petit] - mini.tab[deA, plus.grand])
  37     dist.deB <- abs(mini.tab[deB, plus.petit] - mini.tab[deB, plus.grand])
  38     dist.labbe <- sum(dist.commun) + sum(dist.deA) + sum(dist.deB)
  39
  40     indice.labbe <- dist.labbe/(cs[plus.petit] + sum(mini.tab[,plus.grand]))
  41     indice.labbe
  42 }
  43
  44 #calcul pour distance texte 1 et 2
  45 #compute.labbe(1,2,tab)
  46
  47 dist.labbe <- function(tab) {
  48         mat <- matrix(NA, ncol=ncol(tab), nrow=ncol(tab))
  49         rownames(mat) <- colnames(tab)
  50         colnames(mat) <- colnames(tab)
  51         for (i in 1:(ncol(tab)-1)) {
  52                 for (j in (1+i):ncol(tab)) {
  53                         #lab <- compute.labbe(i,j,tab)
  54                         mat[j,i] <- compute.labbe(i,j,tab)
  55                 }
  56         }
  57     mat
  58 }
  59