旋转分类树终端Barplot轴 - R

Question

我有一个分类树分析使用ctree()想知道如何旋转终端节点，以便轴是垂直的？

library(party) 
data(iris) 
attach(iris) 
plot(ctree(Species ~ Sepal.Length + Sepel.Width 
    + Petal.Length + Petal.Width, data = iris)) 

Answer 1

这是我该如何去做的。不是最短的答案，但我希望尽可能彻底。

由于我们正在策划你的树，它可能是一个好主意，看看在适当的绘图功能的文档：

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参数的以下说明：

绘制终端节点的窗体函数（节点） 的可选面板函数。或者，一个产生 函数的面板“grapcon_generator”被调用参数x 和tp_args来设置面板函数。默认情况下，根据相关的变量 的比例选择合适的面板函数。

进一步向下的文档是链接到?node_barplot。这是我猜是被用作默认值，并调用以下证明猜对了：

plot(ctree, terminal_panel = node_barplot(ctree)) 

（输出相同的原始图）。

遗憾的是，node_barplot没有horizontal或horiz参数。查看该函数的代码，只需在提示符处输入node_barplot，即可显示图形是使用视口“手工绘制”的。不幸的是，我能找到的唯一方法就是编辑这个函数。我试图让我的变化明显地：

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

现在我们可以测试一下吧！

plot(ctree, terminal_panel = alt_node_barplot(ctree, horiz = TRUE)) 

下面是输出：

就在几个点：

• 我承认，这可能不是你的问题的解决方案。这只是解决这类问题的一种方式，而不存在更简单的选项。

• 不要相信我完全给出的功能。如您所见，beside参数会自动禁用horiz参数（我的第一次编辑），因为我没有更改处理beside为真的代码段。如果你想在这种情况下工作，你必须自己做这些编辑 - 看看?viewport和?grid.rect开始。我很肯定reverse功能也被打破，但没有测试任何东西。如果我对它进行了一点点屠杀，我对这个函数的原作者抱歉，这只是一个示范。

我希望这会有所帮助。祝你好运，你需要做任何进一步的编辑！