1

如果数据大于某个值,我想在我的图表中写一些条件统计数据。

在 Jack Ryan 的帮助下(Cut data and access groups to draw percentile lines),我可以创建以下脚本,将数据分组为小时并绘制结果:

# Read example data
A <- read.csv(url('http://people.ee.ethz.ch/~hoferr/download/data-20130812.csv'))

# Libraries
library(doBy)
library(ggplot2)
library(plyr)
library(reshape2)
library(MASS)
library(scales)

# Sample size function
give.n <- function(x){
       return(c(y = min(x) - 0.2, label = length(x)))
}

# Calculate gaps
gaps <- rep(NA, length(A$Timestamp))
times <- A$Timestamp
loss <- A$pingLoss
gap.start <- 1
gap.end <- 1
for(i in 2:length(A$Timestamp))
{ #For all rows
    if(is.na(A$pingRTT.ms.[i]))
    { #Currently no connection
        if(!is.na(A$pingRTT.ms.[i-1]))
        { #Connection lost now
            gap.start <- i
        }
        if(!is.na(A$pingRTT.ms.[i+1]))
        { # Connection restores next time
            gap.end <- i+1
            gaps[gap.start] <- as.numeric(A$Timestamp[gap.end]-A$Timestamp[gap.start], units="secs")
            loss[gap.start] <- gap.end - gap.start
        } 
    }       
}              
H <- data.frame(times, gaps, loss)
H <- H[complete.cases(H),]
C <- H      
C$dates <- strptime(C$times, "%Y-%m-%d %H:%M:%S")
C$h1 <- C$dates$hour

# Calculate percentiles
cuts <- c(1, .75, .5, .25, 0)
c <- ddply(C, .(h1), function (x) { summarise(x, y = quantile(x$gaps, cuts)) } )
c$cuts <- cuts
c <- dcast(c, h1 ~ cuts, value.var = "y")
c.melt <- melt(c, id.vars = "h1")

p <- ggplot(c.h1.melt, aes(x = h1, y = value, color = variable)) +
geom_point(size = 4) +
stat_summary(fun.data = max.n, geom = "text", fun.y = max, colour = "red", angle = 90, size=4) +
scale_colour_brewer(palette="RdYlBu", name="Percentile", guide = guide_legend(reverse=TRUE)) +
scale_x_continuous(breaks=0:23, limits = c(0,23)) +
annotation_logticks(sides = "lr") +
theme_bw() +
scale_y_log10(breaks=c(1e0,1e1,1e2,1e3,1e4), labels = trans_format("log10", math_format(10^.x)), limits=c(1e0,1e4)) +
xlab("Hour of day") + ylab("Ping gaps [s]")
p

p <- ggplot(c.m1.melt, aes(x = m1/60, y = value, color = variable)) +
geom_point(size = 1) +
stat_summary(fun.data = give.n, geom = "text", fun.y = median, angle = 90, size=4) +
stat_summary(fun.data = max.n, geom = "text", fun.y = max, colour = "red", angle = 90, size=4) +
scale_colour_brewer(palette="RdYlBu", name="Percentile", guide = guide_legend(reverse=TRUE)) +
scale_x_continuous(breaks=0:23, limits = c(0,24)) +
annotation_logticks(sides = "lr") +
theme_bw() +
scale_y_log10(breaks=c(1e0,1e1,1e2,1e3,1e4), labels = trans_format("log10", math_format(10^.x)), limits=c(1e0,1e4)) +
xlab("Time of day") + ylab("Ping gaps [s]")
p

这将创建一个每小时分组的间隙图,其中最长间隙的长度写在数据点旁边:

每小时分组图,每组没有样本数

下面是按分钟分组的图。这个数字是不可读的,为什么我想在间隔超过 5 分钟或仅针对十个最长间隔或类似情况时添加条件统计信息。

具有不可读统计数据的分钟分组图

我试图将 stat 函数更改为

max.n.filt <- function(x){
    filter = 300
    if ( x > filter ) {
      return(c(y = max(x) + 0.4, label = round(max(10^x),2)))
    } else {
        return(c(y=x, label = ""))
    }
}

并将其用于按分钟分组的图。但我得到了这个错误:

Error in list_to_dataframe(res, attr(.data, "split_labels")) : 
  Results do not have equal lengths
In addition: There were 50 or more warnings (use warnings() to see the first 50)
Error in if (nrow(layer_data) == 0) return() : argument is of length zero
Calls: print ... print.ggplot -> ggplot_gtable -> Map -> mapply -> <Anonymous>
In addition: Warning message:
Removed 6 rows containing missing values (geom_point).

此外,在每小时图中,我想在间隙长度旁边写下每小时的样本数。我想我可以在 c 数据框中添加一个新列,但不幸的是我找不到这样做的方法。

很感谢任何形式的帮助。

4

1 回答 1

2

请参阅 ?stat_summary。

fun.data : 完整的汇总功能。应以数据帧为输入,返回数据帧为输出

您的函数max.n.filt使用了一个if()尝试评估条件的语句x > filter。但是当 时length(x) > 1,该if()语句只计算 的第一个值的条件x。在数据框上使用时,这将返回一个列表,该列表由原始输入和语句返回x的任何标签拼凑而成。if()

> max.n.filt(data.frame(x=c(10,15,400)))
$y.x
[1]  10  15 400

$label
[1] ""

尝试使用一个函数ifelse()

max.n.filt2 <- function(x){
    filter = 300                  # whatever threshold
    y = ifelse( x > filter, max(x) + 1, x[,1] )
    label = ifelse( x > filter, round(max(x),2), NA )
    return(data.frame(y=y[,1], label=label[,1]))
}

> max.n.filt2(data.frame(x=c(10,15,400)))
    y label
1  10    NA
2  15    NA
3 401   400

或者,您可能会发现它更易于使用geom_text()。我无法重现您的示例,但这是一个模拟数据集:

set.seed(101)
sim_data <- expand.grid(m1=1:1440, variable=factor(c(0,0.25,0.5,0.75,1)))
sim_data$sample_size <- sapply(1:1440, function(.) sample(1:25, 1, replace=T))
sim_data$value = t(sapply(1:1440, function(.) quantile(rgamma(sim_data$sample_size, 0.9, 0.5),c(0,0.25,0.5,0.75,1))))[1:(1440*5)]

只需使用subset参数 ingeom_text()选择您希望标记的那些点:

ggplot(sim_data, aes(x = m1/60, y = value, color = variable)) +
geom_point(size = 4) + geom_text(aes(label=round(value)), subset = .(variable == 1 & value > 25), angle = 90, size = 4, colour = "red", hjust = -0.5)

如果您有一列样本大小,则可以将其合并labelpaste()

ggplot(sim_data, aes(x = m1/60, y = value, color = variable)) +
geom_point(size = 4) + geom_text(aes(label=paste(round(value),", N=",sample_size)), subset = .(variable == 1 & value > 25), angle = 90, size = 4, colour = "red", hjust = -0.25)

(或在您的数据中使用您想要的任何标签创建一个单独的列。)如果您询问如何检索样本大小,您可以将您的调用修改为ddply()

...
c2 <- ddply(C, .(h1), function (x) { cbind(summarise(x, y = quantile(x$gaps, cuts)), n=nrow(x)) } )
c2$cuts <- cuts
c2 <- dcast(c2, h1 + n ~ cuts, value.var = "y")
c2.h1.melt <- melt(c2, id.vars = c("h1","n"))
...
于 2013-08-23T23:35:54.630 回答