有没有办法在violins包绘图命令中禁用y轴（yaxt="n"不起作用）或指定它？
library(violins)
df=data.frame(x=rnorm(100,0,1),y=rnorm(100,1,1),z=rnorm(100,2,3))
violins(df,yaxt="n")
Error in violins(df, yaxt = "n") : unused argument (yaxt = "n")
答案 0 :(得分：1)
您可能需要将函数重写为以下内容：
violins_ <- function (x, by, range = 1.5, h = NULL, ylim = NULL, names = NULL,
horizontal = FALSE, col = "transparent", border = "black",
lty = 1, lwd = 1, rectCol = "grey50", colMed = "grey80",
pchMed = 19, at, add = FALSE, wex = 1, drawRect = TRUE, main = "",
xlab = "", ylab = "", connect = c("median", "mean", "hubermu",
"deciles"), SD.or.SE = c("SD"), connectcol = c("lightblue",
"cyan", "darkred", "grey"), las = 2, stats = FALSE, quantiles = c(0.1,
0.9), CImed = TRUE, deciles = TRUE)
{
options(warnings = -1)
require(sm)
if (is.data.frame(x))
x <- as.list.data.frame(x)
if (!missing(by)) {
if (is.numeric(by))
x <- .cat2list(x[order(by)], sort(by))
if (!is.numeric(by))
x <- .cat2list(x, by)
}
if (is.list(x)) {
datas <- x
if (length(names) == 0)
names <- names(x)
}
else {
datas <- list(x)
}
n <- length(datas)
if (missing(at))
at <- 1:n
upper <- vector(mode = "numeric", length = n)
lower <- vector(mode = "numeric", length = n)
q.1 <- vector(mode = "numeric", length = n)
q1 <- vector(mode = "numeric", length = n)
q3 <- vector(mode = "numeric", length = n)
q.9 <- vector(mode = "numeric", length = n)
med <- vector(mode = "numeric", length = n)
hubermu <- vector(mode = "numeric", length = n)
average <- vector(mode = "numeric", length = n)
stddevlower <- vector(mode = "numeric", length = n)
stddevupper <- vector(mode = "numeric", length = n)
stderrlower <- vector(mode = "numeric", length = n)
stderrupper <- vector(mode = "numeric", length = n)
base <- vector(mode = "list", length = n)
height <- vector(mode = "list", length = n)
medCI05 <- vector(mode = "list", length = n)
medCI95 <- vector(mode = "list", length = n)
decile <- matrix(NA, nrow = n, ncol = 9)
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, na.rm = TRUE)
data.max <- max(data, na.rm = TRUE)
q.1[i] <- quantile(data, quantiles[1], na.rm = TRUE)
q1[i] <- quantile(data, 0.25, na.rm = TRUE)
q3[i] <- quantile(data, 0.75, na.rm = TRUE)
q.9[i] <- quantile(data, quantiles[2], na.rm = TRUE)
med[i] <- median(data, na.rm = TRUE)
medCI05[i] <- caroline:::.ci.median(data)$ci[2]
medCI95[i] <- caroline:::.ci.median(data)$ci[3]
hubermu[i] <- caroline:::.huber.mu(data)
average[i] <- mean(data)
iqd <- q3[i] - q1[i]
upper[i] <- min(q3[i] + range * iqd, data.max)
lower[i] <- max(q1[i] - range * iqd, data.min)
stddevlower[i] <- average[i] - sd(data)
stddevupper[i] <- average[i] + sd(data)
if (deciles)
for (j in 1:9) decile[i, j] <- quantile(data, j/10)
N <- length(data)
stderrlower[i] <- average[i] - (sd(data)/sqrt(N))
stderrupper[i] <- average[i] + (sd(data)/sqrt(N))
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
if (length(at) == 1)
at <- 1:n + at
}
boxwidth <- 0.05 * wex
if (!add)
plot.new()
if (!horizontal) {
if (!add) {
plot.window(xlim = xlim, ylim = ylim, las = las)
#axis(2, las = las)
axis(1, at = at, labels = label, las = las)
title(main, xlab = xlab, ylab = ylab)
}
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[i], border = border,
lty = lty, lwd = lwd)
if (drawRect) {
if (deciles)
for (j in 1:9) rect(at[i] - boxwidth * wex,
decile[i, j], at[i] + boxwidth * wex, decile[i,
j], lwd = 0.3 * lwd)
lines(at[c(i, i)], c(lower[i], upper[i]), lwd = lwd,
lty = lty)
rect(at[i] - boxwidth * wex, q.1[i], at[i] +
boxwidth * wex, q.9[i], col = "transparent",
lty = 3)
rect(at[i] - boxwidth/3 * wex, q1[i], at[i] +
boxwidth/3 * wex, q3[i], col = rectCol)
if (any(SD.or.SE == "SD"))
lines(at[c(i + 0.05, i + 0.05)], c(stddevlower[i],
stddevupper[i]), lwd = lwd * 4 * wex, lty = lty)
if (any(SD.or.SE == "SE"))
lines(at[c(i + 0.05, i + 0.05)], c(stderrlower[i],
stderrupper[i]), lwd = lwd * 4 * wex, lty = lty)
points(at[i], med[i], pch = pchMed, col = colMed)
if (CImed)
rect(at[i] - boxwidth/1.6 * wex, medCI05[i],
at[i] + boxwidth/1.6 * wex, medCI95[i])
points(at[i], hubermu[i], pch = 12, col = colMed)
points(at[i], average[i], pch = 13, col = colMed)
}
s <- seq(length(datas))
s <- s[-length(s)]
if (any(connect == "median"))
segments(at[s], med[s], at[s + 1], med[s + 1],
col = connectcol[1])
if (any(connect == "hubermu"))
segments(at[s], hubermu[s], at[s + 1], hubermu[s +
1], col = connectcol[2])
if (any(connect == "mean"))
segments(at[s], average[s], at[s + 1], average[s +
1], col = connectcol[3])
if (deciles & any(connect == "deciles"))
for (j in 1:9) segments(at[s], decile[s, j],
at[s + 1], decile[s + 1, j], lwd = 0.6 * lwd,
col = connectcol[4])
}
}
else {
if (!add) {
plot.window(xlim = ylim, ylim = xlim, las = las)
#axis(1, las = las)
axis(2, at = at, labels = label, las = las)
}
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[i], border = border,
lty = lty, lwd = lwd)
if (drawRect) {
if (deciles)
for (j in 1:9) rect(decile[i, j], at[i] - boxwidth *
wex, decile[i, j], at[i] + boxwidth * wex,
lwd = 0.5 * lwd)
lines(c(lower[i], upper[i]), at[c(i, i)], lwd = lwd,
lty = lty)
rect(q.1[i], at[i] - boxwidth * wex, q.9[i],
at[i] + boxwidth * wex, col = "transparent",
lty = 3)
rect(q1[i], at[i] - boxwidth/3 * wex, q3[i],
at[i] + boxwidth/3 * wex, col = rectCol)
if (any(SD.or.SE == "SD"))
lines(c(stddevlower[i], stddevupper[i]), at[c(i +
0.05, i + 0.05)], lwd = lwd * 4 * wex, lty = lty)
if (any(SD.or.SE == "SE"))
lines(c(stderrlower[i], stderrupper[i]), at[c(i +
0.05, i + 0.05)], lwd = lwd * 4 * wex, lty = lty)
if (CImed)
rect(medCI05[i], at[i] - boxwidth/1.6 * wex,
medCI95[i], at[i] + boxwidth/1.6 * wex)
points(med[i], at[i], pch = pchMed, col = colMed)
points(average[i], at[i], pch = 13, col = colMed)
}
s <- seq(length(datas))
s <- s[-length(s)]
if (any(connect == "median"))
segments(med[s], at[s], med[s + 1], at[s + 1],
col = connectcol[1])
if (any(connect == "hubermu"))
segments(hubermu[s], at[s], hubermu[s + 1], at[s +
1], col = connectcol[2])
if (any(connect == "mean"))
segments(average[s], at[s], average[s + 1], at[s +
1], col = connectcol[3])
if (deciles & any(connect == "deciles"))
for (j in 1:9) segments(decile[s, j], at[s],
decile[s + 1, j], at[s + 1], lwd = 0.6 * lwd,
col = connectcol[4])
}
}
if (stats) {
if (all(quantiles == c(0, 0)))
quantiles = c(0.25, 0.75)
stats(x, by, quantiles)
}
}
答案 1 :(得分：0)
我想你的意思是来自caroline包的函数。
您可以通过手动更改此图形参数来禁用y轴。这个新设置将被axis()函数识别，violins()在绘图的某个步骤由内部调用。
library(caroline)
df=data.frame(x=rnorm(100,0,1),y=rnorm(100,1,1),z=rnorm(100,2,3))
par(yaxt='n')
violins(df)
不幸的是，violins()中的许多图形参数似乎都是硬编码的。我想要不同的轴，使用par()禁用它们，然后使用您喜欢的设置手动调用axis()。