Wczytanie danych

dane <- read.csv("https://opendata.ecdc.europa.eu/covid19/casedistribution/csv", 
                 na.strings = "", fileEncoding = "UTF-8-BOM")

danePL <- dane[dane$countriesAndTerritories=="Poland",]
danePL$time <- as.Date(danePL$dateRep, "%d/%m/%Y")
danePL <- danePL[order(danePL$time),]
danePL$cumdeaths <- cumsum(danePL$deaths)

danePL <- danePL[danePL$cumdeaths!=0,]
plot(cumdeaths~time, data=danePL)
abline(v=as.Date("2020-05-04"), lty=3)
text(as.Date("2020-05-04"), 0, "Do tego miejsca \n były dostępne dane \n z PD", pos=3)

Można było dopasować dwa oddzielne modele

mod1 <- lm(log(cumdeaths)~time, data=danePL, subset=(time <= as.Date("2020-03-25")))
mod2 <- lm(sqrt(cumdeaths)~time, data=danePL, subset=(time > as.Date("2020-03-25") & 
                                                  time <= as.Date("2020-05-04")))
plot(cumdeaths~time, data=danePL)
lines(mod1$model$time, exp(mod1$fitted.values), col="red", lwd=2)
lines(mod2$model$time, mod2$fitted.values^2, col="red", lwd=2)

Można było dopasować jeden model, ale dodać zmienne

Można było różne zmienne pododawać (np. kolejne stopnie wielomianu) i poeksperymentować z wyborem części z nich.

danePL$time_number <- 1:nrow(danePL)
danePL_duzo_zmiennych <- data.frame(cumdeaths=danePL$cumdeaths,
                                    time1=danePL$time_number,
                                    time2=(danePL$time_number)^2,
                                    time_exp=exp(danePL$time_number),
                                    time=danePL$time)

mod <- lm(cumdeaths~.-time, data=danePL_duzo_zmiennych, subset=(time <= as.Date("2020-05-04")))

plot(cumdeaths~time, data=danePL)
lines(mod$model$time, mod$fitted.values, col="red", lwd=2)

Jeszcze inaczej (tak chyba nikt nie zrobił)

Może być tak, że na poszczególnych przedziałach czasu chcemy mieć zależność liniową/kwadratową i chcemy, żeby przejścia pomiędzy przedziałami były np. ciągłe. Możemy to zrobić dobierając odpowiednio macierz eksperymentu.

Potrzebna nam będzie pomocnicza funkcja, która dla x niedodatniego przyjmuje 0:

plus <- function(x){
  ifelse(x > 0, x, 0)
}

Będę modelować na trzech przedziałach (wypisałam ich granice).

przedzial1 <- 20
przedzial2 <- 48
c(danePL$time[1], danePL$time[przedzial1], danePL$time[przedzial2], danePL$time[nrow(danePL)])

## [1] "2020-03-13" "2020-04-01" "2020-04-29" "2020-05-19"

Teraz tworzymy macierz eksperymentu i dopasowuję modele:

x <- danePL$time_number
X <- data.frame(x1=x, x2=x^2, 
                zawias11=plus(x-przedzial1), zawias12=plus(x-przedzial1)^2, 
                zawias21=plus(x-przedzial2), zawias22=plus(x-przedzial2)^2,
                time=danePL$time)
danePL_inne_zmienne <- data.frame(X, y=danePL$cumdeaths)

mod.liniowe.wyrazy <- lm(y~x1+zawias11+zawias21-time, data=danePL_inne_zmienne)
mod.wszystkie.wyrazy <- lm(y~.-time, data=danePL_inne_zmienne)

Odejmuję “time”, bo tam są po prostu daty - kolejne dni są i tak w zmiennej “x”.

Tak wyglądają wykresy:

par(mfrow=c(1,2))
plot(cumdeaths~time, data=danePL, main="Liniowe")
lines(mod.liniowe.wyrazy$model$time, mod.liniowe.wyrazy$fitted.values, col="red", lwd=2)
abline(v=danePL$time[c(przedzial1, przedzial2)], col="gray", lty=3)
plot(cumdeaths~time, data=danePL, main="Wielomiany drugiego stopnia")
lines(mod.wszystkie.wyrazy$model$time, mod.wszystkie.wyrazy$fitted.values, col="red", lwd=2)
abline(v=danePL$time[c(przedzial1, przedzial2)], col="gray", lty=3)

To są spliny. Popularne są np. spliny kubiczne (wielomiany trzeciego stopnia).