Este projeto apresenta a modelagem da diferenca de gols entre mandantes e visitantes no Campeonato Brasileiro. A variavel resposta considerada e a diferenca entre o total de gols marcados pelos mandantes e o total de gols marcados pelos visitantes em cada rodada.
Como essa diferenca assume valores inteiros positivos, nulos ou negativos, foram avaliadas distribuicoes discretas capazes de representar esse tipo de variavel. Os modelos considerados foram:
Os parametros foram estimados por maxima verossimilhanca e os modelos foram comparados pelos criterios AIC e BIC, alem da inspecao grafica das probabilidades ajustadas.
A base utilizada deve estar no mesmo diretorio do arquivo R Markdown.
Neste script, considera-se o arquivo tudo.txt, com
informacoes agregadas por ano e rodada.
Foram mantidos apenas os campeonatos a partir de 2006, periodo em que o Campeonato Brasileiro passou a apresentar formato mais estavel, com 20 equipes e 38 rodadas.
## ano rodata mandante_Placar visitante_Placar soma_diferenca jogos
## 134 2006 1 11 7 4 10
## 135 2006 2 21 5 16 10
## 136 2006 3 18 15 3 10
## 137 2006 4 15 10 5 10
## 138 2006 5 14 11 3 10
## 139 2006 6 15 15 0 10
## 'data.frame': 760 obs. of 6 variables:
## $ ano : int 2006 2006 2006 2006 2006 2006 2006 2006 2006 2006 ...
## $ rodata : int 1 2 3 4 5 6 7 8 9 10 ...
## $ mandante_Placar : int 11 21 18 15 14 15 25 11 12 12 ...
## $ visitante_Placar: int 7 5 15 10 11 15 13 10 9 12 ...
## $ soma_diferenca : int 4 16 3 5 3 0 12 1 3 0 ...
## $ jogos : int 10 10 10 10 10 10 10 10 10 10 ...
A variavel de interesse e a diferenca de gols entre mandante e visitante. No codigo original, essa variavel se encontra na quinta coluna da base.
x <- as.numeric(as.character(dados[, 5]))
n <- length(x)
xs <- seq(min(x), max(x), by = 1)
summary(x)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -13,00 2,00 5,00 4,89 8,00 22,00
Antes do ajuste dos modelos, sao obtidas medidas descritivas da diferenca de gols por rodada.
descritiva_x <- data.frame(
n = length(x),
media = mean(x),
mediana = median(x),
desvio_padrao = sd(x),
minimo = min(x),
primeiro_quartil = quantile(x, 0.25),
terceiro_quartil = quantile(x, 0.75),
maximo = max(x),
assimetria = skewness(x),
curtose = kurtosis(x)
)
kable(descritiva_x, digits = 3)| n | media | mediana | desvio_padrao | minimo | primeiro_quartil | terceiro_quartil | maximo | assimetria | curtose | |
|---|---|---|---|---|---|---|---|---|---|---|
| 25% | 760 | 4,888 | 5 | 4,912 | -13 | 2 | 8 | 22 | 0,017 | 3,355 |
Nesta etapa, sao definidas as funcoes de probabilidade utilizadas no ajuste dos modelos.
A normal discreta e obtida pela diferenca entre valores acumulados da distribuicao normal continua:
\[ P(X=x)=\Phi\left(\frac{x-\mu+1}{\sigma}\right) - \Phi\left(\frac{x-\mu}{\sigma}\right). \]
A skew-normal discreta e definida de forma analoga, pela diferenca entre valores acumulados da distribuicao skew-normal continua.
A distribuicao Skellam representa a diferenca entre duas variaveis aleatorias independentes com distribuicao de Poisson. Se \(X \sim Poisson(\lambda_1)\) e \(Y \sim Poisson(\lambda_2)\), entao \(D = X - Y\) segue distribuicao Skellam.
Tambem foi considerada a distribuicao da diferenca entre duas variaveis independentes com distribuicao Weibull discreta.
dweibull_discrete <- function(x, q, beta) {
if (any(x < 0)) {
stop("x deve ser >= 0")
}
q^(x^beta) - q^((x + 1)^beta)
}
dweibull_diff <- function(d, q1, beta1, q2, beta2, max_k = 200) {
sapply(d, function(di) {
if (di >= 0) {
sum(
dweibull_discrete(0:max_k + di, q1, beta1) *
dweibull_discrete(0:max_k, q2, beta2)
)
} else {
sum(
dweibull_discrete(0:max_k, q1, beta1) *
dweibull_discrete(0:max_k - di, q2, beta2)
)
}
})
}As funcoes abaixo retornam a log-verossimilhanca negativa. Dessa
forma, todas podem ser minimizadas diretamente pela funcao
optim.
loglik_norm <- function(par) {
mu <- par[1]
sigma <- exp(par[2])
p <- ddnorm2(x, mu, sigma)
-sum(log(p + 1e-12))
}
loglik_skew <- function(par) {
xi <- par[1]
omega <- abs(par[2])
alpha <- par[3]
p <- ddskewnorm(x, xi, omega, alpha)
-sum(log(p + 1e-12))
}
loglik_skellam <- function(par) {
lambda1 <- exp(par[1])
lambda2 <- exp(par[2])
p <- dskellam(x, lambda1, lambda2)
-sum(log(p + 1e-12))
}
loglik_weibull_diff <- function(par) {
q1 <- 1 / (1 + exp(-par[1]))
beta1 <- exp(par[2])
q2 <- 1 / (1 + exp(-par[3]))
beta2 <- exp(par[4])
p <- dweibull_diff(x, q1, beta1, q2, beta2)
-sum(log(p + 1e-12))
}Os parametros foram estimados por maxima verossimilhanca. Para garantir as restricoes dos parametros, algumas transformacoes foram utilizadas:
sigma = exp(par[2]), garantindo \(\sigma > 0\);lambda = exp(par), garantindo \(\lambda > 0\);q = 1/(1 + exp(-par)), garantindo \(0 < q < 1\);beta = exp(par), garantindo \(\beta > 0\).fit_norm <- optim(
par = c(mean(x), log(sd(x))),
fn = loglik_norm,
method = "BFGS"
)
fit_skew <- optim(
par = c(mean(x), sd(x), 0),
fn = loglik_skew,
method = "BFGS"
)
lambda1_ini <- (var(x) + mean(x)) / 2
lambda2_ini <- (var(x) - mean(x)) / 2
lambda1_ini <- max(lambda1_ini, 0.1)
lambda2_ini <- max(lambda2_ini, 0.1)
fit_skellam <- optim(
par = c(log(lambda1_ini), log(lambda2_ini)),
fn = loglik_skellam,
method = "BFGS"
)
fit_weibull <- optim(
par = c(0, 0, 0, 0),
fn = loglik_weibull_diff,
method = "BFGS"
)mu_norm_hat <- fit_norm$par[1]
sigma_norm_hat <- exp(fit_norm$par[2])
xi_hat <- fit_skew$par[1]
omega_hat <- abs(fit_skew$par[2])
alpha_hat <- fit_skew$par[3]
lambda1_hat <- exp(fit_skellam$par[1])
lambda2_hat <- exp(fit_skellam$par[2])
par_hat <- fit_weibull$par
q1_hat <- 1 / (1 + exp(-par_hat[1]))
beta1_hat <- exp(par_hat[2])
q2_hat <- 1 / (1 + exp(-par_hat[3]))
beta2_hat <- exp(par_hat[4])
tabela_parametros <- data.frame(
Modelo = c(
"Normal discreta",
"Skew-normal discreta",
"Skellam",
"Diferenca Weibull discreta"
),
Parametro_1 = c(mu_norm_hat, xi_hat, lambda1_hat, q1_hat),
Parametro_2 = c(sigma_norm_hat, omega_hat, lambda2_hat, beta1_hat),
Parametro_3 = c(NA, alpha_hat, NA, q2_hat),
Parametro_4 = c(NA, NA, NA, beta2_hat)
)
kable(tabela_parametros, digits = 4)| Modelo | Parametro_1 | Parametro_2 | Parametro_3 | Parametro_4 |
|---|---|---|---|---|
| Normal discreta | 5,3882 | 4,900 | NA | NA |
| Skew-normal discreta | 3,2401 | 5,350 | 0,5822 | NA |
| Skellam | 14,4704 | 9,582 | NA | NA |
| Diferenca Weibull discreta | 0,9933 | 2,224 | 0,8279 | 1,252 |
Os criterios AIC e BIC foram utilizados para comparar os modelos ajustados. Menores valores indicam melhor equilibrio entre qualidade de ajuste e complexidade.
ll_norm <- -fit_norm$value
ll_skew <- -fit_skew$value
ll_skel <- -fit_skellam$value
ll_weibull <- -fit_weibull$value
k_norm <- 2
k_skew <- 3
k_skel <- 2
k_weibull <- 4
criterios <- data.frame(
Modelo = c(
"Normal discreta",
"Skew-normal discreta",
"Skellam",
"Diferenca Weibull discreta"
),
LogLik = c(ll_norm, ll_skew, ll_skel, ll_weibull),
k = c(k_norm, k_skew, k_skel, k_weibull),
AIC = c(
-2 * ll_norm + 2 * k_norm,
-2 * ll_skew + 2 * k_skew,
-2 * ll_skel + 2 * k_skel,
-2 * ll_weibull + 2 * k_weibull
),
BIC = c(
-2 * ll_norm + log(n) * k_norm,
-2 * ll_skew + log(n) * k_skew,
-2 * ll_skel + log(n) * k_skel,
-2 * ll_weibull + log(n) * k_weibull
)
)
criterios <- criterios %>%
arrange(AIC)
kable(criterios, digits = 3)| Modelo | LogLik | k | AIC | BIC |
|---|---|---|---|---|
| Skellam | -2287 | 2 | 4578 | 4588 |
| Normal discreta | -2288 | 2 | 4579 | 4588 |
| Diferenca Weibull discreta | -2286 | 4 | 4580 | 4599 |
| Skew-normal discreta | -2288 | 3 | 4581 | 4595 |
Nesta etapa, sao calculadas as frequencias relativas observadas e as probabilidades estimadas por cada modelo para os valores inteiros observados da diferenca de gols.
freq_obs <- table(factor(x, levels = xs))
prob_obs <- as.numeric(freq_obs) / length(x)
prob_norm <- ddnorm2(
xs,
mu = mu_norm_hat,
sigma = sigma_norm_hat
)
prob_skew <- ddskewnorm(
xs,
xi = xi_hat,
omega = omega_hat,
alpha = alpha_hat
)
prob_skel <- dskellam(
xs,
lambda1 = lambda1_hat,
lambda2 = lambda2_hat
)
prob_weib <- dweibull_diff(
xs,
q1 = q1_hat,
beta1 = beta1_hat,
q2 = q2_hat,
beta2 = beta2_hat
)O grafico compara as probabilidades observadas com as probabilidades ajustadas pelos modelos considerados.
simbolos <- c(16, 0, 1, 2, 3)
cores <- c(
"black",
"#0072B2",
"#D55E00",
"#009E73",
"#CC79A7"
)
rotulos <- c(
"Observado",
"Normal discreta",
"Skew-normal discreta",
"Skellam",
"Diferenca Weibull discreta"
)
probabilidades <- list(
prob_obs,
prob_norm,
prob_skew,
prob_skel,
prob_weib
)
desenhar_grafico <- function() {
par(
family = "sans",
mar = c(4.5, 5, 1, 1),
oma = c(0, 0, 3, 0),
mgp = c(3, 0.8, 0),
las = 1,
bty = "l",
cex.axis = 1,
cex.lab = 1.1
)
ymax <- max(unlist(probabilidades), na.rm = TRUE)
plot(
xs, prob_obs,
type = "n",
xlab = "Diferenca de gols por rodada",
ylab = "Probabilidade",
ylim = c(0, ymax * 1.10),
yaxs = "i",
xaxt = "n",
yaxt = "n"
)
marcas_x <- pretty(range(xs), n = 7)
marcas_x <- marcas_x[
marcas_x >= min(xs) & marcas_x <= max(xs)
]
marcas_y <- pretty(c(0, ymax * 1.10), n = 5)
marcas_y <- marcas_y[
marcas_y >= 0 & marcas_y <= ymax * 1.10
]
abline(
h = marcas_y,
col = "grey90",
lwd = 0.8
)
axis(1, at = marcas_x)
axis(
2,
at = marcas_y,
labels = formatC(
marcas_y,
format = "f",
digits = 2,
decimal.mark = ","
)
)
for (i in 2:5) {
points(
xs, probabilidades[[i]],
pch = simbolos[i],
col = cores[i],
cex = 1.15,
lwd = 1.8
)
}
points(
xs, prob_obs,
pch = simbolos[1],
col = cores[1],
cex = 0.85
)
legend(
"top",
inset = c(0, -0.12),
legend = rotulos,
pch = simbolos,
col = cores,
ncol = 3,
pt.cex = 1,
cex = 0.85,
bty = "n",
xpd = NA
)
}
desenhar_grafico()Os comandos abaixo exportam o grafico em PNG e PDF, em dimensoes adequadas para insercao em poster ou apresentacao.
png(
filename = "grafico_ajuste_brasileirao.png",
width = 39,
height = 20,
units = "cm",
res = 300,
pointsize = 26,
bg = "white"
)
desenhar_grafico()
dev.off()
pdf(
file = "grafico_ajuste_brasileirao.pdf",
width = 39 / 2.54,
height = 20 / 2.54,
pointsize = 26,
family = "Helvetica",
bg = "white"
)
desenhar_grafico()
dev.off()A comparacao entre as distribuicoes permite avaliar qual modelo representa melhor a diferenca de gols por rodada no Campeonato Brasileiro. A Skellam e uma alternativa natural para esse problema, pois descreve a diferenca entre duas contagens independentes. Entretanto, a comparacao com outras distribuicoes discretas, como a normal discreta, a skew-normal discreta e a diferenca de Weibull discretas, permite avaliar se estruturas mais flexiveis oferecem melhor ajuste aos dados.
Os criterios AIC e BIC devem ser analisados em conjunto com a inspecao grafica, pois pequenas diferencas nos criterios podem indicar ajustes semelhantes em termos praticos.