From 334347d5b8d40a7aff72961e387cdb94b48958e5 Mon Sep 17 00:00:00 2001 From: Filip Krikava Date: Wed, 17 Sep 2025 16:33:22 +0200 Subject: [PATCH 1/9] Add the SpeedTest benchmarks (#43) --- Benchmarks/prg/Qlearn.R | 78 +++++++++++++++ Benchmarks/prg/cholesky.R | 36 +++++++ Benchmarks/prg/cv-basisfun.R | 58 +++++++++++ Benchmarks/prg/data.R | 37 +++++++ Benchmarks/prg/em.R | 24 +++++ Benchmarks/prg/gcd.R | 47 +++++++++ Benchmarks/prg/gp.R | 79 +++++++++++++++ Benchmarks/prg/heat.R | 30 ++++++ Benchmarks/prg/hmc/hmc1.R | 42 ++++++++ Benchmarks/prg/hmc/hmc2.R | 44 +++++++++ Benchmarks/prg/kernel-PCA.R | 49 +++++++++ Benchmarks/prg/lm-nn.R | 99 +++++++++++++++++++ Benchmarks/prg/matexp/matexp_large.R | 24 +++++ Benchmarks/prg/matexp/matexp_medium.R | 24 +++++ Benchmarks/prg/matexp/matexp_small.R | 28 ++++++ Benchmarks/prg/matmult/matmult_sumprd.R | 41 ++++++++ Benchmarks/prg/matmult/matmult_triplp.R | 43 ++++++++ Benchmarks/prg/mlp.R | 91 +++++++++++++++++ Benchmarks/prg/near/near_large.R | 37 +++++++ Benchmarks/prg/near/near_small.R | 38 +++++++ Benchmarks/prg/primes.R | 28 ++++++ Benchmarks/prg/sieve/sieve1.R | 21 ++++ Benchmarks/prg/sieve/sieve2.R | 17 ++++ Benchmarks/prg/text/text_look.R | 18 ++++ Benchmarks/prg/text/text_replace.R | 25 +++++ Benchmarks/tst/alloc/alloc1.R | 5 + Benchmarks/tst/alloc/alloc2.R | 16 +++ Benchmarks/tst/alloc/alloc3.R | 12 +++ Benchmarks/tst/alloc/alloc4.R | 13 +++ Benchmarks/tst/any-all/any-all_all.R | 17 ++++ Benchmarks/tst/any-all/any-all_any.R | 17 ++++ Benchmarks/tst/any-all/any-all_relop.R | 19 ++++ Benchmarks/tst/apply/eapply.R | 20 ++++ Benchmarks/tst/apply/lapply.R | 19 ++++ Benchmarks/tst/apply/vapply.R | 18 ++++ Benchmarks/tst/assign/assign_largevec.R | 11 +++ Benchmarks/tst/assign/assign_simple.R | 12 +++ .../assign/complicated/complicated_dollar.R | 11 +++ .../complicated/complicated_doublebracket.R | 11 +++ .../assign/complicated/complicated_matrix.R | 5 + .../assign/complicated/complicated_nested.R | 5 + Benchmarks/tst/assign/list/list_bracket.R | 13 +++ Benchmarks/tst/assign/list/list_dollar.R | 5 + .../tst/assign/list/list_doublebracket.R | 11 +++ Benchmarks/tst/assign/named/named_scalar.R | 10 ++ Benchmarks/tst/assign/named/named_vector.R | 9 ++ Benchmarks/tst/assign/vecmat/vecmat_matrix.R | 10 ++ Benchmarks/tst/assign/vecmat/vecmat_named.R | 11 +++ Benchmarks/tst/assign/vecmat/vecmat_numeric.R | 10 ++ Benchmarks/tst/attr/attr_change1.R | 13 +++ Benchmarks/tst/attr/attr_change2.R | 13 +++ Benchmarks/tst/attr/attr_get1.R | 7 ++ Benchmarks/tst/attr/attr_get2.R | 7 ++ Benchmarks/tst/attr/attr_set1.R | 6 ++ Benchmarks/tst/attr/attr_set2.R | 6 ++ Benchmarks/tst/base/apply/apply1.R | 14 +++ Benchmarks/tst/base/apply/apply2.R | 16 +++ Benchmarks/tst/base/base_array.R | 24 +++++ Benchmarks/tst/base/base_dataframe.R | 31 ++++++ Benchmarks/tst/base/base_diag.R | 23 +++++ Benchmarks/tst/base/base_ifelse.R | 19 ++++ Benchmarks/tst/base/base_matrix.R | 27 +++++ Benchmarks/tst/base/eigen/eigen_full.R | 16 +++ Benchmarks/tst/base/eigen/eigen_onlyval.R | 16 +++ Benchmarks/tst/base/svd/svd_full.R | 13 +++ Benchmarks/tst/base/svd/svd_onlyval.R | 13 +++ Benchmarks/tst/bind/bind_unlist.R | 18 ++++ Benchmarks/tst/bind/cbind.R | 35 +++++++ .../tst/bind/concatenate/concatenate_mixed.R | 22 +++++ .../tst/bind/concatenate/concatenate_str.R | 14 +++ .../tst/bind/concatenate/concatenate_vec.R | 12 +++ Benchmarks/tst/bind/rbind.R | 35 +++++++ Benchmarks/tst/class/S3/S3_class.R | 12 +++ Benchmarks/tst/class/S3/S3_list.R | 6 ++ Benchmarks/tst/class/S3/S3_noclass.R | 20 ++++ Benchmarks/tst/class/S3/S3_num.R | 6 ++ Benchmarks/tst/class/S3/S3_seq.R | 8 ++ Benchmarks/tst/class/S4/S4_fiddle.R | 24 +++++ Benchmarks/tst/class/S4/S4_fiddle2.R | 26 +++++ Benchmarks/tst/class/S4/S4_imsqrt.R | 20 ++++ Benchmarks/tst/class/S4/S4_sqrt.R | 11 +++ Benchmarks/tst/class/unclass/unclass_add.R | 26 +++++ Benchmarks/tst/class/unclass/unclass_subset.R | 10 ++ .../tst/complex-expr/complex-expr_intops.R | 13 +++ .../tst/complex-expr/complex-expr_trig.R | 12 +++ Benchmarks/tst/cum/cum_complex.R | 9 ++ Benchmarks/tst/cum/cum_double.R | 16 +++ Benchmarks/tst/cum/cum_int.R | 14 +++ Benchmarks/tst/dollar/dollar_exact-name.R | 17 ++++ Benchmarks/tst/dollar/dollar_exact-string.R | 17 ++++ Benchmarks/tst/dollar/dollar_partial-name.R | 16 +++ Benchmarks/tst/dollar/dollar_partial-string.R | 16 +++ Benchmarks/tst/for.R | 37 +++++++ 93 files changed, 2084 insertions(+) create mode 100644 Benchmarks/prg/Qlearn.R create mode 100644 Benchmarks/prg/cholesky.R create mode 100644 Benchmarks/prg/cv-basisfun.R create mode 100644 Benchmarks/prg/data.R create mode 100644 Benchmarks/prg/em.R create mode 100644 Benchmarks/prg/gcd.R create mode 100644 Benchmarks/prg/gp.R create mode 100644 Benchmarks/prg/heat.R create mode 100644 Benchmarks/prg/hmc/hmc1.R create mode 100644 Benchmarks/prg/hmc/hmc2.R create mode 100644 Benchmarks/prg/kernel-PCA.R create mode 100644 Benchmarks/prg/lm-nn.R create mode 100644 Benchmarks/prg/matexp/matexp_large.R create mode 100644 Benchmarks/prg/matexp/matexp_medium.R create mode 100644 Benchmarks/prg/matexp/matexp_small.R create mode 100644 Benchmarks/prg/matmult/matmult_sumprd.R create mode 100644 Benchmarks/prg/matmult/matmult_triplp.R create mode 100644 Benchmarks/prg/mlp.R create mode 100644 Benchmarks/prg/near/near_large.R create mode 100644 Benchmarks/prg/near/near_small.R create mode 100644 Benchmarks/prg/primes.R create mode 100644 Benchmarks/prg/sieve/sieve1.R create mode 100644 Benchmarks/prg/sieve/sieve2.R create mode 100644 Benchmarks/prg/text/text_look.R create mode 100644 Benchmarks/prg/text/text_replace.R create mode 100644 Benchmarks/tst/alloc/alloc1.R create mode 100644 Benchmarks/tst/alloc/alloc2.R create mode 100644 Benchmarks/tst/alloc/alloc3.R create mode 100644 Benchmarks/tst/alloc/alloc4.R create mode 100644 Benchmarks/tst/any-all/any-all_all.R create mode 100644 Benchmarks/tst/any-all/any-all_any.R create mode 100644 Benchmarks/tst/any-all/any-all_relop.R create mode 100644 Benchmarks/tst/apply/eapply.R create mode 100644 Benchmarks/tst/apply/lapply.R create mode 100644 Benchmarks/tst/apply/vapply.R create mode 100644 Benchmarks/tst/assign/assign_largevec.R create mode 100644 Benchmarks/tst/assign/assign_simple.R create mode 100644 Benchmarks/tst/assign/complicated/complicated_dollar.R create mode 100644 Benchmarks/tst/assign/complicated/complicated_doublebracket.R create mode 100644 Benchmarks/tst/assign/complicated/complicated_matrix.R create mode 100644 Benchmarks/tst/assign/complicated/complicated_nested.R create mode 100644 Benchmarks/tst/assign/list/list_bracket.R create mode 100644 Benchmarks/tst/assign/list/list_dollar.R create mode 100644 Benchmarks/tst/assign/list/list_doublebracket.R create mode 100644 Benchmarks/tst/assign/named/named_scalar.R create mode 100644 Benchmarks/tst/assign/named/named_vector.R create mode 100644 Benchmarks/tst/assign/vecmat/vecmat_matrix.R create mode 100644 Benchmarks/tst/assign/vecmat/vecmat_named.R create mode 100644 Benchmarks/tst/assign/vecmat/vecmat_numeric.R create mode 100644 Benchmarks/tst/attr/attr_change1.R create mode 100644 Benchmarks/tst/attr/attr_change2.R create mode 100644 Benchmarks/tst/attr/attr_get1.R create mode 100644 Benchmarks/tst/attr/attr_get2.R create mode 100644 Benchmarks/tst/attr/attr_set1.R create mode 100644 Benchmarks/tst/attr/attr_set2.R create mode 100644 Benchmarks/tst/base/apply/apply1.R create mode 100644 Benchmarks/tst/base/apply/apply2.R create mode 100644 Benchmarks/tst/base/base_array.R create mode 100644 Benchmarks/tst/base/base_dataframe.R create mode 100644 Benchmarks/tst/base/base_diag.R create mode 100644 Benchmarks/tst/base/base_ifelse.R create mode 100644 Benchmarks/tst/base/base_matrix.R create mode 100644 Benchmarks/tst/base/eigen/eigen_full.R create mode 100644 Benchmarks/tst/base/eigen/eigen_onlyval.R create mode 100644 Benchmarks/tst/base/svd/svd_full.R create mode 100644 Benchmarks/tst/base/svd/svd_onlyval.R create mode 100644 Benchmarks/tst/bind/bind_unlist.R create mode 100644 Benchmarks/tst/bind/cbind.R create mode 100644 Benchmarks/tst/bind/concatenate/concatenate_mixed.R create mode 100644 Benchmarks/tst/bind/concatenate/concatenate_str.R create mode 100644 Benchmarks/tst/bind/concatenate/concatenate_vec.R create mode 100644 Benchmarks/tst/bind/rbind.R create mode 100644 Benchmarks/tst/class/S3/S3_class.R create mode 100644 Benchmarks/tst/class/S3/S3_list.R create mode 100644 Benchmarks/tst/class/S3/S3_noclass.R create mode 100644 Benchmarks/tst/class/S3/S3_num.R create mode 100644 Benchmarks/tst/class/S3/S3_seq.R create mode 100644 Benchmarks/tst/class/S4/S4_fiddle.R create mode 100644 Benchmarks/tst/class/S4/S4_fiddle2.R create mode 100644 Benchmarks/tst/class/S4/S4_imsqrt.R create mode 100644 Benchmarks/tst/class/S4/S4_sqrt.R create mode 100644 Benchmarks/tst/class/unclass/unclass_add.R create mode 100644 Benchmarks/tst/class/unclass/unclass_subset.R create mode 100644 Benchmarks/tst/complex-expr/complex-expr_intops.R create mode 100644 Benchmarks/tst/complex-expr/complex-expr_trig.R create mode 100644 Benchmarks/tst/cum/cum_complex.R create mode 100644 Benchmarks/tst/cum/cum_double.R create mode 100644 Benchmarks/tst/cum/cum_int.R create mode 100644 Benchmarks/tst/dollar/dollar_exact-name.R create mode 100644 Benchmarks/tst/dollar/dollar_exact-string.R create mode 100644 Benchmarks/tst/dollar/dollar_partial-name.R create mode 100644 Benchmarks/tst/dollar/dollar_partial-string.R create mode 100644 Benchmarks/tst/for.R diff --git a/Benchmarks/prg/Qlearn.R b/Benchmarks/prg/Qlearn.R new file mode 100644 index 00000000..ada5d05d --- /dev/null +++ b/Benchmarks/prg/Qlearn.R @@ -0,0 +1,78 @@ +execute <- function(size = 30000L) { + simulate <- function(init, world, gamma, alpha, epsilon, steps) { + history = matrix(NA,steps,6) + colnames(history) = c("t","s","a","r","rs","sn") + + Q = matrix(0,n.states,n.actions) + + s = init() + + for (t in 1:steps) { + if (runif(1)n.states/2) + s = s - bit*n.states/2 + + if (runif(1)<0.05) + { s = sample(n.states/2,1) + } + else + { if (a>3) + { bit = 1-bit + a = a-3 + } + s = s + (a-2) + if (s<1) s = n.states/2 + if (s>n.states/2) s = 1 + } + + r = marks[s] - 10*as.numeric(s==1) + + marks <<- as.numeric (marks>0 | (runif(n.states)<0.3)) + marks[s] <<- 0 + + s = s + bit*n.states/2 + + list (s=s, r=r) + } + + gamma = 0.95 + alpha = 0.015 + epsilon = 0.1 + + n.states = 10*2 + n.actions = 3*2 + set.seed(1) + + result2m = simulate (init2m, world2m, gamma, alpha, epsilon, size) + return (mean(result2m$history[,"r"])) # Average reward +} \ No newline at end of file diff --git a/Benchmarks/prg/cholesky.R b/Benchmarks/prg/cholesky.R new file mode 100644 index 00000000..5af7d0ee --- /dev/null +++ b/Benchmarks/prg/cholesky.R @@ -0,0 +1,36 @@ +execute <- function(size = 200L) { + cholesky <- function(A) { + if (!is.matrix(A) || nrow(A) != ncol(A)) { + stop("The argument for cholesky must be a square matrix") + } + + p <- nrow(A) + U <- matrix(0, p, p) + + for (i in 1:p) { + if (i == 1) {U[i,i] <- sqrt(A[i,i])} + else {U[i,i] <- sqrt(A[i,i] - sum(U[1:(i-1),i]^2))} + + if (i b) gcd1(a-b,b) else if (b > a) gcd1(a,b-a) else a + + gcd2 <- function(a, b) { + if (a == 0) b + else if (b == 0) a + else if (a > b) gcd2(a%%b,b) + else gcd2(a,b%%a) + } + + gcd3 <- function(a, b) { + repeat { + if (a > b) { a <- a-b; next } + if (b > a) { b <- b-a; next } + return (a); + } + } + + gcd4 <- function(a, b) { + repeat { + if (a == 0) return (b) + if (b == 0) return (a) + if (a > b) a <- a%%b + else b <- b%%a + } + } + + gcd5 <- function(a, b) { + while (a != b) { + if (a > b) a <- a - b + else b <- b - a + } + a + } + + gcd_table <- function(n, gcd) { + tbl <- matrix(integer(), n, n) + for (i in 1:n) + for (j in 1:n) + tbl[i, j] <- gcd(i, j) + tbl + } + r1 <- gcd_table(size,gcd1); r2 <- gcd_table(size,gcd2); r3 <- gcd_table(size,gcd3) + r4 <- gcd_table(size,gcd4); r5 <- gcd_table(size,gcd5) + res <- all(sapply(list(r2, r3, r4, r5), identical, r1)) + return(res) +} \ No newline at end of file diff --git a/Benchmarks/prg/gp.R b/Benchmarks/prg/gp.R new file mode 100644 index 00000000..08512bc6 --- /dev/null +++ b/Benchmarks/prg/gp.R @@ -0,0 +1,79 @@ +execute <- function(size = 1L) { + gp_cov <- function(x1, x2, s, r) { + n <- length(x1) + m <- length(x2) + C <- matrix(nrow=n,ncol=m) + + for (j in seq_len(m)) {C[,j] <- s^2 * exp(-(r*(x1-x2[j]))^2)} + C + } + + gp_log_likelihood <- function(x, y, s, r, v) { + C <- gp_cov(x, x, s, r) + diag(C) <- diag(C) + v^2 + U <- chol(C) + u <- backsolve(U, y, transpose = TRUE) + as.vector(-sum(u^2)/2 - sum(log(diag(U))) - length(y)*log(2*pi)/2) + } + + gp_search <- function(x, y, s.vec, r.vec, v.vec) { + best.ll <- -Inf + for (s in s.vec) { + for (r in r.vec) { + for (v in v.vec) { + ll <- gp_log_likelihood(x, y, s, r, v) + if (ll >= best.ll) { + best.s <- s + best.r <- r + best.v <- v + best.ll <- ll + } + } + } + } + c(s = best.s, r = best.r, v = best.v) + } + + gp_predict <- function(x, y, s, r, v, x.test) { + C <- gp_cov(x,x,s,r) + diag(C) <- diag(C) + v^2 + U <- chol(C) + u <- backsolve(U,y,transpose=TRUE) + u <- backsolve(U,u) + K <- gp_cov(x,x.test,s,r) + as.vector (t(K) %*% u) + } + + tf <- function(x) 1.2 * sin(0.3 + 0.2 * x^2 + 2.7 * sin(2 * x + 0.2)) + + f <- function (N, n) { + set.seed(1) + hlist <<- list() + + for (i in 1:N) { + x <- rnorm(n) + x.test <- seq(-2,2,length=1000) + y <- tf(x) + rnorm(n,0,0.11) + + h <- gp_search (x, y, s.vec = c(0.7,1.0,1.2,1.4,2.0), + r.vec = c(1.0,1.4,2.0,2.8), + v.vec = c(0.1,0.14,0.2,0.28)) + hlist[[i]] <<- h + + p <- gp_predict (x, y, h["s"], h["r"], h["v"], x.test) + } + + cbind (x=x.test, y=tf(x.test), p=p) + } + + R1 <- f((size*10), 100) + res <- hlist + R2 <- f(size, 350) + + list(res, R1[c(1,500,1000),"p"], R2[c(1,500,1000),"p"]) + + # Original benchmark result checking + # + # plot(R[,"x"],R[,"y"],type="l") + # points(R[,"x"],R[,"p"],pch=20) +} \ No newline at end of file diff --git a/Benchmarks/prg/heat.R b/Benchmarks/prg/heat.R new file mode 100644 index 00000000..eeaf71a9 --- /dev/null +++ b/Benchmarks/prg/heat.R @@ -0,0 +1,30 @@ +execute <- function(size = 10L) { + initial_temperatures <- function(nr, nc) { + M <- matrix(0, nrow = nr, ncol = nc) + for (i in 1:nr) M[i,nc] <- 1 + for (j in 1:nc) M[nr,j] <- 1 + M + } + + heat_flow <- function(M) { + R <- M + for (i in 2:(ncol(M)-1)) { + for (j in 2:9) { + R[i,j] <- (M[i,j] + M[i-1,j] + M[i,j-1] + M[i+1,j] + M[i,j+1]) / 5 + } + } + R + } + + doit <- function(nr,nc,k){ + M <- initial_temperatures(nr, nc) + for (i in 1:k) M <- heat_flow(M) + M + } + + r1 <- doit(size,size,(size*3000)) + res1 <- round(r1,2) + r2 <- doit((size*10),(size*10),(size*30)) + res2 <- round(r2[91:100,91:100],2) + list(res1, res2) +} \ No newline at end of file diff --git a/Benchmarks/prg/hmc/hmc1.R b/Benchmarks/prg/hmc/hmc1.R new file mode 100644 index 00000000..7df39200 --- /dev/null +++ b/Benchmarks/prg/hmc/hmc1.R @@ -0,0 +1,42 @@ +execute <- function(size = 50000L) { + HMC <- function(U, grad_U, epsilon, L, current_q) { + q = current_q + p = rnorm(length(q),0,1) + current_p = p + p = p - epsilon * grad_U(q) / 2 + + for (i in 1:L) { + q = q + epsilon * p + if (i!=L) p = p - epsilon * grad_U(q) + } + + p = p - epsilon * grad_U(q) / 2 + p = -p + + current_U = U(current_q) + current_K = sum(current_p^2) / 2 + proposed_U = U(q) + proposed_K = sum(p^2) / 2 + + if (runif(1) < exp(current_U-proposed_U+current_K-proposed_K)) q else current_q + } + + test_HMC = function (epsilon,L,n,seed=1){ + set.seed(seed) + + U = function (q) q^2/2 + sin(q) + grad_U = function (q) q + cos(q) + + q = numeric(n+1) + for (i in 1:n) + { q[i+1] = HMC(U,grad_U,epsilon,L,q[i]) + } + + list (median=median(q), mean=mean(q), sd=sd(q)) + } + + r1 <- test_HMC(0.8,10,size) + r2 <- test_HMC(1.1,1,(size*2)) + + list(r1,r2) +} \ No newline at end of file diff --git a/Benchmarks/prg/hmc/hmc2.R b/Benchmarks/prg/hmc/hmc2.R new file mode 100644 index 00000000..e661bef4 --- /dev/null +++ b/Benchmarks/prg/hmc/hmc2.R @@ -0,0 +1,44 @@ +execute <- function(size = 25000L) { + HMC <- function(U, grad_U, epsilon, L, current_q) { + q = current_q + p = rnorm(length(q),0,1) + current_p = p + p = p - epsilon * grad_U(q) / 2 + + for (i in 1:L) { + q = q + epsilon * p + if (i!=L) p = p - epsilon * grad_U(q) + } + + p = p - epsilon * grad_U(q) / 2 + p = -p + + current_U = U(current_q) + current_K = sum(current_p^2) / 2 + proposed_U = U(q) + proposed_K = sum(p^2) / 2 + + if (runif(1) < exp(current_U-proposed_U+current_K-proposed_K)) q else current_q + } + + test_HMC = function (epsilon,L,n,seed=1) + { + set.seed(seed) + + s1 = 2; s2 = 3; r = 0.9 + inv_cov = solve(matrix(c(s1^2,s1*s2*r,s1*s2*r,s2^2),2,2)) + U = function (q) t(q) %*% inv_cov %*% q / 2 + grad_U = function (q) inv_cov %*% q + + q = matrix(0,n+1,2) + for (i in 1:n) + { q[i+1,] = HMC(U,grad_U,epsilon,L,q[i,]) + } + + list (mean=apply(q,2,mean), sd=apply(q,2,sd), cor=cor(q[,1],q[,2])) + } + r1 <- test_HMC(0.8,10,size) + r2 <- test_HMC(1.1,1,(size*2)) + + list(r1,r2) +} \ No newline at end of file diff --git a/Benchmarks/prg/kernel-PCA.R b/Benchmarks/prg/kernel-PCA.R new file mode 100644 index 00000000..850abbf8 --- /dev/null +++ b/Benchmarks/prg/kernel-PCA.R @@ -0,0 +1,49 @@ +# execute <- function(size = 100L) { +# kpca <- function(Xtrn, Xtst, rho, m) { +# n <- nrow(Xtrn) +# +# K <- matrix(NA, n, n) +# for (i in 1:n) { +# for (j in i:n) { +# K[i,j] <- K[j,i] <- exp(-rho^2*sum((Xtrn[i,]-Xtrn[j,])^2)) +# } +# } +# +# M <- diag(n) - matrix(1/n, n, n) +# e <- eigen(M %*% K %*% M, symmetric=TRUE) +# +# prj <- matrix(NA, nrow(Xtst), m) +# Ks <- colSums(K)/n +# for (t in 1:nrow(Xtst)) { +# k <- rep(NA, n) +# for (i in 1:n) {k[i] <- exp(-rho^2*sum((Xtrn[i,]-Xtst[t,])^2))} +# for (w in 1:m) {prj[t,w] <- (k - Ks) %*% M %*% e$vectors[,w] / sqrt(e$values[w])} +# } +# prj +# } +# +# set.seed(1) +# X <- matrix(NA, size, 2) +# class <- rep(NA,size) +# +# for (i in 1:(size)) { +# theta <- runif(1,0,2*pi) +# r <- runif(1,1,1.75) +# X[i,1] <- r*cos(theta) +# X[i,2] <- 1.1*r*sin(theta) +# +# class[i] <- as.numeric(runif(1)<0.5) +# if (class[i]) +# { X[i,1] <- 0.8*X[i,1]+0.1 +# X[i,2] <- 0.7*X[i,2]-0.2 +# } +# } +# +# class.trn <- class[1:size] +# class.tst <- class[(size+1):(size)] +# +# for (i in 1:25) {prj <- kpca(X, X, 1, 3)} +# res <- coef(glm(class~prj,family="binomial")) +# +# return(res) +# } diff --git a/Benchmarks/prg/lm-nn.R b/Benchmarks/prg/lm-nn.R new file mode 100644 index 00000000..6aa32ddc --- /dev/null +++ b/Benchmarks/prg/lm-nn.R @@ -0,0 +1,99 @@ +execute <- function(size = 25L) { + lm.nn <- function(x.train, y.train, x.test, K = length(y.train), lambda = 0) { + if (K > length(y.train)) K <- length(y.train) + + x.train <- cbind(1, as.matrix(x.train)) + x.test <- cbind(1, as.matrix(x.test)) + + if (is.finite(lambda)) { + Istar <- diag(ncol(x.train)) + Istar[1,1] <- 0 + S <- lambda*Istar + t(x.train)%*%x.train + b <- as.vector(solve(S) %*% t(x.train) %*% y.train) + } else { + b <- c(mean(y.train), rep(0, ncol(x.train)-1)) + } + + r <- y.train - x.train %*% b + yp <- numeric(nrow(x.test)) + + for (i in 1:nrow(x.test)) { + x <- x.test[i,] + dsq <- colSums((t(x.train) - x)^2) + nn <- order(dsq)[1:K] + lmp <- x %*% b + yp[i] <- lmp + mean(r[nn]) + } + yp + } + + lm.nn.val <- function (x.train, y.train, val.ix, try.K, try.lambda){ + x.train <- as.matrix(x.train) + + V <- matrix (NA, length(try.K), length(try.lambda)) + rownames(V) <- paste("K=",try.K,sep="") + colnames(V) <- paste("lambda=",try.lambda,sep="") + + for (i in 1:length(try.K)) + { for (j in 1:length(try.lambda)) + { + yp <- lm.nn (x.train[-val.ix,], y.train[-val.ix], + x.train[val.ix,,drop=FALSE], # drop=F needed if only 1 case + K = try.K[i], lambda = try.lambda[j]) + + V[i,j] <- mean ((y.train[val.ix] - yp)^2) + } + } + + V + } + + lm.nn.cross.val <- function(x.train, y.train, S, try.K, try.lambda) { + n <- length(y.train) + m <- round((0:S)*n/S) + + for (h in 1:S) { + V <- lm.nn.val (x.train, y.train, (m[h]+1) : m[h+1], try.K, try.lambda) + Vsum <- if (h==1) V else Vsum+V + } + + V <- Vsum / S + sq_errs <<- V + best.err <- Inf + + for (i in 1:length(try.K)) { + for (j in 1:length(try.lambda)) { + if (V[i,j] < best.err) { + best.K <- try.K[i] + best.lambda <- try.lambda[j] + best.err <- V[i,j] + } + } + } + list (K = best.K, lambda = best.lambda) + } + + try.K <- c(1,2,3,4,5,8,11,16,21,32,Inf) + try.lambda <- c(0,0.003,0.1,0.3,1,3,10,30,100,300,1000,3000,Inf) + trn <- matrix (c ( + 0.880502, 0.184882, 1.028223, 0.702374, 0.972312, 0.573326, 0.909021, 0.168052, + 0.95079, 0.943839, 0.887451, 0.943475, 0.839248, 0.129159, 1.043134, 0.833449, + 0.973279, 0.468019, 0.961081, 0.549984, 0.949531, 0.552674, 0.91663, 0.238895, + 0.990195, 0.760513, 0.896209, 0.18082, 0.938033, 0.405282, 0.990347, 0.853548, + 0.925798, 0.976398, 0.842838, 0.225825, 0.983122, 0.444809, 0.815483, 0.074979, + 1.008201, 0.661899, 0.899325, 0.38755, 0.958679, 0.836889, 0.815854, 0.150501, + 0.965061, 0.347272, 0.955632, 0.488773, 0.869407, 0.149247, 0.932092, 0.357063, + 0.979991, 0.962644, 0.845821, 0.132372, 0.865177, 0.010415, 0.837018, 0.164642, + 1.056621, 0.810192, 1.027535, 0.868861, 0.958395, 0.514282, 1.006573, 0.627196, + 0.966963, 0.844429, 0.926343, 0.284871, 0.951499, 0.667226, 0.816952, 0.15047, + 0.966922, 0.981728, 0.96647, 0.297011, 0.890256, 0.115084, 0.888619, 0.163201, + 0.940952, 0.944042, 1.032706, 0.794864, 0.950564, 0.974688, 0.902847, 0.349088, + 0.947514, 0.50197, 1.032153, 0.810397), + ncol=2, byrow=TRUE) + + x.train <- as.matrix(trn[,-1]) + y.train <- as.vector(trn[,1]) + + result <- lm.nn.cross.val(x.train, y.train, size, try.K, try.lambda) + list(round(sqrt(sq_errs), 5), result) +} \ No newline at end of file diff --git a/Benchmarks/prg/matexp/matexp_large.R b/Benchmarks/prg/matexp/matexp_large.R new file mode 100644 index 00000000..6f983614 --- /dev/null +++ b/Benchmarks/prg/matexp/matexp_large.R @@ -0,0 +1,24 @@ +execute <- function(power = 20L) { + matexp <- function(A, last_pow) { + S <- diag(nrow(A)) + if (last_pow > 0) { + T <- A + if (last_pow > 1) { + for (pow in 2:last_pow) { + S <- S + T + T <- (A %*% T) * (1/pow) + } + } + S <- S + T + } + S + } + + A <- matrix(seq(0,0.2,length=100^2), 100, 100) + s <- 0 + for (i in 1:500) { + R <- matexp(A,power) + if (R[length(R)] < 0) s <- 1 + } + list(s,sum(R)) +} \ No newline at end of file diff --git a/Benchmarks/prg/matexp/matexp_medium.R b/Benchmarks/prg/matexp/matexp_medium.R new file mode 100644 index 00000000..0df51ef1 --- /dev/null +++ b/Benchmarks/prg/matexp/matexp_medium.R @@ -0,0 +1,24 @@ +execute <- function(power = 30L) { + matexp <- function(A, last_pow) { + S <- diag(nrow(A)) + if (last_pow > 0) { + T <- A + if (last_pow > 1) { + for (pow in 2:last_pow) { + S <- S + T + T <- (A %*% T) * (1/pow) + } + } + S <- S + T + } + S + } + + A <- matrix(seq(0,0.5,length=25^2), 25, 25) + s <- 0 + for (i in 1:5000) { + R <- matexp(A,power) + if (R[length(R)] < 0) s <- 1 + } + list(s, round(R,2)) +} \ No newline at end of file diff --git a/Benchmarks/prg/matexp/matexp_small.R b/Benchmarks/prg/matexp/matexp_small.R new file mode 100644 index 00000000..acdc1fd8 --- /dev/null +++ b/Benchmarks/prg/matexp/matexp_small.R @@ -0,0 +1,28 @@ +execute <- function(power = 10L) { + matexp <- function(A, last_pow) { + S <- diag(nrow(A)) + if (last_pow > 0) { + T <- A + if (last_pow > 1) { + for (pow in 2:last_pow) { + S <- S + T + T <- (A %*% T) * (1/pow) + } + } + S <- S + T + } + S + } + + A <- matrix(seq(0,1,length=7^2), 7, 7) + s1 <- s2 <- 0 + for (i in 1:50000) { + R1 <- matexp(A,power) + if (R1[length(R1)] < 0) s <- 1 + } + for (i in 1:50000) { + R2 <- matexp(A,(power*2)) + if (R2[length(R2)] < 0) s <- 1 + } + list(s1,s2,R1,R2) +} \ No newline at end of file diff --git a/Benchmarks/prg/matmult/matmult_sumprd.R b/Benchmarks/prg/matmult/matmult_sumprd.R new file mode 100644 index 00000000..55e8e2d4 --- /dev/null +++ b/Benchmarks/prg/matmult/matmult_sumprd.R @@ -0,0 +1,41 @@ +execute <- function(r = 2000L) { + matmult <- function(A, B) { + stopifnot(is.matrix(A) && is.matrix(B) && ncol(A)==nrow(B)) + + n <- nrow(A) + m <- ncol(B) + k <- ncol(A) + + R <- matrix(numeric(0), n, m) + + for (i in seq_len(n)) + { for (j in seq_len(m)) + { R[i,j] <- sum(A[i,]*B[,j]) + } + } + R + } +set.seed(1) + +gen <- function (n) as.double(rbinom(n,1000,0.5)) + +A0 <- matrix(gen(1*40000),1,40000) +A1 <- matrix(gen(2*20000),2,20000) +A2 <- matrix(gen(200*200),200,200) +A3 <- matrix(gen(133*301),133,301) + +B0 <- matrix(gen(40000*1),40000,1) +B1 <- matrix(gen(2*20000),20000,2) +B2 <- matrix(gen(200*200),200,200) +B3 <- matrix(gen(301*133),301,133) + +R <- A3 %*% B3 + +V <- vector("list",r) +for (i in 1:r) V[[i]] <- matmult(A0,B0) +for (i in 1:r) V[[i]] <- matmult(A1,B1) +for (i in 1:(r/50)) V[[i]] <- matmult(A2,B2) +for (i in 1:(r/50)) V[[i]] <- matmult(A3,B3) +for (i in 1:length(V)) {if (!identical(V[[i]],R)) return(FALSE)} + return(TRUE) +} \ No newline at end of file diff --git a/Benchmarks/prg/matmult/matmult_triplp.R b/Benchmarks/prg/matmult/matmult_triplp.R new file mode 100644 index 00000000..3813d5a6 --- /dev/null +++ b/Benchmarks/prg/matmult/matmult_triplp.R @@ -0,0 +1,43 @@ +execute <- function(r = 50L) { + matmult <- function(A, B) { + stopifnot(is.matrix(A) && is.matrix(B) && ncol(A)==nrow(B)) + + n <- nrow(A) + m <- ncol(B) + k <- ncol(A) + + R <- matrix(numeric(0), n, m) + + for (i in seq_len(n)) { + for (j in seq_len(m)) { + s <- 0 + for (h in seq_len(k)) s <- s + A[i,h] * B[h,j] + R[i,j] <- s + } + } + R + } +set.seed(1) + +gen <- function (n) as.double(rbinom(n,1000,0.5)) + +A0 <- matrix(gen(1*40000),1,40000) +A1 <- matrix(gen(2*20000),2,20000) +A2 <- matrix(gen(200*200),200,200) +A3 <- matrix(gen(133*301),133,301) + +B0 <- matrix(gen(40000*1),40000,1) +B1 <- matrix(gen(2*20000),20000,2) +B2 <- matrix(gen(200*200),200,200) +B3 <- matrix(gen(301*133),301,133) + +R <- A3 %*% B3 + +V <- vector("list",r) +for (i in 1:r) V[[i]] <- matmult(A0,B0) +for (i in 1:r) V[[i]] <- matmult(A1,B1) +for (i in 1:(r/50)) V[[i]] <- matmult(A2,B2) +for (i in 1:(r/50)) V[[i]] <- matmult(A3,B3) +for (i in 1:length(V)) {if (!identical(V[[i]],R)) return(FALSE)} + return(TRUE) +} \ No newline at end of file diff --git a/Benchmarks/prg/mlp.R b/Benchmarks/prg/mlp.R new file mode 100644 index 00000000..d54d7511 --- /dev/null +++ b/Benchmarks/prg/mlp.R @@ -0,0 +1,91 @@ +execute <- function(size = 200L) { + mlp.train <- function(y, X, eta1, eta2, iters, q=NULL, init=NULL) { + n <- nrow(X) + p <- ncol(X) + + if (is.null(q)) q <- as.integer((length(init)-1)/(p+2)) + + M <- (q+1) + q*(p+1) + + if (is.null(init)) init <- c(log(mean(y)/(1-mean(y))), rnorm(M-1,0,0.01)) + + eta <- c(rep(eta2,q+1), rep(eta1,q*(p+1))) + ll <- rep(NA,iters) + params <- matrix(NA,iters,M) + p1 <- matrix(NA,iters,n) + current <- init + fw <- mlp.forward(X,q,current) + + for (iter in 1:iters) { + bk <- mlp.backward(y,X,q,current,fw) + gr <- mlp.grad(X,q,fw,bk) + current <- current + eta*gr + params[iter,] <- current + fw <- mlp.forward(X,q,current) + p1[iter,] <- 1/(1+exp(-fw$o)) + ll[iter] <- mlp.log.likelihood(y,fw$o) + } + + list(ll=ll, p1=p1, params=params) + } + + mlp.forward <- function(X, q, params) { + n <- nrow(X) + p <- ncol(X) + + if (length(params) != (q+1) + q*(p+1)) {stop("Parameter vector is the wrong length")} + + beta0 <- params[1] + beta <- params[2:(q+1)] + gamma0 <- params[(q+2):(2*q+1)] + gamma0m <- matrix(gamma0,n,q,byrow=T) + gamma <- matrix(params[(2*q+2):length(params)],p,q) + + s <- X %*% gamma + gamma0m + h <- tanh(s) + o <- h %*% beta + beta0 + + list(s=s, h=h, o=o) + } + + mlp.backward <- function(y, X, q, params, fw) { + beta <- params[2:(q+1)] + + p1 <- 1/(1+exp(-fw$o)) + + dl.do <- y-p1 + dl.dh <- dl.do %*% beta + dl.ds <- (1-fw$h^2) * dl.dh + + list(dl.do=dl.do, dl.dh=dl.dh, dl.ds=dl.ds) + } + + mlp.grad <- function(X, q, fw, bk) { + p <- ncol(X) + + dl.dbeta0 <- sum(bk$dl.do) + dl.dbeta <- t(fw$h) %*% bk$dl.do + dl.dgamma0 <- apply(bk$dl.ds, 2, sum) + dl.dgamma <- matrix(NA,p,q) + + for (j in 1:p) {dl.dgamma[j,] <- X[,j] %*% bk$dl.ds} + + c(dl.dbeta0=dl.dbeta0, dl.dbeta=dl.dbeta, dl.dgamma0=dl.dgamma0, dl.dgamma=dl.dgamma) + } + + mlp.log.likelihood <- function(y, o) { + sum(-log(1+exp(-(2*y-1)*o))) + } + + + set.seed(1) + X <- matrix(rnorm(12*size), size, 12) + y <- 1 / (1 + exp(-(X[,1]-X[,2]^2-4*sin(2*X[,3]-0.3*X[,4]*X[,5])))) + n.iters <- 1500 + + res <- mlp.train (y, X, 0.004, 0.004, n.iters, 20) + r1 <- round(res$ll[seq(1,n.iters,length=20)],2) + r2 <- round(res$params[n.iters,],4) + + list(r1,r2) +} \ No newline at end of file diff --git a/Benchmarks/prg/near/near_large.R b/Benchmarks/prg/near/near_large.R new file mode 100644 index 00000000..bcb796aa --- /dev/null +++ b/Benchmarks/prg/near/near_large.R @@ -0,0 +1,37 @@ +execute <- function(size = 1000L) { + sq_dist <- function(M, v) colSums((M-v)^2) + + near <- function(M, V, P, t, proj_M=P%*%M) { + count <- numeric(ncol(V)) + dist <- numeric(ncol(V)) + + for (j in 1:ncol(V)) { + sqd <- sq_dist(proj_M, as.vector(P %*% V[,j])) + c <- 0 + d <- Inf + + for (i in 1:length(sqd)) { + if (sqd[i] < t) { + c <- c + 1 + d2 <- sum((M[,i]-V[,j])^2) + if (d2 < d) d <- d2 + } + } + + count[j] <- c + dist[j] <- sqrt(d) + } + + list(count=count, dist=dist) + } + + set.seed(2) + p_dim <- max(100, round(size/10)) + P <- matrix(runif(p_dim*size,-2,+2), p_dim, size) + M <- matrix(rnorm(size*20*size), size, 20*size) + proj_M <- P %*% M + V <- matrix(rnorm(size*5*p_dim), size, 5*p_dim) + + res <- near(M,V,P,425^2,proj_M) + list(c(mean(res$count),mean(res$count==0)), res$dist[c(1,500)]) +} \ No newline at end of file diff --git a/Benchmarks/prg/near/near_small.R b/Benchmarks/prg/near/near_small.R new file mode 100644 index 00000000..5f81f192 --- /dev/null +++ b/Benchmarks/prg/near/near_small.R @@ -0,0 +1,38 @@ +execute <- function(size = 20L) { + sq_dist <- function(M, v) colSums((M-v)^2) + + near <- function(M, V, P, t, proj_M=P%*%M) { + count <- numeric(ncol(V)) + dist <- numeric(ncol(V)) + + for (j in 1:ncol(V)) { + sqd <- sq_dist(proj_M, as.vector(P %*% V[,j])) + c <- 0 + d <- Inf + + for (i in 1:length(sqd)) { + if (sqd[i] < t) { + c <- c + 1 + d2 <- sum((M[,i]-V[,j])^2) + if (d2 < d) d <- d2 + } + } + + count[j] <- c + dist[j] <- sqrt(d) + } + + list(count=count, dist=dist) + } + + set.seed(1) + p_dim <- max(5, round(size/4)) + P <- matrix(runif(p_dim*size,-2,+2), p_dim, size) + M <- matrix(rnorm(size*10*size), size, 10*size) + proj_M <- P %*% M + V <- matrix(rnorm(size*size), size, size) + + res <- NULL + for (i in 1:500) res <- unlist(near(M,V,P,8^2,proj_M)) + return(res) +} \ No newline at end of file diff --git a/Benchmarks/prg/primes.R b/Benchmarks/prg/primes.R new file mode 100644 index 00000000..e2ab7180 --- /dev/null +++ b/Benchmarks/prg/primes.R @@ -0,0 +1,28 @@ +execute <- function(size = 16L) { + isPrime <- function(n) { + if (n < 2) FALSE + else if (n == 2) TRUE + else if (n %% 2 == 0) FALSE + else{ + upperLimit <- sqrt(n); + i <- 3 + while (i <= upperLimit) { + if (n %% i == 0) return(FALSE) + i <- i + 2 + } + TRUE + } + } + + doit <- function (LIMIT) { + limit <- 2^LIMIT + noPrimes <- 0 + for (n in 0:limit) {if (isPrime(n)) noPrimes <- noPrimes + 1} + paste("pi(",limit,") = ",noPrimes,"\n",sep="") + } + + r1 <- doit(size) + r2 <- doit((size+2)) + + list(r1, r2) +} \ No newline at end of file diff --git a/Benchmarks/prg/sieve/sieve1.R b/Benchmarks/prg/sieve/sieve1.R new file mode 100644 index 00000000..49ab264f --- /dev/null +++ b/Benchmarks/prg/sieve/sieve1.R @@ -0,0 +1,21 @@ +execute <- function(size = 1000L) { + sieve <- function(n) { + composite <- logical(n) + composite[1] <- TRUE + + for (i in 2:n) { + if (!composite[i]) { + j <- 2*i + while (j <= n) { + composite[j] <- TRUE + j <- j + i + } + } + } + (1:n)[!composite] + } + + for (i in 1:2000) ra <- sieve(size) + for (i in 1:2) rb <- sieve(size*1000) + list(ra, rb[c(1:10,(length(rb)-9):length(rb))]) +} \ No newline at end of file diff --git a/Benchmarks/prg/sieve/sieve2.R b/Benchmarks/prg/sieve/sieve2.R new file mode 100644 index 00000000..b39684f0 --- /dev/null +++ b/Benchmarks/prg/sieve/sieve2.R @@ -0,0 +1,17 @@ +execute <- function(size = 1000L) { + sieve <- function(n) { + composite <- logical(n) + composite[1] <- TRUE + + for (i in 2:floor(n/2)) { + if (!composite[i]) { + composite[seq.int(from=2*i, to=n, by=i)] <- TRUE + } + } + (1:n)[!composite] + } + + for (i in 1:10000) ra <- sieve(size) + for (i in 1:10) rb <- sieve(size*1000) + list(ra, rb[c(1:10,(length(rb)-9):length(rb))]) +} \ No newline at end of file diff --git a/Benchmarks/prg/text/text_look.R b/Benchmarks/prg/text/text_look.R new file mode 100644 index 00000000..b22534c8 --- /dev/null +++ b/Benchmarks/prg/text/text_look.R @@ -0,0 +1,18 @@ +execute <- function(size = 50000L) { + count <- function(s1, s2) { + cnt <- 0 + for (i in seq_len(min(nchar(s1),nchar(s2)))) + if (substr(s1,i,i) == substr(s2,i,i)) + cnt <- cnt + 1 + cnt + } + + a <- "ABCDEFGHIJKLMNOPQRSTUVWXYZ" + b <- "ABCDEFG.IJKLMNOPQ.STUVWXYZ" + c <- "........IJ........S....................................................." + + for (i in 1:50000) r1 <- count(a,b) + for (i in 1:50000) r2 <- count(a,c) + + list(r1,r2) +} \ No newline at end of file diff --git a/Benchmarks/prg/text/text_replace.R b/Benchmarks/prg/text/text_replace.R new file mode 100644 index 00000000..1d936df5 --- /dev/null +++ b/Benchmarks/prg/text/text_replace.R @@ -0,0 +1,25 @@ +execute <- function(size = 1000L) { + replace <- function(s, c, v) { + k <- 1 + for (i in seq_along(s)) { + for (j in 1:nchar(s[i])) { + if (substr(s[i],j,j) == c) { + substr(s[i],j,j) <- substr(v,k,k) + k <- k+1 + if (k > nchar(v)) k <- 1 + } + } + } + s + } + + s1 <- rep(c("abc.defg.hijklm","x.y.z",".","pqrstuvwxyz"),size) + s2 <- paste("x",1:(size*100),"y") + s3 <- rep(c("a...b","..c..","....","x.y"), size) + + for (i in 1:30) r1 <- replace(s1, ".", "ABCDEFG") + r2 <- replace(paste("x",1:100000,"y"), "4", "ABCDEFGHIJK") + for (i in 1:30) r3 <- replace(s3,".","ABCDEFGHIJKLMNOPQRSTUVWXYZ") + + list(r1[1:20], r2[1:50], r3[1:20]) +} \ No newline at end of file diff --git a/Benchmarks/tst/alloc/alloc1.R b/Benchmarks/tst/alloc/alloc1.R new file mode 100644 index 00000000..4c2325bc --- /dev/null +++ b/Benchmarks/tst/alloc/alloc1.R @@ -0,0 +1,5 @@ +execute <- function(size = 30000L) { + f <- function(i) { a <- (i-10000):(i+10000); c(a[1],a[length(a)]) } + g <- function(n) { b <- 0; for (i in 1:n) b <- b + f(i); b } + g(size) +} \ No newline at end of file diff --git a/Benchmarks/tst/alloc/alloc2.R b/Benchmarks/tst/alloc/alloc2.R new file mode 100644 index 00000000..a23bc816 --- /dev/null +++ b/Benchmarks/tst/alloc/alloc2.R @@ -0,0 +1,16 @@ +execute <- function(size = 8L) { + f <- function(x, y, n) { + if (n < 1) return(x + y) + for (k in 1:3) { + a <- c(x, y, 1.1) + for (i in 1:2) { + b <- as.integer(123 * a) + d <- as.logical(b) + a <- f(0.11 * d, 0.32 * a, n / 2) + } + } + return(a) + } + a<-f(c(1.3, 5.1), c(0.3, 1.3), size) + list(a[1],a[length(a)],sum(a)) +} \ No newline at end of file diff --git a/Benchmarks/tst/alloc/alloc3.R b/Benchmarks/tst/alloc/alloc3.R new file mode 100644 index 00000000..6b2d6884 --- /dev/null +++ b/Benchmarks/tst/alloc/alloc3.R @@ -0,0 +1,12 @@ +execute <- function(size = 128L) { + f <- function(x, y, n) { + if (n < 1) return(x + y) + a <- c(x, 1.1) + y + for (i in 1:5) { + b <- as.integer(1234 * a) + a <- f(x + 0.1, b/2000, n/2) + } + return(a) + } + f(3.1, c(0.3, 1.3), size) +} \ No newline at end of file diff --git a/Benchmarks/tst/alloc/alloc4.R b/Benchmarks/tst/alloc/alloc4.R new file mode 100644 index 00000000..961da0e0 --- /dev/null +++ b/Benchmarks/tst/alloc/alloc4.R @@ -0,0 +1,13 @@ +execute <- function(size = 10000L) { + set.seed(1) + f <- function(n, m, r) { + s <- sample(1:n) + a <- vector("list", n) + for (i in 1:r) { + for (j in s) a[[j]] <- integer(m) + for (j in s) a[[j]] <- integer(3 * m) + for (j in s) a[[j]] <- integer(5 * m) + } + } + f(size, 10, 20) +} \ No newline at end of file diff --git a/Benchmarks/tst/any-all/any-all_all.R b/Benchmarks/tst/any-all/any-all_all.R new file mode 100644 index 00000000..a52c357b --- /dev/null +++ b/Benchmarks/tst/any-all/any-all_all.R @@ -0,0 +1,17 @@ +execute <- function(size = 500000L) { + b <- rep(T,1000) + + d <- c(FALSE, TRUE) + f1 <- function () {for (i in 1:(size*10)) x <- all(d); x} + x1<-f1() + + b[700] <- F + f2 <- function () {for (i in 1:size) x <- all(b); x} + x2<-f2() + + b[700] <- NA + f3 <- function () {for (i in 1:size) x <- all(b); x} + x3<-f3() + + list(x1, x2, x3) +} \ No newline at end of file diff --git a/Benchmarks/tst/any-all/any-all_any.R b/Benchmarks/tst/any-all/any-all_any.R new file mode 100644 index 00000000..f6381e75 --- /dev/null +++ b/Benchmarks/tst/any-all/any-all_any.R @@ -0,0 +1,17 @@ +execute <- function(size = 500000L) { + b <- rep(FALSE, 1000) + + d <- c(FALSE, TRUE) + f1 <- function () {for (i in 1:(size*10)) x <- any(d); x} + x1<-f1() + + b[700] <- TRUE + f2 <- function () {for (i in 1:size) x <- any(b); x} + x2<-f2() + + b[700] <- NA + f3 <- function () {for (i in 1:size) x <- any(b); x} + x3<-f3() + + list(x1, x2, x3) +} \ No newline at end of file diff --git a/Benchmarks/tst/any-all/any-all_relop.R b/Benchmarks/tst/any-all/any-all_relop.R new file mode 100644 index 00000000..c78c7023 --- /dev/null +++ b/Benchmarks/tst/any-all/any-all_relop.R @@ -0,0 +1,19 @@ +execute <- function(size = 100000L) { + a <- seq(0.001,1,length=1000) + anan <- a + anan[300] <- 0/0 + + x1 <- x2 <- x3 <- x4 <- x5 <- x6 <- x7 <- x8 <- x9 <- NULL + + for (i in 1:size) x1 <- any(a > 0.2) + for (i in 1:size) x2 <- all(a < 0.2) + for (i in 1:size) x3 <- any(a > 0.7) + for (i in 1:size) x4 <- all(a < 0.7) + for (i in 1:(size*2)) x5 <- any(is.na(a)) + for (i in 1:(size*2)) x6 <- any(is.nan(anan)) + for (i in 1:(size*2)) x7 <- any(is.infinite(a)) + for (i in 1:(size*2)) x8 <- all(is.finite(a)) + for (i in 1:(size*3)) x9 <- all(is.na(a)) + + list(x1, x2, x3, x4, x5, x6, x7, x8, x9) +} \ No newline at end of file diff --git a/Benchmarks/tst/apply/eapply.R b/Benchmarks/tst/apply/eapply.R new file mode 100644 index 00000000..c70938e4 --- /dev/null +++ b/Benchmarks/tst/apply/eapply.R @@ -0,0 +1,20 @@ +execute <- function(size = 10000L) { + F <- new.env() + for (i in 1:9) F[[paste0("v",i)]] <- rep(1.01*i, 100) + E <- new.env() + for (i in 1:99) E[[paste0("v",i)]] <- rep(1.01*i, 100) + f1 <- function(x) sum(x)+10000 + f2 <- function(x,a) sum(x)+a + f3 <- function(x) c(sum(x),-1) + + a1 <- a2 <- a3 <- a4 <- a5 <- a6 <- NULL + for (i in 1:(size*10)) a1 <- eapply(F, f1)[order(names(eapply(F, f1)))] + for (i in 1:(size*10)) a2 <- eapply(F, f2, 10000)[order(names(eapply(F, f2, 10000)))] + for (i in 1:(size*10)) a3 <- eapply(F, f3)[order(names(eapply(F, f3)))] + for (i in 1:size) a4 <- eapply(E, f1)[order(names(eapply(E, f1)))] + for (i in 1:size) a5 <- eapply(E, f2, 10000)[order(names(eapply(E, f2, 10000)))] + for (i in 1:size) a6 <- eapply(E, f3)[order(names(eapply(E, f3)))] + + res <- lapply(list(a1, a2, a3, a4, a5, a6), unlist) + return(res) +} \ No newline at end of file diff --git a/Benchmarks/tst/apply/lapply.R b/Benchmarks/tst/apply/lapply.R new file mode 100644 index 00000000..5986962b --- /dev/null +++ b/Benchmarks/tst/apply/lapply.R @@ -0,0 +1,19 @@ +execute <- function(size = 10000L) { + S <- lapply(1:9, function(i) rep(1.01*i, 100)) + L <- lapply(1:99, function(i) rep(1.01*i, 100)) + + f1 <- function(x) sum(x)+10000 + f2 <- function(x,a) sum(x)+a + f3 <- function(x) c(sum(x),-1) + + a1 <- a2 <- a3 <- a4 <- a5 <- a6 <- NULL + for (i in 1:(size*10)) a1 <- lapply(S, f1) + for (i in 1:(size*10)) a2 <- lapply(S, f2, 10000) + for (i in 1:(size*10)) a3 <- lapply(S, f3) + for (i in 1:size) a4 <- lapply(L, f1) + for (i in 1:size) a5 <- lapply(L, f2, 10000) + for (i in 1:size) a6 <- lapply(L, f3) + + res <- lapply(list(a1, a2, a3, a4, a5, a6), unlist) + return(res) +} \ No newline at end of file diff --git a/Benchmarks/tst/apply/vapply.R b/Benchmarks/tst/apply/vapply.R new file mode 100644 index 00000000..739f7255 --- /dev/null +++ b/Benchmarks/tst/apply/vapply.R @@ -0,0 +1,18 @@ +execute <- function(size = 10000L) { + S <- lapply(1:9, function(i) rep(1.01*i, 100)) + L <- lapply(1:99, function(i) rep(1.01*i, 100)) + f1 <- function(x) sum(x)+10000 + f2 <- function(x,a) sum(x)+a + f3 <- function(x) c(sum(x),-1) + + a1 <- a2 <- a3 <- a4 <- a5 <- a6 <- NULL + for (i in 1:(size*10)) a1 <- vapply(S, f1, numeric(1)) + for (i in 1:(size*10)) a2 <- vapply(S, f2, numeric(1), 10000) + for (i in 1:(size*10)) a3 <- vapply(S, f3, numeric(2)) + for (i in 1:size) a4 <- vapply(L, f1, numeric(1)) + for (i in 1:size) a5 <- vapply(L, f2, numeric(1), 10000) + for (i in 1:size) a6 <- vapply(L, f3, numeric(2)) + + res <- lapply(list(a1, a2, a3, a4, a5, a6), unlist) + return(res) +} \ No newline at end of file diff --git a/Benchmarks/tst/assign/assign_largevec.R b/Benchmarks/tst/assign/assign_largevec.R new file mode 100644 index 00000000..3df3e0dd --- /dev/null +++ b/Benchmarks/tst/assign/assign_largevec.R @@ -0,0 +1,11 @@ +execute <- function(size = 30000L) { + f <- function(n, j, v){ + vec <- (1:10000)/10000 + for (i in 1:n) vec[j] <- v + sum(vec) + } + r1 <- f(size,201:8000,1.1) + r2 <- f(size,201:8000,(1:100)*1.1) + r3 <- f(size,201:8000,(201:8000)*1.1) + list(r1,r2,r3) +} \ No newline at end of file diff --git a/Benchmarks/tst/assign/assign_simple.R b/Benchmarks/tst/assign/assign_simple.R new file mode 100644 index 00000000..333905d5 --- /dev/null +++ b/Benchmarks/tst/assign/assign_simple.R @@ -0,0 +1,12 @@ +execute <- function(size = 1000000L) { + w <- x <- y <- z <- 0 + a <- 1.1 + b <- 2.2 + for (i in 1:size) { + w <- a+1 + x <- a+b + y <- a-b + z <- a*b + } + w+x+y+z +} \ No newline at end of file diff --git a/Benchmarks/tst/assign/complicated/complicated_dollar.R b/Benchmarks/tst/assign/complicated/complicated_dollar.R new file mode 100644 index 00000000..baf4f606 --- /dev/null +++ b/Benchmarks/tst/assign/complicated/complicated_dollar.R @@ -0,0 +1,11 @@ +execute <- function(size = 500000L) { + f <- function(n, j, k, v){ + lis <- list (a=1, b=(1:11)/11, c=list(xa=10,ya=20,xb=30,yb=40)) + for (i in 1:n) lis[[j]][k] <- v + lis + } + + r1 <- f(size,2,3,5) + r2 <- f(size,"b",3,5) + list(unlist(r1), unlist(r2)) +} \ No newline at end of file diff --git a/Benchmarks/tst/assign/complicated/complicated_doublebracket.R b/Benchmarks/tst/assign/complicated/complicated_doublebracket.R new file mode 100644 index 00000000..13c02203 --- /dev/null +++ b/Benchmarks/tst/assign/complicated/complicated_doublebracket.R @@ -0,0 +1,11 @@ +execute <- function(size = 500000L) { + f <- function(n, k, v){ + lis <- list (a=1, b=(1:11)/11, c=list(xa=10,ya=20,xb=30,yb=40)) + for (i in 1:n) lis$b[k] <- v + lis + } + + r1 <- f(size,3,5) + r2 <- f(size,c(3,1),5) + list(unlist(r1), unlist(r2)) +} \ No newline at end of file diff --git a/Benchmarks/tst/assign/complicated/complicated_matrix.R b/Benchmarks/tst/assign/complicated/complicated_matrix.R new file mode 100644 index 00000000..a7a584e2 --- /dev/null +++ b/Benchmarks/tst/assign/complicated/complicated_matrix.R @@ -0,0 +1,5 @@ +# execute <- function(size = 60000L) { +# lis <- list(a=1, b=matrix(4,2,2), c=10) +# for (i in 1:size) diag(lis$b)[2] <- 5 +# unlist(lis) +# } diff --git a/Benchmarks/tst/assign/complicated/complicated_nested.R b/Benchmarks/tst/assign/complicated/complicated_nested.R new file mode 100644 index 00000000..9e9f8aa3 --- /dev/null +++ b/Benchmarks/tst/assign/complicated/complicated_nested.R @@ -0,0 +1,5 @@ +execute <- function(size = 500000L) { + lis <- list(a=1, b=(1:11)/11, c=list(xa=10,ya=20,xb=30,yb=40)) + for (i in 1:size) lis$c$xb <- 5 + unlist(lis) +} \ No newline at end of file diff --git a/Benchmarks/tst/assign/list/list_bracket.R b/Benchmarks/tst/assign/list/list_bracket.R new file mode 100644 index 00000000..119fc8ca --- /dev/null +++ b/Benchmarks/tst/assign/list/list_bracket.R @@ -0,0 +1,13 @@ +execute <- function(size = 1000000L) { + f <- function(n, j){ + lis <- list(ab=3,cd=4,ef=5,gh=6) + for (i in 1:n) lis[j] <- 10 + lis + } + + r1 <- f(size,"ef") + r2 <- f(size,3) + r3 <- f(size,c("ef","ab")) + r4 <- f(size,c(3,1)) + list(unlist(r1), unlist(r2), unlist(r3), unlist(r4)) +} \ No newline at end of file diff --git a/Benchmarks/tst/assign/list/list_dollar.R b/Benchmarks/tst/assign/list/list_dollar.R new file mode 100644 index 00000000..12e0d9a4 --- /dev/null +++ b/Benchmarks/tst/assign/list/list_dollar.R @@ -0,0 +1,5 @@ +execute <- function(size = 1000000L) { + lis <- list(ab=3, cd=4, ef=5, gh=6) + for (i in 1:size) lis$ef <- 10 + unlist(lis) +} \ No newline at end of file diff --git a/Benchmarks/tst/assign/list/list_doublebracket.R b/Benchmarks/tst/assign/list/list_doublebracket.R new file mode 100644 index 00000000..e0340d12 --- /dev/null +++ b/Benchmarks/tst/assign/list/list_doublebracket.R @@ -0,0 +1,11 @@ +execute <- function(size = 1000000L) { + f <- function(n, j){ + lis <- list(ab=3,cd=4,ef=5,gh=6) + for (i in 1:n) lis[[j]] <- 10 + lis + } + + r1 <- f(size,"ef") + r2 <- f(size,3) + list(unlist(r1),unlist(r2)) +} \ No newline at end of file diff --git a/Benchmarks/tst/assign/named/named_scalar.R b/Benchmarks/tst/assign/named/named_scalar.R new file mode 100644 index 00000000..dce68d74 --- /dev/null +++ b/Benchmarks/tst/assign/named/named_scalar.R @@ -0,0 +1,10 @@ +execute <- function(size = 500000L) { + u <- numeric(1000) + w <- 1 + for (i in 1:size) { + v <- w + v <- 0 + u[10] <- 1 + } + u[10] +} \ No newline at end of file diff --git a/Benchmarks/tst/assign/named/named_vector.R b/Benchmarks/tst/assign/named/named_vector.R new file mode 100644 index 00000000..b94c2360 --- /dev/null +++ b/Benchmarks/tst/assign/named/named_vector.R @@ -0,0 +1,9 @@ +execute <- function(size = 500000L) { + u <- numeric(1000) + for (i in 1:size) { + v <- u + v <- 0 + u[10] <- 1 + } + u[10] +} \ No newline at end of file diff --git a/Benchmarks/tst/assign/vecmat/vecmat_matrix.R b/Benchmarks/tst/assign/vecmat/vecmat_matrix.R new file mode 100644 index 00000000..60e0c864 --- /dev/null +++ b/Benchmarks/tst/assign/vecmat/vecmat_matrix.R @@ -0,0 +1,10 @@ +execute <- function(size = 1000000L) { + f <- function(n, j, k, v){ + mat <- matrix ((1:100)/100, 10, 10) + for (i in 1:n) mat[j,k] <- v + sum(mat) + } + r1 <- f(size,7,2,1.1) + r2 <- f(size,5:7,2,1.1) + list(r1,r2) +} \ No newline at end of file diff --git a/Benchmarks/tst/assign/vecmat/vecmat_named.R b/Benchmarks/tst/assign/vecmat/vecmat_named.R new file mode 100644 index 00000000..a472d15b --- /dev/null +++ b/Benchmarks/tst/assign/vecmat/vecmat_named.R @@ -0,0 +1,11 @@ +execute <- function(size = 1000000L) { + f <- function(n, j, v){ + vec <- (1:100)/100 + names(vec) <- paste(c("a","b","c","d","e","f","g","h","i","j"),1:100,sep="") + for (i in 1:n) vec[j] <- v + sum(vec) + } + r1 <- f(size, "g17", 1.1) + r2 <- f(size, c("e15, f16, g17"), 1.1) + list(r1,r2) +} \ No newline at end of file diff --git a/Benchmarks/tst/assign/vecmat/vecmat_numeric.R b/Benchmarks/tst/assign/vecmat/vecmat_numeric.R new file mode 100644 index 00000000..e7a7a00d --- /dev/null +++ b/Benchmarks/tst/assign/vecmat/vecmat_numeric.R @@ -0,0 +1,10 @@ +execute <- function(size = 1000000L) { + f <- function(n, j, v){ + vec <- (1:100)/100 + for (i in 1:n) vec[j] <- v + sum(vec) + } + r1 <- f(size, 17, 1.1) + r2 <- f(size, 15:17, 1.1) + list(r1,r2) +} \ No newline at end of file diff --git a/Benchmarks/tst/attr/attr_change1.R b/Benchmarks/tst/attr/attr_change1.R new file mode 100644 index 00000000..cd8f7755 --- /dev/null +++ b/Benchmarks/tst/attr/attr_change1.R @@ -0,0 +1,13 @@ +execute <- function(size = 1000L) { + L <- size + R <- 500 + a <- 1:L + attr(a, "fred") <- rep("f", L) + + for (j in 1:R){ + tmp <- attr(a, "fred") + for (i in 1:L) tmp[i] <- "F" + attr(a, "fred") <- tmp + } + return(a) +} \ No newline at end of file diff --git a/Benchmarks/tst/attr/attr_change2.R b/Benchmarks/tst/attr/attr_change2.R new file mode 100644 index 00000000..06b6572c --- /dev/null +++ b/Benchmarks/tst/attr/attr_change2.R @@ -0,0 +1,13 @@ +execute <- function(size = 1000L) { + L <- size + R <- 500 + a <- 1:L + names(a) <- rep("n", L) + + for (j in 1:R) { + tmp <- names(a) + for (i in 1:L) tmp[i] <- "N" + names(a) <- tmp + } + return(a) +} \ No newline at end of file diff --git a/Benchmarks/tst/attr/attr_get1.R b/Benchmarks/tst/attr/attr_get1.R new file mode 100644 index 00000000..ee182f68 --- /dev/null +++ b/Benchmarks/tst/attr/attr_get1.R @@ -0,0 +1,7 @@ +execute <- function(size = 2000000L) { + a <- 9 + attributes(a) <- list(dd=1.4, cc=1.3, bb=1.2, aa=1.1) + r <- NULL + for (i in 1:size) r <- attr(a, "bb") + r +} \ No newline at end of file diff --git a/Benchmarks/tst/attr/attr_get2.R b/Benchmarks/tst/attr/attr_get2.R new file mode 100644 index 00000000..d07b10c2 --- /dev/null +++ b/Benchmarks/tst/attr/attr_get2.R @@ -0,0 +1,7 @@ +execute <- function(size = 2000000L) { + a <- 9 + attributes(a) <- list(dd=1.4, cc=1.3, bb=1.2, aa=1.1) + r <- NULL + for (i in 1:size) r <- attr(a, "b") + r +} \ No newline at end of file diff --git a/Benchmarks/tst/attr/attr_set1.R b/Benchmarks/tst/attr/attr_set1.R new file mode 100644 index 00000000..4d4ae49b --- /dev/null +++ b/Benchmarks/tst/attr/attr_set1.R @@ -0,0 +1,6 @@ +execute <- function(size = 1000000L) { + a <- 9 + attributes(a) <- list(dd=1.4, cc=1.3, bb=1.2, aa=1.1) + for (i in 1:size) { b <- a; attr(b,"bb") <- NULL} + return(b) +} \ No newline at end of file diff --git a/Benchmarks/tst/attr/attr_set2.R b/Benchmarks/tst/attr/attr_set2.R new file mode 100644 index 00000000..23ae0f99 --- /dev/null +++ b/Benchmarks/tst/attr/attr_set2.R @@ -0,0 +1,6 @@ +execute <- function(size = 1000000L) { + a <- 9 + attributes(a) <- list(dd=1.4, cc=1.3, bb=1.2, aa=1.1) + for (i in 1:size) { b <- a; attr(b,"bb") <- "x"} + return(b) +} \ No newline at end of file diff --git a/Benchmarks/tst/base/apply/apply1.R b/Benchmarks/tst/base/apply/apply1.R new file mode 100644 index 00000000..71e87c5e --- /dev/null +++ b/Benchmarks/tst/base/apply/apply1.R @@ -0,0 +1,14 @@ +execute <- function(size = 1000L) { + m <- matrix(seq(0,1,length=1200), 30, 40) + M <- matrix(seq(0,1,length=120000), 300, 400) + + f <- function (d,m,n) { + for (i in seq_len(n)) v <- apply(m,d,sum); v + } + + v1 <- f(1, m, (size*10)) + v2 <- f(2, m, (size*10)) + v3 <- f(1, M, size) + v4 <- f(2, M, size) + list(v1, v2, v3[c(1:10,291:300)], v4[c(1:10,391:400)]) +} \ No newline at end of file diff --git a/Benchmarks/tst/base/apply/apply2.R b/Benchmarks/tst/base/apply/apply2.R new file mode 100644 index 00000000..f69c5866 --- /dev/null +++ b/Benchmarks/tst/base/apply/apply2.R @@ -0,0 +1,16 @@ +execute <- function(size = 1000L) { + m <- matrix(seq(0,1,length=1200), 30, 40) + M <- matrix(seq(0,1,length=120000), 300, 400) + + f <- function (m,n) { + for (i in seq_len(n)) { + v <- numeric(nrow(m)); + for (j in seq_len(nrow(m))) v[j] <- sum(m[j,]) + } + v + } + + v1 <- f(m, (size*10)) + v2 <- f(M, size) + list(v1, v2[c(1:10,291:300)]) +} \ No newline at end of file diff --git a/Benchmarks/tst/base/base_array.R b/Benchmarks/tst/base/base_array.R new file mode 100644 index 00000000..92220252 --- /dev/null +++ b/Benchmarks/tst/base/base_array.R @@ -0,0 +1,24 @@ +execute <- function(size=500000L) { + v <- seq(1,2,length=10*10*10) + + f <- function (r,d) { + m <- c(10,10,10) + for (i in 1:r){ + a <- array(d,m) + a[1,1,1] <- 0 + } + + a + } + + a1<-f(size,1.1) + a2<-f(size,c(1.1,2.2)) + a3<-f(size,v) + + res <- lapply(list(a1, a2, a3), function(x) list( + dim1_slice = x[1, 1, 1:10], + dim2_slice = x[1, 1:10, 1], + dim3_slice = x[1:10, 1, 1] + )) + return(res) +} \ No newline at end of file diff --git a/Benchmarks/tst/base/base_dataframe.R b/Benchmarks/tst/base/base_dataframe.R new file mode 100644 index 00000000..318827cd --- /dev/null +++ b/Benchmarks/tst/base/base_dataframe.R @@ -0,0 +1,31 @@ +# execute <- function(size=1000L) { +# M <- matrix(c(1.2,1.3,1.4),1000,30,byrow=TRUE) +# +# f <- function (n,M) {for (i in 1:n) d <- as.data.frame(M); d} +# d<-f((size*5),M) +# +# g <- function (n,d) {for (i in 1:n) M <- as.matrix(d); M} +# M2<-g((size*3),d) +# +# r1 <- any(M2!=M) +# +# h <- function (n,d){ +# for (i in 1:n) { d[2,] <- 3.1; d[,3] <- 4.2; d[3,2] <- 5.5 } +# d +# } +# d2<-h(size,d) +# +# M2[2,] <- 3.1 +# M2[,3] <- 4.2 +# M2[3,2] <- 5.5 +# +# r2 <- any(M2!=as.matrix(d2)) +# +# e <- function (n,d) { +# for (i in 1:n) r <- d$V2 * d[,2] * (1:nrow(d)); r } +# w<-e((size*10),d) +# +# r3 <- sum(w) +# +# list(r1,r2,r3) +# } diff --git a/Benchmarks/tst/base/base_diag.R b/Benchmarks/tst/base/base_diag.R new file mode 100644 index 00000000..dccb9f96 --- /dev/null +++ b/Benchmarks/tst/base/base_diag.R @@ -0,0 +1,23 @@ +execute <- function(size=10000L) { + m <- matrix (seq(0,1,length=1200), 30, 30) + m <- m+t(m) + M <- matrix (seq(0,1,length=120000), 300, 300) + M <- M+t(M) + + f <- function (d,n) { + for (i in 1:n){ + M <- diag(d) + M[1,2] <- 7 + diag(M) <- diag(M) + 1 + M[1,1] <- 9 + v <- sum(diag(M)) + } + + v + } + + a<-f(30,size) + b<-f(rep(1+2i,30),size) + + list(a, b) +} \ No newline at end of file diff --git a/Benchmarks/tst/base/base_ifelse.R b/Benchmarks/tst/base/base_ifelse.R new file mode 100644 index 00000000..2263adfc --- /dev/null +++ b/Benchmarks/tst/base/base_ifelse.R @@ -0,0 +1,19 @@ +execute <- function(size=50000L) { + a <- rep(c(T,F),length=100) + u <- seq(1,2,length=100) + v <- seq(4,5,length=100) + + f <- function (n,a,u,v) { + for (i in seq_len(n)) r <- ifelse(a,u,v); r + } + + r1<-f((size*4),T,10,20) + r2<-f(size,a,u,v) + r3<-f(size,a,u,c(10,20,30,40,50)) + + u <- seq(1,2,length=20) + v <- seq(4,5,length=40) + attr(a,"fred") <- "bert" + r4<-f(size,a,u,v) + list(r1, r2, r3, r4) +} \ No newline at end of file diff --git a/Benchmarks/tst/base/base_matrix.R b/Benchmarks/tst/base/base_matrix.R new file mode 100644 index 00000000..4a9754cd --- /dev/null +++ b/Benchmarks/tst/base/base_matrix.R @@ -0,0 +1,27 @@ +execute <- function(size=5000L) { + v <- seq(1,2,length=300*210) + u <- seq(3,4,length=300) + + f <- function (d,n,m,r,byrow=FALSE) { + for (i in 1:r) + { a <- matrix(d,n,m,byrow=byrow) + a[1,1] <- 0 + } + + a + } + + a1<-f(1.1,300,210,size) + a2<-f(c(1.1,2.1,2.3),300,210,size) + a3<-f(v,300,210,size) + a4<-f(1.1,210,300,size,byrow=TRUE) + a5<-f(u,210,300,size,byrow=TRUE) + a6<-f(c(1.1,2.1,2.3),210,300,size,byrow=TRUE) + a7<-f(v,210,300,size,byrow=TRUE) + + res <- list( + row_slices = lapply(list(a1, a2, a3, a4, a5, a6, a7), function(x) x[1, 1:15]), + col_slices = lapply(list(a1, a2, a3, a4, a5, a6, a7), function(x) x[1:15, 1]) + ) + return(res) +} \ No newline at end of file diff --git a/Benchmarks/tst/base/eigen/eigen_full.R b/Benchmarks/tst/base/eigen/eigen_full.R new file mode 100644 index 00000000..8df0dbe9 --- /dev/null +++ b/Benchmarks/tst/base/eigen/eigen_full.R @@ -0,0 +1,16 @@ +# execute <- function(size=20L) { +# m <- matrix (seq(0,1,length=1200), 30, 30) +# m <- m+t(m) +# M <- matrix (seq(0,1,length=120000), 300, 300) +# M <- M+t(M) +# +# f <- function (m,n,k) { +# for (i in seq_len(n)) v <- eigen(m,symmetric=TRUE) +# v$values +# } +# +# a<-f(m,(size*500)) +# b<-f(M,size) +# +# list(a,b) +# } diff --git a/Benchmarks/tst/base/eigen/eigen_onlyval.R b/Benchmarks/tst/base/eigen/eigen_onlyval.R new file mode 100644 index 00000000..f44a615d --- /dev/null +++ b/Benchmarks/tst/base/eigen/eigen_onlyval.R @@ -0,0 +1,16 @@ +execute <- function(size=20L) { + m <- matrix (seq(0,1,length=1200), 30, 30) + m <- m+t(m) + M <- matrix (seq(0,1,length=120000), 300, 300) + M <- M+t(M) + + f <- function (m,n,k) { + for (i in seq_len(n)) v <- eigen(m,,symmetric=TRUE,only.values=TRUE) + v$values + } + + a<-f(m,(size*500)) + b<-f(M,size) + + list(a,b) +} \ No newline at end of file diff --git a/Benchmarks/tst/base/svd/svd_full.R b/Benchmarks/tst/base/svd/svd_full.R new file mode 100644 index 00000000..a534195d --- /dev/null +++ b/Benchmarks/tst/base/svd/svd_full.R @@ -0,0 +1,13 @@ +execute <- function(size=20L) { + m <- matrix (seq(0,1,length=1200), 30, 30) + m <- m+t(m) + M <- matrix (seq(0,1,length=120000), 300, 300) + M <- M+t(M) + + f <- function (m,n,k) {for (i in seq_len(n)) v <- svd(m); v$d} + + a<-f(m,(size*500)) + b<-f(M,size) + + list(a,b) +} \ No newline at end of file diff --git a/Benchmarks/tst/base/svd/svd_onlyval.R b/Benchmarks/tst/base/svd/svd_onlyval.R new file mode 100644 index 00000000..30babb54 --- /dev/null +++ b/Benchmarks/tst/base/svd/svd_onlyval.R @@ -0,0 +1,13 @@ +execute <- function(size=20L) { + m <- matrix (seq(0,1,length=1200), 30, 30) + m <- m+t(m) + M <- matrix (seq(0,1,length=120000), 300, 300) + M <- M+t(M) + + f <- function (m,n,k) {for (i in seq_len(n)) v <- svd(m,0,0); v$d} + + a<-f(m,(size*500)) + b<-f(M,size) + + list(a,b) +} \ No newline at end of file diff --git a/Benchmarks/tst/bind/bind_unlist.R b/Benchmarks/tst/bind/bind_unlist.R new file mode 100644 index 00000000..8a0a363f --- /dev/null +++ b/Benchmarks/tst/bind/bind_unlist.R @@ -0,0 +1,18 @@ +execute <- function(size=10000L) { + u <- rep(1.1,80) + v <- rep(2.2,800) + w <- rep(3.3,80) + + f <- function (n,xl) {for (i in 1:n) x <- unlist(xl); x} + + x1<-f((size*100),list(u,w)) + x2<-f((size*30),list(u,v,w)) + x3<-f((size*3),list(a=u,b=w)) + + names(u) <- paste("x",1:length(u),sep=":") + names(w) <- paste("y",1:length(u),sep=":") + x4<-f((size*10),list(u,w)) + x5<-f((size*10),list(a=u,b=w)) + + list(x1, sum(x2), x3, x4, x5) +} \ No newline at end of file diff --git a/Benchmarks/tst/bind/cbind.R b/Benchmarks/tst/bind/cbind.R new file mode 100644 index 00000000..214f4bb9 --- /dev/null +++ b/Benchmarks/tst/bind/cbind.R @@ -0,0 +1,35 @@ +execute <- function(size=10000L) { + u <- rep(1.1,100) + j <- 1:100 + v <- rep(0.7,10) + M <- matrix(2.2,100,50) + N <- matrix(3.3,100,40) + W <- matrix(7.1,100,2) + + Mnamed <- M + rownames(Mnamed) <- paste("R",1:nrow(M),sep="") + colnames(Mnamed) <- paste("C",1:ncol(M),sep="") + + Nnamed <- N + rownames(Nnamed) <- paste("r",1:nrow(N),sep="") + colnames(Nnamed) <- paste("c",1:ncol(N),sep="") + + f <- function (n,...) { for (i in 1:n) x <- cbind(...); x } + + x1<-f((size*3),M,N) + x2<-f((size*3),Mnamed,Nnamed) + x3<-f((size*3),M,u,j,N) + x4<-f((size*3),M,u) + x5<-f((size*3),M,v) + x6<-f((size*20),u,u,u,u,u) + x7<-f((size*20),W,W,W) + x8<-f((size*10),100,M,200) + + res <- list( + row_sums = lapply(list(x1, x2, x3, x4, x5), function(x) rowSums(x)), + col_sums = lapply(list(x1, x2, x3, x4, x5), function(x) colSums(x)), + dim_sums = lapply(list(x6,x7), function(x) c(dim(x), sum(x))), + x8 = list(x8[1,], x8[100,]) + ) + return(res) +} \ No newline at end of file diff --git a/Benchmarks/tst/bind/concatenate/concatenate_mixed.R b/Benchmarks/tst/bind/concatenate/concatenate_mixed.R new file mode 100644 index 00000000..b71bf67e --- /dev/null +++ b/Benchmarks/tst/bind/concatenate/concatenate_mixed.R @@ -0,0 +1,22 @@ +execute <- function(size=10000L) { + u <- rep(1.1,80) + j <- 1:80 + v <- rep(2.2,800) + w <- rep(3.3,80) + + f <- function (n,...) {for (i in 1:n) x <- c(...); x} + + x1<-f((size*500),2.1,3.2) + x2<-f((size*500),"ab","xy","pqrs") + x3<-f((size*500),list(1.1,2.2),list(3.3),list(4.4)) + x4<-f((size*200),u,w) + x5<-f((size*50),u,j,v,w) + x6<-f((size*3),a=u,b=w) + + names(u) <- paste("x",1:length(u),sep=":") + names(w) <- paste("y",1:length(u),sep=":") + x7<-f((size*10),u,w) + x8<-f((size*10),a=u,b=w) + + list(x1,x2,x3,x4,x5,x6,x7,x8) +} \ No newline at end of file diff --git a/Benchmarks/tst/bind/concatenate/concatenate_str.R b/Benchmarks/tst/bind/concatenate/concatenate_str.R new file mode 100644 index 00000000..36d2d2aa --- /dev/null +++ b/Benchmarks/tst/bind/concatenate/concatenate_str.R @@ -0,0 +1,14 @@ +execute <- function(size=600000L) { + f <- function (n,s1,s2,s3) + { + for (i in 1:n) v <- c(rep(s1,10),s2,s3) + v + } + + s1 <- rep("1.2",100) + s2 <- rep("3.4",1000) + s3 <- rep("5.6",1001) + + r <- f(size,s1,s2,s3) + c(length(r),sum(as.numeric(r))) +} \ No newline at end of file diff --git a/Benchmarks/tst/bind/concatenate/concatenate_vec.R b/Benchmarks/tst/bind/concatenate/concatenate_vec.R new file mode 100644 index 00000000..4dec8c6a --- /dev/null +++ b/Benchmarks/tst/bind/concatenate/concatenate_vec.R @@ -0,0 +1,12 @@ +execute <- function(size=1000000L) { + f <- function (n,u,v) + { + for (i in 1:n) r <- c(u+1,v-1) + r + } + + r1 <- f((size*10),10,27) + r2<-f(size,numeric(1000)+0.1,123.4) + + list(r1,length(r2),sum(r2)) +} \ No newline at end of file diff --git a/Benchmarks/tst/bind/rbind.R b/Benchmarks/tst/bind/rbind.R new file mode 100644 index 00000000..51a5aae8 --- /dev/null +++ b/Benchmarks/tst/bind/rbind.R @@ -0,0 +1,35 @@ +execute <- function(size=10000L) { + u <- rep(1.1,100) + j <- 1:100 + v <- rep(0.7,10) + M <- matrix(2.2,50,100) + N <- matrix(3.3,40,100) + W <- matrix(7.1,2,100) + + Mnamed <- M + rownames(Mnamed) <- paste("R",1:nrow(M),sep="") + colnames(Mnamed) <- paste("C",1:ncol(M),sep="") + + Nnamed <- N + rownames(Nnamed) <- paste("r",1:nrow(N),sep="") + colnames(Nnamed) <- paste("c",1:ncol(N),sep="") + + f <- function (n,...) {for (i in 1:n) x <- rbind(...); x} + + x1<-f((size*3),M,N) + x2<-f((size*3),Mnamed,Nnamed) + x3<-f((size*3),M,u,j,N) + x4<-f((size*3),M,u) + x5<-f((size*3),M,v) + x6<-f((size*20),u,u,u,u,u) + x7<-f((size*20),W,W,W) + x8<-f((size*10),100,M,200) + + res <- list( + row_sums = lapply(list(x1, x2, x3, x4, x5), function(x) rowSums(x)), + col_sums = lapply(list(x1, x2, x3, x4, x5), function(x) colSums(x)), + dim_sums = lapply(list(x6,x7), function(x) c(dim(x), sum(x))), + x8 = list(x8[,1], x8[,100]) + ) + return(res) +} \ No newline at end of file diff --git a/Benchmarks/tst/class/S3/S3_class.R b/Benchmarks/tst/class/S3/S3_class.R new file mode 100644 index 00000000..6a9cecef --- /dev/null +++ b/Benchmarks/tst/class/S3/S3_class.R @@ -0,0 +1,12 @@ +execute <- function(size=300000L){ + a <- 5; class(a) <- "fred" + b <- 7; class(b) <- "mary" + + addzeroc <- function (x) UseMethod("addzeroc") + + addzeroc.fred <- function (x) { r <- c(x,0); class(r) <- "fred"; r } + addzeroc.mary <- function (x) { r <- c(0,x); class(r) <- "mary"; r } + + for (i in 1:size) r <- list(addzeroc(a),addzeroc(b)) + return(r) +} \ No newline at end of file diff --git a/Benchmarks/tst/class/S3/S3_list.R b/Benchmarks/tst/class/S3/S3_list.R new file mode 100644 index 00000000..77bb3a20 --- /dev/null +++ b/Benchmarks/tst/class/S3/S3_list.R @@ -0,0 +1,6 @@ +# execute <- function(size=1000000L){ +# s <- list(q=101); class(s) <- "bert" +# +# for (i in 1:size) r <- s$q +# return(r) +# } diff --git a/Benchmarks/tst/class/S3/S3_noclass.R b/Benchmarks/tst/class/S3/S3_noclass.R new file mode 100644 index 00000000..aedae3f0 --- /dev/null +++ b/Benchmarks/tst/class/S3/S3_noclass.R @@ -0,0 +1,20 @@ +execute <- function(size=300000L){ + a <- 5; class(a) <- "fred" + b <- 7; class(b) <- "mary" + + addzero <- function (x) UseMethod("addzero") + + addzero.fred <- function (x) c(x,0) + addzero.mary <- function (x) c(0,x) + addzero.default <- function (x) c(8,9) + + f <- function (n,a,b) { + for (i in 1:n) r <- list(addzero(a),addzero(b)) + r + } + + r1 <- f(size,a,b) + r2 <- f(size,2,TRUE) + + list(r1, r2) +} \ No newline at end of file diff --git a/Benchmarks/tst/class/S3/S3_num.R b/Benchmarks/tst/class/S3/S3_num.R new file mode 100644 index 00000000..f7a1bbc4 --- /dev/null +++ b/Benchmarks/tst/class/S3/S3_num.R @@ -0,0 +1,6 @@ +execute <- function(size=1000000L){ + a <- 5; class(a) <- "fred" + + for (i in 1:size) r <- a+1 + return(r) +} \ No newline at end of file diff --git a/Benchmarks/tst/class/S3/S3_seq.R b/Benchmarks/tst/class/S3/S3_seq.R new file mode 100644 index 00000000..16b2b5a5 --- /dev/null +++ b/Benchmarks/tst/class/S3/S3_seq.R @@ -0,0 +1,8 @@ +execute <- function(size=500000L){ + a <- 5; class(a) <- "fred" + + seq.fred <- function (x,y) c(x,0,y) + + for (i in 1:size) r <- seq(a,9) + return(r) +} \ No newline at end of file diff --git a/Benchmarks/tst/class/S4/S4_fiddle.R b/Benchmarks/tst/class/S4/S4_fiddle.R new file mode 100644 index 00000000..e4c3e5c6 --- /dev/null +++ b/Benchmarks/tst/class/S4/S4_fiddle.R @@ -0,0 +1,24 @@ +fiddle <- function (x) standardGeneric("fiddle") + +execute <- function(size=10000L){ + setClass ("bert",representation(x="integer",a="complex"), + prototype(x=c(30L,1:999),a=0+0i)) + setClass ("gwen",representation(x="integer",a="complex"), + prototype(x=c(30L,40L),a=0+0i)) + + setMethod ("fiddle", "bert", function(x) new("gwen",a=x@a+1)) + setMethod ("fiddle", "gwen", function(x) new("bert",a=x@a-1i)) + + z <- new("bert") + z@a <- 2+5i + + w <- new("gwen") + w@a <- 2+5i + + f <- function (n,q) {for (i in 1:n) q <- fiddle(q); q} + + r1 <- f(size,z) + r2 <- f(size,w) + + list(r1,r2) +} \ No newline at end of file diff --git a/Benchmarks/tst/class/S4/S4_fiddle2.R b/Benchmarks/tst/class/S4/S4_fiddle2.R new file mode 100644 index 00000000..4736337c --- /dev/null +++ b/Benchmarks/tst/class/S4/S4_fiddle2.R @@ -0,0 +1,26 @@ +fiddle2 <- function (x) standardGeneric("fiddle2") + +execute <- function(size=1000L){ + setClass ("bert",representation(x="integer",a="complex"), + prototype(x=c(30L,1:999),a=0+0i)) + setClass ("gwen",representation(x="integer",a="complex"), + prototype(x=c(30L,40L),a=0+0i)) + + setMethod ("fiddle2", "bert", + function(x) { for (i in 1:100) x@a <- x@a-7; x@a }) + setMethod ("fiddle2", "gwen", + function(x) { for (i in 1:100) x@x[2] <- x@x[2]+7L; x@x }) + + z <- new("bert") + z@a <- 2+5i + + w <- new("gwen") + w@a <- 2+5i + + f <- function (n,x) { for (i in 1:n) r <- fiddle2(x); r } + + r1 <- f((size*3),z) + r2 <- f(size,w) + + list(r1,sum(r2)) +} \ No newline at end of file diff --git a/Benchmarks/tst/class/S4/S4_imsqrt.R b/Benchmarks/tst/class/S4/S4_imsqrt.R new file mode 100644 index 00000000..e16db2c2 --- /dev/null +++ b/Benchmarks/tst/class/S4/S4_imsqrt.R @@ -0,0 +1,20 @@ +imsqrt <- function (x) standardGeneric("imsqrt") + +execute <- function(size=100000L){ + setClass ("bert",representation(x="integer",a="complex"), + prototype(x=c(30L,1:999),a=0+0i)) + setClass ("gwen",representation(x="integer",a="complex"), + prototype(x=c(30L,40L),a=0+0i)) + + setMethod ("imsqrt", "bert", function(x) sqrt(Im(x@a))) + setMethod ("imsqrt", "gwen", function(x) sqrt(Re(x@a)+Im(x@a))) + + z <- new("bert") + z@a <- 2+5i + + w <- new("gwen") + w@a <- 2+5i + + for (i in 1:size) r <- 100*imsqrt(w) + imsqrt(z); + return(r) +} \ No newline at end of file diff --git a/Benchmarks/tst/class/S4/S4_sqrt.R b/Benchmarks/tst/class/S4/S4_sqrt.R new file mode 100644 index 00000000..23fbd834 --- /dev/null +++ b/Benchmarks/tst/class/S4/S4_sqrt.R @@ -0,0 +1,11 @@ +execute <- function(size=2000000L){ + setClass ("bert",representation(x="integer",a="complex"), + prototype(x=c(30L,1:999),a=0+0i)) + setMethod ("sqrt", "bert", function(x) sqrt(Re(x@a))) + + z <- new("bert") + z@a <- 2+5i + + for (i in 1:size) r <- sqrt(z); + return(r) +} \ No newline at end of file diff --git a/Benchmarks/tst/class/unclass/unclass_add.R b/Benchmarks/tst/class/unclass/unclass_add.R new file mode 100644 index 00000000..87f0b9df --- /dev/null +++ b/Benchmarks/tst/class/unclass/unclass_add.R @@ -0,0 +1,26 @@ +execute <- function(size=5000L){ + `+.mod12` <- function (x,y) { + s <- (unclass(x) + unclass(y)) %% 12L + class(s) <- "mod12" + s + } + + f <- function (n,a,b) { + for (i in 1:n) r <- (a+b) + r + } + + a <- 6L; class(a) <- "mod12" + b <- 8L; class(b) <- "mod12" + r1 <- f((size*100),a,b) + + a <- rep(6L,200); class(a) <- "mod12" + b <- rep(8L,200); class(b) <- "mod12" + r2 <- f((size*100),a,b) + + a <- rep(6L,100000); class(a) <- "mod12" + b <- rep(8L,100000); class(b) <- "mod12" + r3 <- f(size,a,b) + + list(r1, r2, sum(r3)) +} \ No newline at end of file diff --git a/Benchmarks/tst/class/unclass/unclass_subset.R b/Benchmarks/tst/class/unclass/unclass_subset.R new file mode 100644 index 00000000..7fd75f93 --- /dev/null +++ b/Benchmarks/tst/class/unclass/unclass_subset.R @@ -0,0 +1,10 @@ +execute <- function(size=100000L){ + a <- rep(6L,100000); class(a) <- "mod12" + + `[.mod12` <- function (x,i) unclass(x)[i] %% 12L + + # Original function with arg i set to 3000 in test, seemingly unused: + # g <- function (n,a,i){for (i in 1:n) r <- a[i]; r} + for (i in 1:size) r <- a[i] + return(r) +} \ No newline at end of file diff --git a/Benchmarks/tst/complex-expr/complex-expr_intops.R b/Benchmarks/tst/complex-expr/complex-expr_intops.R new file mode 100644 index 00000000..2a480d57 --- /dev/null +++ b/Benchmarks/tst/complex-expr/complex-expr_intops.R @@ -0,0 +1,13 @@ +execute <- function(size=100000L){ + u <- 1:100 + v <- 101:200 + w <- 1001:1100 + + g <- function (n,a,b,c){ + for (i in 1:n) r <- a + ((- b + 3L*a - c + 30000L) %/% (a+100L)) %% 5L + r + } + r1 <- g((size*10),300L,500L,700L) + r2 <- g(size,u,v,w) + list(r1, sum(r2)) +} \ No newline at end of file diff --git a/Benchmarks/tst/complex-expr/complex-expr_trig.R b/Benchmarks/tst/complex-expr/complex-expr_trig.R new file mode 100644 index 00000000..613b4987 --- /dev/null +++ b/Benchmarks/tst/complex-expr/complex-expr_trig.R @@ -0,0 +1,12 @@ +execute <- function(size=10000L){ + u <- seq(1,2,length=2000) + v <- seq(2,3,length=2000) + + f <- function (n,a,b){ + for (i in 1:n) r <- exp(sin(1-abs(a*b)+5*b) / (1+cos(a+b+1/b+1)) - 1) + r + } + r1 <- f((size*100),1.1,2.2) + r2 <- f(size,u,v) + list(r1, sum(r2)) +} \ No newline at end of file diff --git a/Benchmarks/tst/cum/cum_complex.R b/Benchmarks/tst/cum/cum_complex.R new file mode 100644 index 00000000..28cb49d3 --- /dev/null +++ b/Benchmarks/tst/cum/cum_complex.R @@ -0,0 +1,9 @@ +execute <- function(size=1000000L){ + n <- 100 + a <- c(1:n,n:1) + 0.1i + + for (i in 1:size) b1 <- cumsum(a) + for (i in 1:size) b2 <- cumprod(a) + + list(b1,b2) +} \ No newline at end of file diff --git a/Benchmarks/tst/cum/cum_double.R b/Benchmarks/tst/cum/cum_double.R new file mode 100644 index 00000000..10907538 --- /dev/null +++ b/Benchmarks/tst/cum/cum_double.R @@ -0,0 +1,16 @@ +execute <- function(size=100000L){ + n <- 400 + a <- c(1:n,n:1) + 0.1 + + for (i in 1:(size*10)) b1 <- cumsum(a) + for (i in 1:size) b2 <- cumprod(a) + for (i in 1:(size*10)) b3 <- cummax(a) + for (i in 1:(size*10)) b4 <- cummin(a) + + a[300] <- 0/0 + a[500] <- NA + + for (i in 1:(size*5)) b5 <- cumsum(a) + + list(b1,b2,b3,b4,b5) +} \ No newline at end of file diff --git a/Benchmarks/tst/cum/cum_int.R b/Benchmarks/tst/cum/cum_int.R new file mode 100644 index 00000000..349f94a4 --- /dev/null +++ b/Benchmarks/tst/cum/cum_int.R @@ -0,0 +1,14 @@ +execute <- function(size=1000000L){ + n <- 900 + a <- c(1:n,n:1) + + for (i in 1:size) b1 <- cumsum(a) + for (i in 1:size) b2 <- cummax(a) + for (i in 1:size) b3 <- cummin(a) + + a[300] <- NA + + for (i in 1:size) b4 <- cumsum(a) + + list(b1,b2,b3,b4) +} \ No newline at end of file diff --git a/Benchmarks/tst/dollar/dollar_exact-name.R b/Benchmarks/tst/dollar/dollar_exact-name.R new file mode 100644 index 00000000..67cb8a1e --- /dev/null +++ b/Benchmarks/tst/dollar/dollar_exact-name.R @@ -0,0 +1,17 @@ +execute <- function(size=1000000L){ + vl <- list (dd=1.4, cc=1.3, bb=1.2, aa=1.1) + + pl <- pairlist (dd=1.4, cc=1.3, bb=1.2, aa=1.1) + + ev <- new.env(parent=emptyenv()) + ev$aa <- 1.1 + ev$bb <- 1.2 + ev$cc <- 1.3 + ev$dd <- 1.4 + + for (i in 1:size) s1 <- vl$aa+vl$bb+vl$cc+vl$dd + for (i in 1:size) s2 <- pl$aa+pl$bb+pl$cc+pl$dd + for (i in 1:size) s3 <- ev$aa+ev$bb+ev$cc+ev$dd + + list(s1,s2,s3) +} \ No newline at end of file diff --git a/Benchmarks/tst/dollar/dollar_exact-string.R b/Benchmarks/tst/dollar/dollar_exact-string.R new file mode 100644 index 00000000..6a8b357d --- /dev/null +++ b/Benchmarks/tst/dollar/dollar_exact-string.R @@ -0,0 +1,17 @@ +execute <- function(size=1000000L){ + vl <- list (dd=1.4, cc=1.3, bb=1.2, aa=1.1) + + pl <- pairlist (dd=1.4, cc=1.3, bb=1.2, aa=1.1) + + ev <- new.env(parent=emptyenv()) + ev$aa <- 1.1 + ev$bb <- 1.2 + ev$cc <- 1.3 + ev$dd <- 1.4 + + for (i in 1:size) s1 <- vl$"aa"+vl$"bb"+vl$"cc"+vl$"dd" + for (i in 1:size) s2 <- pl$"aa"+pl$"bb"+pl$"cc"+pl$"dd" + for (i in 1:size) s3 <- ev$"aa"+ev$"bb"+ev$"cc"+ev$"dd" + + list(s1,s2,s3) +} \ No newline at end of file diff --git a/Benchmarks/tst/dollar/dollar_partial-name.R b/Benchmarks/tst/dollar/dollar_partial-name.R new file mode 100644 index 00000000..24a03035 --- /dev/null +++ b/Benchmarks/tst/dollar/dollar_partial-name.R @@ -0,0 +1,16 @@ +execute <- function(size=1000000L){ + vl <- list (dd=1.4, cc=1.3, bb=1.2, aa=1.1) + + pl <- pairlist (dd=1.4, cc=1.3, bb=1.2, aa=1.1) + + ev <- new.env(parent=emptyenv()) + ev$aa <- 1.1 + ev$bb <- 1.2 + ev$cc <- 1.3 + ev$dd <- 1.4 + + for (i in 1:size) s1 <- vl$a+vl$b+vl$c+vl$d + for (i in 1:size) s2 <- pl$a+pl$b+pl$c+pl$d + + list(s1,s2) +} \ No newline at end of file diff --git a/Benchmarks/tst/dollar/dollar_partial-string.R b/Benchmarks/tst/dollar/dollar_partial-string.R new file mode 100644 index 00000000..61f56a89 --- /dev/null +++ b/Benchmarks/tst/dollar/dollar_partial-string.R @@ -0,0 +1,16 @@ +execute <- function(size=1000000L){ + vl <- list (dd=1.4, cc=1.3, bb=1.2, aa=1.1) + + pl <- pairlist (dd=1.4, cc=1.3, bb=1.2, aa=1.1) + + ev <- new.env(parent=emptyenv()) + ev$aa <- 1.1 + ev$bb <- 1.2 + ev$cc <- 1.3 + ev$dd <- 1.4 + + for (i in 1:size) s1 <- vl$"a"+vl$"b"+vl$"c"+vl$"d" + for (i in 1:size) s2 <- pl$"a"+pl$"b"+pl$"c"+pl$"d" + + list(s1,s2) +} \ No newline at end of file diff --git a/Benchmarks/tst/for.R b/Benchmarks/tst/for.R new file mode 100644 index 00000000..c776ff50 --- /dev/null +++ b/Benchmarks/tst/for.R @@ -0,0 +1,37 @@ +execute <- function(size=10L){ + a1 <- 0; n <- (size*200) + for (j in 1:n) for (i in 1:n) a1 <- a1+i/j + + a2 <- 0; n <- (size*15) + for (k in 1:n) for (j in 1:n) for (i in 1:n) a2 <- a2+k*i/j + + a3 <- 0; n <- (size*4) + for (l in 1:n) for (k in 1:n) for (j in 1:n) for (i in 1:n) a3 <- a3+l*k*i/j + + a4 <- 0; n <- (size*200) + for (j in seq_len(n)) for (i in seq_len(n)) a4 <- a4+i/j + + f <- function (n) {for (l in 1:n) for (k in 1:n) for (j in 1:n) for (i in 1:n) i} + a5 <- f(size*7) + + v1n <- 1:(size*7) + g <- function () {for (l in v1n) for (k in v1n) for (j in v1n) for (i in v1n) i} + a6 <- g() + + h <- function(){ + v1 <- 1:70; + for (l in v1) + { v2 <- 1:70 + for (k in v2) + { v3 <- 1:70 + for (j in v3) + { v4 <- 1:70 + for (i in v4) i + } + } + } + } + a7 <- h() + + list(a1,a2,a3,a4,a5,a6,a7) +} \ No newline at end of file From 110cd1f40233fc5c5e367b906585f7bf7f484d4c Mon Sep 17 00:00:00 2001 From: Filip Krikava Date: Tue, 23 Sep 2025 13:20:25 +0000 Subject: [PATCH 2/9] Enable kernel-PCA benchmark --- Benchmarks/prg/kernel-PCA.R | 98 ++++++++++++++++++------------------- 1 file changed, 49 insertions(+), 49 deletions(-) diff --git a/Benchmarks/prg/kernel-PCA.R b/Benchmarks/prg/kernel-PCA.R index 850abbf8..1914bacc 100644 --- a/Benchmarks/prg/kernel-PCA.R +++ b/Benchmarks/prg/kernel-PCA.R @@ -1,49 +1,49 @@ -# execute <- function(size = 100L) { -# kpca <- function(Xtrn, Xtst, rho, m) { -# n <- nrow(Xtrn) -# -# K <- matrix(NA, n, n) -# for (i in 1:n) { -# for (j in i:n) { -# K[i,j] <- K[j,i] <- exp(-rho^2*sum((Xtrn[i,]-Xtrn[j,])^2)) -# } -# } -# -# M <- diag(n) - matrix(1/n, n, n) -# e <- eigen(M %*% K %*% M, symmetric=TRUE) -# -# prj <- matrix(NA, nrow(Xtst), m) -# Ks <- colSums(K)/n -# for (t in 1:nrow(Xtst)) { -# k <- rep(NA, n) -# for (i in 1:n) {k[i] <- exp(-rho^2*sum((Xtrn[i,]-Xtst[t,])^2))} -# for (w in 1:m) {prj[t,w] <- (k - Ks) %*% M %*% e$vectors[,w] / sqrt(e$values[w])} -# } -# prj -# } -# -# set.seed(1) -# X <- matrix(NA, size, 2) -# class <- rep(NA,size) -# -# for (i in 1:(size)) { -# theta <- runif(1,0,2*pi) -# r <- runif(1,1,1.75) -# X[i,1] <- r*cos(theta) -# X[i,2] <- 1.1*r*sin(theta) -# -# class[i] <- as.numeric(runif(1)<0.5) -# if (class[i]) -# { X[i,1] <- 0.8*X[i,1]+0.1 -# X[i,2] <- 0.7*X[i,2]-0.2 -# } -# } -# -# class.trn <- class[1:size] -# class.tst <- class[(size+1):(size)] -# -# for (i in 1:25) {prj <- kpca(X, X, 1, 3)} -# res <- coef(glm(class~prj,family="binomial")) -# -# return(res) -# } +execute <- function(size = 100L) { + kpca <- function(Xtrn, Xtst, rho, m) { + n <- nrow(Xtrn) + + K <- matrix(NA, n, n) + for (i in 1:n) { + for (j in i:n) { + K[i,j] <- K[j,i] <- exp(-rho^2*sum((Xtrn[i,]-Xtrn[j,])^2)) + } + } + + M <- diag(n) - matrix(1/n, n, n) + e <- eigen(M %*% K %*% M, symmetric=TRUE) + + prj <- matrix(NA, nrow(Xtst), m) + Ks <- colSums(K)/n + for (t in 1:nrow(Xtst)) { + k <- rep(NA, n) + for (i in 1:n) {k[i] <- exp(-rho^2*sum((Xtrn[i,]-Xtst[t,])^2))} + for (w in 1:m) {prj[t,w] <- (k - Ks) %*% M %*% e$vectors[,w] / sqrt(e$values[w])} + } + prj + } + + set.seed(1) + X <- matrix(NA, size, 2) + class <- rep(NA,size) + + for (i in 1:(size)) { + theta <- runif(1,0,2*pi) + r <- runif(1,1,1.75) + X[i,1] <- r*cos(theta) + X[i,2] <- 1.1*r*sin(theta) + + class[i] <- as.numeric(runif(1)<0.5) + if (class[i]) + { X[i,1] <- 0.8*X[i,1]+0.1 + X[i,2] <- 0.7*X[i,2]-0.2 + } + } + + class.trn <- class[1:size] + class.tst <- class[(size+1):(size)] + + for (i in 1:25) {prj <- kpca(X, X, 1, 3)} + res <- coef(glm(class~prj,family="binomial")) + + return(res) +} From eac21bbe31e7c61139412f526feba487f675afc0 Mon Sep 17 00:00:00 2001 From: Filip Krikava Date: Tue, 23 Sep 2025 13:22:10 +0000 Subject: [PATCH 3/9] Enable S3_list benchmark --- Benchmarks/tst/class/S3/S3_list.R | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/Benchmarks/tst/class/S3/S3_list.R b/Benchmarks/tst/class/S3/S3_list.R index 77bb3a20..37944a62 100644 --- a/Benchmarks/tst/class/S3/S3_list.R +++ b/Benchmarks/tst/class/S3/S3_list.R @@ -1,6 +1,6 @@ -# execute <- function(size=1000000L){ -# s <- list(q=101); class(s) <- "bert" -# -# for (i in 1:size) r <- s$q -# return(r) -# } +execute <- function(size=1000000L){ + s <- list(q=101); class(s) <- "bert" + + for (i in 1:size) r <- s$q + return(r) +} From b5c3cbc11ac466b2ef6f4c6bf8ad639b6fda0239 Mon Sep 17 00:00:00 2001 From: Filip Krikava Date: Wed, 24 Sep 2025 10:22:18 +0000 Subject: [PATCH 4/9] Enable eigen_full benchmark --- Benchmarks/tst/base/eigen/eigen_full.R | 32 +++++++++++++------------- 1 file changed, 16 insertions(+), 16 deletions(-) diff --git a/Benchmarks/tst/base/eigen/eigen_full.R b/Benchmarks/tst/base/eigen/eigen_full.R index 8df0dbe9..fd129a8d 100644 --- a/Benchmarks/tst/base/eigen/eigen_full.R +++ b/Benchmarks/tst/base/eigen/eigen_full.R @@ -1,16 +1,16 @@ -# execute <- function(size=20L) { -# m <- matrix (seq(0,1,length=1200), 30, 30) -# m <- m+t(m) -# M <- matrix (seq(0,1,length=120000), 300, 300) -# M <- M+t(M) -# -# f <- function (m,n,k) { -# for (i in seq_len(n)) v <- eigen(m,symmetric=TRUE) -# v$values -# } -# -# a<-f(m,(size*500)) -# b<-f(M,size) -# -# list(a,b) -# } +execute <- function(size=20L) { + m <- matrix (seq(0,1,length=1200), 30, 30) + m <- m+t(m) + M <- matrix (seq(0,1,length=120000), 300, 300) + M <- M+t(M) + + f <- function (m,n,k) { + for (i in seq_len(n)) v <- eigen(m,symmetric=TRUE) + v$values + } + + a<-f(m,(size*500)) + b<-f(M,size) + + list(a,b) +} From ed2c9da75b6c95401cc51b68b6f4b76fbe97196d Mon Sep 17 00:00:00 2001 From: Filip Krikava Date: Wed, 24 Sep 2025 21:05:57 +0000 Subject: [PATCH 5/9] Fix data and base_dataframe benchmarks --- Benchmarks/tst/base/base_dataframe.R | 62 ++++++++++++++-------------- 1 file changed, 31 insertions(+), 31 deletions(-) diff --git a/Benchmarks/tst/base/base_dataframe.R b/Benchmarks/tst/base/base_dataframe.R index 318827cd..114e4635 100644 --- a/Benchmarks/tst/base/base_dataframe.R +++ b/Benchmarks/tst/base/base_dataframe.R @@ -1,31 +1,31 @@ -# execute <- function(size=1000L) { -# M <- matrix(c(1.2,1.3,1.4),1000,30,byrow=TRUE) -# -# f <- function (n,M) {for (i in 1:n) d <- as.data.frame(M); d} -# d<-f((size*5),M) -# -# g <- function (n,d) {for (i in 1:n) M <- as.matrix(d); M} -# M2<-g((size*3),d) -# -# r1 <- any(M2!=M) -# -# h <- function (n,d){ -# for (i in 1:n) { d[2,] <- 3.1; d[,3] <- 4.2; d[3,2] <- 5.5 } -# d -# } -# d2<-h(size,d) -# -# M2[2,] <- 3.1 -# M2[,3] <- 4.2 -# M2[3,2] <- 5.5 -# -# r2 <- any(M2!=as.matrix(d2)) -# -# e <- function (n,d) { -# for (i in 1:n) r <- d$V2 * d[,2] * (1:nrow(d)); r } -# w<-e((size*10),d) -# -# r3 <- sum(w) -# -# list(r1,r2,r3) -# } +execute <- function(size=1000L) { + M <- matrix(c(1.2,1.3,1.4),1000,30,byrow=TRUE) + + f <- function (n,M) {for (i in 1:n) d <- as.data.frame(M); d} + d<-f((size*5),M) + + g <- function (n,d) {for (i in 1:n) M <- as.matrix(d); M} + M2<-g((size*3),d) + + r1 <- any(M2!=M) + + h <- function (n,d){ + for (i in 1:n) { d[2,] <- 3.1; d[,3] <- 4.2; d[3,2] <- 5.5 } + d + } + d2<-h(size,d) + + M2[2,] <- 3.1 + M2[,3] <- 4.2 + M2[3,2] <- 5.5 + + r2 <- any(M2!=as.matrix(d2)) + + e <- function (n,d) { + for (i in 1:n) r <- d$V2 * d[,2] * (1:nrow(d)); r } + w<-e((size*10),d) + + r3 <- sum(w) + + list(r1,r2,r3) +} From 1d60a00fe12f1ee17759d1cc24b7527ccfabbfa8 Mon Sep 17 00:00:00 2001 From: Filip Krikava Date: Thu, 25 Sep 2025 14:44:29 +0000 Subject: [PATCH 6/9] Fix complicated_matrix benchmark --- Benchmarks/tst/assign/complicated/complicated_matrix.R | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/Benchmarks/tst/assign/complicated/complicated_matrix.R b/Benchmarks/tst/assign/complicated/complicated_matrix.R index a7a584e2..c09d50db 100644 --- a/Benchmarks/tst/assign/complicated/complicated_matrix.R +++ b/Benchmarks/tst/assign/complicated/complicated_matrix.R @@ -1,5 +1,5 @@ -# execute <- function(size = 60000L) { -# lis <- list(a=1, b=matrix(4,2,2), c=10) -# for (i in 1:size) diag(lis$b)[2] <- 5 -# unlist(lis) -# } +execute <- function(size = 60000L) { + lis <- list(a=1, b=matrix(4,2,2), c=10) + for (i in 1:size) diag(lis$b)[2] <- 5 + unlist(lis) +} From a009f65635873646df7afd9ade093ba4dddd185f Mon Sep 17 00:00:00 2001 From: Matej Kocourek Date: Fri, 26 Jun 2026 11:43:12 +0200 Subject: [PATCH 7/9] Wire in SpeedTest suite --- Benchmarks/prg/harness.r | 56 +++++++++++ Benchmarks/tst/harness.r | 56 +++++++++++ rebench.conf | 210 +++++++++++++++++++++++++++++++++++++++ 3 files changed, 322 insertions(+) create mode 100644 Benchmarks/prg/harness.r create mode 100644 Benchmarks/tst/harness.r diff --git a/Benchmarks/prg/harness.r b/Benchmarks/prg/harness.r new file mode 100644 index 00000000..33815363 --- /dev/null +++ b/Benchmarks/prg/harness.r @@ -0,0 +1,56 @@ +# Harness for the SpeedTest benchmark suite. +# +# Each benchmark is a single .R file that defines +# execute <- function( = ) { ... } +# Benchmarks are run with their default arguments, so the harness only needs +# the benchmark name and the number of iterations to measure. +# +# Output follows the format expected by ReBench's RebenchLog gauge adapter: +# : iterations=1 runtime: us + +findBenchmark <- function(name) { + files <- list.files(".", pattern = "\\.R$", recursive = TRUE, full.names = TRUE) + hits <- files[basename(files) == paste(name, ".R", sep = "")] + if (length(hits) == 0) + stop(paste("Benchmark file not found: ", name, ".R", sep = "")) + hits[[1]] +} + +doRuns <- function(name, iterations) { + total <- 0 + for (i in 1:iterations) { + startTime <- Sys.time() + invisible(execute()) + endTime <- Sys.time() + runTime <- (as.numeric(endTime) - as.numeric(startTime)) * 1000000 + + cat(name, ": iterations=1 runtime: ", round(runTime), "us\n", sep = "") + total <- total + runTime + } + total +} + +run <- function(args) { + if (length(args) < 1 || 2 < length(args)) + stop(printUsage()) + + name <- args[[1]] + numIterations <- if (length(args) > 1) strtoi(args[[2]]) else 1 + + source(findBenchmark(name)) + + total <- as.numeric(doRuns(name, numIterations)) + cat(name, ": ", + "iterations=", numIterations, "; ", + "average: ", round(total / numIterations), " us; ", + "total: ", round(total), "us\n\n", sep = "") +} + +printUsage <- function() { + cat("harness.r benchmark [num-iterations]\n") + cat("\n") + cat(" benchmark - benchmark name (file .R defining execute())\n") + cat(" num-iterations - number of times to execute benchmark, default: 1\n") +} + +run(commandArgs(trailingOnly = TRUE)) diff --git a/Benchmarks/tst/harness.r b/Benchmarks/tst/harness.r new file mode 100644 index 00000000..33815363 --- /dev/null +++ b/Benchmarks/tst/harness.r @@ -0,0 +1,56 @@ +# Harness for the SpeedTest benchmark suite. +# +# Each benchmark is a single .R file that defines +# execute <- function( = ) { ... } +# Benchmarks are run with their default arguments, so the harness only needs +# the benchmark name and the number of iterations to measure. +# +# Output follows the format expected by ReBench's RebenchLog gauge adapter: +# : iterations=1 runtime: us + +findBenchmark <- function(name) { + files <- list.files(".", pattern = "\\.R$", recursive = TRUE, full.names = TRUE) + hits <- files[basename(files) == paste(name, ".R", sep = "")] + if (length(hits) == 0) + stop(paste("Benchmark file not found: ", name, ".R", sep = "")) + hits[[1]] +} + +doRuns <- function(name, iterations) { + total <- 0 + for (i in 1:iterations) { + startTime <- Sys.time() + invisible(execute()) + endTime <- Sys.time() + runTime <- (as.numeric(endTime) - as.numeric(startTime)) * 1000000 + + cat(name, ": iterations=1 runtime: ", round(runTime), "us\n", sep = "") + total <- total + runTime + } + total +} + +run <- function(args) { + if (length(args) < 1 || 2 < length(args)) + stop(printUsage()) + + name <- args[[1]] + numIterations <- if (length(args) > 1) strtoi(args[[2]]) else 1 + + source(findBenchmark(name)) + + total <- as.numeric(doRuns(name, numIterations)) + cat(name, ": ", + "iterations=", numIterations, "; ", + "average: ", round(total / numIterations), " us; ", + "total: ", round(total), "us\n\n", sep = "") +} + +printUsage <- function() { + cat("harness.r benchmark [num-iterations]\n") + cat("\n") + cat(" benchmark - benchmark name (file .R defining execute())\n") + cat(" num-iterations - number of times to execute benchmark, default: 1\n") +} + +run(commandArgs(trailingOnly = TRUE)) diff --git a/rebench.conf b/rebench.conf index 9b86d616..5b74e37b 100644 --- a/rebench.conf +++ b/rebench.conf @@ -321,6 +321,210 @@ benchmark_suites: extra_args: 5 codespeed_name: "[RealThing] flexclust_no_s4" + speedtest_prg: + # SpeedTest "programs": each benchmark file defines execute() and is run + # with its default arguments by harness.r. + gauge_adapter: RebenchLog + location: "%%BENCHMARKS_PATH%%/prg" + command: *R_BENCH_COMMAND + max_invocation_time: 6000 + benchmarks: + - cholesky: + codespeed_name: "[prg] cholesky" + - cv-basisfun: + codespeed_name: "[prg] cv-basisfun" + - data: + codespeed_name: "[prg] data" + - em: + codespeed_name: "[prg] em" + - gcd: + codespeed_name: "[prg] gcd" + - gp: + codespeed_name: "[prg] gp" + - heat: + codespeed_name: "[prg] heat" + - hmc1: + codespeed_name: "[prg] hmc1" + - hmc2: + codespeed_name: "[prg] hmc2" + - kernel-PCA: + codespeed_name: "[prg] kernel-PCA" + - lm-nn: + codespeed_name: "[prg] lm-nn" + - matexp_large: + codespeed_name: "[prg] matexp_large" + - matexp_medium: + codespeed_name: "[prg] matexp_medium" + - matexp_small: + codespeed_name: "[prg] matexp_small" + - matmult_sumprd: + codespeed_name: "[prg] matmult_sumprd" + - matmult_triplp: + codespeed_name: "[prg] matmult_triplp" + - mlp: + codespeed_name: "[prg] mlp" + - near_large: + codespeed_name: "[prg] near_large" + - near_small: + codespeed_name: "[prg] near_small" + - primes: + codespeed_name: "[prg] primes" + - Qlearn: + codespeed_name: "[prg] Qlearn" + - sieve1: + codespeed_name: "[prg] sieve1" + - sieve2: + codespeed_name: "[prg] sieve2" + - text_look: + codespeed_name: "[prg] text_look" + - text_replace: + codespeed_name: "[prg] text_replace" + + speedtest_tst: + # SpeedTest micro-benchmarks: each benchmark file defines execute() and + # is run with its default arguments by harness.r. + gauge_adapter: RebenchLog + location: "%%BENCHMARKS_PATH%%/tst" + command: *R_BENCH_COMMAND + max_invocation_time: 6000 + benchmarks: + - alloc1: + codespeed_name: "[tst] alloc1" + - alloc2: + codespeed_name: "[tst] alloc2" + - alloc3: + codespeed_name: "[tst] alloc3" + - alloc4: + codespeed_name: "[tst] alloc4" + - any-all_all: + codespeed_name: "[tst] any-all_all" + - any-all_any: + codespeed_name: "[tst] any-all_any" + - any-all_relop: + codespeed_name: "[tst] any-all_relop" + - apply1: + codespeed_name: "[tst] apply1" + - apply2: + codespeed_name: "[tst] apply2" + - assign_largevec: + codespeed_name: "[tst] assign_largevec" + - assign_simple: + codespeed_name: "[tst] assign_simple" + - attr_change1: + codespeed_name: "[tst] attr_change1" + - attr_change2: + codespeed_name: "[tst] attr_change2" + - attr_get1: + codespeed_name: "[tst] attr_get1" + - attr_get2: + codespeed_name: "[tst] attr_get2" + - attr_set1: + codespeed_name: "[tst] attr_set1" + - attr_set2: + codespeed_name: "[tst] attr_set2" + - base_array: + codespeed_name: "[tst] base_array" + - base_dataframe: + codespeed_name: "[tst] base_dataframe" + - base_diag: + codespeed_name: "[tst] base_diag" + - base_ifelse: + codespeed_name: "[tst] base_ifelse" + - base_matrix: + codespeed_name: "[tst] base_matrix" + - bind_unlist: + codespeed_name: "[tst] bind_unlist" + - cbind: + codespeed_name: "[tst] cbind" + - complex-expr_intops: + codespeed_name: "[tst] complex-expr_intops" + - complex-expr_trig: + codespeed_name: "[tst] complex-expr_trig" + - complicated_dollar: + codespeed_name: "[tst] complicated_dollar" + - complicated_doublebracket: + codespeed_name: "[tst] complicated_doublebracket" + - complicated_matrix: + codespeed_name: "[tst] complicated_matrix" + - complicated_nested: + codespeed_name: "[tst] complicated_nested" + - concatenate_mixed: + codespeed_name: "[tst] concatenate_mixed" + - concatenate_str: + codespeed_name: "[tst] concatenate_str" + - concatenate_vec: + codespeed_name: "[tst] concatenate_vec" + - cum_complex: + codespeed_name: "[tst] cum_complex" + - cum_double: + codespeed_name: "[tst] cum_double" + - cum_int: + codespeed_name: "[tst] cum_int" + - dollar_exact-name: + codespeed_name: "[tst] dollar_exact-name" + - dollar_exact-string: + codespeed_name: "[tst] dollar_exact-string" + - dollar_partial-name: + codespeed_name: "[tst] dollar_partial-name" + - dollar_partial-string: + codespeed_name: "[tst] dollar_partial-string" + - eapply: + codespeed_name: "[tst] eapply" + - eigen_full: + codespeed_name: "[tst] eigen_full" + - eigen_onlyval: + codespeed_name: "[tst] eigen_onlyval" + - for: + codespeed_name: "[tst] for" + - lapply: + codespeed_name: "[tst] lapply" + - list_bracket: + codespeed_name: "[tst] list_bracket" + - list_dollar: + codespeed_name: "[tst] list_dollar" + - list_doublebracket: + codespeed_name: "[tst] list_doublebracket" + - named_scalar: + codespeed_name: "[tst] named_scalar" + - named_vector: + codespeed_name: "[tst] named_vector" + - rbind: + codespeed_name: "[tst] rbind" + - S3_class: + codespeed_name: "[tst] S3_class" + - S3_list: + codespeed_name: "[tst] S3_list" + - S3_noclass: + codespeed_name: "[tst] S3_noclass" + - S3_num: + codespeed_name: "[tst] S3_num" + - S3_seq: + codespeed_name: "[tst] S3_seq" + - S4_fiddle: + codespeed_name: "[tst] S4_fiddle" + - S4_fiddle2: + codespeed_name: "[tst] S4_fiddle2" + - S4_imsqrt: + codespeed_name: "[tst] S4_imsqrt" + - S4_sqrt: + codespeed_name: "[tst] S4_sqrt" + - svd_full: + codespeed_name: "[tst] svd_full" + - svd_onlyval: + codespeed_name: "[tst] svd_onlyval" + - unclass_add: + codespeed_name: "[tst] unclass_add" + - unclass_subset: + codespeed_name: "[tst] unclass_subset" + - vapply: + codespeed_name: "[tst] vapply" + - vecmat_matrix: + codespeed_name: "[tst] vecmat_matrix" + - vecmat_named: + codespeed_name: "[tst] vecmat_named" + - vecmat_numeric: + codespeed_name: "[tst] vecmat_numeric" + # VMs have a name and are specified by a path and the binary to be executed executors: @@ -343,6 +547,8 @@ experiments: - simple_reduced - simple_extra - real_thing + - speedtest_prg + - speedtest_tst - GNU-R: suites: - are-we-fast-r @@ -350,9 +556,13 @@ experiments: - simple_reduced - simple_extra - real_thing + - speedtest_prg + - speedtest_tst - FASTR: suites: - are-we-fast-r - shootout - simple_reduced - real_thing + - speedtest_prg + - speedtest_tst From 409280ed0b289d0aa77917c9c3508f665a5fa21e Mon Sep 17 00:00:00 2001 From: Sebastian Krynski Date: Tue, 30 Jun 2026 13:54:07 +0000 Subject: [PATCH 8/9] add extra_args from R files --- rebench.conf | 93 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 93 insertions(+) diff --git a/rebench.conf b/rebench.conf index 5b74e37b..17cf9f09 100644 --- a/rebench.conf +++ b/rebench.conf @@ -331,54 +331,79 @@ benchmark_suites: benchmarks: - cholesky: codespeed_name: "[prg] cholesky" + extra_args: 200 - cv-basisfun: codespeed_name: "[prg] cv-basisfun" + extra_args: 10 - data: codespeed_name: "[prg] data" + extra_args: 10 - em: codespeed_name: "[prg] em" + extra_args: 10 - gcd: codespeed_name: "[prg] gcd" + extra_args: 500 - gp: codespeed_name: "[prg] gp" + extra_args: 1 - heat: codespeed_name: "[prg] heat" + extra_args: 10 - hmc1: codespeed_name: "[prg] hmc1" + extra_args: 50000 - hmc2: codespeed_name: "[prg] hmc2" + extra_args: 25000 - kernel-PCA: codespeed_name: "[prg] kernel-PCA" + extra_args: 100 - lm-nn: codespeed_name: "[prg] lm-nn" + extra_args: 25 - matexp_large: codespeed_name: "[prg] matexp_large" + extra_args: 20 - matexp_medium: codespeed_name: "[prg] matexp_medium" + extra_args: 30 - matexp_small: codespeed_name: "[prg] matexp_small" + extra_args: 10 - matmult_sumprd: codespeed_name: "[prg] matmult_sumprd" + extra_args: 2000 - matmult_triplp: codespeed_name: "[prg] matmult_triplp" + extra_args: 50 - mlp: codespeed_name: "[prg] mlp" + extra_args: 200 - near_large: codespeed_name: "[prg] near_large" + extra_args: 1000 - near_small: codespeed_name: "[prg] near_small" + extra_args: 20 - primes: codespeed_name: "[prg] primes" + extra_args: 16 - Qlearn: codespeed_name: "[prg] Qlearn" + extra_args: 30000 - sieve1: codespeed_name: "[prg] sieve1" + extra_args: 1000 - sieve2: codespeed_name: "[prg] sieve2" + extra_args: 1000 - text_look: codespeed_name: "[prg] text_look" + extra_args: 50000 - text_replace: codespeed_name: "[prg] text_replace" + extra_args: 1000 speedtest_tst: # SpeedTest micro-benchmarks: each benchmark file defines execute() and @@ -390,140 +415,208 @@ benchmark_suites: benchmarks: - alloc1: codespeed_name: "[tst] alloc1" + extra_args: 30000 - alloc2: codespeed_name: "[tst] alloc2" + extra_args: 8 - alloc3: codespeed_name: "[tst] alloc3" + extra_args: 128 - alloc4: codespeed_name: "[tst] alloc4" + extra_args: 10000 - any-all_all: codespeed_name: "[tst] any-all_all" + extra_args: 500000 - any-all_any: codespeed_name: "[tst] any-all_any" + extra_args: 500000 - any-all_relop: codespeed_name: "[tst] any-all_relop" + extra_args: 100000 - apply1: codespeed_name: "[tst] apply1" + extra_args: 1000 - apply2: codespeed_name: "[tst] apply2" + extra_args: 1000 - assign_largevec: codespeed_name: "[tst] assign_largevec" + extra_args: 30000 - assign_simple: codespeed_name: "[tst] assign_simple" + extra_args: 1000000 - attr_change1: codespeed_name: "[tst] attr_change1" + extra_args: 1000 - attr_change2: codespeed_name: "[tst] attr_change2" + extra_args: 1000 - attr_get1: codespeed_name: "[tst] attr_get1" + extra_args: 2000000 - attr_get2: codespeed_name: "[tst] attr_get2" + extra_args: 2000000 - attr_set1: codespeed_name: "[tst] attr_set1" + extra_args: 1000000 - attr_set2: codespeed_name: "[tst] attr_set2" + extra_args: 1000000 - base_array: codespeed_name: "[tst] base_array" + extra_args: 500000 - base_dataframe: codespeed_name: "[tst] base_dataframe" + extra_args: 1000 - base_diag: codespeed_name: "[tst] base_diag" + extra_args: 10000 - base_ifelse: codespeed_name: "[tst] base_ifelse" + extra_args: 50000 - base_matrix: codespeed_name: "[tst] base_matrix" + extra_args: 5000 - bind_unlist: codespeed_name: "[tst] bind_unlist" + extra_args: 10000 - cbind: codespeed_name: "[tst] cbind" + extra_args: 10000 - complex-expr_intops: codespeed_name: "[tst] complex-expr_intops" + extra_args: 100000 - complex-expr_trig: codespeed_name: "[tst] complex-expr_trig" + extra_args: 10000 - complicated_dollar: codespeed_name: "[tst] complicated_dollar" + extra_args: 500000 - complicated_doublebracket: codespeed_name: "[tst] complicated_doublebracket" + extra_args: 500000 - complicated_matrix: codespeed_name: "[tst] complicated_matrix" + extra_args: 60000 - complicated_nested: codespeed_name: "[tst] complicated_nested" + extra_args: 500000 - concatenate_mixed: codespeed_name: "[tst] concatenate_mixed" + extra_args: 10000 - concatenate_str: codespeed_name: "[tst] concatenate_str" + extra_args: 600000 - concatenate_vec: codespeed_name: "[tst] concatenate_vec" + extra_args: 1000000 - cum_complex: codespeed_name: "[tst] cum_complex" + extra_args: 1000000 - cum_double: codespeed_name: "[tst] cum_double" + extra_args: 100000 - cum_int: codespeed_name: "[tst] cum_int" + extra_args: 1000000 - dollar_exact-name: codespeed_name: "[tst] dollar_exact-name" + extra_args: 1000000 - dollar_exact-string: codespeed_name: "[tst] dollar_exact-string" + extra_args: 1000000 - dollar_partial-name: codespeed_name: "[tst] dollar_partial-name" + extra_args: 1000000 - dollar_partial-string: codespeed_name: "[tst] dollar_partial-string" + extra_args: 1000000 - eapply: codespeed_name: "[tst] eapply" + extra_args: 10000 - eigen_full: codespeed_name: "[tst] eigen_full" + extra_args: 20 - eigen_onlyval: codespeed_name: "[tst] eigen_onlyval" + extra_args: 20 - for: codespeed_name: "[tst] for" + extra_args: 10 - lapply: codespeed_name: "[tst] lapply" + extra_args: 10000 - list_bracket: codespeed_name: "[tst] list_bracket" + extra_args: 1000000 - list_dollar: codespeed_name: "[tst] list_dollar" + extra_args: 1000000 - list_doublebracket: codespeed_name: "[tst] list_doublebracket" + extra_args: 1000000 - named_scalar: codespeed_name: "[tst] named_scalar" + extra_args: 500000 - named_vector: codespeed_name: "[tst] named_vector" + extra_args: 500000 - rbind: codespeed_name: "[tst] rbind" + extra_args: 10000 - S3_class: codespeed_name: "[tst] S3_class" + extra_args: 300000 - S3_list: codespeed_name: "[tst] S3_list" + extra_args: 1000000 - S3_noclass: codespeed_name: "[tst] S3_noclass" + extra_args: 300000 - S3_num: codespeed_name: "[tst] S3_num" + extra_args: 1000000 - S3_seq: codespeed_name: "[tst] S3_seq" + extra_args: 500000 - S4_fiddle: codespeed_name: "[tst] S4_fiddle" + extra_args: 10000 - S4_fiddle2: codespeed_name: "[tst] S4_fiddle2" + extra_args: 1000 - S4_imsqrt: codespeed_name: "[tst] S4_imsqrt" + extra_args: 100000 - S4_sqrt: codespeed_name: "[tst] S4_sqrt" + extra_args: 2000000 - svd_full: codespeed_name: "[tst] svd_full" + extra_args: 20 - svd_onlyval: codespeed_name: "[tst] svd_onlyval" + extra_args: 20 - unclass_add: codespeed_name: "[tst] unclass_add" + extra_args: 5000 - unclass_subset: codespeed_name: "[tst] unclass_subset" + extra_args: 100000 - vapply: codespeed_name: "[tst] vapply" + extra_args: 10000 - vecmat_matrix: codespeed_name: "[tst] vecmat_matrix" + extra_args: 1000000 - vecmat_named: codespeed_name: "[tst] vecmat_named" + extra_args: 1000000 - vecmat_numeric: codespeed_name: "[tst] vecmat_numeric" + extra_args: 1000000 # VMs have a name and are specified by a path and the binary to be executed From ecddb531a355a4574625ddd50684ded3242b7a07 Mon Sep 17 00:00:00 2001 From: Sebastian Krynski Date: Tue, 30 Jun 2026 21:45:42 +0000 Subject: [PATCH 9/9] benchmark paramter --- Benchmarks/prg/harness.r | 18 ++++++++++-------- Benchmarks/tst/harness.r | 18 ++++++++++-------- 2 files changed, 20 insertions(+), 16 deletions(-) diff --git a/Benchmarks/prg/harness.r b/Benchmarks/prg/harness.r index 33815363..a5502f10 100644 --- a/Benchmarks/prg/harness.r +++ b/Benchmarks/prg/harness.r @@ -16,11 +16,11 @@ findBenchmark <- function(name) { hits[[1]] } -doRuns <- function(name, iterations) { +doRuns <- function(name, iterations, benchmarkParameter) { total <- 0 for (i in 1:iterations) { startTime <- Sys.time() - invisible(execute()) + invisible(execute(benchmarkParameter)) endTime <- Sys.time() runTime <- (as.numeric(endTime) - as.numeric(startTime)) * 1000000 @@ -31,15 +31,16 @@ doRuns <- function(name, iterations) { } run <- function(args) { - if (length(args) < 1 || 2 < length(args)) + if (length(args) < 3 || 3 < length(args)) stop(printUsage()) name <- args[[1]] - numIterations <- if (length(args) > 1) strtoi(args[[2]]) else 1 + numIterations <- strtoi(args[[2]]) + benchmarkParameter <- strtoi(args[[3]]) source(findBenchmark(name)) - total <- as.numeric(doRuns(name, numIterations)) + total <- as.numeric(doRuns(name, numIterations, benchmarkParameter)) cat(name, ": ", "iterations=", numIterations, "; ", "average: ", round(total / numIterations), " us; ", @@ -47,10 +48,11 @@ run <- function(args) { } printUsage <- function() { - cat("harness.r benchmark [num-iterations]\n") + cat("harness.r benchmark num-iterations benchmark-parameter\n") cat("\n") - cat(" benchmark - benchmark name (file .R defining execute())\n") - cat(" num-iterations - number of times to execute benchmark, default: 1\n") + cat(" benchmark - benchmark name (file .R defining execute())\n") + cat(" num-iterations - number of times to execute benchmark\n") + cat(" benchmark-parameter - size parameter passed to execute()\n") } run(commandArgs(trailingOnly = TRUE)) diff --git a/Benchmarks/tst/harness.r b/Benchmarks/tst/harness.r index 33815363..a5502f10 100644 --- a/Benchmarks/tst/harness.r +++ b/Benchmarks/tst/harness.r @@ -16,11 +16,11 @@ findBenchmark <- function(name) { hits[[1]] } -doRuns <- function(name, iterations) { +doRuns <- function(name, iterations, benchmarkParameter) { total <- 0 for (i in 1:iterations) { startTime <- Sys.time() - invisible(execute()) + invisible(execute(benchmarkParameter)) endTime <- Sys.time() runTime <- (as.numeric(endTime) - as.numeric(startTime)) * 1000000 @@ -31,15 +31,16 @@ doRuns <- function(name, iterations) { } run <- function(args) { - if (length(args) < 1 || 2 < length(args)) + if (length(args) < 3 || 3 < length(args)) stop(printUsage()) name <- args[[1]] - numIterations <- if (length(args) > 1) strtoi(args[[2]]) else 1 + numIterations <- strtoi(args[[2]]) + benchmarkParameter <- strtoi(args[[3]]) source(findBenchmark(name)) - total <- as.numeric(doRuns(name, numIterations)) + total <- as.numeric(doRuns(name, numIterations, benchmarkParameter)) cat(name, ": ", "iterations=", numIterations, "; ", "average: ", round(total / numIterations), " us; ", @@ -47,10 +48,11 @@ run <- function(args) { } printUsage <- function() { - cat("harness.r benchmark [num-iterations]\n") + cat("harness.r benchmark num-iterations benchmark-parameter\n") cat("\n") - cat(" benchmark - benchmark name (file .R defining execute())\n") - cat(" num-iterations - number of times to execute benchmark, default: 1\n") + cat(" benchmark - benchmark name (file .R defining execute())\n") + cat(" num-iterations - number of times to execute benchmark\n") + cat(" benchmark-parameter - size parameter passed to execute()\n") } run(commandArgs(trailingOnly = TRUE))