--- title: "Uczenie maszynowe w R" author: "Przemysław, Tomasz" date: "2026-05-22" output: pdf_document: default html_document: default --- ```{r setup, include=FALSE} knitr::opts_chunk$set( echo = TRUE ) ``` ```{r} definiowanie_osoby <- function(gender, age, class, embarked, fare, sibsp, parch) { df <- data.frame( gender = factor( gender, levels = c("female", "male") ), age = age, class = factor( class, levels = c( "1st", "2nd", "3rd", "deck crew", "engineering crew", "restaurant staff", "victualling crew" ) ), embarked = factor( embarked, levels = c( "Belfast", "Cherbourg", "Queenstown", "Southampton" ) ), fare = fare, sibsp = sibsp, parch = parch ) return(df) } stworzenie_predykcji <- function(gender, age, class, embarked, fare, sibsp, parch) { df <- definiowanie_osoby(gender, age, class, embarked, fare, sibsp, parch) pred_lmr_t <- predict(titanic_lmr_exp, df) pred_rf_t <- predict(titanic_rf_exp, df) pred_gbm_t <- predict(titanic_gbm_exp, df) pred_svm_t <- predict(titanic_svm_exp, df) cat("Model regresji logistycznej przewiduje:", round(pred_lmr_t, 3), "-> Masz", round(pred_lmr_t * 100, 1), "% szans na przeżycie\n") cat("Model random forest przewiduje:", round(pred_rf_t, 3), "-> Masz", round(pred_rf_t * 100, 1), "% szans na przeżycie\n") cat("Model GBM przewiduje:", round(pred_gbm_t, 3), "-> Masz", round(pred_gbm_t * 100, 1), "% szans na przeżycie\n") cat("Model SVM przewiduje:", round(pred_svm_t, 3), "-> Masz", round(pred_svm_t * 100, 1), "% szans na przeżycie\n") } ``` # Przygotuwujemy nasz skrypt do działania ## Instalujemy potrzebne pakiety ```{r,echo=FALSE}} #install.packages("DALEX") #install.packages("rms") #install.packages("randomForest") #install.packages("gbm") #install.packages("e1071") #install.packages("ggplot2") #install.packages("RCurl") #install.packages("archivist") ``` ## Wczytujemy potrzebne pakiety ```{r,echo=FALSE} library("DALEX") # pakiet umożliwi analizę czarnych skrzynek library("rms") # pakiet umożliwi modelowanie zależności krzywoliniowych za pomocą regresji library("randomForest") # lasy losowe library("gbm") # gradient boosting library("e1071") # support vector machine (maszyna wektorów nośnych) library("ggplot2") # wykresy i wizualizacja danych library("archivist") # pobieranie danych z internetu library("RCurl") # również służy do pobierania danych ``` # Importujemy zbiór danych titanic ```{r} titanic <- archivist::aread("pbiecek/models/27e5c") ``` ## Aby dowiedzieć się więcej o tym zbiorze możemy spojrzeć na oficjalną dokumentacje stworzoną dla tego zbioru danych ```{r} ?titanic ``` ## wyświetlenie kilku pierwszych wartości z tabeli titanic ```{r} head(titanic) ``` # Budowa używanych modeli machine learningu ## Model regresji logistycznej: ```{r} # Zamieniamy wartości „yes”/„no” w kolumnie survived na 1 (przeżył) i 0 (nie przeżył) titanic <- archivist::aread("pbiecek/models/27e5c") titanic$survived <- ifelse(titanic$survived == "yes", 1, 0) # Budujemy model titanic_lmr <- rms::lrm(survived == "1" ~ gender + rms::rcs(age) + class + sibsp + parch + fare + embarked, titanic) ``` ## Model lasów losowych ```{r} set.seed(1313) titanic$survived <- as.factor(titanic$survived) titanic_rf <- randomForest::randomForest(survived ~ class + gender + age + sibsp + parch + fare + embarked, data = titanic, na.action=na.roughfix) ``` ## Model gradient boosting Może się troszkę dłużej ładować :) :D ```{r} set.seed(1313) # Zakładamy, że 'survived' jest faktorem lub tekstem – konwertujemy go do 0/1 titanic$survived <- ifelse(titanic$survived == "Yes" | titanic$survived == "1", 1, 0) # Model gradient boosting titanic_gbm <- gbm( survived ~ class + gender + age + sibsp + parch + fare + embarked, data = titanic, n.trees = 15000, distribution = "bernoulli" ) ``` ## Model maszyny wektorow nosnych: ```{r} set.seed(1313) titanic_svm <- e1071::svm(survived == "1" ~ class + gender + age + sibsp + parch + fare + embarked, data = titanic, type = "C-classification", probability = TRUE) ``` # Zapakowanie modeli do podobnych opakowań (explainerów): ## Model regresji logistycznej: ```{r} titanic_lmr_exp <- explain(model = titanic_lmr, data = titanic[, -9], y = titanic$survived == "1", label = "Logistic Regression", type = "classification") ``` ## Model lasów losowych ```{r} titanic_rf_exp <- explain(model = titanic_rf, data = titanic[, -9], y = titanic$survived == "1", label = "Random Forest") ``` ## Model gradient boosting ```{r} titanic_gbm_exp <- explain(model = titanic_gbm, data = titanic[, -9], y = titanic$survived == "1", label = "Generalized Boosted Regression") ``` ## Model maszyny wektorow nośnych: ```{r} titanic_svm_exp <- explain(model = titanic_svm, data = titanic[, -9], y = titanic$survived == "1", label = "Support Vector Machine") ``` # Porównywanie siły predykcyjnej modeli: ```{r} auc_lmr <- model_performance(titanic_lmr_exp)$measures$auc auc_rf <- model_performance(titanic_rf_exp)$measures$auc auc_gbm <- model_performance(titanic_gbm_exp)$measures$auc auc_svm <- model_performance(titanic_svm_exp)$measures$auc ``` ## WYNIKI ```{r} cat("Siła predykcyjna modelu regresji logistycznej wynosi:", auc_lmr, "\n") cat("Siła predykcyjna modelu random forest wynosi:", auc_rf, "\n") cat("Siła predykcyjna modelu gradient boosting (GBM) wynosi:", auc_gbm, "\n") cat("Siła predykcyjna modelu SVM wynosi:", auc_svm, "\n") ``` Im większa liczba tym lepiej :) # Tworzymy naszych badanych pasażerów Jack i Rose ## Tworzenie Jacka ```{r} jack <- definiowanie_osoby( gender = "male", age = 20, class = "3rd", embarked = "Southampton", fare = 10, sibsp = 0, parch = 0 ) ``` ## Tworzenie Rose ```{r} rose <- definiowanie_osoby( gender = "female", age = 17, class = "1st", embarked = "Southampton", fare = 850, sibsp = 0, parch = 1 ) ``` # Zobaczmy Jacka i Rose w zbiorze ```{r} { print(jack) } ``` ```{r} print(rose) ``` # Przewidywania modeli dla naszych pasażerów ## Wyliczmy przewidywania dla Jacka ```{r} pred_lmr_j <- predict(titanic_lmr_exp, jack) pred_rf_j <- predict(titanic_rf_exp, jack) pred_gbm_j <- predict(titanic_gbm_exp, jack) pred_svm_j <- predict(titanic_svm_exp, jack) ``` ### Wyniki ```{r} cat("Model regresji logistycznej przewiduje:", round(pred_lmr_j, 3), "-> Jack ma", round(pred_lmr_j * 100, 1), "% szans na przeżycie\n") cat("Model random forest przewiduje:", round(pred_rf_j, 3), "-> Jack ma", round(pred_rf_j * 100, 1), "% szans na przeżycie\n") cat("Model GBM przewiduje:", round(pred_gbm_j, 3), "-> Jack ma", round(pred_gbm_j * 100, 1), "% szans na przeżycie\n") cat("Model SVM przewiduje:", round(pred_svm_j, 3), "-> Jack ma", round(pred_svm_j * 100, 1), "% szans na przeżycie\n") ``` ## Wyliczmy przewidywania dla Rose ```{r} pred_lmr_r <- predict(titanic_lmr_exp, rose) pred_rf_r <- predict(titanic_rf_exp, rose) pred_gbm_r <- predict(titanic_gbm_exp, rose) pred_svm_r <- predict(titanic_svm_exp, rose) ``` ### Wyniki ```{r} cat("Model regresji logistycznej przewiduje:", round(pred_lmr_r, 3), "-> Rose ma", round(pred_lmr_r * 100, 1), "% szans na przeżycie\n") cat("Model random forest przewiduje:", round(pred_rf_r, 3), "-> Rose ma", round(pred_rf_r * 100, 1), "% szans na przeżycie\n") cat("Model GBM przewiduje:", round(pred_gbm_r, 3), "-> Rose ma", round(pred_gbm_r * 100, 1), "% szans na przeżycie\n") cat("Model SVM przewiduje:", round(pred_svm_r, 3), "-> Rose ma", round(pred_svm_r * 100, 1), "% szans na przeżycie\n") ``` # Pora na wykresy :) ## Pytanie 1: Co wpływa na wynik w danym modelu? ### JACK #### Model regresji logistycznej ```{r} bd_lmr <- predict_parts(explainer = titanic_lmr_exp, new_observation = jack, type = "break_down") plot(bd_lmr) ``` #### Model lasow losowych ```{r} bd_rf <- predict_parts(explainer = titanic_rf_exp, new_observation = jack, type = "break_down") plot(bd_rf) ``` #### Model gradient boosting ```{r} bd_gbm <- predict_parts(explainer = titanic_gbm_exp, new_observation = jack, type = "break_down") plot(bd_gbm) ``` #### Model maszyny wektorów ```{r} bd_svm <- predict_parts(explainer = titanic_svm_exp, new_observation = jack, type = "break_down") plot(bd_svm) ``` ### ROSE #### Model regresji logistycznej ```{r} bd_lmr <- predict_parts(explainer = titanic_lmr_exp, new_observation = rose, type = "break_down") plot(bd_lmr) ``` #### Model lasow losowych ```{r} bd_rf <- predict_parts(explainer = titanic_rf_exp, new_observation = rose, type = "break_down") plot(bd_rf) ``` #### Model gradient boosting ```{r} bd_gbm <- predict_parts(explainer = titanic_gbm_exp, new_observation = rose, type = "break_down") plot(bd_gbm) ``` #### Model maszyny wektorów ```{r} bd_svm <- predict_parts(explainer = titanic_svm_exp, new_observation = rose, type = "break_down") plot(bd_svm) ``` ## Pytanie 2: Jak wplywa wiek i cena biletu na szanse przeżycia? ### W modelu gradient boosting? ```{r} library("ggplot2") cp_titanic_gbm <- predict_profile(explainer = titanic_gbm_exp, new_observation = jack) plot(cp_titanic_gbm, variables = c("age", "fare")) + ggtitle("Ceteris-paribus profile", "") + ylim(0, 0.8) ``` ## Pytanie 3: Jak wplywa klasa, miejsce z ktorego wyruszyl pasazer oraz plec? ### W modelu regresji logistycznej? ```{r} cp_titanic_lmr <- predict_profile(explainer = titanic_lmr_exp, new_observation = jack) plot(cp_titanic_lmr, variables = c("class", "embarked", "gender"), variable_type = "categorical", categorical_type = "bars") + ggtitle("Ceteris-paribus profile", "") ``` ## Pytanie 4 : Od jakich zmiennych zależy predykcja? ### W modelu regresji logistycznej ```{r} vip_lm <- model_parts(explainer = titanic_lmr_exp, B = 50, N = NULL) plot(vip_lm) ``` ### W modelu lasów losowych ```{r} vip_rf <- model_parts(explainer = titanic_rf_exp, B = 50, N = NULL) plot(vip_rf) ``` ### W modelu gradient boosting ```{r} vip_gbm <- model_parts(explainer = titanic_gbm_exp, B = 50, N = NULL) plot(vip_gbm) ``` ### W modelu maszyny wektorów ```{r} vip_svm <- model_parts(explainer = titanic_svm_exp, B = 50, N = NULL) plot(vip_svm) ``` ## Pytanie 5: W jaki sposób średnio przeżywalność zależy od wieku? ```{r} plot(model_profile(explainer = titanic_rf_exp, variables = "age"), geom="profiles") ``` ## Pytanie 6: W jaki sposób średnio przeżywalność zależy od płci? ```{r} plot(model_profile(explainer = titanic_gbm_exp, variables = "age", groups = "gender"), geom = "profiles") ``` # Pora na Ciebie! ```{r, eval=FALSE} stworzenie_predykcji( gender = WPISZ TUTAJ, # Wpisać jedno z: "female", "male" age = WPISZ TUTAJ, class = WPISZ TUTAJ, # Wpisać jedno z: "1st", "2nd", "3rd", "deck crew", "engineering crew", "restaurant staff", "victualling crew" embarked = WPISZ TUTAJ, # Wpisać jedno z: "Belfast", "Cherbourg", "Queenstown", "southampton" fare = WPISZ TUTAJ, sibsp = WPISZ TUTAJ, parch = WPISZ TUTAJ ) ```