Velký průzkum kvality menz

Vypracoval: Tomáš Bořil, 18. 11. 2015.

Zadání

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.

Úkoly

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.

  1. Načtěte tabulku ze souboru.
library(readxl)
data <- read_excel("menzy_pruzkum.xlsx")
  1. Aby se dalo s daty dobře pracovat, převeďte je nejdříve do Tidy Data formátu.
library(tidyverse)
tidy <- data %>% gather(typ_menza_den, známka, -c(osobaID, pohlavi), na.rm = 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 x 6
##    osobaID pohlavi typ     menza den   známka
##      <dbl> <chr>   <chr>   <chr> <ord>  <dbl>
##  1       1 žena    polévka 1     po         1
##  2       7 žena    polévka 1     po         3
##  3      15 žena    polévka 1     po         2
##  4      21 žena    polévka 1     po         1
##  5      22 žena    polévka 1     po         2
##  6      23 žena    polévka 1     po         2
##  7      24 žena    polévka 1     po         1
##  8      26 muž     polévka 1     po         2
##  9      30 žena    polévka 1     po         2
## 10      35 žena    polévka 1     po         3
## # ... with 3,452 more rows
# tidy <- tidy[complete.cases(tidy), ]
  1. Kolik studentů se aktivně zúčastnilo průzkumu (tedy navštívilo alespoň jednu menzu)? A kolik z toho bylo žen a kolik mužů?
tidy %>% summarise(pocet = n_distinct(osobaID))   # totéž, co length(unique(tidy$osobaID))
## # A tibble: 1 x 1
##   pocet
##   <int>
## 1   498
tidy %>% group_by(pohlavi) %>% summarise(počet = n_distinct(osobaID))
## # A tibble: 2 x 2
##   pohlavi počet
##   <chr>   <int>
## 1 muž       195
## 2 žena      303
  1. Určete počty (muži vs. ženy) pro každý den v týdnu zvlášť.
tidy %>% group_by(den, pohlavi) %>% summarise(pocet = n_distinct(osobaID))
## # A tibble: 10 x 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
  1. Jaké je průměrné hodnocení hlavních jídel jednotlivých 3 menz za celý týden?
tidy %>% filter(typ == "hlavní") %>% group_by(menza) %>% summarise(hlavni = mean(známka))
## # A tibble: 3 x 2
##   menza hlavni
##   <chr>  <dbl>
## 1 1       1.76
## 2 2       1.81
## 3 3       2.85
  1. Jaké je průměrné hodnocení polévek jednotlivých 3 menz za celý týden?
tidy %>% filter(typ == "polévka") %>% group_by(menza) %>% summarise(polevka = mean(známka))
## # A tibble: 3 x 2
##   menza polevka
##   <chr>   <dbl>
## 1 1        1.96
## 2 2        1.20
## 3 3        3.17
  1. Rozdělte předchozí 2 otázky podle pohlaví.
tidy %>% filter(typ == "hlavní") %>% group_by(menza, pohlavi) %>% summarise(hlavni = mean(známka))
## # A tibble: 6 x 3
## # Groups:   menza [3]
##   menza pohlavi hlavni
##   <chr> <chr>    <dbl>
## 1 1     muž       1.78
## 2 1     žena      1.74
## 3 2     muž       1.73
## 4 2     žena      1.87
## 5 3     muž       2.86
## 6 3     žena      2.85
tidy %>% filter(typ == "polévka") %>% group_by(menza, pohlavi) %>% summarise(polevka = mean(známka))
## # A tibble: 6 x 3
## # Groups:   menza [3]
##   menza pohlavi polevka
##   <chr> <chr>     <dbl>
## 1 1     muž        1.97
## 2 1     žena       1.95
## 3 2     muž        1.24
## 4 2     žena       1.17
## 5 3     muž        3.14
## 6 3     žena       3.18
  1. Jaké bylo průměrné hodnocení hlavních jídel každé menzy v jednotlivé dny? A počet hodnotících?
tidy %>% filter(typ == "hlavní") %>% group_by(menza, den) %>%
    summarise(hlavni = mean(známka), pocet = n_distinct(osobaID))
## # A tibble: 15 x 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
  1. A to samé pro polévky?
tidy %>% filter(typ == "polévka") %>% group_by(menza, den) %>%
    summarise(hlavni = mean(známka), pocet = n_distinct(osobaID))
## # A tibble: 15 x 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
  1. Pomocí např. houslových grafů (geom_violin) znázorněte souhrnné hodnocení jednotlivých menz v jednotlivých dnech. V grafu přehledně oddělte hlavní jídla od polévek.
library(ggplot2)

tidy$pohlavi <- factor(tidy$pohlavi)
tidy$typ <- factor(tidy$typ)
tidy$menza <- factor(tidy$menza)

str(tidy)  # kontrola
## tibble [3,462 x 6] (S3: tbl_df/tbl/data.frame)
##  $ osobaID: num [1:3462] 1 7 15 21 22 23 24 26 30 35 ...
##  $ pohlavi: Factor w/ 2 levels "muž","žena": 2 2 2 2 2 2 2 1 2 2 ...
##  $ typ    : Factor w/ 2 levels "hlavní","polévka": 2 2 2 2 2 2 2 2 2 2 ...
##  $ menza  : Factor w/ 3 levels "1","2","3": 1 1 1 1 1 1 1 1 1 1 ...
##  $ den    : Ord.factor w/ 5 levels "po"<"út"<"st"<..: 1 1 1 1 1 1 1 1 1 1 ...
##  $ známka : num [1:3462] 1 3 2 1 2 2 1 2 2 3 ...

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)