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                 col.plusgrand <- mini.tab[,1]
  27                 cs.plus.grand <- sum(col.plusgrand[col.plusgrand>=1])
  28     } else {
  29         U <- N1/N2
  30         mini.tab[,2] <- mini.tab[,2] * U
  31                 col.plusgrand <- mini.tab[,2]
  32                 cs.plus.grand <- sum(col.plusgrand[col.plusgrand>1])
  33     }
  34     commun <- which((mini.tab[,1] > 0) & (mini.tab[,2] > 0))
  35     deA <- which((mini.tab[,plus.petit] > 0) & (mini.tab[,plus.grand] == 0))
  36     deB <- which((mini.tab[,plus.petit] == 0)  & (mini.tab[,plus.grand] >= 1))
  37
  38     dist.commun <- abs(mini.tab[commun, plus.petit] - mini.tab[commun, plus.grand])
  39     dist.deA <- abs(mini.tab[deA, plus.petit] - mini.tab[deA, plus.grand])
  40     dist.deB <- abs(mini.tab[deB, plus.petit] - mini.tab[deB, plus.grand])
  41     dist.labbe <- sum(dist.commun) + sum(dist.deA) + sum(dist.deB)
  42
  43     indice.labbe <- dist.labbe/(cs[plus.petit] + cs.plus.grand)
  44     indice.labbe
  45 }
  46
  47 #calcul pour distance texte 1 et 2
  48 #compute.labbe(1,2,tab)
  49
  50 dist.labbe <- function(tab) {
  51         mat <- matrix(NA, ncol=ncol(tab), nrow=ncol(tab))
  52         rownames(mat) <- colnames(tab)
  53         colnames(mat) <- colnames(tab)
  54         for (i in 1:(ncol(tab)-1)) {
  55                 for (j in (1+i):ncol(tab)) {
  56                         #lab <- compute.labbe(i,j,tab)
  57                         mat[j,i] <- compute.labbe(i,j,tab)
  58                 }
  59         }
  60     mat
  61 }
  62