---
title: "Warsztaty"
author: "Paulina"
date: "2025-04-29"
output:
  pdf_document: default
  html_document: default
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
```

# 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ć :)

```{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 Jack'a

```{r}
jack <- data.frame(

  class = factor("3rd", levels = c("1st", "2nd", "3rd", "deck crew", "engineering crew", "restaurant staff", "victualling crew")),

  gender = factor("male", levels = c("female", "male")),

  age = 20,

  sibsp = 0,

  parch = 0,

  fare = 10,

  embarked = factor("Southampton", levels = c("Belfast", "Cherbourg", "Queenstown", "Southampton"))

)
```

## Tworzenie Rose

```{r}
rose <- data.frame(

  class = factor("1st", levels = c("1st", "2nd", "3rd", "deck crew", "engineering crew", "restaurant staff", "victualling crew")),

  gender = factor("female", levels = c("female", "male")),

  age = 17,

  sibsp = 0,

  parch = 1,

  fare = 850,

  embarked = factor("Southampton", levels = c("Belfast", "Cherbourg", "Queenstown", "Southampton"))

)
```

# Wasza kolej żeby stworzyć swoją postać 

```{r}
#twoje_imie <- data.frame(

  #class = factor(, levels = c("1st", "2nd", "3rd", "deck crew", "engineering crew", "restaurant staff", "victualling crew")),

  #gender = factor(, levels = c("female", "male")),

  #age = ,

  #sibsp = ,

  #parch = ,

  #fare = ,

  #embarked = factor(, levels = c("Belfast", "Cherbourg", "Queenstown", "Southampton"))

#)

```
 
# Zobaczmy Jacka , Rose oraz waszą postac w zbiorze 

```{r}
{
print(jack)
print(rose)
#print(twoje_imie)
}
```


```{r}
#str(archivist::aread("pbiecek/models/e3596"))

#str(jack)

```

# Przewidywania modeli dla naszych pasażerów

## Wyliczmy przewidywania  dla Jack'a

```{r}
pred_lmr <- predict(titanic_lmr_exp, jack)
pred_rf <- predict(titanic_rf_exp, jack)
pred_gbm <- predict(titanic_gbm_exp, jack)
pred_svm <- predict(titanic_svm_exp, jack)
```

### Wyniki

```{r}
cat("Model regresji logistycznej przewiduje:", round(pred_lmr, 3),
    "-> Jack ma", round(pred_lmr * 100, 1), "% szans na przeżycie\n")

cat("Model random forest przewiduje:", round(pred_rf, 3),
    "-> Jack ma", round(pred_rf * 100, 1), "% szans na przeżycie\n")

cat("Model GBM przewiduje:", round(pred_gbm, 3),
    "-> Jack ma", round(pred_gbm * 100, 1), "% szans na przeżycie\n")
cat("Model SVM przewiduje:", round(pred_svm, 3),
    "-> Jack ma", round(pred_svm * 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 * 100, 1), "% szans na przeżycie\n")

cat("Model GBM przewiduje:", round(pred_gbm_r, 3),
    "-> Rose ma", round(pred_gbm * 100, 1), "% szans na przeżycie\n")
cat("Model SVM przewiduje:", round(pred_svm_r, 3),
    "-> Rose ma", round(pred_svm * 100, 1), "% szans na przeżycie\n")

```
# Pora na wykresy :)


## Pytanie : 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")
```