...

[iramuteq] / Rscripts / chdfunct.R

diff --git a/Rscripts/chdfunct.R b/Rscripts/chdfunct.R
index a2dc502..914278c 100644 (file)
--- a/Rscripts/chdfunct.R
+++ b/Rscripts/chdfunct.R
@@ -294,8 +294,8 @@ AsLexico2<- function(mat, chip = FALSE) {
 }
 
 make.spec.hypergeo <- function(mat) {
-    library(textometrieR)
-    spec <- specificites(mat)
+    library(textometry)
+    spec <- specificities(mat)
        sumcol<-colSums(mat)
     eff_relatif<-round(t(apply(mat,1,function(x) {(x/t(as.matrix(sumcol))*1000)})),2)
     colnames(eff_relatif) <- colnames(mat)
@@ -321,6 +321,32 @@ BuildProf01<-function(x,classes) {
        mat
 }
 
+build.prof.tgen <- function(x) {
+    nbst <- sum(x[nrow(x),])
+    totcl <- x[nrow(x),]
+    tottgen <- rowSums(x)
+    nbtgen <- nrow(x) - 1
+    chi2 <- x[1:(nrow(x)-1),]
+    pchi2 <- chi2
+    for (classe in 1:ncol(x)) {
+        for (tg in 1:nbtgen) {
+            cont <- c(x[tg, classe], tottgen[tg] - x[tg, classe], totcl[classe] - x[tg, classe], (nbst - totcl[classe]) - (tottgen[tg] - x[tg, classe]))
+            cont <- matrix(unlist(cont), nrow=2)
+            chiresult<-chisq.test(cont,correct=FALSE)
+            if (is.na(chiresult$p.value)) {
+                chiresult$p.value<-1
+                chiresult$statistic<-0
+            }
+            if (chiresult$expected[1,1] > cont[1,1]) {
+                chiresult$statistic <- chiresult$statistic * -1
+            }
+            chi2[tg,classe] <- chiresult$statistic
+            pchi2[tg,classe] <- chiresult$p.value
+        }
+    }
+    res <- list(chi2 = chi2, pchi2 = pchi2)
+}
+
 BuildProf<- function(x,dataclasse,clusternb,lim=2) {
        ####
        #r.names<-rownames(x)