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!)
<- left_join(flights,planes,by="tailnum")
data1
%>% filter(air_time==max(air_time,na.rm = T)) %>%
data1 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.
<- left_join(weather,flights,by=c("origin","year","month","day","hour"))
data2%>% select(air_time,temp,wind_speed,humid) %>%
data2 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.
<- 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)) data3
## # 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.)
%>% filter(dep_delay>0) %>% summarise(mean=mean(dep_delay)) flights
## # 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.)
<-table(AwardsPlayers$playerID) %>% as.data.frame()
tnames(t)<-c("playerID","num.of.aw")
<-People %>% left_join(t,by="playerID") # hepsine na.omit() uygulamak?
data1%>% filter(num.of.aw==max(num.of.aw,na.rm=T)) %>%
data1 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?
%>% mutate(BMI=weight/(height^2)*703) %>% filter(BMI>=25 & BMI<29.9) %>% nrow() People
## [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)
<-Salaries %>% left_join(t,by="playerID")
data2which.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?
%>% mutate(t=x^2-sqrt(y)+(1/z)) %>% filter(t==min(t)) %>% select(depth) diamonds
## # 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?
%>% mutate(discount = case_when(
diamonds =="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,
cutnew.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,
%>% mutate(discount= case_when(
diamonds =="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,
cutnew.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?)
<-diamonds$clarity %>% as.factor()
cl%>% levels() cl
## [1] "I1" "SI2" "SI1" "VS2" "VS1" "VVS2" "VVS1" "IF"
%>% nlevels() cl
## [1] 8
Soru4. Mağazanın ‘Ideal’ cut tipine sahip ürünlerden elde ettiği ortalama kazanç nedir?
%>% group_by(cut) %>% summarise(mean.pr=mean(price)) diamonds
## # 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,
%>% filter(cut=="Ideal") %>% summarise(mean(price)) diamonds
## # 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?