# Calcular cambios diarios en precios
precios_con_lag <- precios_diarios[order(ticker, fecha)][,
`:=`(
precio_anterior = shift(precio_cierre, 1), # t-1
precio_siguiente = shift(precio_cierre, -1), # t+1
precio_3_dias_antes = shift(precio_cierre, 3), # t-3
volumen_anterior = shift(volumen, 1)
), by = ticker]
# Calcular métricas de cambio
precios_con_lag[, `:=`(
cambio_diario = precio_cierre - precio_anterior,
cambio_pct = round((precio_cierre - precio_anterior) / precio_anterior * 100, 2),
volatilidad_3d = round(abs(precio_cierre - precio_3_dias_antes) / precio_3_dias_antes * 100, 2),
cambio_volumen = volumen - volumen_anterior
)]
print("Análisis de cambios diarios:")
#> [1] "Análisis de cambios diarios:"
print(head(precios_con_lag[!is.na(precio_anterior),
.(ticker, fecha, precio_cierre, cambio_diario, cambio_pct, volatilidad_3d)], 10))
#> ticker fecha precio_cierre cambio_diario cambio_pct volatilidad_3d
#> <char> <Date> <num> <num> <num> <num>
#> 1: AAPL 2024-01-02 183.4407 2.3071617 1.27 NA
#> 2: AAPL 2024-01-03 181.4614 -1.9792962 -1.08 NA
#> 3: AAPL 2024-01-04 182.1432 0.6817462 0.38 0.56
#> 4: AAPL 2024-01-05 184.6943 2.5510975 1.40 0.68
#> 5: AAPL 2024-01-06 187.7013 3.0069915 1.63 3.44
#> 6: AAPL 2024-01-07 190.0722 2.3709305 1.26 4.35
#> 7: AAPL 2024-01-08 188.8158 -1.2563592 -0.66 2.23
#> 8: AAPL 2024-01-09 188.3688 -0.4470651 -0.24 0.36
#> 9: AAPL 2024-01-10 185.8614 -2.5073326 -1.33 2.22
#> 10: AAPL 2024-01-11 180.8085 -5.0529325 -2.72 4.247 Funciones Especiales y Análisis Temporal
7.1 Funciones de Ventana (Window Functions)
Las funciones de ventana permiten realizar cálculos sobre un conjunto de filas relacionadas con la fila actual, sin colapsar el resultado como lo harían las funciones de agregación.
7.1.1 1. shift(): Valores Anteriores y Posteriores
7.1.2 2. frollmean() y Medias Móviles
# Múltiples medias móviles para análisis técnico
precios_ma <- precios_diarios[order(ticker, fecha)][,
`:=`(
ma_5 = frollmean(precio_cierre, 5), # Media móvil 5 días
ma_20 = frollmean(precio_cierre, 20), # Media móvil 20 días
ma_50 = frollmean(precio_cierre, 50), # Media móvil 50 días
volume_ma_10 = frollmean(volumen, 10), # Media móvil volumen 10 días
volatilidad_20 = frollapply(precio_cierre, 20, sd, na.rm = TRUE) # Volatilidad 20 días
), by = ticker]
# Señales técnicas basadas en cruces de medias móviles
precios_ma[!is.na(ma_50), `:=`(
señal_alcista = ma_5 > ma_20 & ma_20 > ma_50,
señal_bajista = ma_5 < ma_20 & ma_20 < ma_50,
precio_sobre_ma20 = precio_cierre > ma_20,
volumen_alto = volumen > volume_ma_10 * 1.5
)]
# Resumen de señales por ticker
señales_resumen <- precios_ma[!is.na(señal_alcista), .(
dias_analizados = .N,
señales_alcistas = sum(señal_alcista, na.rm = TRUE),
señales_bajistas = sum(señal_bajista, na.rm = TRUE),
dias_sobre_ma20 = sum(precio_sobre_ma20, na.rm = TRUE),
volatilidad_promedio = round(mean(volatilidad_20, na.rm = TRUE), 2)
), by = ticker]
print("Resumen de señales técnicas:")
#> [1] "Resumen de señales técnicas:"
print(señales_resumen)
#> ticker dias_analizados señales_alcistas señales_bajistas dias_sobre_ma20
#> <char> <int> <int> <int> <int>
#> 1: AAPL 133 80 19 93
#> 2: GOOGL 133 63 19 81
#> 3: MSFT 133 85 17 84
#> 4: NVDA 133 34 41 77
#> volatilidad_promedio
#> <num>
#> 1: 3.67
#> 2: 15.24
#> 3: 5.17
#> 4: 21.087.1.3 3. frollapply(): Funciones Personalizadas
# Funciones personalizadas para análisis de ventana
precios_estadisticas <- precios_diarios[order(ticker, fecha)][,
`:=`(
rango_10d = frollapply(precio_cierre, 10, function(x) max(x) - min(x)),
percentil_75_20d = frollapply(precio_cierre, 20, function(x) quantile(x, 0.75, na.rm = TRUE)),
coef_variacion_15d = frollapply(precio_cierre, 15, function(x) sd(x, na.rm = TRUE) / mean(x, na.rm = TRUE)),
precio_z_score_30d = frollapply(precio_cierre, 30, function(x) {
if(length(x) < 30) return(NA)
(tail(x, 1) - mean(x)) / sd(x)
}),
tendencia_5d = frollapply(precio_cierre, 5, function(x) {
if(length(x) < 5) return(NA)
lm_result <- lm(x ~ seq_along(x))
coef(lm_result)[2] # Pendiente
})
), by = ticker]
# Análisis de distribuciones y outliers
analisis_outliers <- precios_estadisticas[!is.na(precio_z_score_30d), .(
ticker,
fecha,
precio_cierre,
z_score = round(precio_z_score_30d, 2),
coef_var = round(coef_variacion_15d, 3),
tendencia = round(tendencia_5d, 4),
outlier_extremo = abs(precio_z_score_30d) > 2
)][outlier_extremo == TRUE][order(-abs(z_score))]
print("Precios con comportamiento outlier (|z-score| > 2):")
#> [1] "Precios con comportamiento outlier (|z-score| > 2):"
print(head(analisis_outliers, 10))
#> ticker fecha precio_cierre z_score coef_var tendencia outlier_extremo
#> <char> <Date> <num> <num> <num> <num> <lgcl>
#> 1: MSFT 2024-05-20 457.1759 3.62 0.007 1.9420 TRUE
#> 2: MSFT 2024-06-08 431.7858 -3.00 0.015 -2.5880 TRUE
#> 3: MSFT 2024-03-08 433.9277 2.92 0.019 5.5208 TRUE
#> 4: MSFT 2024-03-07 428.3405 2.76 0.014 2.8564 TRUE
#> 5: MSFT 2024-06-09 430.4144 -2.72 0.017 -3.3287 TRUE
#> 6: AAPL 2024-05-29 196.4133 2.65 0.027 2.5945 TRUE
#> 7: MSFT 2024-04-14 445.9479 2.64 0.015 2.6979 TRUE
#> 8: GOOGL 2024-02-19 2892.6715 2.61 0.005 6.6683 TRUE
#> 9: AAPL 2024-06-26 214.5298 2.58 0.023 1.7983 TRUE
#> 10: NVDA 2024-05-13 546.1066 -2.57 0.024 -1.1179 TRUE7.2 Funciones Condicionales Optimizadas
7.2.1 1. fifelse(): Condicionales Rápidas
# Comparación de rendimiento: fifelse vs ifelse
clientes_clasificacion <- copy(clientes_retencion)
# fifelse para clasificaciones múltiples y anidadas
clientes_clasificacion[, `:=`(
segmento_edad = fifelse(
edad < 25, "Joven",
fifelse(edad < 45, "Adulto", "Senior")
),
categoria_ingresos = fifelse(
ingresos_mensuales < 2000, "Bajos",
fifelse(ingresos_mensuales < 5000, "Medios", "Altos")
),
tipo_cliente = fifelse(
plan == "Empresarial", "Corporativo",
fifelse(activo & ingresos_mensuales > 3000, "Premium_Activo", "Estándar")
)
)]
# Análisis de segmentos
segmentos_analisis <- clientes_clasificacion[, .(
clientes = .N,
ingresos_promedio = round(mean(ingresos_mensuales), 0),
tasa_actividad = round(mean(activo) * 100, 1),
planes_premium = sum(plan %in% c("Premium", "Empresarial"))
), by = .(segmento_edad, categoria_ingresos, tipo_cliente)]
print("Análisis de segmentos de clientes:")
#> [1] "Análisis de segmentos de clientes:"
print(segmentos_analisis[order(-clientes)])
#> segmento_edad categoria_ingresos tipo_cliente clientes ingresos_promedio
#> <char> <char> <char> <int> <num>
#> 1: Senior Altos Premium_Activo 191 13130
#> 2: Adulto Altos Premium_Activo 116 12750
#> 3: Senior Bajos Estándar 96 1301
#> 4: Senior Medios Premium_Activo 74 3916
#> 5: Senior Medios Estándar 72 2973
#> ---
#> 20: Joven Altos Estándar 9 12540
#> 21: Joven Altos Corporativo 6 11067
#> 22: Joven Medios Corporativo 4 3249
#> 23: Adulto Bajos Corporativo 4 1292
#> 24: Joven Bajos Corporativo 1 1952
#> tasa_actividad planes_premium
#> <num> <int>
#> 1: 100.0 71
#> 2: 100.0 41
#> 3: 68.8 26
#> 4: 100.0 22
#> 5: 50.0 28
#> ---
#> 20: 0.0 0
#> 21: 33.3 6
#> 22: 100.0 4
#> 23: 75.0 4
#> 24: 0.0 17.2.2 2. fcase(): Múltiples Condiciones Elegantes
# Sistema de scoring complejo con fcase
clientes_clasificacion[, score_retencion := fcase(
# Casos de alto valor
plan == "Empresarial" & activo & ingresos_mensuales > 5000, 95,
plan == "Premium" & activo & ingresos_mensuales > 3000, 85,
plan == "Básico" & activo & ingresos_mensuales > 4000, 80,
# Casos de riesgo medio
!activo & ingresos_mensuales > 3000 & !is.na(fecha_ultima_actividad), 60,
activo & ingresos_mensuales < 2000, 55,
# Casos de alto riesgo
!activo & is.na(fecha_ultima_actividad), 20,
!activo & ingresos_mensuales < 2000, 15,
# Caso por defecto
default = 50
)]
# Estrategia de retención basada en score
clientes_clasificacion[, estrategia_retencion := fcase(
score_retencion >= 90, "Mantener_Premium",
score_retencion >= 70, "Fidelizar_Activo",
score_retencion >= 50, "Reactivar_Moderado",
score_retencion >= 30, "Reactivar_Intensivo",
default = "Evaluar_Cancelación"
)]
# Resumen estratégico
resumen_estrategia <- clientes_clasificacion[, .(
clientes = .N,
score_promedio = round(mean(score_retencion), 1),
ingresos_totales = sum(ingresos_mensuales),
valor_cliente_promedio = round(mean(ingresos_mensuales), 0)
), by = estrategia_retencion][order(-score_promedio)]
print("Estrategias de retención por score:")
#> [1] "Estrategias de retención por score:"
print(resumen_estrategia)
#> estrategia_retencion clientes score_promedio ingresos_totales
#> <char> <int> <num> <num>
#> 1: Mantener_Premium 21 95.0 243714
#> 2: Fidelizar_Activo 430 82.0 5089950
#> 3: Reactivar_Moderado 306 52.4 667565
#> 4: Evaluar_Cancelación 243 20.0 1853637
#> valor_cliente_promedio
#> <num>
#> 1: 11605
#> 2: 11837
#> 3: 2182
#> 4: 76287.2.3 3. between(): Rangos Eficientes
# Usar between para clasificaciones por rangos
transacciones_analisis <- copy(transacciones_comportamiento)
transacciones_analisis[, `:=`(
# Clasificación por monto usando between
categoria_monto = fcase(
between(monto, 0, 20), "Micro",
between(monto, 20.01, 100), "Pequeña",
between(monto, 100.01, 500), "Mediana",
between(monto, 500.01, 2000), "Grande",
monto > 2000, "Muy Grande",
default = "Sin Clasificar"
),
# Clasificación temporal
hora = hour(fecha_transaccion),
franja_horaria = fcase(
between(hour(fecha_transaccion), 6, 11), "Mañana",
between(hour(fecha_transaccion), 12, 17), "Tarde",
between(hour(fecha_transaccion), 18, 22), "Noche",
default = "Madrugada"
),
# Día de la semana
dia_semana = wday(fecha_transaccion, label = TRUE),
es_fin_semana = wday(fecha_transaccion) %in% c(1, 7)
)]
# Análisis de patrones de comportamiento
patrones_comportamiento <- transacciones_analisis[, .(
transacciones = .N,
monto_promedio = round(mean(monto), 2),
monto_mediana = round(median(monto), 2),
monto_total = round(sum(monto), 2)
), by = .(categoria_monto, franja_horaria, es_fin_semana)][
order(-transacciones)
]
print("Patrones de comportamiento transaccional:")
#> [1] "Patrones de comportamiento transaccional:"
print(head(patrones_comportamiento, 12))
#> categoria_monto franja_horaria es_fin_semana transacciones monto_promedio
#> <char> <char> <lgcl> <int> <num>
#> 1: Pequeña Madrugada FALSE 515 50.42
#> 2: Pequeña Tarde FALSE 442 48.74
#> 3: Pequeña Mañana FALSE 427 52.53
#> 4: Pequeña Noche FALSE 367 48.10
#> 5: Mediana Madrugada FALSE 279 207.18
#> ---
#> 8: Pequeña Madrugada TRUE 224 53.70
#> 9: Mediana Mañana FALSE 222 208.06
#> 10: Mediana Noche FALSE 183 210.25
#> 11: Micro Tarde FALSE 183 11.37
#> 12: Pequeña Mañana TRUE 180 49.12
#> monto_mediana monto_total
#> <num> <num>
#> 1: 46.20 25968.11
#> 2: 44.75 21544.51
#> 3: 47.37 22428.37
#> 4: 45.04 17653.32
#> 5: 167.63 57803.63
#> ---
#> 8: 47.53 12027.96
#> 9: 175.48 46189.11
#> 10: 167.34 38476.05
#> 11: 12.23 2080.01
#> 12: 44.92 8841.157.3 Funciones de Agregación Especiales
7.3.1 1. frank(): Rankings y Percentiles
# Rankings complejos con frank()
rankings_clientes <- clientes_clasificacion[, `:=`(
# Ranking por ingresos (descendente)
rank_ingresos = frank(-ingresos_mensuales),
rank_ingresos_pct = frank(-ingresos_mensuales / .N * 100),
# Ranking por score de retención
rank_retencion = frank(-score_retencion),
# Ranking dentro de cada plan
rank_en_plan = frank(.SD[,-ingresos_mensuales, by = plan]),
rank_en_pais = frank(.SD[,-ingresos_mensuales, by = pais])
)]
# Top performers por categoría
top_performers <- rankings_clientes[rank_ingresos <= 50, .(
cliente_id, plan, pais, ingresos_mensuales, score_retencion,
rank_global = rank_ingresos,
rank_en_plan, rank_en_pais,
percentil_ingresos = round(100 - rank_ingresos_pct, 1)
)][order(rank_global)]
print("Top 10 clientes por ingresos:")
#> [1] "Top 10 clientes por ingresos:"
print(head(top_performers, 10))
#> cliente_id plan pais ingresos_mensuales score_retencion rank_global
#> <int> <char> <char> <num> <num> <num>
#> 1: 780 Básico España 114272 80 1
#> 2: 579 Básico México 112313 20 2
#> 3: 862 Básico Argentina 93104 80 3
#> 4: 537 Premium España 74834 20 4
#> 5: 204 Premium Argentina 66981 85 5
#> 6: 559 Premium Argentina 64783 85 6
#> 7: 370 Básico Chile 63261 80 7
#> 8: 447 Premium España 58316 85 8
#> 9: 220 Básico Colombia 47912 80 9
#> 10: 522 Básico México 44810 80 10
#> rank_en_plan rank_en_pais percentil_ingresos
#> <num> <num> <num>
#> 1: 270 797 99
#> 2: 408 448 98
#> 3: 430 401 97
#> 4: 575 597 96
#> 5: 833 159 95
#> 6: 223 588 94
#> 7: 500 198 93
#> 8: 229 612 92
#> 9: 979 80 91
#> 10: 16 485 907.3.2 2. rleid(): Identificación de Runs
# Identificar secuencias de comportamiento con rleid()
sensores_runs <- sensores_temperatura[order(sensor_id, timestamp)][, `:=`(
# Clasificar temperatura en rangos
temp_categoria = fcase(
temperatura < 18, "Baja",
between(temperatura, 18, 22), "Normal",
between(temperatura, 22, 26), "Alta",
temperatura > 26, "Muy Alta",
default = "Sin Datos"
)
)][, `:=`(
# Identificar runs (secuencias consecutivas)
run_id = rleid(temp_categoria),
# También podemos identificar runs de tendencia
tendencia = fcase(
temperatura > shift(temperatura, 1), "Subida",
temperatura < shift(temperatura, 1), "Bajada",
default = "Estable"
)
), by = sensor_id][, `:=`(
run_tendencia = rleid(tendencia)
), by = sensor_id]
# Análisis de runs de temperatura
analisis_runs <- sensores_runs[!is.na(temperatura), .(
duracion_run = .N,
temp_promedio = round(mean(temperatura, na.rm = TRUE), 1),
temp_min = round(min(temperatura, na.rm = TRUE), 1),
temp_max = round(max(temperatura, na.rm = TRUE), 1),
inicio_run = min(timestamp),
fin_run = max(timestamp)
), by = .(sensor_id, temp_categoria, run_id)][
duracion_run >= 4 # Solo runs de al menos 4 mediciones (1 hora)
][order(sensor_id, -duracion_run)]
print("Runs de temperatura más largos:")
#> [1] "Runs de temperatura más largos:"
print(head(analisis_runs, 12))
#> sensor_id temp_categoria run_id duracion_run temp_promedio temp_min
#> <char> <char> <int> <int> <num> <num>
#> 1: TEMP_A Baja 23 38 16.0 13.6
#> 2: TEMP_A Baja 112 33 15.9 13.8
#> 3: TEMP_A Baja 130 33 15.7 12.4
#> 4: TEMP_A Baja 38 30 15.9 13.3
#> 5: TEMP_A Baja 78 30 15.9 13.9
#> ---
#> 8: TEMP_A Alta 30 23 24.0 22.0
#> 9: TEMP_A Alta 44 21 24.3 22.4
#> 10: TEMP_A Baja 96 21 15.5 13.2
#> 11: TEMP_A Alta 126 19 24.2 22.1
#> 12: TEMP_A Alta 92 16 24.0 22.4
#> temp_max inicio_run fin_run
#> <num> <POSc> <POSc>
#> 1: 18.0 2024-06-01 13:30:00 2024-06-01 22:45:00
#> 2: 17.9 2024-06-06 13:30:00 2024-06-06 21:30:00
#> 3: 17.7 2024-06-07 13:30:00 2024-06-07 21:30:00
#> 4: 17.8 2024-06-02 14:15:00 2024-06-02 21:30:00
#> 5: 17.5 2024-06-04 14:30:00 2024-06-04 21:45:00
#> ---
#> 8: 26.0 2024-06-02 05:00:00 2024-06-02 10:30:00
#> 9: 25.9 2024-06-03 01:45:00 2024-06-03 06:45:00
#> 10: 17.9 2024-06-05 13:45:00 2024-06-05 18:45:00
#> 11: 26.0 2024-06-07 05:45:00 2024-06-07 10:15:00
#> 12: 25.5 2024-06-05 06:00:00 2024-06-05 09:45:007.3.3 3. uniqueN(): Conteos de Únicos Eficientes
# Análisis de diversidad con uniqueN()
diversidad_transacciones <- transacciones_analisis[, .(
# Diversidad básica
transacciones_totales = .N,
categorias_usadas = uniqueN(categoria),
comercios_visitados = uniqueN(comercio_id),
metodos_pago_usados = uniqueN(metodo_pago),
# Métricas de comportamiento
dias_activos = uniqueN(as.Date(fecha_transaccion)),
horas_activas = uniqueN(hour(fecha_transaccion)),
monto_promedio = round(mean(monto), 2),
# Diversidad temporal
meses_activos = uniqueN(month(fecha_transaccion)),
dias_semana_activos = uniqueN(wday(fecha_transaccion))
), by = cliente_id]
# Calcular índices de diversidad
diversidad_transacciones[, `:=`(
indice_diversidad_categoria = round(categorias_usadas / 5 * 100, 1), # 5 categorías posibles
indice_diversidad_temporal = round(horas_activas / 24 * 100, 1), # 24 horas posibles
indice_actividad = round(dias_activos / 180 * 100, 1), # ~180 días en periodo
score_engagement = round((categorias_usadas * 10) + (dias_activos * 2) + (comercios_visitados * 3), 0)
)]
# Clasificar clientes por engagement
diversidad_transacciones[, categoria_engagement := fcase(
score_engagement > 200, "Muy Alto",
score_engagement > 100, "Alto",
score_engagement > 50, "Medio",
score_engagement > 20, "Bajo",
default = "Muy Bajo"
)]
# Resumen por categoría de engagement
resumen_engagement <- diversidad_transacciones[, .(
clientes = .N,
transacciones_promedio = round(mean(transacciones_totales), 1),
diversidad_categoria_promedio = round(mean(indice_diversidad_categoria), 1),
score_promedio = round(mean(score_engagement), 0)
), by = categoria_engagement][order(-score_promedio)]
print("Análisis de engagement de clientes:")
#> [1] "Análisis de engagement de clientes:"
print(resumen_engagement)
#> categoria_engagement clientes transacciones_promedio
#> <char> <int> <num>
#> 1: Alto 6 11.8
#> 2: Medio 580 6.3
#> 3: Bajo 358 3.3
#> 4: Muy Bajo 46 1.3
#> diversidad_categoria_promedio score_promedio
#> <num> <num>
#> 1: 96.7 106
#> 2: 77.2 70
#> 3: 48.9 41
#> 4: 20.0 167.4 Análisis Temporal Avanzado
7.4.1 1. Detección de Anomalías Temporales
# Sistema de detección de anomalías para sensores
anomalias_sensores <- sensores_temperatura[order(sensor_id, timestamp)][, `:=`(
# Medias móviles para diferentes ventanas
temp_ma_short = frollmean(temperatura, 4, na.rm = TRUE), # 1 hora
temp_ma_long = frollmean(temperatura, 24, na.rm = TRUE), # 6 horas
temp_sd_window = frollapply(temperatura, 12, sd, na.rm = TRUE), # Desviación móvil
# Cambios absolutos
cambio_temp = abs(temperatura - shift(temperatura, 1)),
cambio_temp_2 = abs(temperatura - shift(temperatura, 2))
), by = sensor_id][, `:=`(
# Detección de anomalías
anomalia_spike = cambio_temp > 3, # Cambio súbito > 3 grados
anomalia_drift = !is.na(temp_ma_long) & abs(temperatura - temp_ma_long) > 5, # Desviación > 5 grados de media larga
anomalia_variabilidad = !is.na(temp_sd_window) & temp_sd_window > 2 # Alta variabilidad
)]
# Score compuesto de anomalía
anomalias_sensores[, score_anomalia := (as.numeric(anomalia_spike) * 3) +
(as.numeric(anomalia_drift) * 2) +
(as.numeric(anomalia_variabilidad) * 1)]
# Resumen de anomalías por sensor
resumen_anomalias <- anomalias_sensores[!is.na(temperatura), .(
lecturas_totales = .N,
anomalias_spike = sum(anomalia_spike, na.rm = TRUE),
anomalias_drift = sum(anomalia_drift, na.rm = TRUE),
anomalias_variabilidad = sum(anomalia_variabilidad, na.rm = TRUE),
score_promedio = round(mean(score_anomalia, na.rm = TRUE), 2),
temp_min = round(min(temperatura, na.rm = TRUE), 1),
temp_max = round(max(temperatura, na.rm = TRUE), 1)
), by = .(sensor_id, ubicacion)]
print("Resumen de anomalías por sensor:")
#> [1] "Resumen de anomalías por sensor:"
print(resumen_anomalias)
#> sensor_id ubicacion lecturas_totales anomalias_spike anomalias_drift
#> <char> <char> <int> <int> <int>
#> 1: TEMP_A Almacén_A 672 22 13
#> 2: TEMP_B Almacén_B 672 2 0
#> 3: TEMP_C Almacén_C 672 0 0
#> anomalias_variabilidad score_promedio temp_min temp_max
#> <int> <num> <num> <num>
#> 1: 13 0.16 12.4 27.7
#> 2: 0 0.01 16.9 26.9
#> 3: 0 0.00 10.8 30.9
# Top anomalías individuales
top_anomalias <- anomalias_sensores[score_anomalia >= 2, .(
sensor_id, timestamp, temperatura, temp_ma_long,
cambio_temp, score_anomalia
)][order(-score_anomalia)]
if(nrow(top_anomalias) > 0) {
print("\nTop anomalías detectadas:")
print(head(top_anomalias, 8))
} else {
cat("\nNo se detectaron anomalías significativas (score >= 2)\n")
}
#> [1] "\nTop anomalías detectadas:"
#> sensor_id timestamp temperatura temp_ma_long cambio_temp
#> <char> <POSc> <num> <num> <num>
#> 1: TEMP_A 2024-06-01 12:15:00 16.72044 23.10807 3.524149
#> 2: TEMP_A 2024-06-05 01:00:00 23.93975 18.01041 3.102137
#> 3: TEMP_A 2024-06-05 13:45:00 15.41030 21.07500 3.694603
#> 4: TEMP_A 2024-06-07 13:30:00 16.23328 21.58050 4.209491
#> 5: TEMP_A 2024-06-01 09:15:00 21.86478 24.77837 4.167425
#> 6: TEMP_A 2024-06-01 12:30:00 19.82718 22.83089 3.106739
#> 7: TEMP_A 2024-06-02 00:00:00 21.99001 16.89517 1.763178
#> 8: TEMP_A 2024-06-02 00:15:00 23.58168 17.28045 1.591672
#> score_anomalia
#> <num>
#> 1: 5
#> 2: 5
#> 3: 5
#> 4: 5
#> 5: 3
#> 6: 3
#> 7: 3
#> 8: 37.4.2 2. Análisis de Ciclos y Estacionalidad
# Análisis de patrones cíclicos en datos de sensores
patrones_ciclicos <- sensores_temperatura[!is.na(temperatura)][, `:=`(
hora = hour(timestamp),
dia = as.numeric(as.Date(timestamp) - min(as.Date(timestamp))) + 1,
minuto_del_dia = hour(timestamp) * 60 + minute(timestamp)
)][, .(
temperatura_promedio = round(mean(temperatura), 1),
temperatura_sd = round(sd(temperatura), 2),
lecturas = .N
), by = .(sensor_id, hora)]
# Identificar patrones horarios
patrones_resumen <- patrones_ciclicos[, .(
hora_mas_fria = hora[which.min(temperatura_promedio)],
temp_mas_fria = min(temperatura_promedio),
hora_mas_calida = hora[which.max(temperatura_promedio)],
temp_mas_calida = max(temperatura_promedio),
amplitud_termica = round(max(temperatura_promedio) - min(temperatura_promedio), 1),
variabilidad_promedio = round(mean(temperatura_sd), 2)
), by = sensor_id]
print("Patrones térmicos diarios por sensor:")
#> [1] "Patrones térmicos diarios por sensor:"
print(patrones_resumen)
#> sensor_id hora_mas_fria temp_mas_fria hora_mas_calida temp_mas_calida
#> <char> <int> <num> <int> <num>
#> 1: TEMP_A 17 14.9 6 25.1
#> 2: TEMP_B 12 18.8 0 25.0
#> 3: TEMP_C 23 18.4 15 20.5
#> amplitud_termica variabilidad_promedio
#> <num> <num>
#> 1: 10.2 1.04
#> 2: 6.2 0.79
#> 3: 2.1 4.557.5 Ejercicios Prácticos
💡 Solución del Ejercicio 11
# Sistema completo de detección de anomalías multicapa
# CAPA 1: Anomalías estadísticas
sistema_anomalias <- sensores_temperatura[order(sensor_id, timestamp)][, `:=`(
# Ventanas de referencia
temp_ma_1h = frollmean(temperatura, 4, na.rm = TRUE),
temp_ma_6h = frollmean(temperatura, 24, na.rm = TRUE),
temp_ma_24h = frollmean(temperatura, 96, na.rm = TRUE),
# Medidas de variabilidad
temp_sd_1h = frollapply(temperatura, 4, sd, na.rm = TRUE),
temp_sd_6h = frollapply(temperatura, 24, sd, na.rm = TRUE),
# Percentiles móviles
temp_p25_6h = frollapply(temperatura, 24, function(x) quantile(x, 0.25, na.rm = TRUE)),
temp_p75_6h = frollapply(temperatura, 24, function(x) quantile(x, 0.75, na.rm = TRUE)),
# Cambios temporales
cambio_15min = abs(temperatura - shift(temperatura, 1)),
cambio_1h = abs(temperatura - shift(temperatura, 4)),
tendencia_1h = frollapply(temperatura, 4, function(x) {
if(length(x) < 4) return(0)
lm(x ~ seq_along(x))$coefficients[2]
})
), by = sensor_id][, `:=`(
# CAPA 2: Detección de anomalías específicas
anomalia_spike = cambio_15min > 5, # Cambio súbito > 5°C
anomalia_drift = !is.na(temp_ma_6h) & abs(temperatura - temp_ma_6h) > 4, # Drift > 4°C
anomalia_variabilidad = !is.na(temp_sd_1h) & temp_sd_1h > 3, # Alta variabilidad
anomalia_outlier = !is.na(temp_p25_6h) & !is.na(temp_p75_6h) &
(temperatura < (temp_p25_6h - 1.5*(temp_p75_6h - temp_p25_6h)) |
temperatura > (temp_p75_6h + 1.5*(temp_p75_6h - temp_p25_6h))),
anomalia_tendencia = !is.na(tendencia_1h) & abs(tendencia_1h) > 1, # Tendencia > 1°C/15min
anomalia_frozen = !is.na(temp_sd_1h) & temp_sd_1h < 0.1 & !is.na(temperatura) # Sensor "congelado"
)]
# CAPA 3: Clasificación por severidad con fcase()
sistema_anomalias[, `:=`(
# Score compuesto
score_anomalia = (as.numeric(anomalia_spike) * 5) +
(as.numeric(anomalia_drift) * 3) +
(as.numeric(anomalia_variabilidad) * 2) +
(as.numeric(anomalia_outlier) * 2) +
(as.numeric(anomalia_tendencia) * 4) +
(as.numeric(anomalia_frozen) * 6)
)][, severidad := fcase(
score_anomalia >= 10, "CRÍTICA",
score_anomalia >= 6, "ALTA",
score_anomalia >= 3, "MEDIA",
score_anomalia >= 1, "BAJA",
default = "NORMAL"
)]
# CAPA 4: Detección de secuencias anómalas con rleid()
sistema_anomalias[, `:=`(
es_anomalo = severidad != "NORMAL",
secuencia_id = rleid(severidad != "NORMAL")
), by = sensor_id]
# Análisis de secuencias anómalas
secuencias_anomalas <- sistema_anomalias[es_anomalo == TRUE, .(
duracion_minutos = .N * 15, # 15 min por medición
severidad_maxima = severidad[which.max(score_anomalia)],
score_maximo = max(score_anomalia),
score_promedio = round(mean(score_anomalia), 1),
temp_min = round(min(temperatura, na.rm = TRUE), 1),
temp_max = round(max(temperatura, na.rm = TRUE), 1),
inicio = min(timestamp),
fin = max(timestamp),
tipos_anomalia = paste(unique(c(
if(any(anomalia_spike)) "SPIKE",
if(any(anomalia_drift)) "DRIFT",
if(any(anomalia_variabilidad)) "VARIABILIDAD",
if(any(anomalia_outlier)) "OUTLIER",
if(any(anomalia_tendencia)) "TENDENCIA",
if(any(anomalia_frozen)) "FROZEN"
)), collapse = ", ")
), by = .(sensor_id, secuencia_id)][
duracion_minutos >= 30 # Solo secuencias de al menos 30 minutos
][order(-score_maximo)]
# SISTEMA DE ALERTAS AUTOMÁTICAS
cat("🚨 SISTEMA DE ALERTAS DE ANOMALÍAS 🚨\n\n")
#> 🚨 SISTEMA DE ALERTAS DE ANOMALÍAS 🚨
# Alertas activas por sensor
alertas_activas <- sistema_anomalias[es_anomalo == TRUE, .N, by = .(sensor_id, severidad)][order(sensor_id, severidad)]
if(nrow(alertas_activas) > 0) {
cat("ALERTAS ACTIVAS POR SENSOR:\n")
print(alertas_activas)
} else {
cat("✅ No hay alertas activas en este momento.\n")
}
#> ALERTAS ACTIVAS POR SENSOR:
#> sensor_id severidad N
#> <char> <char> <int>
#> 1: TEMP_A ALTA 20
#> 2: TEMP_A BAJA 19
#> 3: TEMP_A MEDIA 67
#> 4: TEMP_B ALTA 5
#> 5: TEMP_B BAJA 14
#> 6: TEMP_B MEDIA 5
#> 7: TEMP_C ALTA 9
#> 8: TEMP_C BAJA 21
#> 9: TEMP_C MEDIA 2
# Top secuencias críticas
if(nrow(secuencias_anomalas) > 0) {
cat("\n🔥 TOP SECUENCIAS ANÓMALAS:\n")
print(head(secuencias_anomalas[, .(sensor_id, severidad_maxima, duracion_minutos,
score_maximo, tipos_anomalia, inicio)], 8))
} else {
cat("\n✅ No se detectaron secuencias anómalas significativas.\n")
}
#>
#> 🔥 TOP SECUENCIAS ANÓMALAS:
#> sensor_id severidad_maxima duracion_minutos score_maximo
#> <char> <char> <num> <num>
#> 1: TEMP_A ALTA 135 9
#> 2: TEMP_A ALTA 30 9
#> 3: TEMP_A ALTA 30 9
#> 4: TEMP_C ALTA 60 9
#> 5: TEMP_A ALTA 30 7
#> 6: TEMP_A ALTA 45 7
#> 7: TEMP_A ALTA 45 7
#> 8: TEMP_A ALTA 30 7
#> tipos_anomalia inicio
#> <char> <POSc>
#> 1: DRIFT, OUTLIER, TENDENCIA 2024-06-01 23:00:00
#> 2: DRIFT, OUTLIER, TENDENCIA 2024-06-03 13:45:00
#> 3: DRIFT, OUTLIER, TENDENCIA 2024-06-05 23:30:00
#> 4: DRIFT, OUTLIER, TENDENCIA 2024-06-06 01:00:00
#> 5: DRIFT, TENDENCIA 2024-06-02 12:30:00
#> 6: DRIFT, TENDENCIA 2024-06-04 02:00:00
#> 7: DRIFT, TENDENCIA 2024-06-05 13:45:00
#> 8: DRIFT, TENDENCIA 2024-06-06 01:45:00
# Resumen estadístico
resumen_sistema <- sistema_anomalias[!is.na(temperatura), .(
lecturas_totales = .N,
anomalias_detectadas = sum(es_anomalo),
pct_anomalias = round(mean(es_anomalo) * 100, 2),
score_promedio = round(mean(score_anomalia), 2)
), by = sensor_id]
cat("\n📊 RESUMEN DEL SISTEMA:\n")
#>
#> 📊 RESUMEN DEL SISTEMA:
print(resumen_sistema)
#> sensor_id lecturas_totales anomalias_detectadas pct_anomalias score_promedio
#> <char> <int> <int> <num> <num>
#> 1: TEMP_A 672 106 15.77 NA
#> 2: TEMP_B 672 24 3.57 NA
#> 3: TEMP_C 672 32 4.76 NA
# # Crear tabla interactiva de secuencias críticas (comentado para PDF)
# if(nrow(secuencias_anomalas) > 0) {
# DT::datatable(
# secuencias_anomalas[1:min(20, nrow(secuencias_anomalas))],
# caption = "Secuencias Anómalas Detectadas - Sistema Multicapa",
# options = list(pageLength = 10, scrollX = TRUE)
# ) %>%
# DT::formatStyle(
# "severidad_maxima",
# backgroundColor = DT::styleEqual(
# c("CRÍTICA", "ALTA", "MEDIA", "BAJA"),
# c("red", "orange", "yellow", "lightblue")
# )
# )
# }
💡 Solución del Ejercicio 12
# Análisis de supervivencia y predicción de churn
# 1. Preparar datos temporales con métricas de ventana
analisis_supervivencia <- clientes_retencion[, `:=`(
dias_desde_registro = as.numeric(as.Date("2024-06-30") - fecha_registro),
dias_desde_ultima_actividad = fifelse(
is.na(fecha_ultima_actividad),
as.numeric(as.Date("2024-06-30") - fecha_registro),
as.numeric(as.Date("2024-06-30") - fecha_ultima_actividad)
)
)]
# Combinar con datos transaccionales para análisis de comportamiento
comportamiento_clientes <- transacciones_comportamiento[, .(
transacciones_totales = .N,
gasto_total = sum(monto),
gasto_promedio = round(mean(monto), 2),
dias_activos = uniqueN(as.Date(fecha_transaccion)),
categorias_usadas = uniqueN(categoria),
ultima_transaccion = max(as.Date(fecha_transaccion)),
primera_transaccion = min(as.Date(fecha_transaccion))
), by = cliente_id]
# Join con datos de clientes
supervivencia_completa <- analisis_supervivencia[
comportamiento_clientes, on = .(cliente_id), nomatch = NULL
][, `:=`(
dias_desde_primera_trans = as.numeric(as.Date("2024-06-30") - primera_transaccion),
dias_desde_ultima_trans = as.numeric(as.Date("2024-06-30") - ultima_transaccion),
frecuencia_transaccional = round(transacciones_totales / dias_activos, 2)
)]
# 2. Identificar patrones de declive con funciones de ventana
# Simular datos de actividad mensual para análisis temporal
actividad_mensual <- supervivencia_completa[, .(
cliente_id, activo, ingresos_mensuales, gasto_total, transacciones_totales
)][, .(
cliente_id,
mes = rep(1:6, .N),
actividad_simulada = as.numeric(activo) * exp(-abs(rnorm(.N * 6, 0, 0.3))),
gasto_simulado = rep(gasto_total / 6, 6) * exp(rnorm(.N * 6, 0, 0.4))
), by = cliente_id][order(cliente_id, mes)]
# Aplicar funciones de ventana para detectar tendencias
actividad_tendencias <- actividad_mensual[, `:=`(
actividad_ma3 = frollmean(actividad_simulada, 3),
gasto_ma3 = frollmean(gasto_simulado, 3),
actividad_anterior = shift(actividad_simulada, 1),
gasto_anterior = shift(gasto_simulado, 1),
tendencia_actividad = actividad_simulada - shift(actividad_simulada, 1),
secuencia_declive = rleid(actividad_simulada < shift(actividad_simulada, 1))
), by = cliente_id]
# 3. Análisis de riesgo de churn con múltiples criterios
modelo_churn <- supervivencia_completa[, `:=`(
# Señales de riesgo temporal
riesgo_inactividad = fcase(
dias_desde_ultima_trans > 90, "ALTO",
dias_desde_ultima_trans > 60, "MEDIO",
dias_desde_ultima_trans > 30, "BAJO",
default = "MÍNIMO"
),
# Señales de comportamiento
riesgo_engagement = fcase(
frecuencia_transaccional < 0.1 & categorias_usadas <= 2, "ALTO",
frecuencia_transaccional < 0.3 & categorias_usadas <= 3, "MEDIO",
frecuencia_transaccional < 0.5, "BAJO",
default = "MÍNIMO"
),
# Señales económicas
riesgo_economico = fcase(
gasto_promedio < ingresos_mensuales * 0.01, "ALTO", # Gasta <1% de ingresos
gasto_promedio < ingresos_mensuales * 0.03, "MEDIO", # Gasta <3% de ingresos
gasto_promedio < ingresos_mensuales * 0.05, "BAJO", # Gasta <5% de ingresos
default = "MÍNIMO"
),
# Señal de valor del cliente
valor_cliente = round((gasto_total / dias_activos) * (ingresos_mensuales / 1000), 0)
)][, `:=`(
# Score compuesto de riesgo de churn
score_churn = (
(riesgo_inactividad == "ALTO") * 40 + (riesgo_inactividad == "MEDIO") * 25 + (riesgo_inactividad == "BAJO") * 10 +
(riesgo_engagement == "ALTO") * 30 + (riesgo_engagement == "MEDIO") * 20 + (riesgo_engagement == "BAJO") * 10 +
(riesgo_economico == "ALTO") * 20 + (riesgo_economico == "MEDIO") * 12 + (riesgo_economico == "BAJO") * 5 +
ifelse(!activo, 25, 0) # Penalización por inactividad actual
)
)][, `:=`(
# 4. Clasificación final y estrategia
clasificacion_churn = fcase(
score_churn >= 80, "CHURN_INMEDIATO",
score_churn >= 60, "ALTO_RIESGO",
score_churn >= 40, "RIESGO_MODERADO",
score_churn >= 20, "BAJO_RIESGO",
default = "SALUDABLE"
),
estrategia_retencion = fcase(
score_churn >= 80, "Contacto_Inmediato + Oferta_Especial",
score_churn >= 60, "Programa_Reactivación + Descuentos",
score_churn >= 40, "Comunicación_Personalizada",
score_churn >= 20, "Monitoreo_Activo",
default = "Mantenimiento_Rutinario"
)
)]
# Análisis de resultados
cat("📈 ANÁLISIS DE SUPERVIVENCIA DE CLIENTES 📈\n\n")
#> 📈 ANÁLISIS DE SUPERVIVENCIA DE CLIENTES 📈
# Distribución por clasificación
distribucion_churn <- modelo_churn[, .N, by = clasificacion_churn][order(-N)]
cat("DISTRIBUCIÓN POR RIESGO DE CHURN:\n")
#> DISTRIBUCIÓN POR RIESGO DE CHURN:
print(distribucion_churn)
#> clasificacion_churn N
#> <char> <int>
#> 1: BAJO_RIESGO 399
#> 2: SALUDABLE 375
#> 3: RIESGO_MODERADO 167
#> 4: ALTO_RIESGO 41
#> 5: CHURN_INMEDIATO 8
# Estadísticas por grupo de riesgo
stats_por_riesgo <- modelo_churn[, .(
clientes = .N,
score_promedio = round(mean(score_churn), 1),
ingresos_promedio = round(mean(ingresos_mensuales), 0),
valor_cliente_promedio = round(mean(valor_cliente), 0),
dias_inactividad_promedio = round(mean(dias_desde_ultima_trans), 0),
tasa_actividad_actual = round(mean(activo) * 100, 1)
), by = clasificacion_churn][order(-score_promedio)]
cat("\n📊 ESTADÍSTICAS POR GRUPO DE RIESGO:\n")
#>
#> 📊 ESTADÍSTICAS POR GRUPO DE RIESGO:
print(stats_por_riesgo)
#> clasificacion_churn clientes score_promedio ingresos_promedio
#> <char> <int> <num> <num>
#> 1: CHURN_INMEDIATO 8 85.0 15829
#> 2: ALTO_RIESGO 41 64.5 8923
#> 3: RIESGO_MODERADO 167 46.3 10399
#> 4: BAJO_RIESGO 399 26.3 10207
#> 5: SALUDABLE 375 8.4 3887
#> valor_cliente_promedio dias_inactividad_promedio tasa_actividad_actual
#> <num> <num> <num>
#> 1: 927 111 0.0
#> 2: 620 101 43.9
#> 3: 975 58 40.7
#> 4: 1000 29 71.9
#> 5: 609 19 100.0
# Clientes críticos que requieren atención inmediata
clientes_criticos <- modelo_churn[clasificacion_churn %in% c("CHURN_INMEDIATO", "ALTO_RIESGO"), .(
cliente_id, plan, pais, ingresos_mensuales, valor_cliente,
score_churn, clasificacion_churn, estrategia_retencion,
dias_inactividad = dias_desde_ultima_trans
)][order(-score_churn)]
cat("\n🚨 CLIENTES QUE REQUIEREN ATENCIÓN INMEDIATA:\n")
#>
#> 🚨 CLIENTES QUE REQUIEREN ATENCIÓN INMEDIATA:
print(head(clientes_criticos, 10))
#> cliente_id plan pais ingresos_mensuales valor_cliente
#> <int> <char> <char> <num> <num>
#> 1: 390 Básico Argentina 22555 2407
#> 2: 644 Premium Chile 7987 361
#> 3: 717 Premium Argentina 28491 2573
#> 4: 677 Empresarial Colombia 8912 130
#> 5: 311 Básico México 25268 1054
#> 6: 69 Básico México 3292 82
#> 7: 807 Básico España 4994 100
#> 8: 489 Básico Chile 25132 708
#> 9: 695 Básico Colombia 1818 46
#> 10: 172 Básico España 4791 501
#> score_churn clasificacion_churn estrategia_retencion
#> <num> <char> <char>
#> 1: 85 CHURN_INMEDIATO Contacto_Inmediato + Oferta_Especial
#> 2: 85 CHURN_INMEDIATO Contacto_Inmediato + Oferta_Especial
#> 3: 85 CHURN_INMEDIATO Contacto_Inmediato + Oferta_Especial
#> 4: 85 CHURN_INMEDIATO Contacto_Inmediato + Oferta_Especial
#> 5: 85 CHURN_INMEDIATO Contacto_Inmediato + Oferta_Especial
#> 6: 85 CHURN_INMEDIATO Contacto_Inmediato + Oferta_Especial
#> 7: 85 CHURN_INMEDIATO Contacto_Inmediato + Oferta_Especial
#> 8: 85 CHURN_INMEDIATO Contacto_Inmediato + Oferta_Especial
#> 9: 77 ALTO_RIESGO Programa_Reactivación + Descuentos
#> 10: 77 ALTO_RIESGO Programa_Reactivación + Descuentos
#> dias_inactividad
#> <num>
#> 1: 98
#> 2: 120
#> 3: 127
#> 4: 121
#> 5: 103
#> 6: 98
#> 7: 121
#> 8: 98
#> 9: 93
#> 10: 168
# ROI potencial de estrategias de retención
roi_estrategias <- modelo_churn[, .(
clientes_objetivo = .N,
valor_total_riesgo = sum(valor_cliente),
valor_promedio_cliente = round(mean(valor_cliente), 0),
inversion_retencion_estimada = .N * fcase(
unique(clasificacion_churn) == "CHURN_INMEDIATO", 200,
unique(clasificacion_churn) == "ALTO_RIESGO", 100,
unique(clasificacion_churn) == "RIESGO_MODERADO", 50,
default = 20
),
roi_potencial = round((sum(valor_cliente) * 0.7) / (.N * fcase(
unique(clasificacion_churn) == "CHURN_INMEDIATO", 200,
unique(clasificacion_churn) == "ALTO_RIESGO", 100,
unique(clasificacion_churn) == "RIESGO_MODERADO", 50,
default = 20
)), 1)
), by = .(clasificacion_churn, estrategia_retencion)][order(-roi_potencial)]
cat("\n💰 ANÁLISIS DE ROI DE ESTRATEGIAS:\n")
#>
#> 💰 ANÁLISIS DE ROI DE ESTRATEGIAS:
print(roi_estrategias)
#> clasificacion_churn estrategia_retencion clientes_objetivo
#> <char> <char> <int>
#> 1: BAJO_RIESGO Monitoreo_Activo 399
#> 2: SALUDABLE Mantenimiento_Rutinario 375
#> 3: RIESGO_MODERADO Comunicación_Personalizada 167
#> 4: ALTO_RIESGO Programa_Reactivación + Descuentos 41
#> 5: CHURN_INMEDIATO Contacto_Inmediato + Oferta_Especial 8
#> valor_total_riesgo valor_promedio_cliente inversion_retencion_estimada
#> <num> <num> <num>
#> 1: 399150 1000 7980
#> 2: 228467 609 7500
#> 3: 162822 975 8350
#> 4: 25439 620 4100
#> 5: 7415 927 1600
#> roi_potencial
#> <num>
#> 1: 35.0
#> 2: 21.3
#> 3: 13.6
#> 4: 4.3
#> 5: 3.2
🎯 Puntos Clave de Este Capítulo
- Funciones de ventana (
shift,frollmean,frollapply) permiten análisis temporal sofisticado sin colapsar datos - Funciones condicionales (
fifelse,fcase,between) optimizan clasificaciones complejas - Funciones de agregación especiales (
frank,rleid,uniqueN) revelan patrones ocultos en los datos - Análisis temporal combina múltiples técnicas para detección de anomalías y predicción
- Performance: Estas funciones están altamente optimizadas y son significativamente más rápidas que alternativas de R base
- Casos de uso reales: Finanzas, IoT, análisis de comportamiento - las aplicaciones son ilimitadas
Las funciones especiales de data.table te dan superpoderes para análisis complejos. En el próximo capítulo exploraremos las técnicas de reshape que complementan perfectamente estas funciones para transformaciones de datos avanzadas.