Brownovo exponenciálne vyrovnávanie

Exponenciálne vyrovnávanie navrhol v roku 1956 pán Robert Goodel Brown, neskôr ho v roku 1957 rozšíril pán Charles Holt. Ide o techniku, pomocou ktorej je možné dáta časového radu vyhladiť a zároveň urobiť predpoveď na budúce obdobie.

Brownovo exponenciálne vyrovnávanie je určené pre nesezónne dáta a umožňuje rôzne typy trendov:

• Jednoduché exponenciálne vyrovnávanie – konštantný trend
• Dvojité exponenciálne vyrovnávanie – lineárny trend
• Trojité exponenciálne vyrovnávanie – kvadratický trend

Predtým než začneme, je dobré si pripraviť vektor dát, na ktoré budeme exponenciálne vyrovnávanie aplikovať. Dáta sú dostupné aj v podobe reálnych údajov.

Príklad vytvorenia dátového vektora v R:

data = c(14.29, 13.81, 13.58, 13.88, 14.26, 13.67, 12.6, 13.44, 13.39,
         13.59, 13.25, 12.9, 12.71, 11.89, 11.93, 12.3, 11.61,
         11.41, 11.33, 11.33, 11.3, 10.87)

Brownovo jednoduché exponenciálne vyrovnávanie v Rcran so zvolením parametra alfa

Exponenciálne vyrovnávanie je možné realizovať aj v prostredí R, pomocou vlastnej funkcie, ktorá zohľadňuje zvolený parameter α. Nižšie uvedená funkcia vypočíta MSE (mean squared error), vypíše odhadované hodnoty Y a poskytne aj predpoveď na jedno obdobie dopredu.

Funkcia BA() pracuje s dátovým vektorom a zvolenou hodnotou parametra alfa. Okrem toho automaticky vykreslí graf pôvodných a vyhladených hodnôt.

BA = function(vector, alpha) {
  avg_vector = sum(vector) / length(vector)
  pom_vector = 1:length(vector)
  pom_vector[1] = alpha * vector[1] + (1 - alpha) * avg_vector
  for (i in 2:length(vector)) {
    pom_vector[i] = alpha * vector[i] + (1 - alpha) * pom_vector[i - 1]
  }
  est_vector = 1:length(vector)
  est_vector[1] = avg_vector
  est_vector[2] = pom_vector[1]
  for (i in 3:length(vector)) {
    est_vector[i] = pom_vector[i - 1]
  }
  residuals = (vector - est_vector)^2
  MSE = mean(residuals)
  forecast = pom_vector[length(vector)]
  cat("Zvolená alfa:", alpha, "\nMSE:", MSE, "\nForecast:", forecast, "\n")
  plot(vector, type = "o", col = "blue", ylim = range(c(vector, est_vector)))
  lines(est_vector, type = "o", col = "red")
  points(length(vector) + 1, forecast, col = "brown", pch = 19)
}

Ukážka použitia funkcie:

data = c(14.29, 13.81, 13.58, 13.88, 14.26, 13.67, 12.6, 13.44, 13.39,
         13.59, 13.25, 12.9, 12.71, 11.89, 11.93, 12.3, 11.61,
         11.41, 11.33, 11.33, 11.3, 10.87)

BA(data, 0.3)

Táto funkcia vykreslí originálne hodnoty (modrá), odhadované hodnoty (červená) a predikciu pre ďalšie obdobie (hnedá).

Brownovo jednoduché exponenciálne vyrovnávanie v Rcran s výpočtom optimálneho parametra alfa

Táto funkcia vykonáva to isté ako predchádzajúca verzia, avšak navyše automaticky vyhľadáva hodnotu parametra α, pri ktorej je stredná kvadratická chyba MSE najnižšia.

Funkcia prechádza interval od 0 do 0.7 a vyhodnocuje výsledky po zadanom kroku.

BO = function(vector, step) {
  alpha = step
  best_alpha = alpha
  min_mse = Inf
  best_forecast = NA
  best_est = rep(0, length(vector))

  while (alpha <= 0.7) {
    avg = mean(vector)
    smooth = rep(0, length(vector))
    smooth[1] = alpha * vector[1] + (1 - alpha) * avg
    for (i in 2:length(vector)) {
      smooth[i] = alpha * vector[i] + (1 - alpha) * smooth[i-1]
    }

    est = c(avg, smooth[1:(length(vector)-1)])
    mse = mean((vector - est)^2)

    if (mse < min_mse) {
      min_mse = mse
      best_alpha = alpha
      best_est = est
      best_forecast = smooth[length(vector)]
    }

    alpha = alpha + step
  }

  cat("Najlepšia hodnota α:", best_alpha, "\nNajnižšie MSE:", min_mse, "\nForecast:", best_forecast, "\n")
  plot(vector, type="o", col="blue", ylim=range(c(vector, best_est)))
  lines(best_est, type="o", col="red")
  points(length(vector)+1, best_forecast, col="brown", pch=19)
}

Ukážka použitia funkcie:

data = c(14.29, 13.81, 13.58, 13.88, 14.26, 13.67, 12.6, 13.44, 13.39,
         13.59, 13.25, 12.9, 12.71, 11.89, 11.93, 12.3, 11.61,
         11.41, 11.33, 11.33, 11.3, 10.87)

BO(data, 0.05)

Modrá línia predstavuje pôvodné hodnoty, červená vyhladené hodnoty s optimálnym α a hnedý bod označuje predikciu na ďalšie obdobie.

Brownovo dvojité exponenciálne vyrovnávanie v Rcran so zvolením parametra alfa

Táto funkcia vykonáva dvojité exponenciálne vyrovnávanie, ktoré je vhodné pre časové rady s lineárnym trendom. Výpočet vyžaduje výber hodnoty parametra α a na jeho základe určuje strednú kvadratickú chybu MSE, predikciu a vyhladené hodnoty.

Funkcia tiež automaticky vykreslí graf s originálnymi hodnotami, odhadom a predpoveďou na jedno obdobie dopredu.

BEA = function(vector, alpha) {
  time = 1:length(vector)
  regr = lm(vector ~ time)
  b0 = regr$coef[1]
  b1 = regr$coef[2]

  st1 = b0 - (b1 * (1 - alpha) / alpha)
  st2 = b0 - (2 * b1 * (1 - alpha) / alpha)

  smooth1 = numeric(length(vector))
  smooth2 = numeric(length(vector))
  smooth1[1] = alpha * vector[1] + (1 - alpha) * st1

  for (i in 2:length(vector)) {
    smooth1[i] = alpha * vector[i] + (1 - alpha) * smooth1[i - 1]
  }

  smooth2[1] = alpha * smooth1[1] + (1 - alpha) * st2
  for (i in 2:length(vector)) {
    smooth2[i] = alpha * smooth1[i] + (1 - alpha) * smooth2[i - 1]
  }

  b_t = (alpha / (1 - alpha)) * (smooth1 - smooth2)
  a_t = 2 * smooth1 - smooth2

  est_vector = c(b0 + b1)
  for (i in 2:length(vector)) {
    est_vector[i] = a_t[i - 1] + b_t[i - 1]
  }

  mse = mean((vector - est_vector)^2)
  forecast = a_t[length(vector)] + b_t[length(vector)]

  cat("Zvolená α:", alpha, "\nMSE:", mse, "\nForecast:", forecast, "\n")
  plot(vector, type = "o", col = "blue", ylim = range(c(vector, est_vector)))
  lines(est_vector, type = "o", col = "red")
  points(length(vector) + 1, forecast, col = "brown", pch = 19)
}

Ukážka použitia funkcie:

data = c(14.29, 13.81, 13.58, 13.88, 14.26, 13.67, 12.6, 13.44, 13.39,
         13.59, 13.25, 12.9, 12.71, 11.89, 11.93, 12.3, 11.61,
         11.41, 11.33, 11.33, 11.3, 10.87)

BEA(data, 0.3)

Modrá línia predstavuje pôvodné hodnoty, červená línia je dvojito vyhladený odhad a hnedý bod označuje predikciu do ďalšieho obdobia.

Brownovo dvojité exponenciálne vyrovnávanie v Rcran s výpočtom optimálneho parametra alfa

Táto funkcia rozširuje klasické dvojité exponenciálne vyrovnávanie o výpočet optimálnej hodnoty parametra α, pri ktorej je MSE (mean squared error) najnižšia. Parametre funkcie umožňujú definovať krok hľadania v rámci intervalu 0–0.7.

Výstupom sú okrem optimálneho α aj odhadované hodnoty Y, predpoveď na ďalšie obdobie a graf zobrazujúci pôvodné aj vyhladené dáta.

BEO = function(vector, step) {
  time = 1:length(vector)
  regr = lm(vector ~ time)
  b0 = regr$coef[1]
  b1 = regr$coef[2]
  alpha = step
  j = 0
  iterations = 0.7 / step
  MSE_data = numeric(iterations)
  parameter_alpha = alpha
  data_memory = numeric(length(vector))
  forecast = numeric(iterations)

  while (alpha <= 0.7) {
    j = j + 1
    st1 = b0 - (b1 * (1 - alpha) / alpha)
    st2 = b0 - (2 * b1 * (1 - alpha) / alpha)

    pom = numeric(length(vector))
    pom2 = numeric(length(vector))
    pom[1] = alpha * vector[1] + (1 - alpha) * st1
    for (i in 2:length(vector)) pom[i] = alpha * vector[i] + (1 - alpha) * pom[i - 1]

    pom2[1] = alpha * pom[1] + (1 - alpha) * st2
    for (i in 2:length(vector)) pom2[i] = alpha * pom[i] + (1 - alpha) * pom2[i - 1]

    b1t = (alpha / (1 - alpha)) * (pom - pom2)
    b0t = 2 * pom - pom2

    est_vector = numeric(length(vector))
    est_vector[1] = b0 + b1
    for (i in 2:length(vector)) est_vector[i] = b0t[i - 1] + b1t[i - 1]

    residuals = (vector - est_vector)^2
    MSE_data[j] = mean(residuals)

    if (j == 1 || MSE_data[j] < min(MSE_data[1:j])) {
      data_memory = est_vector
      parameter_alpha = alpha
      forecast[j] = b0t[length(vector)] + b1t[length(vector)]
    }

    alpha = alpha + step
  }

  MSE = min(MSE_data)
  cat("Optimálne α:", parameter_alpha, "\nNajnižšie MSE:", MSE, "\nForecast:", forecast[which.min(MSE_data)], "\n")

  plot(vector, type = "o", col = "blue", ylim = range(c(vector, data_memory)))
  lines(data_memory, type = "o", col = "red")
  points(length(vector) + 1, forecast[which.min(MSE_data)], col = "brown", pch = 19)
}

Ukážka použitia funkcie:

data = c(14.29, 13.81, 13.58, 13.88, 14.26, 13.67, 12.6, 13.44, 13.39,
         13.59, 13.25, 12.9, 12.71, 11.89, 11.93, 12.3, 11.61,
         11.41, 11.33, 11.33, 11.3, 10.87)

BEO(data, 0.05)

Výsledný graf zobrazuje pôvodné hodnoty (modrá), optimálne vyhladené hodnoty (červená) a predikciu na ďalší časový bod (hnedá).

Brownovo trojité exponenciálne vyrovnávanie v Rcran so zvolením parametra alfa

Trojitá forma exponenciálneho vyrovnávania umožňuje modelovať kvadratické trendy v časových radoch. Táto verzia funkcie vyžaduje výber parametra α a následne vykonáva vyhladenie, výpočet odhadovaných hodnôt Y, hodnoty MSE a predikcie do ďalšieho obdobia.

Výsledkom je aj automatické vykreslenie grafu s originálnymi, vyhladenými a predikovanými hodnotami.

BTA = function(vector, alpha) {
  time1 = 1:length(vector)
  time2 = time1^2
  time = cbind(time1, time2)

  regr = lm(vector ~ time)
  b0 = regr$coef[1]
  b1 = regr$coef[2]
  b2 = regr$coef[3]

  st01 = b0 - (b1 * (1 - alpha) / alpha) + (1 - alpha) * (2 - alpha) / (alpha^2) * b2
  st02 = b0 - (2 * b1 * (1 - alpha) / alpha) + (1 - alpha) * (3 - 2 * alpha) / (alpha^2) * 2 * b2
  st03 = b0 - (3 * b1 * (1 - alpha) / alpha) + 3 * (1 - alpha) * (4 - 3 * alpha) / (alpha^2) * b2

  st1 = numeric(length(vector)); st1[1] = alpha * vector[1] + (1 - alpha) * st01
  for (i in 2:length(vector)) {
    st1[i] = alpha * vector[i] + (1 - alpha) * st1[i - 1]
  }

  st2 = numeric(length(vector)); st2[1] = alpha * st1[1] + (1 - alpha) * st02
  for (i in 2:length(vector)) {
    st2[i] = alpha * st1[i] + (1 - alpha) * st2[i - 1]
  }

  st3 = numeric(length(vector)); st3[1] = alpha * st2[1] + (1 - alpha) * st03
  for (i in 2:length(vector)) {
    st3[i] = alpha * st2[i] + (1 - alpha) * st3[i - 1]
  }

  b0t = 3 * st1 - 3 * st2 + st3
  b1t = (alpha / (2 * (1 - alpha)^2)) * ((6 - 5 * alpha) * st1 - 2 * (5 - 4 * alpha) * st2 + (4 - 3 * alpha) * st3)
  b2t = (alpha^2 / (1 - alpha)^2) * (st1 - 2 * st2 + st3)

  est_vector = numeric(length(vector)); est_vector[1] = b0 + b1 + b2
  for (i in 2:length(vector)) {
    est_vector[i] = b0t[i - 1] + b1t[i - 1] + b2t[i - 1]
  }

  residuals = (vector - est_vector)^2
  mse = mean(residuals)
  forecast = b0t[length(vector)] + b1t[length(vector)] + b2t[length(vector)] / 2

  cat("Zvolená α:", alpha, "\nMSE:", mse, "\nForecast:", forecast, "\n")
  plot(vector, type = "o", col = "blue", ylim = range(c(vector, est_vector)))
  lines(est_vector, type = "o", col = "red")
  points(length(vector) + 1, forecast, col = "brown", pch = 19)
}

Ukážka použitia funkcie:

data = c(14.29, 13.81, 13.58, 13.88, 14.26, 13.67, 12.6, 13.44, 13.39,
         13.59, 13.25, 12.9, 12.71, 11.89, 11.93, 12.3, 11.61,
         11.41, 11.33, 11.33, 11.3, 10.87)

BTA(data, 0.3)

V grafe budú vykreslené: pôvodné hodnoty (modrá), trojito vyhladené odhady (červená) a predikcia pre ďalší časový bod (hnedá).

Brownovo trojité exponenciálne vyrovnávanie v Rcran s výpočtom optimálneho parametra alfa

Táto funkcia rozširuje klasické trojité exponenciálne vyrovnávanie o výpočet optimálnej hodnoty parametra α, pri ktorej je MSE (mean squared error) najnižšie. Parametre funkcie umožňujú definovať krok hľadania v rámci intervalu 0–0.7.

Výstupom sú okrem optimálneho α aj odhadované hodnoty Y, predpoveď na ďalšie obdobie a graf zobrazujúci pôvodné aj vyhladené dáta.

BTO(data, 0.05)  # BTO = funkcia
                 # data = vektor hodnôt
                 # 0.05 = krok pre hľadanie najlepšieho alfa

Skrátený popis algoritmu:

• Pre každé α z intervalu (0, 0.7] sa vypočíta predikcia a MSE.
• Hodnota α s najnižším MSE je vybraná ako optimálna.
• Graf zobrazí pôvodné hodnoty (modrá), vyhladené hodnoty (červená) a predikciu (hnedá).

Príklad použitia funkcie:

data = c(14.29, 13.81, 13.58, 13.88, 14.26, 13.67, 12.6, 13.44, 13.39,
         13.59, 13.25, 12.9, 12.71, 11.89, 11.93, 12.3, 11.61,
         11.41, 11.33, 11.33, 11.3, 10.87)

BTO(data, 0.05)

Výstup funkcie zobrazí optimálny parameter α, najnižšiu hodnotu MSE, odhadované hodnoty a predikciu na ďalšie obdobie.