Brasileirão 2011 - 50 jogos restando - probabilidades completas

Conforme comentei no post anterior, iria utilizar meu tempo livre para calcular corretamente as probabilidades de sulamericana e libertadores, que eram um pouco menos triviais que as demais, pois temos Vasco e Santos já classificados para a CopaLibertadores e com probabilidades reais de estarem entre os quatro primeiros lugares ao fim do Campeonato Brasileiro de 2011.

Em uma primeira olhada para o problema, nos deparamos com uma  sequência complexa decálculos de probabilidades que podem ser resumidos a algo como:

P(libertadores) = P(clubeterminar entre os 4 primeiros lugares) +

    + P(clube terminar em 5º | Vasco terminou entre os 4) +

    + P(clube terminar em 5º | Santos terminou entre os 4) +

    + P(clube terminar em 6º | Vasco E Santos terminaram entre os 5)

Se for pensar em termos de copa sulamericana, o grau de complexidade é o mesmo, com probabilidades sendo calculadas como:

P(sulamericana) = P(clube terminar entre 7º e 12º lugar) +

    + P(clube terminar em 13º | Vasco terminou até 12º) +

    + P(clube terminar em 13º | Santos terminou até 12º) +

    + P(clube terminar em 14º | Santos E Vasco até 13º) +

    + P(clube terminar em 5º | Santos E Vasco entre 6º e 20º) +

    + P(clube terminar em 6º | Santos E Vasco entre 7º e 20º)

Para nossa sorte, estas regras são equivalentes a se fazer uma tabela de classificação sem a presença de Vasco e Santos (Clubes com vaga assegurada na Copa libertadores). no caso do software R, esta ação se resume ao código apresentado a seguir:

standings.restrict <- function(st, restrictions) {
    rnk <-  rank(st[!(st$Equipe %in% restrictions),]$Pos)
    st.t <- data.frame(
        Equipe = st$Equipe[!(st$Equipe %in% restrictions)],
        Ranking = as.numeric(rnk)
    )
    st.final <- merge(st,st.t, all.x=TRUE)
    return(st.final)
}

e para se chegar às probabilidades, se precisa apenas fazer uso da seguinte função:

probabilities <- function(df) {
    Eq <- levels(df$Equipe)
    dft <- as.data.frame(prob.position(df))
    dfr <- as.data.frame(prob.ranking(df))
    p.Champ <- aggregate(
        Freq ~ Equipe, data = dft[dft$Pos == 1,], sum)
    p.libert <- aggregate(
        Freq ~ Equipe, data = dfr[dfr$Ranking %in% (1:4),], sum)
    p.sulam <- aggregate(
        Freq ~ Equipe, data = dfr[dfr$Ranking %in% (5:12),], sum)
    p.relegate <- aggregate(
        Freq ~ Equipe, data = dft[dft$Pos %in% (17:20),], sum)
    prob <- as.data.frame(cbind(
        champ=p.Champ$Freq,
        libert=p.libert$Freq,
        sulam = p.sulam$Freq,
        rebaixa=p.relegate$Freq
    ))
    rownames(prob) <- Eq
   
    prob[rownames(prob) %in% c("Santos","Vasco"),]$libert = 1.0

    return((prob))
}

o resultado da função acima, se aplicado aos dados de simulação realizados no último domingo/segunda, é o seguinte:

> probabilities(dados.1)
                champ  libert   sulam rebaixa
América/MG    0.00000 0.00000 0.00016 0.98952
Atlético/GO   0.00000 0.00004 0.93968 0.00158
Atlético/MG   0.00000 0.00000 0.66450 0.04864
Atlético/PR   0.00000 0.00000 0.03360 0.75750
Avaí          0.00000 0.00000 0.00062 0.98130
Bahia         0.00000 0.00000 0.42980 0.14464
Botafogo      0.03962 0.62346 0.37654 0.00000
Ceará         0.00000 0.00000 0.13686 0.48174
Corinthians   0.39330 0.97724 0.02276 0.00000
Coritiba      0.00006 0.07784 0.92216 0.00000
Cruzeiro      0.00000 0.00000 0.09860 0.56462
Figueirense   0.01978 0.47328 0.52672 0.00000
Flamengo      0.02462 0.52856 0.47144 0.00000
Fluminense    0.17970 0.88926 0.11074 0.00000
Grêmio        0.00000 0.01308 0.98364 0.00000
Internacional 0.00184 0.25112 0.74888 0.00000
Palmeiras     0.00000 0.00000 0.69942 0.03046
Santos        0.00000 1.00000 0.00000 0.00000
São Paulo     0.00044 0.16612 0.83388 0.00000
Vasco         0.34064 1.00000 0.00000 0.00000
>

Como esta série de posts é apenas de carater de demonstração, fico no dever de analisar  toda e qualquer sugestão, inclusive para melhoria do código postado neste blog. Para aproveitar o resultado da última simulação, tornou-se também necessária a construção de uma rotina para a geração da nova classificação. Ela funciona bem na prática e reflete muito do que encontramos em nossa prática profissional, onde temos situações onde devemos tentar aproveitar o máximo da informação que já possuímos. muitas vezes se paga o preço de rodar um comando que demora 3 horas e que foi codificado em igual periodo de tempo a se gastar 3 a 4 dias para se obter uma solução alguns segundos mais rápida. O mundo gira e o prejuízo muitas vezes bate à sua porta.

Continuo também à disposição de vocês através de meu twitter @_ldeassis_