X-Git-Url: http://iramuteq.org/git?p=iramuteq;a=blobdiff_plain;f=Rscripts%2Fchdfunct.R;h=914278c3dd7d726e4c3f13a47ea49ea0d5fa32f0;hp=a2dc502e3bf2c5bf161af037ec1554163abe724a;hb=4c959afafbe1f1ec29b01fa8db3ae1af1b8cd4cf;hpb=7fb5b2b86f6c9a0617208ee85211177c23d12f47 diff --git a/Rscripts/chdfunct.R b/Rscripts/chdfunct.R index a2dc502..914278c 100644 --- 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)