# (gH) -_- art07_inc.r ; TimeStamp (unix) : 03 Juillet 2013 vers 14:37
#################################################################
decritQTparFacteurArt3 <- function(titreQT,nomVarQT,unite=" ",titreQL,nomVarQL,
labels,graphique=FALSE,fichier_image="",lng="FR",
beanp=TRUE,cnt=0,coul=c("blue","red"),barre=-2,vraiNom="",calc=TRUE) {
#################################################################
# barre=-2 : pas de abline horizontale
# barre=-1 : abline horizontale pour mediane globale
# barre>=0 : abline horizontale pour la valeur indiquée
# calc=TRUE : on affiche les calculs
if (missing(titreQT)) {
cat(" syntaxe : decritQTparFacteur(titreQT,nomVar,unite=\"?\",titreQL,nomVarQL,labels, [ graphique=FALSE,fichier_image=\"\" ] ) \n")
cat(" exemples d'utilisation : \n")
cat(" decritQTparFacteur(\"AGE dans ELF\",ag,\"ans\",\"SEXE\",sex,\"homme femme\")\n")
cat(" decritQTparFacteur(\"POIDS dans Ronfle\",poi,\"kg\",,\"SEXE\",sexe,\"homme femme\"graphique=TRUE,fichier_image=\"RON_poi.png\")\n")
} else {
nas <- is.na(nomVarQT)
nbnas <- sum(nas)
if (nbnas>0) {
cat("\n ",nbnas," valeurs manquantes supprimées sur ",length(nomVarQT),"\n")
} ; # fin si
nomVarQT <- nomVarQT[!nas]
nomVarQL <- nomVarQL[!nas]
if (vraiNom=="") {
vraiNom <- titreQT
} ; # fin si
if (unite==" ") {
unite_ <- " "
} else {
unite_ <- paste(",unit=",unite,sep="")
} # fin si
if (calc) {
cat("\n")
if (lng=="FR") {
cat("VARIABLE QT ",vraiNom,unite_,"\n") ;
cat("VARIABLE QL ",titreQL," labels : ",labels,"\n") ;
} else {
cat("QT VARIABLE: ",vraiNom,unite_,"\n",sep="") ;
cat("QL VARIABLE: ",titreQL,", labels =",labels,"\n") ;
} ; # fin de si
cat("\n")
} ; # fin de si
nbl <- length(nomVarQT)
tdata <- matrix(nrow=nbl,ncol=2)
tdata[,1] <- nomVarQT
tdata[,2] <- nomVarQL
if (length(labels)==1) { labels <- chaineEnListe( labels ) }
## print(labels)
vglob <- list()
vglob[[1]] <- tdata[,1]
valQL <- sort(unique(nomVarQL))
nbm <- length(valQL)
for (idm in (1:nbm)) {
vglob[[1+idm]] <- nomVarQT[nomVarQL==valQL[idm]]
} # fin pour idm
vres <- matrix(nrow=1+nbm,ncol=11)
vres[1,] <- allCalcQT("Global",vglob[[1]],unite)
for (idm in (1:nbm)) {
vres[1+idm,] <- allCalcQT(labels[idm],vglob[[1+idm]],unite)
} # fin pour idm
row.names(vres) <- c("Global",labels)
if (lng=="FR") {
colnames(vres) <- chaineEnListe("N Moy Unite Ect Cdv Q1 Med Q3 EIQ Min Max")
} else {
colnames(vres) <- chaineEnListe("N Mean Unit Std Cv Q1 Med Q3 IQR Min Max")
} ; # fin de si
if (calc) {
print(vres,quote=FALSE,right=TRUE) ;
} ; # fin de si
if (!fichier_image=="") { gr(fichier_image) ; graphique = TRUE }
if (graphique) {
titre <- paste(vraiNom," vs ",titreQL)
if (nbm>2) {
nbgr <- 1
} else {
nbgr <- 2
} # fin si
if (beanp) { nbgr <- nbgr + 1 }
par(mfrow=c(1,nbgr))
couls <- rep("black",nbl)
couls[nomVarQL==min(nomVarQL)] <- coul[1]
couls[nomVarQL==max(nomVarQL)] <- coul[2]
titrex <- paste(min(nomVarQL),"en bleu, ", max(nomVarQL)," en rouge ")
titrex <- paste(labels[1],coul[1],";", labels[2],coul[2])
titrey <- ""
ql <- as.factor(nomVarQL)
levels(ql) <- labels
bornesY <- c(min(nomVarQT)*0.9,max(nomVarQT)*1.1)
if (nbm<=2) { plot(1:nbl,nomVarQT,col=couls,pch=21,bg=coul,main=titre,xlab=titrex,ylab=titrey,ylim=bornesY) }
ql2 <- ql
ql3 <- ql
cntql <- table(ql)
for (idc in 1:length(cntql)) {
levels(ql2)[idc] <- paste(levels(ql)[idc]," (",cntql[idc],")",sep="")
levels(ql3)[idc] <- paste(" \n",levels(ql)[idc],"\n",cntql[idc],sep="")
} # fin pour idc
if (cnt==0) {
qlt <- ql
}
if (cnt==1) {
qlt <- ql2
}
if (cnt==2) {
qlt <- ql3
} # fin si
boxplot(nomVarQT~qlt,main=titre,col="yellow",pch=21,bg="red",notch=FALSE,ylim=bornesY)
# ajout éventuelle d'une barre
if (barre>-2) {
lamed <- median(nomVarQT)
if (barre==-1) {
labarre <- lamed
} else {
labarre <- barre
} # finsi
abline(h=labarre)
cat(titre,"médiane globale en ",lamed," barre en ",labarre,"\n")
} # fin si
if (beanp) {
beanplot(nomVarQT~qlt,main=titre,col = c("#CAB2D6", "#33A02C", "#B2DF8A"), border = "#CAB2D6",ylim=bornesY,log="")
} # fin si
par(mfrow=c(1,1))
} # fin si
if (!fichier_image=="") {
cat("\n")
if (lng=="FR") {
cat(" vous pouvez utiliser ",fichier_image,"\n")
} ; # fin de si
dev.off()
} ; # fin de si
#cat("Résultats de l'anova : \n")
ql <- as.factor(nomVarQL)
an <- anova(lm(nomVarQT~ql))
if (calc) {
cat("\n")
print(an)
# analyse non paramétrique
kr <- kruskal.test(nomVarQT~ql)
print(kr)
} ; # fin de si
return(c(an$"Pr(>F)"[1],kr$p.value))
} # fin si
} ; # fin de fonction decritQTparFacteurArt3
|
Retour à la page principale de
(gH)