UP | HOME |

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)