小提琴图使用列表输入

4

我正在使用vioplot包中的vioplot函数,并希望将列表作为输入。以下是我的代码:

# Violin Plots
library(vioplot)
x1 <- mtcars$mpg[mtcars$cyl==4]
x2 <- mtcars$mpg[mtcars$cyl==6]
x3 <- mtcars$mpg[mtcars$cyl==8]
vioplot(x1, x2, x3, names=c("4 cyl", "6 cyl", "8 cyl"),
   col="gold")
title("Violin Plots of Miles Per Gallon")

我希望你能帮忙翻译以下内容:

我想要做的是:

# Violin Plots
library(vioplot)
x1 <- mtcars$mpg[mtcars$cyl==4]
x2 <- mtcars$mpg[mtcars$cyl==6]
x3 <- mtcars$mpg[mtcars$cyl==8]
l<-list(x1,x2,x3)
vioplot(l, names=c("4 cyl", "6 cyl", "8 cyl"),
   col="gold")
title("Violin Plots of Miles Per Gallon")

但是我遇到了这个错误:
Error in min(data) : invalid 'type' (list) of argument

你能帮忙吗?谢谢!


l的更清晰的定义(绕过首先执行所有x的需要)是l <- split(mtcars, mtcars$cyl) - Gregor Thomas
在vioplot()中,也可以使用add=TRUE参数,并使用'at'参数控制位置。然后可以使用lapply()来绘制向量列表。请记得根据需要设置xlim和ylim,例如在空图中首先设置。 - Nightwriter
3个回答

5

我已经修改了vioplot函数,使其可以接受列表作为输入,你可以使用这个vioplot2函数:

vioplot2<-function (x, ..., range = 1.5, h = NULL, ylim = NULL, names = NULL, 
    horizontal = FALSE, col = "magenta", border = "black", lty = 1, 
    lwd = 1, rectCol = "black", colMed = "white", pchMed = 19, 
    at, add = FALSE, wex = 1, drawRect = TRUE) 
{
    if(!is.list(x)){
        datas <- list(x, ...)
    } else{
        datas<-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, 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, 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))
}

您的示例将得到如下内容: 这里输入图片描述

1
我认为我们应该写信给vioplot的作者,通知他们这个更新(dadler at uni-goettingen.de)。 - Tonio
好主意!我刚刚做了它。 - Federico Giorgi

1

这里是另一种解决方案,使用lapply添加彩色小提琴图:

library(vioplot)

# Set up data
x1 <- mtcars$mpg[mtcars$cyl==4]
x2 <- mtcars$mpg[mtcars$cyl==6]
x3 <- mtcars$mpg[mtcars$cyl==8]
l <- list(x1,x2,x3)

# Colors
mycol <- c("yellow", "green", "blue")

# Set up plot without violins
plot("", xlim = c(0.5, length(l)+0.5), ylim = c(min(unlist(l)), max(unlist(l))), xaxt = "n",  xlab = "", ylab = "Miles Per Gallon")
axis(1, labels = c("4cyl", "6cyl", "8cyl"), at = c(1:length(l)))

# Add violins from list
lapply(seq_along(l), function(x)
  vioplot(l[[x]], at = x, col = mycol[x], add = T, box = F)
  )

完成!

Violin plots generated from list


1
我已在Github上的一个函数(R包)中包含了上述解决方案。它应该可以像boxplot一样工作(包括公式输入),还包括许多其他自定义功能,例如每个小提琴的单独颜色。
安装和加载方式如下:
install.packages("devtools")
devtools::install_github("TomKellyGenetics/vioplotx")
library("vioplotx")

所以就像你会制作一个箱线图一样:
# Set up data
data(mtcars)
x1 <- mtcars$mpg[mtcars$cyl==4]
x2 <- mtcars$mpg[mtcars$cyl==6]
x3 <- mtcars$mpg[mtcars$cyl==8]
l<-list(x1,x2,x3)

# Boxplots
boxplot(l, names=c("4 cyl", "6 cyl", "8 cyl"), col="gold")
title("Boxplots of Miles Per Gallon")

enter image description here

你可以使用“vioplotx”来完成同样的任务:
因此,就像制作小提琴图一样:
# Violin plots
vioplotx(l, names=c("4 cyl", "6 cyl", "8 cyl"), col="gold")
title("Violin plots of Miles Per Gallon")

enter image description here

这也可以通过向量输入进行额外的自定义:
vioplotx(l, names=c("4 cyl", "6 cyl", "8 cyl"), col=c("cyan", "magenta", "green"))

enter image description here

这是对Daniel Adler的“vioplot”包进行修改,其中包括基于Federico Giorgi在此处的回答所进行的更改。这仅旨在使运行此类修改变得更加容易。

由于原始的vioplot软件包(版本0.2)已经被遗弃,我已将这些更改提交到CRAN存储库进行审核。https://github.com/TomKellyGenetics/vioplot - Tom Kelly
这个版本的vioplot现在已经被CRAN接受。 - Tom Kelly

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接