SOUMAINE HISSEINE SOUGUI :2010504509 IKT 403 Uygulamalı Ekonometri
Dr. Ögr. Uyesi Hüseyin Utku Demir
2023-12-19
Spaceship Titanic Kaggle Competition
Welcome to the year 2912, where your data science skills are needed
to solve a cosmic mystery. We’ve received a transmission from four
lightyears away and things aren’t looking good. The Spaceship Titanic
was an interstellar passenger liner launched a month ago. With almost
13,000 passengers on board, the vessel set out on its maiden voyage
transporting emigrants from our solar system to three newly habitable
exoplanets orbiting nearby stars. While rounding Alpha Centauri en route
to its first destination—the torrid 55 Cancri E—the unwary Spaceship
Titanic collided with a spacetime anomaly hidden within a dust cloud.
Sadly, it met a similar fate as its namesake from 1000 years before.
Though the ship stayed intact, almost half of the passengers were
transported to an alternate dimension! 
To help rescue crews and retrieve the lost passengers,
you are challenged to predict which passengers were transported by the
anomaly using records recovered from the spaceship’s damaged computer
system.
Help save them and change history!
library(readr)
test <- read_csv("C:/Users/souma/Downloads/test (2).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.train <- read_csv("C:/Users/souma/Downloads/train (1).csv")## Rows: 8693 Columns: 14
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (5): PassengerId, HomePlanet, Cabin, Destination, Name
## dbl (6): Age, RoomService, FoodCourt, ShoppingMall, Spa, VRDeck
## lgl (3): CryoSleep, VIP, Transported
##
## ℹ 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.library(tidyverse)## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ purrr 1.0.2
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ ggplot2 3.4.4 ✔ tibble 3.2.1
## ✔ lubridate 1.9.3 ✔ tidyr 1.3.0
## ── 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 errorslibrary(tidyverse)
library(explore)
train %>% describe_all()## # A tibble: 14 × 8
## variable type na na_pct unique min mean max
## <chr> <chr> <int> <dbl> <int> <dbl> <dbl> <dbl>
## 1 PassengerId chr 0 0 8693 NA NA NA
## 2 HomePlanet chr 201 2.3 4 NA NA NA
## 3 CryoSleep lgl 217 2.5 3 0 0.36 1
## 4 Cabin chr 199 2.3 6561 NA NA NA
## 5 Destination chr 182 2.1 4 NA NA NA
## 6 Age dbl 179 2.1 81 0 28.8 79
## 7 VIP lgl 203 2.3 3 0 0.02 1
## 8 RoomService dbl 181 2.1 1274 0 225. 14327
## 9 FoodCourt dbl 183 2.1 1508 0 458. 29813
## 10 ShoppingMall dbl 208 2.4 1116 0 174. 23492
## 11 Spa dbl 183 2.1 1328 0 311. 22408
## 12 VRDeck dbl 188 2.2 1307 0 305. 24133
## 13 Name chr 200 2.3 8474 NA NA NA
## 14 Transported lgl 0 0 2 0 0.5 1yorum : Bu kod amacı her bir sayısal değişken için temel istatistikleri :ortalama, standart sapma, minimum, maksimum, çeyrekler, medyan vb.kategorik değişkenler için frekans dağılımlarını içeren kapsamlı bir istatistiksel özet sağlar.
test %>% describe_all()## # A tibble: 13 × 8
## variable type na na_pct unique min mean max
## <chr> <chr> <int> <dbl> <int> <dbl> <dbl> <dbl>
## 1 PassengerId chr 0 0 4277 NA NA NA
## 2 HomePlanet chr 87 2 4 NA NA NA
## 3 CryoSleep lgl 93 2.2 3 0 0.37 1
## 4 Cabin chr 100 2.3 3266 NA NA NA
## 5 Destination chr 92 2.2 4 NA NA NA
## 6 Age dbl 91 2.1 80 0 28.7 79
## 7 VIP lgl 93 2.2 3 0 0.02 1
## 8 RoomService dbl 82 1.9 843 0 219. 11567
## 9 FoodCourt dbl 106 2.5 903 0 439. 25273
## 10 ShoppingMall dbl 98 2.3 716 0 177. 8292
## 11 Spa dbl 101 2.4 834 0 303. 19844
## 12 VRDeck dbl 80 1.9 797 0 311. 22272
## 13 Name chr 94 2.2 4177 NA NA NAhead(test)## # A tibble: 6 × 13
## PassengerId HomePlanet CryoSleep Cabin Destination Age VIP RoomService
## <chr> <chr> <lgl> <chr> <chr> <dbl> <lgl> <dbl>
## 1 0013_01 Earth TRUE G/3/S TRAPPIST-1e 27 FALSE 0
## 2 0018_01 Earth FALSE F/4/S TRAPPIST-1e 19 FALSE 0
## 3 0019_01 Europa TRUE C/0/S 55 Cancri e 31 FALSE 0
## 4 0021_01 Europa FALSE C/1/S TRAPPIST-1e 38 FALSE 0
## 5 0023_01 Earth FALSE F/5/S TRAPPIST-1e 20 FALSE 10
## 6 0027_01 Earth FALSE F/7/P TRAPPIST-1e 31 FALSE 0
## # ℹ 5 more variables: FoodCourt <dbl>, ShoppingMall <dbl>, Spa <dbl>,
## # VRDeck <dbl>, Name <chr>train <- train[,c(6, 1:5, 7:14)]head(train)## # A tibble: 6 × 14
## Age PassengerId HomePlanet CryoSleep Cabin Destination VIP RoomService
## <dbl> <chr> <chr> <lgl> <chr> <chr> <lgl> <dbl>
## 1 39 0001_01 Europa FALSE B/0/P TRAPPIST-1e FALSE 0
## 2 24 0002_01 Earth FALSE F/0/S TRAPPIST-1e FALSE 109
## 3 58 0003_01 Europa FALSE A/0/S TRAPPIST-1e TRUE 43
## 4 33 0003_02 Europa FALSE A/0/S TRAPPIST-1e FALSE 0
## 5 16 0004_01 Earth FALSE F/1/S TRAPPIST-1e FALSE 303
## 6 44 0005_01 Earth FALSE F/0/P PSO J318.5-22 FALSE 0
## # ℹ 6 more variables: FoodCourt <dbl>, ShoppingMall <dbl>, Spa <dbl>,
## # VRDeck <dbl>, Name <chr>, Transported <lgl>sırada bu verileri gözlem bazın verileri boş yer var . bazın değişkenler gizli . 2’tan bilgi var bu 2 bilgi çıkarmam lazın . 2 daha farklı eklecem .cabin to 3 coloums.
train[c('deck' , 'num' , 'side')] <- str_split_fixed(train$Cabin, "/" ,3 )yorun : cabin üç farklı parçaya ayırdık
train[c('ailenum' , 'ailesira')] <- str_split_fixed(train$PassengerId, "_" ,2 )test[c('deck' , 'num' , 'side')] <- str_split_fixed(test$Cabin, "/" ,3 )test[c('ailenum' , 'ailesira')] <- str_split_fixed(test$PassengerId, "_" ,2 )train$CryoSleep <- addNA(train$CryoSleep)yorum : Bu kod, eksik değerleri belirli bir değerle doldurarak analiz sürecini kolaylaştırmayı amaçlar.
test$CryoSleep <- addNA(test$CryoSleep)train %>% describe_all()## # A tibble: 19 × 8
## variable type na na_pct unique min mean max
## <chr> <chr> <int> <dbl> <int> <dbl> <dbl> <dbl>
## 1 Age dbl 179 2.1 81 0 28.8 79
## 2 PassengerId chr 0 0 8693 NA NA NA
## 3 HomePlanet chr 201 2.3 4 NA NA NA
## 4 CryoSleep fct 0 0 3 NA NA NA
## 5 Cabin chr 199 2.3 6561 NA NA NA
## 6 Destination chr 182 2.1 4 NA NA NA
## 7 VIP lgl 203 2.3 3 0 0.02 1
## 8 RoomService dbl 181 2.1 1274 0 225. 14327
## 9 FoodCourt dbl 183 2.1 1508 0 458. 29813
## 10 ShoppingMall dbl 208 2.4 1116 0 174. 23492
## 11 Spa dbl 183 2.1 1328 0 311. 22408
## 12 VRDeck dbl 188 2.2 1307 0 305. 24133
## 13 Name chr 200 2.3 8474 NA NA NA
## 14 Transported lgl 0 0 2 0 0.5 1
## 15 deck chr 199 2.3 9 NA NA NA
## 16 num chr 0 0 1818 NA NA NA
## 17 side chr 0 0 3 NA NA NA
## 18 ailenum chr 0 0 6217 NA NA NA
## 19 ailesira chr 0 0 8 NA NA NAyorum : her bir sayısal değişken için ortalama, medyan, standart sapma, minimum, maksimum ve çeyrekler gibi temel istatistikleri içerir. Ayrıca, kategorik değişkenler için frekans dağılımını içerir
unique(train$HomePlanet)## [1] "Europa" "Earth" "Mars" NAunique(test$HomePlanet)## [1] "Earth" "Europa" "Mars" NAggplot(train, aes( x = Age)) +
geom_histogram() +
labs(x = "Age mileage")## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.## Warning: Removed 179 rows containing non-finite values (`stat_bin()`).
burada yaş oranını görmek için histogramı yapıyoruz
ggplot(test, aes( x = Age)) + geom_histogram() + labs(x = "Age mileage")## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.## Warning: Removed 91 rows containing non-finite values (`stat_bin()`).
yorum : en yüsek yaş oranı 20’dir. en düşük oran 80 yaşında
ggplot(train, aes( x = VRDeck)) + geom_histogram() + labs(x = "VRDeck mileage")## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.## Warning: Removed 188 rows containing non-finite values (`stat_bin()`).
ggplot(test, aes( x = VRDeck)) + geom_histogram() + labs(x = "VRDeck mileage")## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.## Warning: Removed 80 rows containing non-finite values (`stat_bin()`).
ggplot(train, aes( x = Age)) + geom_freqpoly() + labs(x = "Age mileage")## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.## Warning: Removed 179 rows containing non-finite values (`stat_bin()`).
yorum : burada histogramımızın sıklığını görmek için bunu yapıyoruz .
grafik yukarın ve aşağı gittiğni gösteriyor
ggplot(test, aes( x = Age)) + geom_freqpoly() + labs(x = "Age mileage")## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.## Warning: Removed 91 rows containing non-finite values (`stat_bin()`).
ggplot(test, aes(x = Age , y = VRDeck)) + geom_point()## Warning: Removed 167 rows containing missing values (`geom_point()`).
yorum : Her bir nokta, belirli bir yaş ve belirli bir VRDeck değerini
temsil eder. Eğer noktalar belirli bir desen gösteriyorsa, bu desen yaş
ve VRDeck arasında bir ilişki olabileceğini gösterir. Noktaların yayılma
veya kümelenme şekli, bu iki değişken arasındaki varyans ve ilişkiyi
anlamamıza yardımcı olabilir.
ggplot(train, aes(x = Age, y = Transported)) + geom_point()## Warning: Removed 179 rows containing missing values (`geom_point()`).
yorum : Bu grafik, yaş (Age) ile “Transported” değişkeni arasındaki ilişkiyi görselleştirmektedir. Her bir nokta, belirli bir yaş ve belirli bir “Transported” değerini temsil eder.
ggplot(train, aes(x = Age, y = VRDeck)) + geom_point()+ geom_smooth(method = "lm")## `geom_smooth()` using formula = 'y ~ x'## Warning: Removed 363 rows containing non-finite values (`stat_smooth()`).## Warning: Removed 363 rows containing missing values (`geom_point()`).
yorum : regresyon çizgisi, yaşın “VRDeck” üzerindeki etkisini lineer bir
modelle gösterir. Eğer çizgi yukarı doğru eğilmişse, bu yaşın artmasıyla
“VRDeck” değerinin arttığını gösterebilir.
ggplot(test, aes(x = Age, y = VRDeck, color = )) + geom_point()## Warning: Removed 167 rows containing missing values (`geom_point()`).
ggplot(train, aes(x = Age, y = VRDeck, color = )) + geom_point()+ scale_color_brewer(palette = "Dark2" )## Warning: Removed 363 rows containing missing values (`geom_point()`).
yorum:Bu kod, yaş ve VRDeck değişkenleri arasındaki ilişkiyi renkli bir şekilde görselleştirmek için kullanılabilir.
test_metric <- test %>%
mutate(Age_metric = 0.425144*Age)
View(test)train %>%
group_by(PassengerId) %>%
summarise(mean(Age), median(Age))## # A tibble: 8,693 × 3
## PassengerId `mean(Age)` `median(Age)`
## <chr> <dbl> <dbl>
## 1 0001_01 39 39
## 2 0002_01 24 24
## 3 0003_01 58 58
## 4 0003_02 33 33
## 5 0004_01 16 16
## 6 0005_01 44 44
## 7 0006_01 26 26
## 8 0006_02 28 28
## 9 0007_01 35 35
## 10 0008_01 14 14
## # ℹ 8,683 more rowsyorum : bu kod her yolcunun yaş ortalamasını ve medianını içeren bir özet veri çerçevesi oluşturur. Bu tür bir analiz, her bir yolcunun yaş özelliklerini daha genel bir şekilde anlamak veya bu istatistiksel ölçümleri daha geniş bir analize dahil etmek için kullanılabilir.
test %>%
group_by(PassengerId) %>%
summarise(mean(Age), median(Age))## # A tibble: 4,277 × 3
## PassengerId `mean(Age)` `median(Age)`
## <chr> <dbl> <dbl>
## 1 0013_01 27 27
## 2 0018_01 19 19
## 3 0019_01 31 31
## 4 0021_01 38 38
## 5 0023_01 20 20
## 6 0027_01 31 31
## 7 0029_01 21 21
## 8 0032_01 20 20
## 9 0032_02 23 23
## 10 0033_01 24 24
## # ℹ 4,267 more rowsquantile## function (x, ...)
## UseMethod("quantile")
## <bytecode: 0x00000210cc81dca8>
## <environment: namespace:stats>quantile(test$Age, na.rm = TRUE)## 0% 25% 50% 75% 100%
## 0 19 26 37 79yorum : minimum, maksimum ve medyan gibi istatistiksel ölçümleri içerebilir.
quantile(train$VIP, na.rm = TRUE)## 0% 25% 50% 75% 100%
## 0 0 0 0 1var(test$Age, na.rm = TRUE)## [1] 201.0461var(train$Age, na.rm = TRUE)## [1] 209.9317yorum : bu kod “Age” değişkeninin varyansını verir.
sd(test$Age, na.rm = TRUE)## [1] 14.17907sd(train$Age, na.rm = TRUE)## [1] 14.48902yorum : Standart sapma, bir değişkenin değerlerinin ne kadar yayıldığını ve ortalamadan ne kadar uzaklaştığını ölçer. Daha yüksek standart sapma, değerlerin ortalamadan daha fazla yayıldığını gösterir. Standart sapmanın düşük olması, değerlerin ortalamaya daha yakın olduğunu gösterir.
hist(train$Age)
hist(test$Age)
yorum : bir değişkenin dağılımını anlamak ve veri setindeki değerlerin frekansını görselleştirmek için kullanılır.
hist(train$VRDeck)
hist(test$Age)
ggplot(test, aes(x = Age )) + geom_bar()## Warning: Removed 91 rows containing non-finite values (`stat_count()`).
ggplot(train, aes(x = Age )) + geom_bar()## Warning: Removed 179 rows containing non-finite values (`stat_count()`).
yorum : belirli bir yaş aralığında yoğunlaşıyorsa, bu yaş aralığındaki gözlemlerin sıklığının arttığını gösterebilir.
hist(test$VRDeck)
table(train$HomePlanet)##
## Earth Europa Mars
## 4602 2131 1759table(test$CryoSleep)##
## FALSE TRUE <NA>
## 2640 1544 93train_set <- train[2:15]Bu tür bir işlemle, orijinal veri çerçevesinin belirli bir alt kümesini oluşturabilir ve bu alt kümesi üzerinde daha spesifik analizler veya modelleme işlemleri gerçekleştirebilirsiniz
test_set <- train[2:15]library(caTools)
set.seed(123)
split = sample.split(train_set$Transported, SplitRatio = 0.75)
training_set = subset(train_set, split == TRUE)
testing_set = subset(train_set, split == FALSE)Bu işlem, genellikle veri setini eğitim (öğrenme) ve test setlerine ayırmak için kullanılır.
naive bayes
naive Bayes” sınıflandırma modelini oluşturmak için kullanılır. Naive Bayes, özellikle metin sınıflandırma gibi birçok uygulama alanında başarılı olan bir makine öğrenimi algoritmasıdır.
library(e1071)
fit_bn <- naiveBayes(Transported ~ ., data =training_set )
preds <- predict(fit_bn, newdata = testing_set[-13], type = "raw") %>%
data.frame()Bu kod, veri setindeki değişkenlere dayanarak “Transported” değişkeninin olasılığa dayalı bir sınıflandırma yapılmasını sağlar. Ardından, bu tahminler bir veri çerçevesine yerleştirilir, böylece daha fazla analiz veya değerlendirme için kullanılabilir.
y_pred = ifelse(preds$TRUE. > 0.5, 1,0)yorum : “TRUE.” sütunundaki değer 0.5’ten büyükse, o zaman 1’e (TRUE), değilse 0’a (FALSE) atama yapar. Bu şekilde, 0.5’ten büyük olup olmama eşiği üzerinden ikili bir sınıflandırma yapmış olursunuz.
y_true <- ifelse(testing_set[-13] == TRUE, 1, 0)y_true <- ifelse(training_set[-13] == TRUE, 1, 0) y_true <- c(0, 1, 1, 0, 1, 0, 0, 1)
y_pred <- c(0, 1, 1, 0, 1, 1, 0, 1)
cm = table(y_true, y_pred)cm## y_pred
## y_true 0 1
## 0 3 1
## 1 0 4(3+4)/ (3+4+0+1)## [1] 0.875nb_son = naiveBayes(Transported ~ ., data =train_set )preds <- predict(nb_son, newdata = test_set, type = "raw") %>%
data.frame()y_pred = ifelse(preds$TRUE. > 0.5, TRUE, FALSE )Eğer tahmin olasılığı 0.5’ten büyükse, pozitif sınıfa ait olarak sınıflandırılır, aksi takdirde negatif sınıfa ait olarak sınıflandırılır.
Transported <- as.character(y_pred)
PassengerId <- test$PassengerIdTransported <- as.vector(Transported)as.vector fonksiyonu, argüman olarak verilen nesneyi bir vektöre dönüştürür. Eğer Transported değişkeni zaten bir vektör tipinde ise, bu işlem bir değişiklik yapmayabilir.
submission <- cbind(PassengerId,Transported)## Warning in cbind(PassengerId, Transported): number of rows of result is not a
## multiple of vector length (arg 1)submission <- as.data.frame(submission)library(stringr)submission$Transported <- str_to_title(submission$Transported)str_to_title fonksiyonu genellikle metin manipülasyonu için kullanılır ve metin içindeki her kelimenin ilk harfini büyük, geri kalan harfini küçük yapar.
write.csv(submission, "sub_nb_cvs", row.names = FALSE, quote=FALSE)Sonuç olarak, bu kod submission veri çerçevesini “submission_nb_cvs.csv” adlı bir CSV dosyasına kaydeder.
svm radial (kernel)
library(e1071)
svm_ker_son <- svm(Transported ~ ., data = train_set,
type = 'C-classification',
kernel = "radial")preds <- predict(svm_ker_son, newdata = test_set, type = "raw") %>%
data.frame()y_pred = preds$.Transported <- as.character(y_pred)
PassengerId <- test$PassengerIdTransported <- as.vector(Transported)submission <- cbind(PassengerId, Transported )## Warning in cbind(PassengerId, Transported): number of rows of result is not a
## multiple of vector length (arg 1)submission <- as.data.frame(submission)submission$Transported <- str_to_title(submission$Transported)write.csv(submission, "submission_kernelsvm_cvs", row.names = FALSE, quote=FALSE)
