2013-08-23 3 views
1

데이터가 특정 값보다 크면 그래프에 조건부 통계를 작성하고 싶습니다. 이것은의 길이 차이의 시간당 그룹화 플롯을 생성조건부 stat_summary for ggplot in R

# 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 

: 잭 라이언의 종류 도움말 (Cut data and access groups to draw percentile lines), 나는 시간에 그룹 데이터 및 결과을 나타내는 다음 스크립트를 작성할 수와

가장 긴 간격이 바로 옆에 데이터 포인트에 대한 서면 :

다음

Hourly grouped plot without sample number per group

은 미세하게 그룹화 플롯이다. 그 숫자는 간격이 5 분보다 길거나 10 개의 가장 긴 간격이나 이와 같은 경우에만 조건부 통계를 추가하려는 이유는 알 수 없습니다.

Minutely grouped plot with unreadable stats

는 그냥

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 데이터 프레임에 새 열을 추가 할 수 있다고 생각하지만 불행히도이 작업을 수행 할 수있는 방법을 찾을 수 없습니다.

모든 도움을 주시면 대단히 감사하겠습니다.

답변

2

? stat_summary를 참조하십시오.

fun.data : Complete summary function. Should take data frame as input and return data frame as output

함수 max.n.filt는 조건 x > filter을 평가하기 위해 애쓰는 if() 문을 사용합니다. 그러나 length(x) > 1 일 때 if() 문은 x의 첫 번째 값에 대한 조건 만 평가합니다. 데이터 프레임에서 사용되면 원래 입력 x과 함께 if() 문에서 반환하는 레이블이 함께 자갈로 표시된 목록을 반환합니다.

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()를 사용하여 찾을 수 있습니다 :

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

$label 
[1] "" 

대신 ifelse()를 사용하는 기능을 사용해보십시오. 나는 당신의 예를 재현 할 수없는, 그러나 여기에서 시뮬레이션 데이터 세트입니다 : 당신의 열이있는 경우

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) 

을 :

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)] 

그냥 당신이 레이블을하고자하는 지점을 선택 geom_text()subset 인수를 사용은 샘플 크기는, 사람들은 paste()으로 label에 통합 할 수 있습니다

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")) 
...