Cleanup

get() à la place de eval(parse(text=)
<<- à la place de assign(,,pos=1)
Reglage de l'arg pourcent dans desc_global()
Encore correction des effectifs de colonne
Utilisation de <<- dans les fonctions anonymes (youpi ! :))

R/charger.R

@@ -13,8 +13,6 @@
 #' @export
 charger <- function(fichier,nom=NULL,feuille=1)
 {
-  # Detache la precedente data.frame et creation du nom de la table si non fourni
-  try(detach(table.courante,character.only=T),silent=T)
   if (is.null(nom))
     nom=strsplit(fichier,"\\.")[[1]][1]
   

R/desc_global.R

@@ -25,7 +25,7 @@ desc_global <- function(html="desc_global", titre=NULL, table=NULL, variables=NU
     titre<-paste("Descriptif global de",deparse(substitute(table))) 
   
   # Creation de la table temporaire contenant les variables demandees
-  if (is.null(table)) table<-eval(parse(text=table.courante))
+  if (is.null(table)) table<-get(table.courante)
   if (!is.null(variables)) 
   {
     badvar <- variables[!variables %in% names(table)]
@@ -161,17 +161,18 @@ desc_global <- function(html="desc_global", titre=NULL, table=NULL, variables=NU
 #' 
 #' Permet de produire un tableau descriptif des variables contenues dans la table courante.
 #' Si les labels et formats sont definis et charges ils seront utilises pour peupler le tableau.
-#' La fonction attribue un paramètre "param" à chaque variable à partir de tests de normalité, ce paramètre est modifiable ensuite, il conditionne l'utilisation des tests statistiques dans la fonction comparer().
+#' La fonction attribue un parametre "param" a chaque variable a partir de tests de normalite, ce parametre est modifiable ensuite, il conditionne l'utilisation des tests statistiques dans la fonction comparer().
 #' Tous les parametres ont une valeur par defaut, il est donc possible de simplement lancer diag() pour obtenir le diagnostic par defaut.
 #' @encoding UTF-8
 #' @param table Table a utiliser, par defaut la derniere chargee
 #' @export
 diagnostic <- function(table=NULL)
 {
-  if (is.null(table)) table<-eval(parse(text=table.courante))
+  if (is.null(table)) table<-get(table.courante)
   
   HTMLInit(CSSfile="diag.css")
-  assign("param", character(), pos=1)
+  #assign("param", character(), pos=1)
+  param<<-character(0)
   
   HTML("<div class='diag_menu'>")
   inc()
@@ -221,7 +222,8 @@ diagnostic <- function(table=NULL)
           tryCatch({
             if (shapiro.test(table[[var]])$p.value > .05)
             {
-              assign("param", c(param,var), pos=1)
+              #assign("param", c(param,var), pos=1)
+              param<<-c(param,var)
               HTML("<b>Param&eacute;trique</b>")
             }
           },error=function(e){})

R/desc_groupe.R

@@ -16,9 +16,9 @@
 #' @param nbdec Nombre de decimales apres la virgule, par defaut 1
 #' @param pourcent Pourcentages pour les variables qualitatives, en colonnes ("col") ou en lignes ("row"), par defaut sur le total
 #' @export
-desc_groupe <- function(groupe=NULL, html=NULL, titre=NULL, table=NULL, variables=NULL, variables_neg=NULL, note=NULL, nbdec=1, pourcent=NULL)
+desc_groupe <- function(groupe=NULL, html=NULL, titre=NULL, table=NULL, variables=NULL, variables_neg=NULL, note=NULL, nbdec=1, pourcent="total")
 {
-  if (is.null(table)) table<-eval(parse(text=table.courante))
+  if (is.null(table)) table<-get(table.courante)
   
   if (is.null(groupe) | (!groupe %in% names(table)))
   {
@@ -78,7 +78,7 @@ desc_groupe <- function(groupe=NULL, html=NULL, titre=NULL, table=NULL, variable
   HTML("<tr><td></td>", sep="")
   for (i in levels(modulo))
   {
-    HTML("<td colspan='2'>N=", length(modulo[modulo==i]), "</td>", sep="")
+    HTML("<td colspan='2'>N=", length(na.omit(modulo[modulo==i])), "</td>", sep="")
   }
   HTML("<td></td></tr>")
 
@@ -147,19 +147,18 @@ desc_groupe <- function(groupe=NULL, html=NULL, titre=NULL, table=NULL, variable
       HTML(" (",test,")</td>", sep="")
       
       HTML("</tr>")
-      rm(test)
     }
     # Variable qualitative
     else if (is.factor(table[[var]]))
     {
+      test <- "X"
       p <- tryCatch(
         {
-          assign("test", "X", pos=1)
           chisq.test(table[[var]],modulo)$p.value
         },
         warning=function(w)
         {
-          assign("test", "f", pos=1)
+          test <<- "f"
           fisher.test(table[[var]],modulo,workspace=2e6)$p.value
         },
         error=function(e)
@@ -172,7 +171,6 @@ desc_groupe <- function(groupe=NULL, html=NULL, titre=NULL, table=NULL, variable
       if (p<.05)
         HTML("*", sep="")
       HTML(" (",test,")</td>", sep="")
-      rm(test,pos=1)
       
       # Levels de la variable qualitative
       for (level in levels(table[[var]]))
@@ -184,7 +182,7 @@ desc_groupe <- function(groupe=NULL, html=NULL, titre=NULL, table=NULL, variable
           switch(pourcent,
                  row = HTML("<td>", format(100*table(table[[var]],modulo)[level,level_m]/rowSums(table(table[[var]],modulo))[level], digits=nbdec, nsmall=nbdec), "</td>", sep=""),
                  col = HTML("<td>", format(100*table(table[[var]],modulo)[level,level_m]/colSums(table(table[[var]],modulo))[level_m], digits=nbdec, nsmall=nbdec), "</td>", sep=""),
-                 ... = HTML("<td>", format(100*table(table[[var]],modulo)[level,level_m]/sum(table(table[[var]],modulo)), digits=nbdec, nsmall=nbdec), "</td>", sep=""))
+                 total = HTML("<td>", format(100*table(table[[var]],modulo)[level,level_m]/sum(table(table[[var]],modulo)), digits=nbdec, nsmall=nbdec), "</td>", sep=""))
         }
         
         HTML("<td></td></tr>")

R/html.R

@@ -18,9 +18,6 @@ HTMLInit <- function(file=tempfile(pattern="report", fileext=".html"), title="",
   file.copy(from=file.path(path.package("cosmosR"),"desc.css"), to=file.path(dirname(file),"desc.css"),overwrite=T)
   file.copy(from=file.path(path.package("cosmosR"),"diag.css"), to=file.path(dirname(file),"diag.css"),overwrite=T)
   file.copy(from=file.path(path.package("cosmosR"),"cosmosR.js"), to=file.path(dirname(file),"cosmosR.js"),overwrite=T)
-  #assign(".HTML.file", file, pos=1)
-  #assign(".tabs", 0, pos=1)
-  #assign(".ligne",F,pos=1)
   unlockBinding(".HTML.file", env=asNamespace("cosmosR"))
   unlockBinding(".tabs", env=asNamespace("cosmosR"))
   unlockBinding(".ligne", env=asNamespace("cosmosR"))
@@ -52,7 +49,6 @@ HTMLInit <- function(file=tempfile(pattern="report", fileext=".html"), title="",
 #' @export
 HTMLEnd <- function()
 {
-  #if (!exists(".HTML.file")) return
   if (is.null(.HTML.file)) return
   
   unlockBinding(".HTML.file", env=asNamespace("cosmosR"))
@@ -63,7 +59,6 @@ HTMLEnd <- function()
   HTML("</HTML>")
   
   browseURL(.HTML.file)
-  #rm(.HTML.file,pos=1)
   .HTML.file <<- NULL
 }
 
@@ -80,7 +75,6 @@ HTMLEnd <- function()
 #' @export
 HTML <- function(x, ..., append=T,sep="\n")
 {
-  #if (!exists(".HTML.file")) return
   if (is.null(.HTML.file)) return
   
   unlockBinding(".ligne", env=asNamespace("cosmosR"))
@@ -93,10 +87,8 @@ HTML <- function(x, ..., append=T,sep="\n")
     tabs <- paste0(rep("\t", .tabs),collapse="")
   
   if (sep == "\n")
-    #assign(".ligne", F, pos=1)
     .ligne <<- F
   else
-    #assign(".ligne", T, pos=1)
     .ligne <<-T
   
   x <- paste0(tabs, x)
@@ -107,13 +99,11 @@ HTML <- function(x, ..., append=T,sep="\n")
 inc <- function()
 {
   unlockBinding(".tabs", env=asNamespace("cosmosR"))
-  #assign(".tabs", .tabs+1)
   .tabs <<- .tabs+1
 }
 
 dec <- function()
 {
-  #if (.tabs>0) assign(".tabs", .tabs-1)
   unlockBinding(".tabs", env=asNamespace("cosmosR"))
   if (.tabs>0) .tabs <<- .tabs-1
 }

man/desc_groupe.Rd

@@ -5,7 +5,7 @@
 \usage{
   desc_groupe(groupe = NULL, html = NULL, titre = NULL,
     table = NULL, variables = NULL, variables_neg = NULL,
-    note = NULL, nbdec = 1, pourcent = NULL)
+    note = NULL, nbdec = 1, pourcent = "total")
 }
 \arguments{
   \item{html}{Nom du fichier html, par defaut

man/diagnostic.Rd

@@ -18,9 +18,9 @@
   Permet de produire un tableau descriptif des variables
   contenues dans la table courante. Si les labels et
   formats sont definis et charges ils seront utilises pour
-  peupler le tableau. La fonction attribue un paramètre
-  "param" à chaque variable à partir de tests de normalité,
-  ce paramètre est modifiable ensuite, il conditionne
+  peupler le tableau. La fonction attribue un parametre
+  "param" a chaque variable a partir de tests de normalite,
+  ce parametre est modifiable ensuite, il conditionne
   l'utilisation des tests statistiques dans la fonction
   comparer(). Tous les parametres ont une valeur par
   defaut, il est donc possible de simplement lancer diag()