Merge pull request #3 from mini-pw/main

AS

Author: janusd33

Materialy/Lab8/Lab8.ipynb

@@ -0,0 +1,117 @@
+---
+title: "PD3 Chylak Maciej"
+output:
+  html_document:
+    df_print: paged
+
+---
+
+```{r setup, include=FALSE}
+knitr::opts_chunk$set(echo = TRUE)
+library(dplyr)
+library(ggplot2)
+library(gridExtra)
+library(DALEX)
+library(DALEXtra)
+library(data.table)
+library(OpenML)
+library(ceterisParibus)
+
+set.seed(seed = 123)
+```
+
+##### Wczytanie zbioru danych
+
+```{r message=FALSE}
+df <- OpenML::getOMLDataSet(data.id = 42225)
+df <-  df$data
+
+```
+
+
+##### Dane:
+
+
+
+##### Przygotowanie naszego zbioru danych do dalszej analizy. Zamienienie kolumny cut na wartosci numeryczne, skala oceny ciecia
+
+```{r}
+df <- df[, c(1, 2, 3, 4, 5, 6, 8, 9, 10, 7)]
+
+df$cut <- ifelse(df$cut=="Fair", 0, ifelse(df$cut=="Good", 1, 
+                                           ifelse(df$cut=="Very Good", 2, 
+                                                  ifelse(df$cut=="Premium", 4, 5))))
+colnames(df) <- c(colnames(df[1:6]), "x_mes", "y_mes", "z_mes", "price")
+df
+```
+
+
+##### Podzielenie naszego zbioru danych na zbiór treninigowy i walidacyjny
+
+```{r essage=FALSE}
+dt <- sort(sample(nrow(df), nrow(df)*.7))
+Train <- df[dt, ]
+Valid <- df[-dt, ]
+```
+
+##### Stworzenie modelu na zbiorze treningowym
+
+```{r essage=FALSE}
+model <- ranger::ranger(price~., data=Train)
+model
+
+```
+
+##### Stworzenie explainera, który posluzy nam pozniej do wyjasnienia modelu 
+
+```{r essage=FALSE}
+explainer <- explain(model = model, 
+                     data = Train[, -10],
+                     y = Train$price)
+```
+
+```{r}
+model_type.dalex_explainer <- DALEXtra::model_type.dalex_explainer
+predict_model.dalex_explainer <- DALEXtra::predict_model.dalex_explainer
+```
+
+
+##### Obliczenie korelacji, a nastepnie zaprezentowanie ich na wykresie
+
+```{r}
+library(corrplot)
+
+res <- cor(df[, c(1, 2, 5, 6, 7, 8, 9)])
+round(res, 2)
+```
+
+##### Jak mozemy zauwazyc, szczegolnie zmienne wymiarow diamentu sa z soba silne skorelowane, moze to zaburzyc nieco nasze ostateczne wyniki, gdyz ten model dekompozycji jest szczegolnie wrazliwy na skorelowane zmienne.
+
+
+##### Wyjasnienie przy pomocy metody ceteris paribus
+
+##### Skupimy sie wokol zmiennej cut oznaczajacej jakos ciecia (1-najgorsze, 5-najlepsze), gdyz jest ona najmniej skorelowana z pozostalymi zmiennymi
+
+
+```{r}
+cp_1 <- ceteris_paribus(explainer, observation = Valid[50, -10], variables = "cut")
+plot(cp_1) + ggtitle("Ceteris paribus 1") 
+```
+
+Na pierwszym wykresie mozemy zauwazyc spodziewany wynik, wartosc diamentow rosnie wraz z jakoscia ciecia. Podobnego rozkladu powinnismy sie spodziewac takze przy pozostalych zmiennych
+
+
+
+```{r}
+cp_2 <- ceteris_paribus(explainer, observation = Valid[200, -10], variables = "cut")
+plot(cp_2) + ggtitle("Ceteris paribus 2")
+
+```
+
+```{r}
+Valid[200, ]
+```
+
+W tym przypadku mozemy zauwazyc dosyc nieoczywista zaleznosc. Wartosc diamentu osiaga swoje maksimum w przypadku gdy jego jakos wynosi 2, natomiast swoje minimum osiaga w punkcie, w ktorym jakos diamentu wynosi 4. Skad wynika taka zaleznosc? Ciezko dokladnie powiedziec, najprawdopodobniej jest ona spowodowana specyfika naszych danych lub z niedokladnosci naszej metody. Na pewno nie powinnismy sugerowac doborem cen w przypadku cech rownych pozostalym cecha naszej wybranej obserwacji, gdyz w dosc nieintuicyjny sposob oszacowalibysmy cene.
+
+Jednak chcialbym rowniez zaznaczyc, ze w wiekszosc przypadkow model zachowal sie w sposob przewidywalny, zanim znalazlem te obserwacje sprawdzilem okolo 20-30 innych i w kazdej z nich wykres wygladal podobnie jak wykres nr 1. 

PraceDomowe/PracaDomowa3/Chylak_Maciej/PD3_chylak_maciej.Rmd

@@ -0,0 +1,129 @@
+---
+title: "Praca Domowa 3"
+author: "Klaudia Gruszkowska"
+output: html_document
+---
+
+```{r setup, include=FALSE}
+knitr::opts_chunk$set(echo = TRUE)
+```
+
+## Model
+
+### Wczytanie przygotowanych danych i podział na zbiór testowy i treningowy
+```{r,message=FALSE}
+library('randomForest')
+
+cleaned_housing <- read.csv("cleaned_housing.csv")
+head(cleaned_housing)
+cleaned_housing$NEAR.BAY = as.factor(cleaned_housing$NEAR.BAY)
+cleaned_housing$X.1H.OCEAN = as.factor(cleaned_housing$X.1H.OCEAN)
+cleaned_housing$INLAND = as.factor(cleaned_housing$INLAND)
+cleaned_housing$ISLAND = as.factor(cleaned_housing$ISLAND)
+cleaned_housing$NEAR.OCEAN = as.factor(cleaned_housing$NEAR.OCEAN)
+
+set.seed(1738)
+
+sample = sample.int(n = nrow(cleaned_housing), size = floor(.8*nrow(cleaned_housing)), replace = F)
+train = cleaned_housing[sample, ] 
+test  = cleaned_housing[-sample, ] 
+
+train_y = train[,'median_house_value']
+train_x = train[, names(train) !='median_house_value']
+```
+
+### Model lasu losowego
+```{r,message=FALSE}
+
+rf_model = randomForest(train_x, y = train_y , ntree = 500, importance = TRUE)
+
+```
+
+## Predykcja modelu
+
+Wybieram obserwację pierwszą i sprawdzę jaką predykcję wylicza zaproponowany model lasu losowego:
+
+```{r}
+y_pred = predict(rf_model, newdata = cleaned_housing[1,])
+y_pred
+```
+
+Rzeczywista wartość dla tej obserwacji:
+
+```{r}
+cleaned_housing[1,'median_house_value']
+```
+
+## Dekompozycja predykcji modelu Ceteris Paribus
+
+Do dekompozycji predykcji modelu użyję profili Ceteris Paribus:
+
+```{r,message=FALSE}
+library(DALEX)
+library(DALEXtra)
+
+
+explainer <- DALEX::explain(model = rf_model,
+                     data = cleaned_housing[, -14],
+                     y = cleaned_housing[, 14], 
+                     colorize=FALSE,
+                     label = "Random Forest")
+```
+
+```{r}
+
+cp_california_rf <- predict_profile(explainer = explainer, 
+                           new_observation = cleaned_housing[1,])
+```
+
+```{r,message=FALSE}
+library("ggplot2")
+plot(cp_california_rf) +
+  ggtitle("Ceteris-paribus profile", "")
+```
+
+Najbardziej zróżnicowany wykres otrzymujemy dla zmiennej median_income czyli mediany wynagrodzenia na gospodarstwo domowe, co pokrywa się z EDA, wcześniejszymi analizami (Break Down, SHAP, lime), które wskazywały tą zmienną jako tą z największym wpływem na predykcję oraz wydaje się to logiczne ze względu na to, że może wskazywać na "bogatą" lub "biedną" dzielnicę. Przy reszcie zmiennych widzimy tylko niewielkie różnice w wartościach predykcji dla zmien tych zmiennych.Co może wydawać się dziwne ale przy wzroście mean_bedrooms i mean_rooms  nie widać wzrostu predykcji. A taki wzrost byłby zgodny z logiką, że im większa liczba pokoi tym większy dom a im większa średnia ilość pokoi w dzielnicy tym 
+ta dzielnica jest bogatsza (większe domy np wille). Jednak takie zachowanie może być związane obcięciem naszej zmiennej celu (z EDA wiemy, że median_house_value została obcięta do wartości 500001). Dodatkowo innym wytłumaczeniem może być to, że nasza zmienna mean_bedrooms jest mocno skorelowana z mean_rooms co prowadzi do dziwnych i nierealnych sytuacji gdy przy dość niskiej wartości mean_bedrooms sprawdzamy wysokie mean_rooms.
+
+```{r}
+
+cp_california_bedrooms <- predict_profile(explainer = explainer, 
+                           new_observation = cleaned_housing[1,], variables = "mean_rooms")
+
+plot(cp_california_bedrooms,variables = "mean_rooms") +
+  ggtitle("Ceteris-paribus profile", "")
+
+```
+
+```{r}
+plot(cp_california_rf, variable_type = "categorical", categorical_type = "bars") +
+  ggtitle("Ceteris-paribus profile", "")
+```
+
+Dla tych powyższych zmiennych, które oznaczają odległość od oceanu zmiany tych zmiennych oznaczają coś co nie jest w stanie zaistnieć w rzeczywistości, dla zmiennej NEAR.BAY = 1 oznaczającej bycie blisko zatoki rozważanie np wartości INLAND = 1 jest nielogiczne. Nie może być dom położony nad zatoką i równocześnie w głębi lądu.
+
+```{r}
+
+cp_california_2 <- predict_profile(explainer = explainer, 
+                           new_observation = cleaned_housing[2000,])
+
+plot(cp_california_2) +
+  ggtitle("Ceteris-paribus profile", "")
+
+```
+
+```{r}
+
+cp_california_2 <- predict_profile(explainer = explainer, 
+                           new_observation = cleaned_housing[2000,], variables = "mean_rooms")
+
+plot(cp_california_2,variables = "mean_rooms") +
+  ggtitle("Ceteris-paribus profile", "")
+
+```
+
+Porównując obserwację pierwszą z obserwacją przedstawioną powyżej możemy zauważyć, że kilka wykresów zmiennych wygląda inaczej np langitude lub longitude. Przyjżyjmy się jednak zmiennej mean_rooms . W tym przypadku widać, że przy lekkim zmniejszeniu tej zmniejszej otrzymamy większe wartości predykcji. Przy obserwacji pierwszej nie ma takiej anomalii. Wykres zmiennej mean_bedrooms też ma taki wzrost. W tym wypadku może to mieć również związek z np. sytuacją gdy wartości zmiennej określającej ilość pokoi byłaby mniejsza od wartości ilości sypialni. Jest to niezbyt realna sytuacja, może to prowadzi do błędu predykcji.  
+
+## Wnioski
+
+Niestety w tym przypadku profile Ceteris Paribus nie sprawdzają się dobrze ponieważ mamy do czynienia ze zmiennymi zależnymi (wiemy to z EDA), a w takim przypadku dochodzimy do dziwnych, nierealnych sytuacji gdy np. dany dom położony jest i blisko  oceanu i w głębi lądu albo ma niską średnią liczbę pokoi a wysoką średnią liczbę sypialni. Przez to nie wszystkie anomalie jesteśmy w stanie wytłumaczyć na podstawie danych.