Este estudio analiza la distribución temporal de los registros de
operación de los oleoductos SOTE y OCP. El año se obtiene de la fecha de
cada registro (Fecha), por lo que toma valores enteros
entre 2015 y 2025 y es una variable cuantitativa
discreta. Los datos de la base son simulados con fines
académicos.
Carga de paquetes.
library(readxl)
library(dplyr)
library(gt)
library(e1071)
setwd() solo tiene efecto dentro del bloque en el que se
ejecuta, por eso la lectura de la base está en el mismo bloque.
setwd("C:/Users/HP/Desktop/tabla_petro")
# 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 <- as.data.frame(read_excel(archivo, sheet = "Datos_10000"))
dim(datos)
## [1] 10000 20
El año se obtiene de los 4 primeros caracteres de la fecha (AAAA-MM-DD), de forma segura tanto si la fecha viene como texto como si viene como fecha de Excel.
Datos <- datos %>%
mutate(Anio = as.numeric(substr(as.character(Fecha), 1, 4))) %>%
filter(!is.na(Anio))
Variable_Exacta <- Datos$Anio
if (length(Variable_Exacta) == 0) stop("ERROR: No hay datos válidos.")
Frecuencias absolutas (ni), porcentuales (hi) y acumuladas ascendentes y descendentes (Ni, Hi).
TDF_Raw <- data.frame(Valor = Variable_Exacta) %>%
group_by(Valor) %>%
summarise(ni = n(), .groups = "drop") %>%
arrange(Valor)
ni <- TDF_Raw$ni
N <- sum(ni)
hi <- (ni / N) * 100
Ni_asc <- cumsum(ni)
Ni_desc <- rev(cumsum(rev(ni)))
Hi_asc <- cumsum(hi)
Hi_desc <- rev(cumsum(rev(hi)))
TDF <- data.frame(
Valor = TDF_Raw$Valor,
ni = ni,
hi = round(hi, 2),
Ni_asc = Ni_asc,
Ni_desc = Ni_desc,
Hi_asc = round(Hi_asc, 2),
Hi_desc = round(Hi_desc, 2)
)
colnames(TDF)[1] <- "Anio"
TDF
## Anio ni hi Ni_asc Ni_desc Hi_asc Hi_desc
## 1 2015 886 8.86 886 10000 8.86 100.00
## 2 2016 952 9.52 1838 9114 18.38 91.14
## 3 2017 963 9.63 2801 8162 28.01 81.62
## 4 2018 920 9.20 3721 7199 37.21 71.99
## 5 2019 892 8.92 4613 6279 46.13 62.79
## 6 2020 871 8.71 5484 5387 54.84 53.87
## 7 2021 887 8.87 6371 4516 63.71 45.16
## 8 2022 940 9.40 7311 3629 73.11 36.29
## 9 2023 923 9.23 8234 2689 82.34 26.89
## 10 2024 882 8.82 9116 1766 91.16 17.66
## 11 2025 884 8.84 10000 884 100.00 8.84
Tabla de distribución de frecuencias.
# Totales
totales <- c("TOTAL", sum(ni), round(sum(hi), 2), "-", "-", "-", "-")
TDF_Char <- TDF %>% mutate(across(everything(), as.character))
TDF_Show <- rbind(TDF_Char, totales)
colnames(TDF_Show) <- names(TDF)
TDF_Show %>%
gt() %>%
tab_header(
title = md("**DISTRIBUCIÓN DE FRECUENCIAS POR AÑO**"),
subtitle = md("Variable: **Año del registro**")
) %>%
tab_source_note(source_note = "Autor: *") %>%
cols_label(
Anio = "Año (xi)",
ni = "Cant. registros (ni)",
hi = "Porcentaje (hi%)",
Ni_asc = "Ni (Asc)", Ni_desc = "Ni (Desc)",
Hi_asc = "Hi (Asc)", Hi_desc = "Hi (Desc)"
) %>%
cols_align(align = "center", columns = everything()) %>%
tab_style(
style = list(cell_fill(color = "#235347"), cell_text(color = "white", weight = "bold")),
locations = cells_title()
) %>%
tab_style(
style = list(cell_fill(color = "#DAF1DE"), cell_text(weight = "bold", color = "#163832")),
locations = cells_column_labels()
) %>%
tab_style(
style = list(cell_fill(color = "#8EB69B"), cell_text(weight = "bold", color = "#163832")),
locations = cells_body(rows = nrow(TDF_Show))
) %>%
tab_options(
table.border.top.color = "#235347",
table.border.bottom.color = "#235347",
column_labels.border.bottom.color = "#235347",
data_row.padding = px(6)
)
| DISTRIBUCIÓN DE FRECUENCIAS POR AÑO | ||||||
| Variable: Año del registro | ||||||
| Año (xi) | Cant. registros (ni) | Porcentaje (hi%) | Ni (Asc) | Ni (Desc) | Hi (Asc) | Hi (Desc) |
|---|---|---|---|---|---|---|
| 2015 | 886 | 8.86 | 886 | 10000 | 8.86 | 100 |
| 2016 | 952 | 9.52 | 1838 | 9114 | 18.38 | 91.14 |
| 2017 | 963 | 9.63 | 2801 | 8162 | 28.01 | 81.62 |
| 2018 | 920 | 9.2 | 3721 | 7199 | 37.21 | 71.99 |
| 2019 | 892 | 8.92 | 4613 | 6279 | 46.13 | 62.79 |
| 2020 | 871 | 8.71 | 5484 | 5387 | 54.84 | 53.87 |
| 2021 | 887 | 8.87 | 6371 | 4516 | 63.71 | 45.16 |
| 2022 | 940 | 9.4 | 7311 | 3629 | 73.11 | 36.29 |
| 2023 | 923 | 9.23 | 8234 | 2689 | 82.34 | 26.89 |
| 2024 | 882 | 8.82 | 9116 | 1766 | 91.16 | 17.66 |
| 2025 | 884 | 8.84 | 10000 | 884 | 100 | 8.84 |
| TOTAL | 10000 | 100 | - | - | - | - |
| Autor: * | ||||||
col_barras <- "#235347"
col_ejes <- "#163832"
col_claro <- "#8EB69B"
titulo_g <- function(x) paste(strwrap(x, 80), collapse = "\n")
vals_x <- as.character(TDF$Anio)
vals_y <- TDF$ni
vals_y_pct <- TDF$hi
ylim_max <- max(vals_y) * 1.1
par(mar = c(6, 5, 5, 2))
bp <- barplot(vals_y,
main = titulo_g("Gráfica N°1: Distribución del año del registro"),
cex.main = 0.9,
ylab = "Cantidad de registros",
col = col_barras, border = "white", axes = FALSE,
ylim = c(0, ylim_max),
axisnames = FALSE)
axis(2, col = col_ejes, col.axis = col_ejes)
axis(1, at = bp, labels = vals_x, col = col_ejes, col.axis = col_ejes, las = 1, cex.axis = 0.9)
title(xlab = "Año", line = 3.5)
grid(nx = NA, ny = NULL, col = "#D7DBDD", lty = "dotted")
box(bty = "l", col = col_ejes)
par(mar = c(6, 5, 5, 2))
bp2 <- barplot(vals_y,
main = titulo_g("Gráfica N°2: Distribución del año del registro"),
cex.main = 0.9,
ylab = "Cantidad de registros",
col = col_barras, border = "white", axes = FALSE,
ylim = c(0, N),
axisnames = FALSE)
axis(2, col = col_ejes, col.axis = col_ejes)
axis(1, at = bp2, labels = vals_x, col = col_ejes, col.axis = col_ejes, las = 1, cex.axis = 0.9)
title(xlab = "Año", line = 3.5)
grid(nx = NA, ny = NULL, col = "#D7DBDD", lty = "dotted")
box(bty = "l", col = col_ejes)
par(mar = c(6, 5, 5, 2))
bp3 <- barplot(vals_y_pct,
main = titulo_g("Gráfica N°3: Distribución porcentual del año del registro"),
cex.main = 0.9,
ylab = "% del total",
col = col_barras, border = "white", axes = FALSE,
ylim = c(0, max(vals_y_pct) * 1.2),
axisnames = FALSE)
axis(2, col = col_ejes, col.axis = col_ejes)
axis(1, at = bp3, labels = vals_x, col = col_ejes, col.axis = col_ejes, las = 1, cex.axis = 0.9)
text(x = bp3, y = vals_y_pct, label = paste0(round(vals_y_pct, 1), "%"), pos = 3, cex = 0.8, col = col_ejes)
title(xlab = "Año", line = 3.5)
grid(nx = NA, ny = NULL, col = "#D7DBDD", lty = "dotted")
box(bty = "l", col = col_ejes)
par(mar = c(6, 5, 5, 2))
bp4 <- barplot(vals_y_pct,
main = titulo_g("Gráfica N°4: Distribución porcentual del año del registro"),
cex.main = 0.9,
ylab = "% del total",
col = col_barras, border = "white", axes = FALSE,
ylim = c(0, 100),
axisnames = FALSE)
axis(2, col = col_ejes, col.axis = col_ejes)
axis(1, at = bp4, labels = vals_x, col = col_ejes, col.axis = col_ejes, las = 1, cex.axis = 0.9)
text(x = bp4, y = vals_y_pct, label = paste0(round(vals_y_pct, 1), "%"), pos = 3, cex = 0.8, col = col_ejes)
title(xlab = "Año", line = 3.5)
abline(h = seq(0, 100, 20), col = "#D7DBDD", lty = "dotted")
box(bty = "l", col = col_ejes)
par(mar = c(6, 5, 5, 2))
boxplot(Variable_Exacta, horizontal = TRUE, col = col_barras,
main = titulo_g("Gráfica N°5: Diagrama de caja del año del registro"),
cex.main = 0.9,
xlab = "", outline = TRUE, outpch = 19, outcol = col_claro,
boxwex = 0.5, frame.plot = FALSE, xaxt = "n")
eje_x <- unique(round(pretty(Variable_Exacta, n = 8)))
axis(1, at = eje_x, labels = format(eje_x, scientific = FALSE), cex.axis = 0.9, col = col_ejes, col.axis = col_ejes)
title(xlab = "Año", line = 3.5)
Se usan puntos (y no líneas) porque la variable es discreta.
par(mar = c(6, 5, 5, 8), xpd = TRUE)
x_vals <- TDF$Anio
y_asc <- TDF$Ni_asc
y_desc <- TDF$Ni_desc
plot(x_vals, y_asc, type = "p", col = col_barras, pch = 19, cex = 1.3,
main = titulo_g("Gráfica N°6: Ojivas ascendente y descendente del año del registro"),
cex.main = 0.9,
ylab = "Frecuencia acumulada", xlab = "",
ylim = c(0, N), axes = FALSE, frame.plot = FALSE)
axis(1, at = x_vals, labels = x_vals, las = 1, cex.axis = 0.9, col = col_ejes, col.axis = col_ejes)
axis(2, col = col_ejes, col.axis = col_ejes)
title(xlab = "Año", line = 3.5)
points(x_vals, y_desc, col = col_claro, pch = 19, cex = 1.3)
legend("right", legend = c("Ascendente", "Descendente"),
col = c(col_barras, col_claro), pch = 19, cex = 0.8,
inset = c(-0.22, 0), bty = "n")
par(xpd = FALSE)
Cálculo de indicadores sobre los valores de la variable.
media_val <- mean(Variable_Exacta)
mediana_val <- median(Variable_Exacta)
t_moda <- table(Variable_Exacta)
freq_max <- max(t_moda)
modas_calc <- as.numeric(names(t_moda)[t_moda == freq_max])
moda_txt <- paste(modas_calc, collapse = ", ")
rango_txt <- paste0("[", min(Variable_Exacta), "; ", max(Variable_Exacta), "]")
varianza_val <- var(Variable_Exacta)
sd_val <- sd(Variable_Exacta)
cv_val <- (sd_val / abs(media_val)) * 100
asimetria_val <- skewness(Variable_Exacta, type = 2)
curtosis_val <- kurtosis(Variable_Exacta, type = 2)
vals_atipicos <- boxplot.stats(Variable_Exacta)$out
num_atipicos <- length(vals_atipicos)
status_atipicos <- if (num_atipicos > 0) {
paste0(num_atipicos, " outliers")
} else {
"0 (Sin atípicos)"
}
df_resumen <- data.frame(
"Variable" = "Año del registro",
"Rango" = rango_txt,
"Media" = media_val,
"Mediana" = mediana_val,
"Moda" = moda_txt,
"Varianza" = varianza_val,
"Desv_Std" = sd_val,
"CV_Porc" = cv_val,
"Asimetria" = asimetria_val,
"Curtosis" = curtosis_val,
"Atipicos" = status_atipicos
)
df_resumen %>%
gt() %>%
tab_header(
title = md("**ESTADÍSTICOS DESCRIPTIVOS**"),
subtitle = "Indicadores calculados sobre los valores de la variable"
) %>%
tab_source_note(source_note = "Autor: *") %>%
fmt_number(columns = c(Media, Mediana, Varianza, Desv_Std), decimals = 2, use_seps = FALSE) %>%
fmt_number(columns = c(CV_Porc, Curtosis), decimals = 2) %>%
fmt_number(columns = c(Asimetria), decimals = 4) %>%
cols_label(
Variable = "Variable",
Rango = "Rango [Min; Max]",
Media = "Media (X̄)",
Mediana = "Mediana (Me)",
Moda = "Moda (Mo)",
Varianza = "Varianza (S²)",
Desv_Std = "Desv. Est. (S)",
CV_Porc = "C.V. (%)",
Asimetria = "Asimetría (As)",
Curtosis = "Curtosis (K)",
Atipicos = "Outliers"
) %>%
cols_align(align = "center", columns = everything()) %>%
tab_options(
column_labels.background.color = "#235347",
table.border.top.color = "#235347",
table.border.bottom.color = "#235347",
column_labels.border.bottom.color = "#235347",
data_row.padding = px(8)
) %>%
tab_style(
style = list(cell_text(weight = "bold", color = "white")),
locations = cells_column_labels()
)
| ESTADÍSTICOS DESCRIPTIVOS | ||||||||||
| Indicadores calculados sobre los valores de la variable | ||||||||||
| Variable | Rango [Min; Max] | Media (X̄) | Mediana (Me) | Moda (Mo) | Varianza (S²) | Desv. Est. (S) | C.V. (%) | Asimetría (As) | Curtosis (K) | Outliers |
|---|---|---|---|---|---|---|---|---|---|---|
| Año del registro | [2015; 2025] | 2019.96 | 2020.00 | 2017 | 9.98 | 3.16 | 0.16 | 0.0177 | −1.23 | 0 (Sin atípicos) |
| Autor: * | ||||||||||
# Interpretación (se usa en la conclusión)
txt_cv <- if (cv_val < 15) "homogéneo" else if (cv_val <= 30) "moderadamente heterogéneo" else "heterogéneo"
txt_asim <- if (abs(asimetria_val) < 0.5) "aproximadamente simétrica" else if (asimetria_val > 0) "asimétrica positiva (sesgo a la derecha)" else "asimétrica negativa (sesgo a la izquierda)"
txt_curt <- if (abs(curtosis_val) < 0.5) "mesocúrtica (similar a la normal)" else if (curtosis_val > 0) "leptocúrtica (más concentrada y con colas más pesadas)" else "platicúrtica (más aplanada)"
pct_moda <- round(max(TDF$hi), 2)
Los valores de la variable Año del registro fluctúan entre 2015 y 2025 y giran en torno a la media de 2019.96 (mediana de 2020), con una desviación estándar de 3.16. El valor más frecuente es 2017, que reúne el 9.63 % de los registros. Con un coeficiente de variación de 0.16 %, el conjunto de datos es homogéneo. La distribución es aproximadamente simétrica (As = 0.0177) y platicúrtica (más aplanada) (K = -1.23). Se identificaron 0 valores atípicos.