如何将partykit决策树终端节点的箱线图替换为小提琴图？

partykit包的plot.constparty()函数可通过node_boxplot()展示决策树终端节点的分布，以下是iris数据集的示例代码：

library("partykit")
ct <- ctree(Petal.Length ~ Sepal.Length + Sepal.Width, data = iris, stump = TRUE)
plot(ct, terminal_panel = node_boxplot)

需求如下：

• 将终端节点的箱线图替换为小提琴图，已知可通过自定义面板函数实现，但不清楚如何用grid函数绘制小提琴图
• 若实现单响应场景的小提琴图面板，如何将其应用到多响应变量场景，替换node_mvar()生成的箱线图

一、单响应变量：自定义小提琴图终端面板函数 #

我们可以基于vioplot包生成小提琴图的核心数据，再用grid函数将其绘制到决策树的终端节点中，具体实现如下：

1. 安装依赖包（若未安装）：

install.packages(c("partykit", "vioplot", "grid"))

2. 自定义node_violin()面板函数：

node_violin <- function(obj, col = "lightgray", border = "black", 
                        horizontal = TRUE, ...) {
  # 提取节点的响应变量数据
  y <- obj$fitted[["(response)"]]
  # 生成小提琴图的计算参数（不直接绘图）
  vp_stats <- vioplot::vioplot(y, plot = FALSE)
  
  # 初始化grid视口
  grid::pushViewport(grid::viewport(layout = grid::grid.layout(1, 1)))
  
  # 绘制小提琴图的左右轮廓
  grid::grid.polygon(x = vp_stats$left, y = vp_stats$y, 
                     gp = grid::gpar(fill = col, col = border))
  grid::grid.polygon(x = vp_stats$right, y = vp_stats$y, 
                     gp = grid::gpar(fill = col, col = border))
  
  # 添加中位数线（红色粗线）
  grid::grid.lines(x = c(min(vp_stats$left), max(vp_stats$right)), 
                   y = rep(vp_stats$stats[3], 2), 
                   gp = grid::gpar(col = "red", lwd = 2))
  
  # 添加上下四分位数线（深红色细线）
  grid::grid.lines(x = c(vp_stats$left[which.min(abs(vp_stats$y - vp_stats$stats[2]))], 
                         vp_stats$right[which.min(abs(vp_stats$y - vp_stats$stats[2]))]), 
                   y = rep(vp_stats$stats[2], 2), 
                   gp = grid::gpar(col = "darkred", lwd = 1))
  grid::grid.lines(x = c(vp_stats$left[which.min(abs(vp_stats$y - vp_stats$stats[4]))], 
                         vp_stats$right[which.min(abs(vp_stats$y - vp_stats$stats[4]))]), 
                   y = rep(vp_stats$stats[4], 2), 
                   gp = grid::gpar(col = "darkred", lwd = 1))
  
  grid::popViewport()
}

3. 调用示例：

library("partykit")
ct <- ctree(Petal.Length ~ Sepal.Length + Sepal.Width, data = iris, stump = TRUE)
plot(ct, terminal_panel = node_violin)

二、多响应变量：替换node_mvar()的箱线图为小提琴图 #

针对多响应场景，我们需要自定义支持多变量的面板函数，对每个响应变量分别绘制小提琴图并按垂直布局排列：

1. 自定义node_mvar_violin()函数：

node_mvar_violin <- function(obj, col = "lightgray", border = "black", 
                             horizontal = TRUE, ...) {
  # 提取多响应变量数据
  y_mat <- obj$fitted[["(response)"]]
  var_count <- ncol(y_mat)
  var_names <- colnames(y_mat)
  
  # 创建网格布局：每个响应变量占一行
  grid::pushViewport(grid::viewport(layout = grid::grid.layout(var_count, 1)))
  
  # 循环绘制每个响应变量的小提琴图
  for (i in seq(var_count)) {
    grid::pushViewport(grid::viewport(layout.pos.row = i, layout.pos.col = 1))
    
    y_i <- y_mat[, i]
    vp_stats <- vioplot::vioplot(y_i, plot = FALSE)
    
    # 绘制小提琴轮廓
    grid::grid.polygon(x = vp_stats$left, y = vp_stats$y, 
                       gp = grid::gpar(fill = col, col = border))
    grid::grid.polygon(x = vp_stats$right, y = vp_stats$y, 
                       gp = grid::gpar(fill = col, col = border))
    
    # 添加中位数和四分位数线
    grid::grid.lines(x = c(min(vp_stats$left), max(vp_stats$right)), 
                     y = rep(vp_stats$stats[3], 2), 
                     gp = grid::gpar(col = "red", lwd = 2))
    grid::grid.lines(x = c(vp_stats$left[which.min(abs(vp_stats$y - vp_stats$stats[2]))], 
                           vp_stats$right[which.min(abs(vp_stats$y - vp_stats$stats[2]))]), 
                     y = rep(vp_stats$stats[2], 2), 
                     gp = grid::gpar(col = "darkred", lwd = 1))
    grid::grid.lines(x = c(vp_stats$left[which.min(abs(vp_stats$y - vp_stats$stats[4]))], 
                           vp_stats$right[which.min(abs(vp_stats$y - vp_stats$stats[4]))]), 
                     y = rep(vp_stats$stats[4], 2), 
                     gp = grid::gpar(col = "darkred", lwd = 1))
    
    # 添加变量名称标签
    grid::grid.text(var_names[i], x = 0.05, y = 0.5, just = "left")
    
    grid::popViewport()
  }
  
  grid::popViewport()
}

2. 多响应变量调用示例：

# 构建多响应数据集
iris_mvar <- iris[, c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width")]
# 训练多响应决策树
ct_mvar <- ctree(cbind(Sepal.Length, Sepal.Width) ~ Petal.Length + Petal.Width, 
                 data = iris_mvar, stump = TRUE)
# 绘制带小提琴图的多响应决策树
plot(ct_mvar, terminal_panel = node_mvar_violin)

内容的提问来源于stack exchange，提问作者fmherla