# investigating issue 104

# SYSTEM SETTING

## Import Packages

    #| 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)

    #may take 3 mins
    source(here("tools/setup.R"))

NODE_RESERVED_NAMES_CONST

## replace reserved_names

    check_compliant_node(attrition_tree)
    check_compliant_node(starwars_tree)

## fit a multi-outcome classifier

    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

    #| 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

     [1] "_height"    "birth_year" "eye_color"  "films"      "gender"     "hair_color" "homeworld"
     [8] "mass"       "skin_color" "starships"  "vehicles"

    #| 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)

                                levelName Age Education EducationField DailyRate
    1  attrition                           NA        NA             NA        NA
    2   ¦--Sales                           NA        NA             NA        NA
    3   ¦   ¦--Sales_Executive             NA        NA             NA        NA
    4   ¦   ¦   ¦--1                       41         2              2      1102
    5   ¦   ¦   ¦--28                      42         4              3       691
    6   ¦   ¦   ¦--40                      33         3              2      1141
    7   ¦   ¦   ¦--44                      27         3              2       994
    8   ¦   ¦   ¦--47                      34         4              3      1065
    9   ¦   ¦   ¦--49                      46         4              3      1211
    10  ¦   ¦   ¦--53                      44         5              3      1488
    11  ¦   ¦   ¦--55                      26         3              3      1443
    12  ¦   ¦   °--... 318 nodes w/ 0 sub  NA        NA             NA        NA
    13  ¦   °--... 2 nodes w/ 438 sub      NA        NA             NA        NA
    14  °--... 2 nodes w/ 1472 sub         NA        NA             NA        NA

# compute torch sparse ancestor matrix for attrition_tree

    #|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]

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

    #|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):

    #|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 ...

    #|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
        ))
    )

    #|label: "loss.R nnf_mc_loss L140"

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

# compute torch sparse ancestor matrix for starwars_tree

    #|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]

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

# quand tabnet_fit() marche

    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()`

    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

    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

    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")

[encoded data, 10080 characters]