Ajout de la possibilité d'écrire une ligne HTML en plusieurs fois.

Desc ok pour les variables quali
label() renvoie le nom de la variable si le label n'est pas set

R/desc.R

@@ -12,33 +12,23 @@
 #' @param variables Vecteur de noms de variables a decrire, par defaut toutes les variables contenues dans la table
 #' @param variables_neg Vecteur de noms de variables a exclure de la description
 #' @param stats Vecteur de valeurs a calculer, parmi N, \%, \%/moy, moy, et, ic95, q1, med, q3. Par defaut c("N","\%/moy","ic95")
-#' @param miss Booleen : afficher ou non les valeurs manquantes, par defaut FALSE
+#' @param miss Booleen : afficher ou non les valeurs manquantes, par defaut TRUE
 #' @param anglais Booleen : obtenir un tableau en anglais(intitules, separation des decimales), par defaut FALSE
 #' @param note Note de bas de page, par defaut vide
 #' @param nbdec Nombre de decimales apres la virgule, par defaut 1
 #' @export
-desc <- function(html="desc", titre=NULL, table=NULL, variables=NULL, variables_neg=NULL, stats=c("N","%/moy","ic95"), miss=FALSE, anglais=FALSE, note=NULL, nbdec=1)
+desc <- function(html="desc", titre=NULL, table=NULL, variables=NULL, variables_neg=NULL, stats=c("N","%/moy","ic95"), miss=TRUE, anglais=FALSE, note=NULL, nbdec=1)
 {
-  nbdec_orig=getOption("digits")
-  dec_mark=getOption("OutDec")
-  options(digits=nbdec)
   if (anglais)
-  {
-    options(OutDec=".")
-  }
+    decmark="."
   else
-  {
-    options(OutDec=",")
-  }
+    decmark=","
   
   if (is.null(titre) & is.null(table))
-  {
     titre<-paste("Descriptif global de",.attachd)
-  }
   else if (is.null(titre))
-  {
     titre<-paste("Descriptif global de",deparse(substitute(table))) 
-  }
+
   if (is.null(table)) table<-eval(parse(text=.attachd))
   if (!is.null(variables)) table=table[variables]
   if (!is.null(variables_neg)) table[variables_neg]<-list(NULL)
@@ -49,7 +39,7 @@ desc <- function(html="desc", titre=NULL, table=NULL, variables=NULL, variables_
     HTML("<caption>", titre, "</caption>")
     HTML("<thead>")
     inc()
-      HTML("<tr><th></th>", paste("<th>",stats,"</th>",sep="", collapse=" "), "</tr>")
+      HTML("<tr><th></th>", paste("<th>",stats,"</th>",sep="", collapse=""), "</tr>")
     dec()
     HTML("</thead>")
     if (!is.null(note))
@@ -62,13 +52,69 @@ desc <- function(html="desc", titre=NULL, table=NULL, variables=NULL, variables_
     }
     HTML("<tbody>")
     inc()
-      
+      for (var in names(table))
+      {
+        etiq <- label(table[[var]])
+        if (etiq == "table[[var]]") etiq <- var
+        
+        if (is.numeric(table[[var]]))
+        {
+          res <- NA
+          for (stat in stats)
+          {
+            
+          }
+        }
+        else if (is.factor(table[[var]]))
+        {
+          HTML("<tr><td class='var' colspan='", length(stats)+1, "'>", etiq, "</td></tr>")
+          
+          if ((miss) & (!is.na(summary(table[[var]])["NA's"])))
+          {
+            if (anglais)
+              HTML("<tr><td class='level'>Missing</td>",sep="")
+            else
+              HTML("<tr><td class='level'>Manquant</td>",sep="")
+            for (stat in stats)
+            {
+              HTML("<td>",sep="")
+              if (stat == "N")
+              {
+                HTML(summary(table[[var]])["NA's"],sep="")
+              }
+#               else if ((stat == "%") | (stat == "%/moy"))
+#               {
+#                 HTML(format(mean(is.na(table[[var]]))*100,digits=nbdec,nsmall=nbdec,decimal.mark=decmark),sep="")
+#               }
+              HTML("</td>",sep="")
+            }
+            HTML("</tr>")
+          }
+          for (level in levels(table[[var]]))
+          {
+            HTML("<tr><td class='level'>", level, "</td>",sep="")
+            for (stat in stats)
+            {
+              HTML("<td>",sep="")
+              if (stat == "N")
+              {
+                HTML(summary(table[[var]])[level],sep="")
+              }
+              else if ((stat == "%") | (stat == "%/moy"))
+              {
+                HTML(format(100*summary(table[[var]])[level]/length(na.omit(table[[var]])),digits=nbdec,nsmall=nbdec,decimal.mark=decmark),sep="")
+#                 HTML(format(100*summary(table[[var]])[level]/length(table[[var]]),digits=nbdec,nsmall=nbdec,decimal.mark=decmark),sep="")
+              }
+              HTML("</td>",sep="")
+            }
+            HTML("</tr>")
+          }
+        }
+        else next
+      }
     dec()
     HTML("</tbody>")
   dec()
   HTML("</table>")
   HTMLEnd()
-  
-  options(digits=nbdec_orig)
-  options(OutDec=dec_mark)
 }

R/html.R

@@ -12,9 +12,10 @@ HTMLInit <- function(file=tempfile(pattern="report", fileext=".html"), title="")
 {
   assign(".HTML.file", file, pos=1)
   assign(".tabs", 0, pos=1)
+  assign(".ligne",F,pos=1)
   
-  HTML("<!DOCTYPE html>")
-  HTML("<HTML>", append=F)
+  HTML("<!DOCTYPE html>", append=F)
+  HTML("<HTML>")
   inc()
     HTML("<HEAD>")
     inc()
@@ -51,15 +52,25 @@ HTMLEnd <- function()
 #' Ecrit dans le fichier initialise par HTMLInit dont le nom est contenu dans .HTML.file
 #' @encoding UTF-8
 #' @export
-HTML <- function(x, ..., append=T)
+HTML <- function(x, ..., append=T,sep="\n")
 {
   if (!exists(".HTML.file")) return
   
   x <- paste0(x,...,collapse="")
-  tabs <- paste0(rep("\t", .tabs),collapse="")
+  
+  if (.ligne)
+    tabs <- ""
+  else
+    tabs <- paste0(rep("\t", .tabs),collapse="")
+  
+  if (sep == "\n")
+    assign(".ligne", F, pos=1)
+  else
+    assign(".ligne", T, pos=1)
+  
   x <- paste0(tabs, x)
   
-  cat(x,file=.HTML.file,sep="\n", append=append)
+  cat(x,file=.HTML.file,sep=sep, append=append)
 }
 
 inc <- function()

R/label.R

@@ -24,8 +24,10 @@ label <- function(objet) UseMethod("label")
 #' @export
 label.default <- function(objet)
 {
-  if (missing("objet"))
+  if (missing(objet))
     NULL
+  else if (is.null(attr(objet,"label")))
+    deparse(substitute(objet))
   else
     attr(objet,"label")
 }

man/HTML.Rd

@@ -3,7 +3,7 @@
 \alias{HTML}
 \title{Ecrit dans le fichier HTML}
 \usage{
-  HTML(x, ..., append = T)
+  HTML(x, ..., append = T, sep = "\n")
 }
 \description{
   Ecrit dans le fichier HTML cree par HTMLInit

man/charger.Rd

@@ -6,13 +6,13 @@
   charger(fichier, nom = NULL, feuille = 1)
 }
 \arguments{
-  \item{fichier}{Fichier de donnees à charger}
+  \item{fichier}{Fichier de donnees a charger}
 
   \item{nom}{Nom de la data frame dans laquelle stocker les
   donnees chargees}
 
-  \item{feuille}{Feuille à utiliser si fichier excel et en
-  cas de feuilles mutiples (et qu'on veut acceder à une
+  \item{feuille}{Feuille a utiliser si fichier excel et en
+  cas de feuilles mutiples (et qu'on veut acceder a une
   feuille au-dela de la premiere)}
 }
 \description{
@@ -22,11 +22,11 @@
 \details{
   La fonction charge les donnees contenues dans le fichier
   de donnees et cree une table de valeurs. Si des
-  labels/formats sont définis ils seront appliques. Les
-  variables pour lesquelles un format est défini seront
+  labels/formats sont definis ils seront appliques. Les
+  variables pour lesquelles un format est defini seront
   considerees comme des variables qualitatives. La table de
   valeurs prend automatiquement le nom du fichier (suffixe
-  par le numero de feuille) et est attachee à
+  par le numero de feuille) et est attachee a
   l'environnement courant.
 }
 \examples{

man/desc.Rd

@@ -5,7 +5,7 @@
 \usage{
   desc(html = "desc", titre = NULL, table = NULL,
     variables = NULL, variables_neg = NULL,
-    stats = c("N", "\%/moy", "ic95"), miss = FALSE,
+    stats = c("N", "\%/moy", "ic95"), miss = TRUE,
     anglais = FALSE, note = NULL, nbdec = 1)
 }
 \arguments{
@@ -30,7 +30,7 @@
   c("N","\%/moy","ic95")}
 
   \item{miss}{Booleen : afficher ou non les valeurs
-  manquantes, par defaut FALSE}
+  manquantes, par defaut TRUE}
 
   \item{anglais}{Booleen : obtenir un tableau en
   anglais(intitules, separation des decimales), par defaut