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(tidyr)
library(dplyr)
tidy <- data %>% gather(typ_menza_den, známka, -c(osobaID, pohlavi), na.rm = TRUE) %>% 
    separate(typ_menza_den, c("typ", "menza", "den"))

tidy$den <- factor(tidy$den, ordered = TRUE, levels = c("po", "út", "st", "čt", "pá"))
tidy
## Source: local data frame [3,462 x 6]
## 
##    osobaID pohlavi     typ menza    den známka
##      (dbl)   (chr)   (chr) (chr) (fctr)  (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
## ..     ...     ...     ...   ...    ...    ...
# 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))
## Source: local data frame [1 x 1]
## 
##   pocet
##   (int)
## 1   498
tidy %>% group_by(pohlavi) %>% summarise(počet = n_distinct(osobaID))
## Source: local data frame [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))
## Source: local data frame [10 x 3]
## Groups: den [?]
## 
##       den pohlavi pocet
##    (fctr)   (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))
## Source: local data frame [3 x 2]
## 
##   menza   hlavni
##   (chr)    (dbl)
## 1     1 1.757216
## 2     2 1.812092
## 3     3 2.851916
  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(hlavni = mean(známka))
## Source: local data frame [3 x 2]
## 
##   menza   hlavni
##   (chr)    (dbl)
## 1     1 1.958855
## 2     2 1.200692
## 3     3 3.167273
  1. Rozdělte předchozí 2 otázky podle pohlaví.
tidy %>% filter(typ == "hlavní") %>% group_by(menza, pohlavi) %>% summarise(hlavni = mean(známka))
## Source: local data frame [6 x 3]
## Groups: menza [?]
## 
##   menza pohlavi   hlavni
##   (chr)   (chr)    (dbl)
## 1     1     muž 1.777778
## 2     1    žena 1.744505
## 3     2     muž 1.728745
## 4     2    žena 1.868493
## 5     3     muž 2.859031
## 6     3    žena 2.847262
tidy %>% filter(typ == "polévka") %>% group_by(menza, pohlavi) %>% summarise(hlavni = mean(známka))
## Source: local data frame [6 x 3]
## Groups: menza [?]
## 
##   menza pohlavi   hlavni
##   (chr)   (chr)    (dbl)
## 1     1     muž 1.967442
## 2     1    žena 1.953488
## 3     2     muž 1.240343
## 4     2    žena 1.173913
## 5     3     muž 3.142857
## 6     3    žena 3.183183
  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))
## Source: local data frame [15 x 4]
## Groups: menza [?]
## 
##    menza    den   hlavni pocet
##    (chr) (fctr)    (dbl) (int)
## 1      1     po 2.033898   118
## 2      1     út 2.117647   119
## 3      1     st 2.445378   119
## 4      1     čt 1.026087   115
## 5      1     pá 1.135593   118
## 6      2     po 1.071429   112
## 7      2     út 2.515873   126
## 8      2     st 2.394737   114
## 9      2     čt 1.079137   139
## 10     2     pá 2.057851   121
## 11     3     po 1.929204   113
## 12     3     út 4.057143   105
## 13     3     st 2.782258   124
## 14     3     čt 2.689320   103
## 15     3     pá 2.875969   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))
## Source: local data frame [15 x 4]
## Groups: menza [?]
## 
##    menza    den   hlavni pocet
##    (chr) (fctr)    (dbl) (int)
## 1      1     po 2.052632   114
## 2      1     út 2.637931   116
## 3      1     st 1.625000   112
## 4      1     čt 1.438095   105
## 5      1     pá 1.982143   112
## 6      2     po 1.361905   105
## 7      2     út 1.025210   119
## 8      2     st 1.112150   107
## 9      2     čt 1.135338   133
## 10     2     pá 1.394737   114
## 11     3     po 4.376147   109
## 12     3     út 2.887755    98
## 13     3     st 3.173554   121
## 14     3     čt 2.383838    99
## 15     3     pá 2.943089   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
## Classes 'tbl_df', 'tbl' and 'data.frame':    3462 obs. of  6 variables:
##  $ osobaID: num  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 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)