匹配R中的Y双轴值

35g0bw71  于 2022-12-06  发布在  其他
关注(0)|答案(2)|浏览(181)

我知道不鼓励在一个图上绘制2个单独的y轴,这可能会造成混乱和误导。
是否有方法匹配Y轴的值?例如,找到一种方法在图形中移动右侧Y轴的数据(?)例如,我希望左侧Y轴的40与右侧Y轴的-1匹配,因为这两个值对应于干旱条件类别的开始。

样品:

structure(list(Time = structure(c(9862, 9893, 9921, 9952, 9982, 
10013, 10043, 10074, 10105, 10135, 10166, 10196, 10227, 10258, 
10286, 10317, 10347, 10378, 10408, 10439), class = "Date"), Year = c(1997, 
1997, 1997, 1997, 1997, 1997, 1997, 1997, 1997, 1997, 1997, 1997, 
1998, 1998, 1998, 1998, 1998, 1998, 1998, 1998), VCI = c(48.7488482440362, 
51.8662335250972, 54.4212125411374, 61.7338808190779, 63.9870065731148, 
61.3375357670741, 62.6197335631611, 63.0950799644754, 61.6276947895731, 
61.1298324406371, 64.4422427513358, 60.3823204404222, 60.5883337239537, 
61.8918834440238, 59.1304135098709, 62.1668350554954, 61.9352586665065, 
55.75795384214, 50.3371363875305, 52.5748728440737), TCI = c(53.7071192239754, 
53.6178820221828, 57.7831310561669, 57.3996088686986, 49.8613200877384, 
54.9673093834738, 42.4962626269047, 33.542249807155, 36.9526033996693, 
46.0464770178552, 49.5240246297537, 49.6298842520857, 47.9889200846868, 
40.3862301499032, 36.8605803231892, 38.8799158911488, 39.0120455451407, 
45.9071510330717, 55.8730250709158, 60.4339176493461), SPEI = c(0.385767341805337, 
-0.240467091114443, 0.218601001011986, 0.392296211626228, -0.0041472667529566, 
0.36089672045203, -0.415596363086708, -0.694577131096395, -0.53422184521265, 
0.372791671097943, 0.0714646484375678, 0.100567550879492, 0.484279813014397, 
-0.478876226785371, -0.591222448288627, -0.473201395390211, -0.347352514594038, 
-0.432571106796894, -0.259775061906046, 0.114961224539346)), row.names = c(NA, 
20L), class = "data.frame")

代码如下:

## Plot first set of data and draw its axis
par(mar = c(5, 5, 4, 4))
#VCI index
plot(variables$Time, variables$VCI, pch=20, cex=.9, axes=FALSE, ylim=c(0,100), xlab="", ylab="", 
     type="l",col="Aquamarine3", main="Temporal trend - drought indices, growing season")
axis(2, ylim=c(0,100),col="black",las=1)  ## las=1 makes horizontal labels
mtext("VCI and TCI",side=2,line=2.5)
box()
abline(h = 40, col = "black", lty = "dotted", lwd= 2)

## Allow a second plot on the same graph
par(new=TRUE)

#TCI index
plot(variables$Time, variables$TCI, pch=21, cex = 1.2, axes=FALSE, ylim=c(0,100), xlab="", ylab="", 
     type="l",col="Chocolate2", main="Temporal trend - drought indices, growing season")
axis(2, ylim=c(0,100),col="grey",las=1)  ## las=1 makes horizontal labels
mtext("VCI and TCI",side=2,line=2.5)
box()

## Allow a second plot on the same graph
par(new=TRUE)

## Plot the second plot and put axis scale on right
plot(variables$Time, variables$SPEI, pch=15, cex=.4, xlab="", ylab="", ylim=c(-2.5,2.5), 
     axes=FALSE, type="l", col="darkorchid3")
abline(h = -1.5, col = "black", lty = "dashed", lwd= 2)

## a little farther out (line=4) to make room for labels
mtext("SPEI",side=4,line=2.5)
axis(4, ylim=c(-2.5, 2.5), col="black",col.axis="black",las=1)

par(new=TRUE)
## Draw the time axis
axis(1, spei.df$Time, format(spei.df$Time, "%Y"), 20)
mtext("Time",side=1,col="black",line=2.5)  

## Add Legend
legend("topleft",legend=c("VCI","TCI", "SPEI"),
       text.col=c("black","black", "black"), lty=1, lwd=2, col=c("Aquamarine3","Chocolate2", "darkorchid3"))
6vl6ewon

6vl6ewon1#

我不知道如何在底数为R的情况下实现这一点,但您可以使用ggplot 2通过一些数学运算和反复试验来对齐第二个轴

library(tidyverse)

dat |>
  mutate(SPEI = (SPEI+(25/15))*15)|>
  pivot_longer(VCI:SPEI) |>
  mutate(name = factor(name, levels = c("VCI", "TCI", "SPEI"))) |>
  ggplot(aes(Time, value, color = name))+
  geom_line()+
  geom_hline(linetype = "dotted", yintercept = 40)+ 
  geom_hline(linetype = "dashed", yintercept = 2.5)+
  scale_color_manual(values = c("Aquamarine3", "Chocolate2", "darkorchid3"))+
  scale_y_continuous(name = "VCI and TCI", 
                     breaks = seq(0, 100, by = 20),
                     limits = c(0, 100),
                     sec.axis = sec_axis(trans = ~(./15)-(25/15), name = "SPEI", 
                                         breaks = seq(-2,5, by = 1)))+
  ggtitle("Temporal trend - drought indices, growing season")+
  labs(color = "")+
  theme(panel.background = element_blank(),
        panel.border = element_rect(fill = NA, color = "black"),
        legend.key = element_blank(),
        legend.box.background = element_rect(fill = NA, color = "black"),
        legend.position = c(0.07,0.87),
        legend.title = element_blank())

编辑UPDATE使40 = -1

library(tidyverse)

dat |>
  mutate(SPEI = ((SPEI+(55/15))*15))|>
  pivot_longer(VCI:SPEI) |>
  mutate(name = factor(name, levels = c("VCI", "TCI", "SPEI"))) |>
  ggplot(aes(Time, value, color = name))+
  geom_line()+
  geom_hline(linetype = "dotted", yintercept = 40)+ 
  geom_hline(linetype = "dashed", yintercept = 32.5)+
  scale_color_manual(values = c("Aquamarine3", "Chocolate2", "darkorchid3"))+
  scale_y_continuous(name = "VCI and TCI", 
                     breaks = seq(0, 100, by = 20),
                     limits = c(0, 100),
                     sec.axis = sec_axis(trans = ~(./15)-(55/15), name = "SPEI", 
                                         breaks = seq(-4,3, by = 1)))+
  ggtitle("Temporal trend - drought indices, growing season")+
  labs(color = "")+
  theme(panel.background = element_blank(),
        panel.border = element_rect(fill = NA, color = "black"),
        legend.key = element_blank(),
        legend.box.background = element_rect(fill = NA, color = "black"),
        legend.position = c(0.07,0.87),
        legend.title = element_blank())

rwqw0loc

rwqw0loc2#

通过使用线性插值公式计算其中一个轴与另一个轴的最大值,可以解决该问题,有关说明,请参见Wikipedia
在这里,我倾向于给予一个更简洁和通用的答案,它可以在类似的情况下重复使用。下面的解决方案使用随机数据,省略了特定问题的标签。
其工作原理如下:
1.创建一些随机数据,其中x为一个序列,y为两个序列yayb
1.设置ya的y轴限制、yb的最小值以及两个轴的匹配值,但忽略第二个轴的最大值。
1.计算yb
1.其余的就可以照常进行了。

## create a few random test data
set.seed(123)
x <- 1:10
ya <- runif(x, min = 20, max = 70)
yb <- runif(x, min = -1.5, max= 1)

## set limits for the two y axes, but omit yb_max
ya_min <- 0; ya_max <- 100; yb_min <- -3

## set value, where the two axes should match
ya_match <- 40; yb_match <- -1

## calculate yb_max using linear interpolation (here: extrapolation)
yb_max <- yb_min + (ya_max - ya_min) * (yb_match - yb_min) / (ya_match - ya_min)

## set graphical parameter to increase margin for right axis
par(mar=c(5, 4, 5, 5) + .1)

## plot data set "a" 
plot(x, ya, type = "l", col = "black", ylim = c(ya_min, ya_max))
abline(h = ya_match, col = "grey", lty = "dashed")

## add a second plot for data set "b", omitting axes and axis labels
par(new = TRUE)
plot(x, yb, type = "l", col = "red", ylim = c(yb_min, yb_max),
     axes = FALSE, xlab = "", ylab = "")

## add right axis and axis label
axis(4)
mtext("yb", side = 4, line = 3, col = "red")

相关问题