如何在R中绘制分位数带？

Question

如何在R中绘制分位数带？

4

我有一个CSV文件，其中包含我感兴趣的每个（Java GC）事件的行。该对象由亚秒级时间戳（非等距）和一些变量组成。对象如下：

gcdata <- read.table("http://bernd.eckenfels.net/view/gc1001.ygc.csv",header=TRUE,sep=",", dec=".")
start = as.POSIXct(strptime("2012-01-01 00:00:00", format="%Y-%m-%d %H:%M:%S"))
gcdata.date = gcdata$Timestamp + start
gcdata = gcdata[,2:7] # remove old date col
gcdata=data.frame(date=gcdata.date,gcdata)
str(gcdata)

结果

'data.frame':   2997 obs. of  7 variables:
 $ date           : POSIXct, format: "2012-01-01 00:00:06" "2012-01-01 00:00:06" "2012-01-01 00:00:18" ...
 $ Distance.s.    : num  0 0.165 11.289 9.029 11.161 ...
 $ YGUsedBefore.K.: int  1610619 20140726 20148325 20213304 20310849 20404772 20561918 21115577 21479211 21544930 ...
 $ YGUsedAfter.K. : int  7990 15589 80568 178113 272036 429182 982841 1346475 1412181 1355412 ...
 $ Promoted.K.    : int  0 0 0 0 8226 937 65429 71166 62548 143638 ...
 $ YGCapacity.K.  : int  22649280 22649280 22649280 22649280 22649280 22649280 22649280 22649280 22649280 22649280 ...
 $ Pause.s.       : num  0.0379 0.022 0.0287 0.0509 0.109 ...

在这种情况下，我关心暂停时间（以秒为单位）。我想绘制一个图表，它将显示每个（挂钟）小时的平均值作为线条，2％和98％作为灰色走廊以及每小时内的最大值作为红线。

我已经做了一些工作，但使用q98函数很丑陋，使用多行语句似乎是浪费的，并且我不知道如何在q02和q98之间实现灰色区域。

q02 <- function(x, ...) {  x <- quantile(x,probs=c(0.2)) }
q98 <- function(x, ...) {  x <- quantile(x,probs=c(0.98)) }
hours = droplevels(cut(gcdata$date, breaks="hours")) # can I have 2 hours?
plot(aggregate(gcdata$Pause.s. ~ hours, data=gcdata, FUN=max),ylim=c(0,2), col="red", ylab="Pause(s)", xlab="Days") # Is always black?
lines(aggregate(gcdata$Pause.s. ~ hours, data=gcdata, FUN=q98),ylim=c(0,2), col="green")
lines(aggregate(gcdata$Pause.s. ~ hours, data=gcdata, FUN=q02),ylim=c(0,2), col="green")
lines(aggregate(gcdata$Pause.s. ~ hours, data=gcdata, FUN=mean),ylim=c(0,2), col="blue")

现在，这将导致图表具有黑点作为最大值、蓝线作为每小时平均值以及下限和上限 0.2 + 0.98 绿线。我认为更好的阅读体验是使用灰色走廊，可能是虚线的最大值（红色）线，并以某种方式固定轴标签。

有什么建议吗？（文件可在上面找到）

- eckes

已删除提示以便更好地剪切+粘贴。 - eckes

4个回答

2

很高兴看到有Debian老手在这里 :) 你的回答已经很好了。由于我经常使用时间序列，所以我想提供一个使用优秀的zoo和xts包的变体。后者建立在前者之上，并具有我们可以在此处使用的period.apply()函数，以及endpoints()函数，以获取每两小时聚合的数据。

因此，在顶部我会使用：

library(zoo)                                # for zoo objects
library(xts)                                # for period.apply

gcdata <- read.table("http://bernd.eckenfels.net/view/gc1001.ygc.csv",
                     header=TRUE, sep=",", dec=".")
timestamps <- gcdata$Timestamp + 
              as.POSIXct(strptime("2012-01-01 00:00:00", 
                         format="%Y-%m-%d %H:%M:%S"))
gcdatazoo <- zoo(gcdata[-1], order.by=timestamps)    # as zoo object

创建一个zoo对象。您的函数保持不变：

plotAreaCorridor <- function(x, y, col.poly1="lightgray", col.poly2="gray",...) {
    x.pol <- c(x, rev(x), x[1])
    y.pol <- c(y[,1], rev(y[,5]),y[,1][1])
    plot(x, y[,6]+1, type="n", ...) 
    polygon(x.pol, y.pol, col=col.poly1, lty=0)

    x.pol <- c(x, rev(x), x[1])
    y.pol <- c(y[,2], rev(y[,4]), y[,1][1])
    polygon(x.pol, y.pol, col=col.poly2, lty=0)

    lines(x, y[,3], col="blue") # median
    lines(x, y[,6], col="red")  # max

    invisible(NULL)
}

接下来我们可以简化一下：

agg <- period.apply(gcdatazoo[,"Pause.s."],               # to which data
                    INDEX=endpoints(gcdatazoo, "hours", k=2), # every 2 hours
                    FUN=function(x) quantile(x,               # what fun.
                                             probs=c(5,20,50,80,95,100)/100)) 

#v99 = q99(gcdata$Pause.s.)        # what is q99 ?
v99 <- mean(agg[,5])                  # mean of 95-th percentile?
plotAreaCorridor(index(agg),          # use time index as x axis
                 coredata(agg),       # and matrix part of zoo object as data
                 ylim=c(0,max(agg[,5])*1.5),
                 ylab="Quantiles of GC events",
                 main="NewPar Collection Activity")
abline(h=median(gcdatazoo[,"Pause.s."]), col="lightblue")
abline(h=v99, col="grey")
labeltxt <- paste("99%=",round(v99,digits=3),"s n=", nrow(gcdatazoo),sep="")
text(x=index(agg)[20], y=1.5*v99, labeltxt, col="grey", pos=3)  # or legend()

这个图表展示了

enter image description here

由于时间跨度小于一周，所以轴现在是自动的，并且仅显示工作日; 如有需要，可以覆盖此设置。

- Dirk Eddelbuettel

很酷，谢谢Dirk（q99是99分位数） - eckes

1

这是我用来绘制实验室分析指标（在这个例子中是收缩压）时间变化的代码：

 SBP.qtr.mat <- aggregate(set1HLI$SBP, 
                          list(  year(set1HLI$Drawdt)+0.25* quarter(set1HLI$Drawdt)), 
                           quantile, prob=c(0.1,0.25,0.5,0.75, 0.9,0.95, 0.975), na.rm=TRUE)
 matplot(SBP.qtr.mat[,1], SBP.qtr.mat$x, type="pl")

将其适应到您的问题上不应该太难...或者您可以发布一个可重现的示例以供使用。这将在单个数据框中给出第10、25、50、75、90、95和97.5个百分位数，并且matplot处理这样的对象的绘图。

灰色区域？...通常的方法是绘制一个多边形，从下限开始“转向”右侧极端点，然后在高侧返回，并在左侧连接回来。polygon参数设置为x，y。有一个col参数，您可以将其设置为“灰色”。

要创建“2小时”序列，您可以将其与您的数据框合并或使用cut.POSIXt作为断点参数，有使用seq.POSIXt的时间单位倍数选项：

> seq(ISOdate(1910,1,1), ISOdate(1999,1,1), "10 years")
[1] "1910-01-01 12:00:00 GMT" "1920-01-01 12:00:00 GMT" "1930-01-01 12:00:00 GMT" "1940-01-01 12:00:00 GMT"
[5] "1950-01-01 12:00:00 GMT" "1960-01-01 12:00:00 GMT" "1970-01-01 12:00:00 GMT" "1980-01-01 12:00:00 GMT"
[9] "1990-01-01 12:00:00 GMT"

我没有看到文档，但你可以在 cut.POSIXt 中使用多个间隔：

> str( cut( seq(ISOdate(1910,1,1), ISOdate(1999,1,1), "years"), "10 years") )
 Factor w/ 9 levels "1910-01-01","1920-01-01",..: 1 1 1 1 1 1 1 1 1 1 ...
> str( cut( seq(ISOdate(1910,1,1), ISOdate(1999,1,1), "years"), "5 years") )
 Factor w/ 18 levels "1910-01-01","1915-01-01",..: 1 1 1 1 1 2 2 2 2 2 ...

- IRTFM

这个编程示例是可复现的，不是吗？ - eckes

我猜是这样。一开始我没有意识到。你可以利用我的时间注释来修复Ricardo的代码。 - IRTFM

0

我目前还没有到达以下脚本（仍需要查看DWin的更高级答案）。它现在有点像我正在寻找的，但代码仍然相当丑陋（例如，我不知道如何对齐标签以及如何获取适当的xlab标签）：

plotAreaCorridor = function(x, y, col.poly1="lightgray", col.poly2="gray",...) {
   x.pol = c(x, rev(x), x[1])
   y.pol = c(y[,1], rev(y[,5]),y[,1][1])
   plot(x, y[,6]+1, type="n", ...) # ugly since type="n" does not work for factor
   polygon(x.pol, y.pol, col=col.poly1, lty=0)

   x.pol = c(x, rev(x), x[1])
   y.pol = c(y[,2], rev(y[,4]), y[,1][1])
   polygon(x.pol, y.pol, col=col.poly2, lty=0)

   lines(x, y[,3], col="blue") # median
   lines(x, y[,6], col="red")  # max

   return(invisible())
}
pause = gcdata$Pause.s.
hours = droplevels(cut(gcdata$date, breaks="hours")) # can I have 2 hours?
agg = aggregate(pause ~ hours, FUN=quantile, probs=c(5,20,50,80,95,100)/100)
x = agg$hours
ys = agg$pause
q99 <- function(x, ...) {  x <- quantile(x,probs=c(0.99)) }  
v99 = q99(gcdata$Pause.s.)
vmed = median(gcdata$Pause.s.)
plotAreaCorridor(x, ys,ylim=c(0,v99*1.5))
abline(h=vmed, col="lightblue")
abline(h=v99, col="grey")
label=paste("99%=",round(v99,digits=3),"s n=", length(gcdata$date),sep="")
text(x=30, y=v99, label, col="grey", pos=3)
title("NewPar Collection Activity")

New Chart Version

- eckes

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- Ricardo Oliveros-Ramos · Accepted Answer

你需要尝试使用多边形。以下代码可能会有用：

你需要尝试polygon。这段代码可能很有用：

y98 = aggregate(gcdata$Pause.s. ~ hours, data=gcdata, FUN=q98)
y02 = aggregate(gcdata$Pause.s. ~ hours, data=gcdata, FUN=q02)
ymax = aggregate(gcdata$Pause.s. ~ hours, data=gcdata, FUN=max)
ymin = aggregate(gcdata$Pause.s. ~ hours, data=gcdata, FUN=min)
ymean = aggregate(gcdata$Pause.s. ~ hours, data=gcdata, FUN=mean)

x = ymean[,1]
y1 = cbind(y02[,2], ymean[,2], y98[,2])
y2 = cbind(ymin[,2], ymean[,2], ymax[,2])

plotAreaCI(x,y2, ylim=c(0,2), xlab="time", ylab="variable")
plotAreaCI(x,y1, ylim=c(0,2), poly.col="blue", add=TRUE)

or

plotAreaCI(x,y2, ylim=c(0,2), xlab="time", ylab="variable", nice.x = TRUE)
plotAreaCI(x,y1, ylim=c(0,2), mean.lwd=2, poly.col="blue", add=TRUE)

其中函数 plotAreaCI 的定义如下：

plotAreaCI = function(x, y, add=FALSE, nice.x = FALSE,
                          xlim=NULL, ylim=NULL,
                          mean.col="black", mean.lwd=1.5,
                          poly.col="gray", poly.lty=3,
                          xlab=NULL, ylab=NULL, main="",
                          ...) {
      isFactorX = isClass("factor", x)
      if(isFactorX) {
        x.label = x
        x = as.numeric(x)
      }
      if(is.null(xlim)) xlim=range(x, na.rm=TRUE)
      if(is.null(ylim)) ylim=range(y, na.rm=TRUE)
      x.pol = c(x, rev(x), x[1])
      y.pol = c(y[,1], rev(y[,3]), y[,1][3])
      if(!add) {
        plot.new()
        plot.window(xlim=xlim, ylim=ylim, ...)
        if(!nice.x & isFactorX) {
          axis(1, at=x, labels=x.label)
        } else {
          xticks = axTicks(1)
          if(isFactorX) {
            xticks = xticks[xticks>=1]
            axis(1, at=xticks, labels=x.label[xticks])
          } else {
            axis(1)
          }
        }
            axis(2, las=1)
        box()
        title(xlab=xlab, ylab=ylab, main=main)
      }
      polygon(x.pol, y.pol, col=poly.col, lty=poly.lty)
      lines(x, y[,2], col=mean.col, lwd=mean.lwd)
      return(invisible())
    }