Variable Cuantitativa Discreta: Fecha de apagado
Variable Original: Shutdown Date
Brandon
Justificación de la variable
Para entender de forma sencilla por qué la “Fecha de apagado” es una variable cuantitativa discreta, imaginen el calendario como una escalera con escalones fijos, en lugar de un río que fluye sin parar. Es cuantitativa porque podemos medirla numéricamente para hacer cálculos matemáticos, como contar los días exactos en los que un sistema estuvo inactivo. Y es discreta porque, al registrar únicamente la fecha, el registro da saltos enteros: pasamos de un día al siguiente como unidades completas, sin medir las fracciones que existen en el medio. Por lo tanto, al capturar este dato, estamos registrando un punto específico y contable dentro de una secuencia de días enteros.
1 Cargar datos
Todo análisis riguroso comienza con la validación de la materia prima. En esta fase, se estructuran los registros crudos de los apagados para convertirlos en un formato temporal operable (limpieza, parseo de fechas y extracción de componentes temporales) que garantice la integridad técnica del estudio.
database <- read.csv("database-_1_.csv", header = TRUE, sep = ",", dec = ".", check.names = FALSE)
raw_dates<- database$`Shutdown Date/Time`
raw_dates <- raw_dates[raw_dates != ""]
raw_dates <- na.omit(raw_dates)
fechas_obj <- as.POSIXct(raw_dates, format = "%m/%d/%Y")
amperaje <- as.numeric(fechas_obj)
amperaje <- na.omit(amperaje)
fechas_obj <- fechas_obj[!is.na(amperaje)]2 Tabla de Frecuencia
Para comprender la dinámica de los cortes, es imperativo transicionar de datos temporales continuos a intervalos discretos. Esta sección consolida la agrupación cronológica mediante clases, sentando las bases matemáticas para la evaluación de densidades y probabilidades.
k <- 1 + (3.322 * log10(length(amperaje)))
k <- floor(k)
min_val <- min(amperaje)
max_val <- max(amperaje)
R <- max_val - min_val
A <- R / k
Li_num <- seq(from = min_val, to = max_val - A, by = A)
if(length(Li_num) < k) { Li_num <- c(Li_num, Li_num[length(Li_num)] + A) }
if(max(Li_num) + A < max_val) { Li_num <- c(Li_num, tail(Li_num, 1) + A) }
Ls_num <- Li_num + A
MC_num <- (Li_num + Ls_num) / 2
ni <- numeric(length(Li_num))
for (i in 1:length(Li_num)) {
if (i == length(Li_num)) {
ni[i] <- sum(amperaje >= Li_num[i] & amperaje <= (max_val + 100000))
} else {
ni[i] <- sum(amperaje >= Li_num[i] & amperaje < Ls_num[i])
}
}
hi <- ni / sum(ni) * 100
Niasc <- cumsum(ni)
Nidsc <- rev(cumsum(rev(ni)))
Hiasc <- round(cumsum(hi), 2)
Hidsc <- round(rev(cumsum(rev(hi))), 2)
Li_fecha <- format(structure(Li_num, class = c("POSIXct", "POSIXt")), "%m/%d/%Y")
Ls_fecha <- format(structure(Ls_num, class = c("POSIXct", "POSIXt")), "%m/%d/%Y")
MC_fecha <- format(structure(MC_num, class = c("POSIXct", "POSIXt")), "%m/%d/%Y")
TDFAmperaje <- data.frame(Li_fecha, Ls_fecha, MC_fecha, ni, hi, Niasc, Nidsc, Hiasc, Hidsc)
tabla1_sturges <- TDFAmperaje %>%
gt() %>%
tab_header(
title = md("*Tabla 1: Distribución de Frecuencias*"),
subtitle = md("**Variable: Shutdown Date**")
) %>%
cols_label(
Li_fecha = "Desde",
Ls_fecha = "Hasta",
MC_fecha = "Marca Clase",
ni = "Frec. Abs.",
hi = "Frec. Rel. %",
Niasc = "Ni Asc.",
Nidsc = "Ni Desc.",
Hiasc = "Hi Asc. %",
Hidsc = "Hi Desc. %"
) %>%
fmt_number(columns = c(hi, Hiasc, Hidsc), decimals = 2, pattern = "{x}%")
tabla1_sturges| Tabla 1: Distribución de Frecuencias | ||||||||
| Variable: Shutdown Date | ||||||||
| Desde | Hasta | Marca Clase | Frec. Abs. | Frec. Rel. % | Ni Asc. | Ni Desc. | Hi Asc. % | Hi Desc. % |
|---|---|---|---|---|---|---|---|---|
| 01/08/2010 | 08/27/2010 | 05/03/2010 | 105 | 7.55% | 105 | 1390 | 7.55% | 100.00% |
| 08/27/2010 | 04/15/2011 | 12/21/2010 | 95 | 6.83% | 200 | 1285 | 14.39% | 92.45% |
| 04/15/2011 | 12/03/2011 | 08/09/2011 | 99 | 7.12% | 299 | 1190 | 21.51% | 85.61% |
| 12/03/2011 | 07/21/2012 | 03/28/2012 | 104 | 7.48% | 403 | 1091 | 28.99% | 78.49% |
| 07/21/2012 | 03/10/2013 | 11/14/2012 | 141 | 10.14% | 544 | 987 | 39.14% | 71.01% |
| 03/10/2013 | 10/27/2013 | 07/04/2013 | 120 | 8.63% | 664 | 846 | 47.77% | 60.86% |
| 10/27/2013 | 06/16/2014 | 02/20/2014 | 135 | 9.71% | 799 | 726 | 57.48% | 52.23% |
| 06/16/2014 | 02/02/2015 | 10/09/2014 | 139 | 10.00% | 938 | 591 | 67.48% | 42.52% |
| 02/02/2015 | 09/22/2015 | 05/29/2015 | 171 | 12.30% | 1109 | 452 | 79.78% | 32.52% |
| 09/22/2015 | 05/10/2016 | 01/15/2016 | 146 | 10.50% | 1255 | 281 | 90.29% | 20.22% |
| 05/10/2016 | 12/28/2016 | 09/03/2016 | 135 | 9.71% | 1390 | 135 | 100.00% | 9.71% |
3 Histograma de Cantidad Absoluta
La visualización macroscópica permite identificar el volumen total de incidencias. Este apartado despliega la distribución temporal completa, revelando visualmente las tendencias estructurales y la concentración del fenómeno a lo largo de todo el periodo de estudio.
total_apagones <- sum(TDFAmperaje$ni)
p_ni <- ggplot(TDFAmperaje, aes(x = MC_num, y = ni)) +
geom_col(fill = "steelblue", color = "black", alpha = 0.8, width = A, linewidth = 0.5) +
scale_x_continuous(labels = function(x) format(as.POSIXct(x, origin="1970-01-01"), "%d/%m/%Y"),
breaks = MC_num) +
scale_y_continuous(limits = c(0, 1500),
expand = expansion(mult = c(0, 0.05))) +
labs(title = "Gráfica No 1: Distribución de los Apagados Globales",
x = "Fecha",
y = "Cantidad") +
theme_classic() +
theme(
plot.title = element_text(hjust = 0.5, face = "bold", size = 13),
plot.subtitle = element_text(hjust = 0.5, color = "gray40"),
axis.text.x = element_text(angle = 45, hjust = 1, color = "black"),
axis.text.y = element_text(color = "black"),
axis.line = element_line(linewidth = 0.5, color = "black")
)
print(p_ni)
4 Histograma de Cantidad Absoluta
Al aislar ventanas temporales críticas, se incrementa la resolución del análisis. Aquí se evalúa el comportamiento volumétrico en intervalos específicos de alta relevancia operativa (ej. el mes más crítico) para contrastarlo con el histórico general.
p_ni_local_barras <- ggplot(TDFAmperaje, aes(x = MC_num, y = ni)) +
geom_col(fill = "steelblue", color = "black", alpha = 0.8, width = A, linewidth = 0.5) +
scale_x_continuous(labels = function(x) format(as.POSIXct(x, origin="1970-01-01"), "%d/%m/%Y"),
breaks = MC_num) +
scale_y_continuous(expand = expansion(mult = c(0, 0.05))) +
labs(title = "Gráfica No 2: Distribución de apagados locales",
x = "Fecha",
y = "Cantidad") +
theme_classic() +
theme(
plot.title = element_text(hjust = 0.5, face = "bold", size = 13),
axis.text.x = element_text(angle = 45, hjust = 1, color = "black"),
axis.text.y = element_text(color = "black"),
axis.line = element_line(linewidth = 0.5, color = "black")
)
print(p_ni_local_barras)
5 Histograma de Cantidad Relativa
Trascendiendo el conteo absoluto, este enfoque normaliza los datos para expresar el peso proporcional de cada intervalo. Es una herramienta crucial para entender la densidad de probabilidad de ocurrencia de un apagado en el panorama general.
p_hi <- ggplot(TDFAmperaje, aes(x = MC_num, y = hi)) +
geom_col(fill = "steelblue", color = "black", alpha = 0.8, width = A, linewidth = 0.5) +
scale_x_continuous(labels = function(x) format(as.POSIXct(x, origin="1970-01-01"), "%d/%m/%Y"),
breaks = MC_num) +
scale_y_continuous(limits = c(0, 100),
expand = expansion(mult = c(0, 0.05)),
labels = function(x) paste0(x, "%")) +
labs(title = "Gráfica 3: Porcentaje de apagado global",
x = "Fecha",
y = "Porcentaje") +
theme_classic() +
theme(
plot.title = element_text(hjust = 0.5, face = "bold", size = 13),
axis.text.x = element_text(angle = 45, hjust = 1, color = "black"),
axis.text.y = element_text(color = "black"),
axis.line = element_line(linewidth = 0.5, color = "black")
)
print(p_hi)
6 Histograma de Cantidad Relativa
Mediante el escalado probabilístico en segmentos temporales acotados, este análisis permite verificar si las dinámicas locales de los apagados obedecen al mismo modelo de probabilidad que rige la tendencia histórica.
p_hi_barras <- ggplot(TDFAmperaje, aes(x = MC_num, y = hi)) +
geom_col(fill = "steelblue", color = "black", alpha = 0.8, width = A, linewidth = 0.5) +
scale_x_continuous(labels = function(x) format(as.POSIXct(x, origin="1970-01-01"), "%d/%m/%Y"),
breaks = MC_num) +
scale_y_continuous(labels = function(x) paste0(x, "%"),
expand = expansion(mult = c(0, 0.05))) +
labs(title = "Gráfica 4: Distribución Porcentual de apagados",
x = "Fecha",
y = "Porcentaje") +
theme_classic() +
theme(
plot.title = element_text(hjust = 0.5, face = "bold", size = 13),
axis.text.x = element_text(angle = 45, hjust = 1, color = "black"),
axis.text.y = element_text(color = "black"),
axis.line = element_line(linewidth = 0.5, color = "black")
)
print(p_hi_barras)
7 Ojivas Combinadas de la Cantidad Absoluta Acumulada
El estudio de la progresión acumulativa es vital para establecer umbrales temporales. Esta gráfica ilustra la suma secuencial de los eventos, evidenciando la velocidad y el ritmo con el que se acumulan los apagados en el tiempo.
library(scales)
p_ojiva_replicada <- ggplot() +
geom_line(data = TDFAmperaje, aes(x = Ls_num, y = Niasc, color = "Ascendente", linetype = "Ascendente"), linewidth = 0.8) +
geom_point(data = TDFAmperaje, aes(x = Ls_num, y = Niasc, color = "Ascendente"), size = 2) +
geom_line(data = TDFAmperaje, aes(x = Li_num, y = Nidsc, color = "Descendente", linetype = "Descendente"), linewidth = 0.8) +
geom_point(data = TDFAmperaje, aes(x = Li_num, y = Nidsc, color = "Descendente"), size = 2) +
scale_x_continuous(labels = function(x) format(as.POSIXct(x, origin="1970-01-01"), "%Y"),
breaks = pretty_breaks(n = 5)) +
scale_color_manual(name = NULL,
values = c("Ascendente" = "black", "Descendente" = "blue")) +
scale_linetype_manual(name = NULL,
values = c("Ascendente" = "longdash", "Descendente" = "solid")) +
labs(title = "Gráfica 5: Identificación gráfica de percentiles de apagados",
x = "Fecha",
y = "Cantidad") +
theme_bw() +
theme(
plot.title = element_text(hjust = 0.5, face = "bold", size = 14),
legend.position = c(0.85, 0.85),
legend.background = element_rect(color = "black", fill = "white", linewidth = 0.5),
legend.key = element_blank(),
panel.grid.minor = element_blank(),
axis.text = element_text(color = "black"),
axis.title.y = element_text(angle = 90, vjust = 0.5)
)
print(p_ojiva_replicada)
8 Ojivas Combinadas de la Cantidad Relativa Acumulada
Esta métrica representa la función de distribución empírica del sistema. Permite leer de forma directa y probabilística en qué momento exacto del tiempo se ha superado un porcentaje crítico de las incidencias.
p_ojiva_Hi <- ggplot() +
geom_line(data = TDFAmperaje, aes(x = Ls_num, y = Hiasc, color = "Ascendente"), linewidth = 0.8) +
geom_point(data = TDFAmperaje, aes(x = Ls_num, y = Hiasc, color = "Ascendente"), size = 2) +
geom_line(data = TDFAmperaje, aes(x = Li_num, y = Hidsc, color = "Descendente"), linewidth = 0.8) +
geom_point(data = TDFAmperaje, aes(x = Li_num, y = Hidsc, color = "Descendente"), size = 2) +
scale_x_continuous(labels = function(x) format(as.POSIXct(x, origin="1970-01-01"), "%d/%m/%Y")) +
scale_y_continuous(limits = c(0, 100),
labels = function(x) paste0(x, "%"),
expand = expansion(mult = c(0, 0.05))) +
scale_color_manual(name = "Tipo de Ojiva",
values = c("Ascendente" = "skyblue", "Descendente" = "salmon")) +
labs(title = "Gráfica 6: Curva de probabilidad acumulada del tiempo de apagado",
x = "Fecha",
y = "Porcentaje") +
theme_classic() +
theme(
plot.title = element_text(hjust = 0.5, face = "bold", size = 13),
axis.text.x = element_text(angle = 45, hjust = 1, color = "black"),
axis.text.y = element_text(color = "black"),
axis.line = element_line(linewidth = 0.5, color = "black"),
legend.position = "bottom" # Leyenda abajo para no tapar las líneas
)
print(p_ojiva_Hi)
9 Diagrama de caja
Más allá de las frecuencias, es fundamental evaluar la variabilidad posicional de los eventos. El diagrama de caja desentraña la estacionalidad, identificando la concentración de la “hora de apagado” y su dispersión según días o meses.
boxplot(fechas_obj,
horizontal = TRUE,
col = "skyblue",
main = "Gráfica 7: Distribución de la Hora de apagado",
xlab = "Tiempo",
xaxt = "n")
axis.POSIXct(1, x = fechas_obj, format = "%Y", las = 1)
grid(nx = NULL, ny = NA, col = "lightgray", lty = "dotted")
10 Tabla Estadístico
La cuantificación objetiva requiere robustez matemática. En este apartado se calculan los parámetros exactos de centralización, dispersión y forma para caracterizar analíticamente el perfil temporal de las interrupciones.
library(e1071) # Necesario para skewness (As) y kurtosis
# Convertimos a numérico para cálculos complejos (SD, As, K)
fechas_num <- as.numeric(fechas_obj)
# 1. Rango (Mínimo y Máximo)
ri <- min(fechas_obj)
rs <- max(fechas_obj)
print(ri)## [1] "2010-01-08 -05"print(rs)## [1] "2016-12-28 -05"# 2. Mediana
mediana <- as.Date(median(fechas_obj))
print(mediana)## [1] "2013-12-25"# 3. Media Aritmética
media_aritmetica <- as.Date(mean(fechas_obj))
print(media_aritmetica)## [1] "2013-10-19"# 4. Moda
t <- table(fechas_obj)
Mo <- as.POSIXct(names(t)[which.max(t)], format="%Y-%m-%d")
print(Mo)## [1] "2015-07-20 -05"# 5. Desviación Estándar
desviacion_estandar_seg <- sd(fechas_num)
desviacion_estandar_dias <- desviacion_estandar_seg / 86400
print(paste(round(desviacion_estandar_dias, 0), "días"))## [1] "717 días"# 6. Coeficiente de Variabilidad
coeficiente_variabilidad <- (desviacion_estandar_seg / mean(fechas_num)) * 100
print(coeficiente_variabilidad)## [1] 4.48288# 7. Asimetría (Skewness)
As <- skewness(fechas_num)
print(As)## [1] -0.2110534# 8. Curtosis
curtosis_val <- kurtosis(fechas_num)
print(curtosis_val)## [1] -1.107667library(knitr)
# Preparamos los textos para la tabla (convertimos todo a caracter legible)
Variable <- "Shutdown Date"
S_texto <- paste(round(desviacion_estandar_dias, 0), "días") # Desviación en días
Tabla_indicadores <- data.frame(
Variable,
format(ri, "%Y-%m-%d"), # Mínimo
format(rs, "%Y-%m-%d"), # Máximo
format(media_aritmetica, "%Y-%m-%d"), # Media
format(mediana, "%Y-%m-%d"), # Mediana
format(Mo, "%Y-%m-%d"), # Moda
S_texto, # Desviación
round(coeficiente_variabilidad, 2),
round(As, 2),
round(curtosis_val, 2)
)
colnames(Tabla_indicadores) <- c("Variable","Mínimo","Máximo","x","Me","Mo","S","Cv (%)","As","K")
# Imprimir Tabla
kable(Tabla_indicadores, format = "markdown", caption = "Tabla No. 1: Indicadores estadísticos de la variable Shutdown Date.")| Variable | Mínimo | Máximo | x | Me | Mo | S | Cv (%) | As | K |
|---|---|---|---|---|---|---|---|---|---|
| Shutdown Date | 2010-01-08 | 2016-12-28 | 2013-10-19 | 2013-12-25 | 2015-07-20 | 717 días | 4.48 | -0.21 | -1.11 |
11 Valores atipicos
En el análisis de incidencias, las anomalías suelen esconder la información operativa más relevante. Esta fase aplica criterios estadísticos estrictos (Rango Intercuartílico) para discriminar eventos atípicos y aislarlos para su evaluación.
# Usamos boxplot.stats sobre los datos numéricos
stats_outliers <- boxplot.stats(fechas_num)$out
# Contar los valores atípicos
num_outliers <- length(stats_outliers)
print(num_outliers)## [1] 0# Obtener Mínimo y Máximo Outlier (si existen)
# Usamos 'if' para evitar errores si num_outliers es 0
minimooutliers <- if(num_outliers > 0) min(stats_outliers) else NA
maximooutliers <- if(num_outliers > 0) max(stats_outliers) else NA
# Convertimos de vuelta a fecha para verlos (si existen)
minimooutliers_fecha <- if(!is.na(minimooutliers)) as.POSIXct(minimooutliers) else "Ninguno"
maximooutliers_fecha <- if(!is.na(maximooutliers)) as.POSIXct(maximooutliers) else "Ninguno"
print(minimooutliers_fecha)## [1] "Ninguno"print(maximooutliers_fecha)## [1] "Ninguno"12 conclusiones
El análisis temporal (2010-2016) revela una distribución platicúrtica (curtosis = 1.89) con asimetría negativa leve (-0.21), evidenciando una ocurrencia sostenida de los eventos con una ligera concentración hacia los años más recientes. La alta dispersión (\(\sigma \approx 717\) días) respecto a la media central (Oct-2013) y la ausencia estadística de valores atípicos demuestran que los apagados no responden a fallos anómalos puntuales, sino que representan una constante estructural continua en el sistema durante el sexenio evaluado.