Czy przekroczą 55 milionów?

Już jutro finał 24. Wielkiej Orkiestry Świątecznej Pomocy. Z roku na rok WOŚP zbiera coraz więcej środków, w tym roku na wsparcie oddziałów pediatrycznych i opieki medycznej seniorów. Jak myślicie ile pieniędzy uda się zebrać?
Zobaczmy co na ten temat mają do powiedzenia modele liniowe 😉

Dane n.t. kwot zebranych podczas kolejnych finałów pobieramy z Wikipedii. Używając pakietu rvest są to w sumie dwie linijki (plus jedna na oczyszczenie napisów). Do roku 2010 na oficjalnej stronie WOŚP kwoty są w USD, ostrożnie z porównaniami.

library(rvest)
tabela <- html("https://pl.wikipedia.org/wiki/Wielka_Orkiestra_%C5%9Awi%C4%85tecznej_Pomocy")
cast <- html_nodes(tabela, "td:nth-child(5)")
as.numeric(gsub(gsub(html_text(cast), pattern="[^0-9,]", replacement=""), pattern = ",", replacement="."))
# [1]  2422465  4134072  6867951  6315296  8818754 12498909 15748393 25229564 24366828 26291937 30116786 27244441 28415177 30690085 30377335
#[16] 32147539 40458625 42877958  2644507 47248415 50638801 50657748 52448765 53109703       NA

Mamy liczby, trzeba je narysować. Oczywiście użyjemy ggplot2. Dwie długaśne linijki i jako wynik otrzymujemy tytułowy wykres z słupkami.

library(ggplot2)
dane <- data.frame(rok = 1993:2015,
                   zebraneWiki = as.numeric(gsub(gsub(html_text(cast), pattern="[^0-9,]", replacement=""), pattern = ",", replacement="."))[c(-25,-19)]/1000000)

ggplot(dane, aes(rok, zebraneWiki)) + 
  geom_bar(stat="identity", alpha=0.5, fill="red4") + 
  theme_minimal() + 
  ylab("Zebrane [mln PLN]\n") + scale_y_continuous(breaks=seq(0,60,5)) + xlab("")+
  ggtitle("Kwoty zebrane w kolejnych edycjach WOŚP\n")

Czas na predykcje, oczywiście będzie przedziałowa.
Ograniczymy się do aproksymacji trendem liniowym bazując wyłącznie na zmiennej rok/edycja (*), ograniczając się do danych z ostatnich 5 lat.
Gdyby ktoś chciał doczytać jak wyznaczać przedziały dla predykcji może zajrzeć na stronę 19 tutaj. W R wystarczy użyć funkcji predict.lm z parametrem interval = „prediction”.

predict(lm(zebraneWiki~rok, data=dane[19:23,]), data.frame(rok=2016), 
  interval = "prediction", level=0.9)
#         fit      lwr     upr
# 1 54.88045 51.83139 57.9295

Tak więc 90% przedział dla predykcji jest dosyć szeroki 52-58 milionów PLN, wartość oczekiwana na tegoroczny finał to 54,88 milionów PLN.

Ciekawe, czy uda się przekroczyć w tym roku 55 milionów PLN? W poprzednim roku zebrano 53.1 mln.

(*) Sprawdzałem czy zebrana kwota zależy od PKB (zaskoczenie, jeżeli uwzględnić trend związany z rokiem, to PKB ma już marginalne znaczenie), od kursu dolara i wygląda na to, że nie są to bardzo decydujące czynniki. Najistotniejszym czynnikiem był rok (dodatni trend). Aproksymacja wielomianami pokazała, że można pozostać przy liniowym trendzie.

*Update:* (za komentarzami) W 2016 roku WOŚP zebrała 72 mln 696 tys. 501 pln. Znacznie powyżej liniowych predykcji. Poniższy wykres pokazuje jak znaczący jest to skok w porównaniu do poprzednich lat.