Commit de version 1.0 et publication sur CRAN !

Suppression des exemples
encoding="native.enc" dans les chargements de fichiers
Correction des effectifs de colonnes dans desc_groupe
Ajout de l'argument "pourcent" dans desc_groupe (pourcentages en lignes ou en colonnes)
Déplacement des CSS et JS dans inst/ plutôt que data/

DESCRIPTION

@@ -1,11 +1,11 @@
 Package: cosmosR
 Type: Package
-Title: Production facilitee de tableaux statistiques
+Title: cosmosR
 Version: 1.0
 Date: 2013-09-18
 Author: Maxime Wack
 Maintainer: Maxime Wack <maximewack@free.fr>
 Depends:
     xlsx
-Description: 
-License: GPLv3
+Description: Production facilitee de tableaux statistiques
+License: GPL-3

R/charger.R

@@ -11,10 +11,6 @@
 #' @param nom Nom de la data frame dans laquelle stocker les donnees chargees
 #' @param 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)
 #' @export
-#' @examples
-#' charger("data.csv") #charger un fichier texte (marche aussi pour les .txt)
-#' charger("donnees.xls") #charger un fichier excel (marche aussi pour les .xlsx)
-#' charger(NULL)
 charger <- function(fichier,nom=NULL,feuille=1)
 {
   # Detache la precedente data.frame et creation du nom de la table si non fourni
@@ -32,16 +28,16 @@ charger <- function(fichier,nom=NULL,feuille=1)
   
   # Lecture du fichier selon l'extension
   if (grepl("\\.csv$",fichier) || grepl("\\.txt$",fichier))
-    x<-read.csv2(fichier, na.strings="")
+    x<-read.csv2(fichier, na.strings="",encoding="native.enc")
   else if (grepl("\\.xlsx?$",fichier))
-    x<-read.xlsx(fichier,feuille)
+    x<-read.xlsx(fichier,feuille,encoding="native.enc")
   
   # Lecture des formats a partir du fichier SAS
   if (file.exists("formats.sas"))
   {
     formats=list(0)
     
-    con=file("formats.sas","r")
+    con=file("formats.sas","r",encoding="native.enc")
       formatsfile=readLines(con)
     close(con)
     
@@ -67,7 +63,7 @@ charger <- function(fichier,nom=NULL,feuille=1)
     # Lecture des attributions de format depuis le fichier SAS
     if (file.exists("attribformats.sas"))
     {
-      con=file("attribformats.sas","r")
+      con=file("attribformats.sas","r",encoding="native.enc")
         attribfile=readLines(con)
       close(con)
       
@@ -96,7 +92,7 @@ charger <- function(fichier,nom=NULL,feuille=1)
   # Lecture des labels a partir du fichier SAS
   if (file.exists("labels.sas"))
   {
-    con=file("labels.sas","r")
+    con=file("labels.sas","r",encoding="native.enc")
     labelsfile=readLines(con)
     close(con)
     labels=labelsfile[grepl('^ *\\w*? *= *\\".*?\\" *$',labelsfile)]

R/desc_global.R

@@ -16,7 +16,7 @@
 #' @param note Note de bas de page, par defaut vide
 #' @param nbdec Nombre de decimales apres la virgule, par defaut 1
 #' @export
-desc_global <- function(html="desc_global", titre=NULL, table=NULL, variables=NULL, variables_neg=NULL, stats=c("N","%/moy","ic95"), miss=TRUE, anglais=FALSE, note=NULL, nbdec=1)
+desc_global <- function(html="desc_global", titre=NULL, table=NULL, variables=NULL, variables_neg=NULL, stats=c("N","%/moy","ic95"), miss=TRUE, note=NULL, nbdec=1)
 {
   # Creation du titre
   if (is.null(titre) & is.null(table))

R/desc_groupe.R

@@ -14,8 +14,9 @@
 #' @param variables_neg Vecteur de noms de variables a exclure de la comparaison
 #' @param note Note de bas de page, par defaut vide
 #' @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 défaut sur le total
 #' @export
-desc_groupe <- function(groupe=NULL, html=NULL, titre=NULL, table=NULL, variables=NULL, variables_neg=NULL, anglais=FALSE, note=NULL, nbdec=1)
+desc_groupe <- function(groupe=NULL, html=NULL, titre=NULL, table=NULL, variables=NULL, variables_neg=NULL, note=NULL, nbdec=1, pourcent=NULL)
 {
   if (is.null(table)) table<-eval(parse(text=table.courante))
   
@@ -77,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=", table(modulo)[[i]], "</td>", sep="")
+    HTML("<td colspan='2'>N=", length(modulo[modulo==i]), "</td>", sep="")
   }
   HTML("<td></td></tr>")
 
@@ -180,7 +181,10 @@ desc_groupe <- function(groupe=NULL, html=NULL, titre=NULL, table=NULL, variable
         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), "</td>", sep="")
+          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=""))
         }
         
         HTML("<td></td></tr>")

R/html.R

@@ -11,9 +11,9 @@
 #' @export
 HTMLInit <- function(file=tempfile(pattern="report", fileext=".html"), title="", CSSfile="")
 {
-  file.copy(from=file.path(path.package("cosmosR"),"data","desc.css"), to=file.path(dirname(file),"desc.css"),overwrite=T)
-  file.copy(from=file.path(path.package("cosmosR"),"data","diag.css"), to=file.path(dirname(file),"diag.css"),overwrite=T)
-  file.copy(from=file.path(path.package("cosmosR"),"data","cosmosR.js"), to=file.path(dirname(file),"cosmosR.js"),overwrite=T)
+  file.copy(from=file.path(path.package("cosmosR"),"inst","desc.css"), to=file.path(dirname(file),"desc.css"),overwrite=T)
+  file.copy(from=file.path(path.package("cosmosR"),"inst","diag.css"), to=file.path(dirname(file),"diag.css"),overwrite=T)
+  file.copy(from=file.path(path.package("cosmosR"),"inst","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)
@@ -59,6 +59,10 @@ HTMLEnd <- function()
 #' 
 #' Ecrit dans le fichier initialise par HTMLInit dont le nom est contenu dans .HTML.file
 #' @encoding UTF-8
+#' @param x Contenu a ecrire
+#' @param ... Contenu concatene sans espace a x
+#' @param append Decide si x... doit etre ajoute a un fichier existant
+#' @param sep Separateur de fin de ligne, modifier pour ecrire sur la meme ligne du fichier
 #' @export
 HTML <- function(x, ..., append=T,sep="\n")
 {
@@ -83,10 +87,10 @@ HTML <- function(x, ..., append=T,sep="\n")
 
 inc <- function()
 {
-  assign(".tabs", .tabs+1, pos=1)
+  assign(".tabs", .tabs+1)
 }
 
 dec <- function()
 {
-  if (.tabs>0) assign(".tabs", .tabs-1, pos=1)
+  if (.tabs>0) assign(".tabs", .tabs-1)
 }

R/label.R

@@ -10,14 +10,6 @@
 #' @param value Le texte de l'etiquette
 #' @export
 #' @return Renvoie une chaine de caracteres contenant l'etiquette de l'objet
-#' @examples
-#' label(a) <- "Une variable"
-#' 
-#' label(a)
-#' # renvoie "Une variable"
-#' 
-#' label(a) <- NULL
-#' # supprime l'attribut
 label <- function(objet) UseMethod("label")
 
 #' @rdname label

SEEC_Nancy.Rproj

@@ -7,7 +7,7 @@ AlwaysSaveHistory: Default
 EnableCodeIndexing: Yes
 UseSpacesForTab: Yes
 NumSpacesForTab: 2
-Encoding: UTF-8
+Encoding: ISO8859-1
 
 RnwWeave: Sweave
 LaTeX: pdfLaTeX

inst/cosmosR.js

@@ -0,0 +1,16 @@
+window.onload = function()
+{
+  var diag_menu_vars = document.querySelectorAll('div.diag_menu p');
+  for (var i in diag_menu_vars)
+  {
+    diag_menu_vars[i].onmouseover = function()
+    {
+      document.getElementById("div_"+this.id).style.display='inline-block';
+    };
+    
+    diag_menu_vars[i].onmouseout = function()
+    {
+      document.getElementById("div_"+this.id).style.display='none';
+    };
+  }
+};

inst/desc.css

@@ -0,0 +1,67 @@
+body
+{
+  background-color: lightgrey;
+}
+
+div.desc
+{
+  background-color: white;
+  border-radius: 10px;
+  box-shadow: 2px 4px 5px grey inset;
+  margin: 20px 10px;
+  padding: 10px;
+  display: inline-block;
+  overflow: hidden;
+  resize: both;
+}
+
+table.desc
+{
+  border-collapse: collapse;
+	font-family: "Tahoma","Trebuchet MS","Verdana","Myriad Web","sans-serif";
+	font-size: .75em;
+}
+
+table.desc caption
+{
+  font-weight: bold;
+  border-bottom: 1px solid black;
+  text-align: left;
+}
+
+table.desc thead, th
+{
+  padding: 0 3em;
+  border-bottom: 1px solid black;
+  height: 2em;
+  font-weight: normal;
+  vertical-align: top;
+  text-align: center;
+}
+
+table.desc tfoot
+{
+  font-style: italic;
+  font-size: small;
+  border-top: 1px solid black;
+}
+
+table.desc tbody td.var
+{
+  padding-top: 1em;
+  padding-left: 0;
+  font-weight: bold;
+  text-align: left;
+}
+
+table.desc tbody td.level
+{
+  padding-left: 1em;
+  text-align: left;
+}
+
+table.desc tbody td
+{
+  text-align: center;
+  vertical-align: bottom;
+}

inst/diag.css

@@ -0,0 +1,66 @@
+body
+{
+  background-color: lightgrey;
+}
+
+div.diag_menu
+{
+  background-color: white;
+  border-radius: 10px;
+  box-shadow: 2px 4px 5px grey inset;
+  margin: 10px 10px;
+  width: 15%;
+  padding: 10px;
+  display: inline-block;
+  vertical-align: top;
+  overflow: hidden;
+  resize: both;
+}
+
+div.diag_menu p
+{
+    margin: 0px;
+    font-weight: bold;
+}
+
+div.diag_menu p:hover
+{
+    background-color: grey;
+}
+
+table.diag{
+  text-align: center;
+  padding: 5px 0;
+}
+
+table.diag td, th
+{
+  padding: 3px;
+}
+
+div.diag_varblock
+{
+  background-color: white;
+  border-radius: 10px;
+  box-shadow: 2px 4px 5px grey inset;
+  margin: 10px 10px;
+  padding: 10px;
+  font-weight: bold;
+  font-size: 1.2em;
+  display: inline-block;
+  vertical-align: top;
+  overflow: hidden;
+  position: fixed;
+}
+
+div.diag_varstat
+{
+  margin: 20px;
+  font-weight: normal;
+  font-size: 1rem;
+}
+
+div.diag_varplot
+{
+  text-align: center;
+}

man/HTML.Rd

@@ -5,6 +5,17 @@
 \usage{
 HTML(x, ..., append = T, sep = "\\n")
 }
+\arguments{
+  \item{x}{Contenu a ecrire}
+
+  \item{...}{Contenu concatene sans espace a x}
+
+  \item{append}{Decide si x... doit etre ajoute a un
+  fichier existant}
+
+  \item{sep}{Separateur de fin de ligne, modifier pour
+  ecrire sur la meme ligne du fichier}
+}
 \description{
 Ecrit dans le fichier HTML cree par HTMLInit
 }

man/charger.Rd

@@ -28,9 +28,4 @@ des variables qualitatives. La table de valeurs prend
 automatiquement le nom du fichier (suffixe par le numero de
 feuille) et est attachee a l'environnement courant.
 }
-\examples{
-charger("data.csv") #charger un fichier texte (marche aussi pour les .txt)
-charger("donnees.xls") #charger un fichier excel (marche aussi pour les .xlsx)
-charger(NULL)
-}
 

man/desc_global.Rd

@@ -5,7 +5,7 @@
 \usage{
 desc_global(html = "desc_global", titre = NULL, table = NULL,
   variables = NULL, variables_neg = NULL, stats = c("N", "\%/moy",
-  "ic95"), miss = TRUE, anglais = FALSE, note = NULL, nbdec = 1)
+  "ic95"), miss = TRUE, note = NULL, nbdec = 1)
 }
 \arguments{
   \item{html}{Nom du fichier html, par defaut

man/desc_groupe.Rd

@@ -4,8 +4,8 @@
 \title{Comparatif par groupe de la table courante}
 \usage{
 desc_groupe(groupe = NULL, html = NULL, titre = NULL, table = NULL,
-  variables = NULL, variables_neg = NULL, anglais = FALSE, note = NULL,
-  nbdec = 1)
+  variables = NULL, variables_neg = NULL, note = NULL, nbdec = 1,
+  pourcent = NULL)
 }
 \arguments{
   \item{html}{Nom du fichier html, par defaut
@@ -30,6 +30,10 @@ desc_groupe(groupe = NULL, html = NULL, titre = NULL, table = NULL,
 
   \item{nbdec}{Nombre de decimales apres la virgule, par
   defaut 1}
+
+  \item{pourcent}{Pourcentages pour les variables
+  qualitatives, en colonnes ("col") ou en lignes ("row"),
+  par défaut sur le total}
 }
 \description{
 Produit un tableau comparatif par groupe de la table

man/label.Rd

@@ -34,13 +34,4 @@ Methode par defaut pour acceder et modifier l'etiquette
 d'un objet ou d'un element d'un objet. Il est possible de
 supprimer l'etiquette en passant NULL a la fonction.
 }
-\examples{
-label(a) <- "Une variable"
-
-label(a)
-# renvoie "Une variable"
-
-label(a) <- NULL
-# supprime l'attribut
-}