Arthur Rocha

Introduction

• Like almost everyone here in Brazil, I have a passion for football (or soccer) and because of that my father and I are always alert to the national championship.
  So, a few days ago my father gave me a challenge, he challenged me to understand what is needed to be a champion in the brazilian national soccer league (knowed here as “Brasileirão”) since the competition change its format to a point based championship in 2003.

Thus I’ve accepted the challenge and here are the results:

Data

• Firstly we need to get the data!!

I haven’t found a well structured data base to work with, so I had to work with the information provided by this site and I had to do a function to scrap the data.

• Packages used

library(XML)      #Package to do web scraping
library(dplyr)    #Manipulation
library(magrittr) #Manipulation
library(tidyr)    #Manipulation
library(scales)   #Formatting
library(ggplot2)  #Plots
library(pROC)     #ROC curves

• That is the function to do the web scraping. Note that the site has information only until 2015.

# URL base to all years
url1="futpedia.globo.com/campeonato
/campeonato-brasileiro/"

#Empty data frame to store the information
games= data_frame()

for (i in 2003:2015) { ## years
  url2 = paste0(url1,i)
  
  readHTMLTable(url2,as.data.frame = T)%>%
    data.table::rbindlist()%>%
    setNames(c("Position","Team","Points","Games","Victories","Ties",
               "Losses","Goals scored","Goals conceded","Goal difference",
               "Performance"))%>%
    mutate(Year = i)%>%
    bind_rows(games) -> games
}

If you don’t want to scrap the data (because it can take some time and sometimes doesn’t work so fine) you can get it from here Data!.

Tip: Be aware with the encoding! (use “latin-1”)

• Moving on, we need some extra information, like which team was the champion in the season and how many games (rounds) are in each season, because the number of teams has changed in 2005 and changed again in 2006.

# Champions data
champ_dt = data_frame(Year = 2003:2018,
                      Champion = c("Cruzeiro","Santos","Corinthians","São Paulo",
                                   "São Paulo","São Paulo","Flamengo","Fluminense",
                                   "Corinthians","Fluminense","Cruzeiro","Cruzeiro",
                                   "Corinthians","Palmeiras","Corinthias","Palmeiras"))

games %<>%  # Tracking the round (game) number
  mutate(Round = c(rep(rep(1:38,each =20),10),
                   rep(1:42,each =22),
                   rep(1:46,each =24),rep(1:46,each =24)))%>%
  
  # Finding the champion in each season
  inner_join(champ_dt) %>%
  # Is this team the champion of this year?
  mutate(Champ = if_else(Team == Champion, 1,0),
         # Total number of games in the season
         N_round = case_when(Year < 2005 ~ 46,
                             Year == 2005 ~ 42,
                             Year > 2005 ~38),
         # In this round, this team is in the first place?
         First_place = if_else(Position ==1,1,0 ),
         # In this round, this team is in the first place
         # and is the champion?
         TP = if_else(First_place == 1 & Champ == 1,
                      1,0),
         # In this round, this team is in the first place
         # and isn't the champion?
         TN = if_else(First_place == 1 & Champ == 1,
                      1,0))

• Let’s take a look in the data

head(games)

##   Position         Team Points Games Victories Ties Losses Goals scored
## 1        1        Sport      3     1         1    0      0            4
## 2        2 Athletico-PR      3     1         1    0      0            3
## 3        3  Chapecoense      3     1         1    0      0            2
## 4        3    São Paulo      3     1         1    0      0            2
## 5        5  Corinthians      3     1         1    0      0            1
## 6        6   Fluminense      3     1         1    0      0            1
##   Goals conceded Goal difference Performance Year Round    Champion Champ
## 1              1               3         100 2015     1 Corinthians     0
## 2              0               3         100 2015     1 Corinthians     0
## 3              1               1         100 2015     1 Corinthians     0
## 4              1               1         100 2015     1 Corinthians     0
## 5              0               1         100 2015     1 Corinthians     1
## 6              0               1         100 2015     1 Corinthians     0
##   N_round First_place TP TN
## 1      38           1  0  0
## 2      38           0  0  0
## 3      38           0  0  0
## 4      38           0  0  0
## 5      38           0  0  0
## 6      38           0  0  0

All seems ok, let’s continue…

Analysing the initial rounds.

• So, now we can analyse the data. Initially, we can try to find the “champion profile” at the 5th and 10th round.

# Making a plot
games %>%
  filter(Round == 5)%>%
  select(Points, Victories, Ties, Losses,
         `Goals scored`, `Goals conceded`,
         Position,Champ)%>%
  mutate_all(.funs = as.numeric)%>%
  mutate(Champ = factor(Champ, labels= c("Not champion","Champion")))%>%
  gather(key="Variable",value="value",-c(Champ))%>%
  group_by(Champ,Variable)%>%
  mutate(tot = n())%>%
  group_by(Champ,Variable,value)%>%
  summarise(freq = n(), tot=mean(tot))%>%
  mutate(perc = freq/tot)%>%
  ggplot(aes(value,perc,fill=Champ))+
  geom_col(width = 1,col=1,alpha=.3)+
  facet_wrap(~Variable,scales = "free")+
  theme_light()+
  scale_fill_discrete("")+
  ylab("Frequency (%)")+
  scale_y_continuous(labels = scales::percent)

# Making a table
games %>%
  filter(Round == 5)%>%
  select(Points, Victories, Ties, Losses,
         `Goals scored`, `Goals conceded`,
         Position,Champ,Performance)%>%
  mutate_all(.funs = as.numeric)%>%
  mutate(Champ = factor(Champ, labels= c("Not champion","Champion")))%>%
  gather(key="Variable",value="value",-c(Champ))%>%
  group_by(Variable,Champ)%>%
  summarise(Min= min(value),
            Mean = mean(value) %>% round(digits = 2),
            Max = max(value),
            SD = sd(value) %>% round(digits = 2))%>%
  knitr::kable()

# Making a plot
games %>%
  filter(Round == 10)%>%
  select(Points, Victories, Ties, Losses,
         `Goals scored`, `Goals conceded`,
         Position,Champ)%>%
  mutate_all(.funs = as.numeric)%>%
  mutate(Champ = factor(Champ, labels= c("Not champion","Champion")))%>%
  gather(key="Variable",value="value",-c(Champ))%>%
  mutate(y = if_else(Champ=="Champion", value/13,value/ 270 ))%>%
  ggplot(aes(value,fill=Champ))+
  #geom_point()+
  geom_histogram(aes(y=..density..),binwidth = 1,col=1,alpha=.3)+
  facet_wrap( ~Variable,scales = "free")+
  theme_light()+
  scale_fill_discrete("")+
  ylab("Frequency (%)")+
  scale_y_continuous(labels = scales::percent)+
  scale_x_continuous(breaks = seq(0,30,by=4))

# Making a table
games %>%
  filter(Round == 10)%>%
  select(Points, Victories, Ties, Losses,
         `Goals scored`, `Goals conceded`,
         Position,Champ,Performance)%>%
  mutate_all(.funs = as.numeric)%>%
  mutate(Champ = factor(Champ, labels= c("Not champion","Champion")))%>%
  gather(key="Variable",value="value",-c(Champ))%>%
  group_by(Variable,Champ)%>%
  summarise(Min= min(value),
            Mean = mean(value) %>% round(digits = 2),
            Max = max(value),
            SD = sd(value)%>% round(digits = 2))%>%
  knitr::kable()

How many rounds on top make a champion?

So, to answer my dad’s question about the football champions I thought that discovery the numbers of rounds in the first place would be of great value.

• Thus now we need to count the number of rounds in first place of each team in each season (year).

games %>%
  group_by(Year,Team)%>%
  #Counting the number of rounds on top
  summarise(Rounds_on_top = sum(First_place))%>%
  inner_join(champ_dt)%>%
  #Was this team the champion of the season?
  mutate(Won = (Team==Champion),
         Won = as.numeric(Won),
         N_round = case_when(Year < 2005 ~ 46,
                             Year == 2005 ~ 42,
                             Year > 2005 ~38)) -> first_place_df

• We can now calcule the proportions of rounds needed.

first_place_df%>%
  mutate(Proportion = Rounds_on_top/N_round,
         Won = factor(Won,labels = c("Not champion",
                                 "Champion")))%>%
  ggplot(aes(Proportion))+
  geom_histogram(bins = 5,col=1,alpha=.5)+
  facet_wrap(~Won,scales = "free_y")+
  theme_light()

first_place_df%>%
  mutate(Proportion = Rounds_on_top/N_round,
         Won = factor(Won,labels = c("Not champion",
                                 "Champion")))%>%
  group_by(Won)%>%
  summarise(min_n=min(Rounds_on_top) %>% round(digits = 2),
            mean_n = mean(Rounds_on_top) %>% round(digits = 2),
            max_n=max(Rounds_on_top) %>% round(digits = 2),
            min_prop=min(Proportion) %>% percent(),
            mean_prop = mean(Proportion) %>% percent(),
            max_prop=max(Proportion) %>% percent())%>%
  knitr::kable()

• So, we can note that the minimum number of rounds on top was 2 (Flamengo, 2009), while the maximum number was 38 (Cruzeiro, 2003) and the average was about 22 games. Looking on the proportions, we can see that the champions often stays on the top a bit more than half of the championship (56,4%).

first_place_df%<>%
  mutate(Proportion = Rounds_on_top/N_round)

#fitting the model

fit=glm(Won ~ Proportion,
        family = binomial(link = "logit"),
        data=first_place_df)

summary(fit)

## 
## Call:
## glm(formula = Won ~ Proportion, family = binomial(link = "logit"), 
##     data = first_place_df)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -1.30508  -0.08386  -0.08386  -0.08386   3.14843  
## 
## Coefficients:
##             Estimate Std. Error z value Pr(>|z|)    
## (Intercept)  -5.6485     0.9264  -6.097 1.08e-09 ***
## Proportion   13.2860     2.5762   5.157 2.51e-07 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 104.234  on 269  degrees of freedom
## Residual deviance:  28.442  on 268  degrees of freedom
## AIC: 32.442
## 
## Number of Fisher Scoring iterations: 8

(ROC = roc(Won ~ Proportion,data=first_place_df,percent=T))

## 
## Call:
## roc.formula(formula = Won ~ Proportion, data = first_place_df,     percent = T)
## 
## Data: Proportion in 257 controls (Won 0) < 13 cases (Won 1).
## Area under the curve: 98.59%

ggroc(ROC)+
  theme_light()

data_frame(Proportion = ROC$thresholds,
           Sens = ROC$sensitivities %>% round(digits = 2),
           Speci = ROC$specificities %>% round(digits = 2))%>%
  mutate(Proportion = percent(Proportion))%>%
  knitr::kable()

data_frame(Proportion=seq(0,1,by=.05),
           prob=predict(fit,
                        newdata = data_frame(Proportion=seq(0,1,by=.05)),
                        type = "response")
)%>%
  mutate(prob = percent(prob))%>%
  knitr::kable()