Bölüm12 Uygulamalar

12.1 CS_1 (NYC Flights)

library(corrr)
library(tidyverse)
library(nycflights13)

2013 yılında NYC’den kalkan uçuşlar ile ilgili veri setlerini içeren nycflights13 paketi ile çalışacağız. Veri seti airlines, airports, flights, planes ve weather verilerini içermektedir. (Veri setlerinin detayı için nycflights13 paketini inceleyiniz.)

Bu çalışmada, farklı veri setlerindeki bilgileri birlikte kullanabilmeniz, dönüştürmeniz, görselleştirmeniz ve çıkarımda bulunmanız hedeflenmektedir.

Her bir veri setini View() komutu ile ayrı bir tablo olarak açıp detaylı inceleyiniz, süreci kavrayabilmeniz için veri setine hakim olmanız gerekmektedir.

View(planes)  #ornegin

Veri setlerini dikkatle incelediğinizde farklı veri setlerinin ortak değişkenler içerdiğini göreceksiniz, bu sizin veri setlerini birbirine bağlayarak daha fazla veri üzerinden çalışmanızı sağlayacaktır.

Ortak değişkenler ve veri setleri için örnek olarak;

planes ve flights veri setlerinde tailnum değişkeni

flights ve weather veri setlerinde origin, year, month, day, hour değişkenleri

flights ve airlines veri setlerinde carrier değişkeni

Soru1. Havada kalış süresi (air_time) en fazla olan uçak için üretim yılı (year), üretici (manufacturer) ve model (model) bilgisi nedir? (Kodunuzda hata alıyorsanız year değişkenini verinizde kontrol ediniz!)

data1<- left_join(flights,planes,by="tailnum") 

data1 %>% filter(air_time==max(air_time,na.rm = T)) %>%
  select(year.y, manufacturer,model)
## # A tibble: 1 x 3
##   year.y manufacturer model    
##    <int> <chr>        <chr>    
## 1   2002 BOEING       767-424ER

Soru2. Havada kalış süresi (air_time), sıcaklık (temp), rüzgar hızı (wind_speed) ve nem (humid) arasında ne tür bir ilişki vardır? İnceleyip yorumlayınız.

data2<- left_join(weather,flights,by=c("origin","year","month","day","hour"))
data2 %>% select(air_time,temp,wind_speed,humid) %>% 
correlate() 
## # A tibble: 4 x 5
##   term       air_time    temp wind_speed   humid
##   <chr>         <dbl>   <dbl>      <dbl>   <dbl>
## 1 air_time    NA      -0.0367     0.0263  0.0405
## 2 temp        -0.0367 NA         -0.140   0.0374
## 3 wind_speed   0.0263 -0.140     NA      -0.187 
## 4 humid        0.0405  0.0374    -0.187  NA

Soru3. Her bir hava yolu şirketi (name) için ortalama ve ortanca gecikme süresilerini (dep_delay) inceleyip yorumlayınız.

data3<- right_join(airlines,flights,by="carrier")
data3 %>% filter(dep_delay>0) %>% na.omit() %>% group_by(name) %>% summarise(mean=mean(dep_delay),median=median(dep_delay))
## # A tibble: 16 x 3
##    name                         mean median
##  * <chr>                       <dbl>  <dbl>
##  1 AirTran Airways Corporation  40.6   16  
##  2 Alaska Airlines Inc.         31.5   12  
##  3 American Airlines Inc.       37.2   16  
##  4 Delta Air Lines Inc.         37.3   16  
##  5 Endeavor Air Inc.            48.5   26  
##  6 Envoy Air                    44.7   27  
##  7 ExpressJet Airlines Inc.     50.2   31  
##  8 Frontier Airlines Inc.       45.2   18  
##  9 Hawaiian Airlines Inc.       44.8    5  
## 10 JetBlue Airways              39.7   20  
## 11 Mesa Airlines Inc.           52.9   29.5
## 12 SkyWest Airlines Inc.        58     40  
## 13 Southwest Airlines Co.       34.8   15  
## 14 United Air Lines Inc.        29.8   12  
## 15 US Airways Inc.              32.9   16  
## 16 Virgin America               34.2   10

Soru4. flights veri setinde yer alan gecikme süresi (dep_delay) değişkeni için 2013 yılı ortalama gecikme süresi kaçtır? (erken varışları dikkate almayınız.)

flights %>% filter(dep_delay>0) %>% summarise(mean=mean(dep_delay))
## # A tibble: 1 x 1
##    mean
##   <dbl>
## 1  39.4

12.2 CS_2 (Sean ‘Lahman’ Baseball Database)

library(Lahman)
library(tidyverse)

Case Study_2 için Lahman paketi içerisinde yer alan People, AwardsPlayers ve Salaries veri setleri üzerinde çalışacaksınız. Veri setlerini inceleyiniz ve aşağıda yer alan sorular paralelinde hazırlanmış olan test sorularını yanıtlayınız.

View(People)

Bu çalışmada ortak değişkenleri sizin tespit etmeniz gerekmektedir.

Soru1. AwardsPlayers veri setini incelediğinizde en çok ödül alan oyuncu kimdir? (People veri seti nameFirst ve nameLast değişkenleri ile yanıtlayınız.)

t<-table(AwardsPlayers$playerID) %>% as.data.frame()
names(t)<-c("playerID","num.of.aw")
data1<-People %>% left_join(t,by="playerID")    # hepsine na.omit() uygulamak?
data1 %>% filter(num.of.aw==max(num.of.aw,na.rm=T)) %>%   
  select(nameFirst,nameLast)
##   nameFirst nameLast
## 1     Barry    Bonds

Soru2. People veri setinde yer alan weight ve height değişkenlerini kullanarak body mass index (BMI) hesaplayınız. BMI formülü ve değerlendirme tablosu aşağıda yer almaktadır.

\(BMI=\frac{weight}{height^{2}}*703\)


BMI Classification
<18.5 Under weight
18.5-24.9 Normal weight
25-29.9 Over weight
30-34.9 Obesity class 1
35-39.9 Obesity class 2
40 or above Obesity class 3


Oyunculardan kaç tanesi normal weight kategorisine girmektedir?

People %>% mutate(BMI=weight/(height^2)*703) %>% filter(BMI>=25 & BMI<29.9) %>% nrow()
## [1] 9119

Soru3. Salaries ve AwardsPlayers veri setlerini inceleyiniz, en fazla ödül alan oyuncunun en yüksek maaşa sahip olduğu söylenebilir mi?

#soru 1 de odul sayilari hesaplandi (t)

data2<-Salaries %>% left_join(t,by="playerID") 
which.max(data2$salary)==which.max(data2$num.of.aw)
## [1] FALSE
slice(data2,which.max(data2$salary))     #max salary
##   yearID teamID lgID  playerID   salary num.of.aw
## 1   2009    NYA   AL rodrial01 33000000        31
slice(data2,which.max(data2$num.of.aw))  #max num of awards
##   yearID teamID lgID  playerID salary num.of.aw
## 1   1986    PIT   NL bondsba01  60000        47

Soru4. En çok alınan ödül hangisidir?

table(AwardsPlayers$awardID) %>% as.data.frame() %>% arrange(desc(Freq))
##                                   Var1 Freq
## 1           Baseball Magazine All-Star 1520
## 2                         TSN All-Star 1391
## 3                           Gold Glove 1091
## 4                       Silver Slugger  685
## 5                 Most Valuable Player  196
## 6                   Rookie of the Year  142
## 7              TSN Pitcher of the Year  137
## 8                       Cy Young Award  114
## 9               TSN Player of the Year   92
## 10             TSN Fireman of the Year   88
## 11 TSN Major League Player of the Year   82
## 12            Rolaids Relief Man Award   74
## 13                    World Series MVP   65
## 14                     Babe Ruth Award   64
## 15           Lou Gehrig Memorial Award   57
## 16                   All-Star Game MVP   55
## 17                         Hutch Award   48
## 18              Roberto Clemente Award   48
## 19                            NLCS MVP   43
## 20                    Hank Aaron Award   38
## 21               Pitching Triple Crown   38
## 22                            ALCS MVP   37
## 23                       TSN Guide MVP   33
## 24         Comeback Player of the Year   26
## 25                 Branch Rickey Award   23
## 26            TSN Reliever of the Year   22
## 27                        Triple Crown   17
## 28          Reliever of the Year Award    8
## 29                Outstanding DH Award    2

12.3 CS_3 (Diamonds)

library(ggplot2)
library(tidyverse)

Soru1. diamonds veri setinde yer alan x, y ve z değişkenleri kullanılarak yeni bir t değişkeni oluşturuluyor. t değişkeni \(t=x^{2}-\sqrt{y}+z^{-2}\) şeklinde tanımlanacak olursa, en düşük t değerine karşılık gelen depth değeri nedir?

diamonds %>% mutate(t=x^2-sqrt(y)+(1/z)) %>% filter(t==min(t)) %>% select(depth)
## # A tibble: 1 x 1
##   depth
##   <dbl>
## 1  62.6

Soru2. Pandemi nedeniyle azalan satışlarını hareketlendirmek isteyen bir mağaza sahibi ürünlerine cut değişkenine bağlı olarak indirim uyguluyor. İndirim oranları aşağıdaki gibidir.

Cut Discount
Fair price*0.01
Good price*0.02
Very Good price*0.025
Premium price*0.03
Ideal price*0.03

İndirimli fiyatlar üzerinden alışveriş yapan bir müşteri ‘E color’ ve ‘SI1 clarity’ ürün için en az kaç $ ödeyecektir?

diamonds %>% mutate(discount = case_when(
  cut=="Fair" ~ price*0.01,
  cut=="Good" ~ price*0.02,
  cut=="Very Good" ~ price*0.025,
  cut=="Premium" ~ price*0.03,
  cut=="Ideal" ~ price*0.03,
),new.price=price-discount) %>% filter(color=="E" & clarity=="SI2" & new.price==min(new.price)) 
## # A tibble: 1 x 12
##   carat cut   color clarity depth table price     x     y     z discount
##   <dbl> <ord> <ord> <ord>   <dbl> <dbl> <int> <dbl> <dbl> <dbl>    <dbl>
## 1  0.23 Ideal E     SI2      61.5    55   326  3.95  3.98  2.43     9.78
## # … with 1 more variable: new.price <dbl>

Alternatif,

diamonds %>% mutate(discount= case_when(
  cut=="Fair" ~ price*0.1,
  cut=="Good" ~ price*0.12,
  cut=="Very Good" ~ price*0.15,
  cut=="Premium" ~ price*0.18,
  cut=="Ideal" ~ price*0.18,
),new.price=price-discount) %>% filter(color=="E"& clarity=="SI1") %>% arrange(new.price)
## # A tibble: 2,426 x 12
##    carat cut   color clarity depth table price     x     y     z discount
##    <dbl> <ord> <ord> <ord>   <dbl> <dbl> <int> <dbl> <dbl> <dbl>    <dbl>
##  1  0.21 Prem… E     SI1      59.8    61   326  3.89  3.84  2.31     58.7
##  2  0.26 Very… E     SI1      62      54   384  4.08  4.11  2.54     57.6
##  3  0.28 Good  E     SI1      62.6    60   373  4.12  4.15  2.59     44.8
##  4  0.27 Very… E     SI1      61.2    57   407  4.2   4.23  2.58     61.0
##  5  0.31 Prem… E     SI1      62.7    58   471  4.32  4.35  2.72     84.8
##  6  0.24 Ideal E     SI1      62.5    56   486  4.01  3.99  2.5      87.5
##  7  0.3  Ideal E     SI1      62.1    58   499  4.27  4.29  2.66     89.8
##  8  0.3  Ideal E     SI1      61.1    57   499  4.3   4.34  2.64     89.8
##  9  0.3  Ideal E     SI1      62.4    57   499  4.27  4.29  2.67     89.8
## 10  0.3  Ideal E     SI1      61.6    54   499  4.32  4.35  2.67     89.8
## # … with 2,416 more rows, and 1 more variable: new.price <dbl>

Soru3. diamonds verisi clarity değişkeni kaç farklı level içermektedir? (Kaç farklı clarity tipi vardır?)

cl<-diamonds$clarity %>% as.factor() 
cl %>% levels()
## [1] "I1"   "SI2"  "SI1"  "VS2"  "VS1"  "VVS2" "VVS1" "IF"
cl %>% nlevels()
## [1] 8

Soru4. Mağazanın ‘Ideal’ cut tipine sahip ürünlerden elde ettiği ortalama kazanç nedir?

diamonds %>% group_by(cut) %>% summarise(mean.pr=mean(price))
## # A tibble: 5 x 2
##   cut       mean.pr
## * <ord>       <dbl>
## 1 Fair        4359.
## 2 Good        3929.
## 3 Very Good   3982.
## 4 Premium     4584.
## 5 Ideal       3458.

Alternatif,

diamonds %>% filter(cut=="Ideal") %>% summarise(mean(price))
## # A tibble: 1 x 1
##   `mean(price)`
##           <dbl>
## 1         3458.

Soru5. Mağazanın cut tipine göre elde ettiği price ortalamaları incelendiğinde en az kazanç sağlayan cut tipi hangisidir?