---
title: "RandomForest"
author: "Szymon Maksymiuk"
date: "4 11 2019"
output:
  html_document:
    df_print: paged
    toc: true
    toc_float: true
    code_folding: hide
    number_sections: true
    theme: spacelab
---

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

# Wstęp

Poniżej przedstawię 110 różnych wyjaśnień dla naszego zbioru. Będą to wyjaśnienia lokalne, a więc pokazujące jak poszczególne cechy danej obserwacji wpływały na odpowiedź modelu. Aby zachować balans między klasami, wezmę pierwsze 54 obserwacji z niezależnością, 3 ze sprzecznością oraz 33 z wynikaniem, zgodnie z ich rozłożeniem w zbiorze. Dla wszystkich obserwacji mujętych w tej sekcji, model poprawnie przewidział typ relacji. W kolejnej sekcji podam 10 obserwacji dla których model się pomylił. Warto zazanczyć, że dla każdej obserwacji pojawią się 3 wykresy, każdy z nich pokaże jak zmienne wpływały na decyzje w obrębie danej klasy.

Model którego użyłem to gbm z wytrenowanymi hiperparametrami. Miarą straty, której użyłem szukając najlepszego modelu było macro weighted averaging Precission, a więc metryka Precission zastosowana dla każdej z klas (na zasadzie 1 przeciw wszystkim) oraz uśredniona względem wag będących licznościami danej klasy. Wynik wynosił około 0.87 przy podobnym accuracy.

Słówko o samym wykresie choć zdaje mi się bardzo intuicyjny. Intercept oznacza średnią odpowiedź modelu dla danej klasy. Słupki pokazują jak wartości poszczególnych zmiennych wływają sie odchylenie od owej średniej.

```{r warning=FALSE, message=FALSE}
library(dplyr)
library(forcats)
dane_2911 <- as.data.frame(readxl::read_xlsx("PL_zbior_29.11.2019.xlsx"))
dane_2911 <- select(dane_2911, T, `verb - semantic class`, `verb - tense`,
                    `verb`, `verb - veridical (positive enviroment)`,`T - negation`,  `T - type of sentence`,
                     `complement - tense`,  `verb - veridical (negative enviroment)`,
                    `GOLD <T,H>`)
colnames(dane_2911) <- make.names(colnames(dane_2911))

data <- dane_2911
for (i in 2:ncol(data)) {
  data[,i] <- as.factor(data[,i])
}
data$verb <- fct_lump(as.factor(data$verb), 30)
data <- data[data$GOLD..T.H. != "?",]
data <- na.omit(data)
data$GOLD..T.H. <- as.factor(as.character(data$GOLD..T.H.))
m <- sample(1:nrow(data), 0.7*nrow(data))
data_train <- data[m,]
data_test <- data[-m,]


library(randomForest)
  model <- randomForest(x = data_train[,-c(1,10)], y = data_train$GOLD..T.H., ntree = 2000, mtry = 2, type = "prob")


custom_predict <- function(X.model, newdata){
predict(X.model, newdata = newdata, type = "prob")
}

library(DALEX)
explainer <- explain(model, data = data_test[,-c(1, 10)], y = data_test$GOLD..T.H., predict_function = custom_predict,
                     verbose = FALSE, precalculate = FALSE, colorize = FALSE, label = "Random Forest (ntree = 2000, mtry = 2)")
```

# Wyjaśnienia (model poprawnie przewidział klasę)

## C

```{r}
new_observations_niez <- data_test[which(as.data.frame(predict(model, newdata = data_test[,-1], type = "prob"))[,1]>0.5),]
new_observations_niez <- new_observations_niez[new_observations_niez$GOLD..T.H. == "C",][1:3,]
library(iBreakDown)
for (i in 1:3) {
  cat(as.character(new_observations_niez[i,1]))
  print(plot(break_down(explainer, new_observations_niez[i,-1])))
  cat("\n")
}
```

## E

```{r}
new_observations_sp <- data_test[which(as.data.frame(predict(model, newdata = data_test[,-1], type = "prob"))[,2]>0.5),]
new_observations_sp <- new_observations_sp[new_observations_sp$GOLD..T.H. == "E",][1:33,]
library(iBreakDown)
for (i in 1:33) {
  cat(as.character(new_observations_sp[i,1]))
  print(plot(break_down(explainer, new_observations_sp[i,-1])))
  cat("\n")
}
```

## N

```{r}
new_observations_wy <- data_test[which(as.data.frame(predict(model, newdata = data_test[,-1], type = "prob"))[,3]>0.5),]
new_observations_wy <- new_observations_wy[new_observations_wy$GOLD..T.H. == "N",][1:54,]
library(iBreakDown)
for (i in 1:54) {
  cat(as.character(new_observations_wy[i,1]))
  print(plot(break_down(explainer, new_observations_wy[i,-1])))
  cat("\n")
}
```

# Wyjaśnienia (model błędnie przewidział klasę)

## C (przewidziane błędnie)

```{r}
new_observations_niez <- data_test[which(as.data.frame(predict(model, newdata = data_test[,-1], type = "prob"))[,1]>0.5),]
new_observations_niez <- new_observations_niez[new_observations_niez$GOLD..T.H. != "C",][1,]
library(iBreakDown)
for (i in 1:1) {
  if(nrow(new_observations_niez) == 0 ) break()
  cat(as.character(new_observations_niez[i,1]), "| true label:", as.character(new_observations_niez[i,]$GOLD..T.H.))
  print(plot(break_down(explainer, new_observations_niez[i,-1])))
  cat("\n")
}
```

## E (przewidziane błędnie)

```{r}
new_observations_sp <- data_test[which(as.data.frame(predict(model, newdata = data_test[,-1], type = "prob"))[,2]>0.5),]
new_observations_sp <- new_observations_sp[new_observations_sp$GOLD..T.H. != "E",][1:3,]
library(iBreakDown)
for (i in 1:3) {
  if(nrow(new_observations_sp) == 0 ) break()
  cat(as.character(new_observations_sp[i,1]), "| true label:", as.character(new_observations_sp[i,]$GOLD..T.H.))
  print(plot(break_down(explainer, new_observations_sp[i,-1])))
  cat("\n")
}
```

## N (przewidziane błędnie)

```{r}
new_observations_wy <- data_test[which(as.data.frame(predict(model, newdata = data_test[,-1], type = "prob"))[,3]>0.5),]
new_observations_wy <- new_observations_wy[new_observations_wy$GOLD..T.H. != "N",][1:6,]
library(iBreakDown)
for (i in 1:6) {
  if(nrow(new_observations_wy) == 0 ) break()
  cat(as.character(new_observations_wy[i,1]), "| true label:", as.character(new_observations_wy[i,]$GOLD..T.H.))
  print(plot(break_down(explainer, new_observations_wy[i,-1])))
  cat("\n")
}
```