决策树使用rpart制作sankey图
Decision tree using rpart to produce a sankey diagram
我可以使用属于基础 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
这将创建一个对应于树(硬编码)的桑基图。所需的三个必要向量是 'source'、'target'、'value',如下所示:
硬编码桑基图:
我的问题是使用 rpart 对象 'fit' 我似乎无法轻易获得一个向量来生成所需的 'source'、'target' 和 'value' 向量阴谋地.
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 个向量,以便 plotly 生成桑基图?该图将在网络应用程序中使用,因此必须使用 plotly,因为我们已经有了与之对应的 javascript,并且它必须易于重用才能应用于各种数据集。
这是我的尝试:
据我所知,挑战在于生成 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")
我暂时有一个临时的解决办法。我只是不喜欢加载额外的库。但这里是:
为 Iris 数据集拟合模型:
fit <- rpart(Species~Sepal.Length +Sepal.Width ,
method="class", data=iris)
printcp(fit)
plot(fit, uniform=TRUE,
main="Classification Tree for IRIS")
text(fit, use.n=TRUE, all=TRUE, cex=.8)
我用来获取节点名称的方法是:
treeFrame=fit$frame
nodes=sapply(row.names(treeFrame),function(x) unlist(rpart::path.rpart(fit,x))
[length(unlist(rpart::path.rpart(fit,x)))])
但在@BigDataScientist 解决方案中有更好的方法:
treeFrame=fit$frame
isLeave <- treeFrame$var == "<leaf>"
nodes <- rep(NA, length(isLeave))
ylevel <- attr(fit, "ylevels")
nodes[isLeave] <- ylevel[treeFrame$yval][isLeave]
nodes[!isLeave] <- labels(fit)[-1][!isLeave[-length(isLeave)]]
现在获取源和目标仍然有点棘手,但对我有帮助的是 rpart.utils 包:
library('rpart.utils')
treeFrame=fit$frame
treeRules=rpart.utils::rpart.rules(fit)
targetPaths=sapply(as.numeric(row.names(treeFrame)),function(x)
strsplit(unlist(treeRules[x]),split=","))
lastStop= sapply(1:length(targetPaths),function(x) targetPaths[[x]]
[length(targetPaths[[x]])])
oneBefore= sapply(1:length(targetPaths),function(x) targetPaths[[x]]
[length(targetPaths[[x]])-1])
target=c()
source=c()
values=treeFrame$n
for(i in 2:length(oneBefore))
{
tmpNode=oneBefore[[i]]
q=which(lastStop==tmpNode)
q=ifelse(length(q)==0,1,q)
source=c(source,q)
target=c(target,i)
}
source=source-1
target=target-1
所以我不喜欢使用额外的库,但这似乎适用于各种数据集。并且使用@BigDataScientist 获取节点的方式更好。但我仍然会寻找更好的解决方案。 @BigDataScientist 我认为您的解决方案会更好地工作,也许需要更改一些小的东西。但是我还不太理解你代码的 "reps" 部分。
最后的剧情代码是:
p <- plot_ly(
type = "sankey",
orientation = "v",
node = list(
label = nodes,
pad = 15,
thickness = 20,
line = list(
color = "black",
width = 0.5
)
),
link = list(
source = source,
target = target,
value=values[-1]
)
) %>%
layout(
title = "Basic Sankey Diagram",
font = list(
size = 10
)
)
p
我可以使用属于基础 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
这将创建一个对应于树(硬编码)的桑基图。所需的三个必要向量是 'source'、'target'、'value',如下所示:
硬编码桑基图:
我的问题是使用 rpart 对象 'fit' 我似乎无法轻易获得一个向量来生成所需的 'source'、'target' 和 'value' 向量阴谋地.
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 个向量,以便 plotly 生成桑基图?该图将在网络应用程序中使用,因此必须使用 plotly,因为我们已经有了与之对应的 javascript,并且它必须易于重用才能应用于各种数据集。
这是我的尝试:
据我所知,挑战在于生成 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")
我暂时有一个临时的解决办法。我只是不喜欢加载额外的库。但这里是: 为 Iris 数据集拟合模型:
fit <- rpart(Species~Sepal.Length +Sepal.Width ,
method="class", data=iris)
printcp(fit)
plot(fit, uniform=TRUE,
main="Classification Tree for IRIS")
text(fit, use.n=TRUE, all=TRUE, cex=.8)
我用来获取节点名称的方法是:
treeFrame=fit$frame
nodes=sapply(row.names(treeFrame),function(x) unlist(rpart::path.rpart(fit,x))
[length(unlist(rpart::path.rpart(fit,x)))])
但在@BigDataScientist 解决方案中有更好的方法:
treeFrame=fit$frame
isLeave <- treeFrame$var == "<leaf>"
nodes <- rep(NA, length(isLeave))
ylevel <- attr(fit, "ylevels")
nodes[isLeave] <- ylevel[treeFrame$yval][isLeave]
nodes[!isLeave] <- labels(fit)[-1][!isLeave[-length(isLeave)]]
现在获取源和目标仍然有点棘手,但对我有帮助的是 rpart.utils 包:
library('rpart.utils')
treeFrame=fit$frame
treeRules=rpart.utils::rpart.rules(fit)
targetPaths=sapply(as.numeric(row.names(treeFrame)),function(x)
strsplit(unlist(treeRules[x]),split=","))
lastStop= sapply(1:length(targetPaths),function(x) targetPaths[[x]]
[length(targetPaths[[x]])])
oneBefore= sapply(1:length(targetPaths),function(x) targetPaths[[x]]
[length(targetPaths[[x]])-1])
target=c()
source=c()
values=treeFrame$n
for(i in 2:length(oneBefore))
{
tmpNode=oneBefore[[i]]
q=which(lastStop==tmpNode)
q=ifelse(length(q)==0,1,q)
source=c(source,q)
target=c(target,i)
}
source=source-1
target=target-1
所以我不喜欢使用额外的库,但这似乎适用于各种数据集。并且使用@BigDataScientist 获取节点的方式更好。但我仍然会寻找更好的解决方案。 @BigDataScientist 我认为您的解决方案会更好地工作,也许需要更改一些小的东西。但是我还不太理解你代码的 "reps" 部分。
最后的剧情代码是:
p <- plot_ly(
type = "sankey",
orientation = "v",
node = list(
label = nodes,
pad = 15,
thickness = 20,
line = list(
color = "black",
width = 0.5
)
),
link = list(
source = source,
target = target,
value=values[-1]
)
) %>%
layout(
title = "Basic Sankey Diagram",
font = list(
size = 10
)
)
p