GİRİŞ

Kaggle’da Titanic Spaceship adında bir Makine Öğrenmesi yarışması bulunmaktadır. Bu yarışmada bir uzay gemisindeki yolcuların başka bir zamana boyutuna taşınıp taşınılmadığının tahmininin yapılması beklenmektedir. Ödev kapsamında bu yarışmaya katılım sağlanacaktır. Tahminler oluşturulurken R programlama dili kullanılarak 3 adet Makine Öğrenmesi modeli test edilerek en yüksek doğruluk oranı veren model test verisi ile test edilecektir. Daha sonra oluşturulan tahminler submission.csv dosyasına yazılarak yarışmaya gönderilecektir. Yarışmaya katılım sağlandıktan sonra ekran görüntüsü de bu dosyanın sonuna eklenerek RPubsta paylaşım yapılacaktır.

Ödev sahibi: Elgun Aghayev

VERİ BİLİMİ İŞLEMLERİ

Gerekli kütüphaneler yüklendikten sonra uzay gemisindeki yolcuların bulunduğu csv dosyası okunur. Daha sonra veriyi anlamlandırmak için gerekli olan preprocess işlemleri yapılacaktır.

library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.4     ✔ readr     2.1.4
## ✔ forcats   1.0.0     ✔ stringr   1.5.1
## ✔ ggplot2   3.4.4     ✔ tibble    3.2.1
## ✔ lubridate 1.9.3     ✔ tidyr     1.3.0
## ✔ purrr     1.0.2     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
df = read_csv("C:\\Project\\train.csv", show_col_types = FALSE)
spec(df)
## cols(
##   PassengerId = col_character(),
##   HomePlanet = col_character(),
##   CryoSleep = col_logical(),
##   Cabin = col_character(),
##   Destination = col_character(),
##   Age = col_double(),
##   VIP = col_logical(),
##   RoomService = col_double(),
##   FoodCourt = col_double(),
##   ShoppingMall = col_double(),
##   Spa = col_double(),
##   VRDeck = col_double(),
##   Name = col_character(),
##   Transported = col_logical()
## )

Sütun tipleri spec() komutu kullanılarak incelenir. PassengerId, HomePlanet, Cabin, Destination ve Name kolonlarının string; Age, RoomService, FoodCourt, ShoppingMall, Spa ve VRDeck kolonlarının double; CrypoSleep, VIP ve sınıflandırma yapılacak olan Transported kolonunun boolean olduğu görülür.

Daha sonra verinin ilk 5 satırı getirilerek veri incelenir:

head(df)
## # A tibble: 6 × 14
##   PassengerId HomePlanet CryoSleep Cabin Destination     Age VIP   RoomService
##   <chr>       <chr>      <lgl>     <chr> <chr>         <dbl> <lgl>       <dbl>
## 1 0001_01     Europa     FALSE     B/0/P TRAPPIST-1e      39 FALSE           0
## 2 0002_01     Earth      FALSE     F/0/S TRAPPIST-1e      24 FALSE         109
## 3 0003_01     Europa     FALSE     A/0/S TRAPPIST-1e      58 TRUE           43
## 4 0003_02     Europa     FALSE     A/0/S TRAPPIST-1e      33 FALSE           0
## 5 0004_01     Earth      FALSE     F/1/S TRAPPIST-1e      16 FALSE         303
## 6 0005_01     Earth      FALSE     F/0/P PSO J318.5-22    44 FALSE           0
## # ℹ 6 more variables: FoodCourt <dbl>, ShoppingMall <dbl>, Spa <dbl>,
## #   VRDeck <dbl>, Name <chr>, Transported <lgl>

Verinin aşağıdaki özelliklerde olduğu yarışma ana sayfasında verilmiştir:(https://www.kaggle.com/competitions/spaceship-titanic/data)

image.png
image.png

BoÅŸluk Doldurma

Bu bölümde eksik olan veriler bazı yöntemler kullanılarak doldurulacaktır veya sabit verilerle doldurulamayan ve etkisi yüksek olmayacağı düşünülen satırlar silinecektir.

na_prop = function(vec){
  sum(is.na(vec)) / length(vec)
}
lapply(df[,1:ncol(df)], na_prop)
## $PassengerId
## [1] 0
## 
## $HomePlanet
## [1] 0.02312205
## 
## $CryoSleep
## [1] 0.02496261
## 
## $Cabin
## [1] 0.02289198
## 
## $Destination
## [1] 0.02093639
## 
## $Age
## [1] 0.02059128
## 
## $VIP
## [1] 0.02335212
## 
## $RoomService
## [1] 0.02082135
## 
## $FoodCourt
## [1] 0.02105142
## 
## $ShoppingMall
## [1] 0.0239273
## 
## $Spa
## [1] 0.02105142
## 
## $VRDeck
## [1] 0.0216266
## 
## $Name
## [1] 0.02300702
## 
## $Transported
## [1] 0

Yukarıdaki çıktı incelendiğinde, PassengerId ve Transported kolonlarında boş veri bulunmadığı, diğer kolonlarda ise yaklaşık %2-2.4 lük bir kısmının eksik olduğu görülür.

Rakamsal verilerde (Age hariç) eksik olan veriler 0 olarak doldurulabilir. Eğer bir yolcunun herhangi bir harcama kolonundaki verisi eksikse, harcama yapmamıştır gibi düşünülebilir.

df = df %>%
mutate(RoomService = ifelse(is.na(RoomService), 0, RoomService),
       FoodCourt = ifelse(is.na(FoodCourt), 0, FoodCourt),
       ShoppingMall = ifelse(is.na(ShoppingMall), 0, ShoppingMall),
       Spa = ifelse(is.na(Spa), 0, Spa),
       VRDeck = ifelse(is.na(VRDeck), 0, VRDeck)  
)

lapply(df[,1:ncol(df)], na_prop)
## $PassengerId
## [1] 0
## 
## $HomePlanet
## [1] 0.02312205
## 
## $CryoSleep
## [1] 0.02496261
## 
## $Cabin
## [1] 0.02289198
## 
## $Destination
## [1] 0.02093639
## 
## $Age
## [1] 0.02059128
## 
## $VIP
## [1] 0.02335212
## 
## $RoomService
## [1] 0
## 
## $FoodCourt
## [1] 0
## 
## $ShoppingMall
## [1] 0
## 
## $Spa
## [1] 0
## 
## $VRDeck
## [1] 0
## 
## $Name
## [1] 0.02300702
## 
## $Transported
## [1] 0

Rakamsal verilerde boş hücreler doldurulmuş oldu. Age için ise ortalama yaş değeri boş olan Age hücreleri için doldurulur.

df = df %>% 
mutate(
Age= ifelse(is.na(Age),mean(Age, trim=0, na.rm=TRUE),Age)
)
lapply(df[,1:ncol(df)], na_prop)
## $PassengerId
## [1] 0
## 
## $HomePlanet
## [1] 0.02312205
## 
## $CryoSleep
## [1] 0.02496261
## 
## $Cabin
## [1] 0.02289198
## 
## $Destination
## [1] 0.02093639
## 
## $Age
## [1] 0
## 
## $VIP
## [1] 0.02335212
## 
## $RoomService
## [1] 0
## 
## $FoodCourt
## [1] 0
## 
## $ShoppingMall
## [1] 0
## 
## $Spa
## [1] 0
## 
## $VRDeck
## [1] 0
## 
## $Name
## [1] 0.02300702
## 
## $Transported
## [1] 0

Age değerleri için de boş veri kalmadı. HomePlanet verisinin Transported sınıfına olan etkisi incelenir:

ggplot(data = df, mapping = aes(x = {HomePlanet}, fill = Transported)) +
geom_bar(position = 'dodge') +
scale_fill_manual('legend', values = c("#222222", "#AAAAAA"))

En az etkisi olan gezegen MARS olduğu için HomePlanet verisi için eksik değerler MARS değeri ile doldurulur.

df = df %>% 
mutate(
HomePlanet= ifelse(is.na(HomePlanet),"Mars",HomePlanet)
)
lapply(df[,1:ncol(df)], na_prop)
## $PassengerId
## [1] 0
## 
## $HomePlanet
## [1] 0
## 
## $CryoSleep
## [1] 0.02496261
## 
## $Cabin
## [1] 0.02289198
## 
## $Destination
## [1] 0.02093639
## 
## $Age
## [1] 0
## 
## $VIP
## [1] 0.02335212
## 
## $RoomService
## [1] 0
## 
## $FoodCourt
## [1] 0
## 
## $ShoppingMall
## [1] 0
## 
## $Spa
## [1] 0
## 
## $VRDeck
## [1] 0
## 
## $Name
## [1] 0.02300702
## 
## $Transported
## [1] 0

Destination kolonunun Transported sınıfı ile ilişkisi incelenir:

ggplot(data = df, mapping = aes(x = {Destination}, fill = Transported)) +
geom_bar(position = 'dodge') +
scale_fill_manual('legend', values = c("#222222", "#AAAAAA"))

En az etkisi olan Varış Yeri PSO J318.5-22 olduğu için Destination için eksik veriler PSO J318.5-22 ile doldurulur.

df = df %>% 
mutate(
Destination= ifelse(is.na(Destination),"PSO J318.5-22",Destination)
)

lapply(df[,1:ncol(df)], na_prop)
## $PassengerId
## [1] 0
## 
## $HomePlanet
## [1] 0
## 
## $CryoSleep
## [1] 0.02496261
## 
## $Cabin
## [1] 0.02289198
## 
## $Destination
## [1] 0
## 
## $Age
## [1] 0
## 
## $VIP
## [1] 0.02335212
## 
## $RoomService
## [1] 0
## 
## $FoodCourt
## [1] 0
## 
## $ShoppingMall
## [1] 0
## 
## $Spa
## [1] 0
## 
## $VRDeck
## [1] 0
## 
## $Name
## [1] 0.02300702
## 
## $Transported
## [1] 0

Name, Cabin ve VIP kolonlarının eğitimde bir etkisi olmayacaktır, geriye kalan CryoSleep değeri boş olan satırları da silinebilir.

df <- df[!is.na(df$CryoSleep),]

Son olarak Transported sınıf kolonu numeric olarak işaretlenir.

df = df %>% 
mutate( 
Transported = as.factor(as.numeric(Transported)))

MAKİNE ÖĞRENMESİ İŞLEMLERİ

Modelde kullanılmayacak sütunlar veri tablosundan çıkarılır ve eğitim(%80) ve test(%20) verileri oluşturulur.

df = df %>% 
  select(-c(PassengerId, Name,  VIP, Cabin))

train = df[ sample(1:nrow(df), 0.8 * nrow(df)),]  
test = df[-sample(1:nrow(df), 0.8 * nrow(df)),]

Kullanılacak modeller için gerekli kütüphaneler yüklenir:

library(caret)
## Loading required package: lattice
## 
## Attaching package: 'caret'
## The following object is masked from 'package:purrr':
## 
##     lift
library(tidymodels)
## ── Attaching packages ────────────────────────────────────── tidymodels 1.1.1 ──
## ✔ broom        1.0.5     ✔ rsample      1.2.0
## ✔ dials        1.2.0     ✔ tune         1.1.2
## ✔ infer        1.0.5     ✔ workflows    1.1.3
## ✔ modeldata    1.2.0     ✔ workflowsets 1.0.1
## ✔ parsnip      1.1.1     ✔ yardstick    1.2.0
## ✔ recipes      1.0.9
## ── Conflicts ───────────────────────────────────────── tidymodels_conflicts() ──
## ✖ scales::discard()        masks purrr::discard()
## ✖ dplyr::filter()          masks stats::filter()
## ✖ recipes::fixed()         masks stringr::fixed()
## ✖ dplyr::lag()             masks stats::lag()
## ✖ caret::lift()            masks purrr::lift()
## ✖ yardstick::precision()   masks caret::precision()
## ✖ yardstick::recall()      masks caret::recall()
## ✖ yardstick::sensitivity() masks caret::sensitivity()
## ✖ yardstick::spec()        masks readr::spec()
## ✖ yardstick::specificity() masks caret::specificity()
## ✖ recipes::step()          masks stats::step()
## • Use suppressPackageStartupMessages() to eliminate package startup messages
library(rpart)
## 
## Attaching package: 'rpart'
## The following object is masked from 'package:dials':
## 
##     prune
library(rpart.plot)
library(e1071)
## 
## Attaching package: 'e1071'
## The following object is masked from 'package:tune':
## 
##     tune
## The following object is masked from 'package:rsample':
## 
##     permutations
## The following object is masked from 'package:parsnip':
## 
##     tune

Logistic Regression Modeli

Lojistik regresyon, iki veri faktörü arasındaki ilişkileri bulmak için matematikten yararlanan bir veri analizi tekniğidir. Lojistik regresyon, daha sonra diğerine dayalı bu faktörlerden birinin değerini tahmin etmek için bu ilişkiyi kullanır. Tahminin genellikle evet ya da hayır gibi sınırlı sayıda sonucu vardır.

Bu ödevde de veriler logistic regresyon modeli ile eğitilir ve accuracy değeri hesaplanır.

model <- logistic_reg(mixture = double(1), penalty = double(1)) %>%
  set_engine("glmnet") %>%
  set_mode("classification") %>%
  fit(Transported ~ ., data = train)
tidy(model)
## Loading required package: Matrix
## 
## Attaching package: 'Matrix'
## The following objects are masked from 'package:tidyr':
## 
##     expand, pack, unpack
## Loaded glmnet 4.1-8
## # A tibble: 12 × 3
##    term                      estimate penalty
##    <chr>                        <dbl>   <dbl>
##  1 (Intercept)              -0.0375         0
##  2 HomePlanetEuropa          1.23           0
##  3 HomePlanetMars            0.418          0
##  4 CryoSleepTRUE             1.52           0
##  5 DestinationPSO J318.5-22 -0.283          0
##  6 DestinationTRAPPIST-1e   -0.333          0
##  7 Age                      -0.00902        0
##  8 RoomService              -0.000813       0
##  9 FoodCourt                 0.000234       0
## 10 ShoppingMall              0.000403       0
## 11 Spa                      -0.000680       0
## 12 VRDeck                   -0.000634       0
pred_class <- predict(model,
                      new_data = test,
                      type = "class")
pred_proba <- predict(model,
                      new_data = test,
                      type = "prob")
results <- test %>%
           select(Transported) %>%
           bind_cols(pred_class, pred_proba)

accuracy(results, truth = Transported, estimate = .pred_class)
## # A tibble: 1 × 3
##   .metric  .estimator .estimate
##   <chr>    <chr>          <dbl>
## 1 accuracy binary         0.778

Karar Ağacı Modeli

Karar ağacı, bir kurum veya kuruluş tarafından tercihlerin, risklerin, kazançların ve hedeflerin anlaşılmasına yardımcı olan bir teknik türüdür. Aynı zamanda birçok önemli yatırım sahalarında uygulanabilen, birbiriyle bağlantılı şans olaylarıyla ilgili olarak çıkan çeşitli karar noktalarını incelemek için kullanılan bir karar destek aracıdır.

Ödevde de karar ağacı modeli kullanılarak kullanılan modelin doğruluk değeri hesaplanacaktır. Aynı zamanda oluşan ağacın çizimi de yapılacaktır.

dec_tree <- rpart(Transported~., data = train)
pruned_tree <- prune(dec_tree, cp=0.01)
prp(pruned_tree, faclen=1)

prediction <- rpart.predict(pruned_tree, newdata = test, type = 'vector')
conf_matrix <- table(prediction, test$Transported)
accuracy <- sum(diag(conf_matrix))/sum(conf_matrix)
accuracy
## [1] 0.7753538

Destek Vektör Makinesi (SVM) Modeli

Destek Vektör Makineleri (Support Vector Machine) genellikle sınıflandırma problemlerinde kullanılan gözetimli öğrenme yöntemlerinden biridir. Bir düzlem üzerine yerleştirilmiş noktaları ayırmak için bir doğru çizer. Bu doğrunun, iki sınıfının noktaları için de maksimum uzaklıkta olmasını amaçlar. Karmaşık ama küçük ve orta ölçekteki veri setleri için uygundur.

Ödev kapsamında da bir destek vektör makinesi modeli eğitilecektir ve accuracy değeri hesaplanacaktır.

svm_model = svm(Transported ~ ., data = train, ,type='C-classification', cost = 0.3, scale = FALSE)
print(svm_model)
## 
## Call:
## svm(formula = Transported ~ ., data = train, , type = "C-classification", 
##     cost = 0.3, scale = FALSE)
## 
## 
## Parameters:
##    SVM-Type:  C-classification 
##  SVM-Kernel:  radial 
##        cost:  0.3 
## 
## Number of Support Vectors:  5315
mean(test$Transported==predict(svm_model, test))
## [1] 0.728184

En iyi accuracy SVM Modelinde alındığı için yarışmada bulunan test verileri bu model kullanılarak test edilip tahminlerin bulunduğu csv dosyası ile yarışmaya katılım sağlanacaktır.

test = read_csv("C:\\Project\\test.csv")
## Rows: 4277 Columns: 13
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (5): PassengerId, HomePlanet, Cabin, Destination, Name
## dbl (6): Age, RoomService, FoodCourt, ShoppingMall, Spa, VRDeck
## lgl (2): CryoSleep, VIP
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
test = test  %>%
mutate(RoomService = ifelse(is.na(RoomService), 0, RoomService),
       FoodCourt = ifelse(is.na(FoodCourt), 0, FoodCourt),
       ShoppingMall = ifelse(is.na(ShoppingMall), 0, ShoppingMall),
       Spa = ifelse(is.na(Spa), 0, Spa),
       VRDeck = ifelse(is.na(VRDeck), 0, VRDeck)  
)
test = test %>% 
mutate(
Age= ifelse(is.na(Age),mean(Age, trim=0, na.rm=TRUE),Age)
)
test = test %>% 
mutate(
HomePlanet= ifelse(is.na(HomePlanet),"Mars",HomePlanet)
)
test = test %>% 
mutate(
Destination= ifelse(is.na(Destination),"PSO J318.5-22",Destination)
)
model <- logistic_reg(mixture = double(1), penalty = double(1)) %>%
  set_engine("glmnet") %>%
  set_mode("classification") %>%
  fit(Transported ~ ., data = df)

predictions = data.frame(PassengerId = test$PassengerId, Transported = str_to_title(as.logical(as.numeric(unlist(predict(model, test, type= "class")))-1)))

write.csv(predictions, "submission.csv", row.names = FALSE)

Leaderboard: