1 Carga de librerias

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

2 Carga de datos

setwd("C:/Users/HP/Desktop/tabla_petro")
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

3 Selección de la variable

Variable <- as.numeric(na.omit(datos$Volumen_transportado_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 transportado (bbl)**"),
    subtitle = md("Variable: **Volumen transportado**")
  ) %>%
  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 transportado (bbl)
Variable: Volumen transportado
Lím. Inf Lím. Sup Marca Clase (Xi) ni hi (%) Ni (Asc) Ni (Desc) Hi (Asc) Hi (Desc)
87999.44 116133.9 102066.7 23 0.23 23 10,000 0.23 100.00
116133.92 144268.4 130201.2 231 2.31 254 9,977 2.54 99.77
144268.40 172402.9 158335.6 855 8.55 1,109 9,746 11.09 97.46
172402.88 200537.4 186470.1 1,388 13.88 2,497 8,891 24.97 88.91
200537.36 228671.8 214604.6 994 9.94 3,491 7,503 34.91 75.03
228671.84 256806.3 242739.1 476 4.76 3,967 6,509 39.67 65.09
256806.32 284940.8 270873.6 558 5.58 4,525 6,033 45.25 60.33
284940.80 313075.3 299008.0 1,233 12.33 5,758 5,475 57.58 54.75
313075.29 341209.8 327142.5 1,737 17.37 7,495 4,242 74.95 42.42
341209.77 369344.2 355277.0 1,469 14.69 8,964 2,505 89.64 25.05
369344.25 397478.7 383411.5 781 7.81 9,745 1,036 97.45 10.36
397478.73 425613.2 411546.0 208 2.08 9,953 255 99.53 2.55
425613.21 453747.7 439680.5 39 0.39 9,992 47 99.92 0.47
453747.69 481882.2 467814.9 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 transportado (bbl)**"),
    subtitle = md(paste0("Variable: **Volumen transportado** (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 transportado (bbl)
Variable: Volumen transportado (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 358 3.58 363 9,995 3.63 99.95
150000 200000 175000 2,098 20.98 2,461 9,637 24.61 96.37
200000 250000 225000 1,403 14.03 3,864 7,539 38.64 75.39
250000 300000 275000 1,210 12.10 5,074 6,136 50.74 61.36
300000 350000 325000 2,957 29.57 8,031 4,926 80.31 49.26
350000 400000 375000 1,756 17.56 9,787 1,969 97.87 19.69
400000 450000 425000 202 2.02 9,989 213 99.89 2.13
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 transportado",
     xlab = "Volumen transportado (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 transportado",
     xlab = "Volumen transportado (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 transportado",
     xlab = "Volumen transportado (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 transportado",
     xlab = "Volumen transportado (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 transportado",
        xlab = "Volumen transportado (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 transportado",
     xlab = "Volumen transportado (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 transportado",
  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 transportado") %>%
  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 transportado
Variable Rango X Me Mo Varianza sd CV As K Valores atípicos
Volumen transportado [87999.44 ; 481882.17] 277,177.78 298,490.67 325000 6,090,391,826.60 78,040.96 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 transportado fluctúan entre 8.799944^{4} y 4.8188217^{5} y giran en torno a la media de 2.7717778^{5} (mediana de 2.9849068^{5}), con una desviación estándar de 7.804096^{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.