performance measurements
Each table row shows performance measurements for this Lisp SBCL program with a particular command-line input value N.
| N | CPU secs | Elapsed secs | Memory KB | Code B | ≈ CPU Load |
|---|---|---|---|---|---|
| 50,000 | 0.50 | 0.29 | 516 | 1948 | 36% 83% 32% 30% |
| 500,000 | 4.55 | 2.30 | 150,404 | 1948 | 34% 44% 90% 32% |
| 5,000,000 | 45.42 | 21.81 | 818,628 | 1948 | 41% 39% 89% 41% |
Read the ↓ make, command line, and program output logs to see how this program was run.
Read regex-dna benchmark to see what this program should do.
notes
This is SBCL 1.1.7, an implementation of ANSI Common Lisp.
regex-dna Lisp SBCL #3 program source code
;;; The Computer Language Benchmarks Game ;;; http://benchmarksgame.alioth.debian.org/ ;;; ;;; Contributed by: Witali Kusnezow 2009-03-02 (eval-when (:compile-toplevel :load-toplevel :execute) (require :asdf) (require :cl-ppcre) #+sb-thread (progn (define-alien-routine sysconf long (name int)) (use-package :sb-thread))) (eval-when (:compile-toplevel) (setf cl-ppcre:*regex-char-code-limit* 128)) (defconstant +regex-list+ '("agggtaaa|tttaccct" "[cgt]gggtaaa|tttaccc[acg]" "a[act]ggtaaa|tttacc[agt]t" "ag[act]gtaaa|tttac[agt]ct" "agg[act]taaa|ttta[agt]cct" "aggg[acg]aaa|ttt[cgt]ccct" "agggt[cgt]aa|tt[acg]accct" "agggta[cgt]a|t[acg]taccct" "agggtaa[cgt]|[acg]ttaccct")) (defconstant +alternatives+ '(("B" "(c|g|t)") ("D" "(a|g|t)") ("H" "(a|c|t)") ("K" "(g|t)") ("M" "(a|c)") ("N" "(a|c|g|t)") ("R" "(a|g)") ("S" "(c|t)") ("V" "(a|c|g)") ("W" "(a|t)") ("Y" "(c|t)"))) #+sb-thread (progn (defconstant +cpu-count+ (sysconf 84)) (defvar *mutex* (make-mutex)) (defvar *aux-mutex* (make-mutex)) (defmacro bg (&body body) `(make-thread (lambda () ,@body))) (defmacro join-all (&body body) `(mapcar #'join-thread (loop for item in (list ,@body) append (if (consp item) item (list item)))))) (defun read-all (stream &aux (buf-size (* 1024 1024)) (size 0) (buf-list (loop for buf = (make-string buf-size :element-type 'base-char) for len = (read-sequence buf stream) do (incf size len) collect (if (< len buf-size) (subseq buf 0 len) buf) while (= len buf-size)))) (declare (type fixnum size)) (loop with res-string = (make-string size :element-type 'base-char) with i of-type fixnum = 0 for str in buf-list do (setf (subseq res-string i) (the simple-base-string str)) (incf i (length (the simple-base-string str))) finally (return res-string))) (defun length-to-replace (match) (loop for x in match sum (- (the fixnum (cdr x)) (the fixnum (car x))) of-type fixnum)) (defun replace-aux (match replacement target-string result-string &key (match-begin 0) (match-end -1) (match-length (length match)) &aux (len (length replacement)) (first-match (if (zerop match-begin) '(0 . 0) (nth (1- match-begin) match))) (target-start (cdr first-match)) (result-start (+ (the fixnum (* len match-begin)) (- target-start (the fixnum (length-to-replace (subseq match 0 match-begin))))))) (declare (type fixnum match-begin match-end match-length target-start result-start len) (type list match) (type simple-base-string result-string target-string) (type vector replacement)) (loop with (i j) of-type fixnum = (list result-start target-start) with mmatch = (if (> match-begin match-end) match (subseq match match-begin match-end)) for pair in mmatch do (setf (subseq result-string i) (subseq target-string j (car pair)) i (+ i (- (the fixnum (car pair)) j)) (subseq result-string i) replacement j (cdr pair) i (+ i len)) finally (if (or (minusp match-end) (<= match-length match-end)) (setf (subseq result-string i ) (subseq target-string j)))) nil) #+sb-thread (defun parts (parts-num len &aux (ranges (loop with (step rest) of-type fixnum = (multiple-value-list (floor len parts-num)) with i of-type fixnum = 0 while (< i len) collect i into res of-type fixnum do (incf i step)(if (plusp rest) (progn (incf i) (decf rest)) ) finally (return (append res (list len)))) )) (declare (type fixnum len parts-num) (type list ranges)) (mapcar #'cons ranges (subseq ranges 1))) (defun replace-all (regexp replacement target-string &aux (rmatch '()) (match '()) (result-string (make-string 0 :element-type 'base-char))) (declare (type simple-base-string result-string target-string) (type vector replacement)) (cl-ppcre:do-scans (match-start match-end reg-starts reg-ends regexp target-string nil) (push (cons match-start match-end) rmatch)) (if rmatch (progn (setf match (reverse rmatch) result-string (make-string (+ (- (length target-string) (length-to-replace match)) (the fixnum (* (length replacement) (length match)))) :element-type 'base-char)) #-sb-thread (replace-aux match replacement target-string result-string) #+sb-thread (mapcar #'join-thread (loop with len of-type fixnum = (length match) with parts-list = (parts +cpu-count+ len) with current of-type fixnum = 0 repeat +cpu-count+ collect (bg (let (range) (with-mutex (*mutex*) (setf range (nth current parts-list)) (incf current)) (replace-aux match replacement target-string result-string :match-begin (car range) :match-end (cdr range) :match-length len))))) result-string) target-string)) (defun main (&optional (stream *standard-input*) &aux (sequence (read-all stream)) (size (length sequence))) (declare (type simple-base-string sequence)) (setf sequence (replace-all ">[^\\n]*\\n|\\n" "" sequence)) #-sb-thread (progn (loop for regex in +regex-list+ do (format t "~a ~a~%" regex (/ (length (the list (cl-ppcre:all-matches regex sequence))) 2))) (format t "~%~a~%~a~%" size (length sequence)) (loop for pair in +alternatives+ do (setf sequence (replace-all (car pair) (cadr pair) sequence ))) (format t "~a~%" (length sequence))) #+sb-thread (let* ((len (length +regex-list+)) (result (make-list (1+ len)))) (join-all (loop with idx of-type fixnum = 0 repeat len collect (bg (let (reg cur) (with-mutex (*aux-mutex*) (setf cur idx reg (nth cur +regex-list+)) (incf idx)) (setf (nth cur result) (format nil "~a ~a" reg (/ (length (the list (cl-ppcre:all-matches reg sequence))) 2)))))) (bg (loop with seq = (copy-seq sequence) for pair in +alternatives+ do (setf seq (replace-all (car pair) (cadr pair) seq )) finally (setf (nth len result) (format nil "~%~a~%~a~%~a" size (length sequence) (length seq)))))) (format t "~{~a~%~}" result)) )
make, command-line, and program output logs
Sat, 04 May 2013 04:36:44 GMT MAKE: cp: ‘regexdna.sbcl-3.sbcl’ and ‘./regexdna.sbcl-3.sbcl’ are the same file SBCL built with: /usr/local/bin/sbcl --userinit /dev/null --batch --eval '(load "regexdna.sbcl-3.sbcl_compile")' ### START regexdna.sbcl-3.sbcl_compile (handler-bind ((sb-ext:defconstant-uneql (lambda (c) (abort c)))) (load (compile-file "regexdna.sbcl-3.sbcl" ))) (save-lisp-and-die "sbcl.core" :purify t) ### END regexdna.sbcl-3.sbcl_compile ; compiling file "/home/dunham/benchmarksgame/bench/regexdna/regexdna.sbcl-3.sbcl" (written 23 JAN 2013 08:20:11 PM): ; compiling (REQUIRE :ASDF) ; compiling (REQUIRE :CL-PPCRE) ; compiling (DEFINE-ALIEN-ROUTINE SYSCONF ...) ; compiling (USE-PACKAGE :SB-THREAD) ; compiling (DEFCONSTANT +REGEX-LIST+ ...) ; compiling (DEFCONSTANT +ALTERNATIVES+ ...) ; compiling (DEFCONSTANT +CPU-COUNT+ ...) ; compiling (DEFVAR *MUTEX* ...) ; compiling (DEFVAR *AUX-MUTEX* ...) ; compiling (DEFMACRO BG ...) ; compiling (DEFMACRO JOIN-ALL ...) ; compiling (DEFUN READ-ALL ...) ; compiling (DEFUN LENGTH-TO-REPLACE ...) ; compiling (DEFUN REPLACE-AUX ...) ; compiling (DEFUN PARTS ...) ; compiling (DEFUN REPLACE-ALL ...) ; compiling (DEFUN MAIN ...) ; /home/dunham/benchmarksgame_quadcore/regexdna/tmp/regexdna.sbcl-3.fasl written ; compilation finished in 0:00:00.602 [undoing binding stack and other enclosing state... done] [saving current Lisp image into sbcl.core: writing 5952 bytes from the read-only space at 0x0x20000000 writing 4064 bytes from the static space at 0x0x20100000 writing 46792704 bytes from the dynamic space at 0x0x1000000000 done] ### START regexdna.sbcl-3.sbcl_run (main) (quit) ### END regexdna.sbcl-3.sbcl_run 1.02s to complete and log all make actions COMMAND LINE: /usr/local/bin/sbcl --noinform --core sbcl.core --userinit /dev/null --load regexdna.sbcl-3.sbcl_run 0 < regexdna-input5000000.txt PROGRAM OUTPUT: agggtaaa|tttaccct 356 [cgt]gggtaaa|tttaccc[acg] 1250 a[act]ggtaaa|tttacc[agt]t 4252 ag[act]gtaaa|tttac[agt]ct 2894 agg[act]taaa|ttta[agt]cct 5435 aggg[acg]aaa|ttt[cgt]ccct 1537 agggt[cgt]aa|tt[acg]accct 1431 agggta[cgt]a|t[acg]taccct 1608 agggtaa[cgt]|[acg]ttaccct 2178 50833411 50000000 66800214