├── .gitignore ├── FAQ.md ├── LICENSE ├── R-benchmark-25 ├── Makefile ├── Matrix_calculation │ ├── att1.R │ ├── att1_1.R │ ├── att1_2.R │ ├── att1_3.R │ ├── att1_4.R │ └── att1_5.R ├── Matrix_functions │ ├── att2.R │ ├── att2_1.R │ ├── att2_2.R │ ├── att2_3.R │ ├── att2_4.R │ └── att2_5.R ├── Programmation │ ├── att3.R │ ├── att3_1.R │ ├── att3_2.R │ ├── att3_3.R │ ├── att3_4.R │ └── att3_5.R ├── R-benchmark-25.R └── README.md ├── README.md ├── algorithm ├── ICA │ ├── ica.R │ ├── ica_lapply.R │ └── setup_ica.R ├── LR │ ├── LR-1var.R │ ├── LR-1var_lms_lapply.R │ ├── LR-1var_lms_vec.R │ ├── LR-1var_ols_lapply.R │ ├── LR.R │ ├── LR_lms_lapply.R │ ├── LR_ols_lapply.R │ ├── setup_LR-1var.R │ └── setup_LR.R ├── LogitRegression │ ├── LogitRegre-1var_lapply.R │ ├── LogitRegre2_lapply.R │ ├── LogitRegre_lapply.R │ ├── setup_logitRegre-1var.R │ └── setup_logitRegre.R ├── PCA │ ├── PCA_lapply.R │ └── setup_PCA.R ├── Pi │ ├── Pi_lapply.R │ └── setup_Pi.R ├── README.md ├── k-NN │ ├── NN.R │ ├── NN_lapply.R │ ├── k-NN.R │ ├── k-NN_lapply.R │ └── setup_k-NN.R └── k-means │ ├── k-means-1D.R │ ├── k-means-1D_lapply.R │ ├── k-means-1D_vec.R │ ├── k-means.R │ ├── k-means_lapply.R │ ├── k-means_vec.R │ ├── setup_k-means-1D.R │ └── setup_k-means.R ├── common.mk ├── docs ├── running_benchmark.md └── writting_benchmark.md ├── example ├── Makefile └── hello_rbenchmark.R ├── mathkernel ├── DoubleNAVecAdd-T1.R ├── DoubleNAVecAdd-T2.R ├── DoubleVecAdd-T1.R ├── DoubleVecAdd-T2.R ├── IntNAVecAdd-T1.R ├── IntNAVecAdd-T2.R ├── IntVecAdd-T1.R ├── IntVecAdd-T2.R ├── MMM-T1.R ├── MMM-T2.R ├── MMM-T3.R └── README.md ├── misc ├── 2DRandomWalk │ ├── rw2d1.R │ ├── rw2d2.R │ └── rw2d3.R └── README.md ├── riposte ├── Makefile ├── README.md ├── black_scholes.R ├── cleaning.R ├── example.R ├── filter1d.R ├── gen_kmeans.R ├── gen_lr.R ├── gen_pca.R ├── histogram.R ├── kmeans.R ├── lr.R ├── lr_test.R ├── mandelbrot.R ├── pca-blocked.R ├── pca.R ├── qr.R ├── raysphere.R ├── riposte.list ├── sample.R ├── sample_builtin.R ├── smv.R ├── smv_builtin.R └── tpc.R ├── scalar ├── ForLoopAdd │ ├── ForLoopAdd.R │ ├── ForLoopAdd.c │ ├── ForLoopAdd.java │ └── ForLoopAdd.python ├── README.md ├── crt │ ├── crt.R │ ├── crt.c │ └── crt.python ├── fib │ ├── fib.R │ ├── fib.c │ ├── fib.python │ ├── fib_rec.R │ ├── fib_rec.c │ └── fib_rec.python ├── gcd │ ├── gcd.R │ ├── gcd.c │ ├── gcd.python │ ├── gcd_rec.R │ ├── gcd_rec.c │ └── gcd_rec.python └── prime │ ├── prime.R │ ├── prime.c │ └── prime.python ├── shootout ├── README.md ├── binary-trees │ ├── Makefile │ ├── binary-trees.R │ ├── binary-trees.c │ ├── binary-trees.python │ ├── binary-trees_2.R │ ├── binary-trees_list.R │ └── binary-trees_native.R ├── fannkuch-redux │ ├── Makefile │ ├── fannkuch-redux.R │ ├── fannkuch-redux_2.R │ └── fannkuch-redux_native.R ├── fasta-redux │ ├── fastaredux-native.R │ └── fastaredux.R ├── fasta │ ├── Makefile │ ├── fasta-2.R │ ├── fasta-3.R │ ├── fasta-native.R │ ├── fasta-native2.R │ ├── fasta.R │ ├── fasta.c │ ├── fasta.f90 │ ├── fasta.java │ ├── fasta.python │ └── fasta_c.R ├── k-nucleotide │ ├── Makefile │ ├── k-nucleotide-brute.R │ ├── k-nucleotide-brute2.R │ ├── k-nucleotide-brute3.R │ ├── k-nucleotide.R │ ├── knucleotide-input1000.txt │ ├── knucleotide-input250000.txt │ └── knucleotide-input50000.txt ├── mandelbrot │ ├── Makefile │ ├── mandelbrot-ascii.R │ ├── mandelbrot-native-ascii.R │ ├── mandelbrot-native.R │ ├── mandelbrot-noout-native.R │ ├── mandelbrot-noout.R │ ├── mandelbrot.R │ ├── mandelbrot.c │ ├── mandelbrot.python │ └── mandelbrot1.R ├── meteor-contest │ ├── Makefile │ ├── meteor-contest.R │ ├── meteor-contest.c │ ├── meteor-contest.python │ └── meteor.python3-3.py ├── nbody │ ├── Makefile │ ├── nbody-1.R │ ├── nbody-2.R │ ├── nbody-3.R │ ├── nbody-native.R │ ├── nbody-native2.R │ ├── nbody-vectorized.R │ ├── nbody.R │ ├── nbody.c │ ├── nbody.f90 │ ├── nbody.java │ └── nbody.python ├── pidigits │ ├── Makefile │ ├── pidigits.R │ ├── pidigits.c │ ├── pidigits.python │ └── pidigits2.R ├── regex-dna │ ├── regexdna-input50000.txt │ ├── regexdna-input500000.txt │ └── regexdna.R ├── reverse-complement │ ├── Makefile │ ├── revcomp-1.R │ ├── revcomp-2.R │ ├── revcomp-input.short │ ├── revcomp-input.txt │ ├── revcomp-input1000.txt │ ├── revcomp-input250000.txt │ ├── revcomp-input50000.txt │ ├── revcomp-native.R │ ├── revcomp-output.txt │ ├── revcomp.R │ ├── reverse.c │ ├── reverse.f90 │ ├── reverse.java │ └── reverse.python ├── shootout.list └── spectral-norm │ ├── Makefile │ ├── README │ ├── spectral-norm-1.R │ ├── spectral-norm-alt.R │ ├── spectral-norm-alt2.R │ ├── spectral-norm-alt3.R │ ├── spectral-norm-alt4.R │ ├── spectral-norm-math.R │ ├── spectral-norm-native.R │ ├── spectral-norm-vectorized.R │ ├── spectral-norm.R │ ├── spectral-norm.c │ ├── spectral-norm.f90 │ ├── spectral-norm.python │ └── spectralnorm.java └── utility ├── ORBIT_harness.R ├── fastr_harness.R ├── hardwarereport.py ├── perfreport.py ├── r_harness.R ├── raw_harness.py ├── rbench.cfg └── rbench.py /.gitignore: -------------------------------------------------------------------------------- 1 | .cproject 2 | .project 3 | .externalToolBuilders/ 4 | .pydevproject 5 | *.pyc 6 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2013, rbenchmark 2 | All rights reserved. 3 | 4 | Redistribution and use in source and binary forms, with or without modification, 5 | are permitted provided that the following conditions are met: 6 | 7 | * Redistributions of source code must retain the above copyright notice, this 8 | list of conditions and the following disclaimer. 9 | 10 | * Redistributions in binary form must reproduce the above copyright notice, this 11 | list of conditions and the following disclaimer in the documentation and/or 12 | other materials provided with the distribution. 13 | 14 | * Neither the name of the {organization} nor the names of its 15 | contributors may be used to endorse or promote products derived from 16 | this software without specific prior written permission. 17 | 18 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 19 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 20 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 21 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR 22 | ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 23 | (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 24 | LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON 25 | ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 26 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 27 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 28 | -------------------------------------------------------------------------------- /R-benchmark-25/Makefile: -------------------------------------------------------------------------------- 1 | LEVEL = .. 2 | 3 | PARA= 4 | 5 | include $(LEVEL)/common.mk 6 | 7 | 8 | 9 | -------------------------------------------------------------------------------- /R-benchmark-25/Matrix_calculation/att1.R: -------------------------------------------------------------------------------- 1 | # TODO: Add comment 2 | # 3 | ############################################################################### 4 | 5 | setup <- function() { 6 | require(Matrix) 7 | } 8 | 9 | run <- function(dataset, runs = 3) { 10 | 11 | cat(" I. Matrix calculation\n") 12 | cat(" ---------------------\n") 13 | cat("2400x2400 normal distributed random matrix ^1000\n"); 14 | for (i in 1:runs) { 15 | a <- abs(matrix(rnorm(2500*2500)/2, ncol=2500, nrow=2500)); 16 | b <- a^1000 17 | } 18 | 19 | cat("Creation, transp., deformation of a 2500x2500 matrix\n"); 20 | for (i in 1:runs) { 21 | a <- matrix(rnorm(2500*2500)/10, ncol=2500, nrow=2500); 22 | b <- t(a); 23 | dim(b) <- c(1250,5000); 24 | a <- t(b) 25 | } 26 | 27 | cat("2800x2800 cross-product matrix (b = a' * a)\n"); 28 | for (i in 1:runs) { 29 | a <- rnorm(2800*2800); dim(a) <- c(2800, 2800) 30 | b <- crossprod(a) # equivalent to: b <- t(a) %*% a 31 | } 32 | 33 | cat("Sorting of 7,000,000 random values\n"); 34 | for (i in 1:runs) { 35 | a <- rnorm(7000000) 36 | b <- sort(a, method="quick") 37 | } 38 | 39 | 40 | cat("Linear regr. over a 3000x3000 matrix (c = a \\ b')\n"); 41 | for (i in 1:runs) { 42 | a <- new("dgeMatrix", x = rnorm(2000*2000), Dim = as.integer(c(2000,2000))) 43 | b <- as.double(1:2000) 44 | c <- solve(crossprod(a), crossprod(a,b)) 45 | } 46 | } -------------------------------------------------------------------------------- /R-benchmark-25/Matrix_calculation/att1_1.R: -------------------------------------------------------------------------------- 1 | # TODO: Add comment 2 | # 3 | ############################################################################### 4 | 5 | 6 | run <- function(runs = 3) { 7 | cat("2400x2400 normal distributed random matrix ^1000\n"); 8 | for (i in 1:runs) { 9 | a <- abs(matrix(rnorm(2500*2500)/2, ncol=2500, nrow=2500)); 10 | b <- a^1000 11 | } 12 | } 13 | -------------------------------------------------------------------------------- /R-benchmark-25/Matrix_calculation/att1_2.R: -------------------------------------------------------------------------------- 1 | # TODO: Add comment 2 | # 3 | ############################################################################### 4 | 5 | 6 | run <- function(runs = 3) { 7 | cat("Creation, transp., deformation of a 2500x2500 matrix\n"); 8 | for (i in 1:runs) { 9 | a <- matrix(rnorm(2500*2500)/10, ncol=2500, nrow=2500); 10 | b <- t(a); 11 | dim(b) <- c(1250,5000); 12 | a <- t(b) 13 | } 14 | } 15 | -------------------------------------------------------------------------------- /R-benchmark-25/Matrix_calculation/att1_3.R: -------------------------------------------------------------------------------- 1 | # TODO: Add comment 2 | # 3 | ############################################################################### 4 | 5 | 6 | run <- function(runs = 3) { 7 | cat("2800x2800 cross-product matrix (b = a' * a)\n"); 8 | for (i in 1:runs) { 9 | a <- rnorm(2800*2800); dim(a) <- c(2800, 2800) 10 | b <- crossprod(a) # equivalent to: b <- t(a) %*% a 11 | } 12 | } 13 | -------------------------------------------------------------------------------- /R-benchmark-25/Matrix_calculation/att1_4.R: -------------------------------------------------------------------------------- 1 | # TODO: Add comment 2 | # 3 | ############################################################################### 4 | 5 | #??switch 6 | run <- function(runs = 3) { 7 | cat("Sorting of 7,000,000 random values\n"); 8 | for (i in 1:runs) { 9 | a <- rnorm(7000000) 10 | b <- sort(a, method="quick") 11 | } 12 | } 13 | -------------------------------------------------------------------------------- /R-benchmark-25/Matrix_calculation/att1_5.R: -------------------------------------------------------------------------------- 1 | # TODO: Add comment 2 | # 3 | ############################################################################### 4 | 5 | 6 | run <- function(runs = 3) { 7 | require(Matrix) 8 | cat("Linear regr. over a 3000x3000 matrix (c = a \\ b')\n"); 9 | for (i in 1:runs) { 10 | a <- new("dgeMatrix", x = rnorm(2000*2000), Dim = as.integer(c(2000,2000))) 11 | b <- as.double(1:2000) 12 | c <- solve(crossprod(a), crossprod(a,b)) 13 | } 14 | } 15 | -------------------------------------------------------------------------------- /R-benchmark-25/Matrix_functions/att2.R: -------------------------------------------------------------------------------- 1 | # TODO: Add comment 2 | # 3 | ############################################################################### 4 | 5 | setup <- function() { 6 | require(Matrix) 7 | } 8 | 9 | run <- function(dataset, runs = 3) { 10 | cat(" II. Matrix functions\n") 11 | cat(" --------------------\n") 12 | cat("FFT over 2,400,000 random values\n"); 13 | for (i in 1:runs) { 14 | a <- rnorm(2400000) 15 | b <- fft(a) 16 | } 17 | cat("Eigenvalues of a 640x640 random matrix\n"); 18 | for (i in 1:runs) { 19 | a <- array(rnorm(600*600), dim = c(600, 600)) 20 | b <- eigen(a, symmetric=FALSE, only.values=TRUE)$Value 21 | } 22 | cat("Determinant of a 2500x2500 random matrix\n"); 23 | for (i in 1:runs) { 24 | a <- rnorm(2500*2500); dim(a) <- c(2500, 2500) 25 | b <- det(a) 26 | } 27 | cat("Cholesky decomposition of a 3000x3000 matrix\n"); 28 | for (i in 1:runs) { 29 | a <- crossprod(new("dgeMatrix", x = rnorm(3000*3000), 30 | Dim = as.integer(c(3000, 3000)))) 31 | b <- chol(a) 32 | } 33 | cat("Inverse of a 1600x1600 random matrix\n"); 34 | for (i in 1:runs) { 35 | a <- new("dgeMatrix", x = rnorm(1600*1600), Dim = as.integer(c(1600, 1600))) 36 | b <- solve(a) 37 | } 38 | } -------------------------------------------------------------------------------- /R-benchmark-25/Matrix_functions/att2_1.R: -------------------------------------------------------------------------------- 1 | # TODO: Add comment 2 | # 3 | ############################################################################### 4 | 5 | 6 | run <- function(runs = 3) { 7 | cat("FFT over 2,400,000 random values\n"); 8 | for (i in 1:runs) { 9 | a <- rnorm(2400000) 10 | b <- fft(a) 11 | } 12 | } 13 | -------------------------------------------------------------------------------- /R-benchmark-25/Matrix_functions/att2_2.R: -------------------------------------------------------------------------------- 1 | # TODO: Add comment 2 | # 3 | ############################################################################### 4 | 5 | 6 | run <- function(runs = 3) { 7 | cat("Eigenvalues of a 640x640 random matrix\n"); 8 | for (i in 1:runs) { 9 | a <- array(rnorm(600*600), dim = c(600, 600)) 10 | b <- eigen(a, symmetric=FALSE, only.values=TRUE)$Value 11 | } 12 | } 13 | -------------------------------------------------------------------------------- /R-benchmark-25/Matrix_functions/att2_3.R: -------------------------------------------------------------------------------- 1 | # TODO: Add comment 2 | # 3 | ############################################################################### 4 | 5 | 6 | run <- function(runs = 3) { 7 | cat("Determinant of a 2500x2500 random matrix\n"); 8 | for (i in 1:runs) { 9 | a <- rnorm(2500*2500); dim(a) <- c(2500, 2500) 10 | b <- det(a) 11 | } 12 | } 13 | -------------------------------------------------------------------------------- /R-benchmark-25/Matrix_functions/att2_4.R: -------------------------------------------------------------------------------- 1 | # TODO: Add comment 2 | # 3 | ############################################################################### 4 | 5 | 6 | run <- function(runs = 3) { 7 | require(Matrix) 8 | cat("Cholesky decomposition of a 3000x3000 matrix\n"); 9 | for (i in 1:runs) { 10 | a <- crossprod(new("dgeMatrix", x = rnorm(3000*3000), 11 | Dim = as.integer(c(3000, 3000)))) 12 | b <- chol(a) 13 | } 14 | } 15 | -------------------------------------------------------------------------------- /R-benchmark-25/Matrix_functions/att2_5.R: -------------------------------------------------------------------------------- 1 | # TODO: Add comment 2 | # 3 | ############################################################################### 4 | 5 | 6 | run <- function(runs = 3) { 7 | require(Matrix) 8 | cat("Inverse of a 1600x1600 random matrix\n"); 9 | for (i in 1:runs) { 10 | a <- new("dgeMatrix", x = rnorm(1600*1600), Dim = as.integer(c(1600, 1600))) 11 | b <- solve(a) 12 | } 13 | } 14 | -------------------------------------------------------------------------------- /R-benchmark-25/Programmation/att3.R: -------------------------------------------------------------------------------- 1 | # TODO: Add comment 2 | # 3 | ############################################################################### 4 | 5 | run <- function(runs = 3) { 6 | cat(" III. Programmation\n") 7 | cat(" ------------------\n") 8 | 9 | cat("3,500,000 Fibonacci numbers calculation (vector calc)\n"); 10 | phi <- 1.6180339887498949 11 | for (i in 1:runs) { 12 | a <- floor(runif(3500000)*1000) 13 | b <- (phi^a - (-phi)^(-a))/sqrt(5) 14 | } 15 | 16 | cat("Creation of a 3000x3000 Hilbert matrix (matrix calc)\n"); 17 | a <- 3000 18 | for (i in 1:runs) { 19 | b <- rep(1:a, a); dim(b) <- c(a, a); 20 | b <- 1 / (t(b) + 0:(a-1)) 21 | } 22 | 23 | cat("Grand common divisors of 400,000 pairs (recursion)\n"); 24 | gcd2 <- function(x, y) {if (sum(y > 1.0E-4) == 0) x else {y[y == 0] <- x[y == 0]; Recall(y, x %% y)}} 25 | for (i in 1:runs) { 26 | a <- ceiling(runif(400000)*1000) 27 | b <- ceiling(runif(400000)*1000) 28 | c <- gcd2(a, b) # gcd2 is a recursive function 29 | } 30 | 31 | cat("Creation of a 500x500 Toeplitz matrix (loops)\n"); 32 | for (i in 1:runs) { 33 | b <- rep(0, 500*500); dim(b) <- c(500, 500) 34 | for (j in 1:500) { 35 | for (k in 1:500) { 36 | jk<-j - k; 37 | b[k,j] <- abs(jk) + 1 38 | } 39 | } 40 | } 41 | 42 | cat("Escoufier's method on a 45x45 matrix (mixed)\n"); 43 | Trace <- function(y) {sum(c(y)[1 + 0:(min(dim(y)) - 1) * (dim(y)[1] + 1)], na.rm=FALSE)} 44 | for (i in 1:runs) { 45 | x <- abs(rnorm(45*45)); dim(x) <- c(45, 45) 46 | p <- ncol(x) 47 | vt <- 1:p # Variables to test 48 | vr <- NULL # Result: ordered variables 49 | RV <- 1:p # Result: correlations 50 | vrt <- NULL 51 | for (j in 1:p) { # loop on the variable number 52 | Rvmax <- 0 53 | for (k in 1:(p-j+1)) { # loop on the variables 54 | x2 <- cbind(x, x[,vr], x[,vt[k]]) 55 | R <- cor(x2) # Correlations table 56 | Ryy <- R[1:p, 1:p] 57 | Rxx <- R[(p+1):(p+j), (p+1):(p+j)] 58 | Rxy <- R[(p+1):(p+j), 1:p] 59 | Ryx <- t(Rxy) 60 | rvt <- Trace(Ryx %*% Rxy) / sqrt(Trace(Ryy %*% Ryy) * Trace(Rxx %*% Rxx)) # RV calculation 61 | if (rvt > Rvmax) { 62 | Rvmax <- rvt # test of RV 63 | vrt <- vt[k] # temporary held variable 64 | } 65 | } 66 | vr[j] <- vrt # Result: variable 67 | RV[j] <- Rvmax # Result: correlation 68 | vt <- vt[vt!=vr[j]] # reidentify variables to test 69 | } 70 | } 71 | } -------------------------------------------------------------------------------- /R-benchmark-25/Programmation/att3_1.R: -------------------------------------------------------------------------------- 1 | # TODO: Add comment 2 | # 3 | ############################################################################### 4 | 5 | 6 | run <- function(runs = 3) { 7 | cat("3,500,000 Fibonacci numbers calculation (vector calc)\n"); 8 | phi <- 1.6180339887498949 9 | for (i in 1:runs) { 10 | a <- floor(runif(3500000)*1000) 11 | b <- (phi^a - (-phi)^(-a))/sqrt(5) 12 | } 13 | } 14 | -------------------------------------------------------------------------------- /R-benchmark-25/Programmation/att3_2.R: -------------------------------------------------------------------------------- 1 | # TODO: Add comment 2 | # 3 | ############################################################################### 4 | 5 | 6 | run <- function(runs = 3) { 7 | cat("Creation of a 3000x3000 Hilbert matrix (matrix calc)\n"); 8 | a <- 3000 9 | for (i in 1:runs) { 10 | b <- rep(1:a, a); dim(b) <- c(a, a); 11 | b <- 1 / (t(b) + 0:(a-1)) 12 | } 13 | } 14 | -------------------------------------------------------------------------------- /R-benchmark-25/Programmation/att3_3.R: -------------------------------------------------------------------------------- 1 | # TODO: Add comment 2 | # 3 | ############################################################################### 4 | 5 | 6 | run <- function(runs = 3) { 7 | cat("Grand common divisors of 400,000 pairs (recursion)\n"); 8 | gcd2 <- function(x, y) {if (sum(y > 1.0E-4) == 0) x else {y[y == 0] <- x[y == 0]; Recall(y, x %% y)}} 9 | for (i in 1:runs) { 10 | a <- ceiling(runif(400000)*1000) 11 | b <- ceiling(runif(400000)*1000) 12 | c <- gcd2(a, b) # gcd2 is a recursive function 13 | } 14 | } 15 | -------------------------------------------------------------------------------- /R-benchmark-25/Programmation/att3_4.R: -------------------------------------------------------------------------------- 1 | # TODO: Add comment 2 | # 3 | ############################################################################### 4 | 5 | 6 | run <- function(runs = 3) { 7 | cat("Creation of a 500x500 Toeplitz matrix (loops)\n"); 8 | for (i in 1:runs) { 9 | b <- rep(0, 500*500); dim(b) <- c(500, 500) 10 | for (j in 1:500) { 11 | for (k in 1:500) { 12 | jk<-j - k; 13 | b[k,j] <- abs(jk) + 1 14 | } 15 | } 16 | } 17 | } 18 | -------------------------------------------------------------------------------- /R-benchmark-25/Programmation/att3_5.R: -------------------------------------------------------------------------------- 1 | # TODO: Add comment 2 | # 3 | ############################################################################### 4 | 5 | 6 | run <- function(runs = 3) { 7 | cat("Escoufier's method on a 45x45 matrix (mixed)\n"); 8 | Trace <- function(y) {sum(c(y)[1 + 0:(min(dim(y)) - 1) * (dim(y)[1] + 1)], na.rm=FALSE)} 9 | for (i in 1:runs) { 10 | x <- abs(rnorm(45*45)); dim(x) <- c(45, 45) 11 | p <- ncol(x) 12 | vt <- 1:p # Variables to test 13 | vr <- NULL # Result: ordered variables 14 | RV <- 1:p # Result: correlations 15 | vrt <- NULL 16 | for (j in 1:p) { # loop on the variable number 17 | Rvmax <- 0 18 | for (k in 1:(p-j+1)) { # loop on the variables 19 | x2 <- cbind(x, x[,vr], x[,vt[k]]) 20 | R <- cor(x2) # Correlations table 21 | Ryy <- R[1:p, 1:p] 22 | Rxx <- R[(p+1):(p+j), (p+1):(p+j)] 23 | Rxy <- R[(p+1):(p+j), 1:p] 24 | Ryx <- t(Rxy) 25 | rvt <- Trace(Ryx %*% Rxy) / sqrt(Trace(Ryy %*% Ryy) * Trace(Rxx %*% Rxx)) # RV calculation 26 | if (rvt > Rvmax) { 27 | Rvmax <- rvt # test of RV 28 | vrt <- vt[k] # temporary held variable 29 | } 30 | } 31 | vr[j] <- vrt # Result: variable 32 | RV[j] <- Rvmax # Result: correlation 33 | vt <- vt[vt!=vr[j]] # reidentify variables to test 34 | } 35 | } 36 | } 37 | -------------------------------------------------------------------------------- /R-benchmark-25/R-benchmark-25.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rbenchmark/benchmarks/9850828078e0858cb55146900afe63e550ed36db/R-benchmark-25/R-benchmark-25.R -------------------------------------------------------------------------------- /R-benchmark-25/README.md: -------------------------------------------------------------------------------- 1 | # R-benchmark-25 2 | 3 | R-benchmark-25 benchmark is also known as ATT benchmark. The original source is at http://r.research.att.com/benchmarks/R-benchmark-25.R. 4 | 5 | The version here is customized for rbench driver. 6 | 7 | - R-benchmark-25.R: Wrap the original code into the run() function, and add the default execution routine. 8 | - att1.R: All benchmarks in Category I of the R-benchmark-25 9 | - att2.R: All benchmarks in Category II of the R-benchmark-25 10 | - att3.R: All benchmarks in Category III of the R-benchmark-25 11 | - att1_1.R ... att3_5.R: individual benchmark of the R-benchmark-25 12 | -------------------------------------------------------------------------------- /algorithm/ICA/ica.R: -------------------------------------------------------------------------------- 1 | # ICA Analysis - fastICA package 2 | # 3 | # Author: Haichuan Wang 4 | # 5 | # The code is based on FastICA R package http://cran.r-project.org/web/packages/fastICA/ 6 | # Un-mixing n mixed independent uniforms using fastICA package 7 | ############################################################################### 8 | app.name <- "ICA_fastICA" 9 | source('setup_ica.R') 10 | library(fastICA) 11 | 12 | run <- function(dataset) { 13 | X <- dataset$X 14 | A <- dataset$A 15 | nvar <- dataset$nvar 16 | niter <- dataset$niter 17 | n <- length(X) #num of samples 18 | 19 | X <- t(simplify2array(X)) 20 | res <- fastICA(X, nvar, alg.typ = "parallel", fun = "logcosh", alpha = 1, 21 | method = "R", row.norm = FALSE, maxit = niter, tol = 0.0001, 22 | verbose = TRUE) 23 | print(res$A) 24 | } 25 | 26 | if (!exists('harness_argc')) { 27 | data <- setup(commandArgs(TRUE)) 28 | run(data) 29 | } -------------------------------------------------------------------------------- /algorithm/ICA/ica_lapply.R: -------------------------------------------------------------------------------- 1 | # ICA Analysis - lapply based algorithm 2 | # 3 | # Author: Haichuan Wang 4 | # 5 | # The code is based on FastICA R package http://cran.r-project.org/web/packages/fastICA/ 6 | # Un-mixing n mixed independent uniforms 7 | ############################################################################### 8 | app.name <- "ICA_lapply" 9 | source('setup_ica.R') 10 | 11 | run <- function(dataset) { 12 | X <- dataset$X 13 | A <- dataset$A 14 | nvar <- dataset$nvar 15 | niter <- dataset$niter 16 | n <- length(X) #num of samples 17 | 18 | message("Whitening") 19 | cross.func <- function(x) { 20 | tcrossprod(x) 21 | } 22 | V <- Reduce('+', lapply(X, cross.func)) / n 23 | s <- La.svd(V) 24 | D <- diag(c(1/sqrt(s$d))) 25 | K <- D %*% t(s$u) 26 | white.func <- function(x){ K %*% x} 27 | X1 <- lapply(X, white.func) 28 | #init W 29 | W <- matrix(rnorm(nvar^2),nvar, nvar) #init.w 30 | sW <- La.svd(W) 31 | W <- sW$u %*% diag(1/sW$d) %*% t(sW$u) %*% W 32 | W1 <- W 33 | alpha <- 1 34 | gwx.fun <- function(x) { 35 | wx <- W %*% x 36 | gwx <- tanh(alpha * wx) 37 | tcrossprod(gwx, x) 38 | } 39 | 40 | g.wx.fun <- function(x) { 41 | wx <- W %*% x 42 | gwx <- tanh(alpha * wx) 43 | alpha * (1 - gwx^2) 44 | } 45 | 46 | ptm <- proc.time() #previous iteration's time 47 | for(iter in 1:niter) { 48 | GWX <- lapply(X1, gwx.fun) 49 | v1 <- Reduce('+', GWX) / n 50 | G.WX <- lapply(X1, g.wx.fun) 51 | v2 <- diag(c(Reduce('+', G.WX) / n)) %*% W 52 | W1 <- v1 - v2 53 | sW1 <- La.svd(W1) 54 | W1 <- sW1$u %*% diag(1/sW1$d) %*% t(sW1$u) %*% W1 55 | W <- W1 56 | ctm <- proc.time() 57 | cat("[INFO]Iter", iter, "Time =", (ctm - ptm)[[3]], '\n') 58 | ptm <- ctm 59 | } 60 | #final turn back 61 | w <- W %*% K 62 | resA <- t(w) %*% solve(w %*% t(w)) 63 | print(resA) 64 | } 65 | 66 | if (!exists('harness_argc')) { 67 | data <- setup(commandArgs(TRUE)) 68 | run(data) 69 | } 70 | -------------------------------------------------------------------------------- /algorithm/ICA/setup_ica.R: -------------------------------------------------------------------------------- 1 | # ICA Analysis - Preparing data set for ICA analysis 2 | # 3 | # Author: Haichuan Wang 4 | # 5 | # Generate the dataset for ICA 6 | # nvar: number of signals of ICA unmixing 7 | # n: number of samples 8 | # X: list of samples, each sample is a length nvar size double vector 9 | # A: Mixing matrix 10 | # niter: number of iterations of the ICA algorithm 11 | ############################################################################### 12 | 13 | 14 | setup <- function(args=c('1000000', '2', '25')) { 15 | n<-as.integer(args[1]) 16 | if(is.na(n)){ n <- 1000000L } 17 | 18 | nvar <-as.integer(args[2]) 19 | if(is.na(nvar)){ nvar <- 2L } 20 | 21 | niter<-as.integer(args[3]) 22 | if(is.na(niter)){ niter <- 25L } 23 | 24 | cat('[INFO][', app.name, '] n=', n, ', nvar=', nvar, ', niter=', niter, '\n', sep='') 25 | 26 | #generate pre-centered data. Note the data shape is n x nvar 27 | S <- matrix(runif(n*nvar), nrow=n, ncol=nvar) 28 | A <- matrix(c(1, 1, -1, 3), 2, 2) 29 | X <- scale(S %*% A, scale = FALSE) #pre-centering 30 | X <- lapply(1:n, function(i){X[i,]}) 31 | list(X = X, A = A, nvar=nvar, niter = niter) 32 | } 33 | -------------------------------------------------------------------------------- /algorithm/LR/LR-1var.R: -------------------------------------------------------------------------------- 1 | # LinearRegression-1var - R lm based solution 2 | # 3 | # Author: Haichuan Wang 4 | ############################################################################### 5 | app.name <- 'LR-1var' 6 | source('setup_LR-1var.R') 7 | 8 | run <- function(dataset) { 9 | YX <- dataset$YX 10 | #grab YX 11 | vYX <- t(simplify2array(YX)) 12 | 13 | res <- lm(vYX[,1] ~ vYX[,2]); 14 | print(res) 15 | } 16 | 17 | if (!exists('harness_argc')) { 18 | data <- setup(commandArgs(TRUE)) 19 | run(data) 20 | } 21 | -------------------------------------------------------------------------------- /algorithm/LR/LR-1var_lms_lapply.R: -------------------------------------------------------------------------------- 1 | # LinearRegression-1var - LMS(least mean square) lapply based solution 2 | # 3 | # Author: Haichuan Wang 4 | ############################################################################### 5 | app.name <- 'LR-1var_lms_lapply' 6 | source('setup_LR-1var.R') 7 | 8 | run <- function(dataset) { 9 | YX <- dataset$YX 10 | niter <- dataset$niter 11 | 12 | #X includes "1" column, Y column vec 13 | grad.func <- function(yx) { 14 | y <- yx[1] 15 | x <- c(1, yx[2]) # add 1 to est interception 16 | error <- (sum(x *theta) - y) 17 | delta <- error * x 18 | return(delta) 19 | } 20 | 21 | cost <- function(X, y, theta) { 22 | # computes the cost of using theta as the parameter for linear regression 23 | # to fit the data points in X and y 24 | sum((X %*% theta - y)^2)/(2 * length(y)) 25 | } 26 | 27 | theta <- double(length(YX[[1]])) #initial guess as 0 28 | alpha <- 0.05 / length(YX) # small step 29 | 30 | ptm <- proc.time() #previous iteration's time 31 | for(iter in 1:niter) { 32 | delta <- lapply(YX, grad.func) 33 | #cat('delta =', delta, '\n') 34 | theta <- theta - alpha * Reduce('+', delta) 35 | ctm <- proc.time() 36 | cat("[INFO]Iter", iter, "Time =", (ctm - ptm)[[3]], '\n') 37 | ptm <- ctm 38 | cat('theta =', theta, '\n') 39 | #print(cost(X,y, theta)) 40 | } 41 | cat('Final theta =', theta, '\n') 42 | } 43 | 44 | if (!exists('harness_argc')) { 45 | data <- setup(commandArgs(TRUE)) 46 | run(data) 47 | } 48 | -------------------------------------------------------------------------------- /algorithm/LR/LR-1var_lms_vec.R: -------------------------------------------------------------------------------- 1 | # LinearRegression-1var - LMS(least mean square) vector programming based solution 2 | # 3 | # Author: Haichuan Wang 4 | ############################################################################### 5 | app.name <- 'LR-1var_lms_vec' 6 | source('setup_LR-1var.R') 7 | 8 | run <- function(dataset) { 9 | YX <- dataset$YX 10 | niter <- dataset$niter 11 | vYX <- t(simplify2array(YX)) 12 | X <- cbind(1, matrix(vYX[,2])) 13 | Y <- vYX[,1] 14 | 15 | #X includes "1" column, Y column vec 16 | grad.func <- function(X, y) { 17 | error <- (X %*% theta - y) 18 | #This is a simple normalization 19 | delta <- t(X) %*% error / length(y) 20 | return(delta) 21 | } 22 | 23 | cost <- function(X, y, theta) { 24 | # computes the cost of using theta as the parameter for linear regression 25 | # to fit the data points in X and y 26 | sum((X %*% theta - y)^2)/(2 * length(y)) 27 | } 28 | 29 | 30 | theta <- double(ncol(X)) #initial guess 31 | alpha <- 0.05 # small step 32 | 33 | ptm <- proc.time() #previous iteration's time 34 | for(iter in 1:niter) { 35 | delta <- grad.func(X, Y) 36 | #cat('delta =', delta, '\n') 37 | theta <- theta - alpha * delta 38 | ctm <- proc.time() 39 | cat("[INFO]Iter", iter, "Time =", (ctm - ptm)[[3]], '\n') 40 | ptm <- ctm 41 | cat('theta =', theta, '\n') 42 | #print(cost(X,y, theta)) 43 | } 44 | cat('Final theta =', theta, '\n') 45 | } 46 | 47 | if (!exists('harness_argc')) { 48 | data <- setup(commandArgs(TRUE)) 49 | run(data) 50 | } 51 | -------------------------------------------------------------------------------- /algorithm/LR/LR-1var_ols_lapply.R: -------------------------------------------------------------------------------- 1 | # LinearRegression-1var - OLS(Ordinary Least Squares) lapply based solution 2 | # 3 | # Author: Haichuan Wang 4 | ############################################################################### 5 | app.name <- 'LR-1var_ols_lapply' 6 | source('setup_LR-1var.R') 7 | 8 | run <- function(dataset) { 9 | YX <- dataset$YX 10 | 11 | #X includes "1" column, Y column vec 12 | A.func <- function(yx) { 13 | x <- c(1, yx[2]) 14 | tcrossprod(x) 15 | } 16 | 17 | b.func <- function(yx) { 18 | y <- yx[1] 19 | x <- c(1, yx[2]) 20 | x * y 21 | } 22 | 23 | A <- Reduce('+', lapply(YX, A.func)) 24 | b <- Reduce('+', lapply(YX, b.func)) 25 | 26 | theta <- solve(A, b) 27 | print(theta) 28 | } 29 | 30 | if (!exists('harness_argc')) { 31 | data <- setup(commandArgs(TRUE)) 32 | run(data) 33 | } 34 | -------------------------------------------------------------------------------- /algorithm/LR/LR.R: -------------------------------------------------------------------------------- 1 | # LinearRegression - R lm based solution 2 | # 3 | # Author: Haichuan Wang 4 | ############################################################################### 5 | app.name <- 'LR' 6 | source('setup_LR.R') 7 | 8 | run <- function(dataset) { 9 | YX <- dataset$YX 10 | #grab YX 11 | vYX <- t(simplify2array(YX)) 12 | 13 | res<-lm(vYX[,1] ~ vYX[,-1]); 14 | print(res) 15 | } 16 | 17 | if (!exists('harness_argc')) { 18 | data <- setup(commandArgs(TRUE)) 19 | run(data) 20 | } 21 | -------------------------------------------------------------------------------- /algorithm/LR/LR_lms_lapply.R: -------------------------------------------------------------------------------- 1 | # LinearRegression - LMS(least mean square) lapply based solution 2 | # 3 | # Author: Haichuan Wang 4 | ############################################################################### 5 | app.name <- 'LR_lms_lapply' 6 | source('setup_LR.R') 7 | 8 | run <- function(dataset) { 9 | YX <- dataset$YX 10 | niter <- dataset$niter 11 | 12 | #X includes "1" column, Y column vec 13 | grad.func <- function(yx) { 14 | y <- yx[1] 15 | x <- yx 16 | x[1] <- 1 #modify the 1st element 17 | error <- (sum(x *theta) - y) 18 | delta <- error * x 19 | return(delta) 20 | } 21 | 22 | cost <- function(X, y, theta) { 23 | # computes the cost of using theta as the parameter for linear regression 24 | # to fit the data points in X and y 25 | sum((X %*% theta - y)^2)/(2 * length(y)) 26 | } 27 | 28 | 29 | theta <- double(length(YX[[1]])) #initial guess as 0 30 | alpha <- 0.05/ length(YX) / length(theta) # small step 31 | 32 | ptm <- proc.time() #previous iteration's time 33 | for(iter in 1:niter) { 34 | delta <- lapply(YX, grad.func) 35 | #cat('delta =', delta, '\n') 36 | theta <- theta - alpha * Reduce('+', delta) 37 | ctm <- proc.time() 38 | cat("[INFO]Iter", iter, "Time =", (ctm - ptm)[[3]], '\n') 39 | ptm <- ctm 40 | cat('theta =', theta, '\n') 41 | #print(cost(X,y, theta)) 42 | } 43 | cat('Final theta =', theta, '\n') 44 | } 45 | 46 | if (!exists('harness_argc')) { 47 | data <- setup(commandArgs(TRUE)) 48 | run(data) 49 | } 50 | -------------------------------------------------------------------------------- /algorithm/LR/LR_ols_lapply.R: -------------------------------------------------------------------------------- 1 | # LinearRegression - OLS(Ordinary Least Squares) lapply based solution 2 | # 3 | # Author: Haichuan Wang 4 | ############################################################################### 5 | app.name <- 'LR_ols_lapply' 6 | source('setup_LR.R') 7 | 8 | run <- function(dataset) { 9 | YX <- dataset$YX 10 | 11 | #X includes "1" column, Y column vec 12 | A.func <- function(yx) { 13 | x <- yx 14 | x[1] <- 1 #modify the 1st element set to 1 15 | tcrossprod(x) 16 | } 17 | 18 | b.func <- function(yx) { 19 | y <- yx[1] 20 | x <- yx 21 | x[1] <-1 22 | x * y 23 | } 24 | 25 | A <- Reduce('+', lapply(YX, A.func)) 26 | b <- Reduce('+', lapply(YX, b.func)) 27 | 28 | theta <- solve(A, b) 29 | print(theta) 30 | } 31 | 32 | if (!exists('harness_argc')) { 33 | data <- setup(commandArgs(TRUE)) 34 | run(data) 35 | } 36 | -------------------------------------------------------------------------------- /algorithm/LR/setup_LR-1var.R: -------------------------------------------------------------------------------- 1 | # LinearRegression - Preparing data set for Linear Regression 2 | # 3 | # Author: Haichuan Wang 4 | # 5 | # Generate the dataset for LogitRegression 6 | # n: number of samples 7 | # niter: number of iterations 8 | # YX: list data, each one is [y x] 9 | ############################################################################### 10 | 11 | 12 | setup <- function(args=c('1000000', '50')) { 13 | n<-as.integer(args[1]) 14 | if(is.na(n)){ n <- 1000000L } 15 | 16 | niter<-as.integer(args[2]) 17 | if(is.na(niter)){ niter <- 50L } 18 | 19 | cat('[INFO][', app.name, '] n=', n, ', niter=', niter, '\n', sep='') 20 | 21 | X<- runif(n, 0, 10) 22 | Y<- X + rnorm(n) + 1 23 | YX <- lapply(1:n, function(i){c(Y[i],X[i])}) 24 | list(YX=YX, niter=niter) 25 | } -------------------------------------------------------------------------------- /algorithm/LR/setup_LR.R: -------------------------------------------------------------------------------- 1 | # LinearRegression-1var - Preparing data set for Linear Regression 1 variable case 2 | # 3 | # Author: Haichuan Wang 4 | # 5 | # Generate the dataset for LogitRegression 6 | # n: number of samples 7 | # niter: number of iterations 8 | # YX: list data, each one is [y x_1 x_2 ... x_nvar] 9 | ############################################################################### 10 | 11 | 12 | setup <- function(args=c('1000000', '10', '50')) { 13 | n<-as.integer(args[1]) 14 | if(is.na(n)){ n <- 1000000L } 15 | 16 | nvar <-as.integer(args[2]) 17 | if(is.na(nvar)){ nvar <- 10L } 18 | 19 | niter<-as.integer(args[3]) 20 | if(is.na(niter)){ niter <- 50L } 21 | 22 | cat('[INFO][', app.name, '] n=', n, ', nvar=', nvar, ', niter=', niter, '\n', sep='') 23 | 24 | X<- matrix(runif(n*nvar, 0, 10), nrow=nvar, ncol=n) 25 | Y<- colSums(X) + rnorm(n) + 1 # now the coefficient are all 1 26 | YX <- lapply(1:n, function(i){c(Y[i],X[,i])}) 27 | list(YX=YX, nvar=nvar, niter=niter); 28 | } -------------------------------------------------------------------------------- /algorithm/LogitRegression/LogitRegre-1var_lapply.R: -------------------------------------------------------------------------------- 1 | # LogitRegre-1var - lapply based algorithm 2 | # 3 | # Author: Haichuan Wang 4 | ############################################################################### 5 | app.name <- 'LogitRegre-1var_lapply' 6 | source('setup_LogitRegre-1var.R') 7 | 8 | run <- function(dataset) { 9 | YX <- dataset$YX 10 | niter<-data$niter 11 | 12 | theta <- double(length(YX[[1]])) #initial guess as 0 13 | 14 | #X includes "1" column, Y column vec 15 | grad.func <- function(yx) { 16 | y <- yx[1] 17 | x <- c(1, yx[2]) 18 | logit <- 1/(1 + exp(-sum(theta*x))) 19 | (y-logit) * x 20 | } 21 | 22 | ptm <- proc.time() #previous iteration's time 23 | for(iter in 1:niter) { 24 | delta <- lapply(YX, grad.func) 25 | #cat('delta =', delta, '\n') 26 | theta <- theta + Reduce('+', delta) / length(YX) 27 | ctm <- proc.time() 28 | cat("[INFO]Iter", iter, "Time =", (ctm - ptm)[[3]], '\n') 29 | ptm <- ctm 30 | cat('theta =', theta, '\n') 31 | #print(cost(X,y, theta)) 32 | } 33 | cat('Final theta =', theta, '\n') 34 | } 35 | 36 | if (!exists('harness_argc')) { 37 | data <- setup(commandArgs(TRUE)) 38 | run(data) 39 | } 40 | -------------------------------------------------------------------------------- /algorithm/LogitRegression/LogitRegre2_lapply.R: -------------------------------------------------------------------------------- 1 | # LogitRegre - lapply based algorithm (from SparkR) 2 | # 3 | # Author: Haichuan Wang 4 | ############################################################################### 5 | app.name <- 'LogitRegre2_lapply' 6 | source('setup_LogitRegre.R') 7 | 8 | run <- function(data) { 9 | YX <- data$YX 10 | nvar <- data$nvar 11 | niter<-data$niter 12 | 13 | #X includes "1" column, Y column vec 14 | grad.func <- function(yx) { 15 | y <- yx[1] 16 | x <- yx[-1] 17 | dot <- sum(x * w) 18 | logit <- 1 / (1 + exp(-y * dot)) 19 | x * ((logit - 1) * y) 20 | } 21 | 22 | # Initialize w to a random value 23 | w <- double(nvar) #runif(n=nvar, min = -1, max = 1) 24 | cat("Initial w: ", w, "\n") 25 | 26 | ptm <- proc.time() #previous iteration's time 27 | for(iter in 1:niter) { 28 | w <- w - Reduce('+', lapply(YX, grad.func)) 29 | ctm <- proc.time() 30 | cat("[INFO]Iter", iter, "Time =", (ctm - ptm)[[3]], '\n') 31 | ptm <- ctm 32 | cat("w = ", w, "\n") 33 | } 34 | cat("Final w: ", w, "\n") 35 | } 36 | 37 | 38 | if (!exists('harness_argc')) { 39 | data <- setup(commandArgs(TRUE)) 40 | run(data) 41 | } 42 | -------------------------------------------------------------------------------- /algorithm/LogitRegression/LogitRegre_lapply.R: -------------------------------------------------------------------------------- 1 | # LogitRegre - lapply based algorithm 2 | # 3 | # Author: Haichuan Wang 4 | ############################################################################### 5 | app.name <- 'LogitRegre_lapply' 6 | source('setup_LogitRegre.R') 7 | 8 | run <- function(dataset) { 9 | YX <- dataset$YX 10 | niter<-data$niter 11 | 12 | theta <- double(length(YX[[1]])) #initial guess as 0 13 | 14 | #X includes "1" column, Y column vec 15 | grad.func <- function(yx) { 16 | y <- yx[1] 17 | x <- yx 18 | x[1] <- 1 #modify the 1st column 19 | logit <- 1/(1 + exp(-sum(theta*x))) 20 | (y-logit) * x 21 | } 22 | 23 | ptm <- proc.time() #previous iteration's time 24 | for(iter in 1:niter) { 25 | delta <- lapply(YX, grad.func) 26 | #cat('delta =', delta, '\n') 27 | theta <- theta + Reduce('+', delta) / length(YX) 28 | ctm <- proc.time() 29 | cat("[INFO]Iter", iter, "Time =", (ctm - ptm)[[3]], '\n') 30 | ptm <- ctm 31 | cat('theta =', theta, '\n') 32 | #print(cost(X,y, theta)) 33 | } 34 | cat('Final theta =', theta, '\n') 35 | } 36 | 37 | if (!exists('harness_argc')) { 38 | data <- setup(commandArgs(TRUE)) 39 | run(data) 40 | } 41 | -------------------------------------------------------------------------------- /algorithm/LogitRegression/setup_logitRegre-1var.R: -------------------------------------------------------------------------------- 1 | # LogitRegre-1var - Preparing data set for LogitRegression 1 variable case 2 | # 3 | # Author: Haichuan Wang 4 | # 5 | # Generate the dataset for LogitRegression 6 | # n: number of samples 7 | # niter: number of iterations 8 | # YX: list data, each one is [y x_1 x_2 ... x_nvar] 9 | ############################################################################### 10 | 11 | 12 | setup <- function(args=c('1000000', '50')) { 13 | n<-as.integer(args[1]) 14 | if(is.na(n)){ n <- 1000000L } 15 | 16 | niter<-as.integer(args[3]) 17 | if(is.na(niter)){ niter <- 50L } 18 | 19 | cat('[INFO][', app.name, '] n=', n, ', niter=', niter, '\n', sep='') 20 | 21 | X<- runif(n, 0, 10) 22 | Y<- 1/(1+exp(-(1+X))) + rnorm(n) * 0.05 # now the coefficient is 1 23 | YX <- lapply(1:n, function(i){c(Y[i],X[i])}) 24 | list(YX=YX, niter=niter); 25 | 26 | } -------------------------------------------------------------------------------- /algorithm/LogitRegression/setup_logitRegre.R: -------------------------------------------------------------------------------- 1 | # LogitRegre - Preparing data set for LogitRegression 2 | # 3 | # Author: Haichuan Wang 4 | # 5 | # Generate the dataset for LogitRegression 6 | # n: number of samples 7 | # nvar: number of variables for one sample 8 | # niter: number of iterations 9 | # YX: list data, each one is [y x_1 x_2 ... x_nvar] 10 | ############################################################################### 11 | 12 | 13 | setup <- function(args=c('1000000', '10', '50')) { 14 | n<-as.integer(args[1]) 15 | if(is.na(n)){ n <- 1000000L } 16 | 17 | nvar <-as.integer(args[2]) 18 | if(is.na(nvar)){ nvar <- 10L } 19 | 20 | niter<-as.integer(args[3]) 21 | if(is.na(niter)){ niter <- 50L } 22 | 23 | cat('[INFO][', app.name, '] n=', n, ', nvar=', nvar, ', niter=', niter, '\n', sep='') 24 | 25 | X<- matrix(runif(n*nvar, -1, 1), nrow=nvar, ncol=n) 26 | theta <- rep(1,nvar) 27 | Y<- 1/(1+exp(-(1+colSums(theta*X)))) # now the coefficient are all 1 28 | YX <- lapply(1:n, function(i){c(Y[i],X[,i])}) 29 | list(YX=YX, nvar=nvar, niter=niter); 30 | } -------------------------------------------------------------------------------- /algorithm/PCA/PCA_lapply.R: -------------------------------------------------------------------------------- 1 | # PCA analysis - Direct method with lapply 2 | # 3 | # Author: Haichuan Wang 4 | ############################################################################### 5 | app.name <- 'PCA_lapply' 6 | source('setup_PCA.R') 7 | 8 | run <- function(dataset) { 9 | X <- dataset$X 10 | 11 | cross.func <- function(x) { 12 | tcrossprod(x) 13 | } 14 | 15 | mean.func <- function(x) { 16 | x 17 | } 18 | 19 | len <- length(X) 20 | XC <- Reduce('+', lapply(X, cross.func)) 21 | vMean <- Reduce('+', lapply(X, mean.func)) / len 22 | 23 | covM <- XC/len - tcrossprod(vMean) 24 | eigen(covM) 25 | } 26 | 27 | if (!exists('harness_argc')) { 28 | data <- setup(commandArgs(TRUE)) 29 | run(data) 30 | } 31 | -------------------------------------------------------------------------------- /algorithm/PCA/setup_PCA.R: -------------------------------------------------------------------------------- 1 | # PCA Analysis - Preparing data set for PCA analysis 2 | # 3 | # Author: Haichuan Wang 4 | # 5 | # Generate the dataset for PCA 6 | # nvar: number of signals of PCA 7 | # n: number of samples 8 | ############################################################################### 9 | 10 | 11 | setup <- function(args=c('1000000', '10')) { 12 | n<-as.integer(args[1]) 13 | if(is.na(n)){ n <- 1000000L } 14 | 15 | nvar <-as.integer(args[2]) 16 | if(is.na(nvar)){ nvar <- 10L } 17 | 18 | cat('[INFO][', app.name, '] n=', n, ', nvar=', nvar, '\n', sep='') 19 | 20 | X <- matrix(runif(n*nvar, 0, 10), nrow=nvar, ncol=n) 21 | X <- lapply(1:n, function(i){X[,i]}) 22 | list(X = X) 23 | } -------------------------------------------------------------------------------- /algorithm/Pi/Pi_lapply.R: -------------------------------------------------------------------------------- 1 | # Monte-Carlo Pi - lapply based solution 2 | # 3 | # Author: Haichuan Wang 4 | ############################################################################### 5 | app.name <- 'Pi_lapply' 6 | source('setup_Pi.R') 7 | 8 | run <- function(S) { 9 | 10 | #X includes "1" column, Y column vec 11 | sample.func <- function(aSample) { 12 | if((aSample[1]^2 + aSample[2]^2) < 1) { 13 | 1.0 14 | } else { 15 | 0.0 16 | } 17 | } 18 | 19 | sampleOut <- lapply(S, sample.func) 20 | 21 | reduceCount <- Reduce('+', sampleOut) 22 | mcPi <- 4.0 * reduceCount / length(S) 23 | 24 | cat('Pi = ', mcPi, '\n'); 25 | } 26 | 27 | if (!exists('harness_argc')) { 28 | data <- setup(commandArgs(TRUE)) 29 | run(data) 30 | } 31 | -------------------------------------------------------------------------------- /algorithm/Pi/setup_Pi.R: -------------------------------------------------------------------------------- 1 | # Monte-Carlo Pi - Preparing data set for Pi calculation 2 | # 3 | # Author: Haichuan Wang 4 | # 5 | # Generate the dataset for Pi 6 | # n: number of samples 7 | ############################################################################### 8 | 9 | setup <- function(args=c('20000000')) { 10 | n<-as.integer(args[1]) 11 | if(is.na(n)){ n <- 20000000L } 12 | 13 | cat('[INFO][', app.name, '] n=', n, '\n', sep='') 14 | 15 | rdata <- runif(n*2) 16 | S <- lapply(1:n, function(i){rdata[(2*i-1):(2*i)]}) 17 | 18 | S 19 | } -------------------------------------------------------------------------------- /algorithm/README.md: -------------------------------------------------------------------------------- 1 | # Algorithms 2 | 3 | Data mining algorithms implemented by different ways. 4 | 5 | ## ICA - Independent Component Analysis 6 | Algorithms are based on FastICA R package http://cran.r-project.org/web/packages/fastICA/ 7 | 8 | - ica.R: directly using fastICA package interface 9 | - ica_lapplyR: Using lapply based iterative algorithm 10 | 11 | ## kmeans 12 | 13 | - k-means.R: Using R built-in function. 14 | - k-means_lapply.R: Using lapply based iterative algorithm 15 | - k-means_vec.R standard iterative algorithm with vector programming 16 | - k-means-1D*.R: the corresponding k-means for 1D samples 17 | 18 | ## k-NN 19 | 20 | - NN.R: Using R built-in knn1 21 | - NN.lapply: Using lapply based algorithm 22 | - k-NN.R: Using R built-in knn 23 | - k-NN_lapply: Using lapply based algorithm 24 | 25 | # LogitRegression - Logistic Regression 26 | 27 | - LogitRegre_lapply: Using lapply based iterative algorithm 28 | - LogitRegre2_lapply: Using lapply based iterative algorithm from SparkR project 29 | - LogitRegre-1var*.R: the corresponding algorithms for 1 variable analysis 30 | 31 | ## LR - Linear Regression 32 | 33 | - LR.R Using built-in lm function 34 | - LR_lms_lapply.R: LMS(least mean square) lapply based iterative algorithm 35 | - LR_ols_lapply.R: LS(Ordinary Least Squares) lapply based direct method 36 | - LR-1var*.R: the corresponding algorithms for 1 variable analysis 37 | 38 | ## PCA - Principle Component Analysis 39 | 40 | - PCA_lapply.R: Standard direct method based lapply 41 | 42 | ## Pi - Calculating Pi with monte-carlo method 43 | 44 | - Pi_lapply.R: Standard monte-carlo method based on lapply 45 | 46 | -------------------------------------------------------------------------------- /algorithm/k-NN/NN.R: -------------------------------------------------------------------------------- 1 | # Nearest Neighbor - R built-in knn1 based implementation 2 | # 3 | # Author: Haichuan Wang 4 | ############################################################################### 5 | app.name <- "NN" 6 | source('setup_k-NN.R') 7 | library(class) #use built-in knn 8 | 9 | run <- function(dataset) { 10 | 11 | list_train<-dataset$train_set 12 | train_n <- length(list_train) 13 | list_test<-dataset$test_set 14 | test_n <- length(list_test) 15 | clusters<- dataset$clusters 16 | 17 | #change list_train into matrix 18 | train <- t(sapply(list_train, function(item){item$val})) 19 | train_cl <- factor(sapply(list_train, function(item){item$label})) 20 | test <- t(sapply(list_test, function(item){item$val})) 21 | test_cl <- knn1(train, test, train_cl) 22 | 23 | #the raw data 24 | test_labels <- attr(test_cl, "levels") 25 | #finally change the test data to attach the label 26 | out_list_test <- lapply(1:test_n, function(i){ 27 | item<-list_test[[i]] 28 | item$label<- test_labels[test_cl[i]] 29 | item 30 | }) 31 | print(summary(test_cl)) 32 | } 33 | 34 | if (!exists('harness_argc')) { 35 | data <- setup(commandArgs(TRUE)) 36 | run(data) 37 | } 38 | -------------------------------------------------------------------------------- /algorithm/k-NN/NN_lapply.R: -------------------------------------------------------------------------------- 1 | # Nearest Neighbor - lapply based implementation 2 | # 3 | # Author: Haichuan Wang 4 | ############################################################################### 5 | app.name <- "NN_lapply" 6 | source('setup_k-NN.R') 7 | 8 | run <- function(dataset) { 9 | 10 | list_train<-dataset$train_set 11 | train_n <- length(list_train) 12 | list_test<-dataset$test_set 13 | test_n <- length(list_test) 14 | clusters<- dataset$clusters 15 | 16 | #outer loop, map function for each test 17 | NN.fun <- function(test_item) { 18 | #calculate the distance to all 19 | dists.fun <- function(train_item) { 20 | sum((train_item$val - test_item$val)^2) 21 | } 22 | 23 | dists <- lapply(list_train, dists.fun) 24 | #get the which min 25 | min.train <- which.min(dists) 26 | #get the category 27 | test_item$label <- (list_train[[min.train]])$label 28 | test_item 29 | } 30 | 31 | out_list_test <- lapply(list_test, NN.fun) 32 | 33 | #get the cl 34 | test_cl_vec <- sapply(out_list_test, function(test_item){test_item$label}) 35 | test_cl <- factor(test_cl_vec) 36 | print(summary(test_cl)) 37 | } 38 | 39 | if (!exists('harness_argc')) { 40 | data <- setup(commandArgs(TRUE)) 41 | run(data) 42 | } 43 | -------------------------------------------------------------------------------- /algorithm/k-NN/k-NN.R: -------------------------------------------------------------------------------- 1 | # k Nearest Neighbor - R built-in knn1 based implementation 2 | # 3 | # Author: Haichuan Wang 4 | ############################################################################### 5 | app.name <- "k-NN" 6 | source('setup_k-NN.R') 7 | library(class) #use built-in knn 8 | 9 | run <- function(dataset) { 10 | list_train<-dataset$train_set 11 | train_n <- length(list_train) 12 | list_test<-dataset$test_set 13 | test_n <- length(list_test) 14 | clusters<- dataset$clusters 15 | k <- dataset$k 16 | 17 | #change list_train into matrix 18 | train <- t(sapply(list_train, function(item){item$val})) 19 | train_cl <- factor(sapply(list_train, function(item){item$label})) 20 | test <- t(sapply(list_test, function(item){item$val})) 21 | test_cl <- knn(train, test, train_cl, k) 22 | 23 | #the raw data 24 | test_labels <- attr(test_cl, "levels") 25 | #finally change the test data to attach the label 26 | out_list_test <- lapply(1:test_n, function(i){ 27 | item<-list_test[[i]] 28 | item$label<- test_labels[test_cl[i]] 29 | item 30 | }) 31 | print(summary(test_cl)) 32 | } 33 | 34 | 35 | if (!exists('harness_argc')) { 36 | data <- setup(commandArgs(TRUE)) 37 | run(data) 38 | } -------------------------------------------------------------------------------- /algorithm/k-NN/k-NN_lapply.R: -------------------------------------------------------------------------------- 1 | # k Nearest Neighbor - lapply based implementation 2 | # 3 | # Author: Haichuan Wang 4 | ############################################################################### 5 | app.name <- "k-NN_lapply" 6 | source('setup_k-NN.R') 7 | 8 | run <- function(dataset) { 9 | list_train<-dataset$train_set 10 | train_n <- length(list_train) 11 | list_test<-dataset$test_set 12 | test_n <- length(list_test) 13 | clusters<- dataset$clusters 14 | k <- dataset$k 15 | 16 | #outer loop, map function for each test 17 | kNN.fun <- function(test_item) { 18 | #calculate the distance to all 19 | dists.fun <- function(train_item) { 20 | sum((train_item$val - test_item$val)^2) 21 | } 22 | 23 | dists_list <- lapply(list_train, dists.fun) 24 | #change to dists_vec, and do the sorting 25 | dists <- unlist(dists_list) 26 | 27 | mink.indices <-order(dists) 28 | #then should pick the first k items, find t 29 | train_items_indices <- mink.indices[1:k] 30 | 31 | train_items_category <- character(k) 32 | for(i in 1:k) { 33 | train_items_category[i] <- list_train[[train_items_indices[i]]]$label 34 | } 35 | 36 | #now get the their label and vote 37 | test_item$label <- names(which.max(table(train_items_category))) 38 | test_item 39 | } 40 | 41 | ptm <- proc.time() #previous iteration's time 42 | out_list_test <- lapply(list_test, kNN.fun) 43 | 44 | 45 | #get the cl 46 | test_cl <- lapply(out_list_test, function(test_item){test_item$label}) 47 | test_cl <- factor(unlist(test_cl)) 48 | cat("[INFO]Time =", (proc.time()-ptm)[[3]], '\n') 49 | print(summary(test_cl)) 50 | } 51 | 52 | 53 | if (!exists('harness_argc')) { 54 | data <- setup(commandArgs(TRUE)) 55 | run(data) 56 | } -------------------------------------------------------------------------------- /algorithm/k-NN/setup_k-NN.R: -------------------------------------------------------------------------------- 1 | # k-NN/NN - Preparing data set for k-NN/NN 2 | # 3 | # Author: Haichuan Wang 4 | # 5 | # Generate the dataset for k-NN 6 | # train_n: number of train samples 7 | # teats_n: number of test samples 8 | # ncluster: how many ncluster 9 | # A: Mixing matrix 10 | # niter: number of iterations of the ICA algorithm 11 | ############################################################################### 12 | 13 | 14 | setup <- function(args=c('10000', '10000', '10', '5')) { 15 | train_n<-as.integer(args[1]) 16 | if(is.na(train_n)){ train_n <- 10000L } 17 | 18 | test_n<-as.integer(args[2]) 19 | if(is.na(test_n)){ test_n <- 10000L } 20 | 21 | ncluster<-as.integer(args[3]) 22 | if(is.na(ncluster)){ ncluster <- 10L } 23 | 24 | k<-as.integer(args[4]) 25 | if(is.na(k)){ k <- 5L } 26 | 27 | cat('[INFO][', app.name, '] train_n=', train_n, ', test_n=', test_n, ', ncluster=', ncluster, ', k=', k, '\n', sep='') 28 | 29 | #generate training 30 | mean_shift <- rep(0:(ncluster-1), length.out = 3*train_n) 31 | train_set <- matrix(rnorm(3*train_n, sd = ncluster/2) + mean_shift, ncol=3) 32 | list_train_set <- lapply(1:train_n, function(i) { 33 | label_str <-paste('C', as.character(mean_shift[i]), sep="") 34 | list(val=train_set[i,], label=label_str) 35 | }) 36 | 37 | test_set <- matrix(runif(3*test_n, min=-ncluster, max=2*ncluster-1), ncol=3) 38 | list_test_set <- lapply(1:test_n, function(i) { 39 | list(val=test_set[i,]) 40 | }) 41 | 42 | list(train_set=list_train_set, 43 | test_set=list_test_set, 44 | ncluster=ncluster, 45 | k=k) 46 | } -------------------------------------------------------------------------------- /algorithm/k-means/k-means-1D.R: -------------------------------------------------------------------------------- 1 | # k-means-1D - R internal k-means based implementation 2 | # 3 | # Author: Haichuan Wang 4 | # 5 | # k-means-1D using R built-in k-means implementation 6 | ############################################################################### 7 | app.name <- "k-means-1D" 8 | source('setup_k-means-1D.R') 9 | 10 | run <- function(dataset) { 11 | ncluster <- dataset$ncluster 12 | niter <- dataset$niter 13 | Points <- dataset$Points 14 | vPoints <- simplify2array(Points) 15 | 16 | res<-kmeans(vPoints, ncluster, iter.max=niter); 17 | cat("Centers:\n") 18 | print(res$centers); 19 | cat("Sizes:\n") 20 | print(res$size); 21 | } 22 | 23 | if (!exists('harness_argc')) { 24 | data <- setup(commandArgs(TRUE)) 25 | run(data) 26 | } 27 | -------------------------------------------------------------------------------- /algorithm/k-means/k-means-1D_lapply.R: -------------------------------------------------------------------------------- 1 | # k-means-1D - lapply based implementation 2 | # 3 | # Author: Haichuan Wang 4 | # 5 | # k-means-1D using lapply based iterative algorithm 6 | ############################################################################### 7 | app.name <- "k-means-1D_lapply" 8 | source('setup_k-means-1D.R') 9 | 10 | run <- function(dataset) { 11 | ncluster <- dataset$ncluster 12 | niter <- dataset$niter 13 | Points <- dataset$Points 14 | 15 | centers <- Points[1:ncluster] #pick 10 as default centers 16 | size <- integer(ncluster); 17 | 18 | dist.func <- function(ptr){ 19 | dist.inner.func <- function(center){ 20 | (ptr-center)^2 21 | } 22 | lapply(centers, dist.inner.func) 23 | } 24 | 25 | ptm <- proc.time() #previous iteration's time 26 | for(iter in 1:niter) { 27 | #map each item into distance to 10 centers. 28 | dists <- lapply(Points, dist.func) 29 | ids <- lapply(dists, which.min); 30 | #calculate the new centers through mean 31 | for(j in 1:ncluster) { 32 | cur_cluster <- Points[ids==j] 33 | size[j] <- length(cur_cluster) 34 | centers[[j]] <- Reduce('+', cur_cluster) / size[j] 35 | } 36 | ctm <- proc.time() 37 | cat("[INFO]Iter", iter, "Time =", (ctm - ptm)[[3]], '\n') 38 | ptm <- ctm 39 | } 40 | #calculate the distance to the 10 centers 41 | 42 | cat("Centers:\n") 43 | print(centers); 44 | cat("Sizes:\n") 45 | print(size); 46 | } 47 | 48 | if (!exists('harness_argc')) { 49 | data <- setup(commandArgs(TRUE)) 50 | run(data) 51 | } 52 | -------------------------------------------------------------------------------- /algorithm/k-means/k-means-1D_vec.R: -------------------------------------------------------------------------------- 1 | # k-means-1D - vector programming based implementation 2 | # 3 | # Author: Haichuan Wang 4 | # 5 | # k-means-1D using vector programming 6 | ############################################################################### 7 | app.name <- "k-means-1D_vec" 8 | source('setup_k-means-1D.R') 9 | library(vecapply) 10 | 11 | run <- function(dataset) { 12 | ncluster <- dataset$ncluster 13 | niter <- dataset$niter 14 | Points <- dataset$Points 15 | vPoints <- simplify2array(Points) 16 | 17 | centers <- vPoints[1:ncluster] #pick 10 as default centers 18 | size <- integer(ncluster) 19 | ptm <- proc.time() #previous iteration's time 20 | for(iter in 1:niter) { 21 | #map each item into distance to 10 centers. 22 | #tmp_centers <- t(matrix(rep(centers, length(data)), ncol=length(data))) 23 | #dists <- (data -tmp_centers)^2 24 | 25 | dists <- outer(vPoints, centers, function(x,y){(x-y)^2}) 26 | ids <- apply(dists, 1, which.min); 27 | #calculate the new centers through mean 28 | for(j in 1:ncluster) { 29 | cur_cluster <- vPoints[ids==j] 30 | size[j] <- length(cur_cluster) 31 | centers[j] <- mean(cur_cluster) 32 | } 33 | ctm <- proc.time() 34 | cat("[INFO]Iter", iter, "Time =", (ctm - ptm)[[3]], '\n') 35 | ptm <- ctm 36 | } 37 | #calculate the distance to the 10 centers 38 | 39 | cat("Centers:\n") 40 | print(sort(centers)); 41 | cat("Sizes:\n") 42 | print(size); 43 | } 44 | 45 | if (!exists('harness_argc')) { 46 | data <- setup(commandArgs(TRUE)) 47 | run(data) 48 | } 49 | -------------------------------------------------------------------------------- /algorithm/k-means/k-means.R: -------------------------------------------------------------------------------- 1 | # k-means - R internal k-means based implementation 2 | # 3 | # Author: Haichuan Wang 4 | # 5 | # k-means using R built-in k-means implementation 6 | ############################################################################### 7 | app.name <- "k-means" 8 | source('setup_k-means.R') 9 | 10 | run <- function(dataset) { 11 | ncluster <- dataset$ncluster 12 | niter <- dataset$niter 13 | Points <- dataset$Points 14 | vPoints <- t(simplify2array(Points)) 15 | 16 | res<-kmeans(vPoints, ncluster, iter.max=niter); 17 | cat("Centers:\n") 18 | print(res$centers); 19 | cat("Sizes:\n") 20 | print(res$size); 21 | } 22 | 23 | if (!exists('harness_argc')) { 24 | data <- setup(commandArgs(TRUE)) 25 | run(data) 26 | } 27 | -------------------------------------------------------------------------------- /algorithm/k-means/k-means_lapply.R: -------------------------------------------------------------------------------- 1 | # k-means - lapply based implementation 2 | # 3 | # Author: Haichuan Wang 4 | # 5 | # k-means using lapply based iterative algorithm 6 | ############################################################################### 7 | 8 | app.name <- "k-means_lapply" 9 | source('setup_k-means.R') 10 | 11 | run <- function(dataset) { 12 | ncluster <- dataset$ncluster 13 | niter <- dataset$niter 14 | Points <- dataset$Points 15 | 16 | dist.func <- function(ptr){ 17 | dist.inner.func <- function(center){ 18 | sum((ptr-center)^2) 19 | } 20 | lapply(centers, dist.inner.func) 21 | } 22 | 23 | centers <- Points[1:ncluster] #pick 10 as default centers 24 | size <- integer(ncluster) 25 | ptm <- proc.time() #previous iteration's time 26 | for(iter in 1:niter) { 27 | #map each item into distance to 10 centers. 28 | dists <- lapply(Points, dist.func) 29 | ids <- lapply(dists, which.min) 30 | #calculate the new centers through mean 31 | for(j in 1:ncluster) { 32 | cur_cluster <- Points[ids==j] 33 | size[j] <- length(cur_cluster) 34 | centers[[j]] <- Reduce('+', cur_cluster) / size[j] 35 | } 36 | ctm <- proc.time() 37 | cat("[INFO]Iter", iter, "Time =", (ctm - ptm)[[3]], '\n') 38 | ptm <- ctm 39 | } 40 | #calculate the distance to the 10 centers 41 | 42 | cat("Centers:\n") 43 | print(centers); 44 | cat("Sizes:\n") 45 | print(size); 46 | } 47 | 48 | if (!exists('harness_argc')) { 49 | data <- setup(commandArgs(TRUE)) 50 | run(data) 51 | } 52 | -------------------------------------------------------------------------------- /algorithm/k-means/k-means_vec.R: -------------------------------------------------------------------------------- 1 | # k-means - vector programming based implementation 2 | # 3 | # Author: Haichuan Wang 4 | # 5 | # k-means using vector programming 6 | ############################################################################### 7 | 8 | app.name <- "k-means_vec" 9 | source('setup_k-means.R') 10 | library(vecapply) 11 | 12 | run <- function(dataset) { 13 | ncluster <- dataset$ncluster 14 | niter <- dataset$niter 15 | Points <- dataset$Points 16 | vPoints <- t(simplify2array(Points)) # n * ndim matrix 17 | 18 | centers <- vPoints[1:ncluster, ] #pick 10 as default centers 19 | size <- integer(ncluster); 20 | n <- nrow(vPoints) 21 | dists <- matrix(0, nrow=n, ncol=ncluster) #pre-allocate memory 22 | ptm <- proc.time() #previous iteration's time 23 | for(iter in 1:niter) { 24 | #need calculate each points' distance to all centers 25 | #try to use vec as much as possible 26 | for(j in 1:ncluster) { 27 | center_expand <- matrix(rep(centers[j,], each=n), n, 3) 28 | dists[,j] = rowSums((vPoints - center_expand)^2) 29 | } 30 | #map each item into distance to 10 centers. 31 | ids <- apply(dists, 1, which.min) 32 | #calculate the new centers through mean 33 | for(j in 1:ncluster) { 34 | cur_cluster <- vPoints[ids==j, ] 35 | size[j] <- nrow(cur_cluster) 36 | centers[j,] <- colMeans(cur_cluster) 37 | } 38 | ctm <- proc.time() 39 | cat("[INFO]Iter", iter, "Time =", (ctm - ptm)[[3]], '\n') 40 | ptm <- ctm 41 | } 42 | #calculate the distance to the 10 centers 43 | 44 | cat("Centers:\n") 45 | print(centers); 46 | cat("Sizes:\n") 47 | print(size); 48 | } 49 | 50 | if (!exists('harness_argc')) { 51 | data <- setup(commandArgs(TRUE)) 52 | run(data) 53 | } 54 | -------------------------------------------------------------------------------- /algorithm/k-means/setup_k-means-1D.R: -------------------------------------------------------------------------------- 1 | # k-means-1D - Preparing dataset for k-means-1D 2 | # 3 | # Author: Haichuan Wang 4 | # 5 | # Generate the dataset for k-means 6 | # n: number of the points 7 | # ncluster: number of the clusters 8 | # niter: number of the iterations 9 | # Points: the samples 10 | ############################################################################### 11 | 12 | setup <- function(args=c('1000000', '10', '15')) { 13 | n<-as.integer(args[1]) 14 | if(is.na(n)){ n <- 1000000L } 15 | 16 | ncluster<-as.integer(args[3]) 17 | if(is.na(ncluster)){ ncluster <- 10L } 18 | 19 | niter<-as.integer(args[3]) 20 | if(is.na(niter)){ niter <- 15L } 21 | 22 | cat('[INFO][', app.name, '] n=', n, ', ncluster=', ncluster, ', niter=', niter, '\n', sep='') 23 | 24 | #the data, each is 25 | mean_shift <- rep(0:(ncluster-1), length.out = n) 26 | Points <- rnorm(n, sd = 0.3) + mean_shift 27 | Points <- lapply(1:n, function(i){Points[i]}) 28 | 29 | return(list(Points=Points, ncluster=ncluster, niter=niter)) 30 | } -------------------------------------------------------------------------------- /algorithm/k-means/setup_k-means.R: -------------------------------------------------------------------------------- 1 | # k-means - Preparing dataset for k-means 2 | # 3 | # Author: Haichuan Wang 4 | # 5 | # Generate the dataset for k-means 6 | # n: number of the points 7 | # ndim: number of the dimensions of the sample. e.g. ndim=3, 3D points 8 | # ncluster: number of the clusters 9 | # niter: number of the iterations 10 | # Points: the samples 11 | ############################################################################### 12 | 13 | 14 | 15 | 16 | setup <- function(args=c('1000000', '3', '10', '15')) { 17 | n<-as.integer(args[1]) 18 | if(is.na(n)){ n <- 1000000L } 19 | 20 | ndim<-as.integer(args[2]) 21 | if(is.na(ndim)){ ndim <- 3L } 22 | 23 | ncluster<-as.integer(args[3]) 24 | if(is.na(ncluster)){ ncluster <- 10L } 25 | 26 | niter<-as.integer(args[4]) 27 | if(is.na(niter)){ niter <- 15L } 28 | 29 | cat('[INFO][', app.name, '] n=', n, ', ndim=', ndim, ', ncluster=', ncluster, ', niter=', niter, '\n', sep='') 30 | 31 | #the data, each is 32 | mean_shift <- rep(0:(ncluster-1), length.out = ndim*n) 33 | Points <- matrix(rnorm(ndim*n, sd = 0.3) + mean_shift, ncol=ndim) 34 | #now change data into list structure 35 | Points <- lapply(1:n, function(i) Points[i,]) 36 | 37 | list(Points=Points, ndim<- ndim, ncluster=ncluster, niter=niter) 38 | } -------------------------------------------------------------------------------- /common.mk: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | R_CMD=$(R_HOME)/bin/Rscript 5 | R_FLAG = --vanilla 6 | RBASE_ENV=R_COMPILE_PKGS=0 R_ENABLE_JIT=0 7 | RBYTECODE_ENV=R_COMPILE_PKGS=1 R_ENABLE_JIT=2 8 | 9 | TERR_CMD=$(TERR_HOME)/bin/TERR 10 | 11 | R_HARNESS=${LEVEL}/utility/r_harness.R 12 | ifndef REP 13 | REP=1 14 | endif 15 | 16 | #How many times a perf measurement is done 17 | PERF_REP=1 18 | PERF_TMP=_perf.tmp 19 | PERF_CMD=perf stat -r $(PERF_REP) -x, -o $(PERF_TMP) --append 20 | PERF_WARM_REP=2 21 | PERF_TOTAL_REP=7 22 | PERF_REPORT_CMD=python ${LEVEL}/utility/perfreport.py 23 | 24 | default: base 25 | 26 | base: ${PROG}.base 27 | 28 | bytecode: ${PROG}.bytecode 29 | 30 | baseperf: ${PROG}.baseperf 31 | 32 | bytecodeperf: ${PROG}.bytecodeperf 33 | 34 | terrperf: ${PROG}.terrperf 35 | 36 | %.base: %.R 37 | ${RBASE_ENV} ${R_CMD} ${R_FLAG} ${R_HARNESS} FALSE ${REP} $< ${PARA} 38 | 39 | %.bytecode: %.R 40 | ${RBYTECODE_ENV} ${R_CMD} ${R_FLAG} ${R_HARNESS} TRUE ${REP} $< ${PARA} 41 | 42 | %.terr: %.R 43 | ${TERR_CMD} -f ${R_HARNESS} --args FALSE ${REP} $< ${PARA} 44 | 45 | %.baseperf: %.R 46 | @echo ${PERF_WARM_REP} > ${PERF_TMP} 47 | ${RBASE_ENV} ${PERF_CMD} ${R_CMD} ${R_FLAG} ${R_HARNESS} FALSE ${PERF_WARM_REP} $< ${PARA} 48 | @echo ${PERF_TOTAL_REP} >> ${PERF_TMP} 49 | ${RBASE_ENV} ${PERF_CMD} ${R_CMD} ${R_FLAG} ${R_HARNESS} FALSE ${PERF_WARM_REP} $< ${PARA} 50 | ${PERF_REPORT_CMD} < $(PERF_TMP) 51 | @rm -f $(PERF_TMP) 52 | 53 | %.bytecodeperf: %.R 54 | @echo ${PERF_WARM_REP} > ${PERF_TMP} 55 | ${RBYTECODE_ENV} ${PERF_CMD} ${R_CMD} ${R_FLAG} ${R_HARNESS} $< ${PERF_WARM_REP} ${PARA} 56 | @echo ${PERF_TOTAL_REP} >> ${PERF_TMP} 57 | ${RBYTECODE_ENV} ${PERF_CMD} ${R_CMD} ${R_FLAG} ${R_HARNESS} $< ${PERF_TOTAL_REP} ${PARA} 58 | ${PERF_REPORT_CMD} < $(PERF_TMP) 59 | @rm -f $(PERF_TMP) 60 | 61 | 62 | %.terrperf: %.R 63 | @echo ${PERF_WARM_REP} > ${PERF_TMP} 64 | ${PERF_CMD} ${TERR_CMD} -f ${R_HARNESS} --args FALSE ${PERF_WARM_REP} $< ${PARA} 65 | @echo ${PERF_TOTAL_REP} >> ${PERF_TMP} 66 | ${PERF_CMD} ${TERR_CMD} -f ${R_HARNESS} --args FALSE ${PERF_TOTAL_REP} $< ${PARA} 67 | ${PERF_REPORT_CMD} < $(PERF_TMP) 68 | @rm -f $(PERF_TMP) -------------------------------------------------------------------------------- /docs/writting_benchmark.md: -------------------------------------------------------------------------------- 1 | # Writing a R benchmark program 2 | 3 | ## Basic Structure 4 | 5 | A benchmark R program should have a mandatory run() function. The driver will call run() function in the benchmarking. 6 | ``` 7 | #hello_rbenchmark.R 8 | run <- function () { 9 | print("Executing hello_rbenchmark run()") 10 | } 11 | ``` 12 | 13 | The benchmark R program could have an optional setup() function. The driver will call setup() first, then use the return value of the setup() to call the run(). 14 | ``` 15 | #hello_rbenchmark.R 16 | 17 | setup <- function(cmdline_args=character(0)) { 18 | return(cmdline_args) 19 | } 20 | 21 | run <- function (input) { 22 | print("Executing hello_rbenchmark run() with input") 23 | print(input) 24 | } 25 | ``` 26 | 27 | ## The Harness R program 28 | 29 | The benchmark harness is like rbench.py -> r_harness.R -> yourProg.R. 30 | - rbench.py: setup the environments, preprocess command lines, and post process output 31 | - r_harness.R: load your benchmark program, and execute it 32 | 33 | The harness code (r_harness.R) 34 | ``` 35 | #code snippet in r_harness.R 36 | bench_args <- ... # the benchmark args from command line. 37 | #If no args passed in, bench_args is just character(0) 38 | 39 | if(exists('setup')) { 40 | if(length(bench_args) == 0) { 41 | bench_args <- setup() 42 | } else { 43 | bench_args <- setup(bench_args) 44 | } 45 | } 46 | 47 | if(length(bench_args) == 0) { 48 | for(bench_i in 1:bench_reps) { run() } 49 | } else { 50 | for(bench_i in 1:bench_reps) { run(bench_args) } 51 | } 52 | ``` 53 | 54 | So you can put the code for parsing command line arguments and preparing dataset in the setup() function. 55 | Then harness will first call the setup(), then call the run() for several times. 56 | 57 | ## Adding default execute routine 58 | 59 | If you want to run your application with 60 | ```bash 61 | $ Rscript yourProg.R 62 | ``` 63 | 64 | you can add the default wrapper in yourProg.R, like this 65 | ``` 66 | run <- function { ... } 67 | 68 | if (!exists('harness_argc')) { 69 | run() 70 | } 71 | ``` 72 | 73 | Or with argument processing in the setup() 74 | ``` 75 | setup <- function(cmdline_args=character(0)) { ... } 76 | 77 | run <- function (input) { ... } 78 | 79 | if (!exists('harness_argc')) { 80 | input = setup(commandArgs(TRUE)) 81 | run(input) 82 | } 83 | ``` 84 | 85 | Because the r\_harness.R will define harness\_argc variable, the default execution routine will be ignored by the benchmark harness. 86 | -------------------------------------------------------------------------------- /example/Makefile: -------------------------------------------------------------------------------- 1 | LEVEL = .. 2 | 3 | include $(LEVEL)/common.mk 4 | -------------------------------------------------------------------------------- /example/hello_rbenchmark.R: -------------------------------------------------------------------------------- 1 | 2 | # setup() function is optional. 3 | setup <- function(cmdline_args=character(0)){ 4 | print("Executing hello_rbenchmark setup() with input:") 5 | print(cmdline_args) 6 | return(cmdline_args) 7 | } 8 | 9 | run <- function(input='No input') { 10 | print("Executing hello_rbenchmark run() with input") 11 | print(input) 12 | } 13 | 14 | 15 | if (!exists('harness_argc')) { 16 | input = commandArgs(TRUE) 17 | input = setup(input) # optional 18 | run(input) 19 | } -------------------------------------------------------------------------------- /mathkernel/DoubleNAVecAdd-T1.R: -------------------------------------------------------------------------------- 1 | # Vector Add 2 | # 3 | ############################################################################### 4 | 5 | setup = function(args='10000000') { 6 | n <- as.integer(args[1]) 7 | if(is.na(n)){ n <- 10000000 } 8 | 9 | cat("Vector Add two", n, "size vectors(10% NA), iterative method\n"); 10 | 11 | A <- rnorm(n) 12 | B <- rnorm(n) 13 | idx <- runif(n*0.1, 1, n) #10% are NA 14 | A[idx] <- NA 15 | idx <- runif(n*0.1, 1, n) #10% are NA 16 | B[idx] <- NA 17 | list(A, B, n) 18 | } 19 | 20 | 21 | 22 | run <- function(data) { 23 | #a and b are matrix 24 | A <- data[[1]] 25 | B <- data[[2]] 26 | n <- data[[3]] 27 | C <- vector('double', n) 28 | for(i in 1:n) { 29 | C[i] = A[i] + B[i] 30 | } 31 | C 32 | } -------------------------------------------------------------------------------- /mathkernel/DoubleNAVecAdd-T2.R: -------------------------------------------------------------------------------- 1 | # Vector Add 2 | # 3 | ############################################################################### 4 | 5 | setup = function(args='10000000') { 6 | n <- as.integer(args[1]) 7 | if(is.na(n)){ n <- 10000000 } 8 | 9 | cat("Vector Add two", n, "size vectors(10% NA), built-in +\n"); 10 | 11 | A <- rnorm(n) 12 | B <- rnorm(n) 13 | idx <- runif(n*0.1, 1, n) #10% are NA 14 | A[idx] <- NA 15 | idx <- runif(n*0.1, 1, n) #10% are NA 16 | B[idx] <- NA 17 | list(A, B, n) 18 | } 19 | 20 | 21 | 22 | run = function(data) { 23 | #a and b are matrix 24 | A <- data[[1]] 25 | B <- data[[2]] 26 | n <- data[[3]] 27 | C <- A + B 28 | } -------------------------------------------------------------------------------- /mathkernel/DoubleVecAdd-T1.R: -------------------------------------------------------------------------------- 1 | # Vector Add 2 | # 3 | ############################################################################### 4 | 5 | setup = function(args='10000000') { 6 | n <- as.integer(args[1]) 7 | if(is.na(n)){ n <- 10000000 } 8 | 9 | cat("Vector Add two", n, "size vectors, iterative method\n"); 10 | 11 | A <- rnorm(n) 12 | B <- rnorm(n) 13 | 14 | list(A, B, n) 15 | } 16 | 17 | 18 | 19 | run <- function(data) { 20 | #a and b are matrix 21 | A <- data[[1]] 22 | B <- data[[2]] 23 | n <- data[[3]] 24 | C <- vector('double', n) 25 | for(i in 1:n) { 26 | C[i] = A[i] + B[i] 27 | } 28 | C 29 | } -------------------------------------------------------------------------------- /mathkernel/DoubleVecAdd-T2.R: -------------------------------------------------------------------------------- 1 | # Vector Add 2 | # 3 | ############################################################################### 4 | 5 | setup = function(args='10000000') { 6 | n <- as.integer(args[1]) 7 | if(is.na(n)){ n <- 10000000 } 8 | 9 | cat("Vector Add two", n, "size vectors, built-in +\n"); 10 | 11 | A <- rnorm(n) 12 | B <- rnorm(n) 13 | 14 | list(A, B, n) 15 | } 16 | 17 | 18 | 19 | run = function(data) { 20 | #a and b are matrix 21 | A <- data[[1]] 22 | B <- data[[2]] 23 | n <- data[[3]] 24 | C <- A + B 25 | } -------------------------------------------------------------------------------- /mathkernel/IntNAVecAdd-T1.R: -------------------------------------------------------------------------------- 1 | # Vector Add 2 | # 3 | ############################################################################### 4 | 5 | setup = function(args='10000000') { 6 | n <- as.integer(args[1]) 7 | if(is.na(n)){ n <- 10000000 } 8 | 9 | cat("Vector Add two integer", n, "size vectors(10% NA), iterative method\n"); 10 | 11 | A <- as.integer(rnorm(n) * 1000) 12 | B <- as.integer(rnorm(n) * 1000) 13 | idx <- runif(n*0.1, 1, n) #10% are NA 14 | A[idx] <- NA 15 | idx <- runif(n*0.1, 1, n) #10% are NA 16 | B[idx] <- NA 17 | list(A, B, n) 18 | } 19 | 20 | 21 | 22 | run <- function(data) { 23 | #a and b are matrix 24 | A <- data[[1]] 25 | B <- data[[2]] 26 | n <- data[[3]] 27 | C <- vector('double', n) 28 | for(i in 1:n) { 29 | C[i] = A[i] + B[i] 30 | } 31 | C 32 | } -------------------------------------------------------------------------------- /mathkernel/IntNAVecAdd-T2.R: -------------------------------------------------------------------------------- 1 | # Vector Add 2 | # 3 | ############################################################################### 4 | 5 | setup = function(args='10000000') { 6 | n <- as.integer(args[1]) 7 | if(is.na(n)){ n <- 10000000 } 8 | 9 | cat("Vector Add two integer", n, "size vectors(10% NA), built-in +\n"); 10 | 11 | A <- as.integer(rnorm(n) * 1000) 12 | B <- as.integer(rnorm(n) * 1000) 13 | idx <- runif(n*0.1, 1, n) #10% are NA 14 | A[idx] <- NA 15 | idx <- runif(n*0.1, 1, n) #10% are NA 16 | B[idx] <- NA 17 | list(A, B, n) 18 | } 19 | 20 | 21 | 22 | run = function(data) { 23 | #a and b are matrix 24 | A <- data[[1]] 25 | B <- data[[2]] 26 | n <- data[[3]] 27 | C <- A + B 28 | } -------------------------------------------------------------------------------- /mathkernel/IntVecAdd-T1.R: -------------------------------------------------------------------------------- 1 | # Vector Add 2 | # 3 | ############################################################################### 4 | 5 | setup = function(args='10000000') { 6 | n <- as.integer(args[1]) 7 | if(is.na(n)){ n <- 10000000 } 8 | 9 | cat("Vector Add two integer", n, "size vectors, iterative method\n"); 10 | 11 | A <- as.integer(rnorm(n) * 1000) 12 | B <- as.integer(rnorm(n) * 1000) 13 | 14 | list(A, B, n) 15 | } 16 | 17 | 18 | 19 | run <- function(data) { 20 | #a and b are matrix 21 | A <- data[[1]] 22 | B <- data[[2]] 23 | n <- data[[3]] 24 | C <- vector('double', n) 25 | for(i in 1:n) { 26 | C[i] = A[i] + B[i] 27 | } 28 | C 29 | } -------------------------------------------------------------------------------- /mathkernel/IntVecAdd-T2.R: -------------------------------------------------------------------------------- 1 | # Vector Add 2 | # 3 | ############################################################################### 4 | 5 | setup = function(args='10000000') { 6 | n <- as.integer(args[1]) 7 | if(is.na(n)){ n <- 10000000 } 8 | 9 | cat("Vector Add two integer", n, "size vectors, built-in +\n"); 10 | 11 | A <- as.integer(rnorm(n) * 1000) 12 | B <- as.integer(rnorm(n) * 1000) 13 | 14 | list(A, B, n) 15 | } 16 | 17 | 18 | 19 | run = function(data) { 20 | #a and b are matrix 21 | A <- data[[1]] 22 | B <- data[[2]] 23 | n <- data[[3]] 24 | C <- A + B 25 | } -------------------------------------------------------------------------------- /mathkernel/MMM-T1.R: -------------------------------------------------------------------------------- 1 | # Matrix-Matrix Multiply 2 | # 3 | ############################################################################### 4 | 5 | setup = function(args='200') { 6 | n <- as.integer(args[1]) 7 | if(is.na(n)){ n <- 200 } 8 | 9 | cat("Matrix-Matrix Multiply of two", n, "x", n, "matrices, iterative method\n"); 10 | 11 | A <- matrix(rnorm(n*n), ncol=n, nrow=n) 12 | B <- matrix(rnorm(n*n), ncol=n, nrow=n) 13 | 14 | list(A,B, n) 15 | } 16 | 17 | 18 | 19 | run <- function(data) { 20 | #a and b are matrix 21 | A <- data[[1]] 22 | B <- data[[2]] 23 | n <- data[[3]] 24 | C <- matrix(n*n, ncol=n, nrow=n) 25 | for(i in 1:n) { 26 | for(j in 1:n) { 27 | v <- 0 28 | for(k in 1:n) { 29 | v <- v + A[i,k] * B[k,j] 30 | } 31 | C[i,j] = v 32 | } 33 | } 34 | C 35 | } -------------------------------------------------------------------------------- /mathkernel/MMM-T2.R: -------------------------------------------------------------------------------- 1 | # Matrix-Matrix Multiply 2 | # 3 | ############################################################################### 4 | 5 | setup = function(args='200') { 6 | n <- as.integer(args[1]) 7 | if(is.na(n)){ n <- 200 } 8 | 9 | cat("Matrix-Matrix Multiply of two", n, "x", n, "matrices, vector method\n"); 10 | 11 | A <- matrix(rnorm(n*n), ncol=n, nrow=n) 12 | B <- matrix(rnorm(n*n), ncol=n, nrow=n) 13 | 14 | list(A,B, n) 15 | } 16 | 17 | 18 | 19 | run = function(data) { 20 | #a and b are matrix 21 | A <- data[[1]] 22 | B <- data[[2]] 23 | n <- data[[3]] 24 | C <- matrix(n*n, ncol=n, nrow=n) 25 | for(i in 1:n) { 26 | for(j in 1:n) { 27 | C[i,j] = A[i,] %*% B[,j] 28 | } 29 | } 30 | C 31 | } -------------------------------------------------------------------------------- /mathkernel/MMM-T3.R: -------------------------------------------------------------------------------- 1 | # Matrix-Matrix Multiply 2 | # 3 | ############################################################################### 4 | 5 | setup = function(args='200') { 6 | n <- as.integer(args[1]) 7 | if(is.na(n)){ n <- 200 } 8 | 9 | cat("Matrix-Matrix Multiply of two", n, "x", n, "matrices, built-in %*%\n"); 10 | 11 | A <- matrix(rnorm(n*n), ncol=n, nrow=n) 12 | B <- matrix(rnorm(n*n), ncol=n, nrow=n) 13 | 14 | list(A,B, n) 15 | } 16 | 17 | 18 | 19 | run <- function(data) { 20 | #a and b are matrix 21 | A <- data[[1]] 22 | B <- data[[2]] 23 | n <- data[[3]] 24 | C <- A %*% B 25 | } -------------------------------------------------------------------------------- /mathkernel/README.md: -------------------------------------------------------------------------------- 1 | # Math Kernels 2 | 3 | A few simple math kernels, such as matrix-matrix multiply, vector add, etc.. 4 | 5 | The suffix of the name is defined as 6 | - -T1: scalar implementation, Type I code 7 | - -I2: vector implementation, Type II code 8 | - -T3: library/runtime function call, Type III code 9 | 10 | - DoubleVecAdd-T?.R: vector add, double type 11 | - DoubleNAVecAdd-T?.R: vector add, double type, 10% numbers are NA 12 | - IntVecAdd-T?.R: vector add, integer type 13 | - IntNAVecAdd-T?.R: vector add, integer type, 10% numbers are NA 14 | - MMM-T?.R: matrix matrix multiply 15 | -------------------------------------------------------------------------------- /misc/2DRandomWalk/rw2d1.R: -------------------------------------------------------------------------------- 1 | # 2D Random Walk, scalar version 2 | # src: https://www.stat.auckland.ac.nz/~ihaka/downloads/Taupo-handouts.pdf 3 | # Author: Ross Ihaka 4 | ############################################################################### 5 | 6 | 7 | setup <- function(args='100000') { 8 | n<-as.integer(args[1]) 9 | if(is.na(n)){ n <- 100000 } 10 | return(n) 11 | } 12 | 13 | run = function(n = 100000) { 14 | xpos = ypos = numeric(n) 15 | for(i in 2:n) { 16 | # Decide whether we are moving horizontally or vertically. 17 | delta = if(runif(1) > .5) 1 else -1 18 | if (runif(1) > .5) { 19 | xpos[i] = xpos[i-1] + delta 20 | ypos[i] = ypos[i-1] 21 | } 22 | else { 23 | xpos[i] = xpos[i-1] 24 | ypos[i] = ypos[i-1] + delta 25 | } 26 | } 27 | list(x = xpos, y = ypos) 28 | } 29 | 30 | 31 | 32 | if (!exists('harness_argc')) { 33 | n <- setup(commandArgs(TRUE)) 34 | run(n) 35 | } 36 | 37 | -------------------------------------------------------------------------------- /misc/2DRandomWalk/rw2d2.R: -------------------------------------------------------------------------------- 1 | # 2D Random Walk, vector version 2 | # src: https://www.stat.auckland.ac.nz/~ihaka/downloads/Taupo-handouts.pdf 3 | # Author: Ross Ihaka 4 | ############################################################################### 5 | 6 | 7 | setup <- function(args='100000') { 8 | n<-as.integer(args[1]) 9 | if(is.na(n)){ n <- 100000 } 10 | return(n) 11 | } 12 | 13 | run<-function(n = 100000) { 14 | steps = sample(c(-1,1), n -1, replace = TRUE) 15 | xdir = sample(c(TRUE,FALSE), n - 1, replace = TRUE) 16 | xpos = c(0, cumsum(ifelse(xdir, steps, 0))) 17 | ypos = c(0, cumsum(ifelse(xdir, 0, steps))) 18 | list(x = xpos, y = ypos) 19 | } 20 | 21 | 22 | 23 | if (!exists('harness_argc')) { 24 | n <- setup(commandArgs(TRUE)) 25 | run(n) 26 | } 27 | 28 | -------------------------------------------------------------------------------- /misc/2DRandomWalk/rw2d3.R: -------------------------------------------------------------------------------- 1 | # 2D Random Walk, optimized vector version 2 | # src: https://www.stat.auckland.ac.nz/~ihaka/downloads/Taupo-handouts.pdf 3 | # Author: Ross Ihaka 4 | ############################################################################### 5 | 6 | 7 | setup <- function(args='100000') { 8 | n<-as.integer(args[1]) 9 | if(is.na(n)){ n <- 100000 } 10 | return(n) 11 | } 12 | 13 | run<-function(n = 100000) { 14 | xsteps = c(-1, 1, 0, 0) 15 | ysteps = c(0, 0, -1, 1) 16 | dir = sample(1:4, n - 1, replace = TRUE) 17 | xpos = c(0, cumsum(xsteps[dir])) 18 | ypos = c(0, cumsum(ysteps[dir])) 19 | list(x = xpos, y = ypos) 20 | } 21 | 22 | 23 | 24 | if (!exists('harness_argc')) { 25 | n <- setup(commandArgs(TRUE)) 26 | run(n) 27 | } 28 | 29 | -------------------------------------------------------------------------------- /misc/README.md: -------------------------------------------------------------------------------- 1 | # Misc Collections 2 | 3 | ## 2D Random Walk 4 | 5 | From https://www.stat.auckland.ac.nz/~ihaka/downloads/Taupo-handouts.pdf 6 | Also used in Rllvm http://www.omegahat.org/Rllvm/rw2d.html performance measurement. 7 | 8 | Three implementations 9 | - rw2d1.R scalar version, Type I code 10 | - rw2d2.R vector version, Type II code 11 | - rw2d3.R optimized vector version, Type III code -------------------------------------------------------------------------------- /riposte/Makefile: -------------------------------------------------------------------------------- 1 | LEVEL = ../.. 2 | 3 | PARA= 4 | 5 | include $(LEVEL)/common.mk 6 | 7 | 8 | 9 | -------------------------------------------------------------------------------- /riposte/README.md: -------------------------------------------------------------------------------- 1 | = Riposte Benchmark = 2 | 3 | Ported from https://github.com/jtalbot/riposte/tree/master/benchmarks/pact 4 | The original author is Justin Talbot. 5 | 6 | The benchmarks were slightly modified to follow rbenchmark's interface, and they can take input size argument now. 7 | 8 | == Run the benchmark == 9 | 10 | You need first generate the benchmark input data set using with GNU R 11 | - gen_kmeans.R 12 | - gen_lr.R 13 | - gen_pca.R 14 | 15 | Note: Please install *clusterGeneration* before run the above scripts. 16 | ```R 17 | install.packages('clusterGeneration') 18 | ``` 19 | 20 | All the benchmarks can be run standalonely or with rbench.py 21 | ```bash 22 | $ Rscript black_scholes.R 23 | $ rbench.py black_scholes.R 24 | ``` 25 | 26 | == Known Issues == 27 | - qr.R doesn't work. Missing strip() function 28 | - tpc.R doesn't work 29 | -------------------------------------------------------------------------------- /riposte/black_scholes.R: -------------------------------------------------------------------------------- 1 | #adapted from https://github.com/ispc/ispc/tree/master/examples/options 2 | #changed by hwang154@illinois.edu 3 | # 1) according to the test harness 4 | # 2) remove global variable lookup 5 | 6 | setup<-function(args='100000') { 7 | N_OPTIONS<-as.integer(args[1]) 8 | if(is.na(N_OPTIONS)){ N_OPTIONS <- 100000L } 9 | 10 | cat('[black_scholes]N_OPTIONS =', N_OPTIONS, '\n') 11 | 12 | 13 | S <- rep(100,each=N_OPTIONS) 14 | X <- rep(98,each=N_OPTIONS) 15 | TT <- rep(2,each=N_OPTIONS) 16 | r <- rep(.02,each=N_OPTIONS) 17 | v <- rep(5,each=N_OPTIONS) 18 | force(S) 19 | force(X) 20 | force(TT) 21 | force(r) 22 | force(v) 23 | 24 | list(S,X,TT,r,v,N_OPTIONS) 25 | } 26 | 27 | run <- function(dataset) { 28 | S<-dataset[[1]] 29 | X<-dataset[[2]] 30 | TT<-dataset[[3]] 31 | r<-dataset[[4]] 32 | v<-dataset[[5]] 33 | N_OPTIONS<-dataset[[6]] 34 | 35 | N_ROUNDS <- 1000 36 | 37 | log10 <- log(10) 38 | invSqrt2Pi <- 0.39894228040 39 | 40 | CND <- function(X) { 41 | k <- 1.0 / (1.0 + 0.2316419 * abs(X)) 42 | w <- (((((1.330274429*k) - 1.821255978)*k + 1.781477937)*k - 0.356563782)*k + 0.31938153)*k 43 | xx <- X * X * -.5 44 | w <- w * invSqrt2Pi * exp(xx) 45 | w <- ifelse(X > 0,1 - w,w) 46 | #Xgt0 <- X > 0 47 | #w[Xgt0] <- (1-w)[Xgt0] 48 | #w 49 | } 50 | 51 | black_scholes <- function() { 52 | delta <- v * sqrt(TT) 53 | sx <- S/X 54 | d1 <- (log(sx)/log10 + (r + v * v * .5) * TT) / delta 55 | d2 <- d1 - delta 56 | rt<--r * TT 57 | s<-S * CND(d1) - X * exp(rt) * CND(d2) 58 | sum(s) 59 | } 60 | #bench part 61 | acc <- 0 62 | for(i in 1:N_ROUNDS) { 63 | acc <- acc + black_scholes() 64 | } 65 | acc <- acc / (N_ROUNDS * N_OPTIONS) 66 | cat(acc,'\n') 67 | } 68 | 69 | if (!exists('harness_argc')) { 70 | dataset <- setup(commandArgs(TRUE)) 71 | run(dataset) 72 | } 73 | -------------------------------------------------------------------------------- /riposte/cleaning.R: -------------------------------------------------------------------------------- 1 | 2 | #changed by hwang154@illinois.edu 3 | # 1) according to the test harness 4 | # 2) remove global variable lookup 5 | 6 | setup<-function(args='20000000') { 7 | n<-as.integer(args[1]) 8 | if(is.na(n)){ n=20000000L } 9 | 10 | cat('[cleaning]n =', n, '\n') 11 | 12 | data <- as.double(1:n) 13 | force(data) 14 | data 15 | } 16 | 17 | 18 | run<-function(data) { 19 | 20 | z.score <- function(data, m=mean(data), stdev=sd(data)) { 21 | # these two lines force the promises, allowing us to fuse m and stdev 22 | # otherwise they are separated by the barrier (data-m), and don't fuse. 23 | # can we do better? 24 | #m 25 | #stdev 26 | (data-m) / stdev 27 | } 28 | 29 | outliers <- function(data, ignore) { 30 | use <- !ignore(data) 31 | z <- z.score(data, mean(data[use]), sd(data[use])) 32 | sum(abs(z) > 1) 33 | } 34 | 35 | #bench part 36 | r<-outliers(data, function(x) { is.na(x) | x==9999 }) 37 | cat(r,'\n'); 38 | } 39 | 40 | if (!exists('harness_argc')) { 41 | dataset <- setup(commandArgs(TRUE)) 42 | run(dataset) 43 | } -------------------------------------------------------------------------------- /riposte/example.R: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | setup<-function(args='20000000') { 5 | n<-as.integer(args[1]) 6 | if(is.na(n)){ n=20000000 } 7 | cat('[example]n =', n, '\n') 8 | 9 | data <- list( 10 | as.double(1:n), 11 | as.double(1:n) 12 | ) 13 | data 14 | } 15 | 16 | 17 | run<-function(data) { 18 | bin <- function(x) { ifelse(x > 0, 1, ifelse(x < 0, -1, 0)) } 19 | ignore <- function(x) { is.na(x) | x == 9999 } 20 | 21 | clean <- function(data) { 22 | data[[2]][!ignore(data[[1]]) & bin(data[[1]]) == 1] 23 | } 24 | 25 | r <- mean(clean(data)) 26 | cat(r,'\n') 27 | } 28 | 29 | 30 | if (!exists('harness_argc')) { 31 | dataset <- setup(commandArgs(TRUE)) 32 | run(dataset) 33 | } 34 | 35 | -------------------------------------------------------------------------------- /riposte/filter1d.R: -------------------------------------------------------------------------------- 1 | 2 | # tests subsetting vector and vector length changing in first iteration of the loop 3 | 4 | 5 | setup<-function(args='10000000') { 6 | n<-as.integer(args[1]) 7 | if(is.na(n)){ n=10000000L } 8 | cat('[filter1d]n =', n, '\n') 9 | a <- runif(n); 10 | force(a); 11 | a; 12 | } 13 | 14 | run<-function(a) { 15 | 16 | filter <- function(v, f) { 17 | r <- 0 18 | for(i in 1L:length(f)) { 19 | r <- r + v[(1L+i): ((length(v)-length(f))+i)]*f[i] 20 | } 21 | r 22 | } 23 | 24 | #filter(a, c(0.1,0.15,0.2,0.3,0.2,0.15,0.1)) 25 | res<-filter(a, c(0.1,0.15,0.2,0.3,0.2,0.15,0.1)); 26 | r<-length(res); 27 | cat(r,'\n'); 28 | } 29 | 30 | if (!exists('harness_argc')) { 31 | dataset <- setup(commandArgs(TRUE)) 32 | run(dataset) 33 | } -------------------------------------------------------------------------------- /riposte/gen_kmeans.R: -------------------------------------------------------------------------------- 1 | 2 | N <- 1000000L 3 | K <- 5L 4 | 5 | library(MASS) 6 | 7 | a <- rbind( 8 | mvrnorm(N/5,c(0,0), matrix(c(1,0,0,1), 2,2)), 9 | mvrnorm(N/5,c(4,0), matrix(c(0.5,0,0,0.5), 2,2)), 10 | mvrnorm(N/5,c(0,4), matrix(c(1,0,0,1), 2,2)), 11 | mvrnorm(N/5,c(2,2), matrix(c(0.25,0.2,0.2,0.25), 2,2)), 12 | mvrnorm(N/5,c(1,0), matrix(c(0.25,0.22,0.22,0.25), 2,2)) 13 | ) 14 | write.table(as.vector(a), "data/kmeans.txt", col.names=FALSE, row.names=FALSE) 15 | 16 | -------------------------------------------------------------------------------- /riposte/gen_lr.R: -------------------------------------------------------------------------------- 1 | 2 | N <- 50000 3 | D <- 30 4 | 5 | library(clusterGeneration) 6 | library(MASS) 7 | cov.matrix <- genPositiveDefMat(D-1, ratioLambda=100) 8 | 9 | m <- scale(mvrnorm(N, rep(0,D-1), cov.matrix$Sigma)) 10 | m <- cbind(rep(1,N),m) 11 | w <- rnorm(D) 12 | r <- as.double(((m %*% w) + rnorm(N,0,10)) > 0) 13 | 14 | write.table(as.vector(m), "data/lr_p.txt", row.names=FALSE, col.names=FALSE) 15 | write.table(as.vector(r), "data/lr_r.txt", row.names=FALSE, col.names=FALSE) 16 | write.table(as.vector(w), "data/lr_w.txt", row.names=FALSE, col.names=FALSE) 17 | write.table(as.vector(rnorm(D)), "data/lr_wi.txt", row.names=FALSE, col.names=FALSE) 18 | -------------------------------------------------------------------------------- /riposte/gen_pca.R: -------------------------------------------------------------------------------- 1 | 2 | # pca (via eigen values of covariance matrix) + reprojection onto new basis 3 | 4 | N <- 100000L 5 | D <- 50L 6 | 7 | library(clusterGeneration) 8 | library(MASS) 9 | cov.matrix <- genPositiveDefMat(D, ratioLambda=100) 10 | a <- mvrnorm(N, rep(0,D), cov.matrix$Sigma) 11 | write.table(as.vector(a), "data/pca.txt",row.names=FALSE,col.names=FALSE) 12 | 13 | -------------------------------------------------------------------------------- /riposte/histogram.R: -------------------------------------------------------------------------------- 1 | 2 | #data <- sample(1:100, 100000, replace=TRUE) 3 | 4 | setup<-function(args='100000000') { 5 | n<-as.integer(args[1]) 6 | if(is.na(n)){ n=10000000L } 7 | cat('[historgram]n =', n, '\n') 8 | data <- as.integer(runif(n,0,100)) 9 | f <- factor(data, 0L:99L) 10 | 11 | } 12 | 13 | run<-function(data) { 14 | #the below 2 are commented in org benchmark 15 | #f <- factor(data, 0L:99L); 16 | #lapply(split(data,f), "length") 17 | #bench part 18 | r<-tabulate(data,100L); 19 | cat(length(r),'\n') 20 | } 21 | 22 | 23 | if (!exists('harness_argc')) { 24 | dataset <- setup(commandArgs(TRUE)) 25 | run(dataset) 26 | } -------------------------------------------------------------------------------- /riposte/lr.R: -------------------------------------------------------------------------------- 1 | # logistic regression test case 2 | 3 | setup<-function(args=c('50000','100')) { 4 | N<-as.integer(args[1]) 5 | if(is.na(N)){ 6 | N <-50000L #according to gen_lr data 7 | } 8 | 9 | reps<-as.integer(args[2]) 10 | if(is.na(reps)){ 11 | reps <-100L 12 | } 13 | 14 | cat('[lr]N =', N, 'reps =', reps, '\n') 15 | 16 | D <- 30L 17 | 18 | p <- read.table("data/lr_p.txt")[[1]] 19 | cat(length(p),'\n') 20 | 21 | r <- read.table("data/lr_r.txt")[[1]] 22 | cat(length(r),'\n') 23 | 24 | wi <- read.table("data/lr_wi.txt")[[1]] 25 | 26 | dim(p) <- c(N,D); 27 | list(p, r, wi,reps); 28 | } 29 | 30 | run<-function(dataset) { 31 | 32 | D <- 30L; 33 | p<-dataset[[1]] 34 | r<-dataset[[2]] 35 | wi<-dataset[[3]] 36 | reps <- dataset[[4]] 37 | 38 | #g <- function(z) 1/(1+exp(-z)) 39 | 40 | update <- function(w) { 41 | diff <- 1/(1+exp(p %*% w)) - r 42 | grad <- double(D); 43 | for(i in 1L:D) { 44 | grad[i] <- mean((p[,i]*diff)) 45 | } 46 | grad 47 | } 48 | 49 | #benchpart 50 | w <- wi 51 | epsilon <- 0.07 52 | 53 | for(j in 1L:reps) { 54 | grad <- update(w) 55 | delta <- grad*epsilon 56 | w <- w - delta 57 | } 58 | 59 | cat(length(w),'\n'); 60 | #glm(r~p-1, family=binomial(link="logit"), na.action=na.pass) 61 | 62 | 63 | } 64 | 65 | if (!exists('harness_argc')) { 66 | dataset <- setup(commandArgs(TRUE)) 67 | run(dataset) 68 | } -------------------------------------------------------------------------------- /riposte/lr_test.R: -------------------------------------------------------------------------------- 1 | # logistic regression test case 2 | 3 | setup<-function(args) { 4 | 5 | p <- read.table("data/lr_p.txt")[[1]] 6 | dim(p) <- c(length(p)/30, 30) 7 | r <- read.table("data/lr_r.txt")[[1]] 8 | 9 | cat('[lr_test]\n') 10 | 11 | list(p,r) 12 | } 13 | 14 | run<-function(dataset) { 15 | p<-dataset[[1]] 16 | r<-dataset[[2]] 17 | glm(r~p-1, family=binomial(link="logit")) 18 | } 19 | 20 | if (!exists('harness_argc')) { 21 | dataset <- setup(commandArgs(TRUE)) 22 | run(dataset) 23 | } -------------------------------------------------------------------------------- /riposte/mandelbrot.R: -------------------------------------------------------------------------------- 1 | #adapted from https://github.com/ispc/ispc/tree/master/examples/mandelbrot 2 | 3 | setup<-function(args='100') { 4 | 5 | maxIterations<-as.integer(args[1]) 6 | if(is.na(maxIterations)){ 7 | maxIterations <-100L 8 | } 9 | 10 | width <- 2048 11 | height <- 1536 12 | 13 | cat('[mandelbrot]width =', width, 'height =', height, 'maxIterations =', maxIterations, '\n') 14 | 15 | x0 <- -2 16 | x1 <- 1 17 | y0 <- -1 18 | y1 <- 1 19 | 20 | 21 | dx <- (x1 - x0) / width 22 | dy <- (y1 - y0) / height 23 | 24 | c <- (1:(width*height)) - 1 25 | i <- c %% width 26 | j <- floor(c / width) 27 | 28 | c_re <- x0 + i * dx 29 | c_im <- y0 + j * dy 30 | 31 | force(c_re) 32 | force(c_im) 33 | 34 | list(c_re, c_im, maxIterations); 35 | } 36 | 37 | 38 | run<-function(dataset) { 39 | c_re<-dataset[[1]] 40 | c_im<-dataset[[2]] 41 | maxIterations <-dataset[[3]] 42 | 43 | 44 | #c_ <- complex(real=c_re, imaginary=c_im) 45 | 46 | #mandel <- function(maxIterations) { 47 | # z_ <- c_ 48 | # cnt <- 0 49 | # for(i in 1:maxIterations) { 50 | # z_ <- z_*z_ + c 51 | # cnt <- cnt + ifelse(Mod(z_) < 2, 1, 0) 52 | # } 53 | # cnt 54 | #} 55 | #bench part 56 | z_re <- c_re 57 | z_im <- c_im 58 | cnt <- 0 59 | for(i in 1:maxIterations) { 60 | #cnt <- cnt + ifelse(z_re * z_re + z_im * z_im <= 4, 1, 0) 61 | cnt <- cnt + (z_re*z_re + z_im*z_im <= 4) 62 | z_re2 <- c_re + (z_re*z_re - z_im*z_im) 63 | z_im2 <- c_im + (2. * z_re * z_im) 64 | z_re <- z_re2 65 | z_im <- z_im2 66 | } 67 | cat(length(cnt),'\n'); 68 | 69 | } 70 | 71 | 72 | if (!exists('harness_argc')) { 73 | dataset <- setup(commandArgs(TRUE)) 74 | run(dataset) 75 | } 76 | -------------------------------------------------------------------------------- /riposte/pca-blocked.R: -------------------------------------------------------------------------------- 1 | 2 | # pca (via eigen values of covariance matrix) + reprojection onto new basis 3 | 4 | setup <-function(args='100000') { 5 | N<-as.integer(args[1]) 6 | if(is.na(N)){ 7 | N <- 100000L #according to gen pca 8 | } 9 | 10 | cat('[pca-blcoked]N =', N, '\n') 11 | D <- 50L 12 | 13 | a <- read.table("data/pca.txt")[[1]] 14 | cat("done reading\n") 15 | dim(a) <- c(N, D) 16 | a 17 | } 18 | 19 | run<-function(a){ 20 | 21 | cov <- function(a,b) { 22 | if(!all(dim(a) == dim(b))) stop("matrices must be same shape") 23 | 24 | m <- nrow(a) 25 | n <- ncol(a) 26 | z <- length(a) 27 | 28 | ma <- double(n) 29 | mb <- double(n) 30 | for(i in 1L:n) { 31 | j <- mean(a[,i]) 32 | k <- mean(b[,i]) 33 | ma[[i]] <- j 34 | mb[[i]] <- k 35 | } 36 | 37 | r <- double(0) 38 | #for(i in 1L:n) { 39 | # for(j in i:n) { 40 | # k <- sum((a[,i]-ma[[i]])*(b[,j]-mb[[j]])) 41 | # r[[(i-1L)*n+j]] <- k 42 | # r[[(j-1L)*n+i]] <- k 43 | # } 44 | #} 45 | bs <- 6 46 | r <- double(2500) 47 | force(r) 48 | for(ii in 1L:ceiling(n/bs)) { 49 | for(jj in 1L:ceiling(n/bs)) { 50 | for(io in 1L:bs) { 51 | for(jo in 1L:bs) { 52 | i <- as.integer( (ii-1)*bs + (io-1) + 1 ) 53 | j <- as.integer( (jj-1)*bs + (jo-1) + 1 ) 54 | if(j >= i && i <= n && j <= n) { 55 | #cat(i, " " , j, "\n") 56 | k <- sum((a[,i]-ma[[i]])*(b[,j]-mb[[j]])) 57 | r[[(i-1L)*n+j]] <- k 58 | r[[(j-1L)*n+i]] <- k 59 | } 60 | #cat(r[[(38-1L)*n + 45]]/(m - 1),"\n") 61 | } 62 | } 63 | } 64 | } 65 | r <- r/(m-1) 66 | dim(r) <- c(n,n) 67 | r 68 | } 69 | 70 | ## TODO: matrix multiplication cost dominates 71 | ## Could just compute the principal components 72 | 73 | pca <- function(a) { 74 | cm <- cov(a,a) 75 | cm 76 | #basis <- eigen(cm, symmetric=TRUE)[[2]] 77 | #basis 78 | } 79 | #system.time(f <- pca(a)) 80 | #bench part 81 | res<-pca(a); 82 | length(res) 83 | } 84 | 85 | if (!exists('harness_argc')) { 86 | dataset <- setup(commandArgs(TRUE)) 87 | run(dataset) 88 | } 89 | 90 | -------------------------------------------------------------------------------- /riposte/pca.R: -------------------------------------------------------------------------------- 1 | 2 | # pca (via eigen values of covariance matrix) + reprojection onto new basis 3 | 4 | 5 | setup<-function(args='100000') { 6 | N<-as.integer(args[1]) 7 | if(is.na(N)){ 8 | N <- 100000L #according to gen pca 9 | #N <- 1000000L 10 | } 11 | cat('[pca]N =', N, '\n') 12 | D <- 50L 13 | 14 | a <- read.table("data/pca.txt")[[1]] 15 | dim(a) <- c(N, D) 16 | 17 | a 18 | } 19 | 20 | 21 | run<-function(dataset){ 22 | 23 | cov <- function(a,b) { 24 | if(!all(dim(a) == dim(b))) stop("matrices must be same shape") 25 | 26 | m <- nrow(a) 27 | n <- ncol(a) 28 | z <- length(a) 29 | 30 | ma <- double(n) 31 | mb <- double(n) 32 | for(i in 1L:n) { 33 | j <- mean(a[,i]) 34 | k <- mean(b[,i]) 35 | ma[i] <- j # why ma[[i]] 36 | mb[i] <- k # why mb[[i]] 37 | } 38 | 39 | r <- double(n*n) 40 | for(i in 1L:n) { 41 | for(j in i:n) { 42 | k_vec = (a[,i]-ma[i])*(b[,j]-mb[j]); 43 | k <- sum(k_vec); 44 | r_i <-(i-1L)*n+j; 45 | r_j <-(j-1L)*n+i; 46 | r[r_i] <- k 47 | r[r_j] <- k 48 | } 49 | } 50 | r <- r/(m-1) 51 | dim(r) <- c(n,n) 52 | r 53 | } 54 | 55 | ## TODO: matrix multiplication cost dominates 56 | ## Could just compute the principal components 57 | 58 | #do pca 59 | cm <- cov(dataset,dataset) 60 | #cm 61 | r<-length(cm) #for return simple result 62 | #basis <- eigen(cm, symmetric=TRUE)[[2]] 63 | #basis 64 | cat(r,'\n') 65 | } 66 | 67 | if (!exists('harness_argc')) { 68 | dataset <- setup(commandArgs(TRUE)) 69 | run(dataset) 70 | } 71 | 72 | -------------------------------------------------------------------------------- /riposte/qr.R: -------------------------------------------------------------------------------- 1 | 2 | setup<-function(args='1000'){ 3 | 4 | #m <- c(1,2,3,4,5,6,7,8,9) 5 | #dim(m) <- c(3,3) 6 | N<-as.integer(args[1]) 7 | if(is.na(N)){ N=1000L } 8 | cat('[qr]N =', N, '\n') 9 | m <- runif(N*N) 10 | dim(m) <- c(N, N) 11 | list(m,N) 12 | } 13 | 14 | 15 | run<-function(dataset){ 16 | m<-dataset[[1]] 17 | N<-dataset[[2]] 18 | 19 | 20 | mv <- function(m, v) { 21 | r <- 0 22 | for(i in 1L:ncol(m)) { 23 | r <- r + m[,i]*v[[i]] 24 | } 25 | r 26 | } 27 | 28 | vm <- function(v, m) { 29 | r <- 0 30 | for(i in 1L:ncol(m)) { 31 | r <- r + m[i,]*v[[i]] 32 | } 33 | r 34 | } 35 | 36 | outer <- function(v) { 37 | v[rep(length(v),1L,length(v)^2)]*v[rep(length(v),length(v),length(v)^2)] 38 | } 39 | 40 | 41 | myqr <- function(m) { 42 | #q <- diag(ncol(m)) 43 | for(i in 1L:ncol(m)) { 44 | a <- (m[,i])[i:nrow(m)] 45 | n <- -sign(m[,i][i])*sqrt(sum(a*a)) 46 | v <- ifelse(1:nrow(m) < i, 0, 47 | ifelse(1:nrow(m) == i, m[i,i]-n, m[,i])) 48 | b <- sum(v*v) 49 | if(b == 0) next 50 | m <- strip(m) - 2/b * outer((vm(v,m))) 51 | dim(m) <- c(N,N) 52 | #m <- m - 2/b * (v %*% (t(v) %*% m)) 53 | #q <- q - 2/b * ((q %*% v) %*% t(v)) 54 | cat(i,'\n') 55 | } 56 | list(q, m) 57 | } 58 | 59 | myqr(m) 60 | #qr(m) 61 | } 62 | 63 | if (!exists('harness_argc')) { 64 | dataset <- setup(commandArgs(TRUE)) 65 | run(dataset) 66 | } 67 | -------------------------------------------------------------------------------- /riposte/raysphere.R: -------------------------------------------------------------------------------- 1 | 2 | setup<-function(args='10000000') { 3 | n<-as.integer(args[1]) 4 | if(is.na(n)){ n=10000000L } 5 | 6 | cat('[raysphere]n =', n,'\n') 7 | 8 | xc <- as.double(0:(n-1)) 9 | yc <- as.double(0:(n-1)) 10 | zc <- as.double(0:(n-1)) 11 | 12 | list(xc,yc,zc); 13 | } 14 | 15 | 16 | run<-function(dataset) { 17 | xo <- 0 18 | yo <- 0 19 | zo <- 0 20 | xd <- 1 21 | yd <- 0 22 | zd <- 0 23 | 24 | xc<- dataset[[1]]; 25 | yc<- dataset[[2]]; 26 | zc<- dataset[[3]]; 27 | 28 | intersect <- function() { 29 | rx <- xo-xc 30 | ry <- yo-yc 31 | rz <- zo-zc 32 | 33 | a <- 1 34 | b <- 2*(xd*rx+yd*ry+zd*rz) 35 | c <- rx*rx+ry*ry+rz*rz-1 36 | 37 | disc <- b*b-4*a*c 38 | 39 | m <- sqrt(disc) 40 | t0 <- (-b - m)/2 41 | t1 <- (-b + m)/2 42 | 43 | cond <- disc > 0 44 | min(pmin(t0[cond], t1[cond])) 45 | } 46 | #benchpart 47 | r<-intersect(); 48 | #system.time() 49 | cat(r,'\n'); 50 | } 51 | 52 | if (!exists('harness_argc')) { 53 | dataset <- setup(commandArgs(TRUE)) 54 | run(dataset) 55 | } 56 | 57 | -------------------------------------------------------------------------------- /riposte/riposte.list: -------------------------------------------------------------------------------- 1 | black_scholes.R 10000 2 | cleaning.R 3 | example.R 4 | filter1d.R 5 | histogram.R 6 | kmeans.R 7 | lr_test.R 8 | lr.R 9 | mandelbrot.R 10 | pca.R 11 | pca-blocked.R 12 | qr.R 13 | raysphere.R 14 | sample_builtin.R 15 | sample.R 16 | smv_builtin.R 17 | smv.R -------------------------------------------------------------------------------- /riposte/sample.R: -------------------------------------------------------------------------------- 1 | 2 | # sample a mixture of gaussians via a rational approximation of the inverse cdf 3 | # http://home.online.no/~pjacklam/notes/invnorm/ 4 | 5 | 6 | setup<-function(args='10000000') { 7 | n<-as.integer(args[1]) 8 | if(is.na(n)){ n=10000000L } 9 | cat('[sample]n =', n, '\n') 10 | n 11 | } 12 | 13 | 14 | run<-function(n){ 15 | ca <- c(-3.969683028665376e+01, 16 | 2.209460984245205e+02, 17 | -2.759285104469687e+02, 18 | 1.383577518672690e+02, 19 | -3.066479806614716e+01, 20 | 2.506628277459239e+00) 21 | 22 | cb <- c(-5.447609879822406e+01, 23 | 1.615858368580409e+02, 24 | -1.556989798598866e+02, 25 | 6.680131188771972e+01, 26 | -1.328068155288572e+01) 27 | 28 | 29 | cc <- c(-7.784894002430293e-03, 30 | -3.223964580411365e-01, 31 | -2.400758277161838e+00, 32 | -2.549732539343734e+00, 33 | 4.374664141464968e+00, 34 | 2.938163982698783e+00) 35 | 36 | cd <- c( 7.784695709041462e-03, 37 | 3.224671290700398e-01, 38 | 2.445134137142996e+00, 39 | 3.754408661907416e+00) 40 | 41 | inv.cdf <- function(p) { 42 | ifelse(p < 0.02425, 43 | {q <- sqrt(-2*log(p)); 44 | (((((cc[1L]*q+cc[2L])*q+cc[3L])*q+cc[4L])*q+cc[5L])*q+cc[6L]) / 45 | ((((cd[1L]*q+cd[2L])*q+cd[3L])*q+cd[4L])*q+1)}, 46 | ifelse(p <= (1-0.02425), 47 | {q <- (p-0.5); 48 | r <- q*q; 49 | (((((ca[1L]*r+ca[2L])*r+ca[3L])*r+ca[4L])*r+ca[5L])*r+ca[6L])*q / 50 | (((((cb[1L]*r+cb[2L])*r+cb[3L])*r+cb[4L])*r+cb[5L])*r+1)}, 51 | # p > p.high 52 | {q <- sqrt(-2*log(1-p)); 53 | -(((((cc[1L]*q+cc[2L])*q+cc[3L])*q+cc[4L])*q+cc[5L])*q+cc[6L]) / 54 | ((((cd[1L]*q+cd[2L])*q+cd[3L])*q+cd[4L])*q+1)})) 55 | } 56 | 57 | rnorm <- function(n, m=0, sd=1) { 58 | inv.cdf(runif(n))*sd + m 59 | } 60 | 61 | #benchpart 62 | means <- c(0,2,10) 63 | sd <- c(1,0.1,3) 64 | 65 | a <- runif(n) 66 | i <- floor(runif(n)*3)+1L 67 | res<-rnorm(n, means[i], sd[i]) 68 | cat(length(res),'\n'); 69 | } 70 | 71 | 72 | if (!exists('harness_argc')) { 73 | dataset <- setup(commandArgs(TRUE)) 74 | run(dataset) 75 | } 76 | 77 | -------------------------------------------------------------------------------- /riposte/sample_builtin.R: -------------------------------------------------------------------------------- 1 | 2 | 3 | setup<-function(args='10000000') { 4 | n<-as.integer(args[1]) 5 | if(is.na(n)){ n=10000000L } 6 | cat('[sample_builtin]n =', n, '\n') 7 | n 8 | } 9 | 10 | 11 | run<-function(n){ 12 | means <- c(0,2,10) 13 | sd <- c(1,0.1,3) 14 | 15 | a <- runif(n) 16 | i <- floor(runif(n)*3)+1L 17 | res<-rnorm(n, means[i], sd[i]) 18 | 19 | cat(length(res),'\n') 20 | } 21 | 22 | if (!exists('harness_argc')) { 23 | dataset <- setup(commandArgs(TRUE)) 24 | run(dataset) 25 | } -------------------------------------------------------------------------------- /riposte/smv.R: -------------------------------------------------------------------------------- 1 | 2 | # sparse matrix-vector multiplication 3 | # TODO: sort input by row for perf? 4 | # random 1M x 1M matrix with 100M entries 5 | 6 | setup<-function(args=c('20000000', '500000')) { 7 | M <- as.integer(args[1]) 8 | if(is.na(M)){ M=20000000L } 9 | 10 | N <- as.integer(args[2]) 11 | if(is.na(N)){ N=500000L } 12 | 13 | cat('[smv]M =', M, 'N =', N, '\n') 14 | 15 | v <- runif(N) 16 | m <- list( 17 | row=force(sort(as.integer(runif(M, 1, N)))), 18 | col=force(as.integer(runif(M, 1, N))), 19 | val=force(runif(M)) 20 | ) 21 | force(v) 22 | f <- factor(m[[1]]-1L, (1L:N)-1L) 23 | force(f) 24 | list(m,v,f) 25 | } 26 | 27 | 28 | run<-function(dataset){ 29 | m <- dataset[[1]]; 30 | v <- dataset[[2]]; 31 | f <- dataset[[3]]; 32 | 33 | smv <- function(m, v, f) { 34 | lapply(split(m[[3]]*v[m[[2]]], f), "sum") 35 | } 36 | #benchpart; 37 | res<-smv(m,v,f); 38 | cat(length(res),'\n'); 39 | } 40 | 41 | if (!exists('harness_argc')) { 42 | dataset <- setup(commandArgs(TRUE)) 43 | run(dataset) 44 | } 45 | -------------------------------------------------------------------------------- /riposte/smv_builtin.R: -------------------------------------------------------------------------------- 1 | 2 | # sparse matrix-vector multiplication 3 | # TODO: sort input by row for perf? 4 | 5 | # random 1M x 1M matrix with 10M entries 6 | 7 | setup<-function(args='10000000') { 8 | n<-as.integer(args[1]) 9 | if(is.na(n)){ n=10000000L } 10 | cat('[smv_builtin]n =', n, '\n') 11 | library(Matrix) 12 | 13 | m <- sparseMatrix( 14 | as.integer(runif(n, 1, n)), 15 | sort(as.integer(runif(n, 1, n))), 16 | x=runif(n), 17 | dims=c(n,n)) 18 | 19 | v <- runif(n) 20 | 21 | list(m,v) 22 | } 23 | 24 | run<-function(dataset){ 25 | m <- dataset[[1]] 26 | v <- dataset[[2]] 27 | 28 | smv <- function(m, v) { 29 | m %*% v 30 | } 31 | #benchpart 32 | res<-smv(m,v) 33 | cat(length(res),'\n') 34 | 35 | } 36 | 37 | if (!exists('harness_argc')) { 38 | dataset <- setup(commandArgs(TRUE)) 39 | run(dataset) 40 | } 41 | 42 | -------------------------------------------------------------------------------- /riposte/tpc.R: -------------------------------------------------------------------------------- 1 | 2 | # missing code so far 3 | 4 | # data is in tests/tpc 5 | 6 | # query definition is: 7 | # (from http://www.tpc.org/tpch/spec/tpch2.14.3.pdf) 8 | #select 9 | #l_returnflag, 10 | #l_linestatus, 11 | #sum(l_quantity) as sum_qty, 12 | #sum(l_extendedprice) as sum_base_price, 13 | #sum(l_extendedprice*(1-l_discount)) as sum_disc_price, 14 | #sum(l_extendedprice*(1-l_discount)*(1+l_tax)) as sum_charge, 15 | #avg(l_quantity) as avg_qty, 16 | #avg(l_extendedprice) as avg_price, 17 | #avg(l_discount) as avg_disc, 18 | #count(*) as count_order 19 | #from 20 | #lineitem 21 | #where 22 | #l_shipdate <= date '1998-12-01' - interval '[DELTA]' day (3) 23 | #group by 24 | #l_returnflag, 25 | #l_linestatus 26 | #order by 27 | #l_returnflag, 28 | #l_linestatus; 29 | 30 | 31 | run<-function(){ 32 | format <- 33 | c( NA, 34 | NA, 35 | NA, 36 | NA, 37 | "double", #quantity 38 | "double", #extendedprice 39 | "double", #discount 40 | "double", #tax 41 | "character", #returnflag 42 | "character", #linestatus 43 | "date", #shipdate 44 | NA, 45 | NA, 46 | NA, 47 | NA, 48 | NA 49 | ) 50 | r <- read.table("benchmarks/data/lineitem_small.tbl",sep="|",colClasses=format) 51 | a <- ifelse(r[[5]] == 'A', 0L, ifelse(r[[5]] == 'N', 1L, 2L)) 52 | b <- ifelse(r[[6]] == 'F', 0L, 1L) 53 | start_date <- 912499200-(90*24*60*60) 54 | #f <- factor((a*2L+b)[r[[7]] <= start_date], 0L:5L) 55 | f <- factor((a*2L+b), 0L:5L) 56 | 57 | benchmark <- function() { 58 | z <- list(0) 59 | 60 | #filter <- r[[7]] <= start_date 61 | #z[[1]] <- lapply(split(r[[1]][filter], f), 'sum') 62 | #z[[2]] <- lapply(split(r[[2]][filter], f), 'sum') 63 | #z[[3]] <- lapply(split((r[[2]]*(1-r[[3]]))[filter], f), 'sum') 64 | #z[[4]] <- lapply(split((r[[2]]*(1-r[[3]])*(1+r[[4]]))[filter], f), 'sum') 65 | #z[[5]] <- lapply(split(r[[1]][filter], f), 'mean') 66 | #z[[6]] <- lapply(split(r[[2]][filter], f), 'mean') 67 | #z[[7]] <- lapply(split(r[[3]][filter], f), 'mean') 68 | #z[[8]] <- lapply(split(r[[1]][filter], f), 'length') 69 | 70 | z[[1]] <- lapply(split(r[[1]], f), 'sum') 71 | z[[2]] <- lapply(split(r[[2]], f), 'sum') 72 | z[[3]] <- sum(r[[3]]) 73 | z[[4]] <- sum(r[[4]]) 74 | #z[[1]] <- lapply(split(r[[1]], f), 'sum') 75 | #z[[2]] <- lapply(split(r[[2]], f), 'sum') 76 | #z[[3]] <- lapply(split((r[[2]]*(1-r[[3]])), f), 'sum') 77 | #z[[4]] <- lapply(split((r[[2]]*(1-r[[3]])*(1+r[[4]])), f), 'sum') 78 | #z[[5]] <- lapply(split(r[[1]], f), 'mean') 79 | #z[[6]] <- lapply(split(r[[2]], f), 'mean') 80 | #z[[7]] <- lapply(split(r[[3]], f), 'mean') 81 | #z[[8]] <- lapply(split(r[[1]], f), 'length') 82 | z 83 | } 84 | 85 | #bench part 86 | for(i in 1:100) {benchmark()} 87 | 88 | } 89 | 90 | -------------------------------------------------------------------------------- /scalar/ForLoopAdd/ForLoopAdd.R: -------------------------------------------------------------------------------- 1 | # TODO: Add comment 2 | # 3 | # Author: Haichuan Wang(hwang154@illinois.edu) 4 | ############################################################################### 5 | 6 | 7 | setup <- function(args='10000000') { 8 | n<-as.integer(args[1]) 9 | if(is.na(n)){ n <- 10000000 } 10 | return(n) 11 | } 12 | 13 | run <-function(n=10000000) { 14 | r <- 0; 15 | for( i in 1:n) { 16 | r <- r + i; 17 | } 18 | print(r) 19 | }; 20 | 21 | if (!exists('harness_argc')) { 22 | n <- setup(commandArgs(TRUE)) 23 | run(n) 24 | } -------------------------------------------------------------------------------- /scalar/ForLoopAdd/ForLoopAdd.c: -------------------------------------------------------------------------------- 1 | 2 | #include 3 | int main(int argc, char* argv[]) { 4 | int n = 10000000; 5 | if(argc >= 2) { 6 | n = atoi(argv[1]); 7 | } 8 | long r=0; 9 | int i; 10 | for(i = 0; i < n; i++) { r +=i; } 11 | printf("%ld\n", r); 12 | return 0; 13 | } 14 | -------------------------------------------------------------------------------- /scalar/ForLoopAdd/ForLoopAdd.java: -------------------------------------------------------------------------------- 1 | 2 | 3 | class ForLoopAdd { 4 | public static void main( String[] args ) { 5 | int n = 10000000; 6 | n = args.length > 0 ? Integer.parseInt( args[0] ) : 10000000; 7 | long r=0; 8 | int i; 9 | for(i = 0; i < n; i++) { r +=i; } 10 | System.out.printf("%d\n", r); 11 | } 12 | } -------------------------------------------------------------------------------- /scalar/ForLoopAdd/ForLoopAdd.python: -------------------------------------------------------------------------------- 1 | #!/usr/bin/python 2 | 3 | 4 | def run(n=10000000): 5 | r = 0 6 | for i in range(0, n): 7 | r = r + i 8 | print(r) 9 | 10 | from sys import argv 11 | n = 10000000 12 | if(len(argv) > 1): 13 | n = int(argv[1]) 14 | run(n) -------------------------------------------------------------------------------- /scalar/README.md: -------------------------------------------------------------------------------- 1 | # scalar benchmark 2 | 3 | A few simple micro benchmarks. 4 | 5 | - crt.R: Chinese Remainder Theorem 6 | - fib_rec.R: fibonacci number, recursive method 7 | - fib.R: fibonacci number, iterative method 8 | - ForLoopAdd.R: forloop accumulation add 9 | - gcd_rec.R: Greatest common divisor, calculate GCD for two numbers 10 | - gcd.R: Greatest common divisor, calculate GCD for 100M pairs of random numbers 11 | - prime.R: find prime numbers 12 | -------------------------------------------------------------------------------- /scalar/crt/crt.R: -------------------------------------------------------------------------------- 1 | # TODO: Add comment 2 | # 3 | # Author: Administrator 4 | ############################################################################### 5 | 6 | # I define GCD and LCM inside the run function 7 | 8 | setup <- function(args='100') { 9 | n<-as.integer(args[1]) 10 | if(is.na(n)){ n <- 100 } 11 | return(n) 12 | } 13 | 14 | run <- function(repcount=100) { 15 | gcd = function(m, n) { 16 | while (n != 0){ 17 | t <- n; 18 | n <- m %% n; 19 | m <- t; 20 | } 21 | m; 22 | } 23 | 24 | lcm = function(m,n) { 25 | m * n / gcd(m,n); 26 | } 27 | 28 | #construct the input 29 | n<-40 30 | residual <- 1:n; #n length vec 31 | divisor <- residual+1; #n length vec 32 | 33 | 34 | #print(divisor); 35 | #print(residual); 36 | #benchpart 37 | for(iter in 1:repcount){ 38 | a <- divisor[1]; 39 | r <- residual[1]; 40 | for(i in 2:n) { 41 | 42 | while(r %% divisor[i] != residual[i]) { 43 | r <- r + a; 44 | #print("a/r=");print(a);print(r); 45 | } 46 | a <- lcm(a, divisor[i]); 47 | #print("a=");print(a); 48 | } 49 | } 50 | print(r); 51 | } 52 | 53 | if (!exists('harness_argc')) { 54 | n <- setup(commandArgs(TRUE)) 55 | run(n) 56 | } 57 | -------------------------------------------------------------------------------- /scalar/crt/crt.c: -------------------------------------------------------------------------------- 1 | 2 | #include 3 | 4 | long gcd(long m, long n) { 5 | long t; 6 | while (n != 0){ 7 | t = n; 8 | n = m % n; 9 | m = t; 10 | } 11 | return m; 12 | } 13 | 14 | long lcm(long m, long n) { 15 | return m * n / gcd(m,n); 16 | } 17 | 18 | int main(int argc, char* argv[]) { 19 | int rep = 10000; 20 | if(argc >=2) { 21 | rep = atoi (argv[1]); 22 | } 23 | 24 | int n = 40; 25 | long residual[n]; 26 | long divisor[n]; 27 | int i; 28 | for(i=0; i < n; i++) { 29 | residual[i] = i+1; 30 | divisor[i] = i+2; 31 | } 32 | long a,r; 33 | int iter; 34 | for(iter = 0; iter < rep; iter++){ 35 | a=divisor[0]; 36 | r=residual[0]; 37 | for(i = 1; i < n; i++){ 38 | while(r % divisor[i] != residual[i]) { 39 | r = r+a; 40 | } 41 | a = lcm(a, divisor[i]); 42 | //printf("a=%ld\n",a); 43 | } 44 | } 45 | printf("%ld\n",r); 46 | return 0; 47 | } 48 | -------------------------------------------------------------------------------- /scalar/crt/crt.python: -------------------------------------------------------------------------------- 1 | #!/usr/bin/python 2 | # I define GCD and LCM inside the run function 3 | 4 | def gcd(m, n): 5 | while (n != 0): 6 | t = n 7 | n = m % n 8 | m = t 9 | return m 10 | 11 | def lcm(m,n): 12 | return m * n / gcd(m,n) 13 | 14 | 15 | def run(rep=10000): 16 | #construct the input 17 | n = 40 18 | residual = range(1,n+1) #n length vec 19 | divisor = range(2,n+2) #n length vec 20 | for iter in range(rep): 21 | a = divisor[0] 22 | r = residual[0] 23 | for i in range(1,n): 24 | while(r % divisor[i] != residual[i]): 25 | r = r + a 26 | a = lcm(a, divisor[i]); 27 | print(r) 28 | 29 | from sys import argv 30 | rep = 100 31 | if(len(argv) > 1): 32 | rep = int(argv[1]) 33 | run(rep) -------------------------------------------------------------------------------- /scalar/fib/fib.R: -------------------------------------------------------------------------------- 1 | # TODO: Add comment 2 | # 3 | # Author: Haichuan Wang(hwang154@illinois.edu) 4 | ############################################################################### 5 | 6 | setup <- function(args='1000') { 7 | n<-as.integer(args[1]) 8 | if(is.na(n)){ n <- 1000 } 9 | return(n) 10 | } 11 | 12 | run <- function(rep=1000) 13 | { 14 | n <-1000; 15 | for(i in 1:rep){ 16 | a <- 1 17 | b <- 1 18 | for(j in 1:n) {t <- a; a <- b; b <- b+t} 19 | } 20 | print(b) 21 | } 22 | 23 | #Default Driver 24 | 25 | if (!exists('harness_argc')) { 26 | n <- setup(commandArgs(TRUE)) 27 | run(n) 28 | } -------------------------------------------------------------------------------- /scalar/fib/fib.c: -------------------------------------------------------------------------------- 1 | /* 2 | * 3 | */ 4 | #include 5 | 6 | int main(int argc, char* argv[]) { 7 | int rep; 8 | if(argc >=2) { 9 | rep = atoi (argv[1]); 10 | } else { 11 | rep = 1000; 12 | } 13 | 14 | int i, j; 15 | double a, b, t; 16 | for(i = 0; i < rep; i++) { 17 | a = 1; 18 | b = 1; 19 | for(j = 0; j< 1000; j++) { 20 | t = a; a = b; b = b+t; 21 | } 22 | } 23 | printf("%f\n", b); 24 | return 0; 25 | } 26 | -------------------------------------------------------------------------------- /scalar/fib/fib.python: -------------------------------------------------------------------------------- 1 | #!/usr/bin/python 2 | 3 | 4 | def run(rep=1000): 5 | n = 1000 6 | for i in range(1, rep): 7 | a = 1 8 | b = 1 9 | for j in range(0, n): 10 | t = a 11 | a = b 12 | b = b+t 13 | print(b) 14 | 15 | from sys import argv 16 | rep = 1000 17 | if(len(argv) > 1): 18 | rep = int(argv[1]) 19 | run(rep) 20 | 21 | 22 | 23 | -------------------------------------------------------------------------------- /scalar/fib/fib_rec.R: -------------------------------------------------------------------------------- 1 | # TODO: Add comment 2 | # 3 | # Author: Administrator 4 | ############################################################################### 5 | 6 | setup <- function(args='30') { 7 | n<-as.integer(args[1]) 8 | if(is.na(n)){ n <- 30 } 9 | return(n) 10 | } 11 | 12 | 13 | run <- function(n=30) 14 | { 15 | if (n < 2) { 1; } 16 | else {run(n - 1) + run(n - 2);} 17 | } 18 | 19 | if (!exists('harness_argc')) { 20 | n <- setup(commandArgs(TRUE)) 21 | run(n) 22 | } 23 | -------------------------------------------------------------------------------- /scalar/fib/fib_rec.c: -------------------------------------------------------------------------------- 1 | 2 | #include 3 | 4 | int fib(int n) { 5 | if (n < 2) { return 1; } 6 | else { return fib(n - 1) + fib(n - 2);} 7 | } 8 | 9 | int main(int argc, char* argv[]) { 10 | int n = 30; 11 | if(argc >=2) { 12 | n = atoi (argv[1]); 13 | } 14 | 15 | printf("fib(%d)=%d\n", n, fib(n)); 16 | return 0; 17 | } 18 | -------------------------------------------------------------------------------- /scalar/fib/fib_rec.python: -------------------------------------------------------------------------------- 1 | #!/usr/bin/python 2 | 3 | def run(n=30): 4 | if (n < 2): 5 | return 1 6 | else: 7 | return run(n - 1) + run(n - 2) 8 | 9 | 10 | from sys import argv 11 | n = 30 12 | if(len(argv) > 1): 13 | n = int(argv[1]) 14 | print(run(n)) 15 | -------------------------------------------------------------------------------- /scalar/gcd/gcd.R: -------------------------------------------------------------------------------- 1 | # TODO: Add comment 2 | # 3 | # Author: Haichuan Wang(hwang154@illinois.edu) 4 | ############################################################################### 5 | 6 | 7 | setup <- function(args='100000') { 8 | n<-as.integer(args[1]) 9 | if(is.na(n)){ n <- 100000 } 10 | return(n) 11 | } 12 | 13 | run <- function(l=100000) { 14 | 15 | a <- as.integer(runif(l, 1, 1000000000)); 16 | b <- as.integer(runif(l, 1, 1000000000)); 17 | for(i in 1:l) { 18 | m<-a[i]; 19 | n<-b[i]; 20 | while(n!=0) { 21 | t=m; 22 | m=n; 23 | n=t %% n; 24 | } 25 | } 26 | print(l) 27 | } 28 | 29 | if (!exists('harness_argc')) { 30 | n <- setup(commandArgs(TRUE)) 31 | run(n) 32 | } 33 | -------------------------------------------------------------------------------- /scalar/gcd/gcd.c: -------------------------------------------------------------------------------- 1 | 2 | #include 3 | #include 4 | 5 | int main(int argc, char* argv[]) { 6 | int l = 100000; 7 | if(argc >=2) { 8 | l = atoi (argv[1]); 9 | } 10 | 11 | int a[l],b[l],i; 12 | for(i=0; i 1): 20 | l = int(argv[1]) 21 | run(l) 22 | -------------------------------------------------------------------------------- /scalar/gcd/gcd_rec.R: -------------------------------------------------------------------------------- 1 | # TODO: Add comment 2 | # 3 | # Author: Haichuan Wang(hwang154@illinois.edu) 4 | ############################################################################### 5 | 6 | 7 | setup <- function(args=c('123456789', '234736437')) { 8 | m<-as.integer(args[1]) 9 | n<-as.integer(args[2]) 10 | if(is.na(m)){ m <- 123456789 } 11 | if(is.na(n)){ n <- 234736437 } 12 | list(m,n) 13 | } 14 | 15 | run <- function(mn) { 16 | m <- mn[[1]] 17 | n <- mn[[2]] 18 | gcd<-function(m,n) { 19 | if(n==0) { m; } 20 | else { gcd(n,m %% n); } 21 | } 22 | r<-gcd(m,n); 23 | print(r); 24 | } 25 | 26 | 27 | if (!exists('harness_argc')) { 28 | mn <- setup(commandArgs(TRUE)) 29 | run(mn) 30 | } -------------------------------------------------------------------------------- /scalar/gcd/gcd_rec.c: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | int gcd(int m, int n) { 4 | if(n==0) { return m; } 5 | else { return gcd(n, m % n); } 6 | } 7 | 8 | 9 | int main(){ 10 | int m = 123456789; 11 | int n = 234736437; 12 | printf("%d\n", gcd(m,n)); 13 | return 0; 14 | } 15 | 16 | -------------------------------------------------------------------------------- /scalar/gcd/gcd_rec.python: -------------------------------------------------------------------------------- 1 | #!/usr/bin/python 2 | 3 | def gcd(m,n): 4 | if(n==0): 5 | return m 6 | else: 7 | return gcd(n,m % n) 8 | 9 | 10 | def run(): 11 | m = 123456789 12 | n = 234736437 13 | r = gcd(m,n) 14 | print(r) 15 | 16 | run() 17 | -------------------------------------------------------------------------------- /scalar/prime/prime.R: -------------------------------------------------------------------------------- 1 | # TODO: Add comment 2 | # 3 | # Author: Haichuan Wang(hwang154@illinois.edu) 4 | ############################################################################### 5 | 6 | setup <- function(args='100000') { 7 | n<-as.integer(args[1]) 8 | if(is.na(n)){ n <- 100000 } 9 | return(n) 10 | } 11 | 12 | #Simple trivial test of n 13 | #no any optimizaiton, just test the worst loop case 14 | 15 | run <- function(n=100000) { 16 | if(n<2) { n <- 2;} 17 | 18 | num_primes <- 0; 19 | 20 | for(i in 2:n) { 21 | limit <- sqrt(i); 22 | prime <- TRUE; #for 2 is prime 23 | j<-2; # i %% j 24 | while(prime && j <= limit){ 25 | if((i %% j) ==0) { prime <- FALSE;} 26 | j <- j+1; 27 | } 28 | if(prime) { 29 | #print("prime:");print(i); 30 | num_primes<-num_primes+1; 31 | } 32 | } 33 | print(num_primes); 34 | } 35 | 36 | 37 | if (!exists('harness_argc')) { 38 | n <- setup(commandArgs(TRUE)) 39 | run(n) 40 | } -------------------------------------------------------------------------------- /scalar/prime/prime.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | 4 | int main(int argc, char* argv[]) { 5 | int n = 100000; 6 | if(argc >= 2) { 7 | n = atoi(argv[1]); 8 | if(n<2) { n = 2; } 9 | } 10 | 11 | int num_primes = 0; 12 | int i; double limit; 13 | int prime,j; 14 | for(i = 2; i <= n; i++) { 15 | limit = sqrt((double)i); 16 | prime = 1; //for 2 is prime 17 | j = 2; 18 | while(prime && j <= limit){ 19 | if((i % j) == 0) { prime = 0;} 20 | j++; 21 | } 22 | if(prime) { 23 | num_primes++; 24 | } 25 | } 26 | printf("Prime(%d)=%d\n", n, num_primes); 27 | return 0; 28 | } 29 | 30 | -------------------------------------------------------------------------------- /scalar/prime/prime.python: -------------------------------------------------------------------------------- 1 | #!/usr/bin/python 2 | 3 | #Simple trivial test of n 4 | #no any optimizaiton, just test the worst loop case 5 | import math 6 | 7 | def run(n=100000): 8 | if(n<2): 9 | n = 2 10 | num_primes = 0 11 | for i in range(2,n+1): 12 | limit = math.sqrt(i) 13 | prime = True #for 2 is prime 14 | j=2 # i %% j 15 | while(prime and (j <= limit)): 16 | if((i % j) ==0): 17 | prime = False 18 | j = j+1 19 | if(prime): 20 | num_primes=num_primes+1 21 | print(num_primes) 22 | 23 | from sys import argv 24 | n = 100000 25 | if(len(argv) > 1): 26 | n = int(argv[1]) 27 | run(n); -------------------------------------------------------------------------------- /shootout/README.md: -------------------------------------------------------------------------------- 1 | # Shootout benchmark 2 | 3 | The benchmark suite is ported from http://benchmarksgame.alioth.debian.org/. 4 | 5 | The R shootout here are the combinations of several versions. 6 | - FastR version of Purdue FastR project (https://github.com/allr/fastr). 7 | - ORBIT version of UIUC ORBIT project 8 | 9 | All the code were slightly modified to follow rbenchmark's interface. 10 | 11 | ## Attributes 12 | Shootout is belong to Type I R code. 13 | 14 | ## The fastest R implementation 15 | There are several different implementations of each shootout app included in the repository. 16 | The fastest implementations (run with R byte-code interpreter 2.4.1) are 17 | 18 | | Name | File | 19 | |------|------| 20 | | bindary-trees | bindary-trees.R| 21 | | fannkuch-redux | fannkuch-redux.R | 22 | | fasta | fasta-native.R | 23 | | fasta-redux | fastaredux.R | 24 | | k-nucleotide | k-nucleotide.R | 25 | | mandelbrot | mandelbrot1.R | 26 | | meteor-contest | meteor-contest.R | 27 | | nbody | nbody.R | 28 | | pidigits | pidigits.R | 29 | | regex-dna | regexdna.R | 30 | | reverse-complement | revcomp-1.R | 31 | | spectral-norm | spectral-norm-alt.R | 32 | 33 | Others we're still testing. 34 | 35 | ## Credit 36 | 37 | - Purdue FastR project (https://github.com/allr/fastr). 38 | - UIUC ORBIT project 39 | 40 | 41 | 42 | -------------------------------------------------------------------------------- /shootout/binary-trees/Makefile: -------------------------------------------------------------------------------- 1 | LEVEL = ../../../tests 2 | 3 | PARA=12 4 | PROG=binary-trees 5 | CFLAG= -pipe -Wall -O3 -fomit-frame-pointer -march=native -std=c99 -pthread -lm 6 | include $(LEVEL)/Makefile.common 7 | 8 | 9 | -------------------------------------------------------------------------------- /shootout/binary-trees/binary-trees.R: -------------------------------------------------------------------------------- 1 | # R version Shootout binary-trees. 2 | # Use R list structure to represent the binary tree. 3 | # 4 | # The original version from Leo Osvald uses NA as terminator. 5 | # The current version uses 0L to improve the performance. 6 | # 7 | # Contributed by Haichuan Wang, Leo Osvald 8 | ############################################################################### 9 | 10 | setup <- function(args='12') { 11 | n<-as.integer(args[1]) 12 | if(is.na(n)){ n <- 12 } 13 | return(n) 14 | } 15 | 16 | run<-function(n) { 17 | 18 | tree <- function(item, depth) { 19 | if (depth == 0L) 20 | return(c(item, 0L, 0L)) 21 | return(list(item, 22 | tree(2L * item - 1L, depth - 1L), 23 | tree(2L * item, depth - 1L))) 24 | } 25 | 26 | check <- function(tree) { 27 | if(tree[[2]][[1]] == 0L) tree[[1]] else tree[[1]] + check(tree[[2]]) - check(tree[[3]]); 28 | } 29 | 30 | inputdepth <- as.integer(n); 31 | 32 | min_depth <- 4L 33 | max_depth <- if(min_depth + 2 > n) { min_depth + 2L} else { inputdepth } 34 | stretch_depth <- max_depth + 1 35 | 36 | cat(sep="", "stretch tree of depth ", stretch_depth, "\t check: ", 37 | check(tree(0L, stretch_depth)), "\n") 38 | 39 | long_lived_tree <- tree(0L, max_depth) 40 | 41 | for (depth in seq(min_depth, max_depth, 2L)) { 42 | iterations <- 2^(max_depth - depth + min_depth) 43 | chk_sum <- 0L 44 | for (i in 1:iterations) 45 | chk_sum <- chk_sum + check(tree(i, depth)) + check(tree(-i, depth)) 46 | cat(sep="", iterations * 2L, "\t trees of depth ", depth, "\t check ", 47 | chk_sum, "\n") 48 | } 49 | 50 | cat(sep="", "long lived tree of depth ", max_depth, "\t check: ", 51 | check(long_lived_tree), "\n") 52 | 53 | } 54 | 55 | if (!exists('harness_argc')) { 56 | n <- setup(commandArgs(TRUE)) 57 | run(n) 58 | } 59 | -------------------------------------------------------------------------------- /shootout/binary-trees/binary-trees.python: -------------------------------------------------------------------------------- 1 | # The Computer Language Benchmarks Game 2 | # http://benchmarksgame.alioth.debian.org/ 3 | # 4 | # contributed by Antoine Pitrou 5 | # modified by Dominique Wahli and Daniel Nanz 6 | 7 | from __future__ import print_function 8 | 9 | import sys 10 | import multiprocessing as mp 11 | 12 | 13 | def make_tree(i, d): 14 | 15 | if d > 0: 16 | i2 = i + i 17 | d -= 1 18 | return (i, make_tree(i2 - 1, d), make_tree(i2, d)) 19 | return (i, None, None) 20 | 21 | 22 | def check_tree(node): 23 | 24 | (i, l, r) = node 25 | if l is None: 26 | return i 27 | else: 28 | return i + check_tree(l) - check_tree(r) 29 | 30 | 31 | def make_check(itde, make=make_tree, check=check_tree): 32 | 33 | i, d = itde 34 | return check(make(i, d)) 35 | 36 | 37 | def get_argchunks(i, d, chunksize=5000): 38 | 39 | assert chunksize % 2 == 0 40 | chunk = [] 41 | for k in range(1, i + 1): 42 | chunk.extend([(k, d), (-k, d)]) 43 | if len(chunk) == chunksize: 44 | yield chunk 45 | chunk = [] 46 | if len(chunk) > 0: 47 | yield chunk 48 | 49 | 50 | def main(n, min_depth=4): 51 | 52 | max_depth = max(min_depth + 2, n) 53 | stretch_depth = max_depth + 1 54 | if mp.cpu_count() > 1: 55 | pool = mp.Pool() 56 | chunkmap = pool.map 57 | else: 58 | chunkmap = map 59 | 60 | print('stretch tree of depth {0}\t check: {1}'.format( 61 | stretch_depth, make_check((0, stretch_depth)))) 62 | 63 | long_lived_tree = make_tree(0, max_depth) 64 | 65 | mmd = max_depth + min_depth 66 | for d in range(min_depth, stretch_depth, 2): 67 | i = 2 ** (mmd - d) 68 | cs = 0 69 | for argchunk in get_argchunks(i,d): 70 | cs += sum(chunkmap(make_check, argchunk)) 71 | print('{0}\t trees of depth {1}\t check: {2}'.format(i * 2, d, cs)) 72 | 73 | print('long lived tree of depth {0}\t check: {1}'.format( 74 | max_depth, check_tree(long_lived_tree))) 75 | 76 | 77 | if __name__ == '__main__': 78 | main(int(sys.argv[1])) 79 | -------------------------------------------------------------------------------- /shootout/binary-trees/binary-trees_2.R: -------------------------------------------------------------------------------- 1 | # ------------------------------------------------------------------ 2 | # The Computer Language Shootout 3 | # http://shootout.alioth.debian.org/ 4 | # 5 | # Contributed by Leo Osvald 6 | # 7 | # Original Loc: https://raw.github.com/allr/fastr/master/test/r/shootout/binarytrees/binarytrees-2.r 8 | # Modified to be compatible with rbenchmark interface 9 | # ------------------------------------------------------------------ 10 | 11 | 12 | setup <- function(args='12') { 13 | n<-as.integer(args[1]) 14 | if(is.na(n)){ n <- 12 } 15 | return(n) 16 | } 17 | 18 | run <-function (n) { 19 | 20 | tree <- function(item, depth) { 21 | if (depth == 0L) 22 | return(c(item, NA, NA)) 23 | return(list(item, 24 | tree(2L * item - 1L, depth - 1L), 25 | tree(2L * item, depth - 1L))) 26 | } 27 | 28 | check <- function(tree) 29 | if(is.na(tree[[2]][[1]])) tree[[1]] else tree[[1]] + check(tree[[2]]) - check(tree[[3]]) 30 | 31 | min_depth <- 4 32 | max_depth <- max(min_depth + 2, n) 33 | stretch_depth <- max_depth + 1 34 | 35 | cat(sep="", "stretch tree of depth ", stretch_depth, "\t check: ", 36 | check(tree(0, stretch_depth)), "\n") 37 | 38 | long_lived_tree <- tree(0, max_depth) 39 | 40 | for (depth in seq(min_depth, max_depth, 2)) { 41 | iterations <- as.integer(2^(max_depth - depth + min_depth)) 42 | check_sum <- sum(sapply( 43 | 1:iterations, 44 | function(i) check(tree(i, depth)) + check(tree(-i, depth)))) 45 | cat(sep="", iterations * 2L, "\t trees of depth ", depth, "\t check: ", 46 | check_sum, "\n") 47 | } 48 | 49 | cat(sep="", "long lived tree of depth ", max_depth, "\t check: ", 50 | check(long_lived_tree), "\n") 51 | 52 | } 53 | 54 | if (!exists('harness_argc')) { 55 | n <- setup(commandArgs(TRUE)) 56 | run(n) 57 | } 58 | -------------------------------------------------------------------------------- /shootout/binary-trees/binary-trees_list.R: -------------------------------------------------------------------------------- 1 | # ------------------------------------------------------------------ 2 | # The Computer Language Shootout 3 | # http://shootout.alioth.debian.org/ 4 | # 5 | # Contributed by Leo Osvald 6 | # 7 | # Original Loc: https://raw.github.com/allr/fastr/master/test/r/shootout/binarytrees/binarytrees.r 8 | # Modified to be compatible with rbenchmark interface 9 | # ------------------------------------------------------------------ 10 | 11 | setup <- function(args='12') { 12 | n<-as.integer(args[1]) 13 | if(is.na(n)){ n <- 12 } 14 | return(n) 15 | } 16 | 17 | run<-function(n) { 18 | tree <- function(item, depth) { 19 | if (depth == 0L) 20 | return(c(item, NA, NA)) 21 | # it is ridiculous that this doesn't help 22 | next_depth <- depth - 1L 23 | right_item <- 2L * item 24 | left_item <- right_item - 1L 25 | return(list(item, 26 | tree(left_item, next_depth), 27 | tree(right_item, next_depth))) 28 | } 29 | 30 | check <- function(tree) { 31 | if(is.na(tree[[2]][[1]])) tree[[1]] else tree[[1]] + check(tree[[2]]) - check(tree[[3]]) 32 | } 33 | 34 | min_depth <- 4L 35 | max_depth <- max(min_depth + 2L, n) 36 | stretch_depth <- max_depth + 1L 37 | 38 | cat(sep="", "stretch tree of depth ", stretch_depth, "\t check: ", 39 | check(tree(0L, stretch_depth)), "\n") 40 | 41 | long_lived_tree <- tree(0L, max_depth) 42 | 43 | for (depth in seq(min_depth, max_depth, 2L)) { 44 | iterations <- as.integer(2^(max_depth - depth + min_depth)) 45 | check_sum <- sum(sapply( 46 | 1:iterations, 47 | function(i) check(tree(i, depth)) + check(tree(-i, depth)))) 48 | cat(sep="", iterations * 2L, "\t trees of depth ", depth, "\t check: ", 49 | check_sum, "\n") 50 | } 51 | 52 | cat(sep="", "long lived tree of depth ", max_depth, "\t check: ", 53 | check(long_lived_tree), "\n") 54 | } 55 | 56 | 57 | if (!exists('harness_argc')) { 58 | n <- setup(commandArgs(TRUE)) 59 | run(n) 60 | } -------------------------------------------------------------------------------- /shootout/binary-trees/binary-trees_native.R: -------------------------------------------------------------------------------- 1 | # ------------------------------------------------------------------ 2 | # The Computer Language Shootout 3 | # http://shootout.alioth.debian.org/ 4 | # 5 | # Contributed by Leo Osvald 6 | # 7 | # Original Loc: https://raw.github.com/allr/fastr/master/test/r/shootout/binarytrees/binarytrees-naive.r 8 | # Modified to be compatible with rbenchmark interface 9 | # ------------------------------------------------------------------ 10 | 11 | setup <- function(args='12') { 12 | n<-as.integer(args[1]) 13 | if(is.na(n)){ n <- 12 } 14 | return(n) 15 | } 16 | 17 | run <- function(n) { 18 | tree <- function(item, depth) { 19 | if (depth == 0L) 20 | return(c(item, NA, NA)) 21 | return(list(item, 22 | tree(2L * item - 1L, depth - 1L), 23 | tree(2L * item, depth - 1L))) 24 | } 25 | 26 | check <- function(tree) 27 | if(is.na(tree[[2]][[1]])) tree[[1]] else tree[[1]] + check(tree[[2]]) - check(tree[[3]]) 28 | 29 | 30 | min_depth <- 4 31 | max_depth <- max(min_depth + 2, n) 32 | stretch_depth <- max_depth + 1 33 | 34 | cat(sep="", "stretch tree of depth ", stretch_depth, "\t check: ", 35 | check(tree(0, stretch_depth)), "\n") 36 | 37 | long_lived_tree <- tree(0, max_depth) 38 | 39 | for (depth in seq(min_depth, max_depth, 2)) { 40 | iterations <- as.integer(2^(max_depth - depth + min_depth)) 41 | chk_sum <- 0L 42 | for (i in 1:iterations) 43 | chk_sum <- chk_sum + check(tree(i, depth)) + check(tree(-i, depth)) 44 | cat(sep="", iterations * 2L, "\t trees of depth ", depth, "\t check ", 45 | chk_sum, "\n") 46 | } 47 | 48 | cat(sep="", "long lived tree of depth ", max_depth, "\t check: ", 49 | check(long_lived_tree), "\n") 50 | 51 | } 52 | 53 | if (!exists('harness_argc')) { 54 | n <- setup(commandArgs(TRUE)) 55 | run(n) 56 | } 57 | -------------------------------------------------------------------------------- /shootout/fannkuch-redux/Makefile: -------------------------------------------------------------------------------- 1 | LEVEL = ../../.. 2 | 3 | PARA=8 4 | PROG=fannkuch-redux 5 | CFLAG=-pipe -Wall -O3 -fomit-frame-pointer -march=native 6 | JFLAG=-server -XX:+TieredCompilation -XX:+AggressiveOpts 7 | 8 | include $(LEVEL)/common.mk 9 | REP=2 10 | 11 | 12 | -------------------------------------------------------------------------------- /shootout/fannkuch-redux/fannkuch-redux.R: -------------------------------------------------------------------------------- 1 | # The Computer Language Benchmarks Game 2 | # http://shootout.alioth.debian.org/ 3 | 4 | # contributed by Isaac Gouy 5 | # converted to Java by Oleg Mazurov 6 | # converted to Python by Buck Golemon 7 | # modified by Justin Peel 8 | # 9 | # R Comment: 10 | # converted to R by Haichuan 11 | 12 | 13 | setup <- function(args='10') { 14 | n<-as.integer(args[1]) 15 | if(is.na(n)){ n <- 10 } 16 | return(n) 17 | } 18 | 19 | 20 | run <- function(n) { 21 | maxFlipsCount <- 0; 22 | permSign <- TRUE; 23 | checksum <- 0; 24 | 25 | perm1 <- 0:(n-1); 26 | count <- perm1; # do copy 27 | rxrange <- 3:(n-1); 28 | nm <- n - 1; 29 | 30 | while (TRUE) { 31 | k <- perm1[1]; 32 | if (k != 0) { 33 | perm <- perm1; 34 | flipsCount <- 1; 35 | kk <- perm[k + 1]; 36 | while (kk != 0){ 37 | perm[1:(k+1)] <- perm[(k+1):1]; 38 | flipsCount <- flipsCount+1; 39 | k <- kk; 40 | kk <- perm[kk + 1]; 41 | } 42 | 43 | if (maxFlipsCount < flipsCount) { 44 | maxFlipsCount <- flipsCount; 45 | } 46 | checksum <- checksum + (if(permSign) flipsCount else -flipsCount); 47 | } 48 | 49 | # Use incremental change to generate another permutation 50 | if(permSign) { 51 | tmp <-perm1[2]; 52 | perm1[2] <- perm1[1]; 53 | perm1[1] <- tmp; 54 | permSign <- FALSE; 55 | } 56 | else { 57 | tmp <-perm1[3]; 58 | perm1[3] <- perm1[2]; 59 | perm1[2] <- tmp; 60 | permSign <- TRUE; 61 | 62 | breaked <- FALSE; 63 | for (r in rxrange) { 64 | if (count[r] != 0 ){ 65 | breaked <- TRUE; 66 | break; 67 | } 68 | count[r] <- r - 1 69 | perm0 <- perm1[1]; 70 | perm1[1:r] <- perm1[2:(r+1)]; 71 | perm1[r+1] <- perm0; 72 | } 73 | if(!breaked) { 74 | r <- nm + 1; 75 | if (count[r] == 0){ 76 | print( checksum ); 77 | return(maxFlipsCount); 78 | } 79 | } 80 | count[r] <- count[r] - 1; 81 | } 82 | } 83 | } 84 | 85 | if (!exists('harness_argc')) { 86 | n <- setup(commandArgs(TRUE)) 87 | cat("Pfannkuchen(", n, ") = ", run(n), "\n", sep="") 88 | } 89 | -------------------------------------------------------------------------------- /shootout/fannkuch-redux/fannkuch-redux_2.R: -------------------------------------------------------------------------------- 1 | # ------------------------------------------------------------------ 2 | # The Computer Language Shootout 3 | # http://shootout.alioth.debian.org/ 4 | # 5 | # Contributed by Leo Osvald 6 | # 7 | # Original Loc: https://raw.github.com/allr/fastr/master/test/r/shootout/fannkuch/fannkuchredux.r 8 | # Modified to be compatible with rbenchmark interface 9 | # ------------------------------------------------------------------ 10 | 11 | setup <- function(args='10') { 12 | n<-as.integer(args[1]) 13 | if(is.na(n)){ n <- 10 } 14 | return(n) 15 | } 16 | 17 | run <- function(n) { 18 | one_two = c(1, 2) 19 | two_one = c(2, 1) 20 | two_three = c(2, 3) 21 | three_two = c(3, 2) 22 | if (n > 3L) 23 | rxrange = 3:(n - 1) 24 | else 25 | rxrange = integer(0) 26 | 27 | max_flip_count <- 0L 28 | perm_sign <- TRUE 29 | checksum <- 0L 30 | perm1 <- 1:n 31 | count <- 0:(n - 1L) 32 | while (TRUE) { 33 | if (k <- perm1[[1L]]) { 34 | perm <- perm1 35 | flip_count <- 1L 36 | while ((kk <- perm[[k]]) > 1L) { 37 | k_range = 1:k 38 | perm[k_range] <- rev.default(perm[k_range]) 39 | flip_count <- flip_count + 1L 40 | k <- kk 41 | kk <- perm[[kk]] 42 | } 43 | max_flip_count <- max(max_flip_count, flip_count) 44 | checksum <- checksum + if (perm_sign) flip_count else -flip_count 45 | } 46 | 47 | # Use incremental change to generate another permutation 48 | if (perm_sign) { 49 | perm1[one_two] <- perm1[two_one] 50 | perm_sign = FALSE 51 | } else { 52 | perm1[two_three] <- perm1[three_two] 53 | perm_sign = TRUE 54 | was_break <- FALSE 55 | for (r in rxrange) { 56 | if (count[[r]]) { 57 | was_break <- TRUE 58 | break 59 | } 60 | count[[r]] <- r - 1L 61 | perm0 <- perm1[[1L]] 62 | perm1[1:r] <- perm1[2:(r + 1L)] 63 | perm1[[r + 1L]] <- perm0 64 | } 65 | if (!was_break) { 66 | r <- n 67 | if (!count[[r]]) { 68 | cat(checksum, "\n", sep="") 69 | return(max_flip_count) 70 | } 71 | } 72 | count[[r]] <- count[[r]] - 1L 73 | } 74 | } 75 | } 76 | 77 | if (!exists('harness_argc')) { 78 | n <- setup(commandArgs(TRUE)) 79 | cat("Pfannkuchen(", n, ") = ", run(n), "\n", sep="") 80 | } 81 | -------------------------------------------------------------------------------- /shootout/fannkuch-redux/fannkuch-redux_native.R: -------------------------------------------------------------------------------- 1 | # ------------------------------------------------------------------ 2 | # The Computer Language Shootout 3 | # http://shootout.alioth.debian.org/ 4 | # 5 | # Contributed by Leo Osvald 6 | # 7 | # Original Loc: https://raw.github.com/allr/fastr/master/test/r/shootout/fannkuch/fannkuchredux-naive.r 8 | # Modified to be compatible with rbenchmark interface 9 | # Replace all [[]] access to [] access 10 | # ------------------------------------------------------------------ 11 | 12 | setup <- function(args='10') { 13 | n<-as.integer(args[1]) 14 | if(is.na(n)){ n <- 10 } 15 | return(n) 16 | } 17 | 18 | run <- function(n) { 19 | if (n > 3L) 20 | rxrange = 3:(n - 1) 21 | else 22 | rxrange = integer(0) 23 | 24 | max_flip_count <- 0L 25 | perm_sign <- TRUE 26 | checksum <- 0L 27 | perm1 <- 1:n 28 | count <- 0:(n - 1L) 29 | while (TRUE) { 30 | if (k <- perm1[[1L]]) { 31 | perm <- perm1 32 | flip_count <- 1L 33 | while ((kk <- perm[[k]]) > 1L) { 34 | for (lo in 1:(k %/% 2L)) { 35 | hi = k - lo + 1L 36 | t <- perm[[lo]]; perm[[lo]] <- perm[[hi]]; perm[[hi]] <- t 37 | } 38 | flip_count <- flip_count + 1L 39 | k <- kk 40 | kk <- perm[[kk]] 41 | } 42 | max_flip_count <- max(max_flip_count, flip_count) 43 | checksum <- checksum + if (perm_sign) flip_count else -flip_count 44 | } 45 | 46 | # Use incremental change to generate another permutation 47 | if (perm_sign) { 48 | t <- perm1[[1]]; perm1[[1]] <- perm1[[2]]; perm1[[2]] <- t 49 | perm_sign = FALSE 50 | } else { 51 | t <- perm1[[2]]; perm1[[2]] <- perm1[[3]]; perm1[[3]] <- t 52 | perm_sign = TRUE 53 | was_break <- FALSE 54 | for (r in rxrange) { 55 | if (count[[r]]) { 56 | was_break <- TRUE 57 | break 58 | } 59 | count[[r]] <- r - 1L 60 | perm0 <- perm1[[1L]] 61 | for (i in 1:r) 62 | perm1[[i]] <- perm1[[i + 1L]] 63 | perm1[[r + 1L]] <- perm0 64 | } 65 | if (!was_break) { 66 | r <- n 67 | if (!count[[r]]) { 68 | cat(checksum, "\n", sep="") 69 | return(max_flip_count) 70 | } 71 | } 72 | count[[r]] <- count[[r]] - 1L 73 | } 74 | } 75 | } 76 | 77 | if (!exists('harness_argc')) { 78 | n <- setup(commandArgs(TRUE)) 79 | cat("Pfannkuchen(", n, ") = ", run(n), "\n", sep="") 80 | } 81 | -------------------------------------------------------------------------------- /shootout/fasta/Makefile: -------------------------------------------------------------------------------- 1 | LEVEL = ../../../tests 2 | 3 | PARA=2500 4 | PROG=fasta 5 | CFLAG=-pipe -Wall -O3 -fomit-frame-pointer -march=native -std=c99 -mfpmath=sse -msse3 6 | JFLAG=-server -XX:+TieredCompilation -XX:+AggressiveOpts -Xint 7 | include $(LEVEL)/Makefile.common 8 | 9 | 10 | 11 | -------------------------------------------------------------------------------- /shootout/fasta/fasta.R: -------------------------------------------------------------------------------- 1 | # ------------------------------------------------------------------ 2 | # The Computer Language Shootout 3 | # http://shootout.alioth.debian.org/ 4 | # 5 | # Contributed by Leo Osvald 6 | # ------------------------------------------------------------------ 7 | # 8 | # 9 | # Original Loc: https://raw.github.com/allr/fastr/master/test/r/shootout/fasta/fasta.r 10 | # Modified to be compatible with rbenchmark interface 11 | # ------------------------------------------------------------------ 12 | 13 | setup <- function(args='250000') { 14 | n<-as.integer(args[1]) 15 | if(is.na(n)){ n <- 250000 } 16 | return(n) 17 | } 18 | 19 | run <-function(n) { 20 | 21 | width <- 60L 22 | myrandom_last <- 42L 23 | myrandom <- function(m) { 24 | myrandom_last <<- (myrandom_last * 3877L + 29573L) %% 139968L 25 | return(m * myrandom_last / 139968) 26 | } 27 | 28 | alu <- paste( 29 | "GGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGG", 30 | "GAGGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGTTCGAGA", 31 | "CCAGCCTGGCCAACATGGTGAAACCCCGTCTCTACTAAAAAT", 32 | "ACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCA", 33 | "GCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGG", 34 | "AGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCC", 35 | "AGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAA", 36 | sep="", collapse="") 37 | 38 | iub <- matrix(c( 39 | c(0.27, 'a'), 40 | c(0.12, 'c'), 41 | c(0.12, 'g'), 42 | c(0.27, 't'), 43 | c(0.02, 'B'), 44 | c(0.02, 'D'), 45 | c(0.02, 'H'), 46 | c(0.02, 'K'), 47 | c(0.02, 'M'), 48 | c(0.02, 'N'), 49 | c(0.02, 'R'), 50 | c(0.02, 'S'), 51 | c(0.02, 'V'), 52 | c(0.02, 'W'), 53 | c(0.02, 'Y') 54 | ), 2) 55 | 56 | homosapiens <- matrix(c( 57 | c(0.3029549426680, 'a'), 58 | c(0.1979883004921, 'c'), 59 | c(0.1975473066391, 'g'), 60 | c(0.3015094502008, 't') 61 | ), 2) 62 | 63 | repeat_fasta <- function(s, count) { 64 | chars <- strsplit(s, split="")[[1]] 65 | len <- nchar(s) 66 | s2 <- c(chars, chars[1:width]) 67 | pos <- 1L 68 | while (count) { 69 | line <- min(width, count) 70 | next_pos <- pos + line 71 | cat(s2[pos:(next_pos - 1)], "\n", sep="") 72 | pos <- next_pos 73 | if (pos > len) pos <- pos - len 74 | count <- count - line 75 | } 76 | } 77 | 78 | random_fasta <- function(genelist, count) { 79 | psum <- cumsum(genelist[1,]) 80 | while (count) { 81 | line <- min(width, count) 82 | 83 | rs <- double(line) 84 | for (i in 1:line) 85 | rs[[i]] <- myrandom(1) 86 | 87 | cat(genelist[2, colSums(outer(psum, rs, "<")) + 1], "\n", sep='') 88 | count <- count - line 89 | } 90 | } 91 | 92 | 93 | cat(">ONE Homo sapiens alu\n") 94 | repeat_fasta(alu, 2 * n) 95 | cat(">TWO IUB ambiguity codes\n") 96 | random_fasta(iub, 3L * n) 97 | cat(">THREE Homo sapiens frequency\n") 98 | random_fasta(homosapiens, 5L * n) 99 | } 100 | 101 | if (!exists('harness_argc')) { 102 | n <- setup(commandArgs(TRUE)) 103 | run(n) 104 | } -------------------------------------------------------------------------------- /shootout/fasta/fasta.python: -------------------------------------------------------------------------------- 1 | # The Computer Language Benchmarks Game 2 | # http://shootout.alioth.debian.org/ 3 | # 4 | # modified by Ian Osgood 5 | # modified again by Heinrich Acker 6 | # modified by Justin Peel 7 | # modified by Mariano Chouza 8 | # 2to3 9 | 10 | import sys, bisect, array 11 | 12 | alu = ( 13 | 'GGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGG' 14 | 'GAGGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGTTCGAGA' 15 | 'CCAGCCTGGCCAACATGGTGAAACCCCGTCTCTACTAAAAAT' 16 | 'ACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCA' 17 | 'GCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGG' 18 | 'AGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCC' 19 | 'AGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAA') 20 | 21 | iub = list(zip('acgtBDHKMNRSVWY', [0.27, 0.12, 0.12, 0.27] + [0.02]*11)) 22 | 23 | homosapiens = [ 24 | ('a', 0.3029549426680), 25 | ('c', 0.1979883004921), 26 | ('g', 0.1975473066391), 27 | ('t', 0.3015094502008), 28 | ] 29 | 30 | IM = 139968 31 | INITIAL_STATE = 42 32 | 33 | def makeCumulative(table): 34 | P = [] 35 | C = [] 36 | prob = 0. 37 | for char, p in table: 38 | prob += p 39 | P += [prob] 40 | C += [char] 41 | return (P, C) 42 | 43 | randomGenState = INITIAL_STATE 44 | randomLUT = None 45 | def makeRandomLUT(): 46 | global randomLUT 47 | ia = 3877; ic = 29573 48 | randomLUT = [(s * ia + ic) % IM for s in range(IM)] 49 | 50 | def makeLookupTable(table): 51 | bb = bisect.bisect 52 | probs, chars = makeCumulative(table) 53 | imf = float(IM) 54 | return [chars[bb(probs, i / imf)] for i in range(IM)] 55 | 56 | def repeatFasta(src, n): 57 | width = 60 58 | r = len(src) 59 | s = src + src + src[:n % r] 60 | for j in range(n // width): 61 | i = j*width % r 62 | print(s[i:i+width]) 63 | if n % width: 64 | print(s[-(n % width):]) 65 | 66 | def randomFasta(table, n): 67 | global randomLUT, randomGenState 68 | width = 60 69 | rgs = randomGenState 70 | rlut = randomLUT 71 | 72 | lut = makeLookupTable(table) 73 | line_buffer = [] 74 | la = line_buffer.append 75 | 76 | for i in range(n // width): 77 | for i in range(width): 78 | rgs = rlut[rgs] 79 | la(lut[rgs]) 80 | print(''.join(line_buffer)) 81 | line_buffer[:] = [] 82 | if n % width: 83 | for i in range(n % width): 84 | rgs = rlut[rgs] 85 | la(lut[rgs]) 86 | print(''.join(line_buffer)) 87 | 88 | randomGenState = rgs 89 | 90 | def main(): 91 | n = int(sys.argv[1]) 92 | 93 | makeRandomLUT() 94 | 95 | print('>ONE Homo sapiens alu') 96 | repeatFasta(alu, n*2) 97 | 98 | print('>TWO IUB ambiguity codes') 99 | randomFasta(iub, n*3) 100 | 101 | print('>THREE Homo sapiens frequency') 102 | randomFasta(homosapiens, n*5) 103 | 104 | main() 105 | 106 | -------------------------------------------------------------------------------- /shootout/k-nucleotide/Makefile: -------------------------------------------------------------------------------- 1 | LEVEL = ../../.. 2 | 3 | PARA=knucleotide-input50000.txt 4 | PROG=k-nucleotide 5 | REP=2 6 | include $(LEVEL)/common.mk 7 | -------------------------------------------------------------------------------- /shootout/mandelbrot/Makefile: -------------------------------------------------------------------------------- 1 | LEVEL = ../../../tests 2 | 3 | PARA=500 4 | PROG=mandelbrot 5 | CFLAG= -O3 -ffast-math -funroll-loops 6 | include $(LEVEL)/Makefile.common 7 | 8 | 9 | -------------------------------------------------------------------------------- /shootout/mandelbrot/mandelbrot-ascii.R: -------------------------------------------------------------------------------- 1 | # ------------------------------------------------------------------ 2 | # The Computer Language Shootout 3 | # http://shootout.alioth.debian.org/ 4 | # 5 | # Contributed by Leo Osvald 6 | # 7 | # Original Loc: https://github.com/allr/fastr/tree/master/test/r/shootout/mandelbrot 8 | # Modified to be compatible with rbenchmark interface 9 | # ------------------------------------------------------------------ 10 | 11 | 12 | setup <- function(args='1000') { 13 | n<-as.integer(args[1]) 14 | if(is.na(n)){ n <- 1000 } 15 | return(n) 16 | } 17 | 18 | run<-function(n) { 19 | 20 | lim <- 2 21 | iter <- 50 22 | 23 | n_mod8 = n %% 8L 24 | pads <- if (n_mod8) rep.int(0, 8L - n_mod8) else integer(0) 25 | p <- rep(as.integer(rep.int(2, 8) ^ (7:0)), length.out=n) 26 | 27 | cat("P4\n") 28 | cat(n, n, "\n") 29 | for (y in 0:(n-1)) { 30 | c <- 2 * 0:(n-1) / n - 1.5 + 1i * (2 * y / n - 1) 31 | z <- rep(0+0i, n) 32 | i <- 0L 33 | while (i < iter) { # faster than for loop 34 | z <- z * z + c 35 | i <- i + 1L 36 | } 37 | bits <- as.integer(abs(z) <= lim) 38 | bytes <- as.raw(colSums(matrix(c(bits * p, pads), 8L))) 39 | cat(bytes,"\n") 40 | } 41 | } 42 | 43 | if (!exists('harness_argc')) { 44 | n <- setup(commandArgs(TRUE)) 45 | run(n) 46 | } -------------------------------------------------------------------------------- /shootout/mandelbrot/mandelbrot-native-ascii.R: -------------------------------------------------------------------------------- 1 | # ------------------------------------------------------------------ 2 | # The Computer Language Shootout 3 | # http://shootout.alioth.debian.org/ 4 | # 5 | # Contributed by Leo Osvald 6 | # 7 | # Original Loc: https://github.com/allr/fastr/tree/master/test/r/shootout/mandelbrot 8 | # Modified to be compatible with rbenchmark interface 9 | # ------------------------------------------------------------------ 10 | 11 | 12 | setup <- function(args='1000') { 13 | n<-as.integer(args[1]) 14 | if(is.na(n)){ n <- 1000 } 15 | return(n) 16 | } 17 | 18 | run<-function(n) { 19 | 20 | lim <- 2 21 | iter <- 50 22 | 23 | cat("P4\n") 24 | cat(n, n, "\n") 25 | for (y in 0:(n-1)) { 26 | bits <- 0L 27 | x <- 0L 28 | while (x < n) { 29 | c <- 2 * x / n - 1.5 + 1i * (2 * y / n - 1) 30 | z <- 0+0i 31 | i <- 0L 32 | while (i < iter && abs(z) <= lim) { 33 | z <- z * z + c 34 | i <- i + 1L 35 | } 36 | bits <- 2L * bits + as.integer(abs(z) <= lim) 37 | if ((x <- x + 1L) %% 8L == 0) { 38 | cat(as.raw(bits), "\n") 39 | bits <- 0L 40 | } 41 | } 42 | xmod <- x %% 8L 43 | if (xmod) 44 | cat(as.raw(bits * as.integer(2^(8L - xmod))), "\n") 45 | } 46 | } 47 | 48 | if (!exists('harness_argc')) { 49 | n <- setup(commandArgs(TRUE)) 50 | run(n) 51 | } -------------------------------------------------------------------------------- /shootout/mandelbrot/mandelbrot-native.R: -------------------------------------------------------------------------------- 1 | # ------------------------------------------------------------------ 2 | # The Computer Language Shootout 3 | # http://shootout.alioth.debian.org/ 4 | # 5 | # Contributed by Leo Osvald 6 | # 7 | # Original Loc: https://github.com/allr/fastr/tree/master/test/r/shootout/mandelbrot 8 | # Modified to be compatible with rbenchmark interface 9 | # ------------------------------------------------------------------ 10 | 11 | 12 | setup <- function(args='1000') { 13 | n<-as.integer(args[1]) 14 | if(is.na(n)){ n <- 1000 } 15 | return(n) 16 | } 17 | 18 | run<-function(n) { 19 | 20 | lim <- 2 21 | iter <- 50 22 | 23 | cat("P4\n") 24 | cat(n, n, "\n") 25 | bin_con <- pipe("cat", "wb") 26 | for (y in 0:(n-1)) { 27 | bits <- 0L 28 | x <- 0L 29 | while (x < n) { 30 | c <- 2 * x / n - 1.5 + 1i * (2 * y / n - 1) 31 | z <- 0+0i 32 | i <- 0L 33 | while (i < iter && abs(z) <= lim) { 34 | z <- z * z + c 35 | i <- i + 1L 36 | } 37 | bits <- 2L * bits + as.integer(abs(z) <= lim) 38 | if ((x <- x + 1L) %% 8L == 0) { 39 | writeBin(as.raw(bits), bin_con) 40 | bits <- 0L 41 | } 42 | } 43 | xmod <- x %% 8L 44 | if (xmod) 45 | writeBin(as.raw(bits * as.integer(2^(8L - xmod))), bin_con) 46 | flush(bin_con) 47 | } 48 | } 49 | 50 | if (!exists('harness_argc')) { 51 | n <- setup(commandArgs(TRUE)) 52 | run(n) 53 | } -------------------------------------------------------------------------------- /shootout/mandelbrot/mandelbrot-noout-native.R: -------------------------------------------------------------------------------- 1 | # ------------------------------------------------------------------ 2 | # The Computer Language Shootout 3 | # http://shootout.alioth.debian.org/ 4 | # 5 | # Contributed by Leo Osvald 6 | # 7 | # Original Loc: https://github.com/allr/fastr/tree/master/test/r/shootout/mandelbrot 8 | # Modified to be compatible with rbenchmark interface 9 | # ------------------------------------------------------------------ 10 | 11 | 12 | setup <- function(args='1000') { 13 | n<-as.integer(args[1]) 14 | if(is.na(n)){ n <- 1000 } 15 | return(n) 16 | } 17 | 18 | run<-function(n) { 19 | 20 | lim <- 2 21 | iter <- 50 22 | 23 | n_mod8 = n %% 8L 24 | pads <- if (n_mod8) rep.int(0, 8L - n_mod8) else integer(0) 25 | p <- rep(as.integer(rep.int(2, 8) ^ (7:0)), length.out=n) 26 | 27 | cat("P4\n") 28 | cat(n, n, "\n") 29 | C <- matrix(0, n, n) 30 | for (y in 0:(n-1)) { 31 | C[, y] <- 2 * 0:(n-1) / n - 1.5 + 1i * (2 * y / n - 1) 32 | } 33 | 34 | m <- n 35 | Z <- 0 # initialize Z to zero 36 | X <- array(0, c(m,m,20)) # initialize output 3D array 37 | for (k in 1:20) { # loop with 20 iterations 38 | Z <- Z^2+C # the central difference equation 39 | X[,,k] <- exp(-abs(Z)) # capture results 40 | } 41 | } 42 | 43 | if (!exists('harness_argc')) { 44 | n <- setup(commandArgs(TRUE)) 45 | run(n) 46 | } -------------------------------------------------------------------------------- /shootout/mandelbrot/mandelbrot-noout.R: -------------------------------------------------------------------------------- 1 | # ------------------------------------------------------------------ 2 | # The Computer Language Shootout 3 | # http://shootout.alioth.debian.org/ 4 | # 5 | # Contributed by Leo Osvald 6 | # 7 | # Original Loc: https://github.com/allr/fastr/tree/master/test/r/shootout/mandelbrot 8 | # Modified to be compatible with rbenchmark interface 9 | # ------------------------------------------------------------------ 10 | 11 | 12 | setup <- function(args='1000') { 13 | n<-as.integer(args[1]) 14 | if(is.na(n)){ n <- 1000 } 15 | return(n) 16 | } 17 | 18 | run<-function(n) { 19 | 20 | lim <- 2 21 | iter <- 50 22 | 23 | n_mod8 = n %% 8L 24 | pads <- if (n_mod8) rep.int(0, 8L - n_mod8) else integer(0) 25 | p <- rep(as.integer(rep.int(2, 8) ^ (7:0)), length.out=n) 26 | 27 | cat("P4\n") 28 | cat(n, n, "\n") 29 | #bin_con <- pipe("cat", "wb") 30 | for (y in 0:(n-1)) { 31 | c <- 2 * 0:(n-1) / n - 1.5 + 1i * (2 * y / n - 1) 32 | z <- rep(0+0i, n) 33 | i <- 0L 34 | while (i < iter) { # faster than for loop 35 | z <- z * z + c 36 | i <- i + 1L 37 | } 38 | bits <- as.integer(abs(z) <= lim) 39 | bytes <- as.raw(colSums(matrix(c(bits * p, pads), 8L))) 40 | } 41 | } 42 | 43 | if (!exists('harness_argc')) { 44 | n <- setup(commandArgs(TRUE)) 45 | run(n) 46 | } -------------------------------------------------------------------------------- /shootout/mandelbrot/mandelbrot.R: -------------------------------------------------------------------------------- 1 | # ------------------------------------------------------------------ 2 | # The Computer Language Shootout 3 | # http://shootout.alioth.debian.org/ 4 | # 5 | # Contributed by Haichuan Wang 6 | # This is a Type I version mandelbrot. 7 | ############################################################################### 8 | 9 | 10 | setup <- function(args='1000') { 11 | n<-as.integer(args[1]) 12 | if(is.na(n)){ n <- 1000 } 13 | return(n) 14 | } 15 | 16 | run<-function(num) { 17 | 18 | bit_num = 0L; 19 | byte_acc <- 0L; 20 | iter <- 50; 21 | limit <- 2.0; 22 | 23 | w <- h <- num; 24 | 25 | print("P4"); 26 | cat(w,h, "\n"); 27 | bin_con <- pipe("cat", "wb") 28 | for(y in 0:(h-1)) { 29 | for(x in 0:(w-1)){ 30 | Zr <- Zi <- Tr <- Ti <- 0.0; 31 | Cr <- (2.0*x/w - 1.5); 32 | Ci <- (2.0*y/h - 1.0); 33 | 34 | for (i in 1:iter){ 35 | if((Tr+Ti > limit*limit)) { break;} 36 | Zi <- 2.0*Zr*Zi + Ci; 37 | Zr <- Tr - Ti + Cr; 38 | Tr <- Zr * Zr; 39 | Ti <- Zi * Zi; 40 | } 41 | 42 | byte_acc <- (byte_acc * 2L) %% 256L; 43 | if(Tr+Ti <= limit*limit) { 44 | if(byte_acc %% 2L == 0L) { 45 | byte_acc <- byte_acc + 1L; 46 | } 47 | } 48 | 49 | bit_num <- bit_num + 1L; 50 | 51 | if(bit_num == 8L) { 52 | bytes <- as.raw(byte_acc); 53 | writeBin(bytes, bin_con) 54 | byte_acc <- 0L; 55 | bit_num <- 0L; 56 | } 57 | else if(x == (w - 1)) { 58 | 59 | byte_acc <- (byte_acc* as.integer(2L^(8-w%%8))) %% 256L; 60 | bytes <- as.raw(byte_acc); 61 | writeBin(bytes, bin_con) 62 | byte_acc <- 0L; 63 | bit_num <- 0L; 64 | } 65 | } 66 | } 67 | flush(bin_con) 68 | } 69 | 70 | if (!exists('harness_argc')) { 71 | n <- setup(commandArgs(TRUE)) 72 | run(n) 73 | } -------------------------------------------------------------------------------- /shootout/mandelbrot/mandelbrot.c: -------------------------------------------------------------------------------- 1 | /* The Computer Language Benchmarks Game 2 | * http://benchmarksgame.alioth.debian.org/ 3 | 4 | contributed by Greg Buchholz 5 | 6 | for the debian (AMD) machine... 7 | compile flags: -O3 -ffast-math -march=athlon-xp -funroll-loops 8 | 9 | for the gp4 (Intel) machine... 10 | compile flags: -O3 -ffast-math -march=pentium4 -funroll-loops 11 | */ 12 | 13 | #include 14 | 15 | int main (int argc, char **argv) 16 | { 17 | int w, h, bit_num = 0; 18 | char byte_acc = 0; 19 | int i, iter = 50; 20 | double x, y, limit = 2.0; 21 | double Zr, Zi, Cr, Ci, Tr, Ti; 22 | 23 | w = h = atoi(argv[1]); 24 | 25 | printf("P4\n%d %d\n",w,h); 26 | 27 | for(y=0;y 8 | #include 9 | #include 10 | 11 | mpz_t tmp1, tmp2, acc, den, num; 12 | typedef unsigned int ui; 13 | 14 | ui extract_digit(ui nth) { 15 | // joggling between tmp1 and tmp2, so GMP won't have to use temp buffers 16 | mpz_mul_ui(tmp1, num, nth); 17 | mpz_add(tmp2, tmp1, acc); 18 | mpz_tdiv_q(tmp1, tmp2, den); 19 | 20 | return mpz_get_ui(tmp1); 21 | } 22 | 23 | void eliminate_digit(ui d) { 24 | mpz_submul_ui(acc, den, d); 25 | mpz_mul_ui(acc, acc, 10); 26 | mpz_mul_ui(num, num, 10); 27 | } 28 | 29 | void next_term(ui k) { 30 | ui k2 = k * 2U + 1U; 31 | 32 | mpz_addmul_ui(acc, num, 2U); 33 | mpz_mul_ui(acc, acc, k2); 34 | mpz_mul_ui(den, den, k2); 35 | mpz_mul_ui(num, num, k); 36 | } 37 | 38 | int main(int argc, char **argv) { 39 | ui d, k, i; 40 | int n = atoi(argv[1]); 41 | 42 | mpz_init(tmp1); 43 | mpz_init(tmp2); 44 | 45 | mpz_init_set_ui(acc, 0); 46 | mpz_init_set_ui(den, 1); 47 | mpz_init_set_ui(num, 1); 48 | 49 | for (i = k = 0; i < n;) { 50 | next_term(++k); 51 | if (mpz_cmp(num, acc) > 0) 52 | continue; 53 | 54 | d = extract_digit(3); 55 | if (d != extract_digit(4)) 56 | continue; 57 | 58 | putchar('0' + d); 59 | if (++i % 10 == 0) 60 | printf("\t:%u\n", i); 61 | eliminate_digit(d); 62 | } 63 | 64 | return 0; 65 | } 66 | -------------------------------------------------------------------------------- /shootout/pidigits/pidigits.python: -------------------------------------------------------------------------------- 1 | # The Computer Language Benchmarks Game 2 | # http://benchmarksgame.alioth.debian.org/ 3 | # contributed by Joseph LaFata 4 | 5 | from sys import argv 6 | 7 | try: 8 | N = int(argv[1]) 9 | except: 10 | N = 100 11 | 12 | i = k = ns = 0 13 | k1 = 1 14 | n,a,d,t,u = (1,0,1,0,0) 15 | while(1): 16 | k += 1 17 | t = n<<1 18 | n *= k 19 | a += t 20 | k1 += 2 21 | a *= k1 22 | d *= k1 23 | if a >= n: 24 | t,u = divmod(n*3 +a,d) 25 | u += n 26 | if d > u: 27 | ns = ns*10 + t 28 | i += 1 29 | if i % 10 == 0: 30 | print ('%010d\t:%d' % (ns, i)) 31 | ns = 0 32 | if i >= N: 33 | break 34 | a -= d*t 35 | a *= 10 36 | n *= 10 -------------------------------------------------------------------------------- /shootout/regex-dna/regexdna.R: -------------------------------------------------------------------------------- 1 | # ------------------------------------------------------------------ 2 | # The Computer Language Shootout 3 | # http://shootout.alioth.debian.org/ 4 | # 5 | # Contributed by Leo Osvald 6 | # 7 | # Original Loc: https://github.com/allr/fastr/tree/master/test/r/shootout/regexdna 8 | # Modified to be compatible with rbenchmark interface 9 | # ------------------------------------------------------------------ 10 | 11 | setup <- function(args='regexdna-input500000.txt') { 12 | if(length(args) >= 1) { 13 | filename<-args[1] 14 | } else { 15 | filename = 'regexdna-input500000.txt' 16 | } 17 | return(filename) 18 | } 19 | 20 | 21 | run <- function(in_filename) { 22 | pattern1 <- c( 23 | "agggtaaa|tttaccct", 24 | "[cgt]gggtaaa|tttaccc[acg]", 25 | "a[act]ggtaaa|tttacc[agt]t", 26 | "ag[act]gtaaa|tttac[agt]ct", 27 | "agg[act]taaa|ttta[agt]cct", 28 | "aggg[acg]aaa|ttt[cgt]ccct", 29 | "agggt[cgt]aa|tt[acg]accct", 30 | "agggta[cgt]a|t[acg]taccct", 31 | "agggtaa[cgt]|[acg]ttaccct") 32 | 33 | pattern2 <- matrix(c( 34 | c("B", "(c|g|t)"), 35 | c("D", "(a|g|t)"), 36 | c("H", "(a|c|t)"), 37 | c("K", "(g|t)"), 38 | c("M", "(a|c)"), 39 | c("N", "(a|c|g|t)"), 40 | c("R", "(a|g)"), 41 | c("S", "(c|g)"), 42 | c("V", "(a|c|g)"), 43 | c("W", "(a|t)"), 44 | c("Y", "(c|t)") 45 | ), ncol=2, byrow=TRUE) 46 | 47 | match_count <- function(ms) { 48 | l <- length(ms[[1]]) 49 | fst <- ms[[1]][[1]] 50 | return(if (l > 1) l else if (fst != -1L) fst else 0) 51 | } 52 | 53 | 54 | f <- file(in_filename, "r") 55 | str <- paste(c(readLines(f), ""), collapse="\n") 56 | close(f) 57 | 58 | len1 <- nchar(str) 59 | str <- gsub(">.*\n|\n", "", str, perl=TRUE, useBytes=TRUE) 60 | len2 <- nchar(str) 61 | 62 | for (pat in pattern1) 63 | cat(pat, match_count(gregexpr(pat, str, useBytes=TRUE)), "\n") 64 | 65 | for (i in 1:nrow(pattern2)) 66 | str <- gsub(pattern2[[i, 1]], pattern2[[i, 2]], str, perl=TRUE, 67 | useBytes=TRUE) 68 | 69 | cat("", len1, len2, nchar(str), sep="\n") 70 | } 71 | 72 | 73 | if (!exists('harness_argc', mode='numeric')) { 74 | in_filename = setup(commandArgs(TRUE)) 75 | run(in_filename) 76 | } 77 | -------------------------------------------------------------------------------- /shootout/reverse-complement/Makefile: -------------------------------------------------------------------------------- 1 | LEVEL = ../../../tests 2 | 3 | #if use R, no need PARA 4 | PARA== 1) { 13 | filename<-args[1] 14 | } else { 15 | filename = 'revcomp-input250000.txt' 16 | } 17 | return(filename) 18 | } 19 | 20 | run<-function(in_filename) { 21 | codes <- c( 22 | "A", "C", "G", "T", "U", "M", "R", "W", "S", "Y", "K", "V", "H", "D", "B", 23 | "N") 24 | complements <- c( 25 | "T", "G", "C", "A", "A", "K", "Y", "W", "S", "R", "M", "B", "D", "H", "V", 26 | "N") 27 | comp_map <- NULL 28 | comp_map[codes] <- complements 29 | comp_map[tolower(codes)] <- complements 30 | 31 | f <- file(in_filename, "r") 32 | while (length(s <- readLines(f, n=1, warn=FALSE))) { 33 | codes <- strsplit(s, split="")[[1]] 34 | if (codes[[1]] == '>') 35 | cat(s, "\n", sep="") 36 | else { 37 | cat(paste(comp_map[codes], collapse=""), "\n", sep="") 38 | } 39 | } 40 | close(f) 41 | 42 | 43 | } 44 | 45 | if (!exists('harness_argc', mode='numeric')) { 46 | in_filename = setup(commandArgs(TRUE)) 47 | run(in_filename) 48 | } 49 | -------------------------------------------------------------------------------- /shootout/reverse-complement/revcomp-2.R: -------------------------------------------------------------------------------- 1 | # ------------------------------------------------------------------ 2 | # The Computer Language Shootout 3 | # http://shootout.alioth.debian.org/ 4 | # 5 | # Contributed by Leo Osvald 6 | # 7 | # Original Loc: https://github.com/allr/fastr/tree/master/test/r/shootout/reversecomplement 8 | # Modified to be compatible with rbenchmark interface 9 | # ------------------------------------------------------------------ 10 | 11 | setup <- function(args='revcomp-input250000.txt') { 12 | if(length(args) >= 1) { 13 | filename<-args[1] 14 | } else { 15 | filename = 'revcomp-input250000.txt' 16 | } 17 | return(filename) 18 | } 19 | 20 | run<-function(in_filename) { 21 | codes <- c( 22 | "A", "C", "G", "T", "U", "M", "R", "W", "S", "Y", "K", "V", "H", "D", "B", 23 | "N") 24 | complements <- c( 25 | "T", "G", "C", "A", "A", "K", "Y", "W", "S", "R", "M", "B", "D", "H", "V", 26 | "N") 27 | comp_map <- NULL 28 | comp_map[codes] <- complements 29 | comp_map[tolower(codes)] <- complements 30 | 31 | f <- file(in_filename, "r") 32 | lines <- readLines(f) 33 | for (i in 1:length(lines)) { 34 | codes <- strsplit(lines[[i]], split="")[[1]] 35 | if (codes[[1]] == '>') 36 | cat(lines[[i]], "\n", sep="") 37 | else { 38 | cat(paste(comp_map[codes], collapse=""), "\n", 39 | sep="") 40 | } 41 | } 42 | close(f) 43 | 44 | 45 | } 46 | 47 | if (!exists('harness_argc', mode='numeric')) { 48 | in_filename = setup(commandArgs(TRUE)) 49 | run(in_filename) 50 | } 51 | -------------------------------------------------------------------------------- /shootout/reverse-complement/revcomp-input.short: -------------------------------------------------------------------------------- 1 | >ONE Homo sapiens alu 2 | GGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGA 3 | >TWO IUB ambiguity codes 4 | cttBtatcatatgctaKggNcataaaSatgtaaaDcDRtBggDtctttataattcBgtcg 5 | -------------------------------------------------------------------------------- /shootout/reverse-complement/revcomp-native.R: -------------------------------------------------------------------------------- 1 | # ------------------------------------------------------------------ 2 | # The Computer Language Shootout 3 | # http://shootout.alioth.debian.org/ 4 | # 5 | # Contributed by Leo Osvald 6 | # 7 | # Original Loc: https://github.com/allr/fastr/tree/master/test/r/shootout/reversecomplement 8 | # Modified to be compatible with rbenchmark interface 9 | # ------------------------------------------------------------------ 10 | 11 | setup <- function(args='revcomp-input250000.txt') { 12 | if(length(args) >= 1) { 13 | filename<-args[1] 14 | } else { 15 | filename = 'revcomp-input250000.txt' 16 | } 17 | return(filename) 18 | } 19 | 20 | run<-function(in_filename) { 21 | codes <- c( 22 | "A", "C", "G", "T", "U", "M", "R", "W", "S", "Y", "K", "V", "H", "D", "B", 23 | "N") 24 | complements <- c( 25 | "T", "G", "C", "A", "A", "K", "Y", "W", "S", "R", "M", "B", "D", "H", "V", 26 | "N") 27 | comp_map <- NULL 28 | comp_map[codes] <- complements 29 | comp_map[tolower(codes)] <- complements 30 | 31 | f <- file(in_filename, "r") 32 | while (length(s <- readLines(f, n=1, warn=FALSE))) { 33 | codes <- strsplit(s, split="")[[1]] 34 | if (codes[[1]] == '>') 35 | cat(s, "\n", sep="") 36 | else { 37 | for (j in 1:length(codes)) 38 | codes[[j]] <- comp_map[[codes[[j]]]] 39 | cat(paste(codes, collapse=""), "\n", sep="") 40 | } 41 | } 42 | close(f) 43 | 44 | } 45 | 46 | if (!exists('harness_argc', mode='numeric')) { 47 | in_filename = setup(commandArgs(TRUE)) 48 | run(in_filename) 49 | } 50 | -------------------------------------------------------------------------------- /shootout/reverse-complement/revcomp.R: -------------------------------------------------------------------------------- 1 | 2 | 3 | setup <- function(args='revcomp-input250000.txt') { 4 | if(length(args) >= 1) { 5 | filename<-args[1] 6 | } else { 7 | filename = 'revcomp-input250000.txt' 8 | } 9 | return(filename) 10 | } 11 | 12 | run<-function(inputfile) { 13 | exchange = function (i,j,k,l) { 14 | t=complement[[substr(data[i],j,j)]]; 15 | substr(data[i],j,j)<<-complement[[substr(data[k],l,l)]]; 16 | substr(data[k],l,l)<<-t; 17 | } 18 | reverse = function(i,j) { 19 | if (i+1 >= j){ 20 | print("Empty sequence"); 21 | stop(); 22 | } 23 | 24 | fLine=i+1; 25 | bLine=j-1; 26 | fChar=1; 27 | bChar=nchar(data[bLine]); 28 | while (fLine <= bLine && (fLine != bLine || fChar < bChar)) { 29 | exchange(fLine,fChar,bLine, bChar); 30 | fChar=fChar+1; 31 | if (fChar > nchar(data[fLine])){ 32 | fChar=1; 33 | fLine=fLine+1; 34 | } 35 | bChar=bChar-1; 36 | if (bChar <= 0){ 37 | bLine = bLine-1; 38 | bChar = nchar(data[bLine]); 39 | } 40 | } 41 | 42 | } 43 | 44 | complement=list(); 45 | complement[c("A","C","G","T","U","M","R","W","S","Y","K","V","H","D","B","N")]= 46 | c("T","G","C","A","A","K","Y","W","S","R","M","B","D","H","V","N"); 47 | complement[c("a","c","g","t","u","m","r","w","s","y","k","v","h","d","b","n")]= 48 | c("T","G","C","A","A","K","Y","W","S","R","M","B","D","H","V","N"); 49 | data=readLines(inputfile); 50 | headers=c(1:length(data))[substr(data,1,1)==">"] 51 | if (is.na(headers) || ((init<-headers[1]) != 1)) { 52 | print("File does not start with >"); 53 | stop(); 54 | } 55 | for (i in headers[2:length(headers)]){ 56 | reverse(init,i); 57 | init=i; 58 | } 59 | reverse(init, as.integer(length(data)+1)); 60 | cat(data, sep='\n'); 61 | } 62 | 63 | if (!exists('harness_argc', mode='numeric')) { 64 | in_filename = setup(commandArgs(TRUE)) 65 | run(in_filename) 66 | } 67 | -------------------------------------------------------------------------------- /shootout/reverse-complement/reverse.f90: -------------------------------------------------------------------------------- 1 | ! The Computer Language Shootout 2 | ! http://shootout.alioth.debian.org/ 3 | ! 4 | ! contributed by Steve Decker, modified from the version by Simon Geard 5 | ! compilation: 6 | ! g95 -O3 reverse.f90 7 | ! ifort -ipo -O3 -static reverse.f90 8 | 9 | program revcomp 10 | implicit none 11 | 12 | character, parameter :: EndStr = ">" 13 | integer, parameter :: LineWidth = 60 14 | 15 | character(len=LineWidth), dimension(:), allocatable :: data, w 16 | logical :: insection = .false. 17 | integer :: stat, bcount 18 | character(len=LineWidth) :: line, title 19 | 20 | ! Read and process 21 | allocate(data(100)) ! Allocate enough lines so that we don't have to grow the array for the test 22 | readFile: do 23 | read(*, "(a)", iostat=stat) line 24 | if (stat /= 0) exit readFile 25 | if (line(1:1) == EndStr) then 26 | if (insection) then 27 | write(*, "(a)") trim(title) 28 | call printReverseFasta 29 | else 30 | insection = .true. 31 | end if 32 | title = line 33 | bcount = 0 34 | cycle readFile 35 | end if 36 | bcount = bcount + 1 37 | if (bcount > size(data)) then ! Included for completeness - it shouldn't be called in the test 38 | allocate(w(size(data))) 39 | w = data 40 | deallocate(data) 41 | allocate(data(2*size(w))) 42 | data(1:size(w)) = w 43 | deallocate(w) 44 | end if 45 | data(bcount) = line 46 | end do readFile 47 | 48 | write(*, "(a)") trim(title) 49 | call printReverseFasta 50 | 51 | contains 52 | 53 | subroutine printReverseFasta 54 | ! Output the data in reverse order and with the complement 55 | character, dimension(65:121), parameter :: Complement = (/ "T", "V", "G", & 56 | "H", "E", "F", "C", "D", "I", "J", "M", "L", "K", "N", "O", "P", & 57 | "Q", "Y", "S", "A", "A", "B", "W", "X", "R", (" ", stat = 90, 96), & 58 | "T", "V", "G", "H", "E", "F", "C", "D", "I", "J", "M", "L", "K", & 59 | "N", "O", "P", "Q", "Y", "S", "A", "A", "B", "W", "X", "R" /) 60 | 61 | integer :: fLine, fChar, bLine, bChar 62 | character :: c 63 | 64 | fLine = 1 65 | fChar = 1 66 | bLine = bcount 67 | bChar = len_trim(data(bLine)) 68 | do 69 | if (fLine > bLine .or. fLine == bLine .and. fChar >= bChar) exit 70 | c = data(fLine)(fChar:fChar) 71 | data(fLine)(fChar:fChar) = Complement(iachar(data(bLine)(bChar:bChar))) 72 | data(bLine)(bChar:bChar) = Complement(iachar(c)) 73 | fChar = fChar + 1 74 | if (fChar > LineWidth) then 75 | fChar = 1 76 | fLine = fLine + 1 77 | end if 78 | bChar = bChar - 1 79 | if (bChar == 0) then 80 | bChar = LineWidth 81 | bLine = bLine - 1 82 | end if 83 | end do 84 | if (fLine == bLine .and. fChar == bChar) & 85 | data(fLine)(fChar:fChar) = Complement(iachar(data(fLine)(fChar:fChar))) 86 | do fLine = 1, bcount-1 87 | write(*, "(a)") data(fLine) 88 | end do 89 | write(*, "(a)") trim(data(bcount)) 90 | end subroutine printReverseFasta 91 | end program revcomp 92 | 93 | -------------------------------------------------------------------------------- /shootout/reverse-complement/reverse.java: -------------------------------------------------------------------------------- 1 | /* 2 | 3 | * The Computer Language Benchmarks Game 4 | 5 | * http://shootout.alioth.debian.org/ 6 | 7 | 8 | 9 | * contributed by Jon Edvardsson 10 | 11 | * added parallel processing to the original 12 | 13 | * program by Anthony Donnefort and Enotus. 14 | 15 | */ 16 | 17 | import java.io.IOException; 18 | import java.util.LinkedList; 19 | import java.util.List; 20 | import java.util.concurrent.ForkJoinPool; 21 | import java.util.concurrent.RecursiveAction; 22 | 23 | public final class reverse { 24 | 25 | static final ForkJoinPool fjPool = new ForkJoinPool(); 26 | 27 | static final byte[] map = new byte[128]; 28 | 29 | static { 30 | String[] mm = {"ACBDGHK\nMNSRUTWVYacbdghkmnsrutwvy", 31 | "TGVHCDM\nKNSYAAWBRTGVHCDMKNSYAAWBR"}; 32 | for (int i = 0; i < mm[0].length(); i++) 33 | map[mm[0].charAt(i)] = (byte) mm[1].charAt(i); 34 | } 35 | 36 | private static class Reverse extends RecursiveAction { 37 | private byte[] buf; 38 | private int begin; 39 | private int end; 40 | 41 | public Reverse(byte[] buf, int begin, int end) { 42 | this.buf = buf; 43 | this.begin = begin; 44 | this.end = end; 45 | } 46 | 47 | protected void compute() { 48 | byte[] buf = this.buf; 49 | int begin = this.begin; 50 | int end = this.end; 51 | 52 | while (true) { 53 | byte bb = buf[begin]; 54 | if (bb == '\n') 55 | bb = buf[++begin]; 56 | byte be = buf[end]; 57 | if (be == '\n') 58 | be = buf[--end]; 59 | if (begin > end) 60 | break; 61 | buf[begin++] = be; 62 | buf[end--] = bb; 63 | } 64 | } 65 | } 66 | 67 | public static void main(String[] args) throws IOException, InterruptedException { 68 | final byte[] buf = new byte[System.in.available()]; 69 | System.in.read(buf); 70 | List tasks = new LinkedList(); 71 | 72 | for (int i = 0; i < buf.length; ) { 73 | while (buf[i++] != '\n') ; 74 | int data = i; 75 | byte b; 76 | while (i < buf.length && (b = buf[i++]) != '>') { 77 | buf[i-1] = map[b]; 78 | } 79 | Reverse task = new Reverse(buf, data, i - 2); 80 | fjPool.execute(task); 81 | tasks.add(task); 82 | } 83 | for (Reverse task : tasks) { 84 | task.join(); 85 | } 86 | 87 | System.out.write(buf); 88 | } 89 | } -------------------------------------------------------------------------------- /shootout/reverse-complement/reverse.python: -------------------------------------------------------------------------------- 1 | # The Computer Language Benchmarks Game 2 | 3 | # http://benchmarksgame.alioth.debian.org/ 4 | 5 | # 6 | 7 | # contributed by Jacob Lee, Steven Bethard, et al 8 | 9 | # 2to3 10 | 11 | # fixed by Daniele Varrazzo 12 | 13 | 14 | import sys, string 15 | 16 | def show(seq, 17 | table=bytes.maketrans(b'ACBDGHK\nMNSRUTWVYacbdghkmnsrutwvy', 18 | b'TGVHCDM\nKNSYAAWBRTGVHCDMKNSYAAWBR')): 19 | 20 | seq = (''.join(seq)).translate(table)[::-1] 21 | for i in range(0, len(seq), 60): 22 | print(seq[i:i+60]) 23 | 24 | 25 | def main(): 26 | seq = [] 27 | add_line = seq.append 28 | for line in sys.stdin: 29 | if line[0] in '>;': 30 | show(seq) 31 | print(line, end='') 32 | del seq[:] 33 | else: 34 | add_line(line[:-1]) 35 | show(seq) 36 | 37 | main() -------------------------------------------------------------------------------- /shootout/shootout.list: -------------------------------------------------------------------------------- 1 | #Six shootout benchmarks use by ORBIT paper 2 | nbody/nbody.R 3 | fannkuch-redux/fannkuch-redux.R 4 | spectral-norm/spectral-norm.R 5 | mandelbrot/mandelbrot.R 6 | pidigits/pidigits.R 7 | binary-trees/binary-trees.R -------------------------------------------------------------------------------- /shootout/spectral-norm/Makefile: -------------------------------------------------------------------------------- 1 | LEVEL = ../../../tests 2 | 3 | #PARA=5500 4 | PARA=100 5 | PROG=spectralnorm 6 | CFLAG= -pipe -Wall -O3 -fomit-frame-pointer -march=native -Os -fopenmp -mfpmath=sse -msse2 -lm 7 | JFLAG=-server -XX:+TieredCompilation -XX:+AggressiveOpts 8 | include $(LEVEL)/Makefile.common 9 | 10 | 11 | 12 | -------------------------------------------------------------------------------- /shootout/spectral-norm/README: -------------------------------------------------------------------------------- 1 | Build: 2 | - fortran: gfortran spectral-norm.f90 3 | 4 | Runargs: 5500 5 | 6 | Examples: 7 | 8 | ./a.out 5500 9 | -------------------------------------------------------------------------------- /shootout/spectral-norm/spectral-norm-1.R: -------------------------------------------------------------------------------- 1 | # ------------------------------------------------------------------ 2 | # The Computer Language Shootout 3 | # http://shootout.alioth.debian.org/ 4 | # 5 | # Contributed by Leo Osvald 6 | # 7 | # Original Loc: https://github.com/allr/fastr/blob/master/test/r/shootout/spectralnorm/ 8 | # Modified to be compatible with rbenchmark interface 9 | # ------------------------------------------------------------------ 10 | 11 | setup <- function(args='3000') { 12 | n<-as.integer(args[1]) 13 | if(is.na(n)){ n <- 3000L } 14 | return(n) 15 | } 16 | 17 | run <-function(n) { 18 | 19 | options(digits=10) 20 | 21 | eval_A <- function(i, j) 1 / ((i + j) * (i + j + 1) / 2 + i + 1) 22 | eval_A_times_u <- function(u) { 23 | ret <- double(n) 24 | for (i in 0:n1) { 25 | eval_A_col <- double(n) 26 | for (j in 0:n1) 27 | eval_A_col[[j + 1]] <- eval_A(i, j) 28 | ret[[i + 1]] <- u %*% eval_A_col 29 | } 30 | return(ret) 31 | } 32 | eval_At_times_u <- function(u) { 33 | ret <- double(n) 34 | for (i in 0:n1) { 35 | eval_At_col <- double(n) 36 | for (j in 0:n1) 37 | eval_At_col[[j + 1]] <- eval_A(j, i) 38 | ret[[i + 1]] <- u %*% eval_At_col 39 | } 40 | return(ret) 41 | } 42 | eval_AtA_times_u <- function(u) eval_At_times_u(eval_A_times_u(u)) 43 | 44 | n1 <- n - 1 45 | u <- rep(1, n) 46 | v <- rep(0, n) 47 | for (itr in seq(10)) { 48 | v <- eval_AtA_times_u(u) 49 | u <- eval_AtA_times_u(v) 50 | } 51 | 52 | cat(sqrt(sum(u * v) / sum(v * v)), "\n") 53 | 54 | } 55 | 56 | if (!exists('harness_argc')) { 57 | n <- setup(commandArgs(TRUE)) 58 | run(n) 59 | } 60 | -------------------------------------------------------------------------------- /shootout/spectral-norm/spectral-norm-alt.R: -------------------------------------------------------------------------------- 1 | # ------------------------------------------------------------------ 2 | # The Computer Language Shootout 3 | # http://shootout.alioth.debian.org/ 4 | # 5 | # Contributed by Leo Osvald 6 | # 7 | # Original Loc: https://github.com/allr/fastr/blob/master/test/r/shootout/spectralnorm/ 8 | # Modified to be compatible with rbenchmark interface 9 | # ------------------------------------------------------------------ 10 | 11 | setup <- function(args='3000') { 12 | n<-as.integer(args[1]) 13 | if(is.na(n)){ n <- 3000L } 14 | return(n) 15 | } 16 | 17 | run <-function(n) { 18 | 19 | options(digits=10) 20 | 21 | eval_A <- function(i, j) 1 / ((i + j - 2) * (i + j - 1) / 2 + i) 22 | eval_A_times_u <- function(u) u %*% g_eval_A_mat 23 | eval_At_times_u <- function(u) u %*% g_eval_At_mat 24 | eval_AtA_times_u <- function(u) eval_At_times_u(eval_A_times_u(u)) 25 | 26 | g_eval_A_mat <- outer(seq(n), seq(n), FUN=eval_A) 27 | g_eval_At_mat <- t(g_eval_A_mat) 28 | u <- rep(1, n) 29 | v <- rep(0, n) 30 | for (itr in seq(10)) { 31 | v <- eval_AtA_times_u(u) 32 | u <- eval_AtA_times_u(v) 33 | } 34 | 35 | cat(sqrt(sum(u * v) / sum(v * v)), "\n") 36 | 37 | } 38 | 39 | if (!exists('harness_argc')) { 40 | n <- setup(commandArgs(TRUE)) 41 | run(n) 42 | } 43 | -------------------------------------------------------------------------------- /shootout/spectral-norm/spectral-norm-alt2.R: -------------------------------------------------------------------------------- 1 | # ------------------------------------------------------------------ 2 | # The Computer Language Shootout 3 | # http://shootout.alioth.debian.org/ 4 | # 5 | # Contributed by Leo Osvald 6 | # 7 | # Original Loc: https://github.com/allr/fastr/blob/master/test/r/shootout/spectralnorm/ 8 | # Modified to be compatible with rbenchmark interface 9 | # ------------------------------------------------------------------ 10 | 11 | setup <- function(args='3000') { 12 | n<-as.integer(args[1]) 13 | if(is.na(n)){ n <- 3000L } 14 | return(n) 15 | } 16 | 17 | run <-function(n) { 18 | 19 | options(digits=10) 20 | 21 | eval_A <- function(i, j) 1 / ((i + j - 2) * (i + j - 1) / 2 + i) 22 | eval_A_times_u <- function(u) 23 | u %*% outer(seq(n), seq(n), FUN=eval_A) 24 | eval_At_times_u <- function(u) 25 | u %*% t(outer(seq(n), seq(n), FUN=eval_A)) 26 | eval_AtA_times_u <- function(u) 27 | eval_At_times_u(eval_A_times_u(u)) 28 | 29 | u <- rep(1, n) 30 | v <- rep(0, n) 31 | for (itr in seq(10)) { 32 | v <- eval_AtA_times_u(u) 33 | u <- eval_AtA_times_u(v) 34 | } 35 | cat(sqrt(sum(u * v) / sum(v * v)), "\n") 36 | 37 | } 38 | 39 | if (!exists('harness_argc')) { 40 | n <- setup(commandArgs(TRUE)) 41 | run(n) 42 | } 43 | -------------------------------------------------------------------------------- /shootout/spectral-norm/spectral-norm-alt3.R: -------------------------------------------------------------------------------- 1 | # ------------------------------------------------------------------ 2 | # The Computer Language Shootout 3 | # http://shootout.alioth.debian.org/ 4 | # 5 | # Contributed by Leo Osvald 6 | # 7 | # Original Loc: https://github.com/allr/fastr/blob/master/test/r/shootout/spectralnorm/ 8 | # Modified to be compatible with rbenchmark interface 9 | # ------------------------------------------------------------------ 10 | 11 | setup <- function(args='3000') { 12 | n<-as.integer(args[1]) 13 | if(is.na(n)){ n <- 3000L } 14 | return(n) 15 | } 16 | 17 | run <-function(n) { 18 | 19 | options(digits=10) 20 | 21 | eval_A <- function(i, j) eval_A_cache[[i, j]] 22 | eval_A_times_u <- function(u) { 23 | # eval_A_mat <- outer(seq(n), seq(n), FUN=eval_A) 24 | eval_A_mat <- matrix(0, n, n) 25 | for (i in 1:n) 26 | for (j in 1:n) 27 | eval_A_mat[[i, j]] <- eval_A(i, j) 28 | return(u %*% t(eval_A_mat)) 29 | } 30 | eval_At_times_u <- function(u) { 31 | # eval_At_mat <- t(outer(seq(n), seq(n), FUN=eval_A)) 32 | eval_At_mat <- matrix(0, n, n) 33 | for (i in 1:n) 34 | for (j in 1:n) 35 | eval_At_mat[[i, j]] <- eval_A(i, j) 36 | return(u %*% eval_At_mat) 37 | } 38 | eval_AtA_times_u <- function(u) eval_At_times_u(eval_A_times_u(u)) 39 | eval_A_cache <- matrix(0, n, n) 40 | for (i in 1:n) 41 | for (j in 1:n) 42 | eval_A_cache[[i, j]] <- 1/((i + j - 2) * (i + j - 1) / 2 + i) 43 | u <- rep(1, n) 44 | v <- rep(0, n) 45 | for (itr in seq(10)) { 46 | v <- eval_AtA_times_u(u) 47 | u <- eval_AtA_times_u(v) 48 | } 49 | 50 | cat(sqrt(sum(u * v) / sum(v * v)), "\n") 51 | 52 | } 53 | 54 | if (!exists('harness_argc')) { 55 | n <- setup(commandArgs(TRUE)) 56 | run(n) 57 | } 58 | -------------------------------------------------------------------------------- /shootout/spectral-norm/spectral-norm-alt4.R: -------------------------------------------------------------------------------- 1 | # ------------------------------------------------------------------ 2 | # The Computer Language Shootout 3 | # http://shootout.alioth.debian.org/ 4 | # 5 | # Contributed by Leo Osvald 6 | # 7 | # Original Loc: https://github.com/allr/fastr/blob/master/test/r/shootout/spectralnorm/ 8 | # Modified to be compatible with rbenchmark interface 9 | # ------------------------------------------------------------------ 10 | 11 | setup <- function(args='3000') { 12 | n<-as.integer(args[1]) 13 | if(is.na(n)){ n <- 3000L } 14 | return(n) 15 | } 16 | 17 | run <-function(n) { 18 | 19 | options(digits=10) 20 | 21 | eval_A <- function(i, j) 22 | return(if (eval_A_cache[[i, j]] != 0) eval_A_cache[[i, j]] else 23 | eval_A_cache[[i, j]] <<- 1 / ((i + j - 2) * (i + j - 1) / 2 + i)) 24 | eval_A_times_u <- function(u) { 25 | # eval_A_mat <- outer(seq(n), seq(n), FUN=eval_A) 26 | eval_A_mat <- matrix(0, n, n) 27 | for (i in 1:n) 28 | for (j in 1:n) 29 | eval_A_mat[[i, j]] <- eval_A(i, j) 30 | return(u %*% eval_A_mat) 31 | } 32 | eval_At_times_u <- function(u) { 33 | # eval_A_mat <- t(outer(seq(n), seq(n), FUN=eval_A)) 34 | eval_A_mat <- matrix(0, n, n) 35 | for (i in 1:n) 36 | for (j in 1:n) 37 | eval_A_mat[[i, j]] <- eval_A(i, j) 38 | return(u %*% t(eval_A_mat)) 39 | } 40 | eval_AtA_times_u <- function(u) 41 | eval_At_times_u(eval_A_times_u(u)) 42 | 43 | eval_A_cache <- matrix(0, n, n) 44 | u <- rep(1, n) 45 | v <- rep(0, n) 46 | for (itr in seq(10)) { 47 | v <- eval_AtA_times_u(u) 48 | u <- eval_AtA_times_u(v) 49 | } 50 | 51 | cat(sqrt(sum(u * v) / sum(v * v)), "\n") 52 | 53 | } 54 | 55 | if (!exists('harness_argc')) { 56 | n <- setup(commandArgs(TRUE)) 57 | run(n) 58 | } 59 | -------------------------------------------------------------------------------- /shootout/spectral-norm/spectral-norm-math.R: -------------------------------------------------------------------------------- 1 | # ------------------------------------------------------------------ 2 | # The Computer Language Shootout 3 | # http://shootout.alioth.debian.org/ 4 | # 5 | # Contributed by Leo Osvald 6 | # 7 | # Original Loc: https://github.com/allr/fastr/blob/master/test/r/shootout/spectralnorm/ 8 | # Modified to be compatible with rbenchmark interface 9 | # ------------------------------------------------------------------ 10 | 11 | setup <- function(args='3000') { 12 | n<-as.integer(args[1]) 13 | if(is.na(n)){ n <- 3000L } 14 | return(n) 15 | } 16 | 17 | run <-function(n) { 18 | 19 | options(digits=10) 20 | 21 | eval_A <- function(i, j) 1 / ((i + j - 2) * (i + j - 1) / 2 + i) 22 | 23 | m <- outer(seq(n), seq(n), FUN=eval_A) 24 | cat(sqrt(max(eigen(t(m) %*% m)$val)), "\n") 25 | 26 | } 27 | 28 | if (!exists('harness_argc')) { 29 | n <- setup(commandArgs(TRUE)) 30 | run(n) 31 | } 32 | -------------------------------------------------------------------------------- /shootout/spectral-norm/spectral-norm-native.R: -------------------------------------------------------------------------------- 1 | # ------------------------------------------------------------------ 2 | # The Computer Language Shootout 3 | # http://shootout.alioth.debian.org/ 4 | # 5 | # Contributed by Leo Osvald 6 | # 7 | # Original Loc: https://github.com/allr/fastr/blob/master/test/r/shootout/spectralnorm/ 8 | # Modified to be compatible with rbenchmark interface 9 | # ------------------------------------------------------------------ 10 | 11 | setup <- function(args='3000') { 12 | n<-as.integer(args[1]) 13 | if(is.na(n)){ n <- 3000L } 14 | return(n) 15 | } 16 | 17 | run <-function(n) { 18 | 19 | options(digits=10) 20 | 21 | eval_A <- function(i, j) 1 / ((i + j) * (i + j + 1) / 2 + i + 1) 22 | eval_A_times_u <- function(u) { 23 | ret <- rep(0, n) 24 | for (i in 1:n) 25 | for (j in 0:n1) 26 | ret[[i]] <- ret[[i]] + u[[j + 1]] * eval_A(i - 1, j) 27 | return(ret) 28 | } 29 | eval_At_times_u <- function(u) { 30 | ret <- rep(0, n) 31 | for (i in 1:n) 32 | for (j in 0:n1) 33 | ret[[i]] <- ret[[i]] + u[[j + 1]] * eval_A(j, i - 1) 34 | return(ret) 35 | } 36 | eval_AtA_times_u <- function(u) eval_At_times_u(eval_A_times_u(u)) 37 | 38 | n1 <- n - 1 39 | u <- rep(1, n) 40 | v <- rep(0, n) 41 | for (itr in seq(10)) { 42 | v <- eval_AtA_times_u(u) 43 | u <- eval_AtA_times_u(v) 44 | } 45 | 46 | cat(sqrt(sum(u * v) / sum(v * v)), "\n") 47 | 48 | } 49 | 50 | if (!exists('harness_argc')) { 51 | n <- setup(commandArgs(TRUE)) 52 | run(n) 53 | } 54 | -------------------------------------------------------------------------------- /shootout/spectral-norm/spectral-norm-vectorized.R: -------------------------------------------------------------------------------- 1 | #! The Computer Language Benchmarks Game 2 | #! http://shootout.alioth.debian.org/ 3 | #! 4 | #! Original C contributed by Sebastien Loisel 5 | #! Conversion to C++ by Jon Harrop 6 | #! OpenMP parallelize by The Anh Tran 7 | #! Add SSE by The Anh Tran 8 | #! Reconversion into C by Dan Farina 9 | #! Conversion to Fortran by Brian Taylor 10 | 11 | # Conversion to R by Peng Wu 12 | 13 | # directly set command line argument n here 14 | 15 | setup <- function(args='500') { 16 | n<-as.integer(args[1]) 17 | if(is.na(n)){ n <- 500L } 18 | return(n) 19 | } 20 | 21 | 22 | run <- function(n) { 23 | 24 | #! Return element (i,j) of matrix A 25 | eval_A <- function(i, j) { 26 | #real*8 :: eval_A 27 | #integer, intent(in) :: i, j 28 | #real*8 :: di, dj 29 | #integer :: d 30 | 31 | #di = real(i,8) 32 | # penguin: i-1 because R indice starts from 1 instead of 0 from original Fortran version 33 | di = as.double(i-1) 34 | 35 | #dj = real(j,8) 36 | # penguin: j-1 because R indice starts from 1 instead of 0 from original Fortran version 37 | dj = as.double(j-1) 38 | 39 | #eval_A = 1.d0 / (0.5d0 * ((di + dj) * (di + dj + 1.d0)) + di + 1.d0) 40 | eval_A = 1.0 / (0.5 * ((di + dj) * (di + dj + 1.0)) + di + 1.0) 41 | } 42 | 43 | 44 | eval_A_times_u <- function(r_begin, r_end, src) { 45 | #integer, intent(in) :: r_begin, r_end 46 | #real*8, intent(in) :: src(0:) 47 | #real*8, intent(out) :: dest(0:) 48 | #real*8 sum1 49 | #integer :: i, j 50 | 51 | dest = numeric((r_end-r_begin+1)) 52 | tmp = numeric(n) 53 | for (i in r_begin:r_end) { 54 | for (j in 1:n) { 55 | tmp[j] = eval_A(i,j) 56 | } 57 | dest[i] = sum(src[1:n]*tmp[1:n]) 58 | } 59 | dest 60 | } 61 | 62 | 63 | eval_At_times_u <- function(r_begin, r_end, src) { 64 | #integer, intent(in) :: r_begin, r_end 65 | #real*8, intent(in) :: src(0:) 66 | #real*8, intent(out) :: dest(0:) 67 | #real*8 sum1 68 | #integer :: i, j 69 | 70 | dest = numeric(r_end-r_begin+1) 71 | tmp = numeric(n) 72 | for (i in r_begin:r_end) { 73 | for (j in 1:n) { 74 | tmp[j] = eval_A(j,i); 75 | } 76 | dest[i] = sum(src[1:n]*tmp[1:n]) 77 | } 78 | dest 79 | } 80 | 81 | 82 | eval_AtA_times_u <- function(r_begin, r_end, src) { 83 | #integer, intent(in) :: r_begin, r_end 84 | #real*8, intent(in) :: src(0:) 85 | #real*8, intent(out) :: dest(0:) 86 | 87 | tmp = eval_A_times_u(r_begin, r_end, src) 88 | eval_At_times_u(r_begin, r_end, tmp) 89 | } 90 | 91 | 92 | # main function starts here 93 | 94 | #integer :: n 95 | #real*8, allocatable :: u(:), v(:), tmp(:) 96 | #integer :: n2, r_begin, r_end 97 | #real*8 uv, vv 98 | #integer :: i, tid, tcount, chunk, ite 99 | 100 | u = rep(1.0,n) 101 | 102 | for (i in 1:10) { 103 | v = eval_AtA_times_u(1, n, u) 104 | u = eval_AtA_times_u(1, n, v) 105 | } 106 | 107 | uv = sum(u*v) 108 | vv = sum(v*v) 109 | 110 | result=sqrt(uv / vv) 111 | options(digits=10) 112 | cat(result,'\n') 113 | } 114 | 115 | if (!exists('harness_argc')) { 116 | n <- setup(commandArgs(TRUE)) 117 | run(n) 118 | } 119 | -------------------------------------------------------------------------------- /shootout/spectral-norm/spectral-norm.f90: -------------------------------------------------------------------------------- 1 | ! The Computer Language Benchmarks Game 2 | ! http://shootout.alioth.debian.org/ 3 | ! 4 | ! Original C contributed by Sebastien Loisel 5 | ! Conversion to C++ by Jon Harrop 6 | ! OpenMP parallelize by The Anh Tran 7 | ! Add SSE by The Anh Tran 8 | ! Reconversion into C by Dan Farina 9 | ! Conversion to Fortran by Brian Taylor 10 | 11 | program main 12 | !$ use omp_lib 13 | implicit none 14 | 15 | character(len=6) :: argv 16 | integer :: n 17 | real*8, allocatable :: u(:), v(:), tmp(:) 18 | integer :: n2, r_begin, r_end 19 | real*8 uv, vv 20 | integer :: i, tid, tcount, chunk, ite 21 | 22 | call get_command_argument(1, argv) 23 | read (argv, *) n 24 | 25 | n2 = n / 2 26 | 27 | allocate(u(0:n-1), v(0:n-1), tmp(0:n-1)) 28 | 29 | uv = 0.d0 30 | vv = 0.d0 31 | 32 | !$omp parallel default(shared) private(i,tid,tcount,chunk,r_begin,r_end) 33 | 34 | !$omp do schedule(static) 35 | do i = 0, n - 1 36 | u(i) = 1.d0 37 | end do 38 | 39 | ! penguin: convert to single thread version 40 | !tid = omp_get_thread_num() 41 | tid = 0 42 | !tcount = omp_get_num_threads() 43 | tcount = 1 44 | chunk = n / tcount 45 | 46 | r_begin = tid * chunk 47 | if (tid < tcount - 1) then 48 | r_end = r_begin + chunk - 1 49 | else 50 | r_end = n - 1 51 | end if 52 | 53 | do i = 1, 10 54 | call eval_AtA_times_u(r_begin, r_end, u, v) 55 | call eval_AtA_times_u(r_begin, r_end, v, u) 56 | end do 57 | 58 | !$omp do schedule(static) reduction(+:uv) reduction(+:vv) 59 | do i = 0, n - 1 60 | uv = uv + u(i) * v(i) 61 | vv = vv + v(i) * v(i) 62 | end do 63 | !$omp end do nowait 64 | 65 | !$omp end parallel 66 | 67 | !write (*, "(f0.9)") sqrt(uv / vv) 68 | !penguin: change the format to match with R's (6 digit) 69 | write (*, "(f0.6)") sqrt(uv / vv) 70 | 71 | contains 72 | 73 | 74 | ! Return element (i,j) of matrix A 75 | pure function eval_A(i, j) 76 | real*8 :: eval_A 77 | integer, intent(in) :: i, j 78 | real*8 :: di, dj 79 | integer :: d 80 | di = real(i,8) 81 | dj = real(j,8) 82 | eval_A = 1.d0 / (0.5d0 * ((di + dj) * (di + dj + 1.d0)) + di + 1.d0) 83 | end function 84 | 85 | 86 | subroutine eval_A_times_u(r_begin, r_end, src, dest) 87 | integer, intent(in) :: r_begin, r_end 88 | real*8, intent(in) :: src(0:) 89 | real*8, intent(out) :: dest(0:) 90 | real*8 sum1 91 | integer :: i, j 92 | do i = r_begin, r_end 93 | sum1 = 0.d0 94 | do j = 0, n - 1 95 | sum1 = sum1 + src(j) * eval_A(i, j) 96 | end do 97 | dest(i) = sum1 98 | end do 99 | end subroutine 100 | 101 | 102 | subroutine eval_At_times_u(r_begin, r_end, src, dest) 103 | integer, intent(in) :: r_begin, r_end 104 | real*8, intent(in) :: src(0:) 105 | real*8, intent(out) :: dest(0:) 106 | real*8 sum1 107 | integer :: i, j 108 | do i = r_begin, r_end 109 | sum1 = 0.d0 110 | do j = 0, n - 1 111 | sum1 = sum1 + src(j) * eval_A(j, i) 112 | end do 113 | dest(i) = sum1 114 | end do 115 | end subroutine 116 | 117 | 118 | subroutine eval_AtA_times_u(r_begin, r_end, src, dest) 119 | integer, intent(in) :: r_begin, r_end 120 | real*8, intent(in) :: src(0:) 121 | real*8, intent(out) :: dest(0:) 122 | call eval_A_times_u(r_begin, r_end, src, tmp) 123 | !$omp barrier 124 | call eval_At_times_u(r_begin, r_end, tmp, dest) 125 | !$omp barrier 126 | end subroutine 127 | 128 | end program 129 | -------------------------------------------------------------------------------- /shootout/spectral-norm/spectral-norm.python: -------------------------------------------------------------------------------- 1 | # The Computer Language Benchmarks Game 2 | # http://shootout.alioth.debian.org/ 3 | # Contributed by Sebastien Loisel 4 | # Fixed by Isaac Gouy 5 | # Sped up by Josh Goldfoot 6 | # Dirtily sped up by Simon Descarpentries 7 | # Concurrency by Jason Stitt 8 | # 2to3 9 | 10 | from multiprocessing import Pool 11 | from math import sqrt 12 | 13 | from sys import argv 14 | 15 | def eval_A (i, j): 16 | return 1.0 / ((i + j) * (i + j + 1) / 2 + i + 1) 17 | 18 | def eval_A_times_u (u): 19 | args = ((i,u) for i in range(len(u))) 20 | return pool.map(part_A_times_u, args) 21 | 22 | def eval_At_times_u (u): 23 | args = ((i,u) for i in range(len(u))) 24 | return pool.map(part_At_times_u, args) 25 | 26 | def eval_AtA_times_u (u): 27 | return eval_At_times_u (eval_A_times_u (u)) 28 | 29 | def part_A_times_u(xxx_todo_changeme): 30 | (i,u) = xxx_todo_changeme 31 | partial_sum = 0 32 | for j, u_j in enumerate(u): 33 | partial_sum += eval_A (i, j) * u_j 34 | return partial_sum 35 | 36 | def part_At_times_u(xxx_todo_changeme1): 37 | (i,u) = xxx_todo_changeme1 38 | partial_sum = 0 39 | for j, u_j in enumerate(u): 40 | partial_sum += eval_A (j, i) * u_j 41 | return partial_sum 42 | 43 | def main(): 44 | n = int(argv[1]) 45 | u = [1] * n 46 | 47 | for dummy in range (10): 48 | v = eval_AtA_times_u (u) 49 | u = eval_AtA_times_u (v) 50 | 51 | vBv = vv = 0 52 | 53 | for ue, ve in zip (u, v): 54 | vBv += ue * ve 55 | vv += ve * ve 56 | 57 | print("%0.9f" % (sqrt(vBv/vv))) 58 | 59 | if __name__ == '__main__': 60 | pool = Pool(processes=4) 61 | main() 62 | 63 | -------------------------------------------------------------------------------- /utility/ORBIT_harness.R: -------------------------------------------------------------------------------- 1 | # Harness for all the benchmarks of rbenchmark 2 | # 3 | # Author: Haichuan Wang 4 | # 5 | # Requirements: ORBIT as the RVM 6 | 7 | harness_args <- commandArgs(TRUE) 8 | harness_argc <- length(harness_args) 9 | if(harness_argc < 4) { 10 | print("Usage: Rscript --vanilla ORBIT_Harness.R enableByteCode[TRUE/FALSE] useSystemTime[TRUE/FALSE] RepTimes yourFile.R arg1 arg2 ...") 11 | q() 12 | } 13 | 14 | if(!file.exists(harness_args[4])) { 15 | print("Cannot find", harness_args[4]) 16 | q() 17 | } 18 | 19 | useSystemTime <- as.logical(harness_args[2]) 20 | if(is.na(useSystemTime)) { useSystemTime <- FALSE } 21 | bench_reps <- as.integer(harness_args[3]) 22 | if(bench_reps < 2) { 23 | print("ORBIT requires bench repeat times >=2!") 24 | q() 25 | } 26 | source(harness_args[4]) 27 | 28 | if(!exists('run')) { 29 | print("Error: There is no run() function in your benchmark file!") 30 | q() 31 | } 32 | 33 | library(compiler); 34 | run <- cmpfun(run) 35 | 36 | if(harness_argc > 4) { 37 | bench_args <- harness_args[5:harness_argc] 38 | } else { 39 | bench_args <- character(0) 40 | } 41 | 42 | if(exists('setup')) { 43 | if(length(bench_args) == 0) { 44 | bench_args <- setup() 45 | } else { 46 | bench_args <- setup(bench_args) 47 | } 48 | } 49 | 50 | 51 | # finally do benchmark 52 | if(useSystemTime){ 53 | if(length(bench_args) == 0) { 54 | bench_time <- system.time({ 55 | invisible(.Internal(roeonoff(1L))); 56 | run(); 57 | invisible(.Internal(roeonoff(2L))); 58 | for(bench_i in 2:bench_reps) { run() }; 59 | invisible(.Internal(roeonoff(0L))); 60 | }) 61 | } else { 62 | bench_time <- system.time({ 63 | invisible(.Internal(roeonoff(1L))); 64 | run(bench_args); 65 | invisible(.Internal(roeonoff(2L))); 66 | for(bench_i in 2:bench_reps) { run(bench_args) } 67 | invisible(.Internal(roeonoff(0L))); 68 | }) 69 | } 70 | rawtime <- c(bench_time[[1]],bench_time[[2]],bench_time[[3]]) 71 | write(rawtime, file='.rbench.system.time', sep=',') 72 | } else { 73 | if(length(bench_args) == 0) { 74 | invisible(.Internal(roeonoff(1L))); 75 | run() 76 | invisible(.Internal(roeonoff(2L))); 77 | for(bench_i in 2:bench_reps) { run() } 78 | invisible(.Internal(roeonoff(0L))); 79 | } else { 80 | invisible(.Internal(roeonoff(1L))); 81 | run(bench_args) 82 | invisible(.Internal(roeonoff(2L))); 83 | for(bench_i in 2:bench_reps) { run(bench_args) } 84 | invisible(.Internal(roeonoff(0L))); 85 | } 86 | } 87 | -------------------------------------------------------------------------------- /utility/fastr_harness.R: -------------------------------------------------------------------------------- 1 | # Harness for all the benchmarks of rbenchmark 2 | # 3 | # Author: Haichuan Wang 4 | # 5 | # Requirements: fast_r has no print function. Just use cat to simulate print 6 | 7 | 8 | #fast_r has no harness 9 | print <- function(...) { cat(..., '\n') } 10 | 11 | harness_args <- commandArgs(TRUE) 12 | harness_argc <- length(harness_args) 13 | 14 | #cat('harness_args =', harness_args, '\n') 15 | #cat('harness_argc =', harness_argc, '\n') 16 | 17 | #if(harness_argc < 3) { 18 | # cat("Usage: ./r.sh --vanilla Harness.R enableByteCode[Y/N] useSystemTime[TRUE/FALSE] RepTimes yourFile.R arg1 arg2 ...\n") 19 | # q() 20 | #} 21 | 22 | #if(!file.exists(harness_args[3])) { 23 | # cat("Cannot find", harness_args[3], '\n') 24 | # q() 25 | #} 26 | 27 | useSystemTime <- as.logical(harness_args[2]) 28 | if(is.na(useSystemTime)) { useSystemTime <- FALSE } 29 | if(useSystemTime){ 30 | cat("FastR doesn't have system.time(). Cannot measure the time!\n") 31 | } 32 | 33 | bench_reps <- as.integer(harness_args[3]) 34 | source(harness_args[4]) 35 | 36 | if(!exists('run')) { 37 | cat("Error: There is no run() function in your benchmark file!\n") 38 | q() 39 | } 40 | 41 | if(harness_argc > 4) { 42 | bench_args <- harness_args[5:harness_argc] 43 | } else { 44 | bench_args <- character(0) 45 | } 46 | 47 | if(exists('setup')) { 48 | if(length(bench_args) == 0) { 49 | bench_args <- setup() 50 | TRUE 51 | } else { 52 | bench_args <- setup(bench_args) 53 | FALSE 54 | } 55 | } 56 | 57 | # finally do benchmark 58 | if(length(bench_args) == 0) { 59 | for(bench_i in 1:bench_reps) { run() } 60 | } else { 61 | for(bench_i in 1:bench_reps) { run(bench_args) } 62 | } 63 | 64 | 65 | -------------------------------------------------------------------------------- /utility/hardwarereport.py: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env python 2 | 3 | import platform 4 | 5 | 6 | def get_processors(): 7 | p_str = platform.processor() 8 | 9 | if platform.system() == 'Linux': 10 | with open('/proc/cpuinfo') as f: 11 | for line in f: 12 | if line.strip(): 13 | if line.rstrip('\n').startswith('model name'): 14 | model_name = line.rstrip('\n').split(':')[1] 15 | p_str = p_str + model_name 16 | return p_str 17 | return p_str 18 | 19 | def report_platform(rhome): 20 | print '>> Platform' 21 | #TODO: more detail platform descriptions 22 | print 'Processor:', get_processors() 23 | print 'OS:',platform.platform() 24 | print 'R Platform:',rhome -------------------------------------------------------------------------------- /utility/perfreport.py: -------------------------------------------------------------------------------- 1 | #!/usr/bin/python 2 | 3 | import sys,string 4 | 5 | 6 | #problem found in perf, some metrics uses the same name 7 | #e.g. L1-dcache-misses for load misses and store misses 8 | 9 | def gen_unique_metrix_name(bench_metrics, name, uid): 10 | if name in bench_metrics: 11 | name = name + str(uid) 12 | uid = uid + 1 13 | return name, uid 14 | 15 | def process_perf_lines(lines): 16 | 17 | warmup_rep = 0 18 | bench_rep = 0 19 | warmup_metrics={} 20 | bench_metrics={} 21 | for line in lines: 22 | if line.startswith('WARMUP_TIMES'): 23 | values = string.split(line, ':') 24 | warmup_rep = int(values[1]) 25 | unique_suffix_id = 1; 26 | elif line.startswith('BENCH_TIMES'): 27 | values = string.split(line, ':') 28 | bench_rep = int(values[1]) 29 | unique_suffix_id = 1; 30 | elif ',' in line and (not line.startswith('')): 31 | values=string.split(line,',') 32 | #now dependent on the state 33 | if (bench_rep == 0): #warmup period 34 | mname, unique_suffix_id = gen_unique_metrix_name(warmup_metrics, values[1], unique_suffix_id) 35 | warmup_metrics[mname] = float(values[0]) 36 | else: # now in benchmark parse period 37 | mname, unique_suffix_id = gen_unique_metrix_name(bench_metrics, values[1], unique_suffix_id) 38 | bench_metrics[mname] = float(values[0]) 39 | 40 | if(warmup_rep > 0): 41 | for key in bench_metrics: 42 | bench_metrics[key] = (bench_metrics[key] - warmup_metrics[key]) / (bench_rep - warmup_rep) 43 | else: 44 | for key in bench_metrics: 45 | bench_metrics[key] = (bench_metrics[key]) / (bench_rep) 46 | 47 | return bench_metrics 48 | 49 | 50 | if __name__ == "__main__": 51 | #lines = [line.strip() for line in open('_perf.tmp')] 52 | lines = [line.strip() for line in sys.stdin.readlines()] 53 | metrics = process_perf_lines(lines) 54 | print "==== Each Iteration Metrics ====" 55 | keys = metrics.keys() 56 | keys.sort() 57 | for key in keys: 58 | print "%.2f,%s" % (metrics[key],key) 59 | -------------------------------------------------------------------------------- /utility/r_harness.R: -------------------------------------------------------------------------------- 1 | # Harness for all the benchmarks of rbenchmark 2 | # 3 | # Author: Haichuan Wang 4 | # 5 | # Requirements: 6 | 7 | harness_args <- commandArgs(TRUE) 8 | harness_argc <- length(harness_args) 9 | if(harness_argc < 4) { 10 | print("Usage: Rscript --vanilla r_harness.R enableByteCode[TRUE/FALSE] useSystemTime[TRUE/FALSE] RepTimes yourFile.R arg1 arg2 ...") 11 | q() 12 | } 13 | 14 | if(!file.exists(harness_args[4])) { 15 | print("Cannot find", harness_args[4]) 16 | q() 17 | } 18 | 19 | 20 | enableBC <- as.logical(harness_args[1]) 21 | if(is.na(enableBC)) { enableBC <- FALSE } 22 | useSystemTime <- as.logical(harness_args[2]) 23 | if(is.na(useSystemTime)) { useSystemTime <- FALSE } 24 | bench_reps <- as.integer(harness_args[3]) 25 | source(harness_args[4]) 26 | 27 | if(!exists('run')) { 28 | print("Error: There is no run() function in your benchmark file!") 29 | q() 30 | } 31 | 32 | if(enableBC) { 33 | library(compiler); 34 | run <- cmpfun(run) 35 | } 36 | 37 | if(harness_argc > 4) { 38 | bench_args <- harness_args[5:harness_argc] 39 | } else { 40 | bench_args <- character(0) 41 | } 42 | if(exists('setup')) { 43 | if(length(bench_args) == 0) { 44 | bench_args <- setup() 45 | #TRUE 46 | } else { 47 | bench_args <- setup(bench_args) 48 | #FALSE 49 | } 50 | } 51 | 52 | # finally do benchmark 53 | if(useSystemTime){ 54 | if(length(bench_args) == 0) { 55 | bench_time <- system.time(for(bench_i in 1:bench_reps) { run() }) 56 | } else { 57 | bench_time <- system.time(for(bench_i in 1:bench_reps) { run(bench_args) }) 58 | } 59 | rawtime <- c(bench_time[[1]],bench_time[[2]],bench_time[[3]]) 60 | write(rawtime, file='.rbench.system.time', sep=',') 61 | } else { 62 | if(length(bench_args) == 0) { 63 | for(bench_i in 1:bench_reps) { run() } 64 | } else { 65 | for(bench_i in 1:bench_reps) { run(bench_args) } 66 | } 67 | } 68 | 69 | 70 | 71 | 72 | 73 | -------------------------------------------------------------------------------- /utility/raw_harness.py: -------------------------------------------------------------------------------- 1 | #!/usr/bin/python 2 | 3 | 4 | # Usage raw_harness.py Y/N repTimes sourceFile arguments 5 | 6 | 7 | # finally, will append a full function file 8 | ''' 9 | original R file 10 | 11 | #if has input, gen 12 | 13 | args=c(args, argd, ...) 14 | dataset = setup 15 | 16 | ''' 17 | import sys,os 18 | 19 | 20 | raw_haress_str = ''' 21 | 22 | rnorm <- runif 23 | 24 | if(exists('setup')) { 25 | if(length(bench_args) == 0) { 26 | bench_args <- setup() 27 | TRUE 28 | } else { 29 | bench_args <- setup(bench_args) 30 | FALSE 31 | } 32 | } 33 | 34 | if(length(bench_args) == 0) { 35 | for(bench_i in 1:bench_reps) { run() } 36 | } else { 37 | for(bench_i in 1:bench_reps) { run(bench_args) } 38 | } 39 | 40 | 41 | 42 | 43 | ''' 44 | 45 | 46 | if __name__ == "__main__": 47 | argv = sys.argv 48 | argc = int(argv[1]) #this is how many fixed for the rvm 49 | 50 | rvm_path = argv[2] 51 | rvm_cmd = argv[3:(argc+1)] #with all args 52 | 53 | use_system_time = argv[argc+1] 54 | if(use_system_time == 'TRUE'): 55 | print '[rbench]Cannot use system.time() for these experiment R VMs. Fall back to meter=time.' 56 | 57 | rep = argv[argc+2] 58 | print rep 59 | src = argv[argc+3] #the file 60 | print src 61 | #construct the file's full current full path 62 | src = os.path.join(os.getcwd(), src) 63 | #now generate the source file 64 | #use the benchmark file to 65 | src_dir = os.path.dirname(src) 66 | src_basename = os.path.basename(src) 67 | tmpsrc = os.path.join(src_dir, 'rbench_'+src_basename) 68 | 69 | #then decide whether there are additional args 70 | if(len(argv) > argc+4): 71 | bench_args = argv[argc+4:] 72 | bench_args_str = "bench_args <- c('" + "','".join(bench_args)+ "')\n" 73 | else: 74 | bench_args_str = "bench_args <- character(0)\n" 75 | 76 | bench_reps_str = 'bench_reps <- ' + rep +'\n' 77 | # now generate the file 78 | 79 | with open(tmpsrc, 'w') as f: 80 | f.write('harness_argc<-1\n') 81 | f.write(bench_args_str) 82 | f.write(bench_reps_str) 83 | with open(src, 'r') as srcf: 84 | f.write(srcf.read()) 85 | f.write(raw_haress_str) 86 | 87 | 88 | #now start running 89 | #need change to the directory 90 | os.chdir(rvm_path) 91 | rvm_cmd.append(tmpsrc) 92 | exit_code = os.system(' '.join(rvm_cmd)) 93 | os.remove(tmpsrc) 94 | sys.exit(exit_code) 95 | --------------------------------------------------------------------------------