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

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: Presión de operación (psi)**"),
    subtitle = md("Variable: **Presión de operación**")
  ) %>%
  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: Presión de operación (psi)
Variable: Presión de operación
Lím. Inf Lím. Sup Marca Clase (Xi) ni hi (%) Ni (Asc) Ni (Desc) Hi (Asc) Hi (Desc)
472.72 541.53 507.13 5 0.05 5 10,000 0.05 100.00
541.53 610.34 575.94 59 0.59 64 9,995 0.64 99.95
610.34 679.16 644.75 237 2.37 301 9,936 3.01 99.36
679.16 747.97 713.56 765 7.65 1,066 9,699 10.66 96.99
747.97 816.78 782.37 1,528 15.28 2,594 8,934 25.94 89.34
816.78 885.59 851.19 2,021 20.21 4,615 7,406 46.15 74.06
885.59 954.40 920.00 1,968 19.68 6,583 5,385 65.83 53.85
954.40 1023.22 988.81 1,491 14.91 8,074 3,417 80.74 34.17
1023.22 1092.03 1057.62 953 9.53 9,027 1,926 90.27 19.26
1092.03 1160.84 1126.44 532 5.32 9,559 973 95.59 9.73
1160.84 1229.65 1195.25 292 2.92 9,851 441 98.51 4.41
1229.65 1298.47 1264.06 111 1.11 9,962 149 99.62 1.49
1298.47 1367.28 1332.87 30 0.30 9,992 38 99.92 0.38
1367.28 1436.09 1401.68 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: Presión de operación (psi)**"),
    subtitle = md(paste0("Variable: **Presión de operación** (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: Presión de operación (psi)
Variable: Presión de operación (Amplitud = 50)
Lím. Inf Lím. Sup Marca Clase (Xi) ni hi (%) Ni (Asc) Ni (Desc) Hi (Asc) Hi (Desc)
450 500 475 2 0.02 2 10,000 0.02 100.00
500 550 525 7 0.07 9 9,998 0.09 99.98
550 600 575 32 0.32 41 9,991 0.41 99.91
600 650 625 111 1.11 152 9,959 1.52 99.59
650 700 675 324 3.24 476 9,848 4.76 98.48
700 750 725 617 6.17 1,093 9,524 10.93 95.24
750 800 775 1,034 10.34 2,127 8,907 21.27 89.07
800 850 825 1,410 14.10 3,537 7,873 35.37 78.73
850 900 875 1,528 15.28 5,065 6,463 50.65 64.63
900 950 925 1,404 14.04 6,469 4,935 64.69 49.35
950 1000 975 1,183 11.83 7,652 3,531 76.52 35.31
1000 1050 1025 851 8.51 8,503 2,348 85.03 23.48
1050 1100 1075 601 6.01 9,104 1,497 91.04 14.97
1100 1150 1125 394 3.94 9,498 896 94.98 8.96
1150 1200 1175 258 2.58 9,756 502 97.56 5.02
1200 1250 1225 138 1.38 9,894 244 98.94 2.44
1250 1300 1275 69 0.69 9,963 106 99.63 1.06
1300 1350 1325 24 0.24 9,987 37 99.87 0.37
1350 1400 1375 9 0.09 9,996 13 99.96 0.13
1400 1450 1425 4 0.04 10,000 4 100.00 0.04
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 Presión de operación",
     xlab = "Presión de operación (psi)", 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 Presión de operación",
     xlab = "Presión de operación (psi)", 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 Presión de operación",
     xlab = "Presión de operación (psi)", 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 Presión de operación",
     xlab = "Presión de operación (psi)", 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 Presión de operación",
        xlab = "Presión de operación (psi)", 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 Presión de operación",
     xlab = "Presión de operación (psi)", 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 = "Presión de operación",
  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: Presión de operación") %>%
  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: Presión de operación
Variable Rango X Me Mo Varianza sd CV As K Valores atípicos
Presión de operación [472.72 ; 1436.09] 908.46 897.96 875 18,129.42 134.65 14.82 0.3555 0.05 80 [ 472.72 ; 1436.09 ]
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 Presión de operación fluctúan entre 472.72 y 1436.09 y giran en torno a la media de 908.46 (mediana de 897.96), con una desviación estándar de 134.65. Con un coeficiente de variación de 14.82 %, el conjunto de datos es homogéneo y sus valores se reparten de forma equilibrada alrededor de la media. La distribución es aproximadamente simétrica (As = 0.3555) y mesocúrtica (similar a la normal) (K = 0.05). Se identificaron 80 valores atípicos, en el rango de 472.72 a 1436.09.