[Corpusreader-svn] SF.net SVN: corpusreader:[206] trunk/corpusreader/src/main/R/specificites.R

[<syl...@us...>]

Revision: 206
          http://corpusreader.svn.sourceforge.net/corpusreader/?rev=206&view=rev
Author:   sylvainloiseau
Date:     2008-12-15 21:40:31 +0000 (Mon, 15 Dec 2008)

Log Message:
-----------
New implementation of specificites

Added Paths:
-----------
    trunk/corpusreader/src/main/R/specificites.R

Added: trunk/corpusreader/src/main/R/specificites.R
===================================================================
--- trunk/corpusreader/src/main/R/specificites.R	                        (rev 0)
+++ trunk/corpusreader/src/main/R/specificites.R	2008-12-15 21:40:31 UTC (rev 206)
@@ -0,0 +1,106 @@
+specificites <- function(corpus, souscorpus) {
+    ## Sylvain Loiseau
+    ## Derni\xE8re \xE9dition samedi 13 d\xE9cembre 2008, 19:38:22 (UTC+0100)
+    ##
+    ## Indice de sp\xE9cificit\xE9 des formes d'un sous corpus par rapport \xE0 un corpus.
+    ## Mesur\xE9e par la formule hyperg\xE9om\xE9trique,
+    ## retourne un tableau :
+    ##   une ligne par forme du sous corpus
+    ##   en colonne : indice de sp\xE9cificit\xE9, sous fr\xE9quence, fr\xE9quence.
+    ##   
+
+	## Les fr\xE9quences dans le corpus
+        if (class(corpus) == "data.frame") {
+            frequencesCorpus <- colSums(corpus);
+            print("Le corpus est un data frame");
+        } else {
+            frequencesCorpus = corpus;
+        }
+
+	print(paste("Nombre de variables dans le corpus : ", length(frequencesCorpus)));
+
+	## Un peu de nettoyage dans le sous corpus : on supprime
+        ## d'\xE9ventuelles forme ou partie sans aucune valeur
+        sousCorpus <- sousCorpus[,colSums(sousCorpus) > 0];
+        sousCorpus <- sousCorpus[rowSums(sousCorpus) > 0,];
+
+	## Les fr\xE9quences dans le sous-corpus
+	sousFrequences <- colSums(sousCorpus); 
+
+        specificitesFrequencyLists(frequencesCorpus, sousFrequences);
+}
+
+specificitesFrequencyLists <- function(frequencesCorpus, sousFrequences) {
+        if (any(is.na(frequencesCorpus))) {
+          stop("Valeurs non num\xE9riques dans la liste des frequences du corpus.");
+        }
+        if (any(is.na(sousFrequences))) {
+          stop("Valeurs non num\xE9riques dans la liste des fr\xE9quences du sous corpus.");
+        }
+
+	## Nombre de formes \xE0 traiter
+        nbrFormes <- length(sousFrequences);
+	print(paste("Nombre de formes dans le sous corpus :", nbrFormes));
+
+	## On ne garde des frequences du corpus principal 
+	## que les variables qui sont dans le sous corpus
+	frequencesTotales <- frequencesCorpus[names(sousFrequences)] 
+	if (length(frequencesTotales) < nbrFormes) {
+	    warning("Attention : toutes les variables du sous corpus n'ont pas \xE9t\xE9 trouv\xE9es dans le corpus.")
+	}
+
+        #frequencesTotales <- frequencesTotales[ !is.na(frequencesTotales) ];
+        #if (any(is.na(frequencesTotales))) {
+        #  stop("NA in frequencesTotales");
+        #}
+
+	## Nombre d'occurrences dans le corpus et son sous-corpus
+	longueurCorpus <- sum(frequencesCorpus)
+	longueurSousCorpus <- sum(sousFrequences)
+	print(paste("Longueur du corpus :", longueurCorpus));
+	print(paste("Longueur du sous corpus :", longueurSousCorpus));
+
+        ## Pour chaque fr\xE9quence totale, on calcule la diff\xE9rence entre la taille du corpus et cette fr\xE9quence
+        ## (n\xE9cessaire pour les fonctions phyper et dhyper)
+        longueurCorpusMoinsFrequencesTotales <- (longueurCorpus - frequencesTotales);
+        # print(paste("Taille de corpus moins fr\xE9quence", length(longueurCorpusMoinsFrequencesTotales)));
+        # if (any(is.na(longueurCorpusMoinsFrequencesTotales))) {
+        #   stop("NA in longueurCorpusMoinsFrequencesTotales");
+        # }
+
+        ## on met dans un tableau "cumulative", pour chaque forme, la propabilit\xE9 cumul\xE9e 
+        ## (phyper) correspondant \xE0 sa sous fr\xE9quence dans le sous corpus compte tenu de sa 
+        ## fr\xE9quence absolue dans le corpus principal et des tailles des deux corpus.
+        ##
+	cumulative <- double(nbrFormes);
+	cumulative <- phyper(sousFrequences, frequencesTotales, longueurCorpusMoinsFrequencesTotales, longueurSousCorpus);
+	# cumulative[is.na(cumulative)] <- 0;
+        # if (any(is.na(cumulative))) {
+        #   stop("NA in cumulative");
+        # }
+
+        ## Si la fr\xE9quence cumul\xE9e est inf\xE9rieure \xE0 0.5, c'est qu'il y a *moins* d'occurrences 
+        ## que ne le laisserait pr\xE9voir le hasard, si la fr\xE9quence cumul\xE9e est sup\xE9rieure \xE0 0.5
+        ## c'est qu'il y a plus d'occurrences qu'il n'y aurait d\xFB en avoir. On inverse donc les signes
+        ## pour prendre en compte cette diff\xE9rence.
+	specificiteIndex <-  double(nbrFormes);
+
+        if (any(is.na(specificiteIndex))) {
+          stop("NA in specificiteIndex");
+        }
+        if (any(is.na(sousFrequences))) {
+          stop("NA in sousFrequences");
+        }
+	# specificiteIndex[cumulative < 0.5] <- specificiteIndex[cumulative < 0.5];
+	specificiteIndex[cumulative >= 0.5] <- (1 - specificiteIndex[cumulative >= 0.5]);
+
+        m <- matrix(
+            c(specificiteIndex, sousFrequences, frequencesTotales), 
+            nrow = nbrFormes, 
+            ncol=3, 
+            dimnames = list(names(sousFrequences), c("Indice de sp\xE9cificit\xE9", "Sous fr\xE9quence", "Fr\xE9quence absolue"))
+            );
+	
+        sorted <- m[order(m[,1], decreasing=TRUE),];
+        return(sorted); 
+}


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.