Analiza danych Titanic
Baza danych Titanic
W momencie wodowania “Titanic” był największym pasażerskim statkiem parowym na świecie. W swój dziewiczy rejs wypłynął z portu w Southampton 10 kwietnia 1912 roku do Nowego Jorku. W nocy z 14 na 15 kwietnia zderzył się z górą lodową. Zatonął w ciągu niespełna trzech godzin. Katastrofa “Titanica” była największą katastrofą morską w czasach pokoju. Spośród ponad 2,2 tys. pasażerów i członków załogi życie straciło ponad 1,5 tys. osób.
Pracujemy na danych pt. “Titanic Passenger Survival Data Set” z pakietu titanic w R, korzystamy zarówno z danych titanic_train jak i titanic_test. Na ich podstawie analizujemy które czynniki mają wpływ na przeżycie tej katastrofy. Więcej szczegółów o tej bazie danych można znaleźć https://github.com/cran/titanic.
#install.packages("titanic")
library(titanic)
library(dplyr)
library(ggplot2)
library(zoo)
library(reshape2)
#install.packages("PerformanceAnalytics")
library("PerformanceAnalytics")
library(tidyverse)
library(extrafont)
library(extrafontdb)Dane wejsciowe
Podstawowe informacje o danych w titanic_train
summary(titanic_train) #podstawowe statystyki## PassengerId Survived Pclass Name
## Min. : 1.0 Min. :0.0000 Min. :1.000 Length:891
## 1st Qu.:223.5 1st Qu.:0.0000 1st Qu.:2.000 Class :character
## Median :446.0 Median :0.0000 Median :3.000 Mode :character
## Mean :446.0 Mean :0.3838 Mean :2.309
## 3rd Qu.:668.5 3rd Qu.:1.0000 3rd Qu.:3.000
## Max. :891.0 Max. :1.0000 Max. :3.000
##
## Sex Age SibSp Parch
## Length:891 Min. : 0.42 Min. :0.000 Min. :0.0000
## Class :character 1st Qu.:20.12 1st Qu.:0.000 1st Qu.:0.0000
## Mode :character Median :28.00 Median :0.000 Median :0.0000
## Mean :29.70 Mean :0.523 Mean :0.3816
## 3rd Qu.:38.00 3rd Qu.:1.000 3rd Qu.:0.0000
## Max. :80.00 Max. :8.000 Max. :6.0000
## NA's :177
## Ticket Fare Cabin Embarked
## Length:891 Min. : 0.00 Length:891 Length:891
## Class :character 1st Qu.: 7.91 Class :character Class :character
## Mode :character Median : 14.45 Mode :character Mode :character
## Mean : 32.20
## 3rd Qu.: 31.00
## Max. :512.33
## names(titanic_train) #nazwy zmiennych## [1] "PassengerId" "Survived" "Pclass" "Name" "Sex"
## [6] "Age" "SibSp" "Parch" "Ticket" "Fare"
## [11] "Cabin" "Embarked"dim(titanic_train) #wymiar ramki danych## [1] 891 12knitr::kable(head(titanic_train))| PassengerId | Survived | Pclass | Name | Sex | Age | SibSp | Parch | Ticket | Fare | Cabin | Embarked |
|---|---|---|---|---|---|---|---|---|---|---|---|
| 1 | 0 | 3 | Braund, Mr. Owen Harris | male | 22 | 1 | 0 | A/5 21171 | 7.2500 | S | |
| 2 | 1 | 1 | Cumings, Mrs. John Bradley (Florence Briggs Thayer) | female | 38 | 1 | 0 | PC 17599 | 71.2833 | C85 | C |
| 3 | 1 | 3 | Heikkinen, Miss. Laina | female | 26 | 0 | 0 | STON/O2. 3101282 | 7.9250 | S | |
| 4 | 1 | 1 | Futrelle, Mrs. Jacques Heath (Lily May Peel) | female | 35 | 1 | 0 | 113803 | 53.1000 | C123 | S |
| 5 | 0 | 3 | Allen, Mr. William Henry | male | 35 | 0 | 0 | 373450 | 8.0500 | S | |
| 6 | 0 | 3 | Moran, Mr. James | male | NA | 0 | 0 | 330877 | 8.4583 | Q |
Podstawowe informacje o danych w titanic_test
summary(titanic_test) #podstawowe statystyki## PassengerId Pclass Name Sex
## Min. : 892.0 Min. :1.000 Length:418 Length:418
## 1st Qu.: 996.2 1st Qu.:1.000 Class :character Class :character
## Median :1100.5 Median :3.000 Mode :character Mode :character
## Mean :1100.5 Mean :2.266
## 3rd Qu.:1204.8 3rd Qu.:3.000
## Max. :1309.0 Max. :3.000
##
## Age SibSp Parch Ticket
## Min. : 0.17 Min. :0.0000 Min. :0.0000 Length:418
## 1st Qu.:21.00 1st Qu.:0.0000 1st Qu.:0.0000 Class :character
## Median :27.00 Median :0.0000 Median :0.0000 Mode :character
## Mean :30.27 Mean :0.4474 Mean :0.3923
## 3rd Qu.:39.00 3rd Qu.:1.0000 3rd Qu.:0.0000
## Max. :76.00 Max. :8.0000 Max. :9.0000
## NA's :86
## Fare Cabin Embarked
## Min. : 0.000 Length:418 Length:418
## 1st Qu.: 7.896 Class :character Class :character
## Median : 14.454 Mode :character Mode :character
## Mean : 35.627
## 3rd Qu.: 31.500
## Max. :512.329
## NA's :1names(titanic_test) #nazwy zmiennych## [1] "PassengerId" "Pclass" "Name" "Sex" "Age"
## [6] "SibSp" "Parch" "Ticket" "Fare" "Cabin"
## [11] "Embarked"dim(titanic_test) #wymiar ramki danych## [1] 418 11knitr::kable(head(titanic_test))| PassengerId | Pclass | Name | Sex | Age | SibSp | Parch | Ticket | Fare | Cabin | Embarked |
|---|---|---|---|---|---|---|---|---|---|---|
| 892 | 3 | Kelly, Mr. James | male | 34.5 | 0 | 0 | 330911 | 7.8292 | Q | |
| 893 | 3 | Wilkes, Mrs. James (Ellen Needs) | female | 47.0 | 1 | 0 | 363272 | 7.0000 | S | |
| 894 | 2 | Myles, Mr. Thomas Francis | male | 62.0 | 0 | 0 | 240276 | 9.6875 | Q | |
| 895 | 3 | Wirz, Mr. Albert | male | 27.0 | 0 | 0 | 315154 | 8.6625 | S | |
| 896 | 3 | Hirvonen, Mrs. Alexander (Helga E Lindqvist) | female | 22.0 | 1 | 1 | 3101298 | 12.2875 | S | |
| 897 | 3 | Svensson, Mr. Johan Cervin | male | 14.0 | 0 | 0 | 7538 | 9.2250 | S |
Dane titanic_train zawieracją 891 obserwacji o pasażerach o numerach identyfikacyjnych od 1 do 891, natomiast titanic_test zawierają 418 obserwacji o pasażerach o numerach identyfikacyjnych od 892 do 1309. Ponadto dane treningowe zawierają dodatkowo zmienną Survived. W dalszej analizie połączymy dane testowe z treningowymi w jedną całość. Najpierw musimy dodać kolumnę Survived do danych testowych, natępnie (jak już obie tabele mają tą samą liczbę zmiennych) możemy połączyć dane testowe i treningowe w jedną ramkę danych titanic_calosc.
titanic_test$Survived <- NA # test$Survived dodajemy pustą informację
titanic_calosc <- rbind(titanic_train, titanic_test)Oto kilka pierwszych wierszy tabeli titanic_calosc
knitr::kable(head(titanic_calosc))| PassengerId | Survived | Pclass | Name | Sex | Age | SibSp | Parch | Ticket | Fare | Cabin | Embarked |
|---|---|---|---|---|---|---|---|---|---|---|---|
| 1 | 0 | 3 | Braund, Mr. Owen Harris | male | 22 | 1 | 0 | A/5 21171 | 7.2500 | S | |
| 2 | 1 | 1 | Cumings, Mrs. John Bradley (Florence Briggs Thayer) | female | 38 | 1 | 0 | PC 17599 | 71.2833 | C85 | C |
| 3 | 1 | 3 | Heikkinen, Miss. Laina | female | 26 | 0 | 0 | STON/O2. 3101282 | 7.9250 | S | |
| 4 | 1 | 1 | Futrelle, Mrs. Jacques Heath (Lily May Peel) | female | 35 | 1 | 0 | 113803 | 53.1000 | C123 | S |
| 5 | 0 | 3 | Allen, Mr. William Henry | male | 35 | 0 | 0 | 373450 | 8.0500 | S | |
| 6 | 0 | 3 | Moran, Mr. James | male | NA | 0 | 0 | 330877 | 8.4583 | Q |
Przy czym poszczególne zmienne mają następujące znaczenie:
| nazwa | opis |
|---|---|
| PassengerId | Numer identyfikacyjny pasażera |
| Survived | Czy dana osoba przeżyła czy nie. Oznaczenia: 0-nie przeżyła, 1-przeżyła |
| Pclass | Klasa socjalno-ekonomiczna. Oznaczenia: 1-Wyższa, 2-Średnia, 3-Niższa |
| Name | Imiona i nazwiska oddzielone przecinkami w formacie: nazwisko, tytuł imię |
| Sex | Płeć. Oznaczenia: male - mężczyzna, female -kobieta |
| Age | Wiek |
| SibSp | Liczba rodzeństwa lub małżonków na pokładzie |
| Parch | Liczba rodziców lub dzieci na pokładzie |
| Ticket | Numer biletu |
| Fare | Opłata za bilet |
| Cabin | Numer kabiny |
| Embarked | Port źródłowy. Oznaczenia: C -Cherbourk, Q - Quenstown, S - Southampton |
Kolejno wyświetlamy podstawowe informacje o danych, jak nazwa, typ i przykłady wartości:
str(titanic_calosc)## 'data.frame': 1309 obs. of 12 variables:
## $ PassengerId: int 1 2 3 4 5 6 7 8 9 10 ...
## $ Survived : int 0 1 1 1 0 0 0 0 1 1 ...
## $ Pclass : int 3 1 3 1 3 3 1 3 3 2 ...
## $ Name : chr "Braund, Mr. Owen Harris" "Cumings, Mrs. John Bradley (Florence Briggs Thayer)" "Heikkinen, Miss. Laina" "Futrelle, Mrs. Jacques Heath (Lily May Peel)" ...
## $ Sex : chr "male" "female" "female" "female" ...
## $ Age : num 22 38 26 35 35 NA 54 2 27 14 ...
## $ SibSp : int 1 1 0 1 0 0 0 3 0 1 ...
## $ Parch : int 0 0 0 0 0 0 0 1 2 0 ...
## $ Ticket : chr "A/5 21171" "PC 17599" "STON/O2. 3101282" "113803" ...
## $ Fare : num 7.25 71.28 7.92 53.1 8.05 ...
## $ Cabin : chr "" "C85" "" "C123" ...
## $ Embarked : chr "S" "C" "S" "S" ...oraz podstawowe statystyki
summary(titanic_calosc)## PassengerId Survived Pclass Name
## Min. : 1 Min. :0.0000 Min. :1.000 Length:1309
## 1st Qu.: 328 1st Qu.:0.0000 1st Qu.:2.000 Class :character
## Median : 655 Median :0.0000 Median :3.000 Mode :character
## Mean : 655 Mean :0.3838 Mean :2.295
## 3rd Qu.: 982 3rd Qu.:1.0000 3rd Qu.:3.000
## Max. :1309 Max. :1.0000 Max. :3.000
## NA's :418
## Sex Age SibSp Parch
## Length:1309 Min. : 0.17 Min. :0.0000 Min. :0.000
## Class :character 1st Qu.:21.00 1st Qu.:0.0000 1st Qu.:0.000
## Mode :character Median :28.00 Median :0.0000 Median :0.000
## Mean :29.88 Mean :0.4989 Mean :0.385
## 3rd Qu.:39.00 3rd Qu.:1.0000 3rd Qu.:0.000
## Max. :80.00 Max. :8.0000 Max. :9.000
## NA's :263
## Ticket Fare Cabin Embarked
## Length:1309 Min. : 0.000 Length:1309 Length:1309
## Class :character 1st Qu.: 7.896 Class :character Class :character
## Mode :character Median : 14.454 Mode :character Mode :character
## Mean : 33.295
## 3rd Qu.: 31.275
## Max. :512.329
## NA's :1Kategoryzacja danych
Część danych jest w postaci tekstowej i trzeba je skategoryzować. W tym celu dodajemy nowe pola w naszej tabeli: Sex2 i Embarked2:
titanic_calosc$Sex2 <- as.numeric(as.factor(titanic_calosc$Sex))
titanic_calosc$Embarked2 <- as.numeric(as.factor(titanic_calosc$Embarked))Oto kilka pierwszych wierszy nowej tabeli titanic_calosc
knitr::kable(head(titanic_calosc))| PassengerId | Survived | Pclass | Name | Sex | Age | SibSp | Parch | Ticket | Fare | Cabin | Embarked | Sex2 | Embarked2 |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 1 | 0 | 3 | Braund, Mr. Owen Harris | male | 22 | 1 | 0 | A/5 21171 | 7.2500 | S | 2 | 4 | |
| 2 | 1 | 1 | Cumings, Mrs. John Bradley (Florence Briggs Thayer) | female | 38 | 1 | 0 | PC 17599 | 71.2833 | C85 | C | 1 | 2 |
| 3 | 1 | 3 | Heikkinen, Miss. Laina | female | 26 | 0 | 0 | STON/O2. 3101282 | 7.9250 | S | 1 | 4 | |
| 4 | 1 | 1 | Futrelle, Mrs. Jacques Heath (Lily May Peel) | female | 35 | 1 | 0 | 113803 | 53.1000 | C123 | S | 1 | 4 |
| 5 | 0 | 3 | Allen, Mr. William Henry | male | 35 | 0 | 0 | 373450 | 8.0500 | S | 2 | 4 | |
| 6 | 0 | 3 | Moran, Mr. James | male | NA | 0 | 0 | 330877 | 8.4583 | Q | 2 | 3 |
Widzimy, że mamy następujące dane w nowych kolumnach
| Embarked | Embarked2 |
|---|---|
| S | 3 |
| Q | 2 |
| C | 1 |
Analiza brakujących danych
Wyświetlimy teraz informacje, które pole zawiera brakujące dane NA i ile jest tych braków:
titanic_calosc %>%
select(everything()) %>%
summarise_all(funs(sum(is.na(.))))## PassengerId Survived Pclass Name Sex Age SibSp Parch Ticket Fare Cabin
## 1 0 418 0 0 0 263 0 0 0 1 0
## Embarked Sex2 Embarked2
## 1 0 0 0Widzimy, że pole Survived zawiera 418 braków danych, Age - 263 braki danych, a Fare - 1 brak danych. Ponadto jeśli pogrupujemy naszą tabelę po zmiennej Embarked, to zauważymy, że występują tu też dwa braki danych:
titanic_calosc %>%
group_by(Embarked)%>%
summarise(cnt = n()) %>%
arrange(desc(cnt))## # A tibble: 4 x 2
## Embarked cnt
## <chr> <int>
## 1 "S" 914
## 2 "C" 270
## 3 "Q" 123
## 4 "" 2titanic_calosc %>%
filter( is.na(Embarked) )## [1] PassengerId Survived Pclass Name Sex Age
## [7] SibSp Parch Ticket Fare Cabin Embarked
## [13] Sex2 Embarked2
## <0 wierszy> (lub 'row.names' o zerowej długości)titanic_calosc %>%
filter( Embarked=="" )## PassengerId Survived Pclass Name Sex
## 1 62 1 1 Icard, Miss. Amelie female
## 2 830 1 1 Stone, Mrs. George Nelson (Martha Evelyn) female
## Age SibSp Parch Ticket Fare Cabin Embarked Sex2 Embarked2
## 1 38 0 0 113572 80 B28 1 1
## 2 62 0 0 113572 80 B28 1 1Zastępujemy najpierw “” w polu Embarked przez NA
titanic_calosc <- titanic_calosc %>% mutate(Embarked = ifelse( Embarked=="",NA, Embarked) )
#inny sposób mutate_all(na_if,"")
titanic_calosc %>%
filter( is.na(Embarked) )## PassengerId Survived Pclass Name Sex
## 1 62 1 1 Icard, Miss. Amelie female
## 2 830 1 1 Stone, Mrs. George Nelson (Martha Evelyn) female
## Age SibSp Parch Ticket Fare Cabin Embarked Sex2 Embarked2
## 1 38 0 0 113572 80 B28 <NA> 1 1
## 2 62 0 0 113572 80 B28 <NA> 1 1Wówczas nasze zestawienie brakujących wartości wygląda następujaco
titanic_calosc %>%
select(everything()) %>%
summarise_all(funs(sum(is.na(.))))## PassengerId Survived Pclass Name Sex Age SibSp Parch Ticket Fare Cabin
## 1 0 418 0 0 0 263 0 0 0 1 0
## Embarked Sex2 Embarked2
## 1 2 0 0W kwestii Cabin
titanic_calosc %>%
filter( Cabin=="" )%>%
summarise(cnt = n())## cnt
## 1 1014mamy aż 1014 braków danych na 1309 obserwacji. W związku z tym postanowiłyśmy pominąć pole Cabin w naszych analizach.
titanic_calosc = titanic_calosc %>% select(-Cabin)W związku z tym w dalszej części zajmiemy się usuwaniem braków danych dla zmiennych Age, Fare i Embarked.
Wypełnianie braków danych w Embarked
Pole Embarked ma tylko dwa braki danych. Wynika z tego, że można Embarked wypełnić wartościami z wierwszy o zbliżonych wartościach. Najpierw sprawdzimy od czego ona najbardziej zależy Embarked.
cols <- c('Age','Sex2', 'Embarked2','Fare', 'Parch' , 'Pclass', 'SibSp')
abs(cor(titanic_calosc[,cols],use="complete.obs")[,"Embarked2"]) %>% .[order(., decreasing = TRUE)]## Embarked2 Fare Pclass Sex2 Age SibSp Parch
## 1.00000000 0.30310839 0.28198941 0.11599775 0.09064651 0.04836727 0.01411680Badając korelację zmiennej Embarked z pozostałymi zmiennymi, widzimy, że zależy ona najbardziej o zmiennych: Fare, Pclass i Sex2. A zatem potrzebujemy dla cClass, Sex2 obliczyć Fare i zobaczyć który Embarked jest najbliżej. Najpierw wyświetlmy dane tych pasazerów, u których są braki danych w Embarked:
knitr::kable(titanic_calosc %>%
filter( is.na(Embarked) ))| PassengerId | Survived | Pclass | Name | Sex | Age | SibSp | Parch | Ticket | Fare | Embarked | Sex2 | Embarked2 |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 62 | 1 | 1 | Icard, Miss. Amelie | female | 38 | 0 | 0 | 113572 | 80 | NA | 1 | 1 |
| 830 | 1 | 1 | Stone, Mrs. George Nelson (Martha Evelyn) | female | 62 | 0 | 0 | 113572 | 80 | NA | 1 | 1 |
Widzimy, że są to kobiety podróżujace pierwszą klasą, a ich opłata wynosi 80. Wówczas wybieramy dane, które właśnie spełniają te warunki.
titanic_calosc %>%
filter(Pclass == 1 & Sex2 == 1 ) %>%
group_by(Embarked) %>%
summarise( sum = sum(Fare), count = n(), mean = mean(Fare), median = median(Fare))## # A tibble: 4 x 5
## Embarked sum count mean median
## <chr> <dbl> <int> <dbl> <dbl>
## 1 C 8442. 71 119. 83.2
## 2 Q 180 2 90 90
## 3 S 6974. 69 101. 78.8
## 4 <NA> 160 2 80 80Najbliżej 80 jest mediana z portu źródłowego Southampton. Możemy to jeszcze ilustrować na wykresie, gdzie czerwoną linią jest zaznaczony poziom Fare=80.
ggplot(data=titanic_calosc %>%filter(Pclass == 1 & Sex2 == 1 & Embarked %in% c('C','S', 'Q') ), aes(Embarked, Fare, group = Embarked)) +
geom_boxplot() + geom_hline(yintercept=80,color='red') 
Wynika stąd, że brakujące wrtości w polu Embarked można zastąpić wartością S.
titanic_calosc[62,'Embarked'] = 'S'
titanic_calosc[830,'Embarked'] = 'S'
titanic_calosc$Embarked2 <- as.numeric(as.factor(titanic_calosc$Embarked))
str(titanic_calosc)## 'data.frame': 1309 obs. of 13 variables:
## $ PassengerId: int 1 2 3 4 5 6 7 8 9 10 ...
## $ Survived : int 0 1 1 1 0 0 0 0 1 1 ...
## $ Pclass : int 3 1 3 1 3 3 1 3 3 2 ...
## $ Name : chr "Braund, Mr. Owen Harris" "Cumings, Mrs. John Bradley (Florence Briggs Thayer)" "Heikkinen, Miss. Laina" "Futrelle, Mrs. Jacques Heath (Lily May Peel)" ...
## $ Sex : chr "male" "female" "female" "female" ...
## $ Age : num 22 38 26 35 35 NA 54 2 27 14 ...
## $ SibSp : int 1 1 0 1 0 0 0 3 0 1 ...
## $ Parch : int 0 0 0 0 0 0 0 1 2 0 ...
## $ Ticket : chr "A/5 21171" "PC 17599" "STON/O2. 3101282" "113803" ...
## $ Fare : num 7.25 71.28 7.92 53.1 8.05 ...
## $ Embarked : chr "S" "C" "S" "S" ...
## $ Sex2 : num 2 1 1 1 2 2 2 2 1 1 ...
## $ Embarked2 : num 3 1 3 3 3 2 3 3 3 1 ...Wypełnianie braków danych w Age
W przypadku zmiennej Age uzupełniamy braki danych wartością średnią zmiennej Age:
titanic_calosc$Age[is.na(titanic_calosc$Age)] <- mean(titanic_calosc$Age,na.rm=T)Wypełnianie braków danych w Fare
Zaczynamy od wyświetlenia tej obserwacji, gdzie Fare jest NA i od sprawdzenia z czym zmienna Fare jest nabardziej skorelowana:
knitr::kable(titanic_calosc %>%
filter( is.na(Fare) ))| PassengerId | Survived | Pclass | Name | Sex | Age | SibSp | Parch | Ticket | Fare | Embarked | Sex2 | Embarked2 |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 1044 | NA | 3 | Storey, Mr. Thomas | male | 60.5 | 0 | 0 | 3701 | NA | S | 2 | 3 |
cols <- c('Age','Sex2', 'Embarked2','Fare', 'Parch' , 'Pclass', 'SibSp')
abs(cor(titanic_calosc[,cols],use="complete.obs")[,"Fare"]) %>% .[order(., decreasing = TRUE)]## Fare Pclass Embarked2 Parch Sex2 Age SibSp
## 1.0000000 0.5586287 0.2380054 0.2215387 0.1855230 0.1718929 0.1602383Widzimy, że zmienna Fare jest skorelowana z Pclass, Embarked2, Parch Sex2 i Age. A zatem biorąc pod uwagę, że nasz pasażer, dla którego mamy brak opłaty, podróżuje klasą 3, wyruszył z portu w Southampton, jest mężczyzną i ma 60,5 roku. A zatem szukamy pasujących danych:
titanic_calosc %>%
filter(Pclass == 3 & Embarked2 == 3 & Parch == 0 & Sex2 ==2 & Age > 50) %>%
group_by(Age) %>%
summarise( sum = sum(Fare), count = n(), mean = mean(Fare), median = median(Fare))## # A tibble: 6 x 5
## Age sum count mean median
## <dbl> <dbl> <int> <dbl> <dbl>
## 1 51 22.9 3 7.62 7.75
## 2 55.5 8.05 1 8.05 8.05
## 3 59 7.25 1 7.25 7.25
## 4 60.5 NA 1 NA NA
## 5 61 6.24 1 6.24 6.24
## 6 74 7.78 1 7.78 7.78Można przypuszczać że osoby w tym wieku średnio płaciły między 6.24 a 7.25 funtów. Możemy w takim razie przyjąć średnią z tych dwóch wartości. Różnica między 6.24 a 7.25 jest zbyt mała, aby mieć istotny wpływ w porównaniu do całego obszaru cen (od 0 do 512, gdzie średnia to 33 a mediana to 14).
titanic_calosc[1044,'Fare'] = (7.25 + 6.24)/2Ostatecznies nasze zestawienie brakujących wartości wygląda następujaco
titanic_calosc %>%
select(everything()) %>%
summarise_all(funs(sum(is.na(.))))## PassengerId Survived Pclass Name Sex Age SibSp Parch Ticket Fare Embarked
## 1 0 418 0 0 0 0 0 0 0 0 0
## Sex2 Embarked2
## 1 0 0W kwestii Survived braki danych pozostają, posłużą nam one w przyszłości do podziału danych na dane testowe i treningowe.
Podstawowe wykresy
Ile osób przeżyło (1), a ile nie przeżyło (0):
table(titanic_calosc$Survived)##
## 0 1
## 549 342titanic_calosc %>%
ggplot(aes(x = factor(!is.na(Survived))))+
geom_bar(width = 0.4) +
scale_x_discrete(labels=c("przeżyli", "zginęli"))+
theme_classic() +
theme(
plot.title = element_text(family = "Times New Roman", hjust = 0.5),
axis.text = element_text(family = "Times New Roman",face = "bold"),
axis.title = element_text(family = "Times New Roman", face = "bold")
) +
labs(title = "Ogólne wskaźniki przeżycia", x = NULL, y = "Liczba pasazerów")
Na podstawie wykresu widać, że szanse na przeżycie były małe.
Ile jest kobiet, a ile mężczyzn:
table(titanic_calosc$Sex)##
## female male
## 466 843titanic_calosc %>%
ggplot(aes(x = Sex)) +
geom_bar(width = 0.4) +
theme_classic() +
theme(
plot.title = element_text(family = "Times New Roman", hjust = 0.5),
axis.text = element_text(family = "Times New Roman",face = "bold"),
axis.title = element_text(family = "Times New Roman", face = "bold")
) +
labs(title = "Podział ze względu na płeć", x = NULL, y = "Liczba pasażerów")
### Ile osób wsiadło w każdym porcie
table(titanic_calosc$Embarked)##
## C Q S
## 270 123 916titanic_calosc %>%
ggplot(aes(x = Embarked)) +
geom_bar(width = 0.4) +
theme_classic() +
theme(
plot.title = element_text(family = "Times New Roman", hjust = 0.5),
axis.text = element_text(family = "Times New Roman",face = "bold"),
axis.title = element_text(family = "Times New Roman", face = "bold")
) +
labs(title = "Podział ze względu na port źródłowy", x = NULL, y = "Liczba pasażerów")
### Ile osób podróżowało samych, a ile z rodziną:
table(titanic_calosc$SibSp)##
## 0 1 2 3 4 5 8
## 891 319 42 20 22 6 9titanic_calosc %>%
ggplot(aes(x = SibSp)) +
geom_bar(width = 0.4) +
theme_classic() +
theme(
plot.title = element_text(family = "Times New Roman", hjust = 0.5),
axis.text = element_text(family = "Times New Roman",face = "bold"),
axis.title = element_text(family = "Times New Roman", face = "bold")
) +
labs(title = "Podział ze względu na posiadanie rodzeńswta/współmałżonka", x = NULL, y = "Liczba pasazerów")
table(titanic_calosc$Parch)##
## 0 1 2 3 4 5 6 9
## 1002 170 113 8 6 6 2 2titanic_calosc %>%
ggplot(aes(x = Parch)) +
geom_bar(width = 0.4) +
theme_classic() +
theme(
plot.title = element_text(family = "Times New Roman", hjust = 0.5),
axis.text = element_text(family = "Times New Roman",face = "bold"),
axis.title = element_text(family = "Times New Roman", face = "bold")
) +
labs(title = "Podział ze względu na posiadanie dzieci/rodziców", x = NULL, y = "Liczba pasazerów")
Ile osób było w każdej klasie
table(titanic_calosc$Pclass)##
## 1 2 3
## 323 277 709titanic_calosc %>%
ggplot(aes(x = Pclass)) +
geom_bar(width = 0.4) +
theme_classic() +
theme(
plot.title = element_text(family = "Times New Roman", hjust = 0.5),
axis.text = element_text(family = "Times New Roman",face = "bold"),
axis.title = element_text(family = "Times New Roman", face = "bold")
) +
labs(title = "Podział ze względu na klasę podróży", x = NULL, y = "Liczba pasazerów")
Najwięcej osób podróżowało w 3 klasie.
ggplot(data = titanic_calosc, aes(Pclass, Age, group = Pclass)) + geom_boxplot()+
labs(title = "Podział ze względu na klasę podróży", x = "Klasy", y = "Wiek pasażerów")
Osoby z 3 klasy są najmłodsze i rozrzut jest najmniejszy ze wszystkich. 50% osób w pierwszej klasie znajduje się między 30 a 50 rokiem życia
Histogram zmiennej Age
ggplot(data=titanic_calosc, aes(titanic_calosc$Age)) + geom_histogram()## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
ggplot(data=titanic_calosc, aes(x=Age)) +
geom_histogram(binwidth = 2.5, alpha = 0.2) +
geom_histogram(data = subset(titanic_calosc,Survived == 1), fill = "blue", alpha = 0.2) +
geom_density(aes(y=2.5 * ..count..),color="red",na.rm = T) +
geom_density(data = subset(titanic_calosc,Survived == 1), aes(y=2.5 * ..count..),color="blue",na.rm = T)+
labs(title = "Histogram zmiennej Age", x = "Wiek", y = "Ilość osób")## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
Analiza przeżycia - związek zmiennej Survived z pozostałymi
Zwizualizujmy, jak wskaźniki przeżycia różniły się w zależności od płci.
Czy przeżyło więcej mężczyzn czy kobiet?
table(titanic_calosc$Sex)##
## female male
## 466 843titanic_calosc %>%
ggplot(aes(x = Sex, fill = factor(!is.na(Survived)))) +
geom_bar(width = 0.4) +
scale_x_discrete(labels=c("Kobiety", "Mężczyźni"))+
scale_fill_discrete(labels=c("zginęli","przeżyli"))+
theme_classic() +
theme(
plot.title = element_text(family = "Times New Roman", hjust = 0.5),
axis.text = element_text(family = "Times New Roman",face = "bold"),
axis.title = element_text(family = "Times New Roman", face = "bold"),
legend.title = element_blank(),
legend.text = element_text(family = "Times New Roman")
) +
labs(title = "Współczynnik przeżycia wg płci", x = NULL, y = "Liczba pasażerów")
W oparciu o powyższy wykres, kobiety miały większe szanse na przeżycie.
Sprawdźmy zależność przeżycia w odniesieniu do wieku
titanic_calosc %>%
ggplot(aes(x = Age, fill = factor(!is.na(Survived)))) +
geom_histogram() +
scale_fill_discrete(labels=c("zginęli","przeżyli"))+
theme_classic() +
theme(
plot.title = element_text(family = "Times New Roman", hjust = 0.5),
axis.text = element_text(family = "Times New Roman",face = "bold"),
axis.title = element_text(family = "Times New Roman", face = "bold"),
legend.title = element_blank(),
legend.text = element_text(family = "Times New Roman")
) +
labs(title = "Zależność pomiędzy wiekiem a przeżywalnością ", x="Wiek", y= "Ilość osób")## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
titanic_calosc %>%
ggplot(aes(x = Survived, y = Age)) +
geom_boxplot() +
theme_classic() +
theme(
plot.title = element_text(family = "Times New Roman", hjust = 0.5),
axis.text = element_text(family = "Times New Roman", face = "bold"),
axis.title = element_text(family = "Times New Roman", face = "bold"),
legend.title = element_blank(),
legend.text = element_text(family = "Times New Roman")
) +
labs(title = "Wskaźniki przeżywalności według wieku", x = NULL)
Dzieci poniżej 5 lat miały większe szanse na przeżycie. Pasażerowie w wieku 20-40 lat byli bardziej narażeni na śmierć. Pasażerowie w wieku około 65 - 75 lat mieli prawie zerowe szanse na przeżycie. Przeżył jeden pasażer w wieku 80 lat. Pasażerowie, którzy przeżyli wydają się mieć niższą medianę wieku.
###Sprawdźmy współczynnik przeżycia według klasy pasażerskiej.
titanic_calosc %>%
ggplot(aes(x = Pclass, fill = factor(!is.na(Survived)))) +
geom_bar(width = 0.4) +
scale_fill_discrete(labels=c("zginęli","przeżyli"))+
theme_classic() +
theme(
plot.title = element_text(family = "Times New Roman", hjust = 0.5),
axis.text = element_text(family = "Times New Roman",face = "bold"),
axis.title = element_text(family = "Times New Roman", face = "bold"),
legend.title = element_blank(),
legend.text = element_text(family = "Times New Roman")
) +
labs(title = "Współczynnik przeżycia według klasy pasażerskiej [1-Wyższa, 2-Średnia, 3-Niższa]", x = NULL, y = "Liczba pasażerów")
Przeżyło najwiecej osób, którzy kupili bilet w klasie pierwszej.
Zbadamy, jak różne zmienne oddziaływały na siebie i na wskaźnik przeżycia.
titanic_calosc %>%
ggplot(aes(x = Sex, fill = factor(!is.na(Survived)))) +
geom_bar(width = 0.4) +
scale_fill_discrete(labels=c("zginęli","przeżyli"))+
facet_wrap(~ Pclass) +
theme_test() +
theme(
plot.title = element_text(family = "Times New Roman", hjust = 0.5),
axis.text = element_text(family = "Times New Roman", face = "bold"),
axis.title = element_text(family = "Times New Roman", face = "bold"),
legend.title = element_blank(),
legend.text = element_text(family = "Times New Roman")
) +
labs(title = "Wskaźniki przeżywalności wg płci i klasy pasażerskiej", x = NULL, y = "Liczba pasażerów")
Kobiety w 1, 2 i 3 klasie miały odpowiednio 90%, 90% i 50% szans na przeżycie w porównaniu do mężczyzn.
titanic_calosc %>%
ggplot(aes(x = Age, fill = factor(!is.na(Survived)))) +
geom_histogram() +
scale_fill_discrete(labels=c("zginęli","przeżyli"))+
facet_wrap(~Sex + Pclass) +
theme_test() +
theme(
plot.title = element_text(family = "Times New Roman", hjust = 0.5),
axis.text = element_text(family = "Times New Roman", face = "bold"),
axis.title = element_text(family = "Times New Roman", face = "bold"),
legend.title = element_blank(),
legend.text = element_text(family = "Times New Roman")
) +
labs(title = "Wskaźniki przeżywalności wg wieku, płci i klasy pasażerskiej", x = NULL, y = "Liczba pasażerów")## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
W danych dotyczących Titanica, wiek, płeć i klasa pasażerów były ważnymi czynnikami predykcyjnymi przeżycia. Najwięcej umarło mężczyzn w 3 klasie w wieku między 18 a 50 rokiem życia.
Spojrzymy jeszcze na korelacje między zmiennymi
cols <- c('Age','Sex2','Embarked2','Fare','Parch','Pclass','SibSp','Survived')
corr <- cor( titanic_calosc[,cols], use="complete.obs")
heatmap(corr,
na.rm = T, # same data set for cell labels
)
###Bardziej zaawansowany heatmap oferuje ggplot, trzeba tylko wynik korelacji (który jest typu matrix) zamienić na data.frame. Można to zrobić przez funkcje melt
corr_df <- melt(corr, na.rm = TRUE)
ggplot(corr_df, aes(x=Var1,y=Var2, fill=value)) +
geom_tile() +
geom_text(aes(Var2, Var1, label = round(value,2)), color = "white", size = 4) 
###Sprawdzimy od czego Survived najbardziej zależy.
cols <- c('Age','Sex2', 'Embarked2','Fare', 'Parch' , 'Pclass', 'SibSp', 'Survived')
knitr::kable(abs(cor(titanic_calosc[,cols],use="complete.obs")[,"Survived"]) %>% .[order(., decreasing = TRUE)])| x | |
|---|---|
| Survived | 1.0000000 |
| Sex2 | 0.5433514 |
| Pclass | 0.3384810 |
| Fare | 0.2573065 |
| Embarked2 | 0.1676753 |
| Parch | 0.0816294 |
| Age | 0.0703227 |
| SibSp | 0.0353225 |
Tak jak w analizie powyżej szansa przeżycia zależała przede wszytskim od płci, klasy i ceny biletu.
Ciekawym wykresem jest Performance Analytics. Pozwala na jedynm wykresie pokazać histogram, zależności między zmiennymi i jak zmieniają się dane w zależności od zmiennych.
cols <- c('Age','Sex2', 'Embarked2','Fare', 'Parch' , 'Pclass', 'SibSp', 'Survived')
library("PerformanceAnalytics")
chart.Correlation(titanic_calosc[,cols], histogram=TRUE, pch=19, font.size = 15)
Po przekątnej mamy histogram, po lewej na dole wykresy punktowe i szacowany wykres zależności między punktami. Np: wiersz Survived z kolumną Age widzimy, że wraz ze wzrostem wieku przeżywalność spada, odwrotnie jak w przypadku opłaty za bilet Fare, wraz ze wzrostem przeżywalność rośnie.