Домашнее задание 2

Во второй домашке узнаем всё про пассажиров Титаника и закрепим изученное на семинаре :)

Прежде всего — библиотеки!

Упражнение 0.

Отключите в этом куске кода сообщения и предупреждения.

library(tidyverse) # обработка данных, графики...
library(vcd) # мозаичные графики для качественных переменных
library(skimr) # описательные статистики
library(rio) # импорт фантастического количества форматов данных
library(ggalluvial) # потоковые диаграммы для качественных переменных
library(titanic) # набор данных о пассажирах Титаника
library(corrplot) # визуализация корреляций
library(reshape2) # длинные и широкие таблицы

Описание данных:

Survived - выжил ли пассажир (1 — да, 0 — нет)
Pclass - класс билета (1 — первый, 2 — второй, 3 — третий)
Name - имя пассажира
Sex - пол пассажира
Age - возраст пассажира
SibSp - число братьев или сестер / присутствие мужа или жены на корабле
Parch - количество детей / родителей на корабле
Ticket - номер билета
Fare - стоимость билета
Cabin - номер каюты
Embarked - порт посадки (C = Cherbourg, Q = Queenstown, S = Southampton)

Прежде всего положим данные в переменную df и посмотрим описателные статистики.

df <- import('titanic.csv')
skim(df)

## Skim summary statistics
##  n obs: 891 
##  n variables: 12

## Warning: package 'bindrcpp' was built under R version 3.4.4

## 
## Variable type: character 
##  variable missing complete   n min max empty n_unique
##     Cabin       0      891 891   0  15   687      148
##  Embarked       0      891 891   0   1     2        4
##      Name       0      891 891  12  82     0      891
##       Sex       0      891 891   4   6     0        2
##    Ticket       0      891 891   3  18     0      681
## 
## Variable type: integer 
##     variable missing complete   n   mean     sd p0   p25 p50   p75 p100
##        Parch       0      891 891   0.38   0.81  0   0     0   0      6
##  PassengerId       0      891 891 446    257.35  1 223.5 446 668.5  891
##       Pclass       0      891 891   2.31   0.84  1   2     3   3      3
##        SibSp       0      891 891   0.52   1.1   0   0     0   1      8
##     Survived       0      891 891   0.38   0.49  0   0     0   1      1
##      hist
##  ▇▂▁▁▁▁▁▁
##  ▇▇▇▇▇▇▇▇
##  ▃▁▁▃▁▁▁▇
##  ▇▁▁▁▁▁▁▁
##  ▇▁▁▁▁▁▁▅
## 
## Variable type: numeric 
##  variable missing complete   n mean    sd   p0   p25   p50 p75   p100
##       Age     177      714 891 29.7 14.53 0.42 20.12 28     38  80   
##      Fare       0      891 891 32.2 49.69 0     7.91 14.45  31 512.33
##      hist
##  ▂▃▇▆▃▂▁▁
##  ▇▁▁▁▁▁▁▁

Сколько наблюдений в данных?
Сколько переменных?
Все ли переменные соответсвуют своему типу по смыслу?
Упражнение 1.

Пассажиры Титаника могли попасть на корабаль из трёх портов, два из которых находились в Великобритании, а один во Франции.

Какова частотность каждой категории в столбце Embarked?
Объедините британские порты Саутгемптон и Квинстаун в одну категорию GB и сохраните результат в переменной df2.
Что стало с частотностью категорий Embarked в новой таблице df2

table(df$Embarked)

## 
##       C   Q   S 
##   2 168  77 644

df2 <- mutate(df, Embarked = fct_collapse(Embarked, GB = c('Q', 'C')))
table(df2$Embarked)

## 
##      GB   S 
##   2 245 644

Упражнение 2.

Выясним, как связаны класс каюты пассажира и выживание.

Составьте таблицу сопряжённости признаков PClass и Survived.
Проведите тест на независимость этих признаков.
Какой вывод можно сделать?

ctable <- table(df$Pclass, df$Survived)
chisq.test(ctable)

## 
##  Pearson's Chi-squared test
## 
## data:  ctable
## X-squared = 102.89, df = 2, p-value < 2.2e-16

Упражнение 3.

Посмотрим, как соотносятся пол пассажира и класс каюты с его выживанием.

Составьте таблицу сопряжённости для признаков Pclass, Survived, Sex и сохраните её. Не забудьте добавить названия! За это отвечает аргумент dnn :)
Постройте мозаичный график для получившейся таблицы, обязателно цветной и с легендой!
Что на нём изображено?

ctable <- table(df$Pclass, df$Survived, df$Sex, dnn = c('Pclass', 'Survived', 'Sex'))
mosaic(ctable, shade = TRUE, legend = TRUE)

Упражнение 4.

Продолжим исследовать информацию о пассажирах!

Посчитайте корреляции признаков Survived, Age, SibSp, Parch, Fare.
Какой признак сильнее всего коррелирует с выживанием?
Визуализируйте корреляции: постройте график со значениями выше диагонали и квадратами внутри.
Для чего понадобился аргумент use = 'pairwise.complete.obs'?

mcor <- cor(df[, c('Survived', 'Age', 'SibSp', 'Parch', 'Fare')], use = 'pairwise.complete.obs')
mcor

##             Survived         Age      SibSp       Parch       Fare
## Survived  1.00000000 -0.07722109 -0.0353225  0.08162941 0.25730652
## Age      -0.07722109  1.00000000 -0.3082468 -0.18911926 0.09606669
## SibSp    -0.03532250 -0.30824676  1.0000000  0.41483770 0.15965104
## Parch     0.08162941 -0.18911926  0.4148377  1.00000000 0.21622494
## Fare      0.25730652  0.09606669  0.1596510  0.21622494 1.00000000

corrplot(mcor, method = 'square', type = 'upper')

Упражнение 5.

Посмотрим на распределение возраста пассажиров Титаника.

Постройте скрипичный график командой geom_viloin() из пакета ggplot2. Не забудьте подписать оси и придумать название!
Разбейте график на две панели по признаку Survived.

df <- mutate(df, Pclass = factor(Pclass))

ggplot(data = df, aes(x = Pclass, y = Age)) +
  geom_violin() + 
  labs(x = 'Класс каюты', y = 'Возраст', title = 'Возраст пассажиров')

## Warning: Removed 177 rows containing non-finite values (stat_ydensity).

ggplot(data = df, aes(x = factor(Pclass), y = Age)) +
  geom_violin() + 
  facet_grid(Survived ~ .) +
  labs(x = 'Класс каюты', y = 'Возраст', title = 'Возраст пассажиров')

## Warning: Removed 177 rows containing non-finite values (stat_ydensity).

Упражнение 6.

Цель задания — построить потоковую диаграмму!

Посчитайте таблицу частот по переменным Pclass, Sex, Survived. Для этого сгруппируйте наблюдения по этим переменным, а затем для каждой группы посчитайте количество наблюдений n().
Дополните код для потоковой диаграммы. В качестве аргумента data нужно указать созданную таблицу частот, в аргументы axis_ передайте класс каюты, пол и выживыших в этом порядке. Аргумент fill отвечает за цвет потоков — раскрасьте их по классу каюты.

freq_table <- group_by(df, Pclass, Sex, Survived) %>% summarise(freq = n())
freq_table

## # A tibble: 12 x 4
## # Groups:   Pclass, Sex [?]
##    Pclass Sex    Survived  freq
##    <fct>  <chr>     <int> <int>
##  1 1      female        0     3
##  2 1      female        1    91
##  3 1      male          0    77
##  4 1      male          1    45
##  5 2      female        0     6
##  6 2      female        1    70
##  7 2      male          0    91
##  8 2      male          1    17
##  9 3      female        0    72
## 10 3      female        1    72
## 11 3      male          0   300
## 12 3      male          1    47

ggplot(data = freq_table, aes(weight = freq, axis1 = Pclass, axis2 = Sex, axis3 = Survived)) + 
  geom_alluvium(aes(fill = Pclass), width = 1/12) +
  geom_stratum(width = 1/8) +
  geom_label(stat = 'stratum', label.strata = TRUE) +
  scale_x_continuous(breaks = 1:3, labels = c('Class', 'Sex', 'Survived'))

## Warning in to_lodes(data = data, axes = axis_ind, discern =
## params$discern): Some strata appear at multiple axes.

## Warning in to_lodes(data = data, axes = axis_ind, discern =
## params$discern): Some strata appear at multiple axes.

## Warning in to_lodes(data = data, axes = axis_ind, discern =
## params$discern): Some strata appear at multiple axes.

Упражнение 7.

Постройте широкую таблицу, в которой по строкам будем класс каюты пассажира, по столбцам — количесвто его братьев и сестёр на корабле, а внутри — средняя цена билета.

dcast(df, SibSp ~ Pclass, value.var = 'Fare', fun.aggregate = mean)

##   SibSp         1        2         3
## 1     0  75.22336 15.53233  9.832689
## 2     1  88.49202 28.38568 16.658487
## 3     2 159.97584 44.46875 19.564993
## 4     3 263.00000 21.00000 24.378483
## 5     4       NaN      NaN 31.855556
## 6     5       NaN      NaN 46.900000
## 7     8       NaN      NaN 69.550000

Упражнение 8.

В вашем распоряжении новые (но недостоверные) данные о пассажирах Титаника.

Загрузите их из файла titanic_info.xlsx.
Сколько наблюдений в новых данных? Какие переменные совпадают с основными данными?
Объедините новую таблицу с таблицей df всеми возможными способами.
Для каждого случая определите колчиство наблюдений в получившейся таблице.

new_df <- import('titanic_info.xlsx')

## Warning in strptime(x, format, tz = tz): unknown timezone 'zone/tz/2018c.
## 1.0/zoneinfo/Europe/Moscow'

lj <- left_join(df, new_df, by = 'PassengerId')
skim(lj)

## Skim summary statistics
##  n obs: 891 
##  n variables: 14 
## 
## Variable type: character 
##  variable missing complete   n min max empty n_unique
##     Cabin       0      891 891   0  15   687      148
##  Embarked       0      891 891   0   1     2        4
##      Name       0      891 891  12  82     0      891
##       Sex       0      891 891   4   6     0        2
##    Ticket       0      891 891   3  18     0      681
## 
## Variable type: factor 
##  variable missing complete   n n_unique                    top_counts
##    Pclass       0      891 891        3 3: 491, 1: 216, 2: 184, NA: 0
##  ordered
##    FALSE
## 
## Variable type: integer 
##  variable missing complete   n mean   sd p0 p25 p50 p75 p100     hist
##     Parch       0      891 891 0.38 0.81  0   0   0   0    6 ▇▂▁▁▁▁▁▁
##     SibSp       0      891 891 0.52 1.1   0   0   0   1    8 ▇▁▁▁▁▁▁▁
##  Survived       0      891 891 0.38 0.49  0   0   0   1    1 ▇▁▁▁▁▁▁▅
## 
## Variable type: numeric 
##     variable missing complete   n   mean     sd   p0    p25    p50   p75
##          Age     177      714 891  29.7   14.53 0.42  20.12  28     38  
##         Fare       0      891 891  32.2   49.69 0      7.91  14.45  31  
##     Holidays      94      797 891 187.19 106.08 0     96    193    275  
##  PassengerId       0      891 891 446    257.35 1    223.5  446    668.5
##         Pets      91      800 891   2.53   1.72 0      1      2      4  
##    p100     hist
##   80    ▂▃▇▆▃▂▁▁
##  512.33 ▇▁▁▁▁▁▁▁
##  365    ▇▇▇▇▇▇▇▇
##  891    ▇▇▇▇▇▇▇▇
##    5    ▇▇▁▇▆▁▇▇

rj <- right_join(df, new_df, by = 'PassengerId')
skim(rj)

## Skim summary statistics
##  n obs: 836 
##  n variables: 14 
## 
## Variable type: character 
##  variable missing complete   n min max empty n_unique
##     Cabin       0      836 836   0  15   645      140
##  Embarked       0      836 836   0   1     2        4
##      Name       0      836 836  12  82     0      836
##       Sex       0      836 836   4   6     0        2
##    Ticket       0      836 836   3  18     0      652
## 
## Variable type: factor 
##  variable missing complete   n n_unique                    top_counts
##    Pclass       0      836 836        3 3: 463, 1: 202, 2: 171, NA: 0
##  ordered
##    FALSE
## 
## Variable type: integer 
##  variable missing complete   n mean   sd p0 p25 p50 p75 p100     hist
##     Parch       0      836 836 0.37 0.8   0   0   0   0    6 ▇▁▁▁▁▁▁▁
##     SibSp       0      836 836 0.51 1.09  0   0   0   1    8 ▇▁▁▁▁▁▁▁
##  Survived       0      836 836 0.39 0.49  0   0   0   1    1 ▇▁▁▁▁▁▁▅
## 
## Variable type: numeric 
##     variable missing complete   n   mean     sd   p0    p25    p50    p75
##          Age     170      666 836  29.88  14.51 0.42  21     28.5   38.75
##         Fare       0      836 836  31.83  48.18 0      7.9   13.82  30.5 
##     Holidays      39      797 836 187.19 106.08 0     96    193    275   
##  PassengerId       0      836 836 443.75 261.79 1    217.75 440.5  673.25
##         Pets      36      800 836   2.53   1.72 0      1      2      4   
##    p100     hist
##   80    ▂▃▇▆▃▂▁▁
##  512.33 ▇▁▁▁▁▁▁▁
##  365    ▇▇▇▇▇▇▇▇
##  891    ▇▇▇▇▇▇▇▇
##    5    ▇▇▁▇▆▁▇▇

ij <- inner_join(df, new_df, by = 'PassengerId')
skim(ij)

## Skim summary statistics
##  n obs: 836 
##  n variables: 14 
## 
## Variable type: character 
##  variable missing complete   n min max empty n_unique
##     Cabin       0      836 836   0  15   645      140
##  Embarked       0      836 836   0   1     2        4
##      Name       0      836 836  12  82     0      836
##       Sex       0      836 836   4   6     0        2
##    Ticket       0      836 836   3  18     0      652
## 
## Variable type: factor 
##  variable missing complete   n n_unique                    top_counts
##    Pclass       0      836 836        3 3: 463, 1: 202, 2: 171, NA: 0
##  ordered
##    FALSE
## 
## Variable type: integer 
##  variable missing complete   n mean   sd p0 p25 p50 p75 p100     hist
##     Parch       0      836 836 0.37 0.8   0   0   0   0    6 ▇▁▁▁▁▁▁▁
##     SibSp       0      836 836 0.51 1.09  0   0   0   1    8 ▇▁▁▁▁▁▁▁
##  Survived       0      836 836 0.39 0.49  0   0   0   1    1 ▇▁▁▁▁▁▁▅
## 
## Variable type: numeric 
##     variable missing complete   n   mean     sd   p0    p25    p50    p75
##          Age     170      666 836  29.88  14.51 0.42  21     28.5   38.75
##         Fare       0      836 836  31.83  48.18 0      7.9   13.82  30.5 
##     Holidays      39      797 836 187.19 106.08 0     96    193    275   
##  PassengerId       0      836 836 443.75 261.79 1    217.75 440.5  673.25
##         Pets      36      800 836   2.53   1.72 0      1      2      4   
##    p100     hist
##   80    ▂▃▇▆▃▂▁▁
##  512.33 ▇▁▁▁▁▁▁▁
##  365    ▇▇▇▇▇▇▇▇
##  891    ▇▇▇▇▇▇▇▇
##    5    ▇▇▁▇▆▁▇▇

fj <- full_join(df, new_df, by = 'PassengerId')
skim(fj)

## Skim summary statistics
##  n obs: 891 
##  n variables: 14 
## 
## Variable type: character 
##  variable missing complete   n min max empty n_unique
##     Cabin       0      891 891   0  15   687      148
##  Embarked       0      891 891   0   1     2        4
##      Name       0      891 891  12  82     0      891
##       Sex       0      891 891   4   6     0        2
##    Ticket       0      891 891   3  18     0      681
## 
## Variable type: factor 
##  variable missing complete   n n_unique                    top_counts
##    Pclass       0      891 891        3 3: 491, 1: 216, 2: 184, NA: 0
##  ordered
##    FALSE
## 
## Variable type: integer 
##  variable missing complete   n mean   sd p0 p25 p50 p75 p100     hist
##     Parch       0      891 891 0.38 0.81  0   0   0   0    6 ▇▂▁▁▁▁▁▁
##     SibSp       0      891 891 0.52 1.1   0   0   0   1    8 ▇▁▁▁▁▁▁▁
##  Survived       0      891 891 0.38 0.49  0   0   0   1    1 ▇▁▁▁▁▁▁▅
## 
## Variable type: numeric 
##     variable missing complete   n   mean     sd   p0    p25    p50   p75
##          Age     177      714 891  29.7   14.53 0.42  20.12  28     38  
##         Fare       0      891 891  32.2   49.69 0      7.91  14.45  31  
##     Holidays      94      797 891 187.19 106.08 0     96    193    275  
##  PassengerId       0      891 891 446    257.35 1    223.5  446    668.5
##         Pets      91      800 891   2.53   1.72 0      1      2      4  
##    p100     hist
##   80    ▂▃▇▆▃▂▁▁
##  512.33 ▇▁▁▁▁▁▁▁
##  365    ▇▇▇▇▇▇▇▇
##  891    ▇▇▇▇▇▇▇▇
##    5    ▇▇▁▇▆▁▇▇

Бонус победителю!

Если все упражнения получились, можно смело нажимать Knit :)

Домашнее задание 2

May 27, 2018