inst/doc/Hierarchical_classification.R

In tabnet: Fit 'TabNet' Models for Classification and Regression

## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  eval = FALSE
)

## ----setup--------------------------------------------------------------------
#  library(tabnet)
#  library(dplyr)
#  library(data.tree)
#  library(ggplot2)
#  library(rsample)
#  library(tibble)
#  set.seed(202307)

## -----------------------------------------------------------------------------
#  data(acme, package = "data.tree")
#  acme$attributesAll
#  print(acme, "cost", "p" , limit = 8)

## -----------------------------------------------------------------------------
#  data(starwars, package = "dplyr")
#  head(starwars, 4)
#  
#  # erroneous Node construction
#  starwars_tree <- starwars %>%
#    mutate(pathString = paste("StarWars_characters", species, sex, `name`, sep = "/")) %>%
#    as.Node()
#  print(starwars_tree, "name","height", "mass", "eye_color", limit = 8)
#  

## -----------------------------------------------------------------------------
#  # demonstration of reserved column modification in Node construction
#  starwars_tree <- starwars %>%
#    rename(`_name` = "name", `_height` = "height") %>%
#    mutate(pathString = paste("StarWars_characters", species, sex, `_name`, sep = "/")) %>%
#    as.Node()
#  print(starwars_tree, "name", "_name","_height", "mass", "eye_color", limit = 8)

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

## -----------------------------------------------------------------------------
#  # correct Node construction for hierarchical modeling
#  starwars_train_tree <- starw_split %>%
#    training() %>%
#    # avoid reserved column names
#    rename(`_name` = "name", `_height` = "height") %>%
#    rowid_to_column() %>%
#    mutate(pathString = paste("StarWars_characters", species, sex, rowid, 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()
#  
#  starwars_train_tree$attributesAll

## ----model training-----------------------------------------------------------
#  config <- tabnet_config(decision_width = 8, attention_width = 8, num_steps = 3, penalty = .003, cat_emb_dim = 2, valid_split = 0.2, learn_rate = 1e-3, lr_scheduler = "reduce_on_plateau", early_stopping_monitor = "valid_loss", early_stopping_patience = 4, verbose = FALSE)
#  
#  starw_model <- tabnet_fit(starwars_train_tree, config = config, epoch = 170, checkpoint_epochs = 25)
#  

## -----------------------------------------------------------------------------
#  autoplot(starw_model)

## -----------------------------------------------------------------------------
#  vip::vip(starw_model)

## -----------------------------------------------------------------------------
#  starwars_hat <- bind_cols(
#      predict(starw_model, starwars_test_tree),
#      node_to_df(starwars_test_tree)$y
#    )
#  tail(starwars_hat, n = 5)
#  

## -----------------------------------------------------------------------------
#  starwars_explain <- tabnet_explain(starw_model, starwars_test_tree)
#  autoplot(starwars_explain)
#  autoplot(starwars_explain, type = "steps")