[or-cvs] [metrics/master] Update R script for torperf report, too.
karsten at seul.org
karsten at seul.org
Mon Oct 12 09:58:52 UTC 2009
Author: Karsten Loesing <karsten.loesing at gmx.net>
Date: Mon, 12 Oct 2009 11:52:34 +0200
Subject: Update R script for torperf report, too.
Commit: 61fc0865a913febe6629e5b5c27a49459c90fb85
---
scripts/torperf/torperf.R | 121 +++++++++++++++++++++++++++------------------
1 files changed, 72 insertions(+), 49 deletions(-)
diff --git a/scripts/torperf/torperf.R b/scripts/torperf/torperf.R
index f727bf9..38f9c9b 100644
--- a/scripts/torperf/torperf.R
+++ b/scripts/torperf/torperf.R
@@ -36,7 +36,7 @@ parsedata <- function(filename) {
dDComplete <- todelta(t$startsec, t$startusec, t$datacompletesec, t$datacompleteusec)
cbWrite <- t$writebytes
cbRead <- t$readbytes
-
+
results <- data.frame(tStart, dSocket, dConnect,
dNegotiate, dRequest, dResponse,
dDRequest, dDResponse, dDComplete,
@@ -50,52 +50,63 @@ parsedata <- function(filename) {
return(results)
}
-plotboxes <- function(small, medium, large, labels, title, ylim=c(NA,NA)) {
+small <- parsedata("data/torperf/gabelmoo-50kb.data")
+medium <- parsedata("data/torperf/gabelmoo-1mb.data")
+large <- parsedata("data/torperf/gabelmoo-5mb.data")
+msmall <- parsedata("data/torperf/moria-50kb.data")
+mmedium <- parsedata("data/torperf/moria-1mb.data")
+mlarge <- parsedata("data/torperf/moria-5mb.data")
+
+plotboxes <- function(small, medium, large, msmall, mmedium, mlarge, labels, title, ylim=c(NA,NA)) {
range <- 1.5
MinY <- ylim[1]
MaxY <- ylim[2]
## Find how many points this will cause to be skipped
skipped <- c()
- labels[1] <- paste(labels[1], " (", length(na.omit(small)), ", ", length(small) - length(na.omit(small)), ", ", length(small[small > MaxY]), ")", sep="")
- labels[2] <- paste(labels[2], " (", length(na.omit(medium)), ", ", length(medium) - length(na.omit(medium)), ", ", length(medium[medium > MaxY]), ")", sep="")
- labels[3] <- paste(labels[3], " (", length(na.omit(large)), ", ", length(large) - length(na.omit(large)), ", ", length(large[large > MaxY]), ")", sep="")
+ #labels[1] <- paste(labels[1], " (", length(na.omit(small)), ", ", length(small) - length(na.omit(small)), ", ", length(small[small > MaxY]), ")", sep="")
+ #labels[2] <- paste(labels[2], " (", length(na.omit(medium)), ", ", length(medium) - length(na.omit(medium)), ", ", length(medium[medium > MaxY]), ")", sep="")
+ #labels[3] <- paste(labels[3], " (", length(na.omit(large)), ", ", length(large) - length(na.omit(large)), ", ", length(large[large > MaxY]), ")", sep="")
small[small > MaxY] <- NA
medium[medium > MaxY] <- NA
large[large > MaxY] <- NA
+ msmall[msmall > MaxY] <- NA
+ mmedium[mmedium > MaxY] <- NA
+ mlarge[mlarge > MaxY] <- NA
## Plot the data
boxplot(small, medium, large, frame.plot=FALSE, axes=FALSE, ylab="Time (s)", range=range,
- ylim=c(MinY, MaxY), xlab="Request size (# runs, # timeouts, # points omitted)", main=title,
- pars=list(show.names=TRUE, boxwex = 0.8, staplewex = 0.5, outwex = 0.5))
+ ylim=c(MinY, MaxY), xlab="", #Request size (# runs, # timeouts, # points omitted)",
+ main="", pars=list(show.names=TRUE, boxwex = 0.4, staplewex = 0.5, outwex = 0.5), at=1:3-0.22, border="darkblue")
+ boxplot(msmall, mmedium, mlarge, add=TRUE, frame.plot=FALSE, axes=FALSE, ylab="", range=range,
+ ylim=c(MinY, MaxY), xlab="", main="", at=1:3+0.22, border="darkred",
+ pars=list(show.names=TRUE, boxwex = 0.4, staplewex = 0.5, outwex = 0.5))
axis(1, at=1:length(labels), labels=labels, lwd=0)
axis(2, las=1)
+ mtext("gabelmoo", at=1:3-.22, side=3, col="darkblue")
+ mtext("moria", at=1:3+.22, side=3, col="darkred")
+ title(main=title, line=2)
}
-small <- parsedata("data/torperf/50kb.data")
-medium <- parsedata("data/torperf/1mb.data")
-large <- parsedata("data/torperf/5mb.data")
-
-pdf("report/performance/connected.pdf", width=8, height=5)
-par(mar=c(4.3,4.1,3.1,0.1))
-plotboxes(small[,6]/1e6, medium[,6]/1e6, large[,6]/1e6, c("50 KiB", "1 MiB", "5 MiB"), "Time to connect to website", c(0,30))
+png("report/performance/connected.png", width=600, height=375)
+par(mar=c(2.2,4.1,3.3,0.1))
+plotboxes(small[,6]/1e6, medium[,6]/1e6, large[,6]/1e6, msmall[,6]/1e6, mmedium[,6]/1e6, mlarge[,6]/1e6, c("50 KiB", "1 MiB", "5 MiB"), "Time to connect to website", c(0,30))
dev.off()
-pdf("report/performance/firstbyte.pdf", width=8, height=5)
-par(mar=c(4.3,4.1,3.1,0.1))
-plotboxes(small[,8]/1e6, medium[,8]/1e6, large[,8]/1e6, c("50 KiB", "1 MiB", "5 MiB"), "Time until receiving first response byte", c(0,30))
+png("report/performance/firstbyte.png", width=600, height=375)
+par(mar=c(2.2,4.1,3.3,0.1))
+plotboxes(small[,8]/1e6, medium[,8]/1e6, large[,8]/1e6, msmall[,8]/1e6, mmedium[,8]/1e6, mlarge[,8]/1e6, c("50 KiB", "1 MiB", "5 MiB"), "Time until receiving first response byte", c(0,30))
dev.off()
-pdf("report/performance/download.pdf", width=8, height=5)
-par(mar=c(4.3,4.1,3.1,0.1))
-plotboxes(small[,9]/1e6, medium[,9]/1e6, large[,9]/1e6, c("50 KiB", "1 MiB", "5 MiB"), "Time to complete request", c(0,300))
+png("report/performance/download.png", width=600, height=375)
+par(mar=c(2.2,4.1,3.3,0.1))
+plotboxes(small[,9]/1e6, medium[,9]/1e6, large[,9]/1e6, msmall[,9]/1e6, mmedium[,9]/1e6, mlarge[,9]/1e6, c("50 KiB", "1 MiB", "5 MiB"), "Time to complete request", c(0,300))
dev.off()
-smoothened <- function(plotdata, data, size) {
- windowsize <- 251
+smoothened <- function(plotdata, data, size, node, shift, windowsize, colmed, colquart) {
halfwindow <- (windowsize-1)/2
- medians <- c()
- q1s <- c()
- q3s <- c()
+ medians <- rep(NA, shift)
+ q1s <- rep(NA, shift)
+ q3s <- rep(NA, shift)
for (i in 1:halfwindow) {
medians <- c(medians, NA);
q1s <- c(q1s, NA);
@@ -111,42 +122,54 @@ smoothened <- function(plotdata, data, size) {
q1s <- c(q1s, NA);
q3s <- c(q3s, NA)
}
- title <- paste("Time to complete request (", size, sep="")
+ title <- paste("Time to complete ", size, " request on ", node, sep="")
t <- length(data$dDComplete[is.na(data$dDComplete)])
d <- na.omit(plotdata)
- if (t>1)
- title <- paste(title, ", ", length(d), " completed runs, ", t, " timeouts)", sep="")
- else
- title <- paste(title, ", ", length(d), " completed runs)", sep="")
-
- plot(medians/1e6, ylim=c(min(na.omit(q1s/1e6)),max(na.omit(q3s/1e6))), lty=1, type="l", main=title, axes=FALSE, ylab="Time (s)", xlab="Date")
- lines(q1s/1e6, lty=2)
- lines(q3s/1e6, lty=2)
-
- mtext("Q1", side=4, line=1, las=1, at=tail(na.omit(q1s), n=1)/1e6)
- mtext("median", side=4, line=1, las=1, at=tail(na.omit(medians), n=1)/1e6)
- mtext("Q3", side=4, line=1, las=1, at=tail(na.omit(q3s), n=1)/1e6)
- ticks <- 1
- for (i in 2:length(data$tStart))
- if (!is.na(data$tStart[i]) && data$tStart[i] > (data$tStart[1] + length(ticks) * 7*24*60*60*1e6))
+# if (t>1)
+# title <- paste(title, "\n(", length(d), " completed runs, ", t, " timeouts)", sep="")
+# else
+# title <- paste(title, "\n(", length(d), " completed runs)", sep="")
+
+ plot(medians/1e6, ylim=c(min(na.omit(q1s/1e6)),max(na.omit(q3s/1e6))), type="l", main=title, axes=FALSE, ylab="Time (s)", xlab="", col=colmed)
+ lines(q1s/1e6, col=colquart)
+ lines(q3s/1e6, col=colquart)
+
+ mtext("Q1", side=4, line=1, las=1, at=tail(na.omit(q1s), n=1)/1e6, col=colquart)
+ mtext("median", side=4, line=1, las=1, at=tail(na.omit(medians), n=1)/1e6, col=colmed)
+ mtext("Q3", side=4, line=1, las=1, at=tail(na.omit(q3s), n=1)/1e6, col=colquart)
+ ticks <- c()
+ lasttick <- 7*24*60*60*1e6 * round(data$tStart[1] / (7*24*60*60*1e6), digits=0)
+ for (i in 2:length(data$tStart)) {
+ if (!is.na(data$tStart[i]) && data$tStart[i] > lasttick + 7*24*60*60*1e6) {
ticks <- c(ticks, i)
- axis(1, at=c(ticks, length(data$tStart)), labels=c(format(as.POSIXct(data$tStart[ticks]/1e6, origin="1970-01-01", tz="GMT"), "%B %d"),
- format(as.POSIXct(data$tStart[length(data$tStart)]/1e6, origin="1970-01-01", tz="GMT"), "%B %d, %Y")))
+ lasttick <- data$tStart[i]
+ }
+ }
+# ticks <- ticks[2:length(ticks)]
+ #axis(1, at=c(ticks, length(data$tStart))+shift, labels=c(format(as.POSIXct(data$tStart[ticks]/1e6, origin="1970-01-01", tz="GMT"), "%B %d"), format(as.POSIXct(data$tStart[length(data$tStart)]/1e6, origin="1970-01-01", tz="GMT"), "%B %d, %Y")), lwd.ticks=1, lwd=0)
+ axis(1, at=ticks+shift, labels=format(as.POSIXct(data$tStart[ticks]/1e6, origin="1970-01-01", tz="GMT"), "%b %d"), lwd.ticks=1, lwd=0, cex.axis=.75)
+ axis(1, at=c(1, length(data$tStart))+shift, labels=FALSE, lwd.ticks=0)
axis(2, las=1)
}
-pdf("report/performance/small-smoothed.pdf", width=8, height=5)
+png("report/performance/small-smoothed.png", width=600, height=675)
+par(mfrow=c(2, 1))
par(mar=c(4.3,4.1,2.1,4.1))
-smoothened(small$dDComplete, small, "50 KiB")
+smoothened(small$dDComplete, small, "50 KiB", "gabelmoo", 0, 577, "darkblue", "blue")
+smoothened(msmall$dDComplete, msmall, "50 KiB", "moria", length(small$tStart) - length(msmall$tStart), 577, "darkred", "red")
dev.off()
-pdf("report/performance/medium-smoothed.pdf", width=8, height=5)
+png("report/performance/medium-smoothed.png", width=600, height=675)
+par(mfrow=c(2, 1))
par(mar=c(4.3,4.1,2.1,4.1))
-smoothened(medium$dDComplete, medium, "1 MiB")
+smoothened(medium$dDComplete, medium, "1 MiB", "gabelmoo", 0, 97, "darkblue", "blue")
+smoothened(mmedium$dDComplete, mmedium, "1 MiB", "moria", length(medium$tStart) - length(mmedium$tStart), 97, "darkred", "red")
dev.off()
-pdf("report/performance/large-smoothed.pdf", width=8, height=5)
+png("report/performance/large-smoothed.png", width=600, height=675)
+par(mfrow=c(2, 1))
par(mar=c(4.3,4.1,2.1,4.1))
-smoothened(large$dDComplete, large, "5 MiB")
+smoothened(large$dDComplete, large, "5 MiB", "gabelmoo", 0, 49, "darkblue", "blue")
+smoothened(mlarge$dDComplete, mlarge, "5 MiB", "moria", length(large$tStart) - length(mlarge$tStart), 49, "darkred", "red")
dev.off()
--
1.5.6.5
More information about the tor-commits
mailing list