R - 泰勒图绘图

Question

我正在尝试在泰勒图中绘制多个模型，并且在代码方面略有挣扎。我设法制作了图表（见图），但无法弄清楚如何减少轴，因为它们太大了，标准化轴以标记为 1,2,3,4 并在相关性上添加刻度线 - 带有刻度标记我希望每 0.1 有一次主要刻度线，每 0.05 次有次要刻度线，直到 0.9，之后我试图在 0.95 有一次主要刻度线，此时每 0.01 次有次要刻度线（如果这有意义的话）。上述任何帮助/建议都会有所帮助。我在“plotrix”包中使用了“taylor.diagram”（并阅读了它的指南——但我对 R 相对缺乏经验）并附上了我的（有点基本的）代码，但我的情节看起来相当混乱。谢谢

all.models <- as.data.frame(cbind(Sy.One, Sy.Two, Sy.Three, Sy.Four, Sy.Five, Sy.Six, Sy.Seven, Sy.Eight, Sy.Nine, Sy.Ten))

taylor.diagram(CSR, Sy.One, sd.arcs=T, ref.sd=T, pcex=1.5, main=NULL, pos.cor=F,
              xlab="Standard Deviation (cm)", ylab="Standard Deviation (cm)")

for (i in 1:dim(all.models)[2]) {
  model.wanted <- all.models[,i]
  taylor.diagram(CSR, model.wanted, sd.arcs=T, ref.sd=T, pcex=1.5, col=i, add=T, pos.cor=F)}

# Add legend
model.names <- c("Sy=1%","Sy=2%","Sy=3%","Sy=4%","Sy=5%","Sy=6%","Sy=7%","Sy=8%","Sy=9%","Sy=10%")
legend("top", model.names, pch=19, col=i, cex=1.0, bty="n", ncol=5)

Answer 1

一种选择是使用不同的包，例如openair，这可能更灵活。由于您的特定要求，使用为您的要求设计的代码可能会更容易。我写了一些代码来生成下面的图，它接近你想要的图。您可以修改代码以将绘图调整为所需的格式。

# code to make a Taylor diagram
# formulas found in http://www-pcmdi.llnl.gov/about/staff/Taylor/CV/Taylor_diagram_primer.pdf
# and http://rainbow.llnl.gov/publications/pdf/55.pdf

# correlations and tick marks (only major will have a line to the center)
# minor will have a tick mark
correlation_major <- c(seq(-1,1,0.1),-0.95,0.95)
correlation_minor <- c(seq(-1,-0.95,0.01),seq(-0.9,9,0.05),seq(0.95,1,0.01))

# test standard deviation tick marks (only major will have a line)
sigma_test_major <- seq(1,4,1)
sigma_test_minor <- seq(0.5,4,0.5)

# rms lines locations
rms_major <- seq(1,6,1)

# reference standard deviation (observed)
sigma_reference <- 2.9

# color schemes for the liens
correlation_color <- 'black'
sigma_test_color <- 'blue'
rms_color <- 'green'

# line types
correlation_type <- 1
sigma_test_type <- 1
rms_type <- 1

# plot parameters
par(pty='s')
par(mar=c(3,3,3,3)+0.1)

# creating plot with correct space based on the sigma_test limits
plot(NA
     ,NA
     ,xlim=c(-1*max(sigma_test_major),max(sigma_test_major))
     ,ylim=c(-1*max(sigma_test_major),max(sigma_test_major))
     ,xaxt='n'
     ,yaxt='n'
     ,xlab=''
     ,ylab=''
     ,bty='n')

#### adding sigma_test (standard deviation)
# adding semicircles
for(i in 1:length(sigma_test_major)){
  lines(sigma_test_major[i]*cos(seq(0,pi,pi/1000))
       ,sigma_test_major[i]*sin(seq(0,pi,pi/1000))
       ,col=sigma_test_color
       ,lty=sigma_test_type
       ,lwd=1
    )
}

# adding horizontal axis
lines(c(-1*max(sigma_test_major),max(sigma_test_major))
     ,c(0,0)
     ,col=sigma_test_color
     ,lty=sigma_test_type
     ,lwd=1)

# adding labels
text(c(-1*sigma_test_major,0,sigma_test_major)
     ,-0.2
     ,as.character(c(-1*sigma_test_major,0,sigma_test_major))
     ,col=sigma_test_color
     ,cex=0.7)

# adding title
text(0
     ,-0.6
     ,"Standard Deviation"
     ,col=sigma_test_color
     ,cex=1)

#### adding correlation lines, tick marks, and lables
# adding lines
for(i in 1:length(correlation_major)){

  lines(c(0,1.02*max(sigma_test_major)*cos(acos(correlation_major[i])))
        ,c(0,1.02*max(sigma_test_major)*sin(acos(correlation_major[i])))
        ,lwd=2
        ,lty=correlation_type
        ,col=correlation_color
  )
}

# adding minor tick marks for correlation
for(i in 1:length(correlation_minor)){

  lines(max(sigma_test_major)*cos(acos(correlation_minor[i]))*c(1,1.01)
        ,max(sigma_test_major)*sin(acos(correlation_minor[i]))*c(1,1.01)
        ,lwd=2
        ,lty=correlation_type
        ,col=correlation_color
  )
}

# adding labels for correlation
text(1.05*max(sigma_test_major)*cos(acos(correlation_major))
     ,1.05*max(sigma_test_major)*sin(acos(correlation_major))
     ,as.character(correlation_major)
     ,col=correlation_color
     ,cex=0.5)

# adding correlation title
text(0
     ,max(sigma_test_major)+0.5
     ,"Correlation"
     ,col=correlation_color
     ,cex=1)


#### adding rms difference lines
# adding rms semicircles
for(i in 1:length(rms_major)){
  inds <- which((rms_major[i]*cos(seq(0,pi,pi/1000))+sigma_reference)^2 + (rms_major[i]*sin(seq(0,pi,pi/1000)))^2 < max(sigma_test_major)^2)
  lines(rms_major[i]*cos(seq(0,pi,pi/1000))[inds]+sigma_reference
        ,rms_major[i]*sin(seq(0,pi,pi/1000))[inds]
        ,col=rms_color
        ,lty=rms_type
        ,lwd=1
  )
}

# adding observed point
points(sigma_reference
       ,0
       ,pch=19
       ,col=rms_color
       ,cex=1)

# adding labels for the rms lines
text(-1*rms_major*cos(pi*rms_major/40)+sigma_reference
     , rms_major*sin(pi*rms_major/40)
     ,as.character(rms_major)
     ,col=rms_color
     ,cex=0.7
     ,adj=1)

# adding title
text(0
     ,-1.5
     ,'Centered RMS Difference'
     ,col=rms_color
     ,cex=1
     ,adj=0.5)


###################### adding points #####################
names <- paste("model",seq(1,8),sep='')
correl_names <- seq(-0.6,0.8,by=0.2)
std_names <- seq(2,4,by=0.26)
color_names <- topo.colors(length(names))
points(std_names*cos(acos(correl_names))
       ,std_names*sin(acos(correl_names))
       ,col=color_names
       ,pch=19
       ,cex=1.5)

# making legend
par(xpd=TRUE)
legend(0,-2
       ,names
       ,pc=19
       ,col=color_names
       ,ncol=3
       ,bty='n'
       ,xjust=0.5)