Modif du CSS

Gestion des variables quanti vides ou avec 1 entrée dans desc_global()
desc_groupe() finie pour variables quanti et quali.

R/desc_global.R

@@ -84,11 +84,17 @@ desc_global <- function(html="desc_global", titre=NULL, table=NULL, variables=NU
     {
       HTML("<tr><td class='var'>", etiq, "</td>", sep="")
       
-      res <- NA
       for (stat in stats)
       {
         HTML("<td>",sep="")
         
+        if ((length(na.omit(table[[var]])) <= 1) & (stat == "ic95"))
+        {
+          HTML("NA</td>", sep="")
+          warning(var, " ne contient qu'une valeur, on ne peut pas calculer l'ic95")
+          next
+        }
+        
         HTML(format(switch(stat,
           N = length(na.omit(table[[var]])),
           "%/moy" = ,

R/desc_groupe.R

@@ -55,7 +55,8 @@ desc_groupe <- function(groupe=NULL, html=NULL, titre=NULL, table=NULL, variable
       warning("Les variables suivantes n'existent pas dans la table : ",paste(badvar,collapse=", "))
     table[variables_neg]<-list(NULL)
   }
-  table[groupe]<-NULL;
+  
+  table[groupe]<-NULL
   
   # Creation du nom de fichier html
   if (is.null(html))
@@ -78,9 +79,9 @@ desc_groupe <- function(groupe=NULL, html=NULL, titre=NULL, table=NULL, variable
   {
     HTML("<td colspan='2'>N=", table(modulo)[[i]], "</td>", sep="")
   }
-  HTML("</tr>")
+  HTML("<td></td></tr>")
 
-  HTML("<tr><td></td>", paste0(rep(c("<td>N/moy</td>","<td>%/SD</td>"),nlevels(modulo)),collapse=""), "</tr>")
+  HTML("<tr><td></td>", paste0(rep(c("<td>N/moy</td>","<td>%/SD</td>"),nlevels(modulo)),collapse=""), "<td></td></tr>")
 
   dec()
   HTML("</thead>")
@@ -107,77 +108,55 @@ desc_groupe <- function(groupe=NULL, html=NULL, titre=NULL, table=NULL, variable
     # Variable quantitative
     if (is.numeric(table[[var]]))
     {
-#       HTML("<tr><td class='var'>", etiq, "</td>", sep="")
-#       
-#       res <- NA
-#       for (stat in stats)
-#       {
-#         HTML("<td>",sep="")
-#         
-#         HTML(format(switch(stat,
-#                            N = length(na.omit(table[[var]])),
-#                            "%/moy" = ,
-#                            moy = mean(table[[var]],na.rm=T),
-#                            "%/med" = ,
-#                            med = median(table[[var]],na.rm=T),
-#                            Q1 = quantile(table[[var]], probs=.25, na.rm=T),
-#                            Q3 = quantile(table[[var]], probs=.75, na.rm=T),
-#                            min = min(table[[var]],na.rm=T),
-#                            max = max(table[[var]],na.rm=T),
-#                            et = sd(table[[var]],na.rm=T),
-#                            ic95 = paste0("&plusmn;",format(mean(table[[var]],na.rm=T) - t.test(table[[var]])$conf.int[1], digits=nbdec,nsmall=nbdec,decimal.mark=decmark))
-#         ),digits=nbdec,nsmall=nbdec,decimal.mark=decmark), sep="")
-#         
-#         HTML("</td>", sep="")
-#       }
-#       
-#       HTML("</tr>")
+      HTML("<tr><td class='var'>", etiq, "</td>", sep="")
+      
+      for (level in levels(modulo))
+        HTML("<td>",format(mean(table[[var]][modulo==level], na.rm=T), digits=nbdec,nsmall=nbdec,decimal.mark=decmark), "</td><td>", format(sd(table[[var]][modulo==level],na.rm=T), digits=nbdec,nsmall=nbdec,decimal.mark=decmark), "</td>", sep="")
+      
+      if (var %in% .param)
+      {
+        if (nlevels(modulo) == 2)
+          HTML("<td>", format(t.test(table[[var]] ~ modulo)$p.value, digits=nbdec,nsmall=nbdec,decimal.mark=decmark), "(t)</td>")
+        else if (nlevels(modulo) > 2)
+          HTML("<td>", format(summary(aov(table[[var]] ~ modulo))[[1]][["Pr(>F)"]][1], digits=nbdec,nsmall=nbdec,decimal.mark=decmark), "(aov)</td>")
+      }
+      else
+      {
+        if (nlevels(modulo) == 2)
+          HTML("<td>", format(wilcox.test(table[[var]] ~ modulo)$p.value, digits=nbdec,nsmall=nbdec,decimal.mark=decmark), "(m-w)</td>")
+        else if (nlevels(modulo) > 2)
+          HTML("<td>", format(kruskal.test(table[[var]] ~ modulo)$p.value, digits=nbdec,nsmall=nbdec,decimal.mark=decmark), "(k-w)</td>")
+      }
+      
+      HTML("</tr>")
     }
     # Variable qualitative
     else if (is.factor(table[[var]]))
     {
-#       HTML("<tr><td class='var' colspan='", length(stats)+1, "'>", etiq, "</td></tr>")
-#       
-#       # Donnees manquantes
-#       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>")
-#       }
-#       
-#       # Levels de la variable qualitative
-#       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") | (stat == "%/med"))
-#             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>")
-#      }
+      HTML("<tr><td class='var' colspan='", nlevels(modulo)*2+1, "'>", etiq, "</td>", sep="")
+      HTML("<td>", tryCatch(
+        paste0(format(chisq.test(table[[var]],modulo)$p.value,digits=nbdec,nsmall=nbdec,decimal.mark=decmark),"(X)"),
+        warning=function(w)
+        {
+          paste0(format(fisher.test(table[[var]],modulo,workspace=2e6)$p.value,digits=nbdec,nsmall=nbdec,decimal.mark=decmark),"(F)")
+        },
+        error=function(e)
+        {
+          "NA"
+        }), "</td></tr>")
+      
+      # Levels de la variable qualitative
+      for (level in levels(table[[var]]))
+      {
+        HTML("<tr><td class='level'>", level, "</td>",sep="")
+        for (level_m in levels(modulo))
+        {
+          HTML("<td>", table(table[[var]],modulo)[level,level_m], "</td>", sep="")
+          HTML("<td>", format(100*table(table[[var]],modulo)[level,level_m]/sum(table(table[[var]],modulo)), digits=nbdec, nsmall=nbdec, decimal.mark=decmark), "</td>", sep="")
+        }
+        
+        HTML("<td></td></tr>")
+     }
     }
     else next
   }

data/cosmosR.css

@@ -9,8 +9,10 @@ div.desc
   border-radius: 10px;
   box-shadow: 2px 4px 5px grey inset;
   margin: 20px auto;
-  width: 60%;
   padding: 10px;
+  display: inline-block;
+  overflow: hidden;
+  resize: both;
 }
 
 table.desc
@@ -60,7 +62,7 @@ table.desc tbody td.level
 
 table.desc tbody td
 {
-  padding: 0 1em;
+  padding-top: 1em;
   text-align: right;
 }