#install.packages("tidyverse")
#install.packages("janitor")
#install.packages("rio")
#install.packages("here")
#install.packages("haven")
#install.packages("reshape2")
#install.packages("Synth")
#install.packages("SCtools")
#install.packages("kableExtra")
#install.packages("flextable")
#install.packages("lubridate")
rm(list = ls()) # apaga tudo do enverioment
options(scipen = 999) # deixa números em decimal ao invés da notação estranha do R.
library(tidyverse)
## Warning: package 'tidyverse' was built under R version 4.4.3
## Warning: package 'ggplot2' was built under R version 4.4.3
## Warning: package 'tibble' was built under R version 4.4.3
## Warning: package 'tidyr' was built under R version 4.4.3
## Warning: package 'readr' was built under R version 4.4.3
## Warning: package 'purrr' was built under R version 4.4.3
## Warning: package 'dplyr' was built under R version 4.4.3
## Warning: package 'stringr' was built under R version 4.4.3
## Warning: package 'forcats' was built under R version 4.4.3
## Warning: package 'lubridate' was built under R version 4.4.3
## ── 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.2 ✔ tibble 3.3.0
## ✔ lubridate 1.9.4 ✔ tidyr 1.3.1
## ✔ purrr 1.1.0
## ── 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 errors
library(janitor)
## Warning: package 'janitor' was built under R version 4.4.3
##
## Attaching package: 'janitor'
##
## The following objects are masked from 'package:stats':
##
## chisq.test, fisher.test
library(rio)
## Warning: package 'rio' was built under R version 4.4.3
library(here)
## Warning: package 'here' was built under R version 4.4.3
## here() starts at G:/My Drive/Analysis/UFAL_Saude mental
library(haven)
## Warning: package 'haven' was built under R version 4.4.3
library(flextable)
## Warning: package 'flextable' was built under R version 4.4.3
##
## Attaching package: 'flextable'
##
## The following object is masked from 'package:purrr':
##
## compose
library(knitr)
## Warning: package 'knitr' was built under R version 4.4.3
library(kableExtra)
## Warning: package 'kableExtra' was built under R version 4.4.3
##
## Attaching package: 'kableExtra'
##
## The following objects are masked from 'package:flextable':
##
## as_image, footnote
##
## The following object is masked from 'package:dplyr':
##
## group_rows
library(haven)
library(tidyverse)
library(Synth)
## Warning: package 'Synth' was built under R version 4.4.3
## ##
## ## Synth Package: Implements Synthetic Control Methods.
##
## ## See https://web.stanford.edu/~jhain/synthpage.html for additional information.
library(SCtools)
## Warning: package 'SCtools' was built under R version 4.4.3
## Loading required package: future
## Warning: package 'future' was built under R version 4.4.3
library(lubridate)
nba <- import("PlayerStatistics.csv")
medias_jogadores <- import("nba_per_season.csv")
#Game Score = (Pontos) + (0.4 * FG) - (0.7 * FGA) - (0.4 * (FTA - FT)) + (0.7 * OR) + (0.3 * DR) + ST + (0.7 * BLK) - 0.4 * (PF -T)
nba$gameDate <- as.POSIXct(nba$gameDate, format="%Y-%m-%d %H:%M:%S")
nba$ano <- format(nba$gameDate, "%Y")
nba$mes <- format(nba$gameDate, "%m")
nba$dia <- format(nba$gameDate, "%d")
nba <- nba %>%
mutate(
game_score = points +
0.4 * fieldGoalsMade -
0.7 * fieldGoalsAttempted -
0.4 * (freeThrowsAttempted - freeThrowsMade) +
0.7 * reboundsOffensive +
0.3 * reboundsDefensive +
steals +
0.7 * assists +
0.7 * blocks -
0.4 * foulsPersonal -
turnovers
)%>%
mutate(Temporada = case_when(
as.numeric(mes) > 7 ~ as.numeric(ano) + 1,
as.numeric(mes) <= 7 ~ as.numeric(ano)
))
nbaregular <- nba %>%
filter(gameType == "Regular Season")
#Kevin Love ----
# 5; 15; 45; 82; 164
nbaregular %>% tabyl(playerteamCity)
## playerteamCity n percent
## Atlanta 51282 0.0348761767
## Baltimore 7557 0.0051394109
## Boston 64968 0.0441838354
## Brooklyn 13191 0.0089710161
## Buffalo 6224 0.0042328560
## Capital 739 0.0005025836
## Charlotte 33037 0.0224680053
## Chicago 54426 0.0370143675
## Cincinnati 11333 0.0077074161
## Cleveland 49695 0.0337968800
## Dallas 41883 0.0284840472
## Denver 45583 0.0310003659
## Detroit 59519 0.0404780461
## Ft. Wayne Zollner 4778 0.0032494515
## Golden State 49094 0.0333881483
## Houston 48973 0.0333058579
## Indiana 45696 0.0310772156
## Kansas City 8453 0.0057487680
## Kansas City-Omaha 2424 0.0016485288
## Los Angeles 95174 0.0647265170
## Memphis 23953 0.0162901030
## Miami 35205 0.0239424321
## Milwaukee 54416 0.0370075666
## Minneapolis 6864 0.0046681112
## Minnesota 34561 0.0235044566
## New Jersey 30913 0.0210235024
## New Orleans 25046 0.0170334371
## New York 65716 0.0446925399
## Oklahoma City 19158 0.0130290900
## Orlando 34229 0.0232786680
## Philadelphia 62709 0.0426475209
## Phoenix 52004 0.0353671989
## Portland 50003 0.0340063466
## Rochester 4738 0.0032222481
## Sacramento 37897 0.0257732239
## San Antonio 45107 0.0306766449
## San Diego 8042 0.0054692526
## San Francisco 6774 0.0046069034
## Seattle 35525 0.0241600596
## St. Louis 9596 0.0065261065
## Syracuse 8704 0.0059194696
## Toronto 29431 0.0200156148
## Tri-Cities 677 0.0004604183
## Utah 43140 0.0293389155
## Vancouver 5361 0.0036459417
## Washington 46604 0.0316947338
KevinLove <- nbaregular %>%
filter(playerteamCity == "Cleveland")%>%
filter(firstName == "Kevin" & lastName == "Love")%>%
# ordenação por data do jogo, após o filtro
arrange(gameDate) %>%
mutate(Temporada = case_when(
as.numeric(mes) > 7 ~ as.numeric(ano) + 1,
as.numeric(mes) <= 7 ~ as.numeric(ano)
))%>%
# Adiciona o índice da série temporal, que é importante para a análise
mutate(game_index = row_number())
linha_central <- 238
evento_indice <- 238
#KevinLove <- KevinLove %>%
# mutate(
# linha_atual = row_number(),
# distancia = linha_central - linha_atual,
# modulo = abs(distancia)
# )
#KevinLove5 <- KevinLove %>%
# filter(modulo <= 5)%>%
# mutate(per = case_when(
# distancia > 0 ~ "Post",
# distancia < 0 ~ "Neg",
# TRUE ~ "Evento"
# ))%>%
# mutate(Med = mean(game_score))
#KevinLove15 <- KevinLove %>%
# filter(modulo <= 15)%>%
# mutate(per = case_when(
# distancia > 0 ~ "Post",
# distancia < 0 ~ "Neg",
# TRUE ~ "Evento"
# ))%>%
# mutate(Med = mean(game_score))
#KevinLove45 <- KevinLove %>%
# filter(modulo <= 45)%>%
# mutate(per = case_when(
# distancia > 0 ~ "Post",
# distancia < 0 ~ "Neg",
# TRUE ~ "Evento"
# ))%>%
# mutate(Med = mean(game_score))
#KevinLove82 <- KevinLove %>%
# filter(modulo <= 82)%>%
# mutate(per = case_when(
# distancia > 0 ~ "Post",
# distancia < 0 ~ "Neg",
# TRUE ~ "Evento"
# ))%>%
# mutate(Med = mean(game_score))
#KevinLove164 <- KevinLove %>%
# filter(modulo <= 164)%>%
# mutate(per = case_when(
# distancia > 0 ~ "Post",
# distancia < 0 ~ "Neg",
# TRUE ~ "Evento"
# ))%>%
# mutate(Med = mean(game_score))
## Gráficos Kevin Love ----
#ggplot(KevinLove5, aes(x = distancia, y = game_score, color = per)) +
# geom_point(size = 2, alpha = 0.7) +
# geom_vline(xintercept = 0, linetype = "dashed", color = "black") + # linha do evento
# geom_hline(aes(yintercept = Med), linetype = "dotted", color = "gray30") + # média geral
# geom_smooth(method = "lm", se = FALSE) + # tendência linear por grupo
# scale_color_manual(values = c("Neg" = "#1f77b4", "Evento" = "#ff7f0e", "Post" = "#2ca02c")) +
# labs(
# title = "Game Score de Kevin Love - ITC em torno do Evento",
# subtitle = "Comparação de desempenho antes e depois do evento (±5 jogos)",
# x = "Distância em jogos do evento (linha 238)",
# y = "Game Score",
# color = "Período"
# ) +
# theme_minimal(base_size = 13)
#modelo5 <- lm(game_score ~ distancia * per, data = KevinLove5 %>% filter(per != "Evento"))
#summary(modelo5)
#ggplot(KevinLove15, aes(x = distancia, y = game_score, color = per)) +
# geom_point(size = 2, alpha = 0.7) +
# geom_vline(xintercept = 0, linetype = "dashed", color = "black") + # linha do evento
# geom_hline(aes(yintercept = Med), linetype = "dotted", color = "gray30") + # média geral
# geom_smooth(method = "lm", se = FALSE) + # tendência linear por grupo
# scale_color_manual(values = c("Neg" = "#1f77b4", "Evento" = "#ff7f0e", "Post" = "#2ca02c")) +
# labs(
# title = "Game Score de Kevin Love - ITC em torno do Evento",
# subtitle = "Comparação de desempenho antes e depois do evento (±15 jogos)",
# x = "Distância em jogos do evento (linha 238)",
# y = "Game Score",
# color = "Período"
# ) +
# theme_minimal(base_size = 13)
#modelo15 <- lm(game_score ~ distancia * per, data = KevinLove15 %>% filter(per != "Evento"))
#summary(modelo15)
#ggplot(KevinLove45, aes(x = distancia, y = game_score, color = per)) +
# geom_point(size = 2, alpha = 0.7) +
# geom_vline(xintercept = 0, linetype = "dashed", color = "black") + # linha do evento
# geom_hline(aes(yintercept = Med), linetype = "dotted", color = "gray30") + # média geral
# geom_smooth(method = "lm", se = FALSE) + # tendência linear por grupo
# scale_color_manual(values = c("Neg" = "#1f77b4", "Evento" = "#ff7f0e", "Post" = "#2ca02c")) +
# labs(
# title = "Game Score de Kevin Love - ITC em torno do Evento",
# subtitle = "Comparação de desempenho antes e depois do evento (±45 jogos)",
# x = "Distância em jogos do evento (linha 238)",
# y = "Game Score",
# color = "Período"
# ) +
# theme_minimal(base_size = 13)
#modelo45 <- lm(game_score ~ distancia * per, data = KevinLove45 %>% filter(per != "Evento"))
#summary(modelo45)
#ggplot(KevinLove82, aes(x = distancia, y = game_score, color = per)) +
# geom_point(size = 2, alpha = 0.7) +
# geom_vline(xintercept = 0, linetype = "dashed", color = "black") + # linha do evento
# geom_hline(aes(yintercept = Med), linetype = "dotted", color = "gray30") + # média geral
# geom_smooth(method = "lm", se = FALSE) + # tendência linear por grupo
# scale_color_manual(values = c("Neg" = "#1f77b4", "Evento" = "#ff7f0e", "Post" = "#2ca02c")) +
# labs(
# title = "Game Score de Kevin Love - ITC em torno do Evento",
# subtitle = "Comparação de desempenho antes e depois do evento (±82 jogos)",
# x = "Distância em jogos do evento (linha 238)",
# y = "Game Score",
# color = "Período"
# ) +
# theme_minimal(base_size = 13)
#modelo82 <- lm(game_score ~ distancia * per, data = KevinLove82 %>% filter(per != "Evento"))
#summary(modelo82)
#ggplot(KevinLove164, aes(x = distancia, y = game_score, color = per)) +
# geom_point(size = 2, alpha = 0.7) +
# geom_vline(xintercept = 0, linetype = "dashed", color = "black") + # linha do evento
# geom_hline(aes(yintercept = Med), linetype = "dotted", color = "gray30") + # média geral
# geom_smooth(method = "lm", se = FALSE) + # tendência linear por grupo
# scale_color_manual(values = c("Neg" = "#1f77b4", "Evento" = "#ff7f0e", "Post" = "#2ca02c")) +
# labs(
# title = "Game Score de Kevin Love - ITC em torno do Evento",
# subtitle = "Comparação de desempenho antes e depois do evento (±164 jogos)",
# x = "Distância em jogos do evento (linha 238)",
# y = "Game Score",
# color = "Período"
# ) +
# theme_minimal(base_size = 13)
#modelo164 <- lm(game_score ~ distancia * per, data = KevinLove164 %>% filter(per != "Evento"))
#summary(modelo164)
########
#Tentativa de verificar estas informações com análises ligeiramente diferentes
# ao invés de atribuírmos uma janela de tempo de jogos individualmente, vamos
# tentar verificar isso de uma vez só.
#além disso, eu estava pensando, que o tempo de quadra pode ser uma variável de controle
#importante, vamos tentar aqui
#install.packages(("changepoint"))
library(changepoint)
## Warning: package 'changepoint' was built under R version 4.4.3
## Loading required package: zoo
## Warning: package 'zoo' was built under R version 4.4.3
##
## Attaching package: 'zoo'
##
## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric
##
## Successfully loaded changepoint package version 2.3
## WARNING: From v.2.3 the default method in cpt.* functions has changed from AMOC to PELT.
## See NEWS for details of all changes.
# Executa a análise para detectar pontos de mudança na média
# O parâmetro 'method' permite escolher o algoritmo de detecção
analise_cpt <- cpt.mean(KevinLove$game_score, method = "AMOC")
print(analise_cpt)
## Class 'cpt' : Changepoint Object
## ~~ : S4 class containing 12 slots with names
## cpttype date version data.set method test.stat pen.type pen.value minseglen cpts ncpts.max param.est
##
## Created on : Thu Aug 7 11:28:30 2025
##
## summary(.) :
## ----------
## Created Using changepoint version 2.3
## Changepoint type : Change in mean
## Method of analysis : AMOC
## Test Statistic : Normal
## Type of penalty : MBIC with value, 18.81863
## Minimum Segment Length : 1
## Maximum no. of cpts : 1
## Changepoint Locations : 493
plot(analise_cpt)
# Adiciona uma linha vertical para marcar o jogo do evento, facilitando a comparação visual.
abline(v = linha_central, col = "blue", lty = 2)
# Extrai o ponto de mudança detectado
pontos_de_mudanca <- cpts(analise_cpt)
# Imprime o resultado para interpretação
cat("\nO ponto de mudança detectado na série é no jogo de índice:", pontos_de_mudanca, "\n")
##
## O ponto de mudança detectado na série é no jogo de índice: 493
cat("O evento de pânico ocorreu no jogo de índice:", linha_central, "\n")
## O evento de pânico ocorreu no jogo de índice: 238
# Se o 'ponto_de_mudanca_detectado' estiver próximo ou for o mesmo que 'evento_indice',
# isso sugere uma forte correlação temporal.
#você vai perceber pelo gráfico gerado que este ponto de mudança não foi próximo do evento.
#temos que interpretar isso de forma a entender que o evento em sí, considerando a
#série de jogos do KL não causou nenhuma mudança significativa. Mas temos outras possibilidades.
#COLOCANDO O TEMPO DE QUADRA COMO UMA VARIÁVEL CONTROLE NO MODELO
KevinLove_com_eficiencia <- KevinLove %>%
mutate(
game_score_por_minuto = case_when(
numMinutes > 0 ~ game_score / numMinutes,
TRUE ~ 0 # Define o valor como 0 quando o tempo de jogo for 0
)
)
head(KevinLove_com_eficiencia)
## firstName lastName personId gameId gameDate playerteamCity
## 1 Kevin Love 201567 21400018 2014-10-30 20:00:00 Cleveland
## 2 Kevin Love 201567 21400022 2014-10-31 20:00:00 Cleveland
## 3 Kevin Love 201567 21400055 2014-11-04 22:00:00 Cleveland
## 4 Kevin Love 201567 21400066 2014-11-05 21:00:00 Cleveland
## 5 Kevin Love 201567 21400081 2014-11-07 22:30:00 Cleveland
## 6 Kevin Love 201567 21400098 2014-11-10 19:00:00 Cleveland
## playerteamName opponentteamCity opponentteamName gameType gameLabel
## 1 Cavaliers New York Knicks Regular Season
## 2 Cavaliers Chicago Bulls Regular Season
## 3 Cavaliers Portland Trail Blazers Regular Season
## 4 Cavaliers Utah Jazz Regular Season
## 5 Cavaliers Denver Nuggets Regular Season
## 6 Cavaliers New Orleans Pelicans Regular Season
## gameSubLabel seriesGameNumber win home numMinutes points assists blocks
## 1 NA 0 1 38 19 4 0
## 2 NA 1 0 41 16 1 0
## 3 NA 0 0 35 22 2 0
## 4 NA 0 0 38 14 1 0
## 5 NA 1 0 36 19 1 1
## 6 NA 1 1 38 22 2 0
## steals fieldGoalsAttempted fieldGoalsMade fieldGoalsPercentage
## 1 0 14 6 0.429
## 2 4 17 5 0.294
## 3 0 14 7 0.500
## 4 1 10 2 0.200
## 5 0 16 6 0.375
## 6 1 13 7 0.538
## threePointersAttempted threePointersMade threePointersPercentage
## 1 6 3 0.500
## 2 6 1 0.167
## 3 8 5 0.625
## 4 5 1 0.200
## 5 5 0 0.000
## 6 9 6 0.667
## freeThrowsAttempted freeThrowsMade freeThrowsPercentage reboundsDefensive
## 1 4 4 1.000 11
## 2 6 5 0.833 14
## 3 3 3 1.000 9
## 4 11 9 0.818 8
## 5 8 7 0.875 6
## 6 2 2 1.000 4
## reboundsOffensive reboundsTotal foulsPersonal turnovers plusMinusPoints ano
## 1 3 14 1 2 -4 2014
## 2 2 16 2 0 7 2014
## 3 1 10 4 1 -8 2014
## 4 0 8 4 1 1 2014
## 5 2 8 4 2 15 2014
## 6 1 5 2 1 1 2014
## mes dia game_score Temporada game_index game_score_por_minuto
## 1 10 30 17.4 2015 1 0.4578947
## 2 10 31 15.2 2015 2 0.3707317
## 3 11 04 17.2 2015 3 0.4914286
## 4 11 05 8.5 2015 4 0.2236842
## 5 11 07 10.8 2015 5 0.3000000
## 6 11 10 18.2 2015 6 0.4789474
#ANÁLISE DESCRITIVA INICIAL PARA VERIFICARMOS INFORMAÇÕE SMAIS BÁSICAS
# Certifique-se de que os pacotes necessários estão carregados
library(knitr)
# Cria a nova variável 'periodo' no dataframe
KevinLove_com_eficiencia <- KevinLove_com_eficiencia %>%
mutate(
periodo = ifelse(
game_index >= evento_indice,
"Pós-Evento",
"Pré-Evento"
)
)
# Cria uma tabela descritiva comparando os períodos
tabela_descritiva <- KevinLove_com_eficiencia %>%
mutate(periodo = ifelse(periodo == 1, "Pós-Evento", "Pré-Evento")) %>%
group_by(periodo) %>%
summarise(
Media = mean(game_score_por_minuto, na.rm = TRUE),
Mediana = median(game_score_por_minuto, na.rm = TRUE),
`Desvio Padrão` = sd(game_score_por_minuto, na.rm = TRUE),
N = n()
)
# Exibe a tabela descritiva formatada
kable(tabela_descritiva, caption = "Estatísticas Descritivas do Game Score por Minuto")
Estatísticas Descritivas do Game Score por Minuto
| Pré-Evento |
0.4009387 |
0.3945588 |
0.2670596 |
530 |
# Cria um boxplot para comparar visualmente os períodos
ggplot(KevinLove_com_eficiencia, aes(x = factor(periodo, levels = c("Pré-Evento", "Pós-Evento")), y = game_score_por_minuto)) +
geom_boxplot() +
labs(
title = "Comparação da Distribuição do Desempenho",
subtitle = "Período 0: Pré-Evento | Período 1: Pós-Evento",
x = "Período",
y = "Game Score por Minuto"
) +
theme_minimal()
evento_indice <- 238
# Aplica a Análise de Pontos de Mudança na série de eficiência
analise_cpt_eficiencia <- cpt.mean(KevinLove_com_eficiencia$game_score_por_minuto, method = "AMOC")
# Visualiza o resultado
plot(analise_cpt_eficiencia)
abline(v = evento_indice, col = "blue", lty = 2)
# Extrai e exibe o(s) ponto(s) de mudança detectado(s)
ponto_de_mudanca_detectado <- cpts(analise_cpt_eficiencia)
cat("\nO ponto de mudança detectado na série de eficiência é no jogo de índice:", ponto_de_mudanca_detectado, "\n")
##
## O ponto de mudança detectado na série de eficiência é no jogo de índice:
cat("O evento de pânico ocorreu no jogo de índice:", evento_indice, "\n")
## O evento de pânico ocorreu no jogo de índice: 238
# Vamos fazer aqui a Análise de Pontos de Mudança focada na variância
analise_cpt_variancia <- cpt.var(KevinLove_com_eficiencia$game_score_por_minuto, method = "AMOC")
plot(analise_cpt_variancia)
abline(v = evento_indice, col = "blue", lty = 2)
ponto_de_mudanca_variancia <- cpts(analise_cpt_variancia)
cat("\nO ponto de mudança na variância detectado na série de eficiência é no jogo de índice:", ponto_de_mudanca_variancia, "\n")
##
## O ponto de mudança na variância detectado na série de eficiência é no jogo de índice:
cat("O evento de pânico ocorreu no jogo de índice:", evento_indice, "\n")
## O evento de pânico ocorreu no jogo de índice: 238
#resultado aqui é de que incluindo todos os jogos, não temos uma mudança significativa no pré e pós
#então partimos para a análise iterativa com os números de jogos.
###########
#Análise de Efeitos Defasados (Lagged Effects)
###########
# Define um atraso (lag) de, por exemplo, 5 jogos
lag_jogos <- 5
# Cria uma nova série temporal que começa 5 jogos após o evento
serie_com_lag <- KevinLove_com_eficiencia$game_score_por_minuto[
(evento_indice + lag_jogos):length(KevinLove_com_eficiencia$game_score_por_minuto)
]
# Realiza a análise de pontos de mudança na série com atraso
analise_lag <- cpt.mean(serie_com_lag, method = "AMOC")
# Visualiza o resultado para a série com lag
plot(analise_lag)
# Extrai e exibe o(s) ponto(s) de mudança detectado(s) na série defasada
ponto_de_mudanca_lag <- cpts(analise_lag)
cat("\nO ponto de mudança na série com lag é:", ponto_de_mudanca_lag, "\n")
##
## O ponto de mudança na série com lag é:
cat("O evento original ocorreu no jogo de índice:", evento_indice, "\n")
## O evento original ocorreu no jogo de índice: 238
# NOTA: A interpretação é que se um ponto de mudança for encontrado em 'ponto_de_mudanca_lag',
# ele se refere ao índice dentro da nova série 'serie_com_lag'.
# O índice na série original seria (evento_indice + lag_jogos + ponto_de_mudanca_lag - 1).
#vou usar aqui o seu código de 5 jogos com algumas mudanças, principalmente na métrica game_score
KevinLove_com_eficiencia <- KevinLove_com_eficiencia %>%
mutate(
linha_atual = row_number(),
distancia = linha_central - linha_atual,
modulo = abs(distancia)
)
KL5 <- KevinLove_com_eficiencia %>%
filter(modulo <= 5)%>%
mutate(per = case_when(
distancia > 0 ~ "Pós",
distancia < 0 ~ "Pré",
TRUE ~ "Evento"
))%>%
mutate(Med = mean(game_score_por_minuto))
KL15 <- KevinLove_com_eficiencia %>%
filter(modulo <= 15)%>%
mutate(per = case_when(
distancia > 0 ~ "Pós",
distancia < 0 ~ "Pré",
TRUE ~ "Evento"
))%>%
mutate(Med = mean(game_score_por_minuto))
KL45 <- KevinLove_com_eficiencia %>%
filter(modulo <= 45)%>%
mutate(per = case_when(
distancia > 0 ~ "Pós",
distancia < 0 ~ "Pré",
TRUE ~ "Evento"
))%>%
mutate(Med = mean(game_score_por_minuto))
KL82 <- KevinLove_com_eficiencia %>%
filter(modulo <= 82)%>%
mutate(per = case_when(
distancia > 0 ~ "Pós",
distancia < 0 ~ "Pré",
TRUE ~ "Evento"
))%>%
mutate(Med = mean(game_score_por_minuto))
KL164 <- KevinLove_com_eficiencia %>%
filter(modulo <= 164)%>%
mutate(per = case_when(
distancia > 0 ~ "Pós",
distancia < 0 ~ "Pré",
TRUE ~ "Evento"
))%>%
mutate(Med = mean(game_score_por_minuto))
ggplot(KL5, aes(x = distancia, y = game_score_por_minuto, color = per)) +
geom_point(size = 2, alpha = 0.7) +
geom_vline(xintercept = 0, linetype = "dashed", color = "black") + # linha do evento
geom_hline(aes(yintercept = Med), linetype = "dotted", color = "gray30") + # média geral
geom_smooth(method = "lm", se = FALSE) + # tendência linear por grupo
scale_color_manual(values = c("Pré" = "#1f77b4", "Evento" = "#ff7f0e", "Pós" = "#2ca02c")) +
labs(
title = "Game Score de Kevin Love",
subtitle = "Comparação de desempenho antes e depois do evento (±5 jogos)",
x = "Distância em jogos do evento",
y = "Game Score",
color = "Período"
) +
theme_minimal(base_size = 13)
## `geom_smooth()` using formula = 'y ~ x'
modelo05 <- lm(game_score_por_minuto ~ distancia * per, data = KL5 %>% filter(per != "Evento"))
summary(modelo05)
##
## Call:
## lm(formula = game_score_por_minuto ~ distancia * per, data = KL5 %>%
## filter(per != "Evento"))
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.36689 -0.24539 -0.01209 0.22364 0.40127
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.38055 0.34718 1.096 0.315
## distancia 0.02121 0.10468 0.203 0.846
## perPré 0.54111 0.49098 1.102 0.313
## distancia:perPré 0.09031 0.14804 0.610 0.564
##
## Residual standard error: 0.331 on 6 degrees of freedom
## Multiple R-squared: 0.2149, Adjusted R-squared: -0.1777
## F-statistic: 0.5474 on 3 and 6 DF, p-value: 0.668
ggplot(KL15, aes(x = distancia, y = game_score_por_minuto, color = per)) +
geom_point(size = 2, alpha = 0.7) +
geom_vline(xintercept = 0, linetype = "dashed", color = "black") + # linha do evento
geom_hline(aes(yintercept = Med), linetype = "dotted", color = "gray30") + # média geral
geom_smooth(method = "lm", se = FALSE) + # tendência linear por grupo
scale_color_manual(values = c("Pré" = "#1f77b4", "Evento" = "#ff7f0e", "Pós" = "#2ca02c")) +
labs(
title = "Game Score de Kevin Love",
subtitle = "Comparação de desempenho antes e depois do evento (±15 jogos)",
x = "Distância em jogos do evento",
y = "Game Score",
color = "Período"
) +
theme_minimal(base_size = 13)
## `geom_smooth()` using formula = 'y ~ x'
modelo015 <- lm(game_score_por_minuto ~ distancia * per, data = KL15 %>% filter(per != "Evento"))
summary(modelo015)
##
## Call:
## lm(formula = game_score_por_minuto ~ distancia * per, data = KL15 %>%
## filter(per != "Evento"))
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.47300 -0.20189 -0.04643 0.09193 0.70753
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.4268266 0.1610821 2.650 0.0135 *
## distancia -0.0002404 0.0177167 -0.014 0.9893
## perPré 0.1258491 0.2278045 0.552 0.5854
## distancia:perPré -0.0070133 0.0250552 -0.280 0.7818
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.2965 on 26 degrees of freedom
## Multiple R-squared: 0.107, Adjusted R-squared: 0.003912
## F-statistic: 1.038 on 3 and 26 DF, p-value: 0.3922
ggplot(KL45, aes(x = distancia, y = game_score_por_minuto, color = per)) +
geom_point(size = 2, alpha = 0.7) +
geom_vline(xintercept = 0, linetype = "dashed", color = "black") + # linha do evento
geom_hline(aes(yintercept = Med), linetype = "dotted", color = "gray30") + # média geral
geom_smooth(method = "lm", se = FALSE) + # tendência linear por grupo
scale_color_manual(values = c("Pré" = "#1f77b4", "Evento" = "#ff7f0e", "Pós" = "#2ca02c")) +
labs(
title = "Game Score de Kevin Love",
subtitle = "Comparação de desempenho antes e depois do evento (±45 jogos)",
x = "Distância em jogos do evento",
y = "Game Score",
color = "Período"
) +
theme_minimal(base_size = 13)
## `geom_smooth()` using formula = 'y ~ x'
modelo045 <- lm(game_score_por_minuto ~ distancia * per, data = KL45 %>% filter(per != "Evento"))
summary(modelo045)
##
## Call:
## lm(formula = game_score_por_minuto ~ distancia * per, data = KL45 %>%
## filter(per != "Evento"))
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.83867 -0.15408 0.01387 0.15422 0.76343
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.486477 0.083933 5.796 0.000000109 ***
## distancia -0.005061 0.003178 -1.593 0.1149
## perPré 0.183847 0.118700 1.549 0.1251
## distancia:perPré 0.013585 0.004494 3.023 0.0033 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.2768 on 86 degrees of freedom
## Multiple R-squared: 0.1306, Adjusted R-squared: 0.1003
## F-statistic: 4.307 on 3 and 86 DF, p-value: 0.007028
ggplot(KL82, aes(x = distancia, y = game_score_por_minuto, color = per)) +
geom_point(size = 2, alpha = 0.7) +
geom_vline(xintercept = 0, linetype = "dashed", color = "black") + # linha do evento
geom_hline(aes(yintercept = Med), linetype = "dotted", color = "gray30") + # média geral
geom_smooth(method = "lm", se = FALSE) + # tendência linear por grupo
scale_color_manual(values = c("Pré" = "#1f77b4", "Evento" = "#ff7f0e", "Pós" = "#2ca02c")) +
labs(
title = "Game Score de Kevin Love",
subtitle = "Comparação de desempenho antes e depois do evento (±82 jogos)",
x = "Distância em jogos do evento",
y = "Game Score",
color = "Período"
) +
theme_minimal(base_size = 13)
## `geom_smooth()` using formula = 'y ~ x'
modelo082 <- lm(game_score_por_minuto ~ distancia * per, data = KL82 %>% filter(per != "Evento"))
summary(modelo082)
##
## Call:
## lm(formula = game_score_por_minuto ~ distancia * per, data = KL82 %>%
## filter(per != "Evento"))
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.9224 -0.1721 0.0283 0.1638 0.7918
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.358183 0.063001 5.685 0.0000000604 ***
## distancia 0.001761 0.001319 1.336 0.18357
## perPré 0.232364 0.089097 2.608 0.00997 **
## distancia:perPré 0.002092 0.001865 1.122 0.26364
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.2826 on 160 degrees of freedom
## Multiple R-squared: 0.0606, Adjusted R-squared: 0.04299
## F-statistic: 3.441 on 3 and 160 DF, p-value: 0.01828
ggplot(KL164, aes(x = distancia, y = game_score_por_minuto, color = per)) +
geom_point(size = 2, alpha = 0.7) +
geom_vline(xintercept = 0, linetype = "dashed", color = "black") + # linha do evento
geom_hline(aes(yintercept = Med), linetype = "dotted", color = "gray30") + # média geral
geom_smooth(method = "lm", se = FALSE) + # tendência linear por grupo
scale_color_manual(values = c("Pré" = "#1f77b4", "Evento" = "#ff7f0e", "Pós" = "#2ca02c")) +
labs(
title = "Game Score de Kevin Love",
subtitle = "Comparação de desempenho antes e depois do evento (±164 jogos)",
x = "Distância em jogos do evento",
y = "Game Score",
color = "Período"
) +
theme_minimal(base_size = 13)
## `geom_smooth()` using formula = 'y ~ x'
modelo0164 <- lm(game_score_por_minuto ~ distancia * per, data = KL164 %>% filter(per != "Evento"))
summary(modelo0164)
##
## Call:
## lm(formula = game_score_por_minuto ~ distancia * per, data = KL164 %>%
## filter(per != "Evento"))
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.92128 -0.15560 0.01018 0.16075 0.86162
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.41339227 0.03945845 10.477 <0.0000000000000002 ***
## distancia -0.00005439 0.00041484 -0.131 0.896
## perPré 0.07587605 0.05580267 1.360 0.175
## distancia:perPré 0.00104445 0.00058667 1.780 0.076 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.2515 on 324 degrees of freedom
## Multiple R-squared: 0.01733, Adjusted R-squared: 0.008236
## F-statistic: 1.905 on 3 and 324 DF, p-value: 0.1286
#ANÁLISE DE AUTOCORRELAÇÃO COM MODELO ARIMA
#a análise anterior interpreta os jogos como sendo indepentendes, o modelo ARIMA
#"testa" os jogos como se tivessem uma dependencia temporal
# Certifique-se de que os pacotes necessários estão instalados
# e carregue-os no início da sessão.
#install.packages("forecast")
library(forecast)
## Warning: package 'forecast' was built under R version 4.4.3
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
# --------------------------------------------------------------------------
# ETAPA 1: PREPARAÇÃO DOS DADOS
# --------------------------------------------------------------------------
# Identifica o evento de pânico no índice 238
evento_indice <- 238
# Cria a série temporal do Game Score por minuto a partir do seu dataframe
# A função ts() cria um objeto de série temporal no R.
# O parâmetro 'start' é o índice do primeiro jogo (1).
# O parâmetro 'frequency' é 1, pois os dados são diários (jogo a jogo).
serie_game_score <- ts(
KevinLove_com_eficiencia$game_score_por_minuto,
start = 1,
frequency = 1
)
# Cria a variável de intervenção (predictor externo),
# que será 0 antes do evento e 1 a partir do evento.
intervencao_variavel <- ts(
ifelse(KevinLove_com_eficiencia$game_index >= evento_indice, 1, 0),
start = 1,
frequency = 1
)
# --------------------------------------------------------------------------
# ETAPA 2: IDENTIFICAÇÃO E AJUSTE DO MODELO ARIMA
# --------------------------------------------------------------------------
# A função auto.arima() busca e encontra automaticamente a melhor ordem (p, d, q)
# do modelo ARIMA que se ajusta aos seus dados.
# O parâmetro 'xreg' inclui a variável de intervenção no modelo.
modelo_arima_its <- auto.arima(
serie_game_score,
xreg = intervencao_variavel
)
# --------------------------------------------------------------------------
# ETAPA 3: ANÁLISE E INTERPRETAÇÃO DOS RESULTADOS
# --------------------------------------------------------------------------
# Exibe o sumário completo do modelo ajustado
summary(modelo_arima_its)
## Series: serie_game_score
## Regression with ARIMA(1,0,4) errors
##
## Coefficients:
## ar1 ma1 ma2 ma3 ma4 intercept xreg
## 0.8835 -0.7767 0.0706 -0.1703 0.0983 0.3990 -0.0021
## s.e. 0.0723 0.0832 0.0552 0.0542 0.0433 0.0315 0.0418
##
## sigma^2 = 0.06781: log likelihood = -35.46
## AIC=86.93 AICc=87.21 BIC=121.11
##
## Training set error measures:
## ME RMSE MAE MPE MAPE MASE
## Training set 0.00009177974 0.2586756 0.1985934 -Inf Inf 0.7427055
## ACF1
## Training set 0.00008299536
# Plotar os resíduos para verificar se o modelo se ajustou bem aos dados
# Os resíduos devem se parecer com ruído branco
tsdisplay(residuals(modelo_arima_its))
# O modelo ARIMA fornece um coeficiente para a variável de intervenção.
# A interpretação desse coeficiente é crucial para o seu estudo.
# Um valor positivo indica um aumento no nível de desempenho,
# e um valor negativo indica uma queda, após o evento.
# Um p-valor baixo (geralmente < 0.05) indica que este efeito é estatisticamente significativo.
##############################
#ANÁLISE COM ARIMA USANDO AS JANELAS DE JOGOS
#############################
# Define o índice do evento e a janela de tempo
evento_indice <- 238
janela_jogos <- 45
# --------------------------------------------------------------------------
# ETAPA 1: SUBCOJUNTAR OS DADOS
# --------------------------------------------------------------------------
# Filtra o dataframe para a janela de jogos desejada
# A lógica é pegar os jogos do índice 238 - 45 até 238 + 45.
dados_subconjunto <- KevinLove_com_eficiencia %>%
filter(
game_index >= (evento_indice - janela_jogos) &
game_index <= (evento_indice + janela_jogos)
)
# Ajusta o índice do evento para o novo subconjunto
evento_indice_subconjunto <- janela_jogos + 1
# --------------------------------------------------------------------------
# ETAPA 2: AJUSTE DO MODELO ARIMA
# --------------------------------------------------------------------------
# Cria a nova série temporal e a nova variável de intervenção a partir do subconjunto
serie_game_score_sub <- ts(
dados_subconjunto$game_score_por_minuto,
start = 1,
frequency = 1
)
intervencao_sub <- ts(
ifelse(dados_subconjunto$game_index >= evento_indice, 1, 0),
start = 1,
frequency = 1
)
# Ajusta o modelo ARIMA com a variável de intervenção
modelo_arima_sub <- auto.arima(
serie_game_score_sub,
xreg = intervencao_sub
)
# --------------------------------------------------------------------------
# ETAPA 3: INTERPRETAÇÃO DOS RESULTADOS
# --------------------------------------------------------------------------
summary(modelo_arima_sub)
## Series: serie_game_score_sub
## Regression with ARIMA(0,0,0) errors
##
## Coefficients:
## intercept xreg
## 0.3701 0.0996
## s.e. 0.0425 0.0597
##
## sigma^2 = 0.08294: log likelihood = -14.83
## AIC=35.66 AICc=35.94 BIC=43.2
##
## Training set error measures:
## ME RMSE MAE MPE MAPE MASE
## Training set -0.0000000000000006807682 0.2848067 0.2095938 -Inf Inf 0.7072283
## ACF1
## Training set 0.04270808
# A interpretação será a mesma: procure pelo p-valor do coeficiente 'xreg'.
# Um p-valor baixo (ex: < 0.05) indicaria um efeito significativo nesta janela de tempo.
tsdisplay(residuals(modelo_arima_sub))
# 82 jogos
# Define o índice do evento e a janela de tempo
evento_indice <- 238
janela_jogos <- 82
# --------------------------------------------------------------------------
# ETAPA 1: SUBCOJUNTAR OS DADOS
# --------------------------------------------------------------------------
# Filtra o dataframe para a janela de jogos desejada
dados_subconjunto <- KevinLove_com_eficiencia %>%
filter(
game_index >= (evento_indice - janela_jogos) &
game_index <= (evento_indice + janela_jogos)
)
# --------------------------------------------------------------------------
# ETAPA 2: AJUSTE DO MODELO ARIMA
# --------------------------------------------------------------------------
# Cria a nova série temporal e a nova variável de intervenção a partir do subconjunto
serie_game_score_sub <- ts(
dados_subconjunto$game_score_por_minuto,
start = 1,
frequency = 1
)
intervencao_sub <- ts(
ifelse(dados_subconjunto$game_index >= evento_indice, 1, 0),
start = 1,
frequency = 1
)
# Ajusta o modelo ARIMA com a variável de intervenção
modelo_arima_sub <- auto.arima(
serie_game_score_sub,
xreg = intervencao_sub
)
# --------------------------------------------------------------------------
# ETAPA 3: INTERPRETAÇÃO DOS RESULTADOS
# --------------------------------------------------------------------------
summary(modelo_arima_sub)
## Series: serie_game_score_sub
## Regression with ARIMA(0,0,0) errors
##
## Coefficients:
## intercept xreg
## 0.4313 -0.0027
## s.e. 0.0317 0.0448
##
## sigma^2 = 0.08365: log likelihood = -28.43
## AIC=62.85 AICc=63 BIC=72.17
##
## Training set error measures:
## ME RMSE MAE MPE MAPE MASE
## Training set 0.00000000000005945532 0.2874649 0.2212135 -Inf Inf 0.7353118
## ACF1
## Training set 0.1210739
tsdisplay(residuals(modelo_arima_sub))
# A interpretação do resultado será a seguinte:
# procure o coeficiente 'xreg' e seu erro padrão ('s.e.').
# Se o p-valor for baixo (geralmente < 0.05), a mudança de nível
# no desempenho é estatisticamente significativa para esta janela de tempo.