2025-01-12 04:36:52 +08:00

132 lines
5.3 KiB
Plaintext

<%--------------------------------------------------------------
BENCHMARK RESULTS
--------------------------------------------------------------%>
<%--------------------------------------------------------------
Local functions
--------------------------------------------------------------%>
<% toImage <- function(stats, name=levels(stats$expr)[1L], tags=NULL, ylim="auto", col=NULL, alpha=NULL, ...) { %>
<%
# Replace spaces in name with hypen, e.g. ' w/ direct' -> '-w/-direct'
name <- gsub(" ", "-", name, fixed=TRUE)
# Drop any forward slashes in name, e.g. ' w/ ' -> ' w '
name <- gsub("/", "", name, fixed=TRUE)
# Drop any spaces in tags, e.g. 'n = 1000' -> 'n=1000'
tags <- gsub(" ", "", tags, fixed=TRUE)
cat("\n")
%>
![](<%=toPNG(name, tags=c(tags, "benchmark"), aspectRatio=2/3, {
if (identical(ylim, "auto")) {
y <- stats$time/1e6
ymax <- max(y, na.rm=TRUE)
y75 <- quantile(y, probs=0.75, na.rm=TRUE)
yupper <- min(c(1.5*y75, ymax), na.rm=TRUE)
ylim <- c(0, yupper)
}
if (!is.null(ylim)) {
stats$outlier <- (stats$time > ylim[2]*1e6)
stats$time[stats$outlier] <- ylim[2]*1e6
}
gg <- ggplot(data=stats, aes(x=seq_along(time)/length(levels(expr)), y=time/1e6))
gg <- gg + geom_point(aes(colour=expr, shape=outlier))
gg <- gg + scale_shape_manual(values=c(16,4), guide="none")
if (!is.null(col)) gg <- gg + scale_colour_manual(values=col)
if (!is.null(alpha)) gg <- gg + scale_alpha_manual(values=alpha)
gg <- gg + xlab("iteration") + ylab("time (ms)")
if (!is.null(ylim)) gg <- gg + ylim(ylim)
print(gg)
})%>)
<% } # toImage() %>
<%
toTable <- function(stats, tags=NULL, order="median", ...) {
kable({
s <- summary(stats)
s$neval <- NULL
s$cld <- NULL
s <- s[order(s[[order]]),]
s
}, row.names=TRUE)
kable({
s <- summary(stats, unit="relative")
s$neval <- NULL
s$cld <- NULL
s <- s[order(s[[order]]),]
s
}, row.names=TRUE)
cat("\n")
}
%>
<%--------------------------------------------------------------
Benchmark results for vector functions
--------------------------------------------------------------%>
<% benchmarkResults <- function(stats, tags=NULL, ...) { %>
_Table: Benchmarking of <%=hpaste(sprintf("%s()", levels(stats$expr)), lastCollapse=" and ")%> on <%=paste(tags, collapse="+")%> data. The top panel shows times in milliseconds and the bottom panel shows relative times._
<% toTable(stats, tags=tags) %>
_Figure: Benchmarking of <%=hpaste(sprintf("%s()", levels(stats$expr)), lastCollapse=" and ")%> on <%=paste(tags, collapse="+")%> data. Outliers are displayed as crosses. Times are in milliseconds._
<% toImage(stats, tags=tags) %>
<% } # benchmarkResults() %>
<%--------------------------------------------------------------
Benchmark results for col- and row-specific functions
--------------------------------------------------------------%>
<% crBenchmarkResults <- function(colStats, rowStats=NULL, tags=NULL, ...) { %>
_Table: Benchmarking of <%=hpaste(sprintf("%s()", levels(colStats$expr)), lastCollapse=" and ")%> on <%=paste(tags, collapse="+")%> data. The top panel shows times in milliseconds and the bottom panel shows relative times._
<% toTable(colStats, tags=tags) %>
_Table: Benchmarking of <%=hpaste(sprintf("%s()", levels(rowStats$expr)), lastCollapse=" and ")%> on <%=paste(tags, collapse="+")%> data (transposed). The top panel shows times in milliseconds and the bottom panel shows relative times._
<% if (!is.null(rowStats)) { toTable(rowStats, tags=tags) } %>
_Figure: Benchmarking of <%=hpaste(sprintf("%s()", levels(colStats$expr)), lastCollapse=" and ")%> on <%=paste(tags, collapse="+")%> data <% if (!is.null(rowStats)) { %> as well as <%=hpaste(sprintf("%s()", levels(rowStats$expr)), lastCollapse=" and ")%> on the same data transposed<% } # if (!is.null(rowStats)) %>. Outliers are displayed as crosses. Times are in milliseconds._
<%
y <- c(colStats$time, rowStats$time)/1e6
ymax <- max(y, na.rm=TRUE)
y75 <- quantile(y, probs=0.75, na.rm=TRUE)
yupper <- min(c(1.5*y75, ymax), na.rm=TRUE)
ylim <- c(0, yupper)
%>
<% toImage(colStats, tags=tags, ylim=ylim) %>
<% if (!is.null(rowStats)) toImage(rowStats, tags=tags, ylim=ylim) %>
<% if (!is.null(rowStats)) { %>
<%
# Compare performance or the column- and the row-specific methods
# for the "main" function.
stats <- list(colStats, rowStats)
stats <- lapply(stats, FUN=function(x) {
level <- levels(x$expr)[1]
x <- subset(x, expr %in% level)
x$expr <- factor(as.character(x$expr))
x
})
stats <- Reduce(rbind, stats)
odd <- seq(from=1L, to=nrow(stats), by=2L)
top <- 1:(nrow(stats)/2)
stats0 <- stats
stats[ odd,] <- stats0[ top,]
stats[-odd,] <- stats0[-top,]
%>
_Table: Benchmarking of <%=hpaste(sprintf("%s()", levels(stats$expr)), lastCollapse=" and ")%> on <%=paste(tags, collapse="+")%> data (original and transposed). The top panel shows times in milliseconds and the bottom panel shows relative times._
<% toTable(stats, tags=tags) %>
_Figure: Benchmarking of <%=hpaste(sprintf("%s()", levels(stats$expr)), lastCollapse=" and ")%> on <%=paste(tags, collapse="+")%> data (original and transposed). Outliers are displayed as crosses. Times are in milliseconds._
<% toImage(stats, name=paste(levels(stats$expr), collapse="_vs_"), tags=tags, col=c("#000000", "#999999")) %>
<% } # if (!is.null(rowStats)) %>
<% } # crBenchmarkResults() %>