Recherche de tag: boucle
Permet de calculer pour différents regroupements d'individus statistiques (ici des mailles de présence-absence) les valeurs du test de Mac Nemar.
Demande en entrée un tableau avec le nom du regroupement, le nombre d'individus statistiques où le caractère observé est absent, apparait, disparait et se maintient entre t et t+1.
Packages additionels: "treemap", "RColorBrewer"
R version 3.4.4
OS: Linux Xubuntu 16.04
setwd()
library(treemap)
library(RColorBrewer)
tabl #contient vos données en entrée classe data.frame
## Préparation des vecteurs nécessaires au fonctionnement de du script:
Somme<-rep(0,nrow(tabl)) # stock le nombre total d'individus statistiques
stat_mcnemar<-rep(0,nrow(tabl)) # stock la VTZ² pour chaque regroupement
pvalue_mcnemar<-rep(0,nrow(tabl)) # stock la p.value pour chaque regroupement
Applicable<-rep(NA,nrow(tabl)) # stock la condition d'appliation du test
Linkimg<-rep(0,nrow(tabl)) # stock le lien vers la sortie graphique
## Boucle de calcul des paramètres du test et des sorties graphiques par regroupement
for (i in c(1:nrow(tabl))){
# Vérifie que le test de Mac-Nemar est applicable
Somme[i]<-sum(tabl[i,c(1:4)])
Applicable[i]<- tabl[i,3]+tabl[i,2]
# Produit une matrice pour le test de Mac-Nemar
mat<-matrix(c(tabl[i,4],tabl[i,2],tabl[i,3],tabl[i,1]),ncol=2)
# Stockage des résultats du test avec signalement des regroupements où il n'est pas applicable
if (Applicable[i] < 20) stat_mcnemar[i]<- "test non applicable"
else stat_mcnemar[i]<-mcnemar.test(mat)$statistic
if (Applicable[i] < 20) pvalue_mcnemar[i]<- "test non applicable"
else pvalue_mcnemar[i]<-mcnemar.test(mat)$p.value
# Export du graphique résumant la répartition des mailles sur le site et stockage du chemin d'accès dans le tableau
sign<-NULL
if (mcnemar.test(mat)$p.value == "NaN") sign<- c("NA") else
if (mcnemar.test(mat)$p.value < 0.01) sign<-c("***") else
if (mcnemar.test(mat)$p.value < 0.05) sign<-c("**") else
if (mcnemar.test(mat)$p.value < 0.1) sign<-c("*") else sign<-c("-")
# permet de synthétiser la p.value sous forme d'un code à étoiles
value=c(export[i,4],export[i,2],export[i,3],export[i,1])
group=c(paste("Maintien: ",export[i,4]," mailles",sep=''),
paste("Apparition: ",export[i,2]," mailles",sep=''),
paste("Disparition: ",export[i,3]," mailles",sep=''),
paste("Absence: ",export[i,1]," mailles",sep=''))
Tab=data.frame(group,value)
Titre<-NULL
if (Applicable[i] == 0) Titre<- c("Non Applicable") else
Titre<- paste(round(mcnemar.test(mat)$statistic,3)," (",sign,")",sep='')
photo<-paste(getwd(),rownames(export[i,]),".jpg",sep='')
colors <- c("#FFFF00","#FF0000","#0000FF","#FF00FF")
group=c("Maintien","Apparition","Disparition","Absence")
jpeg(filename=photo,res=600,width=6,height=6,units="cm")
treemap(Tab,
index="group",
vSize="value",
type="index",
palette=colors,
fontsize.labels = 5,
force.print.labels = T,
fontface.labels = 4,
title= Titre,
fontsize.title = 10,
border.lwds= 0.5,
fontcolor.labels="black")
dev.off()
Linkimg[i]<-photo
}
export1<-cbind(tabl,Somme,stat_mcnemar,pvalue_mcnemar,Linkimg)
write.csv(export1,paste(getwd(),"/res-mcnemar.csv",sep=''))
0/5 - [0 rating]