Plantilla para exportar FactoMineR a LaTeX
2025-11-03
Plantilla para exportar FactoMineR a LaTeX
El paquete FactoMineR de R se especializa en el análisis exploratorio multidimensional. He creado un plantilla en R para exportar los resultados más relevantes a LaTeX.
@book{benzecri1973,
author = {Benzécri, Jean‐Paul},
title = {Analyse des Données et Recherche Opérationnelle},
publisher = {Dunod},
year = {1973},
address = {Paris}
}
@book{greenacre2007,
author = {Greenacre, Michael J.},
title = {Correspondence Analysis in Practice},
edition = {2nd},
publisher = {Chapman \& Hall/CRC},
year = {2007},
address = {Boca Raton, FL}
}
@book{lebart2000,
author = {Lebart, Laurent and Piron, Marie and Steiner, Jean‐François},
title = {Statistique Exploratoire Multidimensionnelle},
publisher = {Dunod},
year = {2000},
address = {Paris}
}
@book{husson2017,
author = {Husson, François and Lê, Sébastien and Pagès, Jérôme},
title = {Exploratory Multivariate Analysis by Example Using R},
publisher = {CRC Press},
year = {2017},
address = {London}
}
library(data.table);setDTthreads(0L); library(FactoMineR) library(xtable) library(factoextra) library(tikzDevice) library(corrplot) etiquetarlargo <- function(variable,etiquetas){ texto <- etiquetas[["Etiqueta"]][ etiquetas[["Variable"]] == variable ][1] if(is.na(texto)) texto <- pasaravariabletex(variable) texto } etiquetarcorto <- function(variable,etiquetas){ texto <- etiquetas[["Etiqueta_corta"]][ etiquetas[["Variable"]] == variable ][1] if(is.na(texto) | texto=="NA") texto <- pasaravariabletex(variable) texto } pasaravariabletex <- function(variable) { variable <- gsub("_","",variable) variable <- gsub(" ","",variable) variable } sacartablamodclacategoria <- function(cluster, rescategory,etiquetas){ categoriatabla <- rescategory[[cluster]] dd1 <- as.data.frame(categoriatabla) dd1[["rows"]] <- rownames(dd1) dd1 <- as.data.table(dd1) dd1[["rows"]] temp <- as.data.frame(do.call(rbind,strsplit(dd1[["rows"]],"=",fixed=TRUE))) colnames(temp) <- c("Variable","variablemodalidad") dd2 <- as.data.table(cbind(dd1,temp)) dd3 <- merge(dd2,etiquetas,by="Variable",all.x=TRUE) for( i in 1:nrow(dd3)){ value <- gsub(paste0(dd3[i,Variable],"_"),"",dd3[i,variablemodalidad]) set(dd3,i=i,j="modalidad",value=value) } set(dd3, j="etiquetaconmodalidad", value= paste0(dd3[["Etiqueta_corta"]],"=",dd3[["modalidad"]])) set(dd3, j="cluster",value=cluster) dd3 } creartextotikzgraficoinercia <- function(inercia){ n <- length(inercia) xtick <- paste0(1:n,collapse=",") texto <- paste0(" %%\\usepackage{pgfplots} \\begin{tikzpicture} \\begin{axis}[ width=\\textwidth, height=0.6\\textwidth, xlabel={Dimensiones}, ylabel={Porcentaje de varianza explicada (\\%)}, xmin=0.95, xmax=",n+0.05,", ymin=0, xtick={",xtick,"}, grid=both, major grid style={line width=.1pt, draw=gray!10}, minor grid style={line width=.1pt, draw=gray!10}, axis lines=left, axis line style={-stealth, thick}, label style={font=\\small}, tick label style={font=\\footnotesize}, title={Gráfico de inercia}, title style={font=\\bfseries}, legend style={ cells={anchor=west}, legend pos=north east, font=\\footnotesize }, area legend, bar width=4,%0.6, ybar, enlargelimits=0.05, point meta=explicit, % Requerido para metadatos explícitos nodes near coords={\\pgfmathprintnumber{\\pgfplotspointmeta}}, every node near coord/.append style={ font=\\footnotesize, inner sep=1pt } ] % Barras de varianza individual (con metadatos) \\addplot+[ybar, fill=blue!30, draw=blue!50!black] coordinates { ") for(i in 1:n) { texto <- paste0(texto, "(",i,", ", inercia[i],") [",inercia[i],"]\n" ) } texto <- paste(texto, " }; \\end{axis} \\end{tikzpicture} ") texto } datos <- readRDS(file.path("..","datosoriginales", "datos251101.rds")) etiquetas <- readRDS(file.path("..","datosoriginales", "etiquetas251101.rds")) texto <- "" variablesactivas <- c( "lugar_accidente", "mes", "dia", "hora", "h_trabajadas", "gravedad", "parte_cuerpo_lesionada1", "tipo_lesion1", "tipo_lugar1", "tipo_trabajo1", "act_fisica_acc1", "desviacion1", "forma1", "agent_actfis1", "agent_desv1", "agent_forma1", "d11", "d12", "d13", "d22", "d31", "d32", "d41", "d42", "d51", "d61", "d62", "d63", "d64", "d71", "d72", "d81", "d82", "d91", "d92") posvariablesiulstrativas <- which( ! names(datos) %in% variablesactivas ) posvariablesiulstrativas res.mca <- MCA(datos, ncp=40, quali.sup=posvariablesiulstrativas, graph = FALSE) res.mca$eig fviz_screeplot(res.mca, addlabels = TRUE) texto <- creartextotikzgraficoinercia(round(res.mca$eig[1:40,"percentage of variance"],1)) cat(texto) fichero <- "tex11inercia.tex" cat(texto,file=fichero) texto <- "" res.mcatex <- res.mca names(res.mcatex$var) rownames(res.mcatex$var$coord) <- gsub("_","\\\\_",rownames(res.mcatex$var$coord)) rownames(res.mcatex$var$contrib) <- gsub("_","\\\\_",rownames(res.mcatex$var$contrib)) rownames(res.mcatex$var$cos2) <- gsub("_","\\\\_",rownames(res.mcatex$var$cos2)) rownames(res.mcatex$var$eta2) <- gsub("_","\\\\_",rownames(res.mcatex$var$eta2)) names(res.mcatex$quali.sup) rownames(res.mcatex$quali.sup$coord) <- gsub("_","\\\\_",rownames(res.mcatex$quali.sup$coord)) rownames(res.mcatex$quali.sup$cos2) <- gsub("_","\\\\_",rownames(res.mcatex$quali.sup$cos2)) rownames(res.mcatex$quali.sup$eta2) <- gsub("_","\\\\_",rownames(res.mcatex$quali.sup$eta2)) res.mcatex$quali.sup res.mcatex$var$coord res.mcadibujo <- res.mcatex rownames(res.mcadibujo$var$coord) <- substring(rownames(res.mcadibujo$var$coord),1,40) res.desc <- dimdesc(res.mcadibujo, axes = c(1,2)) # Description of dimension 1 names(res.desc[[1]]) res.desc[[1]]$quali head(res.desc[[1]]$category) tail(res.desc[[1]]$category) # Description of dimension 2 res.desc[[2]] head(res.desc[[2]]$category) tail(res.desc[[2]]$category) res.mcadibujo <- res.mcatex p <- fviz_mca_biplot(res.mcadibujo, #repel = TRUE, # Avoid text overlapping (slow if many point) label="none", geom="point", ggtheme = theme_minimal(), title="Principales factores discriminantes (dimensiones 1 y 2)") p <- p+ xlab("Ca\\'{\\i}da de personas vs. operar con m\\'aquinas (4.8\\%)") +ylab("Agentes f\\'{\\i}sicos en el ambiente: No vs. S\\'{\\i} (4.5\\%)") p dev.off() tikz("tex21biplot.tex",standAlone = FALSE) p dev.off() p <- fviz_mca_var(res.mcatex, choice = "mca.cor", repel = TRUE, # Avoid text overlapping (slow) ggtheme = theme_minimal()) p <- p+xlab("Dimensión 1") +ylab("Dimensión 2") p tikz("tex31cor.tex",standAlone = FALSE) p dev.off() res.mcatex$var$cos2 p <- corrplot(res.mcatex$var$cos2, is.corr=FALSE) class(p) p ## pdf("tex41cos2.pdf") ## corrplot(res.mcatex$var$cos2, is.corr=FALSE) ## dev.off() ## tikz("tex41cos2.tex",standAlone = FALSE) ## corrplot(res.mcatex$var$cos2, is.corr=FALSE) ## dev.off() resdibujo <- res.mcatex resdibujo names(resdibujo$var) rownames(resdibujo$var$contrib) <- substring(rownames(resdibujo$var$contrib),1,10) rownames(resdibujo$var$cos2) <- substring(rownames(resdibujo$var$cos2),1,10) head(resdibujo$var$contrib) head(resdibujo$var$cos2) ##rownames(resdibujo$var$coord) <- substring(rownames(resdibujo$var$coord),1,50) x <- facto_summarize(resdibujo,element="var") head(x) resdibujo$var$contrib p <- fviz_contrib(resdibujo, choice = "var", axes = 1:40, top = 15,title="Principales contribuci\\'ones a las dimensiones 1-40") p <- p+ylab("Contribuci\\'on (\\%)") p fviz_contrib x <- facto_summarize(resdibujo,element="var") class(x) head(x) tikz("tex51contr.tex",standAlone = FALSE) p dev.off() facto_summarize res.desc <- dimdesc(res.mcatex, axes = c(1,2)) # Description of dimension 1 res.desc[[1]] # Description of dimension 2 res.desc[[2]] hc <- HCPC(res.mca, nb.clust=5,graph=FALSE) hc p <- fviz_dend(hc, palette = "jco", # Color palette see ?ggpubr::ggpar #rect = TRUE, rect_fill =TRUE, show_labels=FALSE) # Label size) p plot(hc, choice ="tree", cex = 0.6) ## tikz("tex61dendo.tex",standAlone = FALSE) ## plot(hc, choice ="tree", cex = 0.6) ## dev.off() hc$data.clust hc$desc.var p <- fviz_cluster(hc) p <- p +xlab("Dimensi\\'on 1") + ylab("Dimensi\\'on 2") + theme_minimal() p tikz("tex71dendogrupos.tex",standAlone = FALSE) p dev.off() hc str(hc$data.clust) round(100*table(hc$data.clust$clust)/sum(table(hc$data.clust$clust)),1) ##hc$desc.var$category texto <- "\\newpage\n\n" rescategory <- hc$desc.var$category length(rescategory) ##icategoria <- 1 for(icategoria in 1:length(rescategory)){ texto <- paste0(texto,"\\newpage\n\n") texto <- paste0(texto,"\n\n\n \\begin{longtable}{@{}p{0.62\\textwidth}rrrr@{}} \\caption{\\label{tab:tabla-grupo-",icategoria,"}Descripción del grupo ",icategoria,".}\\\\ \\toprule \\multicolumn{1}{r}{Porcentajes} & Fila & Col. & Total & \\multicolumn{1}{c}{\\(t\\)}\\\\ \\midrule \\endfirsthead \\multicolumn{5}{c}{\\textit{Continuación del grupo ",icategoria," tabla \\ref{tab:tabla-grupo-",icategoria,"}}}\\\\ \\toprule \\multicolumn{1}{r}{Porcentajes} & Fila & Col. & Total & \\multicolumn{1}{c}{\\(t\\)}\\\\ \\midrule \\endhead \\midrule \\multicolumn{5}{r}{\\textit{Continúa en la siguiente página...}}\\\\ \\endfoot \\bottomrule \\endlastfoot ") tabla <- sacartablamodclacategoria(icategoria,rescategory,etiquetas) tabla <- tabla[abs(v.test)>=2.5] head(tabla) variablesactivas variablesaccidentes <- etiquetas[Relación=="Accidente",Variable] variablesaccidentes variablesilustrativasaccidente <- variablesaccidentes[!variablesaccidentes %in% variablesactivas] variablesilustrativasaccidente variablesempresa <- etiquetas[Relación=="Empresa",Variable] variablesempresa variablespuesto <- etiquetas[Relación=="Ind-puesto",Variable] variablesindividuo <- etiquetas[Relación=="Individuo",Variable] tablita <- tabla[Variable %in% variablesactivas] tablita <- tablita[order(-v.test)] tablita if(nrow(tablita)){ cols <- c("etiquetaconmodalidad","Cla/Mod","Mod/Cla", "Global" , "v.test") texto <- paste0(texto,"\n", print(xtable(tablita[,..cols], digits=c(1)), only.contents=TRUE,include.colnames=FALSE,include.rownames=FALSE,hline.after=NULL,print.results=FALSE)) } tablita <- tabla[Variable %in% variablesilustrativasaccidente] tablita <- tablita[order(-v.test)] tablita if(nrow(tablita)){ texto <- paste0(texto,"\\\\\n \\multicolumn{5}{c}{\\textit{Variables ilustrativas sobre el accidente}}\\\\\n " ) cols <- c("etiquetaconmodalidad","Cla/Mod","Mod/Cla", "Global" , "v.test") texto <- paste0(texto,"\n", print(xtable(tablita[,..cols], digits=c(1)), only.contents=TRUE,include.colnames=FALSE,include.rownames=FALSE,hline.after=NULL,print.results=FALSE)) } tablita <- tabla[Variable %in% variablespuesto] tablita <- tablita[order(-v.test)] tablita if(nrow(tablita)){ texto <- paste0(texto,"\\\\\n \\multicolumn{5}{c}{\\textit{Sobre el puesto de trabajo}}\\\\\n " ) cols <- c("etiquetaconmodalidad","Cla/Mod","Mod/Cla", "Global" , "v.test") texto <- paste0(texto,"\n", print(xtable(tablita[,..cols], digits=c(1)), only.contents=TRUE,include.colnames=FALSE,include.rownames=FALSE,hline.after=NULL,print.results=FALSE)) } tablita <- tabla[Variable %in% variablesindividuo] tablita <- tablita[order(-v.test)] tablita if(nrow(tablita)){ texto <- paste0(texto,"\\\\\n \\multicolumn{5}{c}{\\textit{Sobre el accidentado}}\\\\\n " ) cols <- c("etiquetaconmodalidad","Cla/Mod","Mod/Cla", "Global" , "v.test") texto <- paste0(texto,"\n", print(xtable(tablita[,..cols], digits=c(1)), only.contents=TRUE,include.colnames=FALSE,include.rownames=FALSE,hline.after=NULL,print.results=FALSE)) } tablita <- tabla[Variable %in% variablesempresa] tablita <- tablita[order(-v.test)] tablita if(nrow(tablita)){ texto <- paste0(texto,"\\\\\n \\multicolumn{5}{c}{\\textit{Sobre la empresa}}\\\\\n " ) cols <- c("etiquetaconmodalidad","Cla/Mod","Mod/Cla", "Global" , "v.test") texto <- paste0(texto,"\n", print(xtable(tablita[,..cols], digits=c(1)), only.contents=TRUE,include.colnames=FALSE,include.rownames=FALSE,hline.after=NULL,print.results=FALSE)) } texto <- paste0(texto, " \\end{longtable}\n\n") } cat(texto) cat(texto,file="tex60_tablas.tex") tools::texi2pdf("01_multivariante.tex", clean = TRUE)