Vypracoval: Tomáš Bořil, 18. 11. 2015.
Jste společným ředitelem tří menz jedné univerzity a máte podezření, že kvalita se výrazně liší. Provedl se proto v rámci jednoho týdne velký průzkum, kterého se zúčastnilo značné množství dotázaných studentů. Za úkol měli hodnotit známkou 1 až 5 (jako ve škole), jak byli spokojeni s hlavním jídlem a polévkou (pokud si ji vzali).
Od podřízených pracovníků se Vám do ruky dostala ne zcela přehledná tabulka (i když jejím tvůrcům připadala v době přípravy připadala naprosto skvělá), a proto ji bude lepší zpracovat odborně, což jistě zvládnete nejlépe právě Vy.
Je zřejmé, že v řádcích je identifikační číslo jednotlivých studentů (kvůli anonymitě), sloupce odpovídají kombinaci ve tvaru TypJídla_ČísloMenzy_Den. Student si vždy daný den zvolil náhodně jednu menzu (pokud to vůbec stíhal) a zde pak hodnotil. Z toho důvodu je mnoho políček prázdných.
Vypracujte stručný a přehledný report ve formátu R Markdown (výstupem je .html stránka), který vyřeší následující problémy. Mělo by být zřejmé, jakými příkazy jste k výsledkům dospěli, aby je mohl případně někdo překontrolovat.
library(readxl)
data <- read_excel("menzy_pruzkum.xlsx")
library(tidyverse)
tidy <- data %>%
pivot_longer(cols = -c(osobaID, pohlavi), names_to = "typ_menza_den", values_to = "známka",
values_drop_na = TRUE) %>%
separate(typ_menza_den, c("typ", "menza", "den"), sep = "_")
tidy$den <- factor(tidy$den, ordered = TRUE, levels = c("po", "út", "st", "čt", "pá"))
tidy
## # A tibble: 3,462 × 6
## osobaID pohlavi typ menza den známka
## <dbl> <chr> <chr> <chr> <ord> <dbl>
## 1 1 žena polévka 1 po 1
## 2 1 žena hlavní 1 po 1
## 3 1 žena polévka 2 út 1
## 4 1 žena hlavní 2 út 2
## 5 1 žena polévka 1 st 1
## 6 1 žena hlavní 1 st 2
## 7 1 žena polévka 3 čt 3
## 8 1 žena hlavní 3 čt 3
## 9 2 muž polévka 2 po 1
## 10 2 muž hlavní 2 po 1
## # ℹ 3,452 more rows
tidy %>% summarise(pocet = n_distinct(osobaID)) # totéž, co length(unique(tidy$osobaID))
## # A tibble: 1 × 1
## pocet
## <int>
## 1 498
tidy %>% group_by(pohlavi) %>% summarise(počet = n_distinct(osobaID))
## # A tibble: 2 × 2
## pohlavi počet
## <chr> <int>
## 1 muž 195
## 2 žena 303
tidy %>% group_by(den, pohlavi) %>% summarise(pocet = n_distinct(osobaID))
## # A tibble: 10 × 3
## # Groups: den [5]
## den pohlavi pocet
## <ord> <chr> <int>
## 1 po muž 131
## 2 po žena 212
## 3 út muž 136
## 4 út žena 214
## 5 st muž 140
## 6 st žena 217
## 7 čt muž 144
## 8 čt žena 213
## 9 pá muž 148
## 10 pá žena 220
tidy %>% filter(typ == "hlavní") %>% group_by(menza) %>% summarise(hlavni = mean(známka))
## # A tibble: 3 × 2
## menza hlavni
## <chr> <dbl>
## 1 1 1.76
## 2 2 1.81
## 3 3 2.85
tidy %>% filter(typ == "polévka") %>% group_by(menza) %>% summarise(polevka = mean(známka))
## # A tibble: 3 × 2
## menza polevka
## <chr> <dbl>
## 1 1 1.96
## 2 2 1.20
## 3 3 3.17
tidy %>% group_by(typ, menza, pohlavi) %>% summarise(hlavni = mean(známka))
## # A tibble: 12 × 4
## # Groups: typ, menza [6]
## typ menza pohlavi hlavni
## <chr> <chr> <chr> <dbl>
## 1 hlavní 1 muž 1.78
## 2 hlavní 1 žena 1.74
## 3 hlavní 2 muž 1.73
## 4 hlavní 2 žena 1.87
## 5 hlavní 3 muž 2.86
## 6 hlavní 3 žena 2.85
## 7 polévka 1 muž 1.97
## 8 polévka 1 žena 1.95
## 9 polévka 2 muž 1.24
## 10 polévka 2 žena 1.17
## 11 polévka 3 muž 3.14
## 12 polévka 3 žena 3.18
tidy %>% filter(typ == "hlavní") %>% group_by(menza, den) %>%
summarise(hlavni = mean(známka), pocet = n_distinct(osobaID))
## # A tibble: 15 × 4
## # Groups: menza [3]
## menza den hlavni pocet
## <chr> <ord> <dbl> <int>
## 1 1 po 2.03 118
## 2 1 út 2.12 119
## 3 1 st 2.45 119
## 4 1 čt 1.03 115
## 5 1 pá 1.14 118
## 6 2 po 1.07 112
## 7 2 út 2.52 126
## 8 2 st 2.39 114
## 9 2 čt 1.08 139
## 10 2 pá 2.06 121
## 11 3 po 1.93 113
## 12 3 út 4.06 105
## 13 3 st 2.78 124
## 14 3 čt 2.69 103
## 15 3 pá 2.88 129
tidy %>% filter(typ == "polévka") %>% group_by(menza, den) %>%
summarise(hlavni = mean(známka), pocet = n_distinct(osobaID))
## # A tibble: 15 × 4
## # Groups: menza [3]
## menza den hlavni pocet
## <chr> <ord> <dbl> <int>
## 1 1 po 2.05 114
## 2 1 út 2.64 116
## 3 1 st 1.62 112
## 4 1 čt 1.44 105
## 5 1 pá 1.98 112
## 6 2 po 1.36 105
## 7 2 út 1.03 119
## 8 2 st 1.11 107
## 9 2 čt 1.14 133
## 10 2 pá 1.39 114
## 11 3 po 4.38 109
## 12 3 út 2.89 98
## 13 3 st 3.17 121
## 14 3 čt 2.38 99
## 15 3 pá 2.94 123
library(ggplot2)
tidy$pohlavi <- factor(tidy$pohlavi)
tidy$typ <- factor(tidy$typ)
tidy$menza <- factor(tidy$menza)
str(tidy) # kontrola
## tibble [3,462 × 6] (S3: tbl_df/tbl/data.frame)
## $ osobaID: num [1:3462] 1 1 1 1 1 1 1 1 2 2 ...
## $ pohlavi: Factor w/ 2 levels "muž","žena": 2 2 2 2 2 2 2 2 1 1 ...
## $ typ : Factor w/ 2 levels "hlavní","polévka": 2 1 2 1 2 1 2 1 2 1 ...
## $ menza : Factor w/ 3 levels "1","2","3": 1 1 2 2 1 1 3 3 2 2 ...
## $ den : Ord.factor w/ 5 levels "po"<"út"<"st"<..: 1 1 2 2 3 3 4 4 1 1 ...
## $ známka : num [1:3462] 1 1 1 2 1 2 3 3 1 1 ...
Běžný zápis v ggplot2 je trochu pozpátku, nejdříve řeknete, s jakými daty chcete pracovat a co kam nastrkat, a teprve pak volíte typ grafu.
Minimální provedení bych viděl např. takto. Pracujeme s daty “tabulka” a minimální estetika (aes) je, ať na x-ovou osu dá dny, na y-ovou hodnocení.
ggplot(data = tidy, aes(x = den, y = známka)) +
geom_violin()
Možná by se nám líbilo barevně oddělit chod. To uděláme přidáním dalšího požadavku do estetiky.
ggplot(data = tidy, aes(x = den, y = známka, fill = typ)) +
geom_violin()
To máme pořád ale všechny tři menzy v jednom. Tak co to rozdělit do samostatných panelů podle menzy? Přičteme další požadavek.
ggplot(data = tidy, aes(x = den, y = známka, fill = typ)) +
geom_violin() +
facet_grid(menza ~ .)
Jiná možnost konfigurace.
ggplot(data = tidy, aes(x = menza, y = známka, fill = menza)) +
facet_grid(typ ~ den) +
geom_violin()
Krabicové grafy nedopadnou moc dobře, příliš málo jedinečných diskrétních hodnot.
ggplot(data = tidy, aes(x = den, y = známka, fill = menza, color = menza)) +
facet_grid(typ ~ .) +
geom_boxplot()
Střední hodnota a odhad intervalu spolehlivosti jejího odhadu. Takto je to asi nepřehlednější pro tento typ dat.
ggplot(data = tidy, aes(x = den, y = známka, color = menza, group = menza)) +
facet_grid(typ ~ .) +
stat_summary(fun.y = mean, geom = "line") +
stat_summary(fun.data = mean_cl_boot, geom = "errorbar", width = 0.3)
# stat_summary(fun.data = mean_cl_boot, geom = "pointrange")
Ještě pokus s “histogramem”, ale není to moc přehledné.
tidy$známka <- factor(tidy$známka)
ggplot(data = tidy, aes(x = známka, fill = menza)) +
geom_bar(position = "dodge") +
facet_grid(den ~ typ)