旋转分类树终端Barplot轴-R [英] Rotate Classification Tree Terminal Barplot axis - R
问题描述
我有一个使用ctree()分析的分类树，想知道如何旋转终端节点以使轴垂直?
I have a classification tree analyzed using ctree() was wondering how can one rotate the terminal nodes so that the axes are vertical?
library(party)
data(iris)
attach(iris)
plot(ctree(Species ~ Sepal.Length + Sepel.Width
+ Petal.Length + Petal.Width, data = iris))
推荐答案
以下是我的处理方法.不是最短的答案，但我想尽可能地透彻.
Here is how I would go about it. Not the shortest answer, but I wanted to be as thorough as possible.
由于我们正在绘制您的树，因此查看适当的绘制功能的文档可能是个好主意:
Since we are plotting your tree, it's probably a good idea to look at the documentation for the appropriate plotting function:
library(party)
data(iris)
attach(iris)
ctree <- ctree(Species ~ Sepal.Length + Sepal.Width
+ Petal.Length + Petal.Width, data = iris)
# getting ctree's class
> class(ctree)
[1] "BinaryTree"
attr(,"package")
[1] "party"
来看?'plot.BinaryTree'，我们看到terminal_panel参数的以下描述:
Looking at ?'plot.BinaryTree' we see the following description of the terminal_panel argument:
形式为function(节点)的可选面板功能 绘制终端节点.或者，面板生成 用参数x调用的"grapcon_generator"类的函数 和tp_args来设置面板功能.默认情况下，适当的 面板功能的选择取决于受抚养者的规模 变量.
an optional panel function of the form function(node) plotting the terminal nodes. Alternatively, a panel generating function of class "grapcon_generator" that is called with arguments x and tp_args to set up a panel function. By default, an appropriate panel function is chosen depending on the scale of the dependent variable.
文档中的下一个是?node_barplot的链接.我猜这是默认值，调用以下命令可以证明是正确的:
Further down in the documentation is a link to ?node_barplot. This is what I guessed was being used as a default, and calling the following proved the guess right:
plot(ctree, terminal_panel = node_barplot(ctree))
(输出与原始图相同).
(The output is the same as your original graph).
不幸的是，node_barplot没有任何horizontal或horiz参数.通过简单地在提示符下键入node_barplot来查看此函数的代码，即可发现使用视口手动"绘制了图形.不幸的是，我唯一可以找到的方法就是编辑此功能.我试图使我的更改尽可能明显:
Unfortunately, there's no horizontal or horiz parameters for node_barplot. Looking at the code for this function, by simply typing node_barplot at the prompt, reveals that the graphs are drawn "by hand" using viewports. Unfortunately, the only way I could find to proceed was to edit this function. I tried to make my changes as obvious as possible:
# Note inclusion of horiz = FALSE
alt_node_barplot <- function (ctreeobj, col = "black", fill = NULL, beside = NULL,
ymax = NULL, ylines = NULL, widths = 1, gap = NULL, reverse = NULL,
id = TRUE, horiz = FALSE)
{
getMaxPred <- function(x) {
mp <- max(x$prediction)
mpl <- ifelse(x$terminal, 0, getMaxPred(x$left))
mpr <- ifelse(x$terminal, 0, getMaxPred(x$right))
return(max(c(mp, mpl, mpr)))
}
y <- response(ctreeobj)[[1]]
if (is.factor(y) || class(y) == "was_ordered") {
ylevels <- levels(y)
if (is.null(beside))
beside <- if (length(ylevels) < 3)
FALSE
else TRUE
if (is.null(ymax))
ymax <- if (beside)
1.1
else 1
if (is.null(gap))
gap <- if (beside)
0.1
else 0
}
else {
if (is.null(beside))
beside <- FALSE
if (is.null(ymax))
ymax <- getMaxPred(ctreeobj@tree) * 1.1
ylevels <- seq(along = ctreeobj@tree$prediction)
if (length(ylevels) < 2)
ylevels <- ""
if (is.null(gap))
gap <- 1
}
if (is.null(reverse))
reverse <- !beside
if (is.null(fill))
fill <- gray.colors(length(ylevels))
if (is.null(ylines))
ylines <- if (beside)
c(3, 2)
else c(1.5, 2.5)
# My edit do not work if beside is not true
#################################################
if(!beside) horiz = FALSE
#################################################
rval <- function(node) {
pred <- node$prediction
if (reverse) {
pred <- rev(pred)
ylevels <- rev(ylevels)
}
np <- length(pred)
nc <- if (beside)
np
else 1
fill <- rep(fill, length.out = np)
widths <- rep(widths, length.out = nc)
col <- rep(col, length.out = nc)
ylines <- rep(ylines, length.out = 2)
gap <- gap * sum(widths)
#######################################################
if (!horiz){
yscale <- c(0, ymax)
xscale <- c(0, sum(widths) + (nc + 1) * gap)
} else {
xscale <- c(0, ymax)
yscale <- c(0, sum(widths) + (nc + 1) * gap)
}
#######################################################
top_vp <- viewport(layout = grid.layout(nrow = 2, ncol = 3,
widths = unit(c(ylines[1], 1, ylines[2]), c("lines",
"null", "lines")), heights = unit(c(1, 1), c("lines",
"null"))), width = unit(1, "npc"), height = unit(1,
"npc") - unit(2, "lines"), name = paste("node_barplot",
node$nodeID, sep = ""))
pushViewport(top_vp)
grid.rect(gp = gpar(fill = "white", col = 0))
top <- viewport(layout.pos.col = 2, layout.pos.row = 1)
pushViewport(top)
mainlab <- paste(ifelse(id, paste("Node", node$nodeID,
"(n = "), "n = "), sum(node$weights), ifelse(id,
")", ""), sep = "")
grid.text(mainlab)
popViewport()
plot <- viewport(layout.pos.col = 2, layout.pos.row = 2,
xscale = xscale, yscale = yscale, name = paste("node_barplot",
node$nodeID, "plot", sep = ""))
pushViewport(plot)
if (beside) {
#############################################################
if(!horiz){
xcenter <- cumsum(widths + gap) - widths/2
for (i in 1:np) {
grid.rect(x = xcenter[i], y = 0, height = pred[i],
width = widths[i], just = c("center", "bottom"),
default.units = "native", gp = gpar(col = col[i],
fill = fill[i]))
}
if (length(xcenter) > 1)
grid.xaxis(at = xcenter, label = FALSE)
grid.text(ylevels, x = xcenter, y = unit(-1, "lines"),
just = c("center", "top"), default.units = "native",
check.overlap = TRUE)
grid.yaxis()
} else {
ycenter <- cumsum(widths + gap) - widths/2
for (i in 1:np) {
grid.rect(y = ycenter[i], x = 0, width = pred[i],
height = widths[i], just = c("left", "center"),
default.units = "native", gp = gpar(col = col[i],
fill = fill[i]))
}
if (length(ycenter) > 1)
grid.yaxis(at = ycenter, label = FALSE)
grid.text(ylevels, y = ycenter, x = unit(-1, "lines"),
just = c("right", "center"), default.units = "native",
check.overlap = TRUE)
grid.xaxis()
}
#############################################################
}
else {
ycenter <- cumsum(pred) - pred
for (i in 1:np) {
grid.rect(x = xscale[2]/2, y = ycenter[i], height = min(pred[i],
ymax - ycenter[i]), width = widths[1], just = c("center",
"bottom"), default.units = "native", gp = gpar(col = col[i],
fill = fill[i]))
}
if (np > 1) {
grid.text(ylevels[1], x = unit(-1, "lines"),
y = 0, just = c("left", "center"), rot = 90,
default.units = "native", check.overlap = TRUE)
grid.text(ylevels[np], x = unit(-1, "lines"),
y = ymax, just = c("right", "center"), rot = 90,
default.units = "native", check.overlap = TRUE)
}
if (np > 2) {
grid.text(ylevels[-c(1, np)], x = unit(-1, "lines"),
y = ycenter[-c(1, np)], just = "center", rot = 90,
default.units = "native", check.overlap = TRUE)
}
grid.yaxis(main = FALSE)
}
grid.rect(gp = gpar(fill = "transparent"))
upViewport(2)
}
return(rval)
}
现在我们可以对其进行测试！
And now we can test it!
plot(ctree, terminal_panel = alt_node_barplot(ctree, horiz = TRUE))
这是输出:
几点:
-
我承认这可能无法解决您的问题.当不存在更简单的选项时，这仅仅是解决此类问题的一种方法.
I admit that this may not THE solution to your problem. It is merely a way of going about solving this type of problem, when easier options do not exist.
完全不信任我上面给出的功能.如您所见，由于我没有更改处理beside为true的代码部分，因此beside参数自动禁用了horiz参数(我的第一次编辑).如果您希望它在这种情况下起作用，则您必须自己进行这些编辑-看一下?viewport和?grid.rect来开始.我很确定reverse函数也已损坏，但是还没有测试任何东西.如果我对此功能稍作保留，请向该功能的原始作者表示歉意，这仅是为了演示.
Don't trust the function I gave above completely. As you can see, the beside parameter disables the horiz parameter automatically (my first edit) since I did not alter the sections of code that deal with beside being true. If you want it to work in this case, you'll have to make those edits yourself - take a look at ?viewport and ?grid.rect to get started. I'm pretty sure the reverse function is also broken, but haven't tested anything. Apologies to the original authors of the function if I butchered it a bit, this was merely meant to be a demonstration.
我希望这能有所帮助.祝您进行任何进一步的编辑祝您好运！
I hope this helped a bit. Good luck with any further edits you need to make!
这篇关于旋转分类树终端Barplot轴-R的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
