programmer une fonction avec argument "subset" [Ré

[Stéphane Adamowicz]

Voici ci-dessous une fonction qui permet de créer facilement un Dataframe contenant un résumé statistique d'une variable (noter que les arguments "coefvar", "sem" et "confint" désignent respectivement le coefficient de variation en %, l'erreur standard de la moyenne et son intervalle de confiance au degré "prob").

Code : Tout sélectionner

tablestat <- function(formula, data= Data, FUN= alist(min, mean, median, max, var, sd, coefvar, sem, confint), prob= 0.95)
{   TABLE <- aggregate(formula, data, length); col <- length(names(TABLE)); names(TABLE)[col] <- "n.tot"
   INTER <- aggregate(update(formula,is.na(.)~.), data, sum); TABLE$NAs <- INTER[,col]
   INTER <- aggregate(update(formula,!is.na(.)~.), data, sum); TABLE$n.val <- INTER[,col]
   INTERsd <- aggregate(formula, data, "sd", na.rm=TRUE)
   FUNref <- alist(min,mean,median,max,var,sd,coefvar,sem,confint)
   j <- match(FUN,FUNref); index <- col+2
   for(i in 1:length(FUN))
      {   if(j[i]<6)
         {   INTER <- aggregate(formula, data, as.character(FUNref[j[i]]), na.rm=TRUE)
            index <- index + 1
            TABLE[,index] <- INTER[,col]; names(TABLE)[length(names(TABLE))] <- FUNref[j[i]]
         }
      if(j[i]==6) {TABLE$sd <- INTERsd[,col]}
      if(j[i]==7) {TABLE$coefvar<-INTERsd[,col]/aggregate(formula, data, "mean",na.rm=TRUE)[,col]*100}
      if(j[i]==8) {TABLE$sem <- INTERsd[,col]/sqrt(TABLE$n.val)}
      if(j[i]==9) {TABLE$confint <- qt((1+prob)/2,df=TABLE$n.val-1) * INTERsd[,col] / sqrt(TABLE$n.val)}
      }
   return(TABLE)
}


Pour mieux comprendre, voici un exemple:

Code : Tout sélectionner

>    data(ToothGrowth)
>    myTable <- tablestat(len ~ supp + dose, data=ToothGrowth, FUN= alist(mean, median, sd, coefvar))

> myTable
  supp dose n.tot NAs n.val  mean median       sd  coefvar
1   OJ  0.5    10   0    10 13.23  12.25 4.459709 33.70906
2   VC  0.5    10   0    10  7.98   7.15 2.746634 34.41898
3   OJ  1.0    10   0    10 22.70  23.45 3.910953 17.22887
4   VC  1.0    10   0    10 16.77  16.50 2.515309 14.99886
5   OJ  2.0    10   0    10 26.06  25.95 2.655058 10.18825
6   VC  2.0    10   0    10 26.14  25.95 4.797731 18.35398


Les colonnes n.tot, NAs et n.val désignent les effectifs de données totales, manquantes et présentes, respectivement.

Venons en maintenant à ma question:
Les fonctions (comme aggregate) qui utilisent les arguments "formula" et "data" acceptent aussi un argument "subset" bien pratique. Quelqu'un saurait-il comment introduire cet argument dans ma fonction "tablestat" ?

[Pierre COLIN]

Bonjour,

Tu peux utiliser les "..." afin de transférer des paramètres optionnels entre ta fonction perso et une fonction utilisée par celle-ci (comme aggregate), sans avoir à préciser lesquels.

Code : Tout sélectionner

tablestat <- function(formula, data= Data, FUN= alist(min, mean, median, max, var, sd, coefvar, sem, confint), prob= 0.95,...){
TABLE <- aggregate(formula, data, length,...)
.
.
.


[Stéphane Adamowicz]

Merci beaucoup pour la suggestion,

mais cela ne semble pas produire l'effet attendu. Voici le nouveau code:

Code : Tout sélectionner

tablestat <- function(formula, data= Data, FUN= alist(min, mean, median, max, var, sd, coefvar, sem, confint), prob= 0.95, ...)
{   
   TABLE <- aggregate(formula, data, subset=, length); col <- length(names(TABLE)); names(TABLE)[col] <- "n.tot"
   INTER <- aggregate(update(formula,is.na(.)~.), data, subset=, sum); TABLE$NAs <- INTER[,col]
   INTER <- aggregate(update(formula,!is.na(.)~.), data, subset=, sum); TABLE$n.val <- INTER[,col]
   INTERsd <- aggregate(formula, data, subset=, "sd", na.rm=TRUE)
   FUNref <- alist(min,mean,median,max,var,sd,coefvar,sem,confint)
   j <- match(FUN,FUNref); index <- col+2
   for(i in 1:length(FUN))
      {   if(j[i]<6)
         {   INTER <- aggregate(formula, data, subset=, as.character(FUNref[j[i]]), na.rm=TRUE)
            index <- index + 1
            TABLE[,index] <- INTER[,col]; names(TABLE)[length(names(TABLE))] <- FUNref[j[i]]
         }
      if(j[i]==6) {TABLE$sd <- INTERsd[,col]}
      if(j[i]==7) {TABLE$coefvar<-INTERsd[,col]/aggregate(formula, data, subset=, "mean",na.rm=TRUE)[,col]*100}
      if(j[i]==8) {TABLE$sem <- INTERsd[,col]/sqrt(TABLE$n.val)}
      if(j[i]==9) {TABLE$confint <- qt((1+prob)/2,df=TABLE$n.val-1) * INTERsd[,col] / sqrt(TABLE$n.val)}
      }
   return(TABLE)
}


Noter que dans les fonctions "aggregate", j'ai mis l'argument "subset=" au lieu de "subset" qui me donnait ce message d'erreur à l'utilisation de la fonction :
Erreur dans subset.default(X[[1L]], ...) : 'subset' must be logical

Le code ci-dessus ne produit aucun message d'erreur, mais l'argument subset n'a aucun effet comme le montre cet exemple:

Code : Tout sélectionner

>    data(ToothGrowth)

#     Toutes les données
>    (my.Table <- tablestat(len ~ supp + dose, data=ToothGrowth, FUN= alist(mean, median, sd, coefvar)))
  supp dose n.tot NAs n.val  mean median       sd  coefvar
1   OJ  0.5    10   0    10 13.23  12.25 4.459709 33.70906
2   VC  0.5    10   0    10  7.98   7.15 2.746634 34.41898
3   OJ  1.0    10   0    10 22.70  23.45 3.910953 17.22887
4   VC  1.0    10   0    10 16.77  16.50 2.515309 14.99886
5   OJ  2.0    10   0    10 26.06  25.95 2.655058 10.18825
6   VC  2.0    10   0    10 26.14  25.95 4.797731 18.35398

#     Certaines données
> (my.Sub.Table <- tablestat(len ~ supp + dose, data=ToothGrowth, subset=dose>0.5, FUN= alist(mean, median, sd, coefvar)))
  supp dose n.tot NAs n.val  mean median       sd  coefvar
1   OJ  0.5    10   0    10 13.23  12.25 4.459709 33.70906
2   VC  0.5    10   0    10  7.98   7.15 2.746634 34.41898
3   OJ  1.0    10   0    10 22.70  23.45 3.910953 17.22887
4   VC  1.0    10   0    10 16.77  16.50 2.515309 14.99886
5   OJ  2.0    10   0    10 26.06  25.95 2.655058 10.18825
6   VC  2.0    10   0    10 26.14  25.95 4.797731 18.35398


[Pierre COLIN]

les ... doivent également apparaitre dans la fonction aggregate
et non l'argument subset directement

tablestat <- function(formula, data= Data, FUN= alist(min, mean, median, max, var, sd, coefvar, sem, confint), prob= 0.95, ...)
{
TABLE <- aggregate(formula, data, length, ...); col <- length(names(TABLE)); names(TABLE)[col] <- "n.tot"
INTER <- aggregate(update(formula,is.na(.)~.), data, sum, ...); TABLE$NAs <- INTER[,col]
INTER <- aggregate(update(formula,!is.na(.)~.), data, sum, ...); TABLE$n.val <- INTER[,col]
INTERsd <- aggregate(formula, data, "sd", na.rm=TRUE, ...)
FUNref <- alist(min,mean,median,max,var,sd,coefvar,sem,confint)
j <- match(FUN,FUNref); index <- col+2
for(i in 1:length(FUN))
{ if(j[i]<6)
{ INTER <- aggregate(formula, data, as.character(FUNref[j[i]]), na.rm=TRUE, ...)
index <- index + 1
TABLE[,index] <- INTER[,col]; names(TABLE)[length(names(TABLE))] <- FUNref[j[i]]
}
if(j[i]==6) {TABLE$sd <- INTERsd[,col]}
if(j[i]==7) {TABLE$coefvar<-INTERsd[,col]/aggregate(formula, data, "mean",na.rm=TRUE, ...)[,col]*100}
if(j[i]==8) {TABLE$sem <- INTERsd[,col]/sqrt(TABLE$n.val)}
if(j[i]==9) {TABLE$confint <- qt((1+prob)/2,df=TABLE$n.val-1) * INTERsd[,col] / sqrt(TABLE$n.val)}
}
return(TABLE)
}

[Stéphane Adamowicz]

Merci de la suggestion,

mais ce nouveau code produit l'erreur suivante lorsqu'on utilise l'argument "subset" :

> (myTable <- tablestat(len ~ supp + dose, data=ToothGrowth, subset=dose>0.5, FUN= alist(mean, median, sd, coefvar)))
Erreur dans eval(expr, envir, enclos) :
..1 utilisé dans un mauvais contexte, aucun ... où chercher

en mode debug, l'erreur se produit dès le premier appel à la fonction "aggregate"

[Pierre COLIN]

bon, on va revenir à quelque chose de plus artisanal.
Lorsque tu définis ta fonction tablestat, tu peux indiquer les valeurs par défaut de chacun de tes paramètres (comme tu l'as fait pour 'prob'). As-tu essayé la meme chose pour l'argument subset, avec comme valeur par défaut 'NULL'?

l'argument 'subset' apparait alors à la fois dans ta fonction tablestat et dans tes fonctions aggregate

[Stéphane Adamowicz]

Oui, j'avais essayé de donner une valeur NULL par défaut à "subset", mais on a alors le message d'erreur suivant :

Erreur dans xj[i] : type 'closure' d'indice incorrect

[Pierre COLIN]

enième tentative

l'argument subset doit etre une matrice de valeur logique, et par défaut il prend en compte toutes les données, c'est à dire une matrice remplie de "TRUE"

Essayes en mettant comme valeur par défaut
"matrix(TRUE,nrow(data),ncol(data))"

[Nicolas Péru]

Salut,

J'ai pas tout relu le fil mais en tout cas personnellement j'utilise la fonction subset() et je n'ai aps de problème à ajouter ses arguments à une fonction globale.

par exemple j'ai des données dans un tableau nommé ref, si j'utilise la fonction subset en mettrant un vecteur logique constitué uniquement de "TRUE" comme valeur par défaut à la fonction subset il me sélectionne mon tableau complet. Ensuit je peux lui mettre une expression logique sélectionnant que certaines lignes.

Code : Tout sélectionner

subset(ref,subset=rep(TRUE,nrow(ref)))#sélectionne le tableau complet
subset(ref,subset=annee==2008)#sélectionne les données de 2008

Nicolas

[Stéphane Adamowicz]

Désolé, mais aucune des solutions proposées n'ont fonctionné. Dans l'exemple traité, j'ai dans tous les cas l'erreur "objet 'dose' introuvable.
Mais j'ai quand même trouvé une solution simple, voire élégante, puisqu'elle prépare le dataframe "data" une fois pour toute et non à chaque occurrence des fonctions "aggregate".
Pour les internautes intéressés, j'ai mis le code complet et documenté de "tablestat" qui permet en outre d'exporter le tableau aux formats tex (pour les utilisateurs de LaTex ou de LyX), html, rtf (pratique pour importation dans un traitement de texte) et txt (pratique pour importation dans un tableur).
Pour ceux qui jugent ces fioritures inutiles et lourdes, il suffit de supprimer tout le code allant "# --- mise forme du tableau ---" jusqu'à l'accolade finale (non comprise).

Code : Tout sélectionner

#   ============================================================================
#   Name   :   tablestat
#   Author   :   Stéphane Adamowicz
#   Version   :   v2   (june 2012)
#   Aims   :   (1)   to create a dataframe of a variable summary statistics
#            (mean, var...) by factor levels
#            (2)   optionally, to export the dataframe as latex, html, rtf or
#            txt files (tab separator)
#   Requires:   Libraries Hmisc, xtable and rtf for exportation
#   ============================================================================
#   Arguments:
#   formula   :   Formula such as Var ~ Fact1 + Fact2 ..., Var being the numeric
#            under study, while Fact1, Fact2 ... are factors
#   data   :   Name of the source dataframe (Data default) containing Var,
#            Fact1, Fact2 ...
#   subset   :   Optional logical expression indicating data rows to keep   
#   FUN      :   Argument list of statistical functions to apply among the fol-
#            -lowing: min, mean, median, max, var, sd, coefvar, sem, confint
#   prob   :   Prob. level for confint (conf. interval of mean, 0.95 default)
#   type   :   If type="" (default), the mere dataframe is printed
#            If type="latex", "html", "rtf" or "txt", it is also exported
#
#   Arguments if type !="":
#   file   :   Name of the file. If "" (default) the latex/html code is merely
#            printed to standard output (not available for txt and rtf).
#            File name extensions (.txt .rtf .tex .html) are automatic.
#   dec      :   significant digits in latex, html and rtf outputs (3 default).
#            All digits are preserved in txt outputs.
#   dec.mark:   Character indicating the numeric decimal point ("." default)
#
#   Latex and rtf specific arguments:
#   size   :   Latex font size (NULL="normalsize") to choose among :
#            "tiny"   "scriptsize"   "footnotesize"   "small"   "normalsize"
#            "large"   "Large"   "LARGE"   "huge"   "Huge".
#            In rtf output, they translate in the following sizes in pts:
#            8   9   10   11   (12=NULL)   14   16   18   20   22
#
#   Latex specific arguments:
#   top.rule:   "double" (default), "single" or "thick": type of horizontal line
#            that starts the table. For "thick", insert "\usepackage{ctable}"
#            in the latex preamble.         
#   where   :   Placement of table float ("!htbp" default).
#   ============================================================================
#   Examples :
#   data(ToothGrowth)
#   dataframe only
#   (myTable <- tablestat(len ~ supp + dose, data=ToothGrowth, FUN= alist(mean, median, sd, coefvar)))
#   dataframe + latex table in the standard output only
#   (myTable <- tablestat(len ~ supp + dose, data=ToothGrowth, FUN= alist(mean, median, sd, coefvar), type="latex"))
#   dataframe + latex table in a file
#   (myTable <- tablestat(len ~ supp + dose, data=ToothGrowth, FUN=alist(mean, median, sd, coefvar), type="latex", file="~/Desktop/Tab"))
#   ============================================================================

tablestat <- function(formula, data= Data, subset, FUN= alist(min, mean, median, max, var, sd, coefvar, sem, confint), prob= 0.95, type= "", file= "", dec= 3, dec.mark= ".", size= NULL, top.rule= "double", where= "!htbp")
{   if (missing(subset)== FALSE)
   {
      attach(data); on.exit(detach(data)); data <-  data[subset,]
   }
   TABLE <- aggregate(formula, data, length); col <- length(names(TABLE)); names(TABLE)[col] <- "n.tot"
   INTER <- aggregate(update(formula,is.na(.)~.), data, sum); TABLE$NAs <- INTER[,col]
   INTER <- aggregate(update(formula,!is.na(.)~.), data, sum); TABLE$n.val <- INTER[,col]
   INTERsd <- aggregate(formula, data, "sd", na.rm=TRUE)
   FUNref <- alist(min,mean,median,max,var,sd,coefvar,sem,confint)
   j <- match(FUN,FUNref); index <- col+2
   for(i in 1:length(FUN))
      {   if(j[i]<6)
         {   INTER <- aggregate(formula, data, as.character(FUNref[j[i]]), na.rm=TRUE)
            index <- index + 1
            TABLE[,index] <- INTER[,col]; names(TABLE)[length(names(TABLE))] <- FUNref[j[i]]
         }
      if(j[i]==6) {TABLE$sd <- INTERsd[,col]}
      if(j[i]==7) {TABLE$coefvar<-INTERsd[,col]/aggregate(formula, data, "mean",na.rm=TRUE)[,col]*100}
      if(j[i]==8) {TABLE$sem <- INTERsd[,col]/sqrt(TABLE$n.val)}
      if(j[i]==9) {TABLE$confint <- qt((1+prob)/2,df=TABLE$n.val-1) * INTERsd[,col] / sqrt(TABLE$n.val)}
      }
   if (type=="") {return(TABLE)}
   # ------------------   mise en forme du tableau   --------------------
   dec.mark.default <- getOption("OutDec"); on.exit(options(OutDec= dec.mark.default))
   options(OutDec= dec.mark)
   tex.size <- c("tiny", "scriptsize", "footnotesize", "small", "normalsize", "large", "Large", "LARGE", "huge", "Huge"); rtf.size <- c(8:12,2*(7:11))
   ncol.tot <- ncol(TABLE); ncol.ent1 <- which(names(TABLE)=="n.tot")
   titre <- as.character(formula)[2]
   if (type %in% c("latex", "html","rtf"))
   {   library(Hmisc)
      TAB <- format.df(TABLE, na.blank= TRUE, digits= dec, numeric.dollar= FALSE)
      if (type=="latex")   # formatage latex
      {   if(file!="") {file <- paste(file,".tex",sep="")}
         if(top.rule=="double") {double.line <- TRUE} else {double.line <- FALSE}
         if(top.rule=="thick") {thick=TRUE} else {thick=FALSE}
         justif <- c(rep("l", ncol.ent1-1), rep("c",3), rep("r",ncol.tot-ncol.ent1-1))
         latex(TAB, col.just= justif, file= file, title= "", size= size, cgroup= c("", titre), n.cgroup= c(ncol.ent1-1, ncol.tot +1 -ncol.ent1), colnamesTexCmd= c(rep("", ncol.ent1), rep("slshape",ncol.tot +2 -ncol.ent1)), first.hline.double= double.line, ctable= thick, multicol=TRUE, where= where)
      }   
      if (type=="html")   # formatage html
      {   library(xtable)
         if(file!="") {file <- paste(file,".html",sep="")}
         justif <- c(rep("l", ncol.ent1), rep("c",3), rep("r",ncol.tot-ncol.ent1-2))
         print.xtable(xtable(TAB, align= justif), NA.string= "", math.style.negative= FALSE, hline.after= c(-1, 0, nrow(TAB)), type= "html", file=file, html.table.attributes= paste("frame=hsides", "title=", titre))
      }
      if (type=="rtf" & file!="")   # formatage rtf
      {   library(rtf)
         file <- RTF(file= paste(file, ".rtf", sep=""))
         if(length(size)==0) {size="normalsize"}
         setFontSize(this= file, font.size= rtf.size[match(x=size,table=tex.size, nomatch=5)])
         addHeader(this= file, title=titre)
         addTable(this= file, dat=TAB, row.names=TRUE, NA.string="")
         done(file)
      }
   }
   if(type=="txt" & file!="")
   {   file <- paste(file,".txt",sep="")
      write.table(x=TABLE, file=file, sep="\t",na="", dec= dec.mark, row.names=FALSE)
   }
   return(TABLE)
}



Voici maintenant un exemple traité :

Code : Tout sélectionner

# Toutes les Données
> (myTable <- tablestat(len ~ supp + dose, data=ToothGrowth, FUN= alist(mean, median, sd, coefvar)))
  supp dose n.tot NAs n.val  mean median       sd  coefvar
1   OJ  0.5    10   0    10 13.23  12.25 4.459709 33.70906
2   VC  0.5    10   0    10  7.98   7.15 2.746634 34.41898
3   OJ  1.0    10   0    10 22.70  23.45 3.910953 17.22887
4   VC  1.0    10   0    10 16.77  16.50 2.515309 14.99886
5   OJ  2.0    10   0    10 26.06  25.95 2.655058 10.18825
6   VC  2.0    10   0    10 26.14  25.95 4.797731 18.35398

# Certaines données
> (myTable <- tablestat(len ~ supp + dose, data=ToothGrowth, subset=dose<2 & supp=="OJ", FUN= alist(mean, median, sd, coefvar)))
  supp dose n.tot NAs n.val  mean median       sd  coefvar
1   OJ  0.5    10   0    10 13.23  12.25 4.459709 33.70906
2   OJ  1.0    10   0    10 22.70  23.45 3.910953 17.22887


Et si on veut en sus exporter le code latex du tableau, et le civiliser avec la virgule décimale on pourra écrire, par exemple :

Code : Tout sélectionner

(myTable <- tablestat(len ~ supp + dose, data=ToothGrowth, FUN= alist(mean, median, sd, coefvar), type ="latex", dec.mark=","))


[Stéphane Laurent]

Salut Stéphane,

Je vois que tu utilises des fonctions du package rtf que je ne connais pas. Comment as-tu appris à utiliser ces fonctions stp ? La seule aide du package rtf s'obtient en faisant

Code : Tout sélectionner

?RTF

et c'est très peu détaillé.

[Stéphane Laurent]

À part ça peut-être que tu seras intéressé par mon post ici : http://forums.cirad.fr/logiciel-R/viewtopic.php?t=4917

[Stéphane Adamowicz]

À vrai dire, je ne me souviens plus comment j'ai pris connaissance de son existence. Je crois être tombé sur la bibliothèque rtf fortuitement, et, le jour où j'en ai eu besoin, je me suis souvenu de son nom ...

Pour ce qui est de son usage, je me suis contenté de l'aide en ligne, squelettique, il est vrai. Mais en essayant les exemples fournis, on en comprend vite l'usage.

[Stéphane Adamowicz]

Oui, ton post m'a intéressé.

Je savais que cela m'arriverait un jour, ... d'enfoncer une porte ouverte. Avec R, le risque est particulièrement grand, et j'aurais certainement gagné du temps si j'avais eu connaissance de ton post.

La présentation finale du tableau est séduisante, mais est-ce que je me trompe en disant qu'elle n'est applicable qu'à des valeurs arrondies en entiers ?

[Stéphane Laurent]

La présentation finale du tableau est séduisante, mais est-ce que je me trompe en disant qu'elle n'est applicable qu'à des valeurs arrondies en entiers ?

Oui je pense que tu te trompes.