在多个时间序列图中标记 X 轴

Question

我在三个不同的屏幕上绘制了三个时间序列图。除了 x 轴之外，所有工作都很好，不会绘制我要求的内容。

我使用了this Stack Overflow question的代码，它适用于一个屏幕，即一个屏幕上的所有三个图形，但它拒绝在没有错误消息的三个屏幕格式上注册。

dev.new()
plot(tp,screens=c(1,2,3),col=c("deepskyblue","seagreen3","orchid4"),ylim=c(0,1600),lwd="3",ylab=(expression("TP"~~(mu*"g/L"))),xlab=NA,
main="Seasonal variation of total phosphorus in Water Friendly Farming catchments",cex.main=2,xaxt="n")
legend(locator(1),legend=c("Barkby Brook","Eye Brook","Stonton Brook"),fill=c("deepskyblue","seagreen3","orchid4"),bty="n")
times<-time(tp)
ticks<-seq(times[1],times[length(times)],by=90)
axis(1,at=ticks,labels=c("Spring 2012","Summer 2012","Autumn 2012","Winter 2012","Spring 2013","Summer 2013","Autumn 2013","Winter 2013","Spring 2014"))

TP 代表三个地点的总磷，我已经合并了三个动物园对象来获得它。然后我将动物园对象合并到一个单独的零宽度动物园对象，其中包含从 2012-03-26 到 2014-04-13 的日期。

数据：

mydata<-structure(list(date = structure(c(16054, 15783, 16139, 15528, 
15615, 15726, 15957, 16155, 15922, 16013, 16105, 15594, 15687, 
16012, 15614, 15684, 16041, 15533, 15841, 16055, 16064, 15916, 
15522, 15621, 16065, 15759, 15868, 16156, 15830, 15629), class = "Date"), 
month = structure(c(7L, 17L, 18L, 12L, 22L, 10L, 25L, 18L, 
5L, 21L, 9L, 24L, 6L, 21L, 22L, 6L, 7L, 12L, 19L, 7L, 7L, 
13L, 12L, 22L, 7L, 8L, 15L, 18L, 19L, 22L), .Label = c("April.2012", 
"April.2013", "April.2014", "Aug.2012", "Aug.2013", "Dec.2012", 
"Dec.2013", "Feb.2013", "Feb.2014", "Jan.2013", "Jan.2014", 
"July.2012", "July.2013", "June.2012", "June.2013", "March.2012", 
"March.2013", "March.2014", "May.2013", "Nov.2012", "Nov.2013", 
"Oct.2012", "Oct.2013", "Sept.2012", "Sept.2013"), class = "factor"), 
year = c(2013L, 2013L, 2014L, 2012L, 2012L, 2013L, 2013L, 
2014L, 2013L, 2013L, 2014L, 2012L, 2012L, 2013L, 2012L, 2012L, 
2013L, 2012L, 2013L, 2013L, 2013L, 2013L, 2012L, 2012L, 2013L, 
2013L, 2013L, 2014L, 2013L, 2012L), tp.barkby = c(200.74, 
103.32, 65.6, NA, 94.37, NA, 1110.46, 105.87, NA, 63.68, 
87, 266.29, NA, 114.62, 184.21, 87.95, 148.81, NA, NA, 204.81, 
138.38, 298.48, 120.8, 146.8, 96.6, 91.16, 384.18, 94.16, 
141.72, 125), tp.eyebrook = c(117.59, 101.74, 102.35, 180, 
131.74, NA, 232.5, 144.82, 487.23, 105.26, 95.75, 250.1, 
NA, 99.93, 144.37, 87.95, 107.14, NA, 105.41, 489.33, 147.91, 
132.52, 105.6, 108.8, 111, 76.95, 193, 130.74, 113.17, 134
), tp.stonton = c(85.2, 99.9, 94.85, NA, 54.9, 79.68, 168.86, 
170.08, 284.05, 133.95, 80.5, 102, NA, NA, 61.21, NA, 68.1, 
NA, 107.23, 367.19, 152.91, 131.33, 79.2, 67.8, 88.26, 56.16, 
151.68, 161.79, 61.5, 272)), .Names = c("date", "month",
"year", "tp.barkby", "tp.eyebrook", "tp.stonton"), row.names = c(582L, 
 311L, 667L, 56L, 143L, 254L, 485L, 683L, 450L, 541L, 633L, 122L, 
215L, 540L, 142L, 212L, 569L, 61L, 369L, 583L, 592L, 444L, 50L, 
149L, 593L, 287L, 396L, 684L, 358L, 157L), class = "data.frame")

mydata$date<-as.Date(mydata$date)
attach(mydata)
str(mydata)
library(zoo)
#Total Phosphorus
#1 - create a zero-width (dataless) zoo object with the missing dates/times.
dates<-seq(from=as.Date("2012-03-26"), to=as.Date("2014-04-13"), by=1)
empty<-zoo(,dates)
#2 - create zoo objects from the data
ts.tpb<-zoo(tp.barkby,date)
ts.tpe<-zoo(tp.eyebrook,date)
ts.tps<-zoo(tp.stonton,date)
#3 - merge the zoo objects and apply na.approx
merged.tp<-na.approx(merge(ts.tpb,ts.tpe,ts.tps))
#4 - merge the dataless with the datafull 
tp<-na.approx(merge(merged.tp,empty,all=TRUE))
#Three screen plot
dev.new()
plot(tp,screens=c(1,2,3),col=c("deepskyblue","seagreen3","orchid4"),ylim=c(0,1600),lwd="3",    ylab=(expression("TP"~~(mu*"g/L"))),xlab=NA,
main="Seasonal variation of total phosphorus in Water Friendly Farming     
catchments",cex.main=2,xaxt="n")
legend(locator(1),legend=c("Barkby Brook","Eye Brook","Stonton             
Brook"),fill=c("deepskyblue","seagreen3","orchid4"),bty="n")
times<-time(tp)
ticks<-seq(times[1],times[length(times)],by=90)
axis(1,at=ticks,labels=c("Spring 2012","Summer 2012","Autumn 2012","Winter     2012","Spring 2013","Summer 2013","Autumn 2013","Winter 2013","Spring 2014"))
#Axis at and labels will differ as this is not the whole dataset

希望对你有帮助.......

Answer 1

下次提出问题时，请将代码缩减到合理的大小，去掉所有与问题无关的部分。

?plot.zoo(link) 的示例部分中有很多关于如何执行此操作的示例。定义一个面板函数并将您的代码放在那里。例如，使用问题中的设置

pnl <- function(x, y, ...) {

  lines(y ~ x)

  panel.number = parent.frame()$panel.number
  nser <- parent.frame()$nser
  if (panel.number == nser) {
     ticks <- seq(x[1], x[length(x)], by=90)
     axis(1, at = ticks, labels = letters[seq_along(ticks)])
  }
}

plot(tp, panel = pnl, xaxt = "n")

2) zoo 还支持 lattice plots 和 ggplot2 plots。这是通过autoplot.zoo (link) 绘制的 ggplot2 图

library(ggplot2)
at <- seq(start(tp), end(tp), by = 90)
autoplot(tp) + scale_x_date(breaks = at, labels = letters[seq_along(at)])

Answer 2

不幸的是，当您绘制多个绘图时，默认 plot.zoo 函数会在内部更改 par 设置，然后在函数存在时自动重置它们。当它重置par 参数时，这将重置绘图表面，因此对axis 的后续调用不起作用。仅绘制单个时间序列时，此函数不执行此操作。

没有超级简单/强大的方法来解决这个问题。但是，如果您觉得大胆，您可以对函数进行手术并在其中插入新代码。 （这不是一般推荐的做法，但在这种情况下，它会让您的生活更轻松）。我用动物园版本 1.7-10 做到了这一点。为确保这对您有用，请检查

body(plot.zoo)[19:20]

返回

do.call("title", title.args)(return(invisible(x)))

因为我们要在这两个语句之间添加一行代码。我们将这样做

plot.zoo2<-plot.zoo
bl<-as.list(body(plot.zoo2))
bl<-c(
    bl[1:19], 
    quote(axis(1,at=ticks,labels=tick.lables)), 
    bl[20]
)
body(plot.zoo2)<-as.call(bl)

我们实际上创建了一个名为plot.zoo2 的新函数，它添加了对轴的调用以及我们想要的值。现在我们调用与普通绘图函数几乎相同的方式，但我们只是使用我们的新版本。

#define these before the plot() since we use them in our function now
times<-time(tp)
ticks<-seq(times[1],times[length(times)],by=90)
tick.labels<-c("Spring 2012","Summer 2012","Autumn 2012","Winter     2012","Spring 2013","Summer 2013","Autumn 2013","Winter 2013")

plot.zoo2(tp,screens=c(1,2,3),
    col=c("deepskyblue","seagreen3","orchid4"),
    ylim=c(0,1600),lwd="3",
    ylab=(expression("TP"~~(mu*"g/L"))),xlab=NA,xaxt="n",
    main="Seasonal variation of total phosphorus",
    cex.main=2)

这给了

Answer 3

您试图在 date 轴上强制使用 text 标签，因此没有输出。对于自定义文本标签，您需要在绘图之前将xts/zoo 转换为data.frame，绘制没有任何时间索引的数据 并在axis(1,...)中提供自定义标签

代码

带有样本 xts 数据

#Load sample xts/zoo data, lubridate for month/year functions

require(PerformanceAnalytics)
require(lubridate)
data(edhec)

#Convert to data.frame for plotting, keep data until Dec 1998 and single time series 

df<-data.frame(date=index(edhec[,1]['/1998']),edhec[,1]['/1998'],row.names=NULL)


#label break dates,monthly data,hence seq index = 3

ticks<-df$date[seq(1,length(df$date),3)]

#label breaks, at = seq(1,length(df$date),3)

#Map months to seasons (USA)
Month2Season<-function(mon){

Winter<-c(12,1,2)
Spring<-c(3,4,5)
Summer<-c(6,7,8)
Autumn<-c(9,10,11)

season<-NULL

if      (any(mon %in% Winter)) season="Winter"  
else if (any(mon %in% Spring)) season="Spring" 
else if (any(mon %in% Summer)) season="Summer" 
else if (any(mon %in% Autumn)) season="Autumn" 

return(season)
}

#get seasons for all label break dates

season_labels<-sapply(ticks,function(x) paste0(Month2Season(month(x)),"-",year(x)))

# provide numeric index for label breaks of at =

plot(df$Convertible.Arbitrage,type="l",xaxt="n")
axis(1,at=seq(1,length(df$date),3),labels=season_labels)

情节