Termina a vinheta da Gamma COunt.

parent ee11d675
This diff is collapsed.
This diff is collapsed.
......@@ -97,20 +97,54 @@ $$
Como
$$
F_n(T) = G(n\alpha, \beta) =
F_n(T) = G(n\alpha, \beta T) =
\frac{1}{\Gamma(n\alpha)}
\int_{0}^{T} t^{n\alpha-1}\cdot\exp\{-\beta t\}\, \text{d}t,
$$
podemos escrever $\Pr(N = n)$ como sendo a diferença de acumuladas da
Gama,
$$
\Pr(N = n) = G(n\alpha, \beta) - G((n+1)\alpha, \beta).
\Pr(N = n) = G(n\alpha, \beta T) - G((n+1)\alpha, \beta T).
$$
Em resumo, a distribuição para o número de eventos, quando se assume a
distribuição do intervalo entre eventos é Gamma, é resultado da
diferença de duas acumuladas da distribuição Gamma.
A média da variável de contagem é resultado de
$$
\begin{align*}
E(N) &= \sum_{i=0}^{\infty} i\cdot \Pr(i) \\
&= \sum_{i=1}^{\infty} i\cdot \Pr(i)\\
&= \sum_{i=1}^{\infty} G(i\alpha, \beta T).\\
\end{align*}
$$
Para um $T$ cada vez maior, tem-se que
$$
N(T)\; \dot{\sim}\; \text{Normal}\left(
\frac{\beta}{\alpha},
\frac{\beta}{\alpha^2}\right).
$$
Considere que
$$
\frac{\beta}{\alpha} = \exp\{x^{\top}\theta\} \Rightarrow
\beta = \alpha \exp\{x^{\top}\theta\}.
$$
Essa parametrização produz um modelo de regressão para a média do tempo
entre eventos definida por
$$
\text{E}(\tau|x) = \frac{\alpha}{\beta} = \exp\{-x^{\top}\theta\}.
$$
O modelo de regressão é para o tempo entre eventos ($\tau$) e não
diretamente para contagem porque, a menos que $\alpha = 1$, não certo
que $\text{E}(N_i|x_i) = [\text{E}(\tau_i|x_i)]^{-1}$. Dessa maneira,
$-\theta$ mede a variação percentual do tempo médio entre eventos para
uma unidade de $x$.
```{r, message=FALSE, error=FALSE, warning=FALSE}
# Definições da sessão.
library(lattice)
......@@ -1215,6 +1249,237 @@ xyplot(nema/off ~ cult, data = nematoide,
## Número de Gols por Partida de Futebol ##
Análise do número de gols feitos pelos times mandantes e desafiantes no
Campeonato Brasileiro de 2010.
```{r}
#-----------------------------------------------------------------------
# Log-verossimilhança para o número de gols dos times em uma partida.
llgols <- function(theta, gh, ga, Xh, Xa){
# theta: Vetor de parâmetros.
# gh, ga: Gols do mandante e do visitante.
# Xh, Xa: Matrizes de incidência das partidas.
gamma <- 1:20 # Parâmetros de ataque.
delta <- 21:40 # Parâmetros de defesa.
omega <- 41 # Vantagem do mando de campo.
alpha <- 42 # Dispersão da Gamma-Count. Se 0 então Poisson.
#----------------------------------------
# Preditor dos times mandantes e desafiante.
eta.h <- (Xh %*% theta[gamma] - Xa %*% theta[delta]) + theta[omega]
eta.a <- (Xa %*% theta[gamma] - Xh %*% theta[delta])
# Parâmetro de dispersão.
alpha <- exp(theta[alpha])
#----------------------------------------
# Quantidades auxiliares.
alpha.gh <- alpha * gh
alpha.eXb.h <- alpha * exp(eta.h)
alpha.ga <- alpha * ga
alpha.eXb.a <- alpha * exp(eta.a)
offset <- 1
#-------------------------------------------------------------------
# Verossimilhanças.
ll.h <- sum(log(pgamma(offset,
shape = alpha.gh,
rate = alpha.eXb.h) -
pgamma(offset,
shape = alpha.gh + alpha,
rate = alpha.eXb.h)))
ll.a <- sum(log(pgamma(offset,
shape = alpha.ga,
rate = alpha.eXb.a) -
pgamma(offset,
shape = alpha.ga + alpha,
rate = alpha.eXb.a)))
# Verossimilhança total.
ll <- sum(ll.h + ll.a)
return(-ll)
}
#-----------------------------------------------------------------------
# Análise dos jogos do Campeonado Brasileiro.
# Tomando as primeiras rodadas do campeonato.
db <- subset(cambras, rod <= 10)
# Quantos jogos cada time fez em casa e fora de casa.
addmargins(cbind(home = xtabs(~home, db),
away = xtabs(~away, db)), margin = 2)
subset(db, home == "Fluminense")
# Níveis na mesma ordem?
all(levels(db$home) == levels(db$away))
# Matrizes de delineamento.
Xh <- model.matrix(~ -1 + home, db) # h: home.
Xa <- model.matrix(~ -1 + away, db) # a: away.
# Verificação.
Xha <- Xh - Xa
db[1:5, c("home", "away")]
print.table(t(Xha[1:5, ]), zero.print = ".")
#-----------------------------------------------------------------------
# Ajuste do modelos.
# Valores iniciais para o modelo Poisson.
start <- c(rep(1, 40), 0.5, 0)
names(start) <- c(paste0("att", 1:20),
paste0("def", 1:20),
"hfa", "alpha")
parnames(llgols) <- names(start)
m0 <- mle2(minuslogl = llgols,
start = start,
data = list(gh = db$h, ga = db$a, Xh = Xh, Xa = Xa),
fixed = list(alpha = 0),
vecpar = TRUE)
# Valores iniciais para o modelo Gamma-Count.
start <- coef(m0)
parnames(llgols) <- names(start)
m2 <- mle2(minuslogl = llgols,
start = start,
data = list(gh = db$h, ga = db$a, Xh = Xh, Xa = Xa),
vecpar = TRUE)
#-----------------------------------------------------------------------
# Comparando resultados.
# Estimativas dos parâmetros.
c0 <- data.frame(Pois = coef(m0),
GCnt = coef(m2))
c0
xyplot(GCnt ~ Pois, data = c0, aspect = "iso",
groups = gsub(x = rownames(c0), "\\d", ""),
auto.key = TRUE, grid = TRUE) +
layer(panel.abline(a = 0, b = 1))
# Teste para o parâmetro de dispersão.
anova(m0, m2)
# plot(profile(m1, which = "alpha"))
# plot(profile(m2, which = "alpha"))
# Função de risco.
al <- exp(coef(m2)[42])
curve(dgamma(x, al, 1)/(1 - pgamma(x, al, 1)),
from = 0, to = 2,
xlab = "t",
ylab = expression(h(t) == f(t)/(1 - F(t))))
ci <- rbind(cbind(1, coef(m0)[-42], confint(m0, method = "quad")),
cbind(2, coef(m2), confint(m2, method = "quad")))
ci <- as.data.frame(ci)
names(ci) <- c("model", "est", "lwr", "upr")
ci$model <- factor(ci$model, labels = c("Pois", "GCnt"))
ci$par <- factor(sub(pattern = "\\d+",
replacement = "",
x = rownames(ci)))
ci$team <- factor(levels(db$home)[
as.numeric(sub(pattern = "\\D+",
replacement = "",
x = rownames(ci)))])
sb <- subset(ci, par == "att" & model == "GCnt")
ci$team <- factor(ci$team, levels = sb$team[order(sb$est)])
segplot(team ~ lwr + upr | model,
centers = est, data = ci,
draw = FALSE, groups = par, gap = 0.2,
pch = as.integer(ci$par),
key = list(title = "Parâmetro", cex.title = 1.1,
type = "o", divide = 1,
text = list(c("Ataque", "Defesa")),
lines = list(pch = 2:3)),
ylab = "Times (ordenados pelo ataque)",
xlab = "Estimativa do parâmetro",
panel = panel.groups.segplot)
#-----------------------------------------------------------------------
# Gols observados e preditos dos times mandantes e desafiantes nestas
# rodadas.
gg <-
rbind(
cbind(x = 1,
y = db$h,
Pois = c(exp(cbind(Xh, -Xa) %*%
coef(m0)[1:40] + coef(m0)["hfa"])),
GCnt1 = c(exp(cbind(Xh, -Xa) %*%
coef(m2)[1:40] + coef(m2)["hfa"])),
GCnt2 = fitted.gcnt(lambda = exp(cbind(Xh, -Xa) %*%
coef(m2)[1:40] +
coef(m2)["hfa"]),
alpha = exp(coef(m2)["alpha"]))),
cbind(x = 2,
y = db$a,
Pois = c(exp(cbind(Xa, -Xh) %*% coef(m0)[1:40])),
GCnt1 = c(exp(cbind(Xa, -Xh) %*% coef(m2)[1:40])),
GCnt2 = fitted.gcnt(lambda = exp(cbind(Xa, -Xh) %*%
coef(m2)[1:40]),
alpha = exp(coef(m2)["alpha"]))))
# Comparação de observado com predito.
splom(gg[, -1], groups = gg[, 1]) +
layer(panel.abline(a = 0, b = 1))
#-----------------------------------------------------------------------
# Fazendo previsão dos resultados da rodada a seguir.
levels(db$home)
# # Na rodada 11 deu Cruzeiro 2x2 Grêmio.
# i <- which(levels(db$home) %in% c("Cruzeiro", "Grêmio"))
# levels(db$home)[i]
# Na rodada 11 dei Ceará 0x0 Palmeiras.
i <- which(levels(db$home) %in% c("Ceará", "Palmeiras"))
levels(db$home)[i]
# Dois times jogando em território neutro.
# HomeAttack - AwayDefense
# AwayAttack - HomeDefense
alp <- exp(coef(m2)[42])
beta <- exp(coef(m2)[i] - rev(coef(m2)[20 + i]))
beta
exp(-beta)
# Probabilidade dos placares de 0x0, 0x1, ..., 6x6.
y <- 0:6
dnn <- lapply(substr(levels(db$home)[i], 0, 3), FUN = paste, y)
plapois <- outer(dgcnt(y = y, lambda = beta[1], alpha = 1),
dgcnt(y = y, lambda = beta[2], alpha = 1),
FUN = "*")
plagcnt <- outer(dgcnt(y = y, lambda = beta[1], alpha = alp),
dgcnt(y = y, lambda = beta[2], alpha = alp),
FUN = "*")
dimnames(plapois) <- dnn
dimnames(plagcnt) <- dnn
print.table(round(plapois, 2), zero.print = ".")
print.table(round(plagcnt, 2), zero.print = ".")
# Olhando só para os empates.
round(cbind(Pois = diag(plapois),
GCnt = diag(plagcnt)), 3)
# Draw - Win - Lose.
dwl <- rbind(Pois = c(sum(diag(plapois)),
sum(plapois[lower.tri(plapois)]),
sum(plapois[upper.tri(plapois)])),
GCnt = c(sum(diag(plagcnt)),
sum(plagcnt[lower.tri(plagcnt)]),
sum(plagcnt[upper.tri(plagcnt)])))
colnames(dwl) <- sprintf(paste(levels(db$home)[i], collapse = " %s "),
c("=", ">", "<"))
t(dwl)
```
```{r, eval=FALSE, include=FALSE}
opts_chunk$set(eval = FALSE)
```
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment