---
title: "DSTG - projekt2023"
output: 
  flexdashboard::flex_dashboard:
    social: menu
    orientation: columns
    vertical_layout: fill
    source_code: embed
---

```{css, echo=FALSE}
.sidebar { overflow: auto; }
.dataTables_scrollBody {
    height:95% !important;
    max-height:95% !important;
}
.chart-stage-flex {
    overflow:auto !important;
}
```

```{r setup, include=FALSE}
library(psych)
library(tidyverse)
library(readxl)
library(tidymodels)
library(vip)
library(knitr)
library(kableExtra)
library(Boruta)
library(ggbump)
library(ggsankey)
library(ggridges)
library(corrplot)
library(ggsankey)
library(rpart.plot)
library(kableExtra)
library(DALEXtra)

rf_metrike <- metric_set(roc_auc, sens, precision, spec, accuracy, f_meas, mcc, kap, mn_log_loss)
update_geom_defaults(geom = "tile", new = list(color = "black"))

Zadavanje_fit <- readRDS("modeli/RF_fit_Zadavanje.rds")
Zadavanje_tuning <- readRDS("modeli/RF_tuning_Zadavanje.rds")
Zadavanje_work <- readRDS("modeli/RF_work_Zadavanje.rds")
Zadavanje_permfit <- readRDS("modeli/RFperm_fit_Zadavanje.rds")
Zadavanje_Boruta <- readRDS("modeli/Boruta_Zadavanje.rds")

Zadavanje_fit_tree <- readRDS("modeli/stablo_fit_Zadavanje.rds")
Zadavanje_tuning_tree <- readRDS("modeli/stablo_tuning_Zadavanje.rds")
Zadavanje_work_tree <- readRDS("modeli/stablo_work_Zadavanje.rds")

Rjesavanje_fit <- readRDS("modeli/RF_fit_Rjesavanje.rds")
Rjesavanje_tuning <- readRDS("modeli/RF_tuning_Rjesavanje.rds")
Rjesavanje_work <- readRDS("modeli/RF_work_Rjesavanje.rds")
Rjesavanje_permfit <- readRDS("modeli/RFperm_fit_Rjesavanje.rds")
Rjesavanje_Boruta <- readRDS("modeli/Boruta_Rjesavanje.rds")

Rjesavanje_fit_tree <- readRDS("modeli/stablo_fit_Rjesavanje.rds")
Rjesavanje_tuning_tree <- readRDS("modeli/stablo_tuning_Rjesavanje.rds")
Rjesavanje_work_tree <- readRDS("modeli/stablo_work_Rjesavanje.rds")

Procjena_fit <- readRDS("modeli/RF_fit_Procjena.rds")
Procjena_tuning <- readRDS("modeli/RF_tuning_Procjena.rds")
Procjena_work <- readRDS("modeli/RF_work_Procjena.rds")
Procjena_permfit <- readRDS("modeli/RFperm_fit_Procjena.rds")
Procjena_Boruta <- readRDS("modeli/Boruta_Procjena.rds")

Procjena_fit_tree <- readRDS("modeli/stablo_fit_Procjena.rds")
Procjena_tuning_tree <- readRDS("modeli/stablo_tuning_Procjena.rds")
Procjena_work_tree <- readRDS("modeli/stablo_work_Procjena.rds")

podaci <- read_excel("podaci/DSTG_projekt2023.xlsx") %>%
  mutate_at(vars(KP1:Procjena), as.numeric) %>%
  filter(Status == "redovni", Upis == "prvi upis") %>%
  mutate(KVIZ = rowSums(across(KP1:KP10))) %>%
  select(KVIZ, KOL1, KOL2, Zadavanje, Rjesavanje, Procjena, UKUPNO)

testRes <- cor.mtest(podaci, conf.level = 0.975)

qvant <- podaci %>% reframe(across(KVIZ:UKUPNO, ~quantile(., prob = c(0,0.33,0.67,1)))) %>%
  mutate(prob = c('0%', '33%', '67%', '100%')) %>% relocate(prob)

podaci_sankey <- podaci %>%  replace(is.na(.), 0) %>% select(KOL1:KOL2, Zadavanje, Rjesavanje, Procjena) %>%
  mutate(KOL1 = case_when(KOL1 <= pull(qvant[2, "KOL1"]) ~ "1", 
                          KOL1 <= pull(qvant[3, "KOL1"]) ~ "2",
                          .default = "3"),
         KOL2 = case_when(KOL2 <= pull(qvant[2, "KOL2"]) ~ "1", 
                          KOL2 <= pull(qvant[3, "KOL2"]) ~ "2",
                          .default = "3"),
         Zadavanje = case_when(Zadavanje <= pull(qvant[2, "Zadavanje"]) ~ "1", 
                               Zadavanje <= pull(qvant[3, "Zadavanje"]) ~ "2",
                               .default = "3"),
         Rjesavanje = case_when(Rjesavanje <= pull(qvant[2, "Rjesavanje"]) ~ "1",
                                Rjesavanje <= pull(qvant[3, "Rjesavanje"]) ~ "2",
                                .default = "3"),
         Procjena = case_when(Procjena <= pull(qvant[2, "Procjena"]) ~ "1", 
                              Procjena <= pull(qvant[3, "Procjena"]) ~ "2",
                              .default = "3")) %>%
  mutate_at(vars(KOL1:Procjena), ~fct_relevel(., c("1","2","3"))) %>%
  make_long(KOL1, KOL2, Zadavanje, Rjesavanje, Procjena)

postoci <- podaci_sankey %>% group_by(x, node) %>% summarize(n = n()) %>% 
  ungroup(node) %>% mutate(pct2 = n / sum(n) * 100, pct = round(pct2))

podaci_sankey <- podaci_sankey %>% left_join(postoci, by = c("x","node"))

podaci_long <- podaci %>% 
  pivot_longer(everything(), names_to = "varijabla", values_to = "vrijednost")

DSTG_blank <- data.frame(
  varijabla = factor(rep(c("KOL1", "KOL2", "KVIZ", "Procjena", 
                           "Rjesavanje", "UKUPNO", "Zadavanje"), each = 2)),
  x = c(0,30,0,30,0,10,0,3,0,18,0,100,0,9),
  y = 0
)

zadavanje_explainer <- explain_tidymodels(
  Zadavanje_fit %>% extract_workflow(),
  data = Zadavanje_work %>% select(KVIZ:KOL2),
  y = Zadavanje_work %>% select(Zadavanje),
  verbose = FALSE
)

pdp_zadavanje_all <- model_profile(
  zadavanje_explainer,
  variables = NULL,
  N = NULL
)

cond_zadavanje_all <- model_profile(
  zadavanje_explainer,
  variables = NULL,
  N = NULL,
  type = "conditional"
)

acc_zadavanje_all <- model_profile(
  zadavanje_explainer,
  variables = NULL,
  N = NULL,
  type = "accumulated"
)

ob2_zadavanje <- predict_parts(
  explainer = zadavanje_explainer, 
  new_observation = Zadavanje_work %>% select(KVIZ:KOL2) %>% slice(2)
  )

ob45_zadavanje <- predict_parts(
  explainer = zadavanje_explainer, 
  new_observation = Zadavanje_work %>% select(KVIZ:KOL2) %>% slice(45)
  )

ob88_zadavanje <- predict_parts(
  explainer = zadavanje_explainer, 
  new_observation = Zadavanje_work %>% select(KVIZ:KOL2) %>% slice(88)
  )

ob2_zadavanje_shap <- predict_parts(
  explainer = zadavanje_explainer, 
  new_observation = Zadavanje_work %>% select(KVIZ:KOL2) %>% slice(2),
  type = "shap",
  B = 20
)

ob45_zadavanje_shap <- predict_parts(
  explainer = zadavanje_explainer, 
  new_observation = Zadavanje_work %>% select(KVIZ:KOL2) %>% slice(45),
  type = "shap",
  B = 20
)

ob88_zadavanje_shap <- predict_parts(
  explainer = zadavanje_explainer, 
  new_observation = Zadavanje_work %>% select(KVIZ:KOL2) %>% slice(88),
  type = "shap",
  B = 20
)

krivulje_zadavanje <- as_tibble(pdp_zadavanje_all$agr_profiles) %>% mutate(vrsta = "PDP") %>%
  bind_rows(as_tibble(cond_zadavanje_all$agr_profiles) %>% mutate(vrsta = "M")) %>%
  bind_rows(as_tibble(acc_zadavanje_all$agr_profiles) %>% mutate(vrsta = "ALE"))

rjesavanje_explainer <- explain_tidymodels(
  Rjesavanje_fit %>% extract_workflow(),
  data = Rjesavanje_work %>% select(KVIZ:Zadavanje),
  y = Rjesavanje_work %>% select(Rjesavanje),
  verbose = FALSE
)

pdp_rjesavanje_all <- model_profile(
  rjesavanje_explainer,
  variables = NULL,
  N = NULL
)

cond_rjesavanje_all <- model_profile(
  rjesavanje_explainer,
  variables = NULL,
  N = NULL,
  type = "conditional"
)

acc_rjesavanje_all <- model_profile(
  rjesavanje_explainer,
  variables = NULL,
  N = NULL,
  type = "accumulated"
)

ob2_rjesavanje <- predict_parts(
  explainer = rjesavanje_explainer, 
  new_observation = Rjesavanje_work %>% select(KVIZ:Zadavanje) %>% slice(2)
  )

ob45_rjesavanje <- predict_parts(
  explainer = rjesavanje_explainer, 
  new_observation = Rjesavanje_work %>% select(KVIZ:Zadavanje) %>% slice(45)
  )

ob88_rjesavanje <- predict_parts(
  explainer = rjesavanje_explainer, 
  new_observation = Rjesavanje_work %>% select(KVIZ:Zadavanje) %>% slice(88)
  )

ob2_rjesavanje_shap <- predict_parts(
  explainer = rjesavanje_explainer, 
  new_observation = Rjesavanje_work %>% select(KVIZ:Zadavanje) %>% slice(2),
  type = "shap",
  B = 20
)

ob45_rjesavanje_shap <- predict_parts(
  explainer = rjesavanje_explainer, 
  new_observation = Rjesavanje_work %>% select(KVIZ:Zadavanje) %>% slice(45),
  type = "shap",
  B = 20
)

ob88_rjesavanje_shap <- predict_parts(
  explainer = rjesavanje_explainer, 
  new_observation = Rjesavanje_work %>% select(KVIZ:Zadavanje) %>% slice(88),
  type = "shap",
  B = 20
)

krivulje_rjesavanje <- as_tibble(pdp_rjesavanje_all$agr_profiles) %>% mutate(vrsta = "PDP") %>%
  bind_rows(as_tibble(cond_rjesavanje_all$agr_profiles) %>% mutate(vrsta = "M")) %>%
  bind_rows(as_tibble(acc_rjesavanje_all$agr_profiles) %>% mutate(vrsta = "ALE"))

procjena_explainer <- explain_tidymodels(
  Procjena_fit %>% extract_workflow(),
  data = Procjena_work %>% select(KVIZ:Rjesavanje),
  y = Procjena_work %>% select(Procjena),
  verbose = FALSE
)

pdp_procjena_all <- model_profile(
  procjena_explainer,
  variables = NULL,
  N = NULL
)

cond_procjena_all <- model_profile(
  procjena_explainer,
  variables = NULL,
  N = NULL,
  type = "conditional"
)

acc_procjena_all <- model_profile(
  procjena_explainer,
  variables = NULL,
  N = NULL,
  type = "accumulated"
)

ob2_procjena <- predict_parts(
  explainer = procjena_explainer, 
  new_observation = Procjena_work %>% select(KVIZ:Rjesavanje) %>% slice(2)
)

ob45_procjena <- predict_parts(
  explainer = procjena_explainer, 
  new_observation = Procjena_work %>% select(KVIZ:Rjesavanje) %>% slice(45)
)

ob88_procjena <- predict_parts(
  explainer = procjena_explainer, 
  new_observation = Procjena_work %>% select(KVIZ:Rjesavanje) %>% slice(88)
)

ob2_procjena_shap <- predict_parts(
  explainer = procjena_explainer, 
  new_observation = Procjena_work %>% select(KVIZ:Rjesavanje) %>% slice(2),
  type = "shap",
  B = 20
)

ob45_procjena_shap <- predict_parts(
  explainer = procjena_explainer, 
  new_observation = Procjena_work %>% select(KVIZ:Rjesavanje) %>% slice(45),
  type = "shap",
  B = 20
)

ob88_procjena_shap <- predict_parts(
  explainer = procjena_explainer, 
  new_observation = Procjena_work %>% select(KVIZ:Rjesavanje) %>% slice(88),
  type = "shap",
  B = 20
)

krivulje_procjena <- as_tibble(pdp_procjena_all$agr_profiles) %>% mutate(vrsta = "PDP") %>%
  bind_rows(as_tibble(cond_procjena_all$agr_profiles) %>% mutate(vrsta = "M")) %>%
  bind_rows(as_tibble(acc_procjena_all$agr_profiles) %>% mutate(vrsta = "ALE"))
```

# Distribucije varijabli {data-navmenu="DESKRIPTIVA"}

## Column 1

### Distribucije varijabli

```{r warning=FALSE, fig.width=18, fig.height=9}
ggplot(podaci_long, aes(x = vrijednost)) + 
  geom_histogram(aes(y=after_stat(density)), 
                 color="#ec8ae5", fill="#48d09b", alpha=0.7) +
  geom_density(alpha=.2, fill="yellow") + geom_blank(data = DSTG_blank, aes(x=x,y=y)) +
  scale_x_continuous(name = "bodovi") + 
  facet_wrap(vars(varijabla), scales = "free", ncol = 4) +
  geom_rug(alpha = 0.3)
```

# Korelacije {data-navmenu="DESKRIPTIVA"}

## Column 1

### Korelacije (redovni studenti, prvi upis)

```{r warning=FALSE, fig.width=10, fig.height=7}
corrplot(round(cor(podaci), 2), type = "lower",
         diag=FALSE, addCoef.col = 'black', tl.srt = 45)
```

## Column 2

### p-vrijednosti korelacija

```{r warning=FALSE, fig.width=10, fig.height=7}
corrplot(round(cor(podaci), 2), type = "lower",
         diag=FALSE, tl.srt = 45, p.mat = testRes$p, insig = 'p-value', sig.level = -1)
```

# Sankey dijagram {data-navmenu="DESKRIPTIVA"}

## Columnn 1

### Sankey dijagram (redovni studenti, prvi upis)

```{r warning=FALSE, fig.width=10, fig.height=7}
ggplot(podaci_sankey, aes(x = x, next_x = next_x, node = node, next_node = next_node,
                          fill = factor(node),
                          label = paste0(node, ' (', pct, '%)'))) +
  geom_sankey(flow.alpha = 0.5, node.color = "black", show.legend = FALSE) +
  geom_sankey_label(size = 3, color = "black", fill= "white", hjust = -0.35) +
  theme_bw() + theme_sankey(base_size = 16) +
  theme(axis.title = element_blank(), axis.text.y = element_blank(), 
        axis.ticks = element_blank(), panel.grid = element_blank())  
```

# Cronbach alpha {data-navmenu="DESKRIPTIVA"}

## Column 1

### Cronbach alpha

```{r}
psych::alpha(podaci, check.keys = TRUE)
```

# Opis modela {data-navmenu="ZADAVANJE"}

## Column 1

### Zadavanje problema (slučajna šuma)

**Prediktori**

- KVIZ - suma svih bodova na kvizovima
- KOL1 - ukupni broj bodova na prvom kolokviju
- KOL2 - ukupni broj bodova na drugom kolokviju

**Response** - Klasifikacija studenata na temelju broja bodova dobivenih na zadavanju problema

- **1** - ako je na zadavanju problema ukupni broj bodova unutar intervala [0%, 33%]
- **2** - ako je na zadavanju problema ukupni broj bodova unutar intervala (33%, 67%]
- **3** - ako je na zadavanju problema ukupni broj bodova unutar intervala (67%, 100%]

**Hiperparametri** - za odabir optimalne kombinacije hiperparametara napravljen je 
cross-validation s 10 *kutija* pri čemu je na slučajni način isprobano 5000 kombinacija 
hiperparametara *mtry*, *min_n* i *trees* preko uzorkovanja na latinskoj hiperkocki. 
Najbolji model je odabran s obzirom na *roc_auc* metriku.

- *mtry* - uvijek je jednak 2
- *trees* - uzimani su prirodni brojevi između 400 i 1500.
- *min_n* - uzimani su prirodni brojevi između 2 i 40.

### Zadavanje problema (stablo odlučivanja)

**Prediktori**

- KVIZ - suma svih bodova na kvizovima
- KOL1 - ukupni broj bodova na prvom kolokviju
- KOL2 - ukupni broj bodova na drugom kolokviju

**Response** - Klasifikacija studenata na temelju broja bodova dobivenih na zadavanju problema

- **1** - ako je na zadavanju problema ukupni broj bodova unutar intervala [0%, 33%]
- **2** - ako je na zadavanju problema ukupni broj bodova unutar intervala (33%, 67%]
- **3** - ako je na zadavanju problema ukupni broj bodova unutar intervala (67%, 100%]

**Hiperparametri** - za odabir optimalne kombinacije hiperparametara napravljen je 
cross-validation s 10 *kutija* pri čemu je na slučajni način isprobano 5000 kombinacija 
hiperparametara *tree_depth*, *min_n* i *cost_complexity* preko uzorkovanja na latinskoj hiperkocki.
Najbolji model je odabran s obzirom na *roc_auc* metriku.

- *tree_depth* - uzimani su prirodni brojevi između 1 i 15.
- *cost_complexity* - uzimani su realni brojevi između 1e-10 i 0.1.
- *min_n* - uzimani su prirodni brojevi između 2 i 40.

## Column 2

### 3-kvantili za kreiranje klasa

```{r}
qvant %>% kbl() %>%
  kable_paper("hover", full_width = F)
```

### summary

```{r}
summary(podaci) %>% kbl() %>%
  kable_paper("hover", full_width = F)
```

# hiperparametri - slučajna šuma {data-navmenu="ZADAVANJE"}

## Column 1

### Testirani hiperparametri

```{r}
Zadavanje_tuning %>%
  collect_metrics() %>%
  filter(.metric == "roc_auc", trees > 0) %>%
  pivot_longer(cols = trees:min_n) %>%
  mutate(best_mod = mean == max(mean)) %>% 
  ggplot(aes(x = value, y = mean)) +
  #geom_line(alpha = 0.5, size = 1.5) +
  geom_point(aes(color = best_mod), size = 0.3) +
  facet_wrap(~name, scales = "free_x") +
  scale_x_continuous() +
  labs(y = "roc auc", x = "", color = "Best Model")
```

## Column 2

### 20 najboljih modela za roc_auc metriku

```{r}
print(Zadavanje_tuning %>% show_best(metric = 'roc_auc', n = 20), n = 20)
```

# efikasnost - slučajna šuma {data-navmenu="ZADAVANJE"}

## Column 1

###  Metrike na testnom i trening skupu {data-height=200}

```{r}
tab1 <- Zadavanje_fit %>% collect_predictions() %>% 
  rf_metrike(truth = Zadavanje, estimate = .pred_class, .pred_1:.pred_3)
tab2 <- Zadavanje_work %>%
  rf_metrike(truth = Zadavanje, estimate = .pred_class, .pred_1:.pred_3)
tab1 %>% inner_join(tab2, by = ".metric") %>%
  select(.metric, .estimator = .estimator.x, trening = .estimate.y, test = .estimate.x)
```

### Confusion matrix

```{r}
Zadavanje_fit %>% collect_predictions() %>%
  conf_mat(truth = Zadavanje, estimate = .pred_class) %>% autoplot("heatmap") +
  scale_fill_gradient(low = "#87DEE7",
                       high = "#FFFFCC")
```

## Column 2

### ROC curve

```{r}
Zadavanje_fit %>% collect_predictions() %>% roc_curve(Zadavanje, .pred_1:.pred_3) %>% autoplot()
```

### Gain curve

```{r}
Zadavanje_fit %>% collect_predictions() %>% gain_curve(Zadavanje, .pred_1:.pred_3) %>% autoplot()
```

# važnost prediktora - slučajna šuma {data-navmenu="ZADAVANJE"}

## Columnn 1

### Gini

```{r}
Zadavanje_fit %>% extract_fit_parsnip() %>% vip()
```

### permutacija

```{r}
Zadavanje_permfit %>% extract_fit_parsnip() %>% vip()
```

## Column 2

### Boruta

```{r}
plot(Zadavanje_Boruta, cex.axis=.7, las=2, xlab="",
     colCode = c("green", "orange", "#f6546a", "#2acaea"))
```

### Boruta (history)

```{r}
plotImpHistory(Zadavanje_Boruta, colCode = c("green", "orange", "#f6546a", "#2acaea"))
```

# PDP-M-ALE plot - slučajna šuma {data-navmenu="ZADAVANJE"}

## Column {.tabset .tabset-fade}

### PDP plot

```{r fig.width=12}
plot(pdp_zadavanje_all, geom = "profiles")
```

### M plot

```{r fig.width=12}
plot(cond_zadavanje_all, geom = "profiles")
```

### ALE plot

```{r fig.width=12}
plot(acc_zadavanje_all, geom = "profiles")
```

### svi

```{r fig.width=12}
oznake <- c("klasa 1", "klasa 2", "klasa 3")
names(oznake) <- c("workflow.1", "workflow.2", "workflow.3")
ggplot(krivulje_zadavanje, aes(x = `_x_`, y = `_yhat_`, color = vrsta)) +
  geom_line() + 
  facet_grid(cols = vars(`_vname_`), rows = vars(`_label_`), scales = "free_x",
             labeller = labeller(`_label_` = oznake)) +
  xlab("bodovi") + ylab("predikcija vjerojatnosti")
```

# Break-Down SHAP - slučajna šuma {data-navmenu="ZADAVANJE"}

## Column 1 {.tabset .tabset-fade}

### BD 2

```{r}
plot(ob2_zadavanje)
```

### BD 45

```{r}
plot(ob45_zadavanje)
```

### BD 88

```{r}
plot(ob88_zadavanje)
```

## Column 2 {.tabset .tabset-fade}

### SHAP 2

```{r}
plot(ob2_zadavanje_shap)
```

### SHAP 45

```{r}
plot(ob45_zadavanje_shap)
```

### SHAP 88

```{r}
plot(ob88_zadavanje_shap)
```

# hiperparametri - stablo odlučivanja {data-navmenu="ZADAVANJE"}

## Column 1

### Testirani hiperparametri

```{r}
Zadavanje_tuning_tree %>%
  collect_metrics() %>%
  filter(.metric == "roc_auc") %>%
  pivot_longer(cols = cost_complexity:min_n) %>%
  mutate(best_mod = mean == max(mean)) %>% 
  ggplot(aes(x = value, y = mean)) +
  #geom_line(alpha = 0.5, size = 1.5) +
  geom_point(aes(color = best_mod), size = 0.3) +
  facet_wrap(~name, scales = "free_x") +
  scale_x_continuous() +
  labs(y = "roc auc", x = "", color = "Best Model")
```

## Column 2

### 20 najboljih modela za roc_auc metriku

```{r}
print(Zadavanje_tuning_tree %>% show_best(metric = 'roc_auc', n = 20), n = 20)
```

# efikasnost - stablo odlučivanja {data-navmenu="ZADAVANJE"}

## Column 1

###  Metrike na testnom i trening skupu {data-height=200}

```{r}
tab1 <- Zadavanje_fit_tree %>% collect_predictions() %>% 
  rf_metrike(truth = Zadavanje, estimate = .pred_class, .pred_1:.pred_3)
tab2 <- Zadavanje_work_tree %>%
  rf_metrike(truth = Zadavanje, estimate = .pred_class, .pred_1:.pred_3)
tab1 %>% inner_join(tab2, by = ".metric") %>%
  select(.metric, .estimator = .estimator.x, trening = .estimate.y, test = .estimate.x)
```

### Confusion matrix

```{r}
Zadavanje_fit_tree %>% collect_predictions() %>%
  conf_mat(truth = Zadavanje, estimate = .pred_class) %>% autoplot("heatmap") +
  scale_fill_gradient(low = "#87DEE7",
                       high = "#FFFFCC")
```

## Column 2

### ROC curve

```{r}
Zadavanje_fit_tree %>% collect_predictions() %>% roc_curve(Zadavanje, .pred_1:.pred_3) %>% autoplot()
```

### Gain curve

```{r}
Zadavanje_fit_tree %>% collect_predictions() %>% gain_curve(Zadavanje, .pred_1:.pred_3) %>% autoplot()
```

# važnost prediktora - stablo odlučivanja {data-navmenu="ZADAVANJE"}

## Columnn 1 {data-width=300}

### Važnost prediktora

```{r}
Zadavanje_fit_tree %>% extract_fit_parsnip() %>% vip()
```

## Column 2 {data-width=500 .tabset .tabset-fade}

### Stablo graf

```{r fig.width=10}
Zadavanje_fit_tree %>% 
  extract_fit_engine() %>%
  rpart.plot(roundint = FALSE, digits = 3)
```

### Stablo tekst

```{r}
Zadavanje_fit_tree %>% 
  extract_fit_engine()
```

### Stablo detalji

```{r}
info1 <- summary(Zadavanje_fit_tree %>% 
  extract_fit_engine())$splits
info1
```

# Opis modela {data-navmenu="RJEŠAVANJE"}

## Column 1

### Rješavanje problema (slučajna šuma)

**Prediktori**

- KVIZ - suma svih bodova na kvizovima
- KOL1 - ukupni broj bodova na prvom kolokviju
- KOL2 - ukupni broj bodova na drugom kolokviju
- Zadavanje - ukupni broj bodova na zadavanju problema

**Response** - Klasifikacija studenata na temelju broja bodova dobivenih na rješavanju problema

- **1** - ako je na rješavanju problema ukupni broj bodova unutar intervala [0%, 33%]
- **2** - ako je na rješavanju problema ukupni broj bodova unutar intervala (33%, 67%]
- **3** - ako je na rješavanju problema ukupni broj bodova unutar intervala (67%, 100%]

**Hiperparametri** - za odabir optimalne kombinacije hiperparametara napravljen je 
cross-validation s 10 *kutija* pri čemu je na slučajni način isprobano 500 kombinacija 
hiperparametara *mtry*, *min_n* i *trees*. Najbolji model je odabran s obzirom na *roc_auc*
metriku.

- *mtry* - uzimane su vrijednosti iz skupa {2,3}
- *trees* - uzimani su prirodni brojevi između 400 i 1500.
- *min_n* - uzimani su prirodni brojevi između 2 i 40.

### Rješavanje problema (stablo odlučivanja)

**Prediktori**

- KVIZ - suma svih bodova na kvizovima
- KOL1 - ukupni broj bodova na prvom kolokviju
- KOL2 - ukupni broj bodova na drugom kolokviju
- Zadavanje - ukupni broj bodova na zadavanju problema

**Response** - Klasifikacija studenata na temelju broja bodova dobivenih na rješavanju problema

- **1** - ako je na rješavanju problema ukupni broj bodova unutar intervala [0%, 33%]
- **2** - ako je na rješavanju problema ukupni broj bodova unutar intervala (33%, 67%]
- **3** - ako je na rješavanju problema ukupni broj bodova unutar intervala (67%, 100%]

**Hiperparametri** - za odabir optimalne kombinacije hiperparametara napravljen je 
cross-validation s 10 *kutija* pri čemu je na slučajni način isprobano 5000 kombinacija 
hiperparametara *tree_depth*, *min_n* i *cost_complexity* preko uzorkovanja na latinskoj hiperkocki.
Najbolji model je odabran s obzirom na *roc_auc* metriku.

- *tree_depth* - uzimani su prirodni brojevi između 1 i 15.
- *cost_complexity* - uzimani su realni brojevi između 1e-10 i 0.1.
- *min_n* - uzimani su prirodni brojevi između 2 i 40.

## Column 2

### 3-kvantili za kreiranje klasa

```{r}
qvant %>% kbl() %>%
  kable_paper("hover", full_width = F)
```

### summary

```{r}
summary(podaci) %>% kbl() %>%
  kable_paper("hover", full_width = F)
```

# hiperparametri - slučajna šuma {data-navmenu="RJEŠAVANJE"}

## Column 1

### Testirani hiperparametri

```{r}
Rjesavanje_tuning %>%
  collect_metrics() %>%
  filter(.metric == "roc_auc", trees > 0) %>%
  pivot_longer(cols = mtry:min_n) %>%
  mutate(best_mod = mean == max(mean)) %>% 
  ggplot(aes(x = value, y = mean)) +
  #geom_line(alpha = 0.5, size = 1.5) +
  geom_point(aes(color = best_mod), size = 0.3) +
  facet_wrap(~name, scales = "free_x") +
  scale_x_continuous() +
  labs(y = "roc auc", x = "", color = "Best Model")
```

## Column 2

### 20 najboljih modela za roc_auc metriku

```{r}
print(Rjesavanje_tuning %>% show_best(metric = 'roc_auc', n = 20), n = 20)
```

# efikasnost - slučajna šuma {data-navmenu="RJEŠAVANJE"}

## Column 1

###  Metrike na testnom i trening skupu {data-height=200}

```{r}
tab1 <- Rjesavanje_fit %>% collect_predictions() %>% 
  rf_metrike(truth = Rjesavanje, estimate = .pred_class, .pred_1:.pred_3)
tab2 <- Rjesavanje_work %>%
  rf_metrike(truth = Rjesavanje, estimate = .pred_class, .pred_1:.pred_3)
tab1 %>% inner_join(tab2, by = ".metric") %>%
  select(.metric, .estimator = .estimator.x, trening = .estimate.y, test = .estimate.x)
```

### Confusion matrix

```{r}
Rjesavanje_fit %>% collect_predictions() %>%
  conf_mat(truth = Rjesavanje, estimate = .pred_class) %>% autoplot("heatmap") +
  scale_fill_gradient(low = "#87DEE7",
                       high = "#FFFFCC")
```

## Column 2

### ROC curve

```{r}
Rjesavanje_fit %>% collect_predictions() %>% roc_curve(Rjesavanje, .pred_1:.pred_3) %>% autoplot()
```

### Gain curve

```{r}
Rjesavanje_fit %>% collect_predictions() %>% gain_curve(Rjesavanje, .pred_1:.pred_3) %>% autoplot()
```

# važnost prediktora - slučajna šuma {data-navmenu="RJEŠAVANJE"}

## Columnn 1

### Gini

```{r}
Rjesavanje_fit %>% extract_fit_parsnip() %>% vip()
```

### permutacija

```{r}
Rjesavanje_permfit %>% extract_fit_parsnip() %>% vip()
```

## Column 2

### Boruta

```{r}
plot(Rjesavanje_Boruta, cex.axis=.7, las=2, xlab="",
     colCode = c("green", "orange", "#f6546a", "#2acaea"))
```

### Boruta (history)

```{r}
plotImpHistory(Rjesavanje_Boruta, colCode = c("green", "orange", "#f6546a", "#2acaea"))
```

# PDP-M-ALE plot - slučajna šuma {data-navmenu="RJEŠAVANJE"}

## Column {.tabset .tabset-fade}

### PDP plot

```{r fig.width=12}
plot(pdp_rjesavanje_all, geom = "profiles")
```

### M plot

```{r fig.width=12}
plot(cond_rjesavanje_all, geom = "profiles")
```

### ALE plot

```{r fig.width=12}
plot(acc_rjesavanje_all, geom = "profiles")
```

### svi

```{r fig.width=12}
oznake <- c("klasa 1", "klasa 2", "klasa 3")
names(oznake) <- c("workflow.1", "workflow.2", "workflow.3")
ggplot(krivulje_rjesavanje, aes(x = `_x_`, y = `_yhat_`, color = vrsta)) +
  geom_line() + 
  facet_grid(cols = vars(`_vname_`), rows = vars(`_label_`), scales = "free_x",
             labeller = labeller(`_label_` = oznake)) +
  xlab("bodovi") + ylab("predikcija vjerojatnosti")
```

# Break-Down SHAP - slučajna šuma {data-navmenu="RJEŠAVANJE"}

## Column 1 {.tabset .tabset-fade}

### BD 2

```{r}
plot(ob2_rjesavanje)
```

### BD 45

```{r}
plot(ob45_rjesavanje)
```

### BD 88

```{r}
plot(ob88_rjesavanje)
```

## Column 2 {.tabset .tabset-fade}

### SHAP 2

```{r}
plot(ob2_rjesavanje_shap)
```

### SHAP 45

```{r}
plot(ob45_rjesavanje_shap)
```

### SHAP 88

```{r}
plot(ob88_rjesavanje_shap)
```

# hiperparametri - stablo odlučivanja {data-navmenu="RJEŠAVANJE"}

## Column 1

### Testirani hiperparametri

```{r}
Rjesavanje_tuning_tree %>%
  collect_metrics() %>%
  filter(.metric == "roc_auc") %>%
  pivot_longer(cols = cost_complexity:min_n) %>%
  mutate(best_mod = mean == max(mean)) %>% 
  ggplot(aes(x = value, y = mean)) +
  #geom_line(alpha = 0.5, size = 1.5) +
  geom_point(aes(color = best_mod), size = 0.3) +
  facet_wrap(~name, scales = "free_x") +
  scale_x_continuous() +
  labs(y = "roc auc", x = "", color = "Best Model")
```

## Column 2

### 20 najboljih modela za roc_auc metriku

```{r}
print(Rjesavanje_tuning_tree %>% show_best(metric = 'roc_auc', n = 20), n = 20)
```

# efikasnost - stablo odlučivanja {data-navmenu="RJEŠAVANJE"}

## Column 1

###  Metrike na testnom i trening skupu {data-height=200}

```{r}
tab1 <- Rjesavanje_fit_tree %>% collect_predictions() %>% 
  rf_metrike(truth = Rjesavanje, estimate = .pred_class, .pred_1:.pred_3)
tab2 <- Rjesavanje_work_tree %>%
  rf_metrike(truth = Rjesavanje, estimate = .pred_class, .pred_1:.pred_3)
tab1 %>% inner_join(tab2, by = ".metric") %>%
  select(.metric, .estimator = .estimator.x, trening = .estimate.y, test = .estimate.x)
```

### Confusion matrix

```{r}
Rjesavanje_fit_tree %>% collect_predictions() %>%
  conf_mat(truth = Rjesavanje, estimate = .pred_class) %>% autoplot("heatmap") +
  scale_fill_gradient(low = "#87DEE7",
                       high = "#FFFFCC")
```

## Column 2

### ROC curve

```{r}
Rjesavanje_fit_tree %>% collect_predictions() %>% roc_curve(Rjesavanje, .pred_1:.pred_3) %>% autoplot()
```

### Gain curve

```{r}
Rjesavanje_fit_tree %>% collect_predictions() %>% gain_curve(Rjesavanje, .pred_1:.pred_3) %>% autoplot()
```

# važnost prediktora - stablo odlučivanja {data-navmenu="RJEŠAVANJE"}

## Columnn 1 {data-width=300}

### Važnost prediktora

```{r}
Rjesavanje_fit_tree %>% extract_fit_parsnip() %>% vip()
```

## Column 2 {data-width=500 .tabset .tabset-fade}

### Stablo graf

```{r fig.width = 12}
Rjesavanje_fit_tree %>% 
  extract_fit_engine() %>%
  rpart.plot(roundint = FALSE, digits = 3)
```

### Stablo tekst

```{r}
Rjesavanje_fit_tree %>% 
  extract_fit_engine()
```

### Stablo detalji

```{r}
info2 <- summary(Rjesavanje_fit_tree %>% 
  extract_fit_engine())$splits
info2
```

# Opis modela {data-navmenu="PROCJENA"}

## Column 1

### Procjena rješenja problema (slučajna šuma)

**Prediktori**

- KVIZ - suma svih bodova na kvizovima
- KOL1 - ukupni broj bodova na prvom kolokviju
- KOL2 - ukupni broj bodova na drugom kolokviju
- Zadavanje - ukupni broj bodova na zadavanju problema
- Rješavanje - ukupni broj bodova na rješavanju problema

**Response** - Klasifikacija studenata na temelju broja bodova dobivenih na procjeni rješenja problema

- **1** - ako je na procjeni rješenja problema ukupni broj bodova unutar intervala [0%, 33%]
- **2** - ako je na procjeni rješenja problema ukupni broj bodova unutar intervala (33%, 67%]
- **3** - ako je na procjeni rješenja problema ukupni broj bodova unutar intervala (67%, 100%]

**Hiperparametri** - za odabir optimalne kombinacije hiperparametara napravljen je 
cross-validation s 10 *kutija* pri čemu je na slučajni način isprobano 5000 kombinacija 
hiperparametara *mtry*, *min_n* i *trees* preko uzorkovanja na latinskoj hiperkocki. 
Najbolji model je odabran s obzirom na *roc_auc* metriku.

- *mtry* - uzimane su vrijednosti iz skupa {2,3}
- *trees* - uzimani su prirodni brojevi između 400 i 1500.
- *min_n* - uzimani su prirodni brojevi između 2 i 40.

### Procjena rješenja problema (stablo odlučivanja)

- KVIZ - suma svih bodova na kvizovima
- KOL1 - ukupni broj bodova na prvom kolokviju
- KOL2 - ukupni broj bodova na drugom kolokviju
- Zadavanje - ukupni broj bodova na zadavanju problema
- Rješavanje - ukupni broj bodova na rješavanju problema

**Response** - Klasifikacija studenata na temelju broja bodova dobivenih na procjeni rješenja problema

- **1** - ako je na procjeni rješenja problema ukupni broj bodova unutar intervala [0%, 33%]
- **2** - ako je na procjeni rješenja problema ukupni broj bodova unutar intervala (33%, 67%]
- **3** - ako je na procjeni rješenja problema ukupni broj bodova unutar intervala (67%, 100%]

**Hiperparametri** - za odabir optimalne kombinacije hiperparametara napravljen je 
cross-validation s 10 *kutija* pri čemu je na slučajni način isprobano 5000 kombinacija 
hiperparametara *tree_depth*, *min_n* i *cost_complexity* preko uzorkovanja na latinskoj hiperkocki.
Najbolji model je odabran s obzirom na *roc_auc* metriku.

- *tree_depth* - uzimani su prirodni brojevi između 1 i 15.
- *cost_complexity* - uzimani su realni brojevi između 1e-10 i 0.1.
- *min_n* - uzimani su prirodni brojevi između 2 i 40.

## Column 2

### 3-kvantili za kreiranje klasa

```{r}
qvant %>% kbl() %>%
  kable_paper("hover", full_width = F)
```

### summary

```{r}
summary(podaci) %>% kbl() %>%
  kable_paper("hover", full_width = F)
```

# hiperparametri - slučajna šuma {data-navmenu="PROCJENA"}

## Column 1

### Testirani hiperparametri

```{r}
Procjena_tuning %>%
  collect_metrics() %>%
  filter(.metric == "roc_auc", trees > 0) %>%
  pivot_longer(cols = mtry:min_n) %>%
  mutate(best_mod = mean == max(mean)) %>% 
  ggplot(aes(x = value, y = mean)) +
  #geom_line(alpha = 0.5, size = 1.5) +
  geom_point(aes(color = best_mod), size = 0.3) +
  facet_wrap(~name, scales = "free_x") +
  scale_x_continuous() +
  labs(y = "roc auc", x = "", color = "Best Model")
```

## Column 2

### 20 najboljih modela za roc_auc metriku

```{r}
print(Procjena_tuning %>% show_best(metric = 'roc_auc', n = 20), n = 20)
```

# efikasnost - slučajna šuma {data-navmenu="PROCJENA"}

## Column 1

###  Metrike na testnom i trening skupu {data-height=200}

```{r}
tab1 <- Procjena_fit %>% collect_predictions() %>% 
  rf_metrike(truth = Procjena, estimate = .pred_class, .pred_1:.pred_3)
tab2 <- Procjena_work %>%
  rf_metrike(truth = Procjena, estimate = .pred_class, .pred_1:.pred_3)
tab1 %>% inner_join(tab2, by = ".metric") %>%
  select(.metric, .estimator = .estimator.x, trening = .estimate.y, test = .estimate.x)
```

### Confusion matrix

```{r}
Procjena_fit %>% collect_predictions() %>%
  conf_mat(truth = Procjena, estimate = .pred_class) %>% autoplot("heatmap") +
  scale_fill_gradient(low = "#87DEE7",
                       high = "#FFFFCC")
```

## Column 2

### ROC curve

```{r}
Procjena_fit %>% collect_predictions() %>% roc_curve(Procjena, .pred_1:.pred_3) %>% autoplot()
```

### Gain curve

```{r}
Procjena_fit %>% collect_predictions() %>% gain_curve(Procjena, .pred_1:.pred_3) %>% autoplot()
```

# važnost prediktora - slučajna šuma {data-navmenu="PROCJENA"}

## Columnn 1

### Gini

```{r}
Procjena_fit %>% extract_fit_parsnip() %>% vip()
```

### permutacija

```{r}
Procjena_permfit %>% extract_fit_parsnip() %>% vip()
```

## Column 2

### Boruta

```{r}
plot(Procjena_Boruta, cex.axis=.7, las=2, xlab="",
     colCode = c("green", "orange", "#f6546a", "#2acaea"))
```

### Boruta (history)

```{r}
plotImpHistory(Procjena_Boruta, colCode = c("green", "orange", "#f6546a", "#2acaea"))
```

# PDP-M-ALE plot - slučajna šuma {data-navmenu="PROCJENA"}

## Column {.tabset .tabset-fade}

### PDP plot

```{r fig.width=12}
plot(pdp_procjena_all, geom = "profiles")
```

### M plot

```{r fig.width=12}
plot(cond_procjena_all, geom = "profiles")
```

### ALE plot

```{r fig.width=12}
plot(acc_procjena_all, geom = "profiles")
```

### svi

```{r fig.width=12}
oznake <- c("klasa 1", "klasa 2", "klasa 3")
names(oznake) <- c("workflow.1", "workflow.2", "workflow.3")
ggplot(krivulje_procjena, aes(x = `_x_`, y = `_yhat_`, color = vrsta)) +
  geom_line() + 
  facet_grid(cols = vars(`_vname_`), rows = vars(`_label_`), scales = "free_x",
             labeller = labeller(`_label_` = oznake)) +
  xlab("bodovi") + ylab("predikcija vjerojatnosti")
```

# Break-Down SHAP - slučajna šuma {data-navmenu="PROCJENA"}

## Column 1 {.tabset .tabset-fade}

### BD 2

```{r}
plot(ob2_procjena)
```

### BD 45

```{r}
plot(ob45_procjena)
```

### BD 88

```{r}
plot(ob88_procjena)
```

## Column 2 {.tabset .tabset-fade}

### SHAP 2

```{r}
plot(ob2_procjena_shap)
```

### SHAP 45

```{r}
plot(ob45_procjena_shap)
```

### SHAP 88

```{r}
plot(ob88_procjena_shap)
```

# hiperparametri - stablo odlučivanja {data-navmenu="PROCJENA"}

## Column 1

### Testirani hiperparametri

```{r}
Procjena_tuning_tree %>%
  collect_metrics() %>%
  filter(.metric == "roc_auc") %>%
  pivot_longer(cols = cost_complexity:min_n) %>%
  mutate(best_mod = mean == max(mean)) %>% 
  ggplot(aes(x = value, y = mean)) +
  #geom_line(alpha = 0.5, size = 1.5) +
  geom_point(aes(color = best_mod), size = 0.3) +
  facet_wrap(~name, scales = "free_x") +
  scale_x_continuous() +
  labs(y = "roc auc", x = "", color = "Best Model")
```

## Column 2

### 20 najboljih modela za roc_auc metriku

```{r}
print(Procjena_tuning_tree %>% show_best(metric = 'roc_auc', n = 20), n = 20)
```

# efikasnost - stablo odlučivanja {data-navmenu="PROCJENA"}

## Column 1

###  Metrike na testnom i trening skupu {data-height=200}

```{r}
tab1 <- Procjena_fit_tree %>% collect_predictions() %>% 
  rf_metrike(truth = Procjena, estimate = .pred_class, .pred_1:.pred_3)
tab2 <- Procjena_work_tree %>%
  rf_metrike(truth = Procjena, estimate = .pred_class, .pred_1:.pred_3)
tab1 %>% inner_join(tab2, by = ".metric") %>%
  select(.metric, .estimator = .estimator.x, trening = .estimate.y, test = .estimate.x)
```

### Confusion matrix

```{r}
Procjena_fit_tree %>% collect_predictions() %>%
  conf_mat(truth = Procjena, estimate = .pred_class) %>% autoplot("heatmap") +
  scale_fill_gradient(low = "#87DEE7",
                       high = "#FFFFCC")
```

## Column 2

### ROC curve

```{r}
Procjena_fit_tree %>% collect_predictions() %>% roc_curve(Procjena, .pred_1:.pred_3) %>% autoplot()
```

### Gain curve

```{r}
Procjena_fit_tree %>% collect_predictions() %>% gain_curve(Procjena, .pred_1:.pred_3) %>% autoplot()
```

# važnost prediktora - stablo odlučivanja {data-navmenu="PROCJENA"}

## Columnn 1 {data-width=300}

### Važnost prediktora

```{r}
Procjena_fit_tree %>% extract_fit_parsnip() %>% vip()
```

## Column 2 {data-width=700 .tabset .tabset-fade}

### Stablo graf

```{r fig.width=16, fig.height=8}
Procjena_fit_tree %>% 
  extract_fit_engine() %>%
  rpart.plot(roundint = FALSE, digits = 3, tweak = 1.1)
```

### Stablo tekst

```{r}
Procjena_fit_tree %>% 
  extract_fit_engine()
```

### Stablo detalji

```{r}
info3 <- summary(Procjena_fit_tree %>% 
  extract_fit_engine())$splits
info3
```