148 lines
2.9 KiB
Plaintext
148 lines
2.9 KiB
Plaintext
<%@include file="includes/setup.md.rsp"%>
|
|
|
|
<%@string fcnname="indexByRow"%>
|
|
<% fcnname <- "<%@string name="fcnname"%>" %>
|
|
<%@meta title="${fcnname}() benchmarks"%>
|
|
<%@meta author="Henrik Bengtsson"%>
|
|
<%@meta date="2014-11-09"%>
|
|
|
|
<%@include file="${header}"%>
|
|
|
|
<%
|
|
lfun <- local({
|
|
locals <- list()
|
|
function(txt = NULL) {
|
|
if (is.null(txt)) return(locals)
|
|
local <- list(txt)
|
|
locals <<- c(locals, local)
|
|
}
|
|
})
|
|
%>
|
|
|
|
# <%@meta name="title"%>
|
|
|
|
This report benchmark the performance of `<%=fcnname%>()` against alternative methods:
|
|
|
|
* `indexByRow_R1()` based in `matrix(..., byrow = TRUE)`
|
|
* `indexByRow_R2()` is a modified version of `indexByRow_R1()`
|
|
|
|
where `indexByRow_R1()` and `indexByRow_R2()` are defined as in the Appendix.
|
|
|
|
<%
|
|
lfun(withCapture({
|
|
indexByRow_R1 <- function(dim, idxs = NULL, ...) {
|
|
n <- prod(dim)
|
|
x <- matrix(seq_len(n), nrow = dim[2L], ncol = dim[1L], byrow = TRUE)
|
|
if (!is.null(idxs))
|
|
x <- x[idxs]
|
|
as.vector(x)
|
|
} # indexByRow_R1()
|
|
}))
|
|
|
|
lfun(withCapture({
|
|
indexByRow_R2 <- function(dim, idxs = NULL, ...) {
|
|
n <- prod(dim)
|
|
if (is.null(idxs)) {
|
|
x <- matrix(seq_len(n), nrow = dim[2L], ncol = dim[1L], byrow = TRUE)
|
|
as.vector(x)
|
|
} else {
|
|
idxs <- idxs - 1
|
|
cols <- idxs %/% dim[2L]
|
|
rows <- idxs %% dim[2L]
|
|
cols + dim[1L]*rows + 1L
|
|
}
|
|
} # indexByRow_R2()
|
|
}))
|
|
%>
|
|
|
|
|
|
## Data
|
|
<% lfun(withCapture({
|
|
<%@include file="R/random-matrices.R"%>
|
|
})) %>
|
|
|
|
```r
|
|
<%=withCapture({
|
|
data <- rmatrices(mode = "index")
|
|
})%>
|
|
```
|
|
where `rmatrices()` is defined in the Appendix.
|
|
|
|
<%
|
|
# data <- data[1:2]
|
|
%>
|
|
|
|
## Results
|
|
|
|
<% for (dataLabel in names(data)) { %>
|
|
<% message(dataLabel) %>
|
|
### <%=dataLabel%> matrix
|
|
|
|
|
|
```r
|
|
<%=withCapture({
|
|
X <- data[[.dataLabel.]]
|
|
dim <- dim(X)
|
|
idxsList <- list(
|
|
'all-by-NULL' = NULL,
|
|
all = seq_len(prod(dim)),
|
|
odd = seq(from = 1, to = prod(dim), by = 2L)
|
|
)
|
|
str(idxsList)
|
|
})%>
|
|
```
|
|
|
|
<% for (ii in seq_along(idxsList)) { %>
|
|
|
|
#### Index set '<%=names(idxsList)[ii]%>'
|
|
<%
|
|
idxs <- idxsList[[ii]]
|
|
idxsTag <- names(idxsList)[ii]
|
|
|
|
# Validate correctness
|
|
res <- list(
|
|
indexByRow = indexByRow(dim, idxs = idxs),
|
|
indexByRow_R1 = indexByRow_R1(dim, idxs = idxs),
|
|
indexByRow_R2 = indexByRow_R2(dim, idxs = idxs)
|
|
)
|
|
lapply(res, FUN = function(x) stopifnot(all.equal(x, res[[1]])))
|
|
gc()
|
|
%>
|
|
|
|
```r
|
|
<%=withCapture({
|
|
stats <- microbenchmark(
|
|
indexByRow = indexByRow(dim, idxs = idxs),
|
|
indexByRow_R1 = indexByRow_R1(dim, idxs = idxs),
|
|
indexByRow_R2 = indexByRow_R2(dim, idxs = idxs),
|
|
unit = "ms"
|
|
)
|
|
})%>
|
|
```
|
|
|
|
<% benchmarkResults(stats, tags=c(dataLabel, idxsTag)) %>
|
|
|
|
<% } # for (ii ...) %>
|
|
|
|
<% } # for (dataLabel ...) %>
|
|
|
|
<%@include file="${footer}"%>
|
|
|
|
### Local functions
|
|
```r
|
|
<%=lfun()[[1]]%>
|
|
```
|
|
```r
|
|
<%=lfun()[[2]]%>
|
|
```
|
|
```r
|
|
<%=lfun()[[3]]%>
|
|
```
|
|
|
|
|
|
<%---------------------------------------------------------------------------
|
|
HISTORY:
|
|
2014-06-09
|
|
o Created.
|
|
---------------------------------------------------------------------------%>
|