MACD
Fagner sutel
2025-07-08
Movimg Average Convergence and Divergence (MACD)
- MACD
- É a diferença entre duas médias móveis exponenciais (EMAs):
- Normalmente: MACD = EMA de 12 períodos – EMA de 26 períodos
- Ele mostra a força e direção da tendência atual. Se está subindo, o
ativo (ou, no nosso caso, o tráfego) está ganhando fluidez. Se está
caindo, pode estar se congestionando.
- Linha de Sinal
- É a média móvel do próprio MACD, geralmente de 9 períodos.
- Serve como referência para identificar pontos de cruzamento:
- MACD cruza acima da linha de sinal → sinal de melhora (tendência
positiva)
- MACD cruza abaixo da linha de sinal → sinal de piora (tendência
negativa)
- Histograma
- É a diferença entre o MACD e a Linha de Sinal:
- Histograma = MACD – Sinal
- Ele mostra a velocidade da mudança entre essas duas curvas:
- Barras maiores (positivas ou negativas) indicam aceleração da
tendência
- Quando o histograma muda de sinal (de + para – ou vice-versa), é um indício precoce de reversão
- É a diferença entre o MACD e a Linha de Sinal:
Resumindo:
- MACD é o coração da análise de tendência.
- Linha de Sinal é o guia comparativo.
- Histograma mostra o “ritmo da dança” entre os dois.
Simulando 100 minutos de dados
library(tidyverse)## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ ggplot2 3.5.1 ✔ tibble 3.2.1
## ✔ lubridate 1.9.4 ✔ tidyr 1.3.1
## ✔ purrr 1.0.4
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorslibrary(TTR)
set.seed(42)
tempo <- seq.POSIXt(from = as.POSIXct("2025-06-29 16:00"), by = "min", length.out = 100)
velocidade <- pmin(pmax(rnorm(100, mean = 40, sd = 7), 10), 60)
atraso <- pmin(pmax(rnorm(100, mean = 5, sd = 2), 1), 15)
intensidade <- round(pmin(pmax((60 - velocidade) / 10, 1), 5))
df <- tibble(
horario = tempo,
velocidade_kmh = velocidade,
atraso_min = atraso,
intensidade = intensidade
)
df## # A tibble: 100 × 4
## horario velocidade_kmh atraso_min intensidade
## <dttm> <dbl> <dbl> <dbl>
## 1 2025-06-29 16:00:00 49.6 7.40 1
## 2 2025-06-29 16:01:00 36.0 7.09 2
## 3 2025-06-29 16:02:00 42.5 2.99 2
## 4 2025-06-29 16:03:00 44.4 8.70 2
## 5 2025-06-29 16:04:00 42.8 3.67 2
## 6 2025-06-29 16:05:00 39.3 5.21 2
## 7 2025-06-29 16:06:00 50.6 4.16 1
## 8 2025-06-29 16:07:00 39.3 4.76 2
## 9 2025-06-29 16:08:00 54.1 5.38 1
## 10 2025-06-29 16:09:00 39.6 5.24 2
## # ℹ 90 more rowsCálculo do MACD com TTR::MACD
macd_result <- MACD(df$velocidade_kmh, nFast = 5, nSlow = 15, nSig = 9, maType = EMA)
df <- df %>%
mutate(
MACD = macd_result[, 1],
Sinal = macd_result[, 2],
Histograma = MACD - Sinal
)
df## # A tibble: 100 × 7
## horario velocidade_kmh atraso_min intensidade MACD Sinal
## <dttm> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 2025-06-29 16:00:00 49.6 7.40 1 NA NA
## 2 2025-06-29 16:01:00 36.0 7.09 2 NA NA
## 3 2025-06-29 16:02:00 42.5 2.99 2 NA NA
## 4 2025-06-29 16:03:00 44.4 8.70 2 NA NA
## 5 2025-06-29 16:04:00 42.8 3.67 2 NA NA
## 6 2025-06-29 16:05:00 39.3 5.21 2 NA NA
## 7 2025-06-29 16:06:00 50.6 4.16 1 NA NA
## 8 2025-06-29 16:07:00 39.3 4.76 2 NA NA
## 9 2025-06-29 16:08:00 54.1 5.38 1 NA NA
## 10 2025-06-29 16:09:00 39.6 5.24 2 NA NA
## # ℹ 90 more rows
## # ℹ 1 more variable: Histograma <dbl># Gráfico
df_long <- df %>%
pivot_longer(cols = c("MACD", "Sinal"), names_to = "linha", values_to = "valor")
ggplot(df_long, aes(x = horario, y = valor, color = linha)) +
geom_line(size = 1) +
geom_col(data = df, aes(x = horario, y = Histograma), fill = "gray70", inherit.aes = FALSE, alpha = 0.5) +
labs(title = "MACD aplicado à Velocidade Média de Trânsito",
x = "Horário", y = "Valor") +
theme_minimal() +
theme(legend.position = "top")## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.## Warning: Removed 36 rows containing missing values or values outside the scale range
## (`geom_line()`).## Warning: Removed 22 rows containing missing values or values outside the scale range
## (`geom_col()`).
Simular dados das 06:00 às 22:00 — 960 minutos
rm(list = ls())
library(tidyverse)
library(TTR)
tempo <- seq.POSIXt(from = as.POSIXct("2025-06-29 06:00"),
to = as.POSIXct("2025-06-29 21:59"),
by = "min")
n <- length(tempo)Simulando padrões de tráfego ao longo do dia
Trânsito mais lento nos horários de pico (7h–9h e 17h–19h)
hora <- hour(tempo)
velocidade_base <- 50 - 15 * ((hora >= 7 & hora <= 9) | (hora >= 17 & hora <= 19))
ruido <- rnorm(n, mean = 0, sd = 5)
velocidade <- pmin(pmax(velocidade_base + ruido, 10), 60)
atraso <- pmin(pmax(15 - velocidade/5 + rnorm(n, 0, 1.5), 1), 20)
intensidade <- round(pmin(pmax((60 - velocidade) / 10, 1), 5))
df <- tibble(
horario = tempo,
velocidade_kmh = velocidade,
atraso_min = atraso,
intensidade = intensidade
)Calculando o MACD
macd_result <- MACD(df$velocidade_kmh, nFast = 5, nSlow = 15, nSig = 9, maType = EMA)
df <- df %>%
mutate(
MACD = macd_result[, 1],
Sinal = macd_result[, 2],
Histograma = MACD - Sinal
)Visualização
df_long <- df %>%
pivot_longer(cols = c("MACD", "Sinal"), names_to = "linha", values_to = "valor")
ggplot(df_long, aes(x = horario, y = valor, color = linha)) +
geom_line(size = 0.9) +
geom_col(data = df, aes(x = horario, y = Histograma),
fill = "gray70", inherit.aes = FALSE, alpha = 0.4) +
labs(title = "MACD aplicado à Velocidade Média (06h–22h)",
x = "Horário", y = "Valor") +
theme_minimal() +
scale_x_datetime(date_breaks = "2 hour", date_labels = "%H:%M") +
theme(legend.position = "top")## Warning: Removed 36 rows containing missing values or values outside the scale range
## (`geom_line()`).## Warning: Removed 22 rows containing missing values or values outside the scale range
## (`geom_col()`).
Simulando com varias vias
rm(list = ls())
library(tidyverse)
library(TTR)Parâmetros
set.seed(42)
ruas <- c("Av Brasil", "Rua das Flores", "Av Central")
tempo <- seq.POSIXt(from = as.POSIXct("2025-06-29 06:00"),
to = as.POSIXct("2025-06-29 21:59"),
by = "min")
n <- length(tempo)
# Gerar DataFrame para todas as ruas
dados <- map_dfr(ruas, function(rua) {
velocidade_base <- 50 - 15 * ((hour(tempo) >= 7 & hour(tempo) <= 9) | (hour(tempo) >= 17 & hour(tempo) <= 19))
ruido <- rnorm(n, 0, 6)
velocidade <- pmin(pmax(velocidade_base + ruido + runif(1, -5, 5), 10), 60)
tibble(
rua = rua,
horario = tempo,
velocidade_kmh = velocidade
)
})Calcular MACD por rua
dados_macd <- dados %>%
group_by(rua) %>%
group_modify(~{
m <- MACD(.x$velocidade_kmh, nFast = 5, nSlow = 15, nSig = 9)
mutate(.x,
MACD = m[,1],
Sinal = m[,2],
Histograma = m[,1] - m[,2])
})
dados_long <- dados_macd %>%
pivot_longer(cols = c("MACD", "Sinal"), names_to = "linha", values_to = "valor")
ggplot(dados_long, aes(x = horario, y = valor, color = linha)) +
geom_line() +
geom_col(data = dados_macd, aes(x = horario, y = Histograma),
inherit.aes = FALSE, fill = "gray75", alpha = 0.5) +
facet_wrap(~ rua, scales = "free_y") +
labs(title = "MACD da Velocidade por Rua",
x = "Horário", y = "Valor") +
theme_minimal() +
theme(legend.position = "top")## Warning: Removed 36 rows containing missing values or values outside the scale range
## (`geom_line()`).## Warning: Removed 66 rows containing missing values or values outside the scale range
## (`geom_col()`).
MACD nesse caso:
🔻 MACD < -4
- Isso indica que a velocidade média da via está muito abaixo da média
recente, sugerindo trânsito travado ou piora acentuada.
- Um valor abaixo de -4 não é absoluto — depende da escala dos seus
dados — mas, na prática, você está dizendo:
- “Se a fluidez piorou o suficiente para o MACD cair mais de 4 unidades
abaixo da linha de base, acione um alerta.”
🔺 Histograma > 3
- Significa que a diferença entre o MACD e a linha de sinal está
bastante positiva. Traduzindo:
- O tráfego está melhorando rapidamente, ou
- O MACD está “disparando para cima” mais do que a média recente
esperaria.
💡 Resumo prático
MACD < -4 → alerta para congestionamento severo.
Histograma > 3 → alerta para recuperação rápida ou reversão de
tendência.
df_alertas <- dados_macd %>%
filter(MACD < -4 | Histograma > 3)
df_alertas## # A tibble: 882 × 6
## # Groups: rua [3]
## rua horario velocidade_kmh MACD Sinal Histograma
## <chr> <dttm> <dbl> <dbl> <dbl> <dbl>
## 1 Av Brasil 2025-06-29 06:14:00 52.5 -4.05 NA NA
## 2 Av Brasil 2025-06-29 06:17:00 37.3 -8.79 NA NA
## 3 Av Brasil 2025-06-29 06:18:00 38.6 -11.8 NA NA
## 4 Av Brasil 2025-06-29 06:19:00 60 -4.04 NA NA
## 5 Av Brasil 2025-06-29 06:21:00 42.6 -5.84 NA NA
## 6 Av Brasil 2025-06-29 06:23:00 60 1.48 -3.73 5.21
## 7 Av Brasil 2025-06-29 06:24:00 60 4.07 -2.17 6.25
## 8 Av Brasil 2025-06-29 06:25:00 50.7 1.79 -1.38 3.17
## 9 Av Brasil 2025-06-29 06:32:00 59.5 4.30 0.740 3.56
## 10 Av Brasil 2025-06-29 06:38:00 38.8 -7.83 -2.44 -5.39
## # ℹ 872 more rowsSimulação Anual
rm(list = ls())
library(tidyverse)
library(lubridate)
library(TTR)
set.seed(42)
ruas <- c("Av Brasil", "Rua das Flores", "Av Central")
dias <- seq.Date(from = as.Date("2025-01-01"), to = as.Date("2025-06-30"), by = "day")
minutos_dia <- seq.POSIXt(from = as.POSIXct("06:00", format="%H:%M"),
to = as.POSIXct("21:59", format="%H:%M"), by = "min")
n <- length(minutos_dia)Simular dados
dados <- expand.grid(
data = dias,
rua = ruas,
minuto = minutos_dia
) %>%
mutate(
horario = as.POSIXct(paste(data, format(minuto, "%H:%M:%S"))),
hora = hour(horario),
# Base = velocidade teórica para o horário
base = 50 - 15 * ((hora >= 7 & hora <= 9) | (hora >= 17 & hora <= 19)),
# Estamos usando uma distribuição normal com média 0 e desvio padrão 6 para gerar pequenas variações;
ruido = rnorm(n() , 0, 5),
velocidade_kmh = pmin(pmax(base + ruido + runif(n(), -5, 5), 10), 60)
)
head(dados)## data rua minuto horario hora base
## 1 2025-01-01 Av Brasil 2025-07-07 06:00:00 2025-01-01 06:00:00 6 50
## 2 2025-01-02 Av Brasil 2025-07-07 06:00:00 2025-01-02 06:00:00 6 50
## 3 2025-01-03 Av Brasil 2025-07-07 06:00:00 2025-01-03 06:00:00 6 50
## 4 2025-01-04 Av Brasil 2025-07-07 06:00:00 2025-01-04 06:00:00 6 50
## 5 2025-01-05 Av Brasil 2025-07-07 06:00:00 2025-01-05 06:00:00 6 50
## 6 2025-01-06 Av Brasil 2025-07-07 06:00:00 2025-01-06 06:00:00 6 50
## ruido velocidade_kmh
## 1 6.8547922 53.89820
## 2 -2.8234909 43.84592
## 3 1.8156421 52.81086
## 4 3.1643130 54.72173
## 5 2.0213416 52.08769
## 6 -0.5306226 51.10586Calcular MACD por rua e por dia
library(tidyverse)
library(TTR)Aplicando MACD por grupo usando group_modify
dados_macd <- dados %>%
group_by(rua, data) %>%
group_modify(~{
resultado <- MACD(.x$velocidade_kmh, nFast = 5, nSlow = 15, nSig = 9)
.x %>%
mutate(
MACD = resultado[, 1],
Sinal = resultado[, 2],
Histograma = MACD - Sinal
)
}) %>%
ungroup()
head(dados_macd)## # A tibble: 6 × 11
## rua data minuto horario hora base ruido
## <fct> <date> <dttm> <dttm> <int> <dbl> <dbl>
## 1 Av Bras… 2025-01-01 2025-07-07 06:00:00 2025-01-01 06:00:00 6 50 6.85
## 2 Av Bras… 2025-01-01 2025-07-07 06:01:00 2025-01-01 06:01:00 6 50 8.04
## 3 Av Bras… 2025-01-01 2025-07-07 06:02:00 2025-01-01 06:02:00 6 50 -1.99
## 4 Av Bras… 2025-01-01 2025-07-07 06:03:00 2025-01-01 06:03:00 6 50 2.14
## 5 Av Bras… 2025-01-01 2025-07-07 06:04:00 2025-01-01 06:04:00 6 50 -2.92
## 6 Av Bras… 2025-01-01 2025-07-07 06:05:00 2025-01-01 06:05:00 6 50 -0.882
## # ℹ 4 more variables: velocidade_kmh <dbl>, MACD <dbl>, Sinal <dbl>,
## # Histograma <dbl>#Criar um índice de criticidade diária
mean(dados_macd$Histograma, na.rm = TRUE)## [1] 0.000444561quantile(dados_macd$Histograma, na.rm = TRUE, probs = c(.5,.75,.80,.85,.90,.95,1))## 50% 75% 80% 85% 90% 95%
## 0.007388733 1.855033188 2.318450744 2.864334727 3.569072768 4.715503297
## 100%
## 17.210814638resumo_dias <- dados_macd %>%
group_by(rua, data) %>%
summarise(
tempo_congestionado = sum(MACD < Sinal, na.rm = TRUE),
#histograma_médio = mean(abs(Histograma), na.rm = TRUE),
histograma_médio = quantile(dados_macd$Histograma, na.rm = TRUE, probs = c(.95)),# quantil 95
pico_negativo = sum(Histograma < -3, na.rm = TRUE),
pico_positivo = sum(Histograma > 3, na.rm = TRUE)
) %>%
arrange(desc(tempo_congestionado))## `summarise()` has grouped output by 'rua'. You can override using the `.groups`
## argument.head(resumo_dias)## # A tibble: 6 × 6
## # Groups: rua [2]
## rua data tempo_congestionado histograma_médio pico_negativo
## <fct> <date> <int> <dbl> <int>
## 1 Av Brasil 2025-03-10 494 4.72 129
## 2 Av Central 2025-06-20 493 4.72 131
## 3 Av Brasil 2025-01-23 492 4.72 124
## 4 Av Brasil 2025-02-17 492 4.72 133
## 5 Av Brasil 2025-05-11 492 4.72 134
## 6 Av Central 2025-04-20 492 4.72 127
## # ℹ 1 more variable: pico_positivo <int>Visualização dos dias críticos (exemplo com heatmap)
ggplot(resumo_dias, aes(x = data, y = rua, fill = tempo_congestionado)) +
geom_tile(color = "white") +
scale_fill_viridis_c(option = "inferno") +
labs(title = "Mapa de calor: dias com maior tempo de congestionamento",
x = "Data", y = "Rua", fill = "Minutos Congestionado") +
theme_minimal()
#### MACD ao longo do tempo (por rua)
ggplot(dados_macd, aes(x = horario, y = MACD, color = rua)) +
geom_line(size = 0.6, alpha = 0.8) +
labs(title = "MACD da Velocidade ao Longo do Mês",
x = "Horário", y = "MACD") +
theme_minimal() +
facet_wrap(~ rua, scales = "free_y", ncol = 1) +
theme(legend.position = "none")## Warning: Removed 42 rows containing missing values or values outside the scale range
## (`geom_line()`).
Heatmap de criticidade por dia
resumo_dias <- dados_macd %>%
mutate(data = as.Date(horario)) %>%
group_by(rua, data) %>%
summarise(
minutos_criticos = sum(MACD < -10 | Histograma > 5, na.rm = TRUE),
.groups = "drop"
)
ggplot(resumo_dias, aes(x = data, y = rua, fill = minutos_criticos)) +
geom_tile(color = "white") +
scale_fill_viridis_c(option = "plasma", name = "Minutos Críticos") +
labs(title = "Dias Críticos por Rua segundo MACD",
x = "Data", y = "Rua") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
## Gráfico com MACD, Linha de Sinal e Histograma
# Transformar dados para gráfico (exibindo MACD e Sinal)
dados_long <- dados_macd %>%
pivot_longer(cols = c("MACD", "Sinal"), names_to = "linha", values_to = "valor")
# Plotar MACD e Sinal com Histograma de fundo
ggplot(dados_long, aes(x = horario, y = valor, color = linha)) +
geom_line(size = 0.7) +
geom_col(data = dados_macd, aes(x = horario, y = Histograma),
inherit.aes = FALSE, fill = "gray75", alpha = 0.4) +
facet_wrap(~ rua, scales = "free_y", ncol = 1) +
labs(title = "MACD, Linha de Sinal e Histograma por Rua",
x = "Horário", y = "Valor do Indicador") +
theme_minimal() +
theme(legend.position = "top")## Warning: Removed 36 rows containing missing values or values outside the scale range
## (`geom_line()`).## Warning: Removed 11946 rows containing missing values or values outside the scale range
## (`geom_col()`).
Avaliando uma via específica
library(ggplot2)
library(dplyr)
library(tidyr)
# Filtra uma rua específica
dados_filtrados <- dados_macd %>%
dplyr::filter(rua == "Av Brasil") %>%
dplyr::select(horario, MACD, Sinal, Histograma)
# Reorganiza os dados para MACD e Sinal em linhas separadas
dados_long <- dados_filtrados %>%
pivot_longer(cols = c("MACD", "Sinal"), names_to = "linha", values_to = "valor")
# Plotagem
ggplot(dados_long, aes(x = horario, y = valor, color = linha)) +
geom_line(size = 0.7) +
geom_col(data = dados_filtrados, aes(x = horario, y = Histograma),
fill = "gray70", alpha = 0.5, inherit.aes = FALSE) +
labs(title = "MACD, Sinal e Histograma – Av Brasil",
x = "Horário", y = "Indicador") +
theme_minimal() +
theme(legend.position = "top")## Warning: Removed 36 rows containing missing values or values outside the scale range
## (`geom_line()`).## Warning: Removed 3982 rows containing missing values or values outside the scale range
## (`geom_col()`).
Modelo preditivo com limites definidos como metas
🔮 Etapa 1: Marcar os dias críticos da série histórica
Vamos considerar como dia crítico qualquer dia com mais de, por exemplo, 60 minutos em condição crítica (MACD < -4 | Histograma > 3).
dias_rotulados <- resumo_dias %>%
mutate(critico = minutos_criticos >= 60) # ajuste esse threshold se desejar🧠 Etapa 2: Construir as variáveis preditoras
Para prever a semana seguinte, criamos estatísticas da semana anterior (última segunda a sexta) — média de minutos críticos, desvio, nº de dias críticos, etc. Isolar os últimos 5 dias úteis da série
ultima_semana <- dias_rotulados %>%
filter(weekdays(data) %in% c("segunda-feira", "terça-feira", "quarta-feira", "quinta-feira", "sexta-feira")) %>%
group_by(rua) %>%
filter(data == max(data[data < max(data)])) %>% # último dia útil da semana anterior
summarise(
media_crit = mean(minutos_criticos, na.rm = TRUE),
dias_crit = sum(critico),
pico_max = max(minutos_criticos)
)📊 Etapa 3: Gerar previsão para próxima semana
Como seus dados são simulados, você pode usar uma regra de decisão
simples:
Se a rua teve mais de 2 dias críticos na última semana ou média > 60
minutos → alta chance de semana seguinte também ter dias críticos
prognostico <- ultima_semana %>%
mutate(provavel_semana_critica = media_crit > 60 | dias_crit >= 3)
prognostico## # A tibble: 3 × 5
## rua media_crit dias_crit pico_max provavel_semana_critica
## <fct> <dbl> <int> <int> <lgl>
## 1 Av Brasil 59 0 59 FALSE
## 2 Rua das Flores 61 1 61 TRUE
## 3 Av Central 56 0 56 FALSEprognostivo por quantis
quantis <- resumo_dias %>%
summarise(
Q1 = quantile(minutos_criticos, 0.25),
Q3 = quantile(minutos_criticos, 0.75)
)Definir um threshold como Q3 (dias no topo dos 25%)
threshold <- quantis$Q3
resumo_dias <- resumo_dias %>%
mutate(critico = minutos_criticos >= threshold)
resumo_dias## # A tibble: 546 × 4
## rua data minutos_criticos critico
## <fct> <date> <int> <lgl>
## 1 Av Brasil 2025-01-01 64 FALSE
## 2 Av Brasil 2025-01-02 77 TRUE
## 3 Av Brasil 2025-01-03 56 FALSE
## 4 Av Brasil 2025-01-04 61 FALSE
## 5 Av Brasil 2025-01-05 56 FALSE
## 6 Av Brasil 2025-01-06 65 TRUE
## 7 Av Brasil 2025-01-07 83 TRUE
## 8 Av Brasil 2025-01-08 69 TRUE
## 9 Av Brasil 2025-01-09 67 TRUE
## 10 Av Brasil 2025-01-10 63 FALSE
## # ℹ 536 more rowsModelo preditivo com determinação estatística
🧮 1. Construir variáveis com médias móveis
Vamos usar os dados históricos de cada rua para calcular estatísticas agregadas por dia, como: Média móvel do número de minutos críticos (últimos 3 a 5 dias) Tendência da média do MACD (sinal de agravamento ou melhora) Quantidade de picos negativos e positivos recentes Exemplo para 5 dias anteriores por rua:
✅ Passo 1: reconstruir resumo_dias com os campos necessários
resumo_dias <- dados_macd %>%
mutate(data = as.Date(horario)) %>%
group_by(rua, data) %>%
summarise(
minutos_criticos = sum(MACD < -10 | Histograma > (5), na.rm = TRUE),
pico_negativo = sum(Histograma < -5, na.rm = TRUE),
pico_positivo = sum(Histograma > 5, na.rm = TRUE),
.groups = "drop"
)###✅ Passo 2: aplicar as médias móveis com slide_dbl()
library(slider)
resumo_vars <- resumo_dias %>%
arrange(rua, data) %>%
group_by(rua) %>%
mutate(
mm_criticos = slide_dbl(minutos_criticos, mean, .before = 5, .complete = TRUE),
mm_pico_neg = slide_dbl(pico_negativo, mean, .before = 5, .complete = TRUE),
mm_pico_pos = slide_dbl(pico_positivo, mean, .before = 5, .complete = TRUE),
critico = minutos_criticos >= quantile(minutos_criticos, 0.75, na.rm = TRUE)
) %>%
ungroup() %>%
drop_na()⚙️ 2. Treinar modelo com xgboost
Agora vamos usar essas médias móveis como preditores para saber se o próximo dia terá alto risco de ser crítico.
library(xgboost)##
## Attaching package: 'xgboost'## The following object is masked from 'package:dplyr':
##
## sliceSeparar treino e teste
set.seed(123)
train_idx <- sample(nrow(resumo_vars), 0.8 * nrow(resumo_vars))
train <- resumo_vars[train_idx, ]
test <- resumo_vars[-train_idx, ]Montar matriz para xgboost
x_train <- as.matrix(select(train, mm_criticos, mm_pico_neg, mm_pico_pos))
y_train <- as.numeric(train$critico)
x_test <- as.matrix(select(test, mm_criticos, mm_pico_neg, mm_pico_pos))
y_test <- as.numeric(test$critico)Treinar modelo
modelo <- xgboost(
data = x_train,
label = y_train,
nrounds = 50,
objective = "binary:logistic",
eval_metric = "logloss",
verbose = 0
)Avaliação
pred_prob <- predict(modelo, x_test)
pred_class <- as.integer(pred_prob > 0.5)
confusion <- table(Predito = pred_class, Real = y_test)
print(confusion)## Real
## Predito 0 1
## 0 64 18
## 1 16 9📈 Gráfico da importância das variáveis no xgboost
Para visualizar o que o modelo mais usou para prever dias
críticos:
Esse gráfico mostra o peso de cada variável (ex: mm_criticos,
mm_pico_neg, etc.) — ou seja, quais padrões o modelo mais considera na
hora de decidir.
library(xgboost)
xgb.plot.importance(xgb.importance(model = modelo))
🎯 3. Curva ROC (sensibilidade vs. especificidade)
A AUC (Área Sob a Curva) de 0.6364 significa que o seu modelo tem capacidade razoável de distinguir entre dias críticos e não críticos — melhor do que um chute aleatório (que seria 0.5), mas ainda com espaço para melhorias. 🧭 Como interpretar: 0.5 a 0.6: quase aleatório 0.6 a 0.7: separação modesta — sua faixa atual 0.7 a 0.8: bom desempenho Acima de 0.8: excelente discriminador
library(pROC)## Type 'citation("pROC")' for a citation.##
## Attaching package: 'pROC'## The following objects are masked from 'package:stats':
##
## cov, smooth, varroc_obj <- roc(response = y_test, predictor = pred_prob)## Setting levels: control = 0, case = 1## Setting direction: controls < casesplot(roc_obj, col = "steelblue", main = "Curva ROC – Previsão de Dias Críticos")
auc(roc_obj) # Área sob a curva — quanto mais perto de 1, melhor## Area under the curve: 0.6653Predição
✅ 1. Isolar os dados da última semana observada
Últimos 5 dias da série
ultima_data <- max(resumo_vars$data)
semana_final <- resumo_vars %>%
filter(data > (ultima_data - 7)) %>%
group_by(rua) %>%
filter(row_number(desc(data)) <= 5) %>%
arrange(rua, data)🛠️ 2. Criar observações preditivas por rua
A ideia aqui é gerar uma linha por rua com a média móvel mais recente
dos últimos 5 dias:
dados_prev <- semana_final %>%
group_by(rua) %>%
summarise(
mm_criticos = mean(minutos_criticos, na.rm = TRUE),
mm_pico_neg = mean(pico_negativo, na.rm = TRUE),
mm_pico_pos = mean(pico_positivo, na.rm = TRUE)
)🤖 3. Prever com o modelo xgboost
Matriz com as variáveis preditoras
x_prev <- as.matrix(select(dados_prev, mm_criticos, mm_pico_neg, mm_pico_pos))Probabilidades previstas
probabilidades <- predict(modelo, x_prev)Classificação binária (ajuste o threshold se quiser mais ou menos sensibilidade)
classe_prevista <- ifelse(probabilidades > 0.5, "Crítica", "Normal")Resultado final
dados_prev$prognostico_semana <- classe_prevista
dados_prev## # A tibble: 3 × 5
## rua mm_criticos mm_pico_neg mm_pico_pos prognostico_semana
## <fct> <dbl> <dbl> <dbl> <chr>
## 1 Av Brasil 50.6 33 32.6 Normal
## 2 Rua das Flores 45.4 36.2 32.2 Normal
## 3 Av Central 48 35 33.6 Normalggplot(dados_prev, aes(x = reorder(rua, -probabilidades), y = probabilidades, fill = prognostico_semana)) +
geom_col(width = 0.6) +
geom_text(aes(label = scales::percent(probabilidades, accuracy = 1)),
vjust = -0.5, size = 4) +
scale_fill_manual(values = c("Crítica" = "#E63946", "Normal" = "#2A9D8F")) +
labs(title = "Prognóstico da Semana Seguinte por Rua",
x = "Rua", y = "Probabilidade de Semana Crítica") +
theme_minimal() +
ylim(0, 1) +
theme(legend.position = "top")
Aplicando sobre dados de semanas anteriores
Função de predição
### retornando para semanas anteriores
gerar_prognostico <- function(df, modelo, semana_referencia = 0, plotar = TRUE) {
library(ggplot2)
ultima_data <- max(df$data)
data_fim <- ultima_data - weeks(semana_referencia)
data_ini <- data_fim - 4 # segunda a sexta
# Filtrar semana desejada
semana_ref <- df %>%
filter(data >= data_ini & data <= data_fim)
# Agregar variáveis por rua
dados_prev <- semana_ref %>%
group_by(rua) %>%
summarise(
mm_criticos = mean(minutos_criticos, na.rm = TRUE),
mm_pico_neg = mean(pico_negativo, na.rm = TRUE),
mm_pico_pos = mean(pico_positivo, na.rm = TRUE),
.groups = "drop"
)
# Prever com o modelo
x_pred <- as.matrix(select(dados_prev, mm_criticos, mm_pico_neg, mm_pico_pos))
prob <- predict(modelo, x_pred)
classe <- ifelse(prob > 0.5, "Crítica", "Normal")
# Adiciona colunas à tabela final
dados_prev <- dados_prev %>%
mutate(
semana_analizada = paste(format(data_ini, "%d/%m"), "a", format(data_fim, "%d/%m")),
prognostico = classe,
probabilidade = prob
)
# Gera gráfico se solicitado
if (plotar) {
p <- ggplot(dados_prev, aes(x = reorder(rua, -probabilidade), y = probabilidade, fill = prognostico)) +
geom_col(width = 0.6) +
geom_text(aes(label = scales::percent(probabilidade, accuracy = 1)),
vjust = -0.5, size = 4) +
scale_fill_manual(values = c("Crítica" = "#E63946", "Normal" = "#2A9D8F")) +
labs(title = paste("Prognóstico da Semana:", format(data_ini, "%d/%m"), "a", format(data_fim, "%d/%m")),
x = "Rua", y = "Probabilidade de Semana Crítica") +
ylim(0, 1) +
theme_minimal() +
theme(legend.position = "top")
print(p) # exibir gráfico
}
return(dados_prev) # retornar tabela também
}Prognóstico baseado na última semana observada
gerar_prognostico(resumo_dias, modelo, semana_referencia = 0)
## # A tibble: 3 × 7
## rua mm_criticos mm_pico_neg mm_pico_pos semana_analizada prognostico
## <fct> <dbl> <dbl> <dbl> <chr> <chr>
## 1 Av Brasil 50.6 33 32.6 27/06 a 01/07 Normal
## 2 Rua das Flor… 45.4 36.2 32.2 27/06 a 01/07 Normal
## 3 Av Central 48 35 33.6 27/06 a 01/07 Normal
## # ℹ 1 more variable: probabilidade <dbl>Prognóstico com base na penúltima semana
gerar_prognostico(resumo_dias, modelo, semana_referencia = 1)
## # A tibble: 3 × 7
## rua mm_criticos mm_pico_neg mm_pico_pos semana_analizada prognostico
## <fct> <dbl> <dbl> <dbl> <chr> <chr>
## 1 Av Brasil 60.2 38.6 40 20/06 a 24/06 Normal
## 2 Rua das Flor… 60.4 40.6 40.8 20/06 a 24/06 Crítica
## 3 Av Central 54.6 40 36.8 20/06 a 24/06 Normal
## # ℹ 1 more variable: probabilidade <dbl>Prognóstico com base na ante penúltima semana
gerar_prognostico(resumo_dias, modelo, semana_referencia = 2)
## # A tibble: 3 × 7
## rua mm_criticos mm_pico_neg mm_pico_pos semana_analizada prognostico
## <fct> <dbl> <dbl> <dbl> <chr> <chr>
## 1 Av Brasil 68.2 43.8 47.2 13/06 a 17/06 Crítica
## 2 Rua das Flor… 58.8 38.4 40.6 13/06 a 17/06 Normal
## 3 Av Central 58.8 41.4 40.4 13/06 a 17/06 Crítica
## # ℹ 1 more variable: probabilidade <dbl>Prognóstico com base em semanas anteriores
gerar_prognostico(resumo_dias, modelo, semana_referencia = 4)
## # A tibble: 3 × 7
## rua mm_criticos mm_pico_neg mm_pico_pos semana_analizada prognostico
## <fct> <dbl> <dbl> <dbl> <chr> <chr>
## 1 Av Brasil 61.2 37.8 39 30/05 a 03/06 Normal
## 2 Rua das Flor… 65.6 43 42.8 30/05 a 03/06 Normal
## 3 Av Central 57.4 41.4 37.6 30/05 a 03/06 Normal
## # ℹ 1 more variable: probabilidade <dbl>gerar_prognostico(resumo_dias, modelo, semana_referencia = 5)
## # A tibble: 3 × 7
## rua mm_criticos mm_pico_neg mm_pico_pos semana_analizada prognostico
## <fct> <dbl> <dbl> <dbl> <chr> <chr>
## 1 Av Brasil 54 38.8 36.6 23/05 a 27/05 Normal
## 2 Rua das Flor… 64.8 43.4 42.8 23/05 a 27/05 Normal
## 3 Av Central 61.2 41.8 40.2 23/05 a 27/05 Normal
## # ℹ 1 more variable: probabilidade <dbl>gerar_prognostico(resumo_dias, modelo, semana_referencia = 6)
## # A tibble: 3 × 7
## rua mm_criticos mm_pico_neg mm_pico_pos semana_analizada prognostico
## <fct> <dbl> <dbl> <dbl> <chr> <chr>
## 1 Av Brasil 63.2 45 41.6 16/05 a 20/05 Normal
## 2 Rua das Flor… 57.8 44 40.8 16/05 a 20/05 Normal
## 3 Av Central 56 40.8 36.2 16/05 a 20/05 Normal
## # ℹ 1 more variable: probabilidade <dbl>gerar_prognostico(resumo_dias, modelo, semana_referencia = 7)
## # A tibble: 3 × 7
## rua mm_criticos mm_pico_neg mm_pico_pos semana_analizada prognostico
## <fct> <dbl> <dbl> <dbl> <chr> <chr>
## 1 Av Brasil 64.2 45.2 43.6 09/05 a 13/05 Normal
## 2 Rua das Flor… 56.4 41.6 36.4 09/05 a 13/05 Normal
## 3 Av Central 66.4 43.4 45.8 09/05 a 13/05 Crítica
## # ℹ 1 more variable: probabilidade <dbl>gerar_prognostico(resumo_dias, modelo, semana_referencia = 8)
## # A tibble: 3 × 7
## rua mm_criticos mm_pico_neg mm_pico_pos semana_analizada prognostico
## <fct> <dbl> <dbl> <dbl> <chr> <chr>
## 1 Av Brasil 59.6 38 39.2 02/05 a 06/05 Normal
## 2 Rua das Flor… 58.6 43.8 37.6 02/05 a 06/05 Normal
## 3 Av Central 53.6 39.8 37 02/05 a 06/05 Normal
## # ℹ 1 more variable: probabilidade <dbl>gerar_prognostico(resumo_dias, modelo, semana_referencia = 9)
## # A tibble: 3 × 7
## rua mm_criticos mm_pico_neg mm_pico_pos semana_analizada prognostico
## <fct> <dbl> <dbl> <dbl> <chr> <chr>
## 1 Av Brasil 63.2 42.8 44.2 25/04 a 29/04 Crítica
## 2 Rua das Flor… 61.2 44.6 40.2 25/04 a 29/04 Normal
## 3 Av Central 61.2 40.8 39.4 25/04 a 29/04 Normal
## # ℹ 1 more variable: probabilidade <dbl>