1 Carga de librerias

library(readxl)
library(dplyr)
library(gt)
library(e1071)

2 Carga de datos

archivo <- list.files(pattern = "^tabla_transporte_petroleo_ecuador_100.*\\.xlsx$",
                      recursive = TRUE)[1]
if (is.na(archivo)) stop("No se encontró el .xlsx en la carpeta del .Rmd ni en sus subcarpetas")
datos <- as.data.frame(read_excel(archivo, sheet = "Datos_10000"))
dim(datos)
## [1] 10000    20

3 Selección de la variable

Variable <- as.numeric(na.omit(datos$Volumen_entregado_estimado_barriles))

if (length(Variable) == 0) {
  stop("ERROR: No hay datos válidos para la variable seleccionada.")
}

4 Frecuencia

Se agrupan los datos en K clases con la regla de Sturges.

N <- length(Variable)
K <- floor(1 + 3.322 * log10(N))
breaks_table <- seq(min(Variable), max(Variable), length.out = K + 1)

ni <- as.vector(table(cut(Variable, breaks = breaks_table, include.lowest = TRUE, right = FALSE)))

hi <- (ni / sum(ni)) * 100
Ni_asc  <- cumsum(ni)
Ni_desc <- rev(cumsum(rev(ni)))
Hi_asc  <- cumsum(hi)
Hi_desc <- rev(cumsum(rev(hi)))

5 Tabla de Distribución de Frecuencia

A continuación se presenta la tabla de distribución de frecuencias obtenida.

5.1 Tabla General

TDF_General <- data.frame(
  Li = round(breaks_table[1:K], 2),
  Ls = round(breaks_table[2:(K + 1)], 2),
  MC = round((breaks_table[1:K] + breaks_table[2:(K + 1)]) / 2, 2),
  ni = ni,
  hi = hi,
  Ni_asc = Ni_asc,
  Ni_desc = Ni_desc,
  Hi_asc = Hi_asc,
  Hi_desc = Hi_desc
)

TDF_General %>%
  gt(rowname_col = "Li") %>%
  tab_header(
    title = md("**DISTRIBUCIÓN DE FRECUENCIAS: Volumen entregado (bbl)**"),
    subtitle = md("Variable: **Volumen entregado**")
  ) %>%
  tab_source_note(source_note = "Autor: *") %>%
  grand_summary_rows(
    columns = c(ni, hi),
    fns = list("TOTAL" = ~sum(., na.rm = TRUE))
  ) %>%
  fmt_number(
    columns = c(ni, Ni_asc, Ni_desc),
    decimals = 0,
    use_seps = TRUE
  ) %>%
  fmt_number(
    columns = c(hi, Hi_asc, Hi_desc),
    decimals = 2
  ) %>%
  cols_label(
    Ls = "Lím. Sup", MC = "Marca Clase (Xi)",
    ni = "ni", hi = "hi (%)",
    Ni_asc = "Ni (Asc)", Ni_desc = "Ni (Desc)",
    Hi_asc = "Hi (Asc)", Hi_desc = "Hi (Desc)"
  ) %>%
  tab_stubhead(label = "Lím. Inf") %>%
  cols_align(align = "center", columns = everything()) %>%
  tab_style(
    style = cell_text(align = "center"),
    locations = cells_stub()
  ) %>%
  tab_style(
    style = list(cell_fill(color = "#235347"), cell_text(color = "white", weight = "bold")),
    locations = list(cells_title(), cells_column_labels(), cells_stubhead())
  ) %>%
  tab_options(
    table.border.top.style = "none",
    table.border.bottom.color = "#235347",
    column_labels.border.bottom.color = "#235347",
    data_row.padding = px(6)
  )
DISTRIBUCIÓN DE FRECUENCIAS: Volumen entregado (bbl)
Variable: Volumen entregado
Lím. Inf Lím. Sup Marca Clase (Xi) ni hi (%) Ni (Asc) Ni (Desc) Hi (Asc) Hi (Desc)
87926.92 116040.1 101983.5 23 0.23 23 10,000 0.23 100.00
116040.09 144153.3 130096.7 231 2.31 254 9,977 2.54 99.77
144153.26 172266.4 158209.8 857 8.57 1,111 9,746 11.11 97.46
172266.43 200379.6 186323.0 1,388 13.88 2,499 8,889 24.99 88.89
200379.60 228492.8 214436.2 992 9.92 3,491 7,501 34.91 75.01
228492.77 256605.9 242549.4 475 4.75 3,966 6,509 39.66 65.09
256605.94 284719.1 270662.5 558 5.58 4,524 6,034 45.24 60.34
284719.10 312832.3 298775.7 1,237 12.37 5,761 5,476 57.61 54.76
312832.27 340945.4 326888.9 1,733 17.33 7,494 4,239 74.94 42.39
340945.44 369058.6 355002.0 1,469 14.69 8,963 2,506 89.63 25.06
369058.61 397171.8 383115.2 780 7.80 9,743 1,037 97.43 10.37
397171.78 425285.0 411228.4 210 2.10 9,953 257 99.53 2.57
425284.95 453398.1 439341.5 39 0.39 9,992 47 99.92 0.47
453398.12 481511.3 467454.7 8 0.08 10,000 8 100.00 0.08
TOTAL — — 10000 100 — — — —
Autor: *

5.2 Tabla Simplificada

Se redefinen las clases con límites redondeados y una amplitud constante.

breaks_table <- pretty(Variable, n = K)
amplitud <- breaks_table[2] - breaks_table[1]
K <- length(breaks_table) - 1

ni <- as.vector(table(cut(Variable, breaks = breaks_table, include.lowest = TRUE, right = FALSE)))

hi <- (ni / sum(ni)) * 100
Ni_asc  <- cumsum(ni)
Ni_desc <- rev(cumsum(rev(ni)))
Hi_asc  <- cumsum(hi)
Hi_desc <- rev(cumsum(rev(hi)))

TDF_Simple <- data.frame(
  Li = round(breaks_table[1:K], 2),
  Ls = round(breaks_table[2:(K + 1)], 2),
  MC = round((breaks_table[1:K] + breaks_table[2:(K + 1)]) / 2, 2),
  ni = ni,
  hi = hi,
  Ni_asc = Ni_asc,
  Ni_desc = Ni_desc,
  Hi_asc = Hi_asc,
  Hi_desc = Hi_desc
)

TDF_Simple %>%
  gt(rowname_col = "Li") %>%
  tab_header(
    title = md("**DISTRIBUCIÓN DE FRECUENCIAS SIMPLIFICADA: Volumen entregado (bbl)**"),
    subtitle = md(paste0("Variable: **Volumen entregado** (Amplitud = ", round(amplitud, 2), ")"))
  ) %>%
  tab_source_note(source_note = "Autor: *") %>%
  grand_summary_rows(
    columns = c(ni, hi),
    fns = list("TOTAL" = ~sum(., na.rm = TRUE))
  ) %>%
  fmt_number(
    columns = c(ni, Ni_asc, Ni_desc),
    decimals = 0,
    use_seps = TRUE
  ) %>%
  fmt_number(
    columns = c(hi, Hi_asc, Hi_desc),
    decimals = 2
  ) %>%
  cols_label(
    Ls = "Lím. Sup", MC = "Marca Clase (Xi)",
    ni = "ni", hi = "hi (%)",
    Ni_asc = "Ni (Asc)", Ni_desc = "Ni (Desc)",
    Hi_asc = "Hi (Asc)", Hi_desc = "Hi (Desc)"
  ) %>%
  tab_stubhead(label = "Lím. Inf") %>%
  cols_align(align = "center", columns = everything()) %>%
  tab_style(
    style = cell_text(align = "center"),
    locations = cells_stub()
  ) %>%
  tab_style(
    style = list(cell_fill(color = "#235347"), cell_text(color = "white", weight = "bold")),
    locations = list(cells_title(), cells_column_labels(), cells_stubhead())
  ) %>%
  tab_options(
    table.border.top.style = "none",
    table.border.bottom.color = "#235347",
    column_labels.border.bottom.color = "#235347",
    data_row.padding = px(6)
  )
DISTRIBUCIÓN DE FRECUENCIAS SIMPLIFICADA: Volumen entregado (bbl)
Variable: Volumen entregado (Amplitud = 50000)
Lím. Inf Lím. Sup Marca Clase (Xi) ni hi (%) Ni (Asc) Ni (Desc) Hi (Asc) Hi (Desc)
50000 100000 75000 5 0.05 5 10,000 0.05 100.00
100000 150000 125000 360 3.60 365 9,995 3.65 99.95
150000 200000 175000 2,107 21.07 2,472 9,635 24.72 96.35
200000 250000 225000 1,393 13.93 3,865 7,528 38.65 75.28
250000 300000 275000 1,221 12.21 5,086 6,135 50.86 61.35
300000 350000 325000 2,957 29.57 8,043 4,914 80.43 49.14
350000 400000 375000 1,748 17.48 9,791 1,957 97.91 19.57
400000 450000 425000 198 1.98 9,989 209 99.89 2.09
450000 500000 475000 11 0.11 10,000 11 100.00 0.11
TOTAL — — 10000 100 — — — —
Autor: *

6 Gráficas De Distribución De Frecuencias

Esta sección presenta la visualización de la distribución de los datos.

6.1 Histogramas de Frecuencia

col_barras <- "#235347"
col_ejes   <- "#163832"
col_claro  <- "#8EB69B"

h_base <- hist(Variable, breaks = breaks_table, right = FALSE, include.lowest = TRUE, plot = FALSE)
limite_x <- range(breaks_table)
etiquetas_x <- format(breaks_table, scientific = FALSE, trim = TRUE)

6.2 GRÁFICO 1: Histograma Absoluto (Local)

par(mar = c(8, 5, 4, 2))
plot(h_base,
     main = "Gráfica N°1: Distribución de Volumen entregado",
     xlab = "Volumen entregado (bbl)", ylab = "Frecuencia absoluta",
     col = col_barras, border = "white", axes = FALSE,
     ylim = c(0, max(h_base$counts) * 1.1),
     xlim = limite_x, cex.main = 1)

axis(1, at = breaks_table, labels = etiquetas_x, las = 2, cex.axis = 0.7)
axis(2)
grid(nx = NA, ny = NULL, col = "#D7DBDD", lty = "dotted")

6.3 GRÁFICO 2: Histograma Absoluto (Global)

par(mar = c(8, 5, 4, 2))
plot(h_base,
     main = "Gráfica N°2: Distribución de Volumen entregado",
     xlab = "Volumen entregado (bbl)", ylab = "Total registros",
     col = col_barras, border = "white", axes = FALSE,
     ylim = c(0, sum(h_base$counts)),
     xlim = limite_x, cex.main = 1)

axis(1, at = breaks_table, labels = etiquetas_x, las = 2, cex.axis = 0.7)
axis(2)
grid(nx = NA, ny = NULL, col = "#D7DBDD", lty = "dotted")

6.4 Gráficos Porcentuales

h_porc <- h_base
h_porc$counts <- (h_porc$counts / sum(h_porc$counts)) * 100

6.5 GRÁFICO 3: Porcentajes (Local)

par(mar = c(8, 5, 4, 2))
plot(h_porc,
     main = "Gráfica N°3: Distribución porcentual de Volumen entregado",
     xlab = "Volumen entregado (bbl)", ylab = "Porcentaje (%)",
     col = col_barras, border = "white", axes = FALSE, freq = TRUE,
     ylim = c(0, max(h_porc$counts) * 1.2),
     xlim = limite_x, cex.main = 1)

axis(1, at = breaks_table, labels = etiquetas_x, las = 2, cex.axis = 0.7)
axis(2)
text(x = h_base$mids, y = h_porc$counts,
     labels = paste0(round(h_porc$counts, 1), "%"),
     pos = 3, cex = 0.6, col = col_ejes)

6.6 GRÁFICO 4: Porcentajes (Global)

par(mar = c(8, 5, 4, 2))
plot(h_porc,
     main = "Gráfica N°4: Distribución porcentual de Volumen entregado",
     xlab = "Volumen entregado (bbl)", ylab = "% del total",
     col = col_barras, border = "white", axes = FALSE, freq = TRUE,
     ylim = c(0, 100),
     xlim = limite_x, cex.main = 1)

axis(1, at = breaks_table, labels = etiquetas_x, las = 2, cex.axis = 0.7)
axis(2)
text(x = h_base$mids, y = h_porc$counts,
     labels = paste0(round(h_porc$counts, 1), "%"),
     pos = 3, cex = 0.6, col = col_ejes)

6.7 GRÁFICO 5: Boxplot

par(mar = c(8, 5, 4, 2))
boxplot(Variable, horizontal = TRUE, col = col_barras,
        main = "Gráfica N°5: Diagrama de caja de Volumen entregado",
        xlab = "Volumen entregado (bbl)", outline = TRUE, outpch = 19,
        outcol = col_claro, axes = FALSE, xlim = c(0.7, 1.3),
        ylim = limite_x, cex.main = 1)

axis(1, at = breaks_table, labels = etiquetas_x, las = 2, cex.axis = 0.7)
box()

6.8 GRÁFICO 6: Ojivas

par(mar = c(8, 5, 4, 8), xpd = TRUE)

plot(breaks_table, c(0, Ni_asc), type = "o", col = col_barras,
     lwd = 2, pch = 19, axes = FALSE,
     main = "Gráfica N°6: Ojivas ascendente y descendente de Volumen entregado",
     xlab = "Volumen entregado (bbl)", ylab = "Frecuencia acumulada", cex.main = 1)

lines(breaks_table, c(Ni_desc, 0), type = "o", col = col_claro,
      lwd = 2, pch = 19)

axis(1, at = breaks_table, labels = etiquetas_x, las = 2, cex.axis = 0.6)
axis(2)

legend("right", legend = c("Ascendente", "Descendente"),
       col = c(col_barras, col_claro),
       lty = 1, pch = 19, cex = 0.7, lwd = 2,
       inset = c(-0.2, 0), bty = "n")

par(xpd = FALSE)

7 Indicadores Estadísticos

media_val   <- mean(Variable)
mediana_val <- median(Variable)
sd_val      <- sd(Variable)
cv_val      <- (sd_val / abs(media_val)) * 100
asimetria_val <- skewness(Variable, type = 2)
curtosis_val  <- kurtosis(Variable, type = 2)

atipicos <- boxplot.stats(Variable)$out
status_atipicos <- if (length(atipicos) > 0) {
  paste0(length(atipicos), " [ ", round(min(atipicos), 2), " ; ", round(max(atipicos), 2), " ]")
} else {
  "0 (Sin atípicos)"
}

df_resumen <- data.frame(
  Variable = "Volumen entregado",
  Rango = paste0("[", round(min(Variable), 2), " ; ", round(max(Variable), 2), "]"),
  X = media_val,
  Me = mediana_val,
  Mo = paste(round(TDF_Simple$MC[TDF_Simple$hi == max(TDF_Simple$hi)], 2), collapse = ", "),
  Varianza = var(Variable),
  sd = sd_val,
  CV = cv_val,
  As = asimetria_val,
  K = curtosis_val,
  Atipicos = status_atipicos
)

df_resumen %>%
  gt() %>%
  tab_header(title = md("**CONCLUSIONES Y ESTADÍSTICOS**"), subtitle = "Variable: Volumen entregado") %>%
  tab_source_note(source_note = "Autor: *") %>%
  cols_label(
    X = "X",
    Me = "Me",
    Mo = "Mo",
    sd = "sd",
    CV = "CV",
    As = "As",
    K = "K",
    Atipicos = "Valores atípicos"
  ) %>%
  fmt_number(columns = c(X, Me, sd), decimals = 2) %>%
  fmt_number(columns = Varianza, decimals = 2) %>%
  fmt_number(columns = c(CV, K), decimals = 2) %>%
  fmt_number(columns = As, decimals = 4) %>%
  cols_width(
    Variable ~ px(140),
    Rango ~ px(150),
    Mo ~ px(100),
    Atipicos ~ px(220),
    everything() ~ px(85)
  ) %>%
  tab_options(
    column_labels.background.color = "#235347",
    table.border.top.style = "solid",
    table.border.bottom.style = "solid",
    heading.border.bottom.style = "solid",
    column_labels.border.top.style = "solid",
    column_labels.border.bottom.style = "solid",
    data_row.padding = px(8)
  ) %>%
  tab_style(
    style = list(
      cell_text(weight = "bold", color = "white"),
      cell_borders(sides = c("left", "right"), color = "#D3D3D3", weight = px(1))
    ),
    locations = cells_column_labels()
  ) %>%
  tab_style(
    style = cell_borders(sides = c("left", "right"), color = "#D3D3D3", weight = px(1)),
    locations = cells_body()
  )
CONCLUSIONES Y ESTADÍSTICOS
Variable: Volumen entregado
Variable Rango X Me Mo Varianza sd CV As K Valores atípicos
Volumen entregado [87926.92 ; 481511.29] 276,955.06 298,225.83 325000 6,080,791,324.78 77,979.43 28.16 −0.2120 −1.22 0 (Sin atípicos)
Autor: *
txt_cv   <- if (cv_val < 15) "homogéneo" else if (cv_val <= 30) "moderadamente heterogéneo" else "heterogéneo"
txt_ubic <- if (asimetria_val > 0.5) "se agrupan en la parte baja de la variable" else if (asimetria_val < -0.5) "se agrupan en la parte alta de la variable" else "se reparten de forma equilibrada alrededor de la media"
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)"
txt_atip <- if (length(atipicos) > 0) {
  paste0("Se identificaron ", length(atipicos), " valores atípicos, en el rango de ", round(min(atipicos), 2), " a ", round(max(atipicos), 2), ".")
} else {
  "No se identificaron valores atípicos."
}

8 Conclusiones

Los valores de Volumen entregado fluctúan entre 8.792692^{4} y 4.8151129^{5} y giran en torno a la media de 2.7695506^{5} (mediana de 2.9822583^{5}), con una desviación estándar de 7.797943^{4}. Con un coeficiente de variación de 28.16 %, el conjunto de datos es moderadamente heterogéneo y sus valores se reparten de forma equilibrada alrededor de la media. La distribución es aproximadamente simétrica (As = -0.212) y platicúrtica (más aplanada) (K = -1.22). No se identificaron valores atípicos.