Как я могу создать корреляционный график и легенду в R? - PullRequest
Новая
       33

Как я могу создать корреляционный график и легенду в R?

0 голосов
/ 27 мая 2019

В приведенном ниже коде я хотел бы поделиться формой графика, который изменяется, когда 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)

1 Ответ

1 голос
/ 28 мая 2019

Если вам нужен простой график, вы можете заключить код в цикл 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)
}

enter image description here

Но если вам нужен более причудливый график и более гибкие параметры, лучше сделать код функцией и использовать [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)

enter image description here

Одно из преимуществ такого подхода состоит в том, что вы можете перебирать значения различных аргументов, изменяя очень мало кода. Например: 

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

И оставляя остальной код как есть, получая

enter image description here

...