1 Carga de Librerias

En esta sección se incorporan las librerías requeridas para realizar el procesamiento y análisis de la información. La carpeta de trabajo y la lectura de la base se hacen en el mismo bloque porque setwd() solo tiene efecto dentro del bloque en el que se ejecuta.

setwd("C:/Users/HP/Desktop/tabla_petro")
library(readxl)
library(dplyr)
library(gt)

# Busca el archivo de Excel en la carpeta, aunque el nombre tenga un sufijo como "(1)"
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 <- read_excel(archivo, sheet = "Datos_10000")

Se definen una sola vez los colores y las funciones que construyen la tabla de frecuencias, la tabla con gt y las gráficas. A diferencia de una variable nominal, en una ordinal las categorías tienen un orden, por lo que la tabla incluye también las frecuencias acumuladas (Ni y Hi).

# Paleta de colores
colores <- list(
  titulo   = "#235347",   # título y spanner de las tablas
  cabecera = "#DAF1DE",   # nombres de columnas
  texto    = "#163832",   # texto oscuro
  total    = "#8EB69B",   # fila Total
  barras   = "#235347"    # barras de las gráficas
)
paleta <- function(n) colorRampPalette(c("#163832", "#235347", "#8EB69B", "#DAF1DE"))(n)

# Tabla de frecuencias de una variable ordinal (las categorías siguen el orden de los niveles)
# ni: absoluta | Ni: absoluta acumulada | fi: fracción | hi: porcentual | Hi: porcentual acumulada
frecuencias_ord <- function(x, nombre) {
  tab <- table(x)
  tdf <- data.frame(categoria = names(tab), ni = as.numeric(tab), stringsAsFactors = FALSE)
  tdf$Ni <- cumsum(tdf$ni)
  tdf$fi <- tdf$ni / sum(tdf$ni)
  tdf$hi <- round(tdf$ni / sum(tdf$ni) * 100, 5)
  tdf$Hi <- cumsum(tdf$hi)
  colnames(tdf)[1] <- nombre
  tdf
}

# Agrega la fila Total (en el total, las acumuladas coinciden con N y 100 %)
con_total <- function(tdf) {
  total <- tdf[1, ]
  total[1, 1] <- "Total"
  total$ni <- sum(tdf$ni)
  total$Ni <- max(tdf$Ni)
  total$fi <- sum(tdf$fi)
  total$hi <- sum(tdf$hi)
  total$Hi <- max(tdf$Hi)
  rbind(tdf, total)
}

# Tabla formal con gt
tabla_gt <- function(tdfc, numero, titulo, subtitulo) {
  gt(tdfc) %>%
    tab_header(
      title = md(paste0("**Tabla N°", numero, ": ", titulo, "**")),
      subtitle = subtitulo) %>%
    tab_spanner(label = md("**Frecuencia Absoluta**"), columns = c(ni, Ni)) %>%
    tab_spanner(label = md("**Frecuencia Relativa**"), columns = c(fi, hi, Hi)) %>%
    cols_label(ni = md("**ni**"), Ni = md("**Ni**"),
               fi = "Fracción", hi = "Porcentual (%)", Hi = "Acumulada (%)") %>%
    fmt_number(columns = fi, decimals = 4) %>%
    fmt_number(columns = c(hi, Hi), decimals = 2) %>%
    cols_align(align = "center", columns = everything()) %>%
    tab_style(
      style = list(cell_fill(color = colores$titulo), cell_text(color = "white", weight = "bold")),
      locations = cells_title()) %>%
    tab_style(
      style = list(cell_fill(color = colores$cabecera), cell_text(weight = "bold", color = colores$texto)),
      locations = cells_column_labels()) %>%
    tab_style(
      style = list(cell_fill(color = colores$titulo), cell_text(color = "white", weight = "bold")),
      locations = cells_column_spanners()) %>%
    tab_style(
      style = list(cell_fill(color = colores$total), cell_text(weight = "bold", color = colores$texto)),
      locations = cells_body(rows = nrow(tdfc))) %>%
    tab_options(
      table.border.top.color = colores$titulo,
      table.border.bottom.color = colores$titulo,
      column_labels.border.bottom.color = colores$titulo,
      data_row.padding = px(6),
      table.font.size = px(13))
}

# Diagrama de barras (columna = "ni" o "hi")
barras <- function(tdf, columna, titulo, xlab, ylab, ylim = NULL) {
  vertical <- max(nchar(as.character(tdf[[1]]))) > 12 || nrow(tdf) > 5
  margen <- if (vertical) ceiling(max(nchar(as.character(tdf[[1]]))) * 0.45 + 3) else 5
  par(mar = c(margen, 5, 5, 2))
  barplot(tdf[[columna]], main = paste(strwrap(titulo, 72), collapse = "\n"),
          xlab = "", ylab = ylab,
          col = colores$barras, names.arg = tdf[[1]],
          las = if (vertical) 2 else 1, cex.names = 1, cex.axis = 0.8, cex.main = 1,
          ylim = ylim)
  mtext(xlab, side = 1, line = margen - 1.5)
  par(mar = c(5, 4, 4, 2) + 0.1)
}

# Diagrama circular con la leyenda a un lado
circular <- function(tdf, titulo, leyenda) {
  cols <- paleta(nrow(tdf))
  layout(matrix(1:2, nrow = 1), widths = c(3, 2.5))
  par(mar = c(1, 3, 1, 3), oma = c(0, 0, 4, 0))
  pie(tdf$hi, labels = paste0(round(tdf$hi, 2), "%"), col = cols,
      radius = 0.75, cex = 1, init.angle = 90)
  plot.new()
  legend("center", legend = tdf[[1]], fill = cols, cex = 1, title = leyenda, bty = "n")
  mtext(paste(strwrap(titulo, 72), collapse = "\n"), outer = TRUE, line = 0.5, font = 2, cex = 1)
  layout(1)
  par(mar = c(5, 4, 4, 2) + 0.1, oma = c(0, 0, 0, 0))
}

# Tabla de indicadores: en una variable ordinal tienen sentido el rango, la mediana y la moda
indicadores_gt <- function(variable, rango, mediana, moda, subtitulo) {
  tabla <- data.frame(variable, rango, "N/A", mediana, moda, "N/A", "N/A", "N/A", "N/A", "N/A", "N/A",
                      stringsAsFactors = FALSE)
  names(tabla) <- c("Variable", "Rango [Min; Max]", paste0("Media (X", "\u0304", ")"), "Mediana (Me)",
                    "Moda (Mo)", paste0("Varianza (S", "\u00b2", ")"), "Desv. Est. (S)", "C.V. (%)",
                    "Asimetría (As)", "Curtosis (K)", "Valores Atípicos")
  gt(tabla) %>%
    tab_header(
      title = md("**CONCLUSIONES Y ESTADÍSTICOS**"),
      subtitle = subtitulo) %>%
    tab_source_note(source_note = "Autor: *") %>%
    cols_align(align = "center", columns = everything()) %>%
    tab_style(
      style = list(cell_fill(color = colores$titulo), cell_text(color = "white", weight = "bold")),
      locations = cells_title()) %>%
    tab_style(
      style = list(cell_fill(color = colores$cabecera), cell_text(weight = "bold", color = colores$texto)),
      locations = cells_column_labels()) %>%
    tab_options(
      table.border.top.color = colores$titulo,
      table.border.bottom.color = colores$titulo,
      column_labels.border.bottom.color = colores$titulo,
      data_row.padding = px(6))
}

2 Cargar datos

Este bloque revisa la estructura de los datos y crea la variable ordinal Clase_API agrupando Gravedad_API_crudo con cortes de uso común en la industria: Pesado (menos de 22,3 °API), Mediano (de 22,3 a menos de 31,1 °API) y Liviano (31,1 °API o más). El orden es Pesado < Mediano < Liviano. Verifica estos cortes con el criterio que use tu clase.

dim(datos)
## [1] 10000    20
datos %>%
  select(ID_registro, Fecha, Gravedad_API_crudo) %>%
  glimpse()
## Rows: 10,000
## Columns: 3
## $ ID_registro        <chr> "EC-PIPE-00248", "EC-PIPE-02975", "EC-PIPE-07780", …
## $ Fecha              <chr> "2015-01-01", "2015-01-02", "2015-01-02", "2015-01-…
## $ Gravedad_API_crudo <dbl> 20.19, 21.46, 17.31, 28.89, 25.98, 22.02, 22.52, 22…
datos$Clase_API <- cut(datos$Gravedad_API_crudo,
                       breaks = c(-Inf, 22.3, 31.1, Inf),
                       labels = c("Pesado", "Mediano", "Liviano"),
                       right = FALSE, ordered_result = TRUE)
levels(datos$Clase_API)
## [1] "Pesado"  "Mediano" "Liviano"

3 Extraer la variable

En esta sección se extrae la variable Clase_API para su posterior análisis.

ClaseAPI <- datos$Clase_API
TDF_ClaseAPI <- frecuencias_ord(ClaseAPI, "Clase de gravedad API")
head(TDF_ClaseAPI)
##   Clase de gravedad API   ni    Ni     fi    hi     Hi
## 1                Pesado 4589  4589 0.4589 45.89  45.89
## 2               Mediano 5361  9950 0.5361 53.61  99.50
## 3               Liviano   50 10000 0.0050  0.50 100.00

4 Conteo

Se calculan las frecuencias absolutas (ni), absolutas acumuladas (Ni), relativas (fi), porcentuales (hi) y porcentuales acumuladas (Hi), y se agrega la fila de totales.

TDF_ClaseAPI_completa <- con_total(TDF_ClaseAPI)
print(TDF_ClaseAPI_completa)
##   Clase de gravedad API    ni    Ni     fi     hi     Hi
## 1                Pesado  4589  4589 0.4589  45.89  45.89
## 2               Mediano  5361  9950 0.5361  53.61  99.50
## 3               Liviano    50 10000 0.0050   0.50 100.00
## 4                 Total 10000 10000 1.0000 100.00 100.00

5 Tabla de frecuencia

Se presenta la información en una tabla formal mediante el paquete gt.

tabla_gt(TDF_ClaseAPI_completa, 1,
         "DISTRIBUCIÓN DE FRECUENCIAS DE LOS REGISTROS SEGÚN LA CLASE DE GRAVEDAD API",
         "Variable cualitativa ordinal: Pesado < Mediano < Liviano")
Tabla N°1: DISTRIBUCIÓN DE FRECUENCIAS DE LOS REGISTROS SEGÚN LA CLASE DE GRAVEDAD API
Variable cualitativa ordinal: Pesado < Mediano < Liviano
Clase de gravedad API
Frecuencia Absoluta
Frecuencia Relativa
ni Ni Fracción Porcentual (%) Acumulada (%)
Pesado 4589 4589 0.4589 45.89 45.89
Mediano 5361 9950 0.5361 53.61 99.50
Liviano 50 10000 0.0050 0.50 100.00
Total 10000 10000 1.0000 100.00 100.00

6 Gráficas

6.1 Diagrama de barras frecuencia absoluta local

barras(TDF_ClaseAPI, "ni",
       "Gráfica N°1: Distribución de la cantidad de registros según clase de gravedad API",
       "Clase de gravedad API", "Cantidad")

6.2 Diagrama de barras frecuencia absoluta global

barras(TDF_ClaseAPI, "ni",
       "Gráfica N°2: Distribución de la cantidad de registros según clase de gravedad API",
       "Clase de gravedad API", "Cantidad", ylim = c(0, sum(TDF_ClaseAPI$ni)))

6.3 Diagrama de barras frecuencia relativa local

barras(TDF_ClaseAPI, "hi",
       "Gráfica N°3: Distribución en porcentaje según clase de gravedad API",
       "Clase de gravedad API", "Porcentaje")

6.4 Diagrama de barras frecuencia relativa global

barras(TDF_ClaseAPI, "hi",
       "Gráfica N°4: Distribución en porcentaje según clase de gravedad API",
       "Clase de gravedad API", "Porcentaje", ylim = c(0, 100))

6.5 Diagrama circular

circular(TDF_ClaseAPI,
         "Gráfica N°5: Distribución porcentual de los registros según clase de gravedad API",
         "Clase API")

6.6 Diagrama de barras frecuencia absoluta acumulada

Solo tiene sentido en una variable ordinal: muestra cuántos registros hay hasta cada categoría, siguiendo el orden.

barras(TDF_ClaseAPI, "Ni",
       "Gráfica N°6: Frecuencia absoluta acumulada según clase de gravedad API",
       "Clase de gravedad API", "Cantidad acumulada", ylim = c(0, sum(TDF_ClaseAPI$ni)))

6.7 Diagrama de barras frecuencia porcentual acumulada

barras(TDF_ClaseAPI, "Hi",
       "Gráfica N°7: Frecuencia porcentual acumulada según clase de gravedad API",
       "Clase de gravedad API", "Porcentaje acumulado", ylim = c(0, 100))

7 Indicadores Estádistico

En una variable cualitativa ordinal se pueden calcular el rango (categoría mínima y máxima), la mediana (primera categoría cuya frecuencia acumulada llega al 50 %) y la moda. La media, la varianza y los demás indicadores no aplican.

niveles <- TDF_ClaseAPI[[1]]
rango   <- paste0("[", niveles[1], "; ", niveles[length(niveles)], "]")
mediana <- niveles[which(TDF_ClaseAPI$Hi >= 50)[1]]
moda    <- niveles[which.max(TDF_ClaseAPI$ni)]

indicadores_gt("Clase de gravedad API", rango, mediana, moda,
               "Resumen de indicadores de la clase de gravedad API de los registros de operación")
CONCLUSIONES Y ESTADÍSTICOS
Resumen de indicadores de la clase de gravedad API de los registros de operación
Variable Rango [Min; Max] Media (X̄) Mediana (Me) Moda (Mo) Varianza (S²) Desv. Est. (S) C.V. (%) Asimetría (As) Curtosis (K) Valores Atípicos
Clase de gravedad API [Pesado; Liviano] N/A Mediano Mediano N/A N/A N/A N/A N/A N/A
Autor: *

8 Conclusión

El valor más frecuente de Clase de gravedad API es Mediano, con 5361 registros (53.61 %), y la mediana es Mediano. El 45.89 % de los registros corresponde a crudo pesado y solo el 0.5 % a crudo liviano.