r - 使用 rpart 生成桑基图的决策树

Question

我可以使用作为基础 R 的一部分的 Kyphosis 数据集创建带有 Rpart 的树:

fit <- rpart(Kyphosis ~ Age + Number + Start,
         method="class", data=kyphosis)
printcp(fit)
plot(fit, uniform=TRUE,main="Classification Tree for Kyphosis")
text(fit, use.n=TRUE, all=TRUE, cex=.8)

这就是树的样子:


现在为了更好地可视化树，我想使用 plotly 使用桑基图。要以 plotly 方式创建桑基图，必须执行以下操作:

library(plotly)
nodes=c("Start>=8.5","Start>-14.5","absent",
                   "Age<55","absent","Age>=111","absent","present","present")
p <- plot_ly(
  type = "sankey",
  orientation = "h",      
  node = list(
    label = nodes,
    pad = 10,
    thickness = 20,
    line = list(
      color = "black",
      width = 0.5
    )
  ),

  link = list(
    source = c(0,1,1,3,3,5,5,0),
    target = c(1,2,3,4,5,6,7,8),
    value =  c(1,1,1,1,1,1,1,1)
  )
) %>% 
  layout(
    title = "Desicion Tree",
    font = list(
      size = 10
    )
  )
p

这将创建与树对应的桑基图(硬编码)。所需的三个必要向量是“源”、“目标”、“值”，如下所示:

硬编码桑基图:



我的问题是使用 rpart 对象“fit”我似乎无法轻松获得向量来生成所需的“源”、“目标”和“值”向量。

fit$frame 和 fit$splits 包含一些信息，但很难将它们聚合或一起使用。在 fit 对象上使用打印功能会生成所需的信息，但我不想进行文本编辑来获取它。

print(fit)

输出:

1) root 81 17 absent (0.79012346 0.20987654)  
   2) Start>=8.5 62  6 absent (0.90322581 0.09677419)  
     4) Start>=14.5 29  0 absent (1.00000000 0.00000000) *
     5) Start< 14.5 33  6 absent (0.81818182 0.18181818)  
      10) Age< 55 12  0 absent (1.00000000 0.00000000) *
      11) Age>=55 21  6 absent (0.71428571 0.28571429)  
        22) Age>=111 14  2 absent (0.85714286 0.14285714) *
        23) Age< 111 7  3 present (0.42857143 0.57142857) *
   3) Start< 8.5 19  8 present (0.42105263 0.57894737) *

那么有没有一种简单的方法可以使用 rpart 对象来获取这 3 个向量以生成 sankey 图？此图将用于 Web 应用程序，因此必须使用 plotly，因为我们已经有了与之对应的 javascript，并且它必须易于重用以应用于各种数据集。

Answer 1

这是我的尝试:

从我看来，挑战是生成 nodes和 source变量。

样本数据:

fit <- rpart(Kyphosis ~ Age + Number + Start,
             method="class", data=kyphosis)

生成 nodes :

frame <- fit$frame
isLeave <- frame$var == "<leaf>"
nodes <- rep(NA, length(isLeave))
ylevel <- attr(fit, "ylevels")
nodes[isLeave] <- ylevel[frame$yval][isLeave]
nodes[!isLeave] <- labels(fit)[-1][!isLeave[-length(isLeave)]]

生成 source :

node <- as.numeric(row.names(frame))
depth <- rpart:::tree.depth(node)
source <- depth[-1] - 1

reps <- rle(source)
tobeAdded <- reps$values[sapply(reps$values, function(val) sum(val >= which(reps$lengths > 1))) > 0]
update <- source %in% tobeAdded
source[update] <- source[update] + sapply(tobeAdded, function(tobeAdd) rep(sum(which(reps$lengths > 1) <= tobeAdd), 2))

测试:

library(rpart)
fit <- rpart(Kyphosis ~ Age + Number + Start,
             method="class", data=kyphosis)
fit2 <- rpart(Kyphosis ~ Age + Number + Start, data = kyphosis,
              parms = list(prior = c(.65,.35), split = "information"))

如何到达:

见: getS3method("print", "rpart")