partykit-修改箱线图的端子节点,以在对数刻度中显示y轴

我试图绘制一个回归树 rpart 使用 partykit 。生成树的代码如下:

library("rpart")
fit <- rpart(Price ~ Mileage + Type + Country, cu.summary)
library("partykit")
tree.2 <- as.party(fit)

plot(tree.2, type = "simple", terminal_panel = node_boxplot(tree.2,
                                                            col = "black", fill = "lightgray", width = 0.5, yscale = NULL,
                                                            ylines = 3, cex = 0.5, id = TRUE))

我试图修改终端节点上的箱线图,以便y轴位于对数刻度上。

我知道,当试图制作箱线图时,我们所要做的就是指定 boxplot(data, log="y") 。这就是我试图修改函数的原因 node_boxplot 仅在功能 boxplot 已使用。然而,我一直得到相同的图表。我有什么遗漏吗?如有任何反馈,我们将不胜感激。

node_boxplot2<-function (obj, col = "black", fill = "lightgray", bg = "white", 
          width = 0.5, yscale = NULL, ylines = 3, cex = 0.5, id = TRUE, 
          mainlab = NULL, gp = gpar()) 
{
  y <- log(obj$fitted[["(response)"]])
  stopifnot(is.numeric(y))
  if (is.null(yscale)) 
    yscale <- range(y) +c(0,0.1)* diff(range(y))
  rval <- function(node) {
    nid <- id_node(node)
    dat <- data_party(obj, nid)
    yn <- dat[["(response)"]]
    wn <- dat[["(weights)"]]
    if (is.null(wn)) 
      wn <- rep(1, length(yn))
    x <- boxplot(rep.int(yn, wn),plot = FALSE)
    top_vp <- viewport(layout = grid.layout(nrow = 2, ncol = 3, 
                                            widths = unit(c(ylines, 1, 1), 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_boxplot", 
                                                                                                                                                                                                           nid, sep = ""), gp = gp)
    pushViewport(top_vp)
    grid.rect(gp = gpar(fill = bg, col = 0))
    top <- viewport(layout.pos.col = 2, layout.pos.row = 1)
    pushViewport(top)
    if (is.null(mainlab)) {
      mainlab <- if (id) {
        function(id, nobs) sprintf("Node %s (n = %s)", 
                                   id, nobs)
      }
      else {
        function(id, nobs) sprintf("n = %s", nobs)
      }
    }
    if (is.function(mainlab)) {
      mainlab <- mainlab(names(obj)[nid], sum(wn))
    }
    grid.text(mainlab)
    popViewport()
    plot <- viewport(layout.pos.col = 2, layout.pos.row = 2, 
                     xscale = c(0, 1), yscale = yscale, name = paste0("node_boxplot", 
                                                                      nid, "plot"), clip = FALSE)
    pushViewport(plot)
    grid.yaxis()
    grid.rect(gp = gpar(fill = "transparent"))
    grid.clip()
    xl <- 0.5 - width/4
    xr <- 0.5 + width/4
    grid.lines(unit(c(xl, xr), "npc"), unit(x$stats[1], "native"), 
               gp = gpar(col = col))
    grid.lines(unit(0.5, "npc"), unit(x$stats[1:2], "native"), 
               gp = gpar(col = col, lty = 2))
    grid.rect(unit(0.5, "npc"), unit(x$stats[2], "native"), 
              width = unit(width, "npc"), height = unit(diff(x$stats[c(2, 
                                                                       4)]), "native"), just = c("center", "bottom"), 
              gp = gpar(col = col, fill = fill))
    grid.lines(unit(c(0.5 - width/2, 0.5 + width/2), "npc"), 
               unit(x$stats[3], "native"), gp = gpar(col = col, 
                                                     lwd = 2))
    grid.lines(unit(0.5, "npc"), unit(x$stats[4:5], "native"), 
               gp = gpar(col = col, lty = 2))
    grid.lines(unit(c(xl, xr), "npc"), unit(x$stats[5], "native"), 
               gp = gpar(col = col))
    n <- length(x$out)
    if (n > 0) {
      index <- 1:n
      if (length(index) > 0) 
        grid.points(unit(rep.int(0.5, length(index)), 
                         "npc"), unit(x$out[index], "native"), size = unit(cex, 
                                                                           "char"), gp = gpar(col = col))
    }
    upViewport(2)
  }
  return(rval)
}