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$Distancia_tramo_km))

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: Distancia del tramo (km)**"),
    subtitle = md("Variable: **Distancia del tramo**")
  ) %>%
  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: Distancia del tramo (km)
Variable: Distancia del tramo
Lím. Inf Lím. Sup Marca Clase (Xi) ni hi (%) Ni (Asc) Ni (Desc) Hi (Asc) Hi (Desc)
55.00 66.79 60.89 993 9.93 993 10,000 9.93 100.00
66.79 78.57 72.68 1,605 16.05 2,598 9,007 25.98 90.07
78.57 90.36 84.46 1,507 15.07 4,105 7,402 41.05 74.02
90.36 102.14 96.25 973 9.73 5,078 5,895 50.78 58.95
102.14 113.93 108.04 945 9.45 6,023 4,922 60.23 49.22
113.93 125.71 119.82 0 0.00 6,023 3,977 60.23 39.77
125.71 137.50 131.61 0 0.00 6,023 3,977 60.23 39.77
137.50 149.29 143.39 0 0.00 6,023 3,977 60.23 39.77
149.29 161.07 155.18 1,518 15.18 7,541 3,977 75.41 39.77
161.07 172.86 166.96 0 0.00 7,541 2,459 75.41 24.59
172.86 184.64 178.75 979 9.79 8,520 2,459 85.20 24.59
184.64 196.43 190.54 0 0.00 8,520 1,480 85.20 14.80
196.43 208.21 202.32 0 0.00 8,520 1,480 85.20 14.80
208.21 220.00 214.11 1,480 14.80 10,000 1,480 100.00 14.80
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: Distancia del tramo (km)**"),
    subtitle = md(paste0("Variable: **Distancia del tramo** (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: Distancia del tramo (km)
Variable: Distancia del tramo (Amplitud = 10)
Lím. Inf Lím. Sup Marca Clase (Xi) ni hi (%) Ni (Asc) Ni (Desc) Hi (Asc) Hi (Desc)
50 60 55 993 9.93 993 10,000 9.93 100.00
60 70 65 0 0.00 993 9,007 9.93 90.07
70 80 75 1,605 16.05 2,598 9,007 25.98 90.07
80 90 85 0 0.00 2,598 7,402 25.98 74.02
90 100 95 2,480 24.80 5,078 7,402 50.78 74.02
100 110 105 0 0.00 5,078 4,922 50.78 49.22
110 120 115 945 9.45 6,023 4,922 60.23 49.22
120 130 125 0 0.00 6,023 3,977 60.23 39.77
130 140 135 0 0.00 6,023 3,977 60.23 39.77
140 150 145 0 0.00 6,023 3,977 60.23 39.77
150 160 155 0 0.00 6,023 3,977 60.23 39.77
160 170 165 1,518 15.18 7,541 3,977 75.41 39.77
170 180 175 0 0.00 7,541 2,459 75.41 24.59
180 190 185 979 9.79 8,520 2,459 85.20 24.59
190 200 195 0 0.00 8,520 1,480 85.20 14.80
200 210 205 0 0.00 8,520 1,480 85.20 14.80
210 220 215 1,480 14.80 10,000 1,480 100.00 14.80
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 Distancia del tramo",
     xlab = "Distancia del tramo (km)", 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 Distancia del tramo",
     xlab = "Distancia del tramo (km)", 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 Distancia del tramo",
     xlab = "Distancia del tramo (km)", 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 Distancia del tramo",
     xlab = "Distancia del tramo (km)", 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 Distancia del tramo",
        xlab = "Distancia del tramo (km)", 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 Distancia del tramo",
     xlab = "Distancia del tramo (km)", 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 = "Distancia del tramo",
  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: Distancia del tramo") %>%
  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: Distancia del tramo
Variable Rango X Me Mo Varianza sd CV As K Valores atípicos
Distancia del tramo [55 ; 220] 124.37 95.00 95 3,083.23 55.53 44.65 0.4988 −1.15 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 Distancia del tramo fluctúan entre 55 y 220 y giran en torno a la media de 124.37 (mediana de 95), con una desviación estándar de 55.53. Con un coeficiente de variación de 44.65 %, el conjunto de datos es heterogéneo y sus valores se reparten de forma equilibrada alrededor de la media. La distribución es aproximadamente simétrica (As = 0.4988) y platicúrtica (más aplanada) (K = -1.15). No se identificaron valores atípicos.