---
title: "investigating issue 104"
output: html_notebook
tldr: see https://github.com/mlverse/tabnet/issues/114
---


# SYSTEM SETTING
## Import Packages
```{r}
#| label: setup
#| warning: false
#| message: false
set.seed(seed = 2023)

library(tidyverse)
library(here)
library(tidymodels)
library(torch)
# library(tabnet)
devtools::load_all()
library(data.tree)
# library(tidyverse)
```


```{r }
#| eval: false
#may take 3 mins
source(here("tools/setup.R"))
```
NODE_RESERVED_NAMES_CONST

## replace reserved_names

```{r}
#| eval: false
check_compliant_node(attrition_tree)
check_compliant_node(starwars_tree)
```
## fit a multi-outcome classifier

```{r}
#| eval: false
#| label: Reprex for https://github.com/mlverse/tabnet/issues/125
library(tabnet)
library(recipes)
starwars_rec <-  recipe(species + homeworld ~ ., data = starwars %>%
                          select(-where(is.list)) |> 
                          mutate(species = coalesce(species, "Unknown_Species"),
           homeworld     = coalesce(homeworld, "Unknown_homeworld"))) %>%
    step_zv(all_predictors()) %>%
    step_impute_mode(all_outcomes()) %>%
    step_string2factor(all_string_predictors(), all_outcomes())

fit_multi <- tabnet_fit(starwars_rec, starwars, cat_emb_dim = 2)
```

## prepare Node objects
```{r}
#| eval: true
starw_split <- starwars %>% 
  tidyr::unnest_longer(films) %>% 
  tidyr::unnest_longer(vehicles, keep_empty = TRUE) %>% 
  tidyr::unnest_longer(starships, keep_empty = TRUE) %>% 
  initial_split( prop = .8, strata = "species")

starwars_train_tree <- starw_split %>% 
  training() %>% 
  # avoid reserved column names
  rename(`_name` = "name", `_height` = "height") %>% 
  rowid_to_column() %>% 
    mutate(species = coalesce(species, "Unknown_Species"),
           sex     = coalesce(sex, "Unknown_Sex"),
           pathString = paste("StarWars_characters", species, sex, `_name`, sep = "/")) %>%
  # remove outcomes labels from predictors
  select(-species, -sex, -`_name`, -rowid) %>% 
  # turn it as hierarchical Node
  as.Node()

starwars_test_tree <- starw_split %>% 
  testing() %>% 
  rename(`_name` = "name", `_height` = "height") %>% 
  rowid_to_column() %>% 
  mutate(pathString = paste("StarWars_characters", species, sex, rowid, sep = "/")) %>%
  select(-species, -sex, -`_name`, -rowid) %>% 
  as.Node() # [77 entries, 11 attributes]

starwars_test_tree$attributesAll

```

```{r}
#| eval: true

attrition_tree <- attrition %>% 
  rowid_to_column() %>% 
  mutate(pathString = paste("attrition", Department, JobRole, rowid, sep = "/")) %>%
  as.Node()
print(attrition_tree, "Age", "Education","EducationField", "DailyRate",  limit = 12)
```
#  compute torch sparse ancestor matrix for attrition_tree
```{r}
#|label: "hardhat.R L160-L170"
x <- attrition_tree$clone(deep = FALSE)

# ensure there is no level_* col in the Node object
check_compliant_node(x)
# get tree leaves and extract attributes into data.frames
xy_df <- node_to_df(x)
processed <- hardhat::mold(xy_df$x, xy_df$y)
# Given n classes, ancestor is an (n x n) matrix where ancestor_ij = 1 if class i is descendant of class j
# ancestor_tt is the torch_tensor of ancestor

ancestor_tt <- build_ancestor_matrix_from_outcomes(
  x = x,
  outcomes = processed$outcomes,
  device = "cpu"
)
 # [1 12 12]
```


```{r}
#| label: "check tree levels attrition"

levels <- sapply(data.tree::Traverse(x), `[[`, "level")
table(levels)
```

```{r}
#|label: "hardhat.R  L369-L370"
# tabnet_bridge(processed, config = config, tabnet_model, from_epoch, task = "supervised") -->
config <- tabnet_config(epochs = 2)
config$ancestor <- ancestor_tt # class "sparse_coo_tensor"
config$outcomes <- processed$outcomes
tabnet_model_lst <- tabnet:::tabnet_initialize(processed$predictors, processed$outcomes, config = config)
tabnet_model <-  tabnet:::new_tabnet_fit(tabnet_model_lst, blueprint = processed$blueprint)

fit_lst <- tabnet:::tabnet_train_supervised(tabnet_model, processed$predictors, processed$outcomes, config = config) # Fails with 
#> ! Erreur : mat1 and mat2 shapes cannot be multiplied (1470x2 and 1470x12)
#> Exception raised from meta at /pytorch/aten/src/ATen/native/LinearAlgebra.cpp:204 (most recent call first):

```

```{r}
#|label: "model_training.R  L460"

obj <- tabnet_model
x <- processed$predictors
y <- processed$outcomes
train_ds <-   torch::dataset(
  initialize = function() {},
  .getbatch = function(batch) {resolve_data(x[batch,], y[batch,])},
  .length = function() {nrow(x)}
)()
train_dl <- torch::dataloader(
  train_ds,
  batch_size = config$batch_size,
  drop_last = config$drop_last,
  shuffle = TRUE ,
  num_workers = config$num_workers
)
# ... to be continued ...
```

```{r}
#|label: "model_training.R train_batch L285"
epoch <- 1
iter <- dataloader_make_iter(train_dl)
batch <- dataloader_next(iter)

c(output, M_loss) %<-% network(batch$x, batch$x_na_mask)
outcome_nlevels <- as.numeric(batch$output_dim$to(device="cpu")) # c(3, 9)
  
config$loss_fn(output,  class_ids_to_binary(
      y = batch$y,
      outcomes = config$outcomes,
      device = out$device
    ))
)

```

```{r}
#|label: "loss.R nnf_mc_loss L140"

target <- batch$y
R <- config$ancestor


```



#  compute torch sparse ancestor matrix for starwars_tree
```{r}
#|label: "hardhat.R L160-L170"
x <- starwars_tree$clone(deep = FALSE)

# ensure there is no level_* col in the Node object
check_compliant_node(x)
# get tree leaves and extract attributes into data.frames
xy_df <- node_to_df(x)
processed <- hardhat::mold(xy_df$x, xy_df$y)
# Given n classes, ancestor is an (n x n) matrix where ancestor_ij = 1 if class i is descendant of class j
# ancestor_tt is the `R` torch_tensor of ancestor

ancestor_tt <- build_ancestor_matrix_from_outcomes(
  x = x,
  outcomes = processed$outcomes,
  device = "cpu"
) # [1 43 43]
```

```{r}
#| label: "check tree levels starwars_tree"

levels <- sapply(data.tree::Traverse(x), `[[`, "level")
table(levels)
```


---






# quand tabnet_fit() marche
```{r}
fit <- tabnet_fit(attrition_tree, cat_emb_dim = 2)
predict(fit, attrition_tree)
# Erreur dans switch(object$spec$mode, regression = "numeric", classification = "class",  : 
#   EXPR doit être un vecteur de longueur 1
```

# develop `tabnet:::tabnet_fit.Node()`
```{r}
#| eval: false
x <- starwars_tree
# TODO check there is no level_* col in the tree
  # extract attributes data.frame
  xy_df <- ToDataFrameTypeCol(x, x$attributesAll)
  x_df <- xy_df %>% select(-starts_with("level_"))
  y_df <- xy_df %>% select(starts_with("level_"))
  processed <- hardhat::mold(x_df, y_df)
  # embed the M matrix in Sextra
  ancestor <- ToDataFrameNetwork(datatree) %>%
    mutate_if(is.character, . %>% as.factor %>% as.numeric) 
  processed$extra$M <- Matrix::sparseMatrix(ancestor$from, ancestor$to, x = 1)
  check_type(processed$outcomes)
```

----------------------------------------------------------
# a yarr sourced file
```{r}
#| eval: false

library(yarr)

# Error   Invalid type specification.
# yeast_train <- foreign::read.arff("~/_Data.science/C-HMCNN-master/HMC_data/others/D0_yeast_GO.trainvalid.arff")
yeast_train_raw <- yarr::read.arff("~/_Data.science/C-HMCNN-master/HMC_data/others/D0_yeast_GO.trainvalid.arff")
yeast_train <- yeast_train_raw %>% mutate_all(as.numeric) %>% mutate_all(as.logical)
```

# another yarr sourced file
```{r}
#| eval: false

library(yarr)
enron_train <- yarr::read.arff("~/_Data.science/C-HMCNN-master/HMC_data/others/Enron_corr_trainvalid.arff")
enron_test <- yarr::read.arff("~/_Data.science/C-HMCNN-master/HMC_data/others/Enron_corr_test.arff")
```