Analýza a vizualizace ekonomických dat

Co se naučíte?

Tento dokument ukazuje několik příkladů toho, co se můžete naučit v předmětu Analýza a vizualizace ekonomických dat. Celý dokument je vytvořen pomocí systému Quarto (viz 12. týden), který umožňuje do jednoho souboru spojit psaný text a analýzu dat. V ISu najdete i zdrojový dokument tohoto textu.

library(dplyr)
library(purrr)
library(ggplot2)
library(modelsummary)
library(tinytable)

data("diamonds")

Data a základní operace s daty

Co je náplní kurzu prakticky ukážeme na datasetu “diamonds”, který obsahuje údaje o 53,940 diamantech. Data jsou uložena v tabulce diamonds. Tabulka obsahuje následující sloupce (vypisuje se jen pár prvních hodnot):

diamonds |> head() |> tt()

carat	cut	color	clarity	depth	table	price	x	y	z
0.23	Ideal	E	SI2	61.5	55	326	3.95	3.98	2.43
0.21	Premium	E	SI1	59.8	61	326	3.89	3.84	2.31
0.23	Good	E	VS1	56.9	65	327	4.05	4.07	2.31
0.29	Premium	I	VS2	62.4	58	334	4.20	4.23	2.63
0.31	Good	J	SI2	63.3	58	335	4.34	4.35	2.75
0.24	Very Good	J	VVS2	62.8	57	336	3.94	3.96	2.48

Jazyk R umožňuje s daty lehce manipulovat. Jednoduše si můžete vyfiltrovat původní data podle vybraných kritérií. Například se můžeme podívat na cenu a váhu u nejlépe zbarvených kamenů (opět vypíšeme jen prvních pár řádků):

diamonds |> filter(color=="D") |> select(color,price,carat) |> head() |> tt()

color	price	carat
D	357	0.23
D	402	0.23
D	403	0.26
D	403	0.26
D	403	0.26
D	404	0.22

Data lze i jednoduše setřídit. Například je možné se podívat na ty nejdražší kameny:

diamonds |> arrange(desc(price)) |> head() |> tt()

carat	cut	color	clarity	depth	table	price	x	y	z
2.29	Premium	I	VS2	60.8	60	18823	8.50	8.47	5.16
2.00	Very Good	G	SI1	63.5	56	18818	7.90	7.97	5.04
1.51	Ideal	G	IF	61.7	55	18806	7.37	7.41	4.56
2.07	Ideal	G	SI2	62.5	55	18804	8.20	8.13	5.11
2.00	Very Good	H	SI1	62.8	57	18803	7.95	8.00	5.01
2.29	Premium	I	SI1	61.8	59	18797	8.52	8.45	5.24

Jednotlivé operace lze kombinovat do větších celků. Například je možné vybrat nejdražší kámen pro každou barvu:

diamonds |> group_by(color) |> arrange(desc(price)) |> slice(1L) |> tt()

carat	cut	color	clarity	depth	table	price	x	y	z
2.19	Ideal	D	SI2	61.8	57	18693	8.23	8.49	5.17
2.02	Very Good	E	SI1	59.8	59	18731	8.11	8.20	4.88
1.71	Premium	F	VS2	62.3	59	18791	7.57	7.53	4.70
2.00	Very Good	G	SI1	63.5	56	18818	7.90	7.97	5.04
2.00	Very Good	H	SI1	62.8	57	18803	7.95	8.00	5.01
2.29	Premium	I	VS2	60.8	60	18823	8.50	8.47	5.16
3.01	Premium	J	SI2	60.7	59	18710	9.35	9.22	5.64

Data je možné i jednoduše agregovat, například spočítat průměrnou cenu pro každou barvu kamenů:

diamonds |>
    group_by(color) |>
    summarise(average_price = mean(price, na.rm = TRUE), .groups = "drop") |>
    tt()

color	average_price
D	3169.954
E	3076.752
F	3724.886
G	3999.136
H	4486.669
I	5091.875
J	5323.818

Kritéria je možné i kombinovat. Následující tabulka obsahuje průměrnou cenu kamene pro kombinaci barvy a řezu (pro stručnost je vypsáno jen prvních 10 řádků):

diamonds |>
    group_by(color,cut) |>
    summarise(average_price = mean(price, na.rm = TRUE), .groups = "drop") |>
    slice(1:10) |>
    tt()

color	cut	average_price
D	Fair	4291.061
D	Good	3405.382
D	Very Good	3470.467
D	Premium	3631.293
D	Ideal	2629.095
E	Fair	3682.312
E	Good	3423.644
E	Very Good	3214.652
E	Premium	3538.914
E	Ideal	2597.550

Vykreslení dat

R obsahuje mocné nástroje pro vizualizaci dat a jejich vztahů. Například odhad hustoty rozdělení ceny pro jednotlivé řezy kamenů:

diamonds |>
  ggplot(aes(price,fill = cut)) + 
  geom_density(alpha = 0.35) +
  theme_bw()

Vzhled grafů lze modifikovat a přidávat dodatečné funkce – v tomto případě vyhlazení. Všimněte si, že R nemá problém s češtinou:

diamonds |>
  ggplot(aes(x = carat,y = price)) + 
  geom_point(alpha = 0.05) +
  geom_smooth() +
  xlab("váha") + ylab("cena") +
  theme_bw()

Vykreslovat lze i vztahy kategoriálních proměnných. Například vztah ceny podle barvy kamene ve formě boxplotu:

diamonds |>
  ggplot(aes(color,y = price)) + 
  geom_boxplot() +
  theme_bw()

…nebo vykreslením zvláštního grafu pro každou barvu:

diamonds |>
  ggplot(aes(x = carat,y = price)) + 
  geom_point(alpha = 0.05) +
  facet_wrap(~color) +
  theme_bw()

Regrese

V diplomových a bakalářských pracích budete často potřebovat provést kvantitativní analýzu dat. S R to není problém. Například ukážeme odhad rovnice vysvětlující cenu diamantů jejich charakteristikami (váhou, řezem, barvou, jasností a velikostí):

\[ \textrm{price}_i = \alpha + \beta \textrm{carat}_i + \gamma \textrm{cut}_t + \epsilon \textrm{table}_i + \varepsilon \]

model <- price ~ carat + cut + table
em <- lm(model, diamonds)

Proměnné cut, color a clarity jsou kategoriální. R je automaticky převede na vektor umělých proměnných (a jednu z nich vypustí). Výsledky regrese se dají zobrazit v přehledné tabulce:

modelsummary(
    em,
    estimate  = c("{estimate} ({std.error}){stars}"),
    statistic = NULL,
    fmt = 2,
    stars = c("*" = 0.1, "**" = 0.05, "***" = 0.01),
    gof_omit = "R2 Adj|IC|Lik|F|RMSE"
)

	(1)
(Intercept)	-1555.61 (205.60)***
carat	7878.92 (14.05)***
cut.L	1202.79 (26.92)***
cut.Q	-546.62 (23.35)***
cut.C	348.86 (20.49)***
cut^4	58.30 (16.49)***
table	-19.84 (3.55)***
Num.Obs.	53940
R2	0.857

Často potřebujete porovnat model odhadnuté v různých specifikacích. Například by mohlo být zajímavé nahradit proměnnou table jiným měřítkem velikosti kamene:

model <- list(
  model,
  model |> update(. ~ . - table + depth),
  model |> update(. ~ . - table + x),
  model |> update(. ~ . - table + y),
  model |> update(. ~ . - table + z)
)

em <- map(model, ~ lm(., data = diamonds))

A výsledky lze opět porovnat v přehledné tabulce…

modelsummary(
    em,
    estimate  = c("{estimate} ({std.error}){stars}"),
    statistic = NULL,
    fmt = 2,
    stars = c("*" = 0.1, "**" = 0.05, "***" = 0.01),
    gof_omit = "R2 Adj|IC|Lik|F|RMSE"
)