图案填充小提琴图（vioplot包）

Question

使用vioplot包在R中创建图时，是否有方法填充不同图案的小提琴图？

我已经想出了如何使用col来更改颜色，如下所示。但我甚至不知道如何开始在vioplot孵化。

vioplot(random_value, at = 0.5, add = T, h = 0.04, col = 'lightsalmon4') 

我已经使用density和angle，但这些并不能帮助。

Answer 1

我在回答我自己的问题，以防万一以后可能对其他人有用。看起来像vioplot包本身不允许它创建的小提琴情节中的“阴影”或“纹理”。但是，似乎可以通过对默认的vioplot函数进行小的更改来实现，以将density和angle合并到它创建的作为小提琴图的多边形中。

vioplot2 = function (x, ..., range = 1.5, h = NULL, ylim = NULL, names = NULL, 
    horizontal = FALSE, col = "magenta", border = "black", lty = 1, 
    lwd = 1, rectCol = "black", density = NA, angle = 45, colMed = "white", pchMed = 19, 
    at, add = FALSE, wex = 1, drawRect = TRUE) 
{ 
    datas <- list(x, ...) 
    n <- length(datas) 
    if (missing(at)) 
     at <- 1:n 
    upper <- vector(mode = "numeric", length = n) 
    lower <- vector(mode = "numeric", length = n) 
    q1 <- vector(mode = "numeric", length = n) 
    q3 <- vector(mode = "numeric", length = n) 
    med <- vector(mode = "numeric", length = n) 
    base <- vector(mode = "list", length = n) 
    height <- vector(mode = "list", length = n) 
    baserange <- c(Inf, -Inf) 
    args <- list(display = "none") 
    if (!(is.null(h))) 
     args <- c(args, h = h) 
    for (i in 1:n) { 
     data <- datas[[i]] 
     data.min <- min(data) 
     data.max <- max(data) 
     q1[i] <- quantile(data, 0.25) 
     q3[i] <- quantile(data, 0.75) 
     med[i] <- median(data) 
     iqd <- q3[i] - q1[i] 
     upper[i] <- min(q3[i] + range * iqd, data.max) 
     lower[i] <- max(q1[i] - range * iqd, data.min) 
     est.xlim <- c(min(lower[i], data.min), max(upper[i], 
      data.max)) 
     smout <- do.call("sm.density", c(list(data, xlim = est.xlim), 
      args)) 
     hscale <- 0.4/max(smout$estimate) * wex 
     base[[i]] <- smout$eval.points 
     height[[i]] <- smout$estimate * hscale 
     t <- range(base[[i]]) 
     baserange[1] <- min(baserange[1], t[1]) 
     baserange[2] <- max(baserange[2], t[2]) 
    } 
    if (!add) { 
     xlim <- if (n == 1) 
      at + c(-0.5, 0.5) 
     else range(at) + min(diff(at))/2 * c(-1, 1) 
     if (is.null(ylim)) { 
      ylim <- baserange 
     } 
    } 
    if (is.null(names)) { 
     label <- 1:n 
    } 
    else { 
     label <- names 
    } 
    boxwidth <- 0.05 * wex 
    if (!add) 
     plot.new() 
    if (!horizontal) { 
     if (!add) { 
      plot.window(xlim = xlim, ylim = ylim) 
      axis(2) 
      axis(1, at = at, label = label) 
     } 
     box() 
     for (i in 1:n) { 
      polygon(c(at[i] - height[[i]], rev(at[i] + height[[i]])), 
       c(base[[i]], rev(base[[i]])), col = col, density = density, angle = angle, border = border, 
       lty = lty, lwd = lwd) 
      if (drawRect) { 
       lines(at[c(i, i)], c(lower[i], upper[i]), lwd = lwd, 
        lty = lty) 
       rect(at[i] - boxwidth/2, q1[i], at[i] + boxwidth/2, 
        q3[i], col = rectCol) 
       points(at[i], med[i], pch = pchMed, col = colMed) 
      } 
     } 
    } 
    else { 
     if (!add) { 
      plot.window(xlim = ylim, ylim = xlim) 
      axis(1) 
      axis(2, at = at, label = label) 
     } 
     box() 
     for (i in 1:n) { 
      polygon(c(base[[i]], rev(base[[i]])), c(at[i] - height[[i]], 
       rev(at[i] + height[[i]])), col = col, density = density, angle = angle, border = border, 
       lty = lty, lwd = lwd) 
      if (drawRect) { 
       lines(c(lower[i], upper[i]), at[c(i, i)], lwd = lwd, 
        lty = lty) 
       rect(q1[i], at[i] - boxwidth/2, q3[i], at[i] + 
        boxwidth/2, col = rectCol) 
       points(med[i], at[i], pch = pchMed, col = colMed) 
      } 
     } 
    } 
    invisible(list(upper = upper, lower = lower, median = med, 
     q1 = q1, q3 = q3)) 
} 

用法

set.seed(42) 
x = rnorm(50,20,4) 
vioplot2(x,density = 9, angle = 20)