Modérateur : Groupe des modérateurs
Code : Tout sélectionner
# créer un tableau pour l'exemple
a <- data.frame(A = rnorm(5), B= runif(5), C= rpois(5,2))
b <- xtable(a)
print(b, type="html",add.to.row=list(pos = list(1), command = "bgcolor = \"#FF6F5A\""), file="/home/gilles/bureau/essais.html")
Code : Tout sélectionner
<TABLE border=1>
<TR> <TH> </TH> <TH> A </TH> <TH> B </TH> <TH> C </TH> </TR>
<TR> <TD align="right"> 1 </TD> <TD align="right"> -0.06 </TD> <TD align="right"> 0.43 </TD> <TD align="right"> 3.00 </TD> </TR>
bgcolor = "#FF6F5A"<TR> <TD align="right"> 2 </TD> <TD align="right"> 0.75 </TD> <TD align="right"> 0.29 </TD> <TD align="right"> 0.00 </TD> </TR>
<TR> <TD align="right"> 3 </TD> <TD align="right"> 0.34 </TD> <TD align="right"> 0.20 </TD> <TD align="right"> 4.00 </TD> </TR>
<TR> <TD align="right"> 4 </TD> <TD align="right"> 0.70 </TD> <TD align="right"> 0.07 </TD> <TD align="right"> 1.00 </TD> </TR>
<TR> <TD align="right"> 5 </TD> <TD align="right"> 0.24 </TD> <TD align="right"> 0.12 </TD> <TD align="right"> 0.00 </TD> </TR>
</TABLE>
Code : Tout sélectionner
<TABLE border=1>
<TR> <TH> </TH> <TH> A </TH> <TH> B </TH> <TH> C </TH> </TR>
<TR> <TD align="right"> 1 </TD> <TD align="right"> -0.06 </TD> <TD align="right"> 0.43 </TD> <TD align="right"> 3.00 </TD> </TR>
<TR bgcolor = "#FF6F5A"> <TD align="right"> 2 </TD> <TD align="right"> 0.75 </TD> <TD align="right"> 0.29 </TD> <TD align="right"> 0.00 </TD> </TR>
<TR> <TD align="right"> 3 </TD> <TD align="right"> 0.34 </TD> <TD align="right"> 0.20 </TD> <TD align="right"> 4.00 </TD> </TR>
<TR> <TD align="right"> 4 </TD> <TD align="right"> 0.70 </TD> <TD align="right"> 0.07 </TD> <TD align="right"> 1.00 </TD> </TR>
<TR> <TD align="right"> 5 </TD> <TD align="right"> 0.24 </TD> <TD align="right"> 0.12 </TD> <TD align="right"> 0.00 </TD> </TR>
</TABLE>
Code : Tout sélectionner
HTML.data.frame2 <-
function (x, file = get(".HTML.file"), Border = 1, innerBorder = 0,
classfirstline = "firstline", classfirstcolumn = "firstcolumn",
classcellinside = "cellinside", append = TRUE, align = "center",
caption = "", captionalign = "bottom", classcaption = "captiondataframe",
classtable = "dataframe", digits = getOption("R2HTML.format.digits"),
nsmall = getOption("R2HTML.format.nsmall"), big.mark = getOption("R2HTML.format.big.mark"),
big.interval = getOption("R2HTML.format.big.interval"), decimal.mark = getOption("R2HTML.format.decimal.mark"),
# sortableDF = getOption("R2HTML.sortableDF"),
row.names = TRUE, optfirstline = NULL, optfirstcolumn = NULL, optcellinside=NULL, opttable=NULL, optinnertable=NULL, ...)
{
cat("\n", file = file, append = append)
# sortableDF removed from this version
# if (is.null(sortableDF))
# sortableDF = FALSE
# if (sortableDF)
# cat(paste(c("\n<style>", ".tablesort {", "cursor: pointer ;",
# " behavior:url(tablesort.htc);", " -moz-binding: url(moz-behaviors.xml#tablesort.htc);",
# "}", "</style>\n"), collapse = "\n"), file = file,
# append = TRUE)
txt <- paste("\n<p align=", align, ">")
# caption
txtcaption <- ifelse(is.null(caption), "", paste("\n<caption align=",
captionalign, " class=", classcaption, ">", caption,
"</caption>\n", sep = ""))
# table and table styles (NEW : opttable and optinnertable stuff)
if (!is.null(Border)){
txt <- paste(txt, "\n<table ",opttable, if(!is.null(opttable)) ";"," cellspacing=0 border=", Border,
">", txtcaption, "<tr><td>", "\n\t<table border=",
innerBorder," ", if(!is.null(classtable)) "class=", classtable, " ",optinnertable, ">", sep = "")} else {
txt <- paste(txt, "\n<table border=", innerBorder, " class=",
classtable," ", optinnertable , if(!is.null(optinnertable)) ";", " cellspacing=0>", txtcaption, sep = "")}
txt <- paste(txt, "\t<tbody>", sep = "\n")
# formating the data
x.formatted <- format(x, digits = digits, nsmall = nsmall,
big.mark = big.mark, big.interval = big.interval, decimal.mark = decimal.mark)
x.formatted <- as.matrix(x.formatted)
x.formatted[is.na(x.formatted)] <- " "
x.formatted[is.nan(x.formatted)] <- " "
x.formatted[x.formatted == "NaN"] <- " " # New (avoid the use of HTMLReplaceNA)
x.formatted[x.formatted == "NA"] <- " " # New (avoid the use of HTMLReplaceNA)
#########################################################################################
## part strongly modified
if(is.vector(classcellinside) & length(classcellinside)==1) classcellinside <- matrix(classcellinside, dim(x)[1], dim(x)[2])
if(is.vector(optcellinside) & length(optcellinside)==1) optcellinside <- matrix(optcellinside, dim(x)[1], dim(x)[2])
# col names
if(row.names) tabnames <- c(" ", dimnames(x)[[2]]) else tabnames <- dimnames(x)[[2]] # add empty colname above the row names if necessary
if(length(optfirstline) == 1) optfirstline <- rep(optfirstline, length(tabnames))
if(length(classfirstline) == 1 & is.null(optfirstline)) { # same options and behavior as the original R2HTML.data.frame
tabnames <- paste("<th> ", tabnames, " </th>", sep="")
tabnames[1] <- paste("<tr class= ", classfirstline, ">", tabnames[1], sep="")
tabnames[length(tabnames)] <- paste(tabnames[length(tabnames)], "</tr> \n", sep="")
} else {
if (length(classfirstline) == length(tabnames)-1) classfirstline <- c("noclass", classfirstline) # add a warning ?
if (length(optfirstline) == length(optfirstline)-1) optfirstline <- c("", optfirstline)
tabnames <- paste("<th ", if(!is.null(classfirstline)) "class=", classfirstline, " ", optfirstline ,"> ", tabnames, " </th>", sep="")
tabnames[1] <- paste("<tr>", tabnames[1], sep="")
tabnames[length(tabnames)] <- paste(tabnames[length(tabnames)], "</tr> \n", sep="")
}
# row names
if(row.names) tabrownames <- paste("<td ", if(!is.null(classfirstcolumn)) "class=", classfirstcolumn, " ", optfirstcolumn ,"> ", dimnames(x)[[1]], " </td>", sep="")
# cells inside the table
tab <- matrix(paste("<td ", if(!is.null(classcellinside)) "class=", classcellinside, " ", optcellinside ,"> ", x.formatted, " </td>", sep=""), dim(x)[1], dim(x)[2])
if(row.names) tab <- cbind(tabrownames, tab)
tab[,1] <- paste("<tr>", tab[,1])
tab[,dim(tab)[2]] <- paste( tab[,dim(tab)[2]],"</tr> \n")
tab <- rbind(tabnames, tab)
tab <- do.call("paste",as.list(t(tab))) # paste all the matrix cells in one string
txt <- paste(txt, tab, "\n\t</tbody>\n</table>\n", if (!is.null(Border)) "</td></table>\n", "<br>")
cat(txt, "\n", file = file, sep = "", append = TRUE)
}
Code : Tout sélectionner
data(swiss)
x <- cor(swiss)
# example using CSS classes
style <- matrix("cellinside", dim(x)[1], dim(x)[2])
style[x > 0.5 & x != 1] <- "emphasis1"
style[x < -0.5] <- "emphasis2"
Code : Tout sélectionner
library(R2HTML)
HTMLStart(filename = "swiss", echo = FALSE)
HTML.data.frame2(x, classcellinside = style)
HTMLStop()
Code : Tout sélectionner
TD.emphasis1 {
padding: 5 10;
background: #FF6F5A;
text-align=right
}
TD.emphasis2 {
padding: 5 10;
background: #A0FFAD;
text-align=right
}
Code : Tout sélectionner
optFirstCol <- "style = \" padding: 5 10; background: #C0C0C0; text-align:center;font-family: Arial, sans-serif; font-size: 10pt \""
optFirstRow <- "style = \" padding: 5 10; color: #FFFFFF; background: #000000; text-align : left ;font-family: Arial, sans-serif; font-size: 10pt \""
optCells <- "style = \" padding: 5 10; background: #FFFFFF; text-align : center ;font-family: Arial, sans-serif; font-size: 10pt\""
emphasis1 <- "style = \" padding: 5 10; background: #FF6F5A; text-align : center ;font-family: Arial, sans-serif; font-size: 10pt\""
emphasis2 <- "style = \" padding: 5 10; background: #A0FFAD; text-align : center ;font-family: Arial, sans-serif; font-size: 10pt\""
style <- matrix(optCells, dim(x)[1], dim(x)[2])
style[x > 0.5 & x != 1] <- emphasis1
style[x < -0.5] <- emphasis2
HTML.data.frame2(x, file = "/home/gilles/bureau/swiss_no_css.html", optfirstline = optFirstRow, optfirstcolumn = optFirstCol, optcellinside=style, optinnertable = optTable)
quelle est la différence entre OdfSweave et ce que tu proposes ?Gilles San Martin a écrit :Je cherche un moyen d'exporter des tableaux de résultats R vers un format HTML ou compatible avec un traitement de texte (çà c'est facile : R2HTML, xtables,...) mais aussi de changer la mise en forme de chaque cellule en fonction de son contenu.
Avec Word (office 2003 et XP) :Gilles San Martin a écrit :on veuille générer pour chaque pays un titre, une matrice de corrélation, les résultats d'une PCA et un graphique représentant les deux premiers axes le tout dans un seul rapport généré automatiquement, les pays les uns à la suite des autres.
Si c'est possible çà m'intéresserait beaucoup de savoir comment on fait en odfWeave...
Gilles San Martin a écrit :Bonjour
Il semble que personne ne soit très inspiré par ma question... J'ai donc mis la main à la pâte et j'ai modifié la fonction de R2HTML qui met en forme les tableaux (matrices et data.frames) pour obtenir ce que je voulais. J'espère que je n'ai pas (trop) réinventé la roue... Voici ce que çà donne au cas où çà pourrait servir à quelqu'un un jour (je n'ai pas de question particulière...).
Code : Tout sélectionner
library(R2HTML)
HTMLStart(filename = "trends", echo = FALSE)
for(i in 1:length(coxsp)) {
HTML.title(coxsp[i])
HTMLInsertGraph(as.character(paste("/home/gilles/stats/R/WorkingDirectory/rprojects/201106_atlas_ladybirds/graphs/maps/",coxsp[i], ".png", sep="")))
HTML.title("observations (date x UTM1 x Observer)", 3)
HTML(trend.layout(a, sp = coxsp[i])[[1]])
HTML.title("UTM 1km", 3)
HTML(trend.layout(a, sp = coxsp[i])[[2]])
HTML.title("UTM 5km", 3)
HTML(trend.layout(a, sp = coxsp[i])[[3]])
}
HTMLStop()
Retourner vers « Questions en cours »
Utilisateurs parcourant ce forum : Aucun utilisateur enregistré et 1 invité