Listing du fichier protpcv2_inc.r
00001 Pour ne pas voir les numéros de ligne, ajoutez &nl=non à la suite du nom du fichier. |
Retour à la page principale de
(gH)
Listing du fichier protpcv2_inc.r
00001# (gH) -_- art07_inc.r ; TimeStamp (unix) : 03 Juillet 2013 vers 14:37
00002
00003 #################################################################
00004
00005 decritQTparFacteurArt3 <- function(titreQT,nomVarQT,unite=" ",titreQL,nomVarQL,
00006 labels,graphique=FALSE,fichier_image="",lng="FR",
00007 beanp=TRUE,cnt=0,coul=c("blue","red"),barre=-2,vraiNom="",calc=TRUE) {
00008
00009 #################################################################
00010
00011 # barre=-2 : pas de abline horizontale
00012 # barre=-1 : abline horizontale pour mediane globale
00013 # barre>=0 : abline horizontale pour la valeur indiquée
00014
00015 # calc=TRUE : on affiche les calculs
00016
00017 if (missing(titreQT)) {
00018 cat(" syntaxe : decritQTparFacteur(titreQT,nomVar,unite=\"?\",titreQL,nomVarQL,labels, [ graphique=FALSE,fichier_image=\"\" ] ) \n")
00019 cat(" exemples d'utilisation : \n")
00020 cat(" decritQTparFacteur(\"AGE dans ELF\",ag,\"ans\",\"SEXE\",sex,\"homme femme\")\n")
00021 cat(" decritQTparFacteur(\"POIDS dans Ronfle\",poi,\"kg\",,\"SEXE\",sexe,\"homme femme\"graphique=TRUE,fichier_image=\"RON_poi.png\")\n")
00022 } else {
00023
00024 nas <- is.na(nomVarQT)
00025 nbnas <- sum(nas)
00026 if (nbnas>0) {
00027 cat("\n ",nbnas," valeurs manquantes supprimées sur ",length(nomVarQT),"\n")
00028 } ; # fin si
00029
00030 nomVarQT <- nomVarQT[!nas]
00031 nomVarQL <- nomVarQL[!nas]
00032
00033 if (vraiNom=="") {
00034 vraiNom <- titreQT
00035 } ; # fin si
00036
00037
00038 if (unite==" ") {
00039 unite_ <- " "
00040 } else {
00041 unite_ <- paste(",unit=",unite,sep="")
00042 } # fin si
00043
00044 if (calc) {
00045 cat("\n")
00046 if (lng=="FR") {
00047 cat("VARIABLE QT ",vraiNom,unite_,"\n") ;
00048 cat("VARIABLE QL ",titreQL," labels : ",labels,"\n") ;
00049 } else {
00050 cat("QT VARIABLE: ",vraiNom,unite_,"\n",sep="") ;
00051 cat("QL VARIABLE: ",titreQL,", labels =",labels,"\n") ;
00052 } ; # fin de si
00053 cat("\n")
00054 } ; # fin de si
00055
00056 nbl <- length(nomVarQT)
00057 tdata <- matrix(nrow=nbl,ncol=2)
00058 tdata[,1] <- nomVarQT
00059 tdata[,2] <- nomVarQL
00060 if (length(labels)==1) { labels <- chaineEnListe( labels ) }
00061 ## print(labels)
00062
00063 vglob <- list()
00064 vglob[[1]] <- tdata[,1]
00065 valQL <- sort(unique(nomVarQL))
00066 nbm <- length(valQL)
00067
00068 for (idm in (1:nbm)) {
00069 vglob[[1+idm]] <- nomVarQT[nomVarQL==valQL[idm]]
00070 } # fin pour idm
00071
00072 vres <- matrix(nrow=1+nbm,ncol=11)
00073 vres[1,] <- allCalcQT("Global",vglob[[1]],unite)
00074 for (idm in (1:nbm)) {
00075 vres[1+idm,] <- allCalcQT(labels[idm],vglob[[1+idm]],unite)
00076 } # fin pour idm
00077 row.names(vres) <- c("Global",labels)
00078 if (lng=="FR") {
00079 colnames(vres) <- chaineEnListe("N Moy Unite Ect Cdv Q1 Med Q3 EIQ Min Max")
00080 } else {
00081 colnames(vres) <- chaineEnListe("N Mean Unit Std Cv Q1 Med Q3 IQR Min Max")
00082 } ; # fin de si
00083
00084 if (calc) {
00085 print(vres,quote=FALSE,right=TRUE) ;
00086 } ; # fin de si
00087
00088 if (!fichier_image=="") { gr(fichier_image) ; graphique = TRUE }
00089
00090 if (graphique) {
00091
00092 titre <- paste(vraiNom," vs ",titreQL)
00093 if (nbm>2) {
00094 nbgr <- 1
00095 } else {
00096 nbgr <- 2
00097 } # fin si
00098 if (beanp) { nbgr <- nbgr + 1 }
00099 par(mfrow=c(1,nbgr))
00100
00101 couls <- rep("black",nbl)
00102 couls[nomVarQL==min(nomVarQL)] <- coul[1]
00103 couls[nomVarQL==max(nomVarQL)] <- coul[2]
00104 titrex <- paste(min(nomVarQL),"en bleu, ", max(nomVarQL)," en rouge ")
00105 titrex <- paste(labels[1],coul[1],";", labels[2],coul[2])
00106 titrey <- ""
00107 ql <- as.factor(nomVarQL)
00108 levels(ql) <- labels
00109 bornesY <- c(min(nomVarQT)*0.9,max(nomVarQT)*1.1)
00110 if (nbm<=2) { plot(1:nbl,nomVarQT,col=couls,pch=21,bg=coul,main=titre,xlab=titrex,ylab=titrey,ylim=bornesY) }
00111 ql2 <- ql
00112 ql3 <- ql
00113 cntql <- table(ql)
00114 for (idc in 1:length(cntql)) {
00115 levels(ql2)[idc] <- paste(levels(ql)[idc]," (",cntql[idc],")",sep="")
00116 levels(ql3)[idc] <- paste(" \n",levels(ql)[idc],"\n",cntql[idc],sep="")
00117 } # fin pour idc
00118
00119 if (cnt==0) {
00120 qlt <- ql
00121 }
00122 if (cnt==1) {
00123 qlt <- ql2
00124 }
00125 if (cnt==2) {
00126 qlt <- ql3
00127 } # fin si
00128
00129 boxplot(nomVarQT~qlt,main=titre,col="yellow",pch=21,bg="red",notch=FALSE,ylim=bornesY)
00130
00131 # ajout éventuelle d'une barre
00132
00133 if (barre>-2) {
00134 lamed <- median(nomVarQT)
00135 if (barre==-1) {
00136 labarre <- lamed
00137 } else {
00138 labarre <- barre
00139 } # finsi
00140 abline(h=labarre)
00141 cat(titre,"médiane globale en ",lamed," barre en ",labarre,"\n")
00142 } # fin si
00143
00144 if (beanp) {
00145 beanplot(nomVarQT~qlt,main=titre,col = c("#CAB2D6", "#33A02C", "#B2DF8A"), border = "#CAB2D6",ylim=bornesY,log="")
00146 } # fin si
00147
00148 par(mfrow=c(1,1))
00149 } # fin si
00150
00151 if (!fichier_image=="") {
00152 cat("\n")
00153 if (lng=="FR") {
00154 cat(" vous pouvez utiliser ",fichier_image,"\n")
00155 } ; # fin de si
00156 dev.off()
00157 } ; # fin de si
00158
00159 #cat("Résultats de l'anova : \n")
00160
00161 ql <- as.factor(nomVarQL)
00162 an <- anova(lm(nomVarQT~ql))
00163
00164 if (calc) {
00165 cat("\n")
00166 print(an)
00167
00168 # analyse non paramétrique
00169 kr <- kruskal.test(nomVarQT~ql)
00170 print(kr)
00171
00172 } ; # fin de si
00173
00174 return(c(an$"Pr(>F)"[1],kr$p.value))
00175
00176 } # fin si
00177
00178 } ; # fin de fonction decritQTparFacteurArt3
00179
Pour ne pas voir les numéros de ligne, ajoutez &nl=non à la suite du nom du fichier.