Przygotowania wstępna

library(kableExtra)
library(tidyverse)
## -- Attaching packages --------------------------------------- tidyverse 1.3.1 --
## v ggplot2 3.3.5     v purrr   0.3.4
## v tibble  3.1.6     v dplyr   1.0.8
## v tidyr   1.2.0     v stringr 1.4.0
## v readr   2.1.2     v forcats 0.5.1
## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter()     masks stats::filter()
## x dplyr::group_rows() masks kableExtra::group_rows()
## x dplyr::lag()        masks stats::lag()
kable1 = function(data) data %>% kbl() %>% 
  kable_styling(bootstrap_options = 
                  c("striped", "hover", "condensed", "responsive"))

kable2 = function(data, height="240px") data %>% kable1 %>% 
  scroll_box(width = "100%", height = height)

Zadanie 1

Dla przeprowadzenia ćwiczenia wybrałem dane z roku 2010.

dane = c(12.9, 13.2, 13, 12.4, 12.1, 11.7, 11.5, 11.4, 11.5, 11.5, 11.7, 12.4) %>% 
  ts(start=c(2010,1), end=c(2010,10), frequency = 12)
dane
##       Jan  Feb  Mar  Apr  May  Jun  Jul  Aug  Sep  Oct
## 2010 12.9 13.2 13.0 12.4 12.1 11.7 11.5 11.4 11.5 11.5

a)

Obliczenie przyrostów absolutnych jednopodstawowych oraz łańcuchowych.

przyr.abs.jednopodstawowe = dane - dane[1]
przyr.abs.jednopodstawowe %>% round(3)
##       Jan  Feb  Mar  Apr  May  Jun  Jul  Aug  Sep  Oct
## 2010  0.0  0.3  0.1 -0.5 -0.8 -1.2 -1.4 -1.5 -1.4 -1.4
dane.przesuniete = dane %>% as.vector() %>% lag()
przyr.abs.łańcuchowe = dane - (dane.przesuniete)
przyr.abs.łańcuchowe %>% round(3)
##       Jan  Feb  Mar  Apr  May  Jun  Jul  Aug  Sep  Oct
## 2010   NA  0.3 -0.2 -0.6 -0.3 -0.4 -0.2 -0.1  0.1  0.0

b)

Obliczenie przyrostów względnych jednopodstawowych oraz łańcuchowych.

przyr.wzg.jednopodstawowe = (dane - dane[1])/dane[1]
przyr.wzg.jednopodstawowe %>% round(3)
##         Jan    Feb    Mar    Apr    May    Jun    Jul    Aug    Sep    Oct
## 2010  0.000  0.023  0.008 -0.039 -0.062 -0.093 -0.109 -0.116 -0.109 -0.109
przyr.wzg.łańcuchowe = (dane - (dane.przesuniete))/dane.przesuniete
przyr.wzg.łańcuchowe %>% round(3)
##         Jan    Feb    Mar    Apr    May    Jun    Jul    Aug    Sep    Oct
## 2010     NA  0.023 -0.015 -0.046 -0.024 -0.033 -0.017 -0.009  0.009  0.000

c)

Obliczenie indeksów dynamiki jednopodstawowych oraz łańcuchowych.

ind.dyn.jednopodstawowe = dane/dane[1]
ind.dyn.jednopodstawowe %>% round(3)
##        Jan   Feb   Mar   Apr   May   Jun   Jul   Aug   Sep   Oct
## 2010 1.000 1.023 1.008 0.961 0.938 0.907 0.891 0.884 0.891 0.891
ind.dyn.łańcuchowe = dane/dane.przesuniete
ind.dyn.łańcuchowe %>% round(3)
##        Jan   Feb   Mar   Apr   May   Jun   Jul   Aug   Sep   Oct
## 2010    NA 1.023 0.985 0.954 0.976 0.967 0.983 0.991 1.009 1.000

d)

Obliczenia średniookresowego tempa zmian.

yg = (dane[length(dane)]/dane[1])^(1/(length(dane)-1))
yg %>% round(3)
## [1] 0.987

e)

Prognoza na listopad i grudzień.

y11 = dane[length(dane)]*(yg)^1
y12 = dane[length(dane)]*(yg)^2
c(y11, y12) %>% round(1)
## [1] 11.4 11.2

Wyciąganie wniosków z tych obliczeń przysparza mi jednak niemały problem. Owszem mogę zauważyć, że stopa bezrobocia wynosiła w listopadzie 11.7 co jest wartością dość bliską względem mojej prognozy wynoszącej 11.4. Natomiast w grudniu różnica jest już większa. Rzeczywista stopa bezrobocia wynosiła bowiem 12.4 co wobec prognozy wynoszącej 11.2 wydaje się sporą różnicą. Niestety, bez znajomości metody oszacowania przedziału predykcji na odpowiednim poziomie ufności trudno jest mi na podstawie takich prognoz wyciągać jakiekolwiek bardziej konstruktywne wnioski.

Zadanie 2

Dane będę przechowywał w tabeli danych typu tibble.

dane = tibble(
  artykuł = LETTERS[1:6],
  p0 = c(150, 320, 10, 7, 35, 15),
  p1 = c(173, 356, 12, 5, 61, 14),
  q0 = c(10, 30, 100, 550, 350, 40),
  q1 = c(30, 10, 100, 450, 500, 50)
)
dane %>% kable1()
artykuł p0 p1 q0 q1
A 150 173 10 30
B 320 356 30 10
C 10 12 100 100
D 7 5 550 450
E 35 61 350 500
F 15 14 40 50

a)

Wyznaczenie dynamiki sprzedaży wykonam stosując funkcję mutate z pakietu dplyr.

dane = dane %>% mutate(
  ip = p1/p0,
  iq = q1/q0,
  iw = p1*q1/(p0*q0)
)

dane %>% mutate_if(is.numeric, round, digits = 2) %>% kable1()
artykuł p0 p1 q0 q1 ip iq iw
A 150 173 10 30 1.15 3.00 3.46
B 320 356 30 10 1.11 0.33 0.37
C 10 12 100 100 1.20 1.00 1.20
D 7 5 550 450 0.71 0.82 0.58
E 35 61 350 500 1.74 1.43 2.49
F 15 14 40 50 0.93 1.25 1.17

b-d)

Korzystając z funkcji summarise od razu wyznaczę wszystkie potrzebne indeksy.

indeksy = dane %>% summarise(
  Iw = sum(p1*q1)/sum(p0*q0),
  IqL = sum(p0*q1)/sum(p0*q0),
  IqP = sum(p1*q1)/sum(p1*q0),
  IpL = sum(p1*q0)/sum(p0*q0),
  IpP = sum(p1*q1)/sum(p1*q0),
  IqF = sqrt(IqL*IqP),
  IpF = sqrt(IpL*IpP)
) 

indeksy %>% mutate_if(is.numeric, round, digits = 2) %>% kable1()
Iw IqL IqP IpL IpP IqF IpF
1.51 1.05 1.13 1.33 1.13 1.09 1.23

Agregatowy indeks wartości sprzedaży wyniósł aż 1.51 co świadczy o bardzo wysokiej dynamice sprzedaży z wzrostem wartości o 51%. Indeks ilości Laspeyresa informuje mnie o tym, że ilość sprzedanych produktów w badanym okresie wzrosła o 5% przy założeniu że ceny na końcu okresu były takie same jak na początku. Natomiast agregatowy indeks ilości Paaschego informuje mnie o tym, że ilość sprzedanych produktów wzrosła o 13% przy założeniu, że ceny na początku badanego okresu były takie jak na końcu okresu. Z koeli indeks cen Laspeyresa informuje mnie o tym, że ceny wzrosły średnio o 33% przy założeniu, że ilości sprzedawanych produktów na końcu okresu były takie same jak na początku. Z kolei indeks cen Paaschego informuje mnie o tym, że ceny sprzedanych produktów wzrosły o 13% przy założeniu, że ilości sprzedanych produktów na początku badanego okresu były takie jak na końcu okresu.