R-ohjelmointi.org

Tilastotieteellistä ohjelmointia R-kielellä

Veikkausliiga 2015 – joukkueiden tuloksia ja katsojamäärien ennustamista

Veikkausliiga on Suomen korkein sarjataso miesten jalkapallossa. Veikkausliigalla on oma kotisivu, jolta löytyy muun muassa eri vuosien tilastoja. Liigan voittaja on jalkapallon Suomen-mestari.

Veikkausliigassa pelaa tällä hetkelllä 12 joukkuetta, joista jokainen saa 16 tai 17 kotiottelua. Kullekin joukkueelle kertyy siis kauden aikana yhteensä 33 ottelua. Sarjan joukkueet kohtaavat toisensa kauden aikana kolmesti. Kunkin ottelun voitosta saa 3 pistettä, tasapelistä 1 pisteen ja häviöstä 0 pistettä.

Katsotaanpa, miltä näytti Veikkausliigan kausi2015.

Joukkueiden sijoitusten ja pisteiden kehitys kauden aikana

Vasemmalla on esitetty joukkueiden sijoitusten kehitys kauden aikana kunkin joukkueen pelaamien otteluiden lukumäärän funktiona. Esimerkiksi RoPS:n nousu alkukaudesta näyttää hyvin nopealta. HIFK taas suoriutui hyvin tasaisisesti, ja sen sijoitus pysyi sijojen 7-9 välillä pääosan kaudesta.

Oikealla olevaan kuvaan on merkitty kunkin ottelun tulos: voitto, tasapeli tai häviö.

kuva2

Joukkueiden pistemäärien kehityksessä (vasemmalla) otteluiden lukumäärän funktiona ei näy sijoitusten vaihtelua vastaava heilahtelu yhtä selkeästi. Toki Veikkausliigan 2015 kolmen kärki eroaa kuvassa muista jo melko alkuvaiheessa, viimeistäänkin kolmaosakauden kuluttua.

Kotiotteluiden keskimääräisissä katsojamäärissä on suuria eroa eri joukkueiden välillä. HJK keräsi keskimäärin suurimman katsojamäärän, IFK Mariehamn puolestaan pienimmän. Osa eroista johtuu varmasti kotipaikkojen sijainneista.

kuva3

Katsojamäärät

Katsojamäärien seuraaminen ja ennustaminen on mielenkiintoista, mutta ei täysin yksioikoista. Todennäköisesti katsojamääriin vaikuttavat muun muassa ottelun tyyppi (koti- vai vierasottelu), paikkakunta, sää, kenties myös ottelun kuukausi tai esimerkiksi viikonpäivä. Kuntopuntari-blogissa on esitetty tarkempi yhteenveto ja arviointi yleisömääristä, mutta voitaisiinko ottelun todennäköistä katsojamäärää ennustaa jo ennalta?

Ensimmäisenä tulee mieleen käyttää yksinkertaista menetelmää, josa ottelun katsojamäärää verrataan koti- ja vierasjoukkueen osalta koko liigan keskiarvoon ja kotijoukkueen keskiarvoon. Tulos näyttää seuraavalta:

Tämän yksinkertaisen mallin perusteella liigan suurimmat vetonaulat ovat HJK ja HIFK, jotka keräävät muita enemmän katsojia erityisesti vierasotteluihinsa. Kotiotteluissa seuraan liittyy Ilves, vierasotteluissa FF Jaro.

kuva4

Monimutkaisempi malli voidaan sovittaa aineistoon vaikkapa regressiomallilla. Jos mallissa huomioidaan koti- ja vierasjoukkueiden lisäksi myös kuukausi ja ottelun päivämäärä, saadaan edellistä yksinkertaista mallia parempi ennuste. Yksinkertainen malli antaa keskimääräiseksi ennustevirheeksi 211 katsojaa, regressiomalli vain 41 asiakasta, jos ennustemallilla ennustetaan Veikkausliigan 2016 pelien katsojamääriä.

Mallin antamat ennusteet ovat visualisointina seuraavat:
kuva5

Kuvaa voidaan lukea siten, että keskimääräisen ottelun katsojamäärä on noin 2400 katsojaa. Jos kotijoukkueena on IFK Mariehamn, on katsojamäärä kuitenkin keskimäärin noin 1200 katsojaa pienempi eli vain noin 1200 katsojaa. Samalla periaatteella jos peli on heinäkuussa, on katsojamäärä keskimäärin noin 80 katsojaa suurempi, ja jos peli on perjantaina, on katsojamäärä 580 katsojaa suurempi. Siten heinäkuisena perjantaina Maarianhaminassa pelattavan pelin katsojamääräksi olisi odotettavissa 2400 – 1200 + 80 + 580 = 1860 katsojaa.

En tiedä, onko Veikkausliigalla käytössä ennustemallia katsojamäärän arvioimiseksi jo ennen peliä, mutta yllä esitelty malli antaa melko hyviä arvioita. Mallissa on kuitenkin vielä parannettavaa, sillä sovitettu malli on mallin oletuksia ajatellen ”hieman” epätyydyttävä.

Yhteenveto

Veikkausliigan tilastot ovat julkisesti helposti saatavilla, ja niiden analysoiminen on siten helpohkoa. Katsojalukumäärien ennustaminen osoittautui yllättävän hankalaksi, ja sovitettu malli on edelleen huonohko, vaikka se antaakin jokseenkin järkeviä ennusteita. Eräänä suurimpana ongelmana on, että mallin residuaalit on heteroskedastisia, mikä täytyy korjata seuraavaan versioon.

R-koodi

Ylempänä esiteltyjen analyysien tuottamiseen käytetty R-koodi on koottu alle.

# Ladataan paketit
library(XML)
library(zoo)
library(reshape2)
library(RColorBrewer)
library(extrafont)
 
# Ladataan data
ottelut<-readHTMLTable("http://www.veikkausliiga.com/tilastot/spljp15/ottelut/")$games
joukkueet<-readHTMLTable("http://www.veikkausliiga.com/tilastot/spljp15/joukkueet/")$stats
 
 
# Muotoillaan dataa haluttuun muotoon
o1<-t(as.data.frame(strsplit(as.character(ottelut$Ottelu), " - ")))
rownames(o1)<-NULL
ottelut$koti<-o1[,1]
ottelut$vieras<-o1[,2]
 
o2<-t(as.data.frame(strsplit(as.character(ottelut$Tulos), " ")))
rownames(o1)<-NULL
ottelut$koti_tulos<-o2[,1]
ottelut$vieras_tulos<-o2[,3]
 
ottelut$koti_voitto<-ifelse(ottelut$koti_tulos > ottelut$vieras_tulos, 1, 0)
ottelut$vieras_voitto<-ifelse(ottelut$koti_tulos < ottelut$vieras_tulos, 1, 0)
 
ottelut$tulos<-0
ottelut$tulos[ottelut$koti_voitto==1]<-1
ottelut$tulos[ottelut$vieras_voitto==1]<-(-1)
 
ottelut$Pvm[as.character(ottelut$Pvm)==""]<-"NA"
ottelut$pvm<-as.Date(substr(na.locf(as.character(ottelut$Pvm)), 4, 25), format="%d.%m.%Y")
 
colnames(ottelut)[7]<-"Yleisöä"
ottelut$Yleisöä<-as.numeric(as.character(ottelut$Yleisöä))
 
tmp<-data.frame(joukkue=c(ottelut$koti, ottelut$vieras), pvm=c(ottelut$pvm, ottelut$pvm), tulos=c(ottelut$tulos, ottelut$tulos))
tmp2<-dcast(tmp, joukkue~pvm)
 
 
# Otteluiden voitot ja häviöt
m2<-matrix(ncol=33, nrow=nrow(tmp2), data=NA)
rownames(m2)<-tmp2$joukkue
for(i in 1:nrow(m2)) {
 
   d1<-ottelut[ottelut$koti==rownames(m2)[i] | ottelut$vieras==rownames(m2)[i],]
   indk<-which(d1$koti==rownames(m2)[i])
   indv<-which(d1$vieras==rownames(m2)[i])
   res<-rep(NA, nrow(d1))
 
   res[indk[d1$koti_tulos[indk] > d1$vieras_tulos[indk]]]<-1
   res[indk[d1$koti_tulos[indk] < d1$vieras_tulos[indk]]]<-(-1)
   res[indk[d1$koti_tulos[indk] == d1$vieras_tulos[indk]]]<-0
 
   res[indv[d1$vieras_tulos[indv] > d1$koti_tulos[indv]]]<-1
   res[indv[d1$vieras_tulos[indv] < d1$koti_tulos[indv]]]<-(-1)
   res[indv[d1$vieras_tulos[indv] == d1$koti_tulos[indv]]]<-0
 
   m2[i,1:length(res)]<-res
 
}
 
# Voitot ja häviöt pisteiksi
m3<-m2
m3[m3==1]<-3
m3[m3==0]<-1
m3[m3==-1]<-0
 
# Kumulatiiviset summat
m4<-t(apply(m3, 1, cumsum))
 
# Ranking
#m5<-apply(m4, 2, function(x) floor(rank(-x)))
m5<-apply(m4, 2, function(x) floor(rank(x)))
 
 
 
# Paneelikuva 1 (kuva1.png)
 
# Avataan ikkuna
windows(width=15, height=10)
 
#pdf(file="C:/Users/Acer/Desktop/testi2.pdf", width=297/25.4, height=160/25.4)
 
# Määritellään asettelu
l<-layout(matrix(nrow=2, ncol=2, data=c(1,1,2,3), byrow=T), heights=c(0.1, 0.9), widths=c(0.75, 0.25))
 
# Otsikko, Kuva 1
par(mar=c(0,0,0,0))
plot(0,0,xlab="",ylab="",axes=F)
text(x=0, y=0, cex=3, labels="Veikkausliiga 2015", col="grey40", family="Segoe UI Black")
 
# Kuva 2
par(mar=c(3,4,4,8), xaxs="i", yaxs="i")
matplot(t(m5), type="l", lwd=6, lty=1, col="grey75", axes=F, xlab="", ylab="", ylim=c(0.9, 12.1), xlim=c(0.8, 33.2))
abline(h=1:12, col="grey90")
abline(v=1:33, col="grey90")
matplot(t(m5), type="l", lwd=6, lty=1, col="grey75", axes=F, xlab="", ylab="", add=T)
matplot(t(m5), type="l", lwd=4, lty=1, col=brewer.pal(12, "Set3"), add=T)
#mtext(side=4, at=m5[,33], text=names(m5[,33]), las=1, family="Segoe UI Black")
mtext(side=4, at=m5[,33], line=4, text=names(m5[,33]), las=1, family="Segoe UI Black",col="grey40",adj=0.5)
mtext(side=2, at=1:12, line=1, text=12:1, las=1, family="Segoe UI Black",col="grey40")
mtext(side=1, at=17, line=1.5, text="Ottelut", family="Segoe UI Black",col="grey40")
mtext(side=1, at=1:33, line=0.25, text=1:33, family="Segoe UI Black",col="grey40", cex=0.75)
par(xpd=NA)
mtext(side=2, at=13, line=0, text="Sijoitus", las=1, family="Segoe UI Black",col="grey40")
par(xpd=FALSE)
title(main="Joukkueiden sijoitusten kehitys kauden aikana", family="Segoe UI Black", col.main="grey40", cex.main=1.5)
 
# Kuva 3
m6<-m2[order(m5[,33], decreasing=FALSE),]
par(mar=c(3,0.5,4,1), xaxs="i", yaxs="i")
plot(y=rep(1,33)+ifelse(m6[1,]==1, 0.15, ifelse(m6[1,]==-1, -0.15, 0)), x=1:33, 
     col=ifelse(m6[1,]==1, "black", ifelse(m6[1,]==-1, "#CC0000", "grey75")), pch=15, ylim=c(0.75,12.25), xlim=c(0.7, 33.3),
     axes=F, xlab="", ylab="")
#abline(h=1:12, col="grey90")
points(y=rep(1,33)+ifelse(m6[1,]==1, 0.15, ifelse(m6[1,]==-1, -0.15, 0)), x=1:33, 
     col=ifelse(m6[1,]==1, "black", ifelse(m6[1,]==-1, "#CC0000", "grey75")), pch=15)
for(i in 2:nrow(m6)) {
   points(y=rep(i,33)+ifelse(m6[i,]==1, 0.15, ifelse(m6[i,]==-1, -0.15, 0)), x=1:33, 
        col=ifelse(m6[i,]==1, "black", ifelse(m6[i,]==-1, "#CC0000", "grey75")), pch=15)
}
title(main="Otteluiden tulokset", family="Segoe UI Black", col.main="grey40", cex.main=1.5)
par(xpd=NA)
legend(x=3, y=0.5, fill=c("black", "grey75", "#CC0000"), border=c("black", "grey75", "#CC0000"), legend=c("Voitto", "Tasapeli", "Tappio"), ncol=3, bty="n")
par(xpd=FALSE)
 
 
 
# Paneelikuva 2
 
# Määritellään asettelu
l<-layout(matrix(nrow=2, ncol=2, data=c(1,1,2,3), byrow=T), heights=c(0.1, 0.9), widths=c(0.72, 0.28))
 
# Otsikko, Kuva 1
par(mar=c(0,0,0,0))
plot(0,0,xlab="",ylab="",axes=F)
text(x=0, y=0, cex=3, labels="Veikkausliiga 2015", col="grey40", family="Segoe UI Black")
 
# Kuva 2
par(mar=c(3,4,4,8), xaxs="i", yaxs="i")
matplot(t(m5), type="l", lwd=8, lty=1, col="grey75", axes=F, xlab="", ylab="", ylim=c(0.9, 12.1), xlim=c(0.8, 33.2))
abline(h=1:12, col="grey90")
abline(v=1:33, col="grey90")
matplot(t(m5), type="l", lwd=8, lty=1, col="grey75", axes=F, xlab="", ylab="", add=T)
matplot(t(m5), type="l", lwd=6, lty=1, col=brewer.pal(12, "Set3"), add=T)
#mtext(side=4, at=m5[,33], text=names(m5[,33]), las=1, family="Segoe UI Black")
mtext(side=4, at=m5[,33], line=4, text=names(m5[,33]), las=1, family="Segoe UI Black",col="grey40",adj=0.5)
mtext(side=2, at=1:12, line=1, text=12:1, las=1, family="Segoe UI Black",col="grey40")
mtext(side=1, at=17, line=1.5, text="Ottelut", family="Segoe UI Black",col="grey40")
mtext(side=1, at=1:33, line=0.25, text=1:33, family="Segoe UI Black",col="grey40", cex=0.75)
par(xpd=NA)
mtext(side=2, at=13, line=0, text="Sijoitus", las=1, family="Segoe UI Black",col="grey40")
par(xpd=FALSE)
title(main="Joukkueiden sijoitusten kehitys kauden aikana", family="Segoe UI Black", col.main="grey40", cex.main=1.5)
 
# Kuva 3
tf<-0.175
cf<-1.35
m6<-m2[order(m5[,33], decreasing=FALSE),]
par(mar=c(3,0.5,4,1), xaxs="i", yaxs="i")
plot(y=rep(1,33)+ifelse(m6[1,]==1, tf, ifelse(m6[1,]==-1, -tf, 0)), x=1:33, 
     col=ifelse(m6[1,]==1, "black", ifelse(m6[1,]==-1, "#CC0000", "grey75")), pch=15, ylim=c(0.75,12.25), xlim=c(0.7, 33.3),
     axes=F, xlab="", ylab="", cex=cf)
#abline(h=1:12, col="grey90")
points(y=rep(1,33)+ifelse(m6[1,]==1, tf, ifelse(m6[1,]==-1, -tf, 0)), x=1:33, 
     col=ifelse(m6[1,]==1, "black", ifelse(m6[1,]==-1, "#CC0000", "grey75")), pch=15, cex=cf)
for(i in 2:nrow(m6)) {
   points(y=rep(i,33)+ifelse(m6[i,]==1, tf, ifelse(m6[i,]==-1, -tf, 0)), x=1:33, 
        col=ifelse(m6[i,]==1, "black", ifelse(m6[i,]==-1, "#CC0000", "grey75")), pch=15, cex=cf)
}
title(main="Otteluiden tulokset", family="Segoe UI Black", col.main="grey40", cex.main=1.5)
par(xpd=NA)
legend(x=3, y=0.5, fill=c("black", "grey75", "#CC0000"), border=c("black", "grey75", "#CC0000"), legend=c("Voitto", "Tasapeli", "Tappio"), ncol=3, bty="n")
par(xpd=FALSE)
 
 
 
# Paneelikuva 3
 
# Määritellään asettelu
l<-layout(matrix(nrow=2, ncol=2, data=c(1,1,2,3), byrow=T), heights=c(0.1, 0.9), widths=c(0.72, 0.28))
 
par(mar=c(0,0,0,0))
plot(0,0,xlab="",ylab="",axes=F,col=0)
text(x=0, y=0, cex=3, labels="Veikkausliiga 2015", col="grey40", family="Segoe UI Black")
 
par(mar=c(3,4,4,8), xaxs="i", yaxs="i")
matplot(t(m4), type="l", lwd=6, lty=1, col="grey75", axes=F, xlab="", ylab="", ylim=c(-0.1, 60.1), xlim=c(0.5, 33.5))
abline(h=seq(0,60,3), col="grey90")
abline(v=1:33, col="grey90")
matplot(t(m4), type="l", lwd=6, lty=1, axes=F, xlab="", ylab="", ylim=c(-0.1, 60.1), xlim=c(0.5, 33.5), col=brewer.pal(12, "Set3"), add=T)
mtext(side=4, at=m4[,33], line=1, text=names(m4[,33]), las=1, family="Segoe UI Black",col=brewer.pal(12, "Set3"),font=2)
mtext(side=1, at=17, line=1.5, text="Ottelut", family="Segoe UI Black",col="grey40")
mtext(side=1, at=1:33, line=0.25, text=1:33, family="Segoe UI Black",col="grey40", cex=0.75)
mtext(side=2, at=seq(0,60,3), line=1, text=seq(0,60,3), las=1, family="Segoe UI Black",col="grey40")
title(main="Joukkueiden pisteiden kehitys kauden aikana", family="Segoe UI Black", col.main="grey40", cex.main=1.5)
par(xpd=NA)
mtext(side=2, at=63, line=-0.5, text="Pisteet", las=1, family="Segoe UI Black",col="grey40")
par(xpd=FALSE)
 
ottelut[,7]<-as.numeric(as.character(ottelut[,7]))
colnames(ottelut)[7]<-"yleisöä"
a<-aggregate(ottelut$yleisöä, list(ottelut$koti, ottelut$vieras), mean)
b<-aggregate(ottelut$yleisöä, list(ottelut$koti), mean)
a$koti<-b$x[match(a$Group.1, b$Group.1)]
colnames(a)<-c("kotijoukkue", "vierasjoukkue", "katsojia", "koti_ka")
a<-a[order(a$kotijoukkue, a$vierasjoukkue),]
a$erotus<-a$katsojia-a$koti_ka
 
par(mar=c(3,8,4,1), xaxs="i", yaxs="i")
b<-aggregate(ottelut$yleisöä, list(ottelut$koti), mean)
rownames(b)<-b$Group.1
b[rownames(m4[order(m4[,33]),]),]
b$col=brewer.pal(12, "Set3")
b<-b[order(b$x),]
bp<-barplot(b[order(b$x),]$x, horiz=T, col=b$col, border=b$col, las=1, axes=F)
mtext(side=2, at=bp, line=1, text=rownames(b), las=1, family="Segoe UI Black",col="grey40")
abline(v=c(1:6)*1000, col="white")
mtext(side=1, at=1:5*1000, line=0.25, text=as.character(1:5*1000), family="Segoe UI Black",col="grey40", cex=0.75)
mtext(side=1, at=2500, line=1.5, text="Yleisöä keskimäärin (lkm)", family="Segoe UI Black",col="grey40", cex=0.75)
title(main="Yleisöä kotijoukkueiden \notteluissa", family="Segoe UI Black", col.main="grey40", cex.main=1.25)
 
 
 
# Paneelikuva 4
 
a$koko_ka<-mean(ottelut$yleisöä)
a$erotus0<-a$koti_ka-a$koko_ka  # Erotus koko keskiarvosta - kotijoukkueen vaikutus
a$erotus1<-a$katsojia-a$koti_ka # Erotus kotipelin keskiarvosta - vierasjoukkueen vaikutus
s1<-aggregate(a$erotus0, list(a$kotijoukkue),mean)
s2<-aggregate(a$erotus1, list(a$vierasjoukkue),mean)
rownames(s1)<-s1$Group.1
rownames(s2)<-s2$Group.1
s1<-s1[rownames(m4[order(m4[,33]),]),]
s1$col=brewer.pal(12, "Set3")
s1<-s1[order(s1$Group.1),]
s2<-s2[rownames(m4[order(m4[,33]),]),]
s2$col=brewer.pal(12, "Set3")
s2<-s2[order(s2$Group.1),]
 
par(mfrow=c(1,2))
par(mar=c(3, 7, 3, 1))
barplot(s1$x, xlim=c(-2000, 3000), las=1, horiz=T, names.arg=s2$Group.1, col=s1$col, border=s1$col, main="Kotijoukkueen vaikutus yleisön määrään \nverrattuna koko liigan keskiarvoon", family="Segoe UI Black", col.axis="grey40", col.main="grey40")
abline(v=c(-3:3)*1000, col="white")
abline(v=0,col="grey75")
barplot(s2$x, names.arg=s2$Group.1, las=1, xlim=c(-2000, 3000), horiz=T, col=s2$col, border=s2$col, main="Vierasjoukkueen vaikutus yleisön määrään \nverrattuna kotijoukkueen keskiarvoon", family="Segoe UI Black", col.axis="grey40", col.main="grey40")
abline(v=c(-3:3)*1000, col="white")
abline(v=0,col="grey75")
 
# Regressiomalli katsojamääristä
test<-ottelut[,c(7,8,9)]
fit<-lm(yleisöä~koti+vieras, data=test)
test$predict<-as.numeric(predict(fit))
fit2<-lm(yleisöä~koti*vieras, data=test)
test$predict2<-as.numeric(predict(fit2))
 
ottelut$kuukausi<-months(as.Date(substr(na.locf(ottelut$Pvm), 4, 20), format="%d.%m.%Y"))
ottelut$viikonpäivä<-substr(na.locf(ottelut$Pvm), 1, 2)
test<-ottelut[,c(7,8,9,16,17)]
fit3<-lm(yleisöä~koti+vieras+kuukausi+viikonpäivä, data=test)
fit4<-lm(yleisöä~koti+vieras+kuukausi, data=test)
 
ottelut16<-readHTMLTable("http://www.veikkausliiga.com/tilastot/2016/veikkausliiga/ottelut/")$games
o1<-t(as.data.frame(strsplit(as.character(ottelut16$Ottelu), " - ")))
rownames(o1)<-NULL
ottelut16$koti<-o1[,1]
ottelut16$vieras<-o1[,2]
ot16<-ottelut16[-which(ottelut16$koti %in% c("PK-35 Vantaa", "PS Kemi") | ottelut16$vieras %in% c("PK-35 Vantaa", "PS Kemi")),]
ot16<-ot16[!ot16$Tulos == "-",]
ot16$Pvm[ot16$Pvm==""]<-NA
ot16$kuukausi<-months(as.Date(substr(na.locf(ot16$Pvm), 4, 20), format="%d.%m.%Y"))
ot16$viikonpäivä<-substr(na.locf(ot16$Pvm), 1, 2)
 
ot16$pred1<-predict(fit, ot16[,c("koti", "vieras")])
ot16$pred2<-predict(fit2, ot16[,c("koti", "vieras")])
ot16$pred3<-predict(fit3, ot16[,c("koti", "vieras", "kuukausi", "viikonpäivä")])
ot16$k15<-a$katsojia[match(paste0(ot16$koti, ot16$vieras), paste0(a$kotijoukkue, a$vierasjoukkue))]
ot16$pred4<-predict(fit4, ot16[,c("koti", "vieras", "kuukausi", "viikonpäivä")])
 
colnames(ot16)[7]<-"yleisöä"
ot16$yleisöä<-as.numeric(as.character(ot16$yleisöä))
ot16$erotus1<-ot16$yleisöä-ot16$pred1
ot16$erotus2<-ot16$yleisöä-ot16$pred2
ot16$erotus3<-ot16$yleisöä-ot16$pred3
ot16$erotusk15<-ot16$yleisöä-ot16$k15
ot16$erotus4<-ot16$yleisöä-ot16$pred4
 
par(mar=c(4,10,4,1))
d<-coef(fit3)
names(d)<-gsub("koti", "Koti: ", names(d))
names(d)<-gsub("vieras", "Vieras: ", names(d))
names(d)<-gsub("kuukausi", "Kuukausi: ", names(d))
names(d)<-gsub("viikonpäivä", "Viikonpäivä: ", names(d))
names(d)<-gsub("(Intercept)", "Vakiotermi: ", names(d))
b<-barplot(d, horiz=T, las=1, col="black", cex.names=0.75, xlim=c(-2000,3000), main="Eri tekijöiden vaikutus Veikkausliigan 2015 katsojamääriin", col.lab="grey50", col.axis="grey50", col.main="grey50")
abline(h=b,col="grey75")
b<-barplot(d, horiz=T, las=1, col="black", cex.names=0.75, xlim=c(-2000,3000), main="Eri tekijöiden vaikutus Veikkausliigan 2015 katsojamääriin", col.lab="grey50", col.axis="grey50", col.main="grey50", add=TRUE)
abline(v=seq(-3000,3000,by=500), col="white")

2 Responses to “Veikkausliiga 2015 – joukkueiden tuloksia ja katsojamäärien ennustamista”

  • Topias sanoo:

    Tämä näytti niin lystiltä, että oli pakko yrittää täydentää mallia hakemalla Ilmatieteen laitoksen rajapinnasta ottelupäivien säätiedot. Lisäsin tuohon kuvan malliin lämpötilan ja sademäärän ottelupäivältä ja poistin kuukauden ettei tulisi ongelmia multikollinearisuuden kanssa, mutta tämä perustui ihan veikkaukseen. Mallista tuli tällainen:
    lm(formula = Yleisöä ~ koti + vieras + viikonpäivä + lämpötila + sade, data = test)

    En validoinut rajapintahakua mitenkään, mutta ainakin kertoimien etumerkki on oletusten mukainen. Sateella vähemmän yleisöä, lämpimämpi sää houkuttelee enemmän yleisöä. Jotain meni kuitenkin mönkään alkupään ajoissa, kun viikonpäivien osalta tuli aivan erilaiset tulokset.

    Katsoin muuten suurimmat residuaalit ja näyttäisi siltä, että ne tulevat derbyissä, jotka vetää puoleensa ennakoitua enemmän porukkaa. Ehkä niistä voisi tehdä dummy:n malliin.

    Tarkemmat speksit:

    Sade on yksinkertaisesti sademäärä. Jakauma on erittäin vino:
    Min. 1st Qu. Median Mean 3rd Qu. Max. NA’s
    0.0000 0.0000 0.0000 0.6793 0.1000 20.8000 1

    Lämpötila on päivän keskilämpötilan ja maksimilämpötilan keskiarvo. Arvelin, että se voisi olla lähellä ottelun ajankohdan lämpötilaa. Rajapinnasta saisi varmaan tarkemmankin lämpötilan, mutta.. rajansa kaikella. Lämpötilan jakauma:
    Min. 1st Qu. Median Mean 3rd Qu. Max. NA’s
    3.95 9.60 13.45 13.16 16.45 21.95 1

    Jostain syystä yksi Tampereella pelattu ottelu jäi vaille säätietoja.

    Ja summary itse mallista:
    Call:
    lm(formula = Yleisöä ~ koti + vieras + viikonpäivä + lämpötila +
    sade, data = test)

    Residuals:
    Min 1Q Median 3Q Max
    -2410.4 -515.4 -70.7 382.5 5498.9

    Coefficients:
    Estimate Std. Error t value Pr(>|t|)
    (Intercept) 1672.5088 495.7201 3.374 0.000923 ***
    kotiFC KTP 0.1505 387.7530 0.000 0.999691
    kotiFC Lahti -235.1743 400.2220 -0.588 0.557593
    kotiFF Jaro -863.5684 398.8057 -2.165 0.031786 *
    kotiHIFK 859.7227 386.0073 2.227 0.027277 *
    kotiHJK 3361.8190 420.4599 7.996 2.09e-13 ***
    kotiIFK Mariehamn -1242.3815 378.2563 -3.284 0.001246 **
    kotiIlves 1408.5299 430.0119 3.276 0.001284 **
    kotiKuPS 632.8925 526.0313 1.203 0.230633
    kotiRoPS 672.3093 489.6696 1.373 0.171609
    kotiSJK 482.3304 392.7561 1.228 0.221161
    kotiVPS -516.9614 421.5849 -1.226 0.221847
    vierasFC KTP -189.2135 372.2923 -0.508 0.611960
    vierasFC Lahti -118.3918 373.9440 -0.317 0.751943
    vierasFF Jaro 497.8893 377.8584 1.318 0.189433
    vierasHIFK 1155.7013 371.9772 3.107 0.002224 **
    vierasHJK 1618.1771 373.6843 4.330 2.57e-05 ***
    vierasIFK Mariehamn 72.8650 377.2800 0.193 0.847091
    vierasIlves 154.7176 378.8910 0.408 0.683548
    vierasKuPS -34.4783 375.3752 -0.092 0.926928
    vierasRoPS 399.1102 370.4862 1.077 0.282927
    vierasSJK 352.1312 379.5580 0.928 0.354889
    vierasVPS -204.8510 373.2300 -0.549 0.583839
    viikonpäiväLa -1058.7748 337.6029 -3.136 0.002025 **
    viikonpäiväMa -134.7511 308.9189 -0.436 0.663257
    viikonpäiväPe -935.0845 428.0193 -2.185 0.030314 *
    viikonpäiväSu -54.2982 315.2604 -0.172 0.863464
    viikonpäiväTi -240.4341 1150.6914 -0.209 0.834745
    viikonpäiväTo 29.7901 355.5342 0.084 0.933325
    lämpötila 46.8546 19.6063 2.390 0.017980 *
    sade -28.6231 34.6737 -0.825 0.410273

    Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

    Residual standard error: 1059 on 166 degrees of freedom
    (1 observation deleted due to missingness)
    Multiple R-squared: 0.5924, Adjusted R-squared: 0.5187
    F-statistic: 8.042 on 30 and 166 DF, p-value: < 2.2e-16

  • Jarno sanoo:

    @Topias: Pohdin itsekin säätietojen lisäämistä malliin, mutta nythän siitä on tuossa jo toteutus! Pitänee paneutua itsekin asiaan tarkemmin.

    Tuossahan voisi tietysti vaikka korvata varsinaisen viikonpäivän jollakin muunnoksella, vaikkapa arkipäivä / viikonloppupäivä. Näyttää nimittäin siltä, että tuo säätietojen lisäys vaikuttaa esim. viikonpäivien estimaattien keskivirheisiin vähän epäsuotuisasti.