如何在R中创建相关图和图例？

Question

在下面的代码中，我想使用循环在图上共享当rho.AB为-0.9、0和0.9时改变的图的形状。我也想表达这个传说。请你能帮帮我。...

mu.A = 0.075
sig.A = 0.258
sig2.A = sig.A^2

mu.B = 0.055
sig.B = 0.115
sig2.B = sig.B^2


rho.AB = -0.164

sig.AB = rho.AB*sig.A*sig.B


x.A = seq(from=0.0, to=1.0, by=0.1)
x.B = 1 - x.A
mu.p = x.A*mu.A + x.B*mu.B
sig2.p = x.A^2 * sig2.A + x.B^2 * sig2.B + 2*x.A*x.B*sig.AB
sig.p = sqrt(sig2.p)

dev.new()
cex.val = 1.5
plot(sig.p, mu.p, type="b", pch=16, cex = cex.val,
     ylim=c(0.052, max(mu.p)), xlim=c(0.08, max(sig.p)+0.04),
     xlab=expression(sigma[p]), ylab=expression(mu[p]), cex.lab=cex.val)

Answer 1

如果只想作一个简单的图，可以将代码包装在for循环中，遍历rho.AB个值的向量。

mu.A = 0.075
sig.A = 0.258
sig2.A = sig.A^2

mu.B = 0.055
sig.B = 0.115
sig2.B = sig.B^2

# Initialize a plotting window with the correct dimensions
plot(0, xlim=c(0.01, 0.26), ylim=c(mu.B, mu.A), cex=0, ann=FALSE)

for (rho.AB in seq(-0.9, 1, by=0.1)) {

    sig.AB = rho.AB*sig.A*sig.B

    x.A = seq(from=0.0, to=1.0, by=0.1)
    x.B = 1 - x.A
    mu.p = x.A*mu.A + x.B*mu.B
    sig2.p = x.A^2 * sig2.A + x.B^2 * sig2.B + 2*x.A*x.B*sig.AB
    sig.p = sqrt(sig2.p)

    # Every loop adds another plot
    lines(sig.p, mu.p, type="b", pch=16,
         xlab=expression(sigma[p]), ylab=expression(mu[p]), cex.lab=cex.val)
}

但是，如果您想要更精美的图表和更灵活的选项，最好将代码变成函数，并使用[sl]apply()遍历值并绘制结果。

wcov <- function(rho.AB=-0.9, mu.A=0.075, mu.B=0.055, 
  sig.A=0.258, sig.B=0.115, x.A=seq(from=0.0, to=1.0, by=0.1)) {
    sig2.A <- sig.A^2
    sig2.B <- sig.B^2
    sig.AB <- rho.AB*sig.A*sig.B

    x.B <- 1 - x.A
    mu.p <- x.A*mu.A + x.B*mu.B
    sig2.p <- x.A^2 * sig2.A + x.B^2 * sig2.B + 2*x.A*x.B*sig.AB
    sig.p <- sqrt(sig2.p)
    data.frame(sig.p, mu.p)
}

# Loop over s values for rho.AB
s <- seq(-0.9, 1, by=0.2)
wcov.l <- lapply(s, function(x) wcov(rho.AB=x))
ltitle <- "Correlation"

# Find the extrema of sig.p and mu.p
xr <- range(sapply(wcov.l, function(x) range(x$sig.p)))
yr <- range(sapply(wcov.l, function(x) range(x$mu.p)))

# Set up the plotting window
par(mar=c(3, 3, 1, 1), mgp=c(1, 0.5, 0))
plot(0, xlim=xr, ylim=yr, cex=0, ann=FALSE)

# Define the colours we want to use
col <- rainbow(length(wcov.l), start=0.2, end=0.1)

# Loop over an index the length of wcov.l and use that index to plot
# each data.frame in wcov.l with a matching colour
l <- lapply(seq_along(wcov.l), 
  function(x) {
      lines(wcov.l[[x]], col=col[x], type="o", pch=16, cex=0.8, lwd=1.5)
  }
)

# Add axis labels
mtext(c(expression(sigma[p]), expression(mu[p])), 
  c(1, 2), c(2, 1.6), cex=1.5)

# Add legend, using the same s and col as before, making it all match
legend("topleft", legend=sprintf("%5.2f", s), 
  bty="n", lty=1, col=col, lwd=1.5, pch=16, cex=0.8, title=ltitle, inset=0.02)

---

这样做的一个优点是，您只需更改很少的代码就可以遍历不同参数的值。例如：

s <- seq(0, 0.9, by=0.2)
wcov.l <- lapply(s, function(x) wcov(mu.A=x))
ltitle <- expression(Mean[A])

其余代码保持原样，产生