Recherche de tag: MacNemar


Test de Mac-Nemar par regroupement pour analyse diachronique par mailles [R]

27.08.2018     Remy_Moine      MacNemar boucle treemap 

  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]