|
1 |
| ---- |
2 |
| -title: "Untitled" |
3 |
| -output: |
4 |
| - pdf_document: default |
5 |
| ---- |
6 |
| - |
7 |
| -```{r setup, include=FALSE} |
8 |
| -knitr::opts_chunk$set(echo = TRUE) |
9 |
| -library(dplyr) |
10 |
| -library(ggplot2) |
11 |
| -library(data.table) |
12 |
| -library(gridExtra) |
13 |
| -library(DALEX) |
14 |
| -library(DALEXtra) |
15 |
| -``` |
16 |
| - |
17 |
| -##### Wczytanie zbioru danych |
18 |
| - |
19 |
| -```{r } |
20 |
| -df <- OpenML::getOMLDataSet(data.id = 42225) |
21 |
| -df <- df$data |
22 |
| -df |
23 |
| -``` |
24 |
| - |
25 |
| - |
26 |
| -##### Dane: |
27 |
| - |
28 |
| - |
29 |
| - |
30 |
| -##### Przygotowanie naszego zbioru danych do dalszej analizy. Zamienienie kolumny cut na wartosci numeryczne, skala oceny ciecia |
31 |
| - |
32 |
| -```{r} |
33 |
| -
|
34 |
| -df <- df[, c(1, 2, 3, 4, 5, 6, 8, 9, 10, 7)] |
35 |
| -df$cut <- ifelse(df$cut=="Fair", 0, ifelse(df$cut=="Good", 1, |
36 |
| - ifelse(df$cut=="Very Good", 2, |
37 |
| - ifelse(df$cut=="Premium", 4, 5)))) |
38 |
| -colnames(df) <- c(colnames(df[1:6]), "x_mes", "y_mes", "z_mes", "price") |
39 |
| -df |
40 |
| -``` |
41 |
| - |
42 |
| - |
43 |
| -##### Podzielenie naszego zbioru danych na zbiór treninigowy i walidacyjny |
44 |
| - |
45 |
| -```{r} |
46 |
| -dt <- sort(sample(nrow(df), nrow(df)*.7)) |
47 |
| -Train <- df[dt, ] |
48 |
| -Valid <- df[-dt, ] |
49 |
| -``` |
50 |
| - |
51 |
| -##### Stworzenie modelu na zbiorze treningowym |
52 |
| - |
53 |
| -```{r} |
54 |
| -model <- ranger::ranger(price~., data=Train) |
55 |
| -model |
56 |
| -
|
57 |
| -``` |
58 |
| - |
59 |
| -##### Stworzenie explainera, który posluzy nam pozniej do wyjasnienia modelu |
60 |
| - |
61 |
| -```{r} |
62 |
| -explainer <- explain(model = model, |
63 |
| - data = Train[, -10], |
64 |
| - y = Train$price) |
65 |
| -``` |
66 |
| - |
67 |
| - |
68 |
| - |
69 |
| -##### Wyjasnienie przy pomocy metody break down i shap dwoch dowolnych wierszy |
70 |
| - |
71 |
| -```{r} |
72 |
| -df_bd_0 <- predict_parts(explainer, new_observation = Valid[1, ], type="break_down") |
73 |
| -plot(df_bd_0) |
74 |
| -``` |
75 |
| - |
76 |
| -```{r} |
77 |
| -df_shap_0 <- predict_parts(explainer, new_observation = Valid[2,], type = "shap", B = 10) |
78 |
| -plot(df_shap_0) |
79 |
| -``` |
80 |
| - |
81 |
| - |
82 |
| - |
83 |
| - |
84 |
| -##### Dwie obserwacje ze zbioru danych, które maja inne najważniejsze zmienne: |
85 |
| - |
86 |
| -```{r} |
87 |
| -df_bd_1 <- predict_parts(explainer, new_observation = Valid[2000, ], type="break_down") |
88 |
| -plot(df_bd_1) |
89 |
| -``` |
90 |
| - |
91 |
| -```{r} |
92 |
| -df_bd_2 <- predict_parts(explainer, new_observation = Valid[30, ], type="break_down") |
93 |
| -plot(df_bd_2) |
94 |
| -``` |
95 |
| - |
96 |
| -W przypadku pierwszej obserwacji do najwazniejszych zmiennych naleza carat oraz color, natomiast w przypadku drugiej obserwacji jest to carat oraz y_mes. Przegladajac wieksza liczbe obserwacji mozemy zauwazyc, ze te trzy zmienne w glownej mierze definiuja ostateczna cene diamentu. Reszta parametrow z reguly ma duzo mniejsze znaczenie. |
97 |
| - |
98 |
| - |
99 |
| - |
100 |
| -##### Dwie obserwacje które dla tych samych zmiennych maja inne efekty (carat) |
101 |
| - |
102 |
| -```{r} |
103 |
| -df_bd_3 <- predict_parts(explainer, new_observation = Valid[1, ], type="break_down") |
104 |
| -plot(df_bd_3) |
105 |
| -``` |
106 |
| - |
107 |
| -```{r} |
108 |
| -df_bd_4 <- predict_parts(explainer, new_observation = Valid[2000, ], type="break_down") |
109 |
| -plot(df_bd_4) |
110 |
| -``` |
111 |
| - |
112 |
| -Oczywiscie rezultat jest taki, poniewaz w przypadku pierwszej obserwacji cena diamentu byla duzo mniejsza niz srednia, natomiast w przypadku drugim duzo wieksza |
| 1 | +--- |
| 2 | +title: "Untitled" |
| 3 | +output: |
| 4 | + html_document: |
| 5 | + df_print: paged |
| 6 | + |
| 7 | +--- |
| 8 | + |
| 9 | +```{r setup, include=FALSE} |
| 10 | +knitr::opts_chunk$set(echo = TRUE) |
| 11 | +library(dplyr) |
| 12 | +library(ggplot2) |
| 13 | +library(data.table) |
| 14 | +library(gridExtra) |
| 15 | +library(DALEX) |
| 16 | +library(DALEXtra) |
| 17 | +``` |
| 18 | + |
| 19 | +##### Wczytanie zbioru danych |
| 20 | + |
| 21 | +```{r } |
| 22 | +df <- OpenML::getOMLDataSet(data.id = 42225) |
| 23 | +df <- df$data |
| 24 | +df |
| 25 | +``` |
| 26 | + |
| 27 | + |
| 28 | +##### Dane: |
| 29 | + |
| 30 | + |
| 31 | + |
| 32 | +##### Przygotowanie naszego zbioru danych do dalszej analizy. Zamienienie kolumny cut na wartosci numeryczne, skala oceny ciecia |
| 33 | + |
| 34 | +```{r} |
| 35 | +
|
| 36 | +df <- df[, c(1, 2, 3, 4, 5, 6, 8, 9, 10, 7)] |
| 37 | +df$cut <- ifelse(df$cut=="Fair", 0, ifelse(df$cut=="Good", 1, |
| 38 | + ifelse(df$cut=="Very Good", 2, |
| 39 | + ifelse(df$cut=="Premium", 4, 5)))) |
| 40 | +colnames(df) <- c(colnames(df[1:6]), "x_mes", "y_mes", "z_mes", "price") |
| 41 | +df |
| 42 | +``` |
| 43 | + |
| 44 | + |
| 45 | +##### Podzielenie naszego zbioru danych na zbiór treninigowy i walidacyjny |
| 46 | + |
| 47 | +```{r} |
| 48 | +dt <- sort(sample(nrow(df), nrow(df)*.7)) |
| 49 | +Train <- df[dt, ] |
| 50 | +Valid <- df[-dt, ] |
| 51 | +``` |
| 52 | + |
| 53 | +##### Stworzenie modelu na zbiorze treningowym |
| 54 | + |
| 55 | +```{r} |
| 56 | +model <- ranger::ranger(price~., data=Train) |
| 57 | +model |
| 58 | +
|
| 59 | +``` |
| 60 | + |
| 61 | +##### Stworzenie explainera, który posluzy nam pozniej do wyjasnienia modelu |
| 62 | + |
| 63 | +```{r} |
| 64 | +explainer <- explain(model = model, |
| 65 | + data = Train[, -10], |
| 66 | + y = Train$price) |
| 67 | +``` |
| 68 | + |
| 69 | + |
| 70 | + |
| 71 | +##### Wyjasnienie przy pomocy metody break down i shap dwoch dowolnych wierszy |
| 72 | + |
| 73 | +```{r} |
| 74 | +df_bd_0 <- predict_parts(explainer, new_observation = Valid[1, ], type="break_down") |
| 75 | +plot(df_bd_0) |
| 76 | +``` |
| 77 | + |
| 78 | +```{r} |
| 79 | +df_shap_0 <- predict_parts(explainer, new_observation = Valid[2,], type = "shap", B = 10) |
| 80 | +plot(df_shap_0) |
| 81 | +``` |
| 82 | + |
| 83 | + |
| 84 | + |
| 85 | + |
| 86 | +##### Dwie obserwacje ze zbioru danych, które maja inne najważniejsze zmienne: |
| 87 | + |
| 88 | +```{r} |
| 89 | +df_bd_1 <- predict_parts(explainer, new_observation = Valid[2000, ], type="break_down") |
| 90 | +plot(df_bd_1) |
| 91 | +``` |
| 92 | + |
| 93 | +```{r} |
| 94 | +df_bd_2 <- predict_parts(explainer, new_observation = Valid[30, ], type="break_down") |
| 95 | +plot(df_bd_2) |
| 96 | +``` |
| 97 | + |
| 98 | +W przypadku pierwszej obserwacji do najwazniejszych zmiennych naleza carat oraz color, natomiast w przypadku drugiej obserwacji jest to carat oraz y_mes. Przegladajac wieksza liczbe obserwacji mozemy zauwazyc, ze te trzy zmienne w glownej mierze definiuja ostateczna cene diamentu. Reszta parametrow z reguly ma duzo mniejsze znaczenie. |
| 99 | + |
| 100 | + |
| 101 | + |
| 102 | +##### Dwie obserwacje które dla tych samych zmiennych maja inne efekty (carat) |
| 103 | + |
| 104 | +```{r} |
| 105 | +df_bd_3 <- predict_parts(explainer, new_observation = Valid[1, ], type="break_down") |
| 106 | +plot(df_bd_3) |
| 107 | +``` |
| 108 | + |
| 109 | +```{r} |
| 110 | +df_bd_4 <- predict_parts(explainer, new_observation = Valid[2000, ], type="break_down") |
| 111 | +plot(df_bd_4) |
| 112 | +``` |
| 113 | + |
| 114 | +Oczywiscie rezultat jest taki, poniewaz w przypadku pierwszej obserwacji cena diamentu byla duzo mniejsza niz srednia, natomiast w przypadku drugim duzo wieksza |
0 commit comments