Relatório de Modelo: Seasonal Mean Baseline

Análise de Desempenho e Comparação com SNaive

1. Introdução

1.1 Objetivo

Este relatório analisa o desempenho do modelo Seasonal Mean (Média Sazonal), que serve como uma alternativa de baseline para o sistema de previsão. Diferente do Seasonal Naive (que usa apenas o último ano), o Seasonal Mean utiliza a média de todos os anos anteriores para a mesma semana epidemiológica.

1.2 Metodologia

• Modelo: Seasonal Mean
• Estratégia: Rolling Replication (Janela deslizante)
• Horizontes de Previsão: 4, 6 e 8 semanas
• Comparativo: Comparação direta com o modelo Seasonal Naive
• Métricas: RMSE, MAE, MAPE, RMSLE, MASE

2. Dados e Preparação

# 1. Carregar dados brutos
df_raw <- load_raw_data()

#> [2026-01-11 14:46:36] INFO: Carregando dados de: /Users/caiosainvallio/ses-sp/forecast_dengue/data/raw/dengue.RData 
#> [2026-01-11 14:46:36] INFO: Dados carregados: 248865 linhas, 23 colunas

# 2. Agregar por estado
df_state <- aggregate_state(df_raw)

#> [2026-01-11 14:46:36] INFO: Agregando dados por estado... 
#> [2026-01-11 14:46:37] INFO: Dados agregados: 626 semanas

# 3. Preprocessamento (garante coluna 'semana')
df <- preprocess_data(df_state)

#> [2026-01-11 14:46:37] INFO: ========== INICIO: Preprocessamento ========== 
#> [2026-01-11 14:46:37] INFO: Removidas 3 linhas da semana 53 
#> [2026-01-11 14:46:37] WARN: Semanas faltantes detectadas: 2 
#> [2026-01-11 14:46:37] WARN: ATENCAO: Alvo nao sera imputado (sera mantido como NA) 
#> [2026-01-11 14:46:37] INFO: Imputados 8 NAs em mean_temp (fill) 
#> [2026-01-11 14:46:37] INFO: Imputados 8 NAs em mean_max_temp (fill) 
#> [2026-01-11 14:46:37] INFO: Imputados 8 NAs em mean_min_temp (fill) 
#> [2026-01-11 14:46:37] INFO: Imputados 8 NAs em mean_precip (fill) 
#> [2026-01-11 14:46:37] INFO: Dados preprocessados: 625 linhas 
#> [2026-01-11 14:46:37] INFO: ========== FIM: Preprocessamento ==========

# NOTA: Seasonal Mean NÃO precisa de features externas
# Usa apenas a média histórica por semana epidemiológica
# Por isso, NÃO chamamos make_features() aqui

df_features <- df  # Usar dados preprocessados diretamente

# Verificar coluna semana
if (!"semana" %in% names(df_features)) {
    stop("Erro: Coluna 'semana' não encontrada no dataframe.")
}

# Visualizar estrutura
glimpse(df_features |> select(data_iniSE, est_inc100k, semana, ano))

#> Rows: 625
#> Columns: 4
#> $ data_iniSE  <date> 2014-01-05, 2014-01-12, 2014-01-19, 2014-01-26, 2014-02-0…
#> $ est_inc100k <dbl> 4.688448, 5.657748, 6.589646, 8.467320, 10.189317, 14.3069…
#> $ semana      <dbl> 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18…
#> $ ano         <dbl> 2014, 2014, 2014, 2014, 2014, 2014, 2014, 2014, 2014, 2014…

3. Definição do Modelo

O modelo calcula, para cada semana epidemiológica (1 a 52/53), a média e o desvio padrão da incidência histórica.

\[ \hat{y}_{t+h} = \frac{1}{N} \sum_{k=1}^{N} y_{t+h-52k} \]

# Carregar definicao do modelo
model_name <- "seasonal_mean"
model <- get_model(model_name)

cat(sprintf(
    "Modelo: %s\nFamília: %s\nDescrição: %s",
    model$name, model$family, model$description
))

#> Modelo: seasonal_mean
#> Família: baseline
#> Descrição: Previsao usando media historica da mesma semana

4. Backtesting

Utilizando a mesma configuração de backtesting do relatório anterior para garantir comparabilidade justa.

# Configuracao do Backtest (Idêntica ao SNaive)
backtest_config <- list(
    backtest = list(
        horizons = c(4, 6, 8),
        initial_window = 52 * 5, # 5 anos de treino inicial
        step = 4 # Avancar a cada 4 semanas
    ),
    data = list(
        date_col = "data_iniSE",
        target = "est_inc100k"
    )
)

# Executar Backtest
bt_result <- run_backtest(
    model_name = model_name,
    data = df_features,
    config = backtest_config,
    verbose = FALSE
)

# Resumo
print(bt_result)

#> 
#> === Resultado de Backtest ===
#> 
#> Modelo: seasonal_mean 
#> Origens: 90 
#> Previsoes: 270 
#> Duracao: 0.2 s
#> 
#> Metricas por Horizonte:
#>  h      mae     rmse     mape    smape     mase    rmsle  n
#>  4 39.03079 91.28455 65.00128 75.74619 1.152442 1.064149 90
#>  6 39.98816 88.40755 72.13843 80.60621 1.180710 1.178472 90
#>  8 43.82470 96.81703 93.80530 88.47015 1.293990 1.331503 90

5. Avaliação de Desempenho

5.1 Métricas por Horizonte

bt_result$metrics |>
    mutate(
        across(where(is.numeric), \(x) round(x, 4)),
        h_desc = paste(h, "semanas")
    ) |>
    select(Horizonte = h_desc, RMSE = rmse, MAE = mae, MAPE = mape, RMSLE = rmsle, MASE = mase) |>
    kable() |>
    kable_styling(bootstrap_options = c("striped", "hover"))

Horizonte	RMSE	MAE	MAPE	RMSLE	MASE
4 semanas	91.2846	39.0308	65.0013	1.0641	1.1524
6 semanas	88.4075	39.9882	72.1384	1.1785	1.1807
8 semanas	96.8170	43.8247	93.8053	1.3315	1.2940

5.2 Comparação com Baseline (SNaive)

Abaixo comparamos o desempenho do Seasonal Mean com o Seasonal Naive (execução anterior).

# Carregar metricas salvas
metrics_path <- file.path(PROJECT_ROOT, "data", "model_metrics.RData")

if (file.exists(metrics_path)) {
    load(metrics_path)

    # Pegar a ultima execucao do SNaive
    snaive_metrics <- model_metrics |>
        filter(model_name == "seasonal_naive") |>
        arrange(desc(execution_date)) |>
        slice(1)

    # Criar tabela de comparacao para horizonte 4 semanas
    comparison <- data.frame(
        Métrica = c("RMSE (4 sem)", "MAE (4 sem)", "MAPE (4 sem)", "RMSLE (4 sem)"),
        SNaive = c(
            snaive_metrics$horizon_4w_rmse,
            snaive_metrics$horizon_4w_mae,
            snaive_metrics$horizon_4w_mape,
            snaive_metrics$horizon_4w_rmsle
        ),
        Seasonal_Mean = c(
            bt_result$metrics[bt_result$metrics$h == 4, "rmse"],
            bt_result$metrics[bt_result$metrics$h == 4, "mae"],
            bt_result$metrics[bt_result$metrics$h == 4, "mape"],
            bt_result$metrics[bt_result$metrics$h == 4, "rmsle"]
        )
    )

    comparison |>
        mutate(
            Diferença = Seasonal_Mean - SNaive,
            Melhor = ifelse(Seasonal_Mean < SNaive, "Seasonal Mean", "SNaive"),
            `% Melhoria` = ifelse(SNaive > 0, (SNaive - Seasonal_Mean) / SNaive * 100, 0)
        ) |>
        mutate(across(where(is.numeric), \(x) round(x, 4))) |>
        kable(caption = "Comparativo Direto: SNaive vs Seasonal Mean (Horizonte 4 semanas)") |>
        kable_styling(bootstrap_options = "striped") |>
        column_spec(5, bold = TRUE, color = ifelse(comparison$Seasonal_Mean < comparison$SNaive, "green", "red"))
} else {
    cat("Arquivo de métricas anteriores não encontrado. Execute o relatório 01_seasonal_naive.qmd primeiro.")
}

Comparativo Direto: SNaive vs Seasonal Mean (Horizonte 4 semanas)

Métrica	SNaive	Seasonal_Mean	Diferença	Melhor	% Melhoria
RMSE (4 sem)	96.3101	91.2846	-5.0256	Seasonal Mean	5.2181
MAE (4 sem)	42.7400	39.0308	-3.7093	Seasonal Mean	8.6786
MAPE (4 sem)	66.1433	65.0013	-1.1420	Seasonal Mean	1.7266
RMSLE (4 sem)	0.9683	1.0641	0.0958	SNaive	-9.8944

5.3 Análise Visual (4 semanas)

# Extrair previsoes de multiplos horizontes
preds_multi <- bind_rows(
  extract_predictions(bt_result, horizon = 4) |> mutate(horizon = "4 semanas"),
  extract_predictions(bt_result, horizon = 6) |> mutate(horizon = "6 semanas"),
  extract_predictions(bt_result, horizon = 8) |> mutate(horizon = "8 semanas")
)

# Plot estatico para ser convertido em interativo
p_backtest <- ggplot() +
  geom_line(data = preds_multi, aes(x = target_date, y = actual), color = "black", size = 0.5) +
  geom_line(data = preds_multi, aes(x = target_date, y = predicted, color = horizon), size = 0.5, alpha = 0.8) +
  scale_color_manual(values = c("4 semanas" = "#E74C3C", "6 semanas" = "#3498DB", "8 semanas" = "#2ECC71")) +
  labs(title = "Backtest: Previsões Multi-Horizonte",
       x = "Data", y = "Incidência") +
  theme_minimal()

ggplotly(p_backtest) |>
  layout(legend = list(orientation = "h", x = 0.5, xanchor = "center", y = -0.2))

5.3 Erros por Regime Epidemiológico

É importante avaliar se o modelo erra mais em picos epidêmicos ou em períodos de baixa transmissão.

# Adicionar classificacao de regime aos resultados
preds_all <- bt_result$predictions
preds_all$regime <- classify_regime(preds_all$actual)

# Calcular metricas por regime
metrics_regime <- compute_metrics_by_regime(preds_all)

metrics_regime |>
  mutate(across(where(is.numeric), \(x) round(x, 3))) |>
  datatable(options = list(dom = 't'))

6. Previsão Futura

Gerando previsões para as próximas semanas com o modelo treinado em todos os dados disponíveis até 2 semanas atrás, simulando o atraso real de notificação do SINAN.

# Definir atraso de notificação (semanas a ignorar)
delay_weeks <- 2
last_reliable_date <- max(df_features$data_iniSE) - (delay_weeks * 7)

# Filtrar dados para treino final (removendo ultimas semanas incompletas)
df_final <- df_features |> 
  filter(data_iniSE <= last_reliable_date)

cat(sprintf("Ignorando últimas %d semanas devido ao atraso de notificação.\n", delay_weeks))

#> Ignorando últimas 2 semanas devido ao atraso de notificação.

cat(sprintf("Treinando modelo com dados até: %s\n", last_reliable_date))

#> Treinando modelo com dados até: 2025-12-07

# Treinar com dados confiaveis
model_fit <- model$fit(df_final, list(week_col = "semana"))

# Datas para previsão (seguindo padrão SARIMA: iniciando após o último dado disponível, T+1)
# O modelo foi treinado até T-2, mas projetamos 8 semanas à frente para cobrir 
# o período de nowcast (T-1, T) e futuro (T+1..T+6), rotulando como T+1..T+8
last_date <- max(df_features$data_iniSE)
future_dates <- seq(
  from = last_date + 7,
  by = "week",
  length.out = 8
)

# Previsao
forecast_h8 <- model$predict(model_fit, h = 8, new_data = df_final)
intervals <- model$predict_interval(model_fit, h = 8, level = 0.95, new_data = df_final)

forecast_df <- data.frame(
  Data = future_dates,
  Semana_Epidem = lubridate::epiweek(future_dates),
  Previsao = round(forecast_h8, 2),
  Inferior_95 = round(intervals$lower, 2),
  Superior_95 = round(intervals$upper, 2)
)

forecast_df |>
  kable(caption = "Previsão Seasonal Mean - Próximas 8 Semanas") |>
  kable_styling(full_width = FALSE, bootstrap_options = c("striped", "hover"))

Previsão Seasonal Mean - Próximas 8 Semanas

Data	Semana_Epidem	Previsao	Inferior_95	Superior_95
2025-12-28	53	11.79	5.62	17.95
2026-01-04	1	12.89	6.08	19.69
2026-01-11	2	20.46	8.72	32.20
2026-01-18	3	24.54	9.64	39.44
2026-01-25	4	30.69	12.99	48.38
2026-02-01	5	37.79	15.82	59.76
2026-02-08	6	45.65	19.43	71.87
2026-02-15	7	53.87	23.28	84.46

# Dados históricos usados no treino (até T-2)
history_train <- df_features |> 
  filter(data_iniSE <= last_reliable_date) |>
  tail(104) |> 
  select(Date = data_iniSE, Value = est_inc100k) |>
  mutate(Type = "Histórico", Lower = NA, Upper = NA)

# Dados recentes ignorados no treino (T-2 a T)
history_ignored <- df_features |> 
  filter(data_iniSE > last_reliable_date) |>
  select(Date = data_iniSE, Value = est_inc100k) |>
  mutate(Type = "Provisório (Ignorado)", Lower = NA, Upper = NA)

# Previsão do modelo (T-2 a T+6)
future_viz <- data.frame(
  Date = future_dates,
  Value = forecast_h8,
  Lower = intervals$lower,
  Upper = intervals$upper,
  Type = "Previsão (Seasonal Mean)"
)

# Combinar para plot
viz_df <- bind_rows(history_train, history_ignored, future_viz)

p_future <- ggplot(viz_df, aes(x = Date, y = Value, color = Type)) +
  geom_line(aes(linetype = Type)) +
  geom_ribbon(aes(ymin = Lower, ymax = Upper, fill = Type), alpha = 0.2, color = NA) +
  geom_point(data = filter(viz_df, Type == "Provisório (Ignorado)"), size = 2) +
  scale_color_manual(values = c(
    "Histórico" = "black", 
    "Previsão (Seasonal Mean)" = "blue",
    "Provisório (Ignorado)" = "gray"
  )) +
  scale_fill_manual(values = c(
    "Histórico" = NA, 
    "Previsão (Seasonal Mean)" = "blue",
    "Provisório (Ignorado)" = NA
  )) +
  scale_linetype_manual(values = c(
    "Histórico" = "solid",
    "Previsão (Seasonal Mean)" = "solid",
    "Provisório (Ignorado)" = "dashed"
  )) +
  labs(title = "Previsão Seasonal Mean - Próximas 8 Semanas",
       subtitle = "Previsão gerada ignorando as últimas 2 semanas (simulação)",
       y = "Incidência / 100k hab") +
  theme_minimal() +
  theme(legend.position = "bottom")

ggplotly(p_future) |>
  layout(legend = list(orientation = "h", x = 0.5, xanchor = "center"))

7. Salvamento e Registro

7.1 Salvar Modelo

models_dir <- file.path(PROJECT_ROOT, "data", "models")
if (!dir.exists(models_dir)) dir.create(models_dir, recursive = TRUE)

saveRDS(model_fit, file.path(models_dir, "seasonal_mean.rds"))
cat("Modelo salvo em data/models/seasonal_mean.rds\n")

#> Modelo salvo em data/models/seasonal_mean.rds

7.2 Atualizar Leaderboard

metrics_path <- file.path(PROJECT_ROOT, "data", "model_metrics.RData")

new_entry <- data.frame(
    model_name = "seasonal_mean",
    execution_date = Sys.time(),
    horizon_4w_rmse = bt_result$metrics[bt_result$metrics$h == 4, "rmse"],
    horizon_4w_mae = bt_result$metrics[bt_result$metrics$h == 4, "mae"],
    horizon_4w_mape = bt_result$metrics[bt_result$metrics$h == 4, "mape"],
    horizon_4w_rmsle = bt_result$metrics[bt_result$metrics$h == 4, "rmsle"],
    horizon_8w_rmse = bt_result$metrics[bt_result$metrics$h == 8, "rmse"],
    horizon_8w_mae = bt_result$metrics[bt_result$metrics$h == 8, "mae"],
    horizon_8w_mape = bt_result$metrics[bt_result$metrics$h == 8, "mape"],
    horizon_8w_rmsle = bt_result$metrics[bt_result$metrics$h == 8, "rmsle"],
    avg_rmse = mean(bt_result$metrics$rmse),
    avg_mape = mean(bt_result$metrics$mape)
)

if (file.exists(metrics_path)) {
    load(metrics_path)

    # Remove anterior do mesmo dia se houver (para evitar duplicação em desenvolvimento)
    # Mas aqui vou apenas adicionar
    model_metrics <- rbind(model_metrics, new_entry)
} else {
    model_metrics <- new_entry
}

save(model_metrics, file = metrics_path)

# Mostrar Leaderboard Atual
model_metrics |>
    group_by(model_name) |>
    slice(which.max(execution_date)) |>
    ungroup() |>
    select(Modelo = model_name, RMSE_4w = horizon_4w_rmse, MAPE_4w = horizon_4w_mape, RMSLE_4w = horizon_4w_rmsle) |>
    arrange(RMSE_4w) |>
    kable(caption = "Leaderboard de Modelos (Melhores Métricas Recentes)")

Leaderboard de Modelos (Melhores Métricas Recentes)

Modelo	RMSE_4w	MAPE_4w	RMSLE_4w
seasonal_mean	91.28455	65.00128	1.0641488
seasonal_naive	96.31014	66.14327	0.9683374

8. Conclusão

A comparação entre Seasonal Mean e Seasonal Naive revela qual estratégia é mais adequada para a série histórica: - Se SNaive for melhor, indica que o passado imediato (ano anterior) é o melhor preditor (série com mudança de regime forte ou tendência evolutiva). - Se Seasonal Mean for melhor, indica que o padrão sazonal é estável ao longo dos anos e a média suaviza ruídos de anos atípicos.

Note

Modelos baseados em média tendem a ser mais conservadores e roubustos a outliers, mas podem falhar em capturar mudanças abruptas de nível (como grandes epidemias recentes que fogem da média histórica).