En esta sección se incorporan las librerías requeridas para realizar
el procesamiento y análisis de la información. La carpeta de trabajo y
la lectura de la base se hacen en el mismo bloque porque
setwd() solo tiene efecto dentro del bloque en el que se
ejecuta.
setwd("C:/Users/HP/Desktop/tabla_petro")
library(readxl)
library(dplyr)
library(gt)
# Busca el archivo de Excel en la carpeta, aunque el nombre tenga un sufijo como "(1)"
archivo <- list.files(pattern = "^tabla_transporte_petroleo.*\\.xlsx$")[1]
if (is.na(archivo)) stop("No se encontró el archivo .xlsx dentro de la carpeta tabla_petro")
datos <- read_excel(archivo, sheet = "Datos_10000")
Se definen una sola vez los colores y las funciones que construyen la
tabla de frecuencias, la tabla con gt y las gráficas. A
diferencia de una variable nominal, en una ordinal las categorías tienen
un orden, por lo que la tabla incluye también las frecuencias acumuladas
(Ni y Hi).
# Paleta de colores
colores <- list(
titulo = "#235347", # título y spanner de las tablas
cabecera = "#DAF1DE", # nombres de columnas
texto = "#163832", # texto oscuro
total = "#8EB69B", # fila Total
barras = "#235347" # barras de las gráficas
)
paleta <- function(n) colorRampPalette(c("#163832", "#235347", "#8EB69B", "#DAF1DE"))(n)
# Tabla de frecuencias de una variable ordinal (las categorías siguen el orden de los niveles)
# ni: absoluta | Ni: absoluta acumulada | fi: fracción | hi: porcentual | Hi: porcentual acumulada
frecuencias_ord <- function(x, nombre) {
tab <- table(x)
tdf <- data.frame(categoria = names(tab), ni = as.numeric(tab), stringsAsFactors = FALSE)
tdf$Ni <- cumsum(tdf$ni)
tdf$fi <- tdf$ni / sum(tdf$ni)
tdf$hi <- round(tdf$ni / sum(tdf$ni) * 100, 5)
tdf$Hi <- cumsum(tdf$hi)
colnames(tdf)[1] <- nombre
tdf
}
# Agrega la fila Total (en el total, las acumuladas coinciden con N y 100 %)
con_total <- function(tdf) {
total <- tdf[1, ]
total[1, 1] <- "Total"
total$ni <- sum(tdf$ni)
total$Ni <- max(tdf$Ni)
total$fi <- sum(tdf$fi)
total$hi <- sum(tdf$hi)
total$Hi <- max(tdf$Hi)
rbind(tdf, total)
}
# Tabla formal con gt
tabla_gt <- function(tdfc, numero, titulo, subtitulo) {
gt(tdfc) %>%
tab_header(
title = md(paste0("**Tabla N°", numero, ": ", titulo, "**")),
subtitle = subtitulo) %>%
tab_spanner(label = md("**Frecuencia Absoluta**"), columns = c(ni, Ni)) %>%
tab_spanner(label = md("**Frecuencia Relativa**"), columns = c(fi, hi, Hi)) %>%
cols_label(ni = md("**ni**"), Ni = md("**Ni**"),
fi = "Fracción", hi = "Porcentual (%)", Hi = "Acumulada (%)") %>%
fmt_number(columns = fi, decimals = 4) %>%
fmt_number(columns = c(hi, Hi), decimals = 2) %>%
cols_align(align = "center", columns = everything()) %>%
tab_style(
style = list(cell_fill(color = colores$titulo), cell_text(color = "white", weight = "bold")),
locations = cells_title()) %>%
tab_style(
style = list(cell_fill(color = colores$cabecera), cell_text(weight = "bold", color = colores$texto)),
locations = cells_column_labels()) %>%
tab_style(
style = list(cell_fill(color = colores$titulo), cell_text(color = "white", weight = "bold")),
locations = cells_column_spanners()) %>%
tab_style(
style = list(cell_fill(color = colores$total), cell_text(weight = "bold", color = colores$texto)),
locations = cells_body(rows = nrow(tdfc))) %>%
tab_options(
table.border.top.color = colores$titulo,
table.border.bottom.color = colores$titulo,
column_labels.border.bottom.color = colores$titulo,
data_row.padding = px(6),
table.font.size = px(13))
}
# Diagrama de barras (columna = "ni" o "hi")
barras <- function(tdf, columna, titulo, xlab, ylab, ylim = NULL) {
vertical <- max(nchar(as.character(tdf[[1]]))) > 12 || nrow(tdf) > 5
margen <- if (vertical) ceiling(max(nchar(as.character(tdf[[1]]))) * 0.45 + 3) else 5
par(mar = c(margen, 5, 5, 2))
barplot(tdf[[columna]], main = paste(strwrap(titulo, 72), collapse = "\n"),
xlab = "", ylab = ylab,
col = colores$barras, names.arg = tdf[[1]],
las = if (vertical) 2 else 1, cex.names = 1, cex.axis = 0.8, cex.main = 1,
ylim = ylim)
mtext(xlab, side = 1, line = margen - 1.5)
par(mar = c(5, 4, 4, 2) + 0.1)
}
# Diagrama circular con la leyenda a un lado
circular <- function(tdf, titulo, leyenda) {
cols <- paleta(nrow(tdf))
layout(matrix(1:2, nrow = 1), widths = c(3, 2.5))
par(mar = c(1, 3, 1, 3), oma = c(0, 0, 4, 0))
pie(tdf$hi, labels = paste0(round(tdf$hi, 2), "%"), col = cols,
radius = 0.75, cex = 1, init.angle = 90)
plot.new()
legend("center", legend = tdf[[1]], fill = cols, cex = 1, title = leyenda, bty = "n")
mtext(paste(strwrap(titulo, 72), collapse = "\n"), outer = TRUE, line = 0.5, font = 2, cex = 1)
layout(1)
par(mar = c(5, 4, 4, 2) + 0.1, oma = c(0, 0, 0, 0))
}
# Tabla de indicadores: en una variable ordinal tienen sentido el rango, la mediana y la moda
indicadores_gt <- function(variable, rango, mediana, moda, subtitulo) {
tabla <- data.frame(variable, rango, "N/A", mediana, moda, "N/A", "N/A", "N/A", "N/A", "N/A", "N/A",
stringsAsFactors = FALSE)
names(tabla) <- c("Variable", "Rango [Min; Max]", paste0("Media (X", "\u0304", ")"), "Mediana (Me)",
"Moda (Mo)", paste0("Varianza (S", "\u00b2", ")"), "Desv. Est. (S)", "C.V. (%)",
"Asimetría (As)", "Curtosis (K)", "Valores Atípicos")
gt(tabla) %>%
tab_header(
title = md("**CONCLUSIONES Y ESTADÍSTICOS**"),
subtitle = subtitulo) %>%
tab_source_note(source_note = "Autor: *") %>%
cols_align(align = "center", columns = everything()) %>%
tab_style(
style = list(cell_fill(color = colores$titulo), cell_text(color = "white", weight = "bold")),
locations = cells_title()) %>%
tab_style(
style = list(cell_fill(color = colores$cabecera), cell_text(weight = "bold", color = colores$texto)),
locations = cells_column_labels()) %>%
tab_options(
table.border.top.color = colores$titulo,
table.border.bottom.color = colores$titulo,
column_labels.border.bottom.color = colores$titulo,
data_row.padding = px(6))
}
Este bloque revisa la estructura de los datos y define el orden de las categorías de la variable. El criterio es el grado de intervención: No < Preventivo < Correctivo (sin mantenimiento, mantenimiento planificado y mantenimiento por falla).
dim(datos)
## [1] 10000 20
datos %>%
select(ID_registro, Fecha, Mantenimiento) %>%
glimpse()
## Rows: 10,000
## Columns: 3
## $ ID_registro <chr> "EC-PIPE-00248", "EC-PIPE-02975", "EC-PIPE-07780", "EC-P…
## $ Fecha <chr> "2015-01-01", "2015-01-02", "2015-01-02", "2015-01-02", …
## $ Mantenimiento <chr> "No", "No", "No", "No", "Preventivo", "No", "No", "No", …
datos$Mantenimiento <- factor(datos$Mantenimiento,
levels = c("No", "Preventivo", "Correctivo"),
ordered = TRUE)
levels(datos$Mantenimiento)
## [1] "No" "Preventivo" "Correctivo"
En esta sección se extrae la variable Mantenimiento para su posterior análisis.
Mantenimiento <- datos$Mantenimiento
TDF_Mantenimiento <- frecuencias_ord(Mantenimiento, "Tipo de mantenimiento")
head(TDF_Mantenimiento)
## Tipo de mantenimiento ni Ni fi hi Hi
## 1 No 8248 8248 0.8248 82.48 82.48
## 2 Preventivo 1266 9514 0.1266 12.66 95.14
## 3 Correctivo 486 10000 0.0486 4.86 100.00
Se calculan las frecuencias absolutas (ni), absolutas acumuladas (Ni), relativas (fi), porcentuales (hi) y porcentuales acumuladas (Hi), y se agrega la fila de totales.
TDF_Mantenimiento_completa <- con_total(TDF_Mantenimiento)
print(TDF_Mantenimiento_completa)
## Tipo de mantenimiento ni Ni fi hi Hi
## 1 No 8248 8248 0.8248 82.48 82.48
## 2 Preventivo 1266 9514 0.1266 12.66 95.14
## 3 Correctivo 486 10000 0.0486 4.86 100.00
## 4 Total 10000 10000 1.0000 100.00 100.00
Se presenta la información en una tabla formal mediante el paquete gt.
tabla_gt(TDF_Mantenimiento_completa, 1,
"DISTRIBUCIÓN DE FRECUENCIAS DE LOS REGISTROS SEGÚN EL TIPO DE MANTENIMIENTO",
"Variable cualitativa ordinal: No < Preventivo < Correctivo")
| Tabla N°1: DISTRIBUCIÓN DE FRECUENCIAS DE LOS REGISTROS SEGÚN EL TIPO DE MANTENIMIENTO | |||||
| Variable cualitativa ordinal: No < Preventivo < Correctivo | |||||
| Tipo de mantenimiento |
Frecuencia Absoluta
|
Frecuencia Relativa
|
|||
|---|---|---|---|---|---|
| ni | Ni | Fracción | Porcentual (%) | Acumulada (%) | |
| No | 8248 | 8248 | 0.8248 | 82.48 | 82.48 |
| Preventivo | 1266 | 9514 | 0.1266 | 12.66 | 95.14 |
| Correctivo | 486 | 10000 | 0.0486 | 4.86 | 100.00 |
| Total | 10000 | 10000 | 1.0000 | 100.00 | 100.00 |
barras(TDF_Mantenimiento, "ni",
"Gráfica N°1: Distribución de la cantidad de registros según tipo de mantenimiento",
"Tipo de mantenimiento", "Cantidad")
barras(TDF_Mantenimiento, "ni",
"Gráfica N°2: Distribución de la cantidad de registros según tipo de mantenimiento",
"Tipo de mantenimiento", "Cantidad", ylim = c(0, sum(TDF_Mantenimiento$ni)))
barras(TDF_Mantenimiento, "hi",
"Gráfica N°3: Distribución en porcentaje según tipo de mantenimiento",
"Tipo de mantenimiento", "Porcentaje")
barras(TDF_Mantenimiento, "hi",
"Gráfica N°4: Distribución en porcentaje según tipo de mantenimiento",
"Tipo de mantenimiento", "Porcentaje", ylim = c(0, 100))
circular(TDF_Mantenimiento,
"Gráfica N°5: Distribución porcentual de los registros según tipo de mantenimiento",
"Mantenimiento")
Solo tiene sentido en una variable ordinal: muestra cuántos registros hay hasta cada categoría, siguiendo el orden.
barras(TDF_Mantenimiento, "Ni",
"Gráfica N°6: Frecuencia absoluta acumulada según tipo de mantenimiento",
"Tipo de mantenimiento", "Cantidad acumulada", ylim = c(0, sum(TDF_Mantenimiento$ni)))
barras(TDF_Mantenimiento, "Hi",
"Gráfica N°7: Frecuencia porcentual acumulada según tipo de mantenimiento",
"Tipo de mantenimiento", "Porcentaje acumulado", ylim = c(0, 100))
En una variable cualitativa ordinal se pueden calcular el rango (categoría mínima y máxima), la mediana (primera categoría cuya frecuencia acumulada llega al 50 %) y la moda. La media, la varianza y los demás indicadores no aplican.
niveles <- TDF_Mantenimiento[[1]]
rango <- paste0("[", niveles[1], "; ", niveles[length(niveles)], "]")
mediana <- niveles[which(TDF_Mantenimiento$Hi >= 50)[1]]
moda <- niveles[which.max(TDF_Mantenimiento$ni)]
indicadores_gt("Tipo de mantenimiento", rango, mediana, moda,
"Resumen de indicadores del tipo de mantenimiento de los registros de operación")
| CONCLUSIONES Y ESTADÍSTICOS | ||||||||||
| Resumen de indicadores del tipo de mantenimiento de los registros de operación | ||||||||||
| Variable | Rango [Min; Max] | Media (X̄) | Mediana (Me) | Moda (Mo) | Varianza (S²) | Desv. Est. (S) | C.V. (%) | Asimetría (As) | Curtosis (K) | Valores Atípicos |
|---|---|---|---|---|---|---|---|---|---|---|
| Tipo de mantenimiento | [No; Correctivo] | N/A | No | No | N/A | N/A | N/A | N/A | N/A | N/A |
| Autor: * | ||||||||||
El valor más frecuente de Tipo de mantenimiento es No, con 8248 registros (82.48 %), y la mediana es No. Esto indica que 82.48 % de los registros no tuvo mantenimiento y que solo 4.86 % requirió mantenimiento correctivo.