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
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)
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)))
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
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ı, 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 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: