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$Perdida_estimada_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: Pérdida estimada (bbl)**"),
    subtitle = md("Variable: **Pérdida estimada en barriles**")
  ) %>%
  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: Pérdida estimada (bbl)
Variable: Pérdida estimada en barriles
Lím. Inf Lím. Sup Marca Clase (Xi) ni hi (%) Ni (Asc) Ni (Desc) Hi (Asc) Hi (Desc)
5.55 59.02 32.28 569 5.69 569 10,000 5.69 100.00
59.02 112.48 85.75 1,161 11.61 1,730 9,431 17.30 94.31
112.48 165.95 139.22 1,752 17.52 3,482 8,270 34.82 82.70
165.95 219.42 192.68 1,918 19.18 5,400 6,518 54.00 65.18
219.42 272.88 246.15 1,554 15.54 6,954 4,600 69.54 46.00
272.88 326.35 299.62 1,173 11.73 8,127 3,046 81.27 30.46
326.35 379.82 353.08 834 8.34 8,961 1,873 89.61 18.73
379.82 433.28 406.55 534 5.34 9,495 1,039 94.95 10.39
433.28 486.75 460.01 266 2.66 9,761 505 97.61 5.05
486.75 540.21 513.48 147 1.47 9,908 239 99.08 2.39
540.21 593.68 566.95 51 0.51 9,959 92 99.59 0.92
593.68 647.15 620.41 25 0.25 9,984 41 99.84 0.41
647.15 700.61 673.88 8 0.08 9,992 16 99.92 0.16
700.61 754.08 727.35 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: Pérdida estimada (bbl)**"),
    subtitle = md(paste0("Variable: **Pérdida estimada en barriles** (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: Pérdida estimada (bbl)
Variable: Pérdida estimada en barriles (Amplitud = 50)
Lím. Inf Lím. Sup Marca Clase (Xi) ni hi (%) Ni (Asc) Ni (Desc) Hi (Asc) Hi (Desc)
0 50 25 455 4.55 455 10,000 4.55 100.00
50 100 75 933 9.33 1,388 9,545 13.88 95.45
100 150 125 1,529 15.29 2,917 8,612 29.17 86.12
150 200 175 1,829 18.29 4,746 7,083 47.46 70.83
200 250 225 1,600 16.00 6,346 5,254 63.46 52.54
250 300 275 1,247 12.47 7,593 3,654 75.93 36.54
300 350 325 927 9.27 8,520 2,407 85.20 24.07
350 400 375 687 6.87 9,207 1,480 92.07 14.80
400 450 425 391 3.91 9,598 793 95.98 7.93
450 500 475 201 2.01 9,799 402 97.99 4.02
500 550 525 124 1.24 9,923 201 99.23 2.01
550 600 575 39 0.39 9,962 77 99.62 0.77
600 650 625 22 0.22 9,984 38 99.84 0.38
650 700 675 8 0.08 9,992 16 99.92 0.16
700 750 725 7 0.07 9,999 8 99.99 0.08
750 800 775 1 0.01 10,000 1 100.00 0.01
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 Pérdida estimada en barriles",
     xlab = "Pérdida estimada (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 Pérdida estimada en barriles",
     xlab = "Pérdida estimada (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 Pérdida estimada en barriles",
     xlab = "Pérdida estimada (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 Pérdida estimada en barriles",
     xlab = "Pérdida estimada (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 Pérdida estimada en barriles",
        xlab = "Pérdida estimada (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 Pérdida estimada en barriles",
     xlab = "Pérdida estimada (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 = "Pérdida estimada en barriles",
  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: Pérdida estimada en barriles") %>%
  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: Pérdida estimada en barriles
Variable Rango X Me Mo Varianza sd CV As K Valores atípicos
Pérdida estimada en barriles [5.55 ; 754.08] 222.72 207.41 175 13,691.20 117.01 52.54 0.6231 0.32 111 [ 533.01 ; 754.08 ]
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 Pérdida estimada en barriles fluctúan entre 5.55 y 754.08 y giran en torno a la media de 222.72 (mediana de 207.42), con una desviación estándar de 117.01. Con un coeficiente de variación de 52.54 %, el conjunto de datos es heterogéneo y sus valores se agrupan en la parte baja de la variable. La distribución es asimétrica positiva (sesgo a la derecha) (As = 0.6231) y mesocúrtica (similar a la normal) (K = 0.32). Se identificaron 111 valores atípicos, en el rango de 533.01 a 754.08.