Cluster_utils.R

xtract_multiclass.R

# Get the multiclass obs and prop

xtract_multiclass <- function(ctree_res){
  
  tab <- sapply(1:length(ctree_res), function(id) {
    y <- data_party(ctree_res[id])
    y <- y[["(response)"]]
    table(y)
  }) 
  
  tab_prop <- prop.table(tab) %>% round(4) %>% 
    as.data.frame() %>% 
    tibble::rownames_to_column(var = "outcome") %>% 
    gather(node, prop_total, -outcome)
  
  tab <- tab %>% as.data.frame()%>% 
    tibble::rownames_to_column(var = "outcome") %>% 
    gather(node, num_obs, -outcome)
  
  left_join(tab, tab_prop) %>% 
    tbl_df %>% 
    group_by(node) %>% 
    mutate(prop_in_node = round(num_obs/sum(num_obs), 3))
  
}

irisct <- ctree(Species ~ .,data = iris)
xtract_multiclass(irisct)