Variable Cuantitativa Continua: Fecha y hora de apagado
Variable Original: Shutdown Date/Time
Brandon
Justificación de la variable
Para entender de forma sencilla por qué la “Fecha y hora de apagado” es una variable cuantitativa continua, imaginen el tiempo como un río que fluye sin parar, en lugar de una escalera con escalones fijos. Es cuantitativa porque podemos medirla numéricamente para hacer cálculos matemáticos, como saber exactamente cuánto tiempo estuvo apagado un sistema. Y es continua porque el tiempo no da saltos enteros: entre un minuto y el siguiente existen infinitas fracciones de segundo. Por lo tanto, al registrar este dato, estamos capturando un punto temporal exacto dentro de una línea continua que siempre se puede seguir dividiendo.
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 %H:%M")
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 %H:%M")
Ls_fecha <- format(structure(Ls_num, class = c("POSIXct", "POSIXt")), "%m/%d/%Y %H:%M")
MC_fecha <- format(structure(MC_num, class = c("POSIXct", "POSIXt")), "%m/%d/%Y %H:%M")
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/Time**")
) %>%
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/Time | ||||||||
| Desde | Hasta | Marca Clase | Frec. Abs. | Frec. Rel. % | Ni Asc. | Ni Desc. | Hi Asc. % | Hi Desc. % |
|---|---|---|---|---|---|---|---|---|
| 01/08/2010 23:41 | 08/28/2010 09:55 | 05/04/2010 16:48 | 105 | 7.55% | 105 | 1390 | 7.55% | 100.00% |
| 08/28/2010 09:55 | 04/16/2011 20:09 | 12/22/2010 03:02 | 95 | 6.83% | 200 | 1285 | 14.39% | 92.45% |
| 04/16/2011 20:09 | 12/04/2011 06:24 | 08/10/2011 13:17 | 99 | 7.12% | 299 | 1190 | 21.51% | 85.61% |
| 12/04/2011 06:24 | 07/22/2012 16:38 | 03/28/2012 23:31 | 104 | 7.48% | 403 | 1091 | 28.99% | 78.49% |
| 07/22/2012 16:38 | 03/11/2013 02:53 | 11/15/2012 09:46 | 141 | 10.14% | 544 | 987 | 39.14% | 71.01% |
| 03/11/2013 02:53 | 10/28/2013 13:07 | 07/04/2013 20:00 | 121 | 8.71% | 665 | 846 | 47.84% | 60.86% |
| 10/28/2013 13:07 | 06/16/2014 23:22 | 02/21/2014 06:14 | 134 | 9.64% | 799 | 725 | 57.48% | 52.16% |
| 06/16/2014 23:22 | 02/03/2015 09:36 | 10/10/2014 16:29 | 140 | 10.07% | 939 | 591 | 67.55% | 42.52% |
| 02/03/2015 09:36 | 09/22/2015 19:51 | 05/30/2015 02:43 | 170 | 12.23% | 1109 | 451 | 79.78% | 32.45% |
| 09/22/2015 19:51 | 05/11/2016 06:05 | 01/16/2016 12:58 | 146 | 10.50% | 1255 | 281 | 90.29% | 20.22% |
| 05/11/2016 06:05 | 12/28/2016 16:20 | 09/03/2016 23:12 | 135 | 9.71% | 1390 | 135 | 100.00% | 9.71% |
3 Histograma Global 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, total_apagones),
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 Local 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 Global 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 Ocurrencia 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 Local 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 sub-períodos",
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 23:41:00 -05"print(rs)## [1] "2016-12-28 16:20:00 -05"# 2. Mediana
mediana <- median(fechas_obj)
print(mediana)## [1] "2013-12-25 21:00:00 -05"# 3. Media Aritmética
media_aritmetica <- mean(fechas_obj)
print(media_aritmetica)## [1] "2013-10-19 17:21:44 -05"# 4. Moda (Calculada como el valor más frecuente)
# Nota: En fechas exactas es difícil que se repitan, pero buscamos la mayor coincidencia.
t <- table(fechas_obj)
Mo <- as.POSIXct(names(t)[which.max(t)], format="%Y-%m-%d %H:%M")
print(Mo)## [1] "2011-09-20 06:50:00 -05"# 5. Desviación Estándar (En días para que sea legible)
# sd() devuelve segundos, dividimos por 86400 para tener días
desviacion_estandar_seg <- sd(fechas_num)
desviacion_estandar_dias <- desviacion_estandar_seg / 86400
print(paste(round(desviacion_estandar_dias, 2), "días"))## [1] "717.14 días"# 6. Coeficiente de Variabilidad
# Se calcula sobre los numéricos. (Cuidado: en fechas timestamps es solo referencial)
coeficiente_variabilidad <- (desviacion_estandar_seg / mean(fechas_num)) * 100
print(coeficiente_variabilidad)## [1] 4.482686# 7. Asimetría (Skewness)
As <- skewness(fechas_num)
print(As)## [1] -0.2110236# 8. Curtosis
curtosis_val <- kurtosis(fechas_num)
print(curtosis_val)## [1] -1.107727library(knitr)
# Preparamos los textos para la tabla (convertimos todo a caracter legible)
Variable <- "Shutdown Date/Time"
S_texto <- paste(round(desviacion_estandar_dias, 2), "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/Time.")| Variable | Mínimo | Máximo | x | Me | Mo | S | Cv (%) | As | K |
|---|---|---|---|---|---|---|---|---|---|
| Shutdown Date/Time | 2010-01-08 | 2016-12-28 | 2013-10-19 | 2013-12-25 | 2011-09-20 | 717.14 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.