Racketified the untyped shootout benchmarks.
This commit is contained in:
Vincent St-Amour
parent
4fde1e8ccb
commit
d48f1bb6aa
|
|
@ -1,4 +1,5 @@
|
|||
The program "run" should kknow how to run each benchmark with its
|
||||
|
||||
The program "run" should know how to run each benchmark with its
|
||||
standard input value. So run <benchmark.ss> like this:
|
||||
|
||||
mzscheme -qu run.ss <benchmark.ss>
|
||||
racket run.rkt <benchmark.ss>
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
#lang scheme/base
|
||||
(require scheme/cmdline)
|
||||
#lang racket/base
|
||||
(require racket/cmdline)
|
||||
|
||||
(define (ack m n)
|
||||
(cond ((zero? m) (+ n 1))
|
||||
|
|
|
|||
|
|
@ -1,21 +1,22 @@
|
|||
(module ary mzscheme
|
||||
(define (main args)
|
||||
(let* ((n (if (= (vector-length args) 0)
|
||||
1
|
||||
(string->number (vector-ref args 0))))
|
||||
(x (make-vector n 0))
|
||||
(y (make-vector n 0))
|
||||
(last (- n 1)))
|
||||
(do ((i 0 (+ i 1)))
|
||||
((= i n))
|
||||
(vector-set! x i (+ i 1)))
|
||||
(do ((k 0 (+ k 1)))
|
||||
((= k 1000))
|
||||
(do ((i last (- i 1)))
|
||||
((< i 0))
|
||||
(vector-set! y i (+ (vector-ref x i) (vector-ref y i)))))
|
||||
(print-list (vector-ref y 0) " " (vector-ref y last))))
|
||||
#lang racket/base
|
||||
|
||||
(define (print-list . items) (for-each display items) (newline))
|
||||
(define (main args)
|
||||
(let* ((n (if (= (vector-length args) 0)
|
||||
1
|
||||
(string->number (vector-ref args 0))))
|
||||
(x (make-vector n 0))
|
||||
(y (make-vector n 0))
|
||||
(last (- n 1)))
|
||||
(do ((i 0 (+ i 1)))
|
||||
((= i n))
|
||||
(vector-set! x i (+ i 1)))
|
||||
(do ((k 0 (+ k 1)))
|
||||
((= k 1000))
|
||||
(do ((i last (- i 1)))
|
||||
((< i 0))
|
||||
(vector-set! y i (+ (vector-ref x i) (vector-ref y i)))))
|
||||
(print-list (vector-ref y 0) " " (vector-ref y last))))
|
||||
|
||||
(main (current-command-line-arguments)))
|
||||
(define (print-list . items) (for-each display items) (newline))
|
||||
|
||||
(main (current-command-line-arguments))
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
#lang scheme/base
|
||||
(require scheme/cmdline)
|
||||
#lang racket/base
|
||||
(require racket/cmdline)
|
||||
|
||||
(define (generate receive-ch n)
|
||||
(if (zero? n)
|
||||
|
|
|
|||
|
|
@ -1,45 +1,47 @@
|
|||
(module echo mzscheme
|
||||
(define PORT 8888)
|
||||
(define DATA "Hello there sailor\n")
|
||||
(define n 10)
|
||||
#lang racket/base
|
||||
(require racket/tcp)
|
||||
|
||||
(define (server)
|
||||
(thread client)
|
||||
(let-values ([(in out) (tcp-accept (tcp-listen PORT 5 #t))]
|
||||
[(buffer) (make-string (string-length DATA))])
|
||||
(file-stream-buffer-mode out 'none)
|
||||
(let loop ([i (read-string! buffer in)]
|
||||
[bytes 0])
|
||||
(if (not (eof-object? i))
|
||||
(begin
|
||||
(display buffer out)
|
||||
(loop (read-string! buffer in)
|
||||
(+ bytes (string-length buffer))))
|
||||
(begin
|
||||
(display "server processed ")
|
||||
(display bytes)
|
||||
(display " bytes\n"))))))
|
||||
(define PORT 8888)
|
||||
(define DATA "Hello there sailor\n")
|
||||
(define n 10)
|
||||
|
||||
(define (client)
|
||||
(let-values ([(in out) (tcp-connect "127.0.0.1" PORT)]
|
||||
[(buffer) (make-string (string-length DATA))])
|
||||
(file-stream-buffer-mode out 'none)
|
||||
(let loop ([n n])
|
||||
(if (> n 0)
|
||||
(begin
|
||||
(display DATA out)
|
||||
(let ([i (read-string! buffer in)])
|
||||
(begin
|
||||
(if (equal? DATA buffer)
|
||||
(loop (- n 1))
|
||||
'error))))
|
||||
(close-output-port out)))))
|
||||
(define (server)
|
||||
(thread client)
|
||||
(let-values ([(in out) (tcp-accept (tcp-listen PORT 5 #t))]
|
||||
[(buffer) (make-string (string-length DATA))])
|
||||
(file-stream-buffer-mode out 'none)
|
||||
(let loop ([i (read-string! buffer in)]
|
||||
[bytes 0])
|
||||
(if (not (eof-object? i))
|
||||
(begin
|
||||
(display buffer out)
|
||||
(loop (read-string! buffer in)
|
||||
(+ bytes (string-length buffer))))
|
||||
(begin
|
||||
(display "server processed ")
|
||||
(display bytes)
|
||||
(display " bytes\n"))))))
|
||||
|
||||
(define (main args)
|
||||
(set! n
|
||||
(if (= (vector-length args) 0)
|
||||
1
|
||||
(string->number (vector-ref args 0))))
|
||||
(server))
|
||||
(define (client)
|
||||
(let-values ([(in out) (tcp-connect "127.0.0.1" PORT)]
|
||||
[(buffer) (make-string (string-length DATA))])
|
||||
(file-stream-buffer-mode out 'none)
|
||||
(let loop ([n n])
|
||||
(if (> n 0)
|
||||
(begin
|
||||
(display DATA out)
|
||||
(let ([i (read-string! buffer in)])
|
||||
(begin
|
||||
(if (equal? DATA buffer)
|
||||
(loop (- n 1))
|
||||
'error))))
|
||||
(close-output-port out)))))
|
||||
|
||||
(main (current-command-line-arguments)))
|
||||
(define (main args)
|
||||
(set! n
|
||||
(if (= (vector-length args) 0)
|
||||
1
|
||||
(string->number (vector-ref args 0))))
|
||||
(server))
|
||||
|
||||
(main (current-command-line-arguments))
|
||||
|
|
|
|||
|
|
@ -1,36 +1,37 @@
|
|||
(module except mzscheme
|
||||
(define HI 0)
|
||||
(define LO 0)
|
||||
#lang racket/base
|
||||
|
||||
(define (hi-excp? x) (eq? x 'Hi_Exception))
|
||||
(define (lo-excp? x) (eq? x 'Lo_Exception))
|
||||
(define (true? x) (if (boolean? x) x #t))
|
||||
(define HI 0)
|
||||
(define LO 0)
|
||||
|
||||
(define (some_fun n)
|
||||
(with-handlers
|
||||
([true? (lambda (exn) #f)])
|
||||
(hi_fun n)))
|
||||
(define (hi-excp? x) (eq? x 'Hi_Exception))
|
||||
(define (lo-excp? x) (eq? x 'Lo_Exception))
|
||||
(define (true? x) (if (boolean? x) x #t))
|
||||
|
||||
(define (hi_fun n)
|
||||
(with-handlers
|
||||
([hi-excp? (lambda (exn) (set! HI (+ HI 1))) ])
|
||||
(lo_fun n)))
|
||||
(define (some_fun n)
|
||||
(with-handlers
|
||||
([true? (lambda (exn) #f)])
|
||||
(hi_fun n)))
|
||||
|
||||
(define (lo_fun n)
|
||||
(with-handlers
|
||||
([lo-excp? (lambda (exn) (set! LO (+ LO 1))) ])
|
||||
(blowup n)))
|
||||
(define (hi_fun n)
|
||||
(with-handlers
|
||||
([hi-excp? (lambda (exn) (set! HI (+ HI 1))) ])
|
||||
(lo_fun n)))
|
||||
|
||||
(define (blowup n)
|
||||
(if (= 0 (modulo n 2))
|
||||
(raise 'Hi_Exception)
|
||||
(raise 'Lo_Exception)))
|
||||
(define (lo_fun n)
|
||||
(with-handlers
|
||||
([lo-excp? (lambda (exn) (set! LO (+ LO 1))) ])
|
||||
(blowup n)))
|
||||
|
||||
(define (main args)
|
||||
(let* ((n (if (= (vector-length args) 1) (string->number (vector-ref args 0)) 1)))
|
||||
(do ((i 0 (+ i 1)))
|
||||
((= i n))
|
||||
(some_fun i)))
|
||||
(printf "Exceptions: HI=~a / LO=~a~n" HI LO))
|
||||
(define (blowup n)
|
||||
(if (= 0 (modulo n 2))
|
||||
(raise 'Hi_Exception)
|
||||
(raise 'Lo_Exception)))
|
||||
|
||||
(main (current-command-line-arguments)))
|
||||
(define (main args)
|
||||
(let* ((n (if (= (vector-length args) 1) (string->number (vector-ref args 0)) 1)))
|
||||
(do ((i 0 (+ i 1)))
|
||||
((= i n))
|
||||
(some_fun i)))
|
||||
(printf "Exceptions: HI=~a / LO=~a~n" HI LO))
|
||||
|
||||
(main (current-command-line-arguments))
|
||||
|
|
|
|||
|
|
@ -1,13 +1,14 @@
|
|||
(module fibo mzscheme
|
||||
(define (fib n)
|
||||
(cond ((< n 2) 1)
|
||||
(else (+ (fib (- n 2)) (fib (- n 1))))))
|
||||
#lang racket/base
|
||||
|
||||
(define (main args)
|
||||
(let ((n (if (= (vector-length args) 0)
|
||||
1
|
||||
(string->number (vector-ref args 0)))))
|
||||
(display (fib n))
|
||||
(newline)))
|
||||
(define (fib n)
|
||||
(cond ((< n 2) 1)
|
||||
(else (+ (fib (- n 2)) (fib (- n 1))))))
|
||||
|
||||
(main (current-command-line-arguments)))
|
||||
(define (main args)
|
||||
(let ((n (if (= (vector-length args) 0)
|
||||
1
|
||||
(string->number (vector-ref args 0)))))
|
||||
(display (fib n))
|
||||
(newline)))
|
||||
|
||||
(main (current-command-line-arguments))
|
||||
|
|
|
|||
|
|
@ -1,18 +1,19 @@
|
|||
(module hash mzscheme
|
||||
(define (main argv)
|
||||
(let* ([n (string->number (vector-ref argv 0))]
|
||||
[hash (make-hash-table 'equal)]
|
||||
[accum 0]
|
||||
[false (lambda () #f)])
|
||||
(let loop ([i 1])
|
||||
(unless (> i n)
|
||||
(hash-table-put! hash (number->string i 16) i)
|
||||
(loop (add1 i))))
|
||||
(let loop ([i n])
|
||||
(unless (zero? i)
|
||||
(when (hash-table-get hash (number->string i) false)
|
||||
(set! accum (+ accum 1)))
|
||||
(loop (sub1 i))))
|
||||
(printf "~s~n" accum)))
|
||||
#lang racket/base
|
||||
|
||||
(main (current-command-line-arguments)))
|
||||
(define (main argv)
|
||||
(let* ([n (string->number (vector-ref argv 0))]
|
||||
[hash (make-hash)]
|
||||
[accum 0]
|
||||
[false (lambda () #f)])
|
||||
(let loop ([i 1])
|
||||
(unless (> i n)
|
||||
(hash-set! hash (number->string i 16) i)
|
||||
(loop (add1 i))))
|
||||
(let loop ([i n])
|
||||
(unless (zero? i)
|
||||
(when (hash-ref hash (number->string i) false)
|
||||
(set! accum (+ accum 1)))
|
||||
(loop (sub1 i))))
|
||||
(printf "~s~n" accum)))
|
||||
|
||||
(main (current-command-line-arguments))
|
||||
|
|
|
|||
|
|
@ -1,25 +1,26 @@
|
|||
(module hash2 mzscheme
|
||||
(define (main argv)
|
||||
(let* ([n (string->number (vector-ref argv 0))]
|
||||
[hash1 (make-hash-table 'equal)]
|
||||
[hash2 (make-hash-table 'equal)]
|
||||
[zero (lambda () 0)])
|
||||
(let loop ([i 0])
|
||||
(unless (= i 10000)
|
||||
(hash-table-put! hash1 (string-append "foo_" (number->string i)) i)
|
||||
(loop (add1 i))))
|
||||
(let loop ([i 0])
|
||||
(unless (= i n)
|
||||
(hash-table-for-each hash1 (lambda (key value)
|
||||
(hash-table-put!
|
||||
hash2
|
||||
key
|
||||
(+ (hash-table-get hash2 key zero) value))))
|
||||
(loop (add1 i))))
|
||||
(printf "~s ~s ~s ~s~n"
|
||||
(hash-table-get hash1 "foo_1")
|
||||
(hash-table-get hash1 "foo_9999")
|
||||
(hash-table-get hash2 "foo_1")
|
||||
(hash-table-get hash2 "foo_9999"))))
|
||||
#lang racket/base
|
||||
|
||||
(main (current-command-line-arguments)))
|
||||
(define (main argv)
|
||||
(let* ([n (string->number (vector-ref argv 0))]
|
||||
[hash1 (make-hash)]
|
||||
[hash2 (make-hash)]
|
||||
[zero (lambda () 0)])
|
||||
(let loop ([i 0])
|
||||
(unless (= i 10000)
|
||||
(hash-set! hash1 (string-append "foo_" (number->string i)) i)
|
||||
(loop (add1 i))))
|
||||
(let loop ([i 0])
|
||||
(unless (= i n)
|
||||
(hash-for-each hash1 (lambda (key value)
|
||||
(hash-set!
|
||||
hash2
|
||||
key
|
||||
(+ (hash-ref hash2 key zero) value))))
|
||||
(loop (add1 i))))
|
||||
(printf "~s ~s ~s ~s~n"
|
||||
(hash-ref hash1 "foo_1")
|
||||
(hash-ref hash1 "foo_9999")
|
||||
(hash-ref hash2 "foo_1")
|
||||
(hash-ref hash2 "foo_9999"))))
|
||||
|
||||
(main (current-command-line-arguments))
|
||||
|
|
|
|||
|
|
@ -5,62 +5,63 @@
|
|||
;;
|
||||
;; Updated by Brent Fulgham to provide proper output formatting
|
||||
|
||||
(module heapsort mzscheme
|
||||
(require (only srfi/13 string-index string-pad-right)
|
||||
(only mzlib/string real->decimal-string))
|
||||
#lang racket/base
|
||||
|
||||
(define IM 139968)
|
||||
(define IA 3877)
|
||||
(define IC 29573)
|
||||
(require (only-in srfi/13 string-index string-pad-right)
|
||||
(only-in mzlib/string real->decimal-string))
|
||||
|
||||
(define LAST 42)
|
||||
(define (gen_random max)
|
||||
(set! LAST (modulo (+ (* LAST IA) IC) IM))
|
||||
(/ (* max LAST) IM))
|
||||
(define IM 139968)
|
||||
(define IA 3877)
|
||||
(define IC 29573)
|
||||
|
||||
(define (heapsort n ra)
|
||||
(let ((ir n)
|
||||
(l (+ (quotient n 2) 1))
|
||||
(i 0)
|
||||
(j 0)
|
||||
(rra 0.0))
|
||||
(let/ec return
|
||||
(do ((bar #t))
|
||||
((= 1 0))
|
||||
(cond ((> l 1)
|
||||
(set! l (- l 1))
|
||||
(set! rra (vector-ref ra l)))
|
||||
(else
|
||||
(set! rra (vector-ref ra ir))
|
||||
(vector-set! ra ir (vector-ref ra 1))
|
||||
(set! ir (- ir 1))
|
||||
(cond ((<= ir 1)
|
||||
(vector-set! ra 1 rra)
|
||||
(return #t)))))
|
||||
(set! i l)
|
||||
(set! j (* l 2))
|
||||
(do ((foo #t))
|
||||
((> j ir))
|
||||
(cond ((and (< j ir) (< (vector-ref ra j) (vector-ref ra (+ j 1))))
|
||||
(set! j (+ j 1))))
|
||||
(cond ((< rra (vector-ref ra j))
|
||||
(vector-set! ra i (vector-ref ra j))
|
||||
(set! i j)
|
||||
(set! j (+ j i)))
|
||||
(else
|
||||
(set! j (+ ir 1)))))
|
||||
(vector-set! ra i rra)))))
|
||||
(define LAST 42)
|
||||
(define (gen_random max)
|
||||
(set! LAST (modulo (+ (* LAST IA) IC) IM))
|
||||
(/ (* max LAST) IM))
|
||||
|
||||
(define (main args)
|
||||
(let* ((n (or (and (= (vector-length args) 1) (string->number (vector-ref args 0)))
|
||||
1))
|
||||
(last (+ n 1))
|
||||
(ary (make-vector last 0)))
|
||||
(do ((i 1 (+ i 1)))
|
||||
((= i last))
|
||||
(vector-set! ary i (gen_random 1.0)))
|
||||
(heapsort n ary)
|
||||
(printf "~a~n"
|
||||
(real->decimal-string (vector-ref ary n) 10))))
|
||||
(define (heapsort n ra)
|
||||
(let ((ir n)
|
||||
(l (+ (quotient n 2) 1))
|
||||
(i 0)
|
||||
(j 0)
|
||||
(rra 0.0))
|
||||
(let/ec return
|
||||
(do ((bar #t))
|
||||
((= 1 0))
|
||||
(cond ((> l 1)
|
||||
(set! l (- l 1))
|
||||
(set! rra (vector-ref ra l)))
|
||||
(else
|
||||
(set! rra (vector-ref ra ir))
|
||||
(vector-set! ra ir (vector-ref ra 1))
|
||||
(set! ir (- ir 1))
|
||||
(cond ((<= ir 1)
|
||||
(vector-set! ra 1 rra)
|
||||
(return #t)))))
|
||||
(set! i l)
|
||||
(set! j (* l 2))
|
||||
(do ((foo #t))
|
||||
((> j ir))
|
||||
(cond ((and (< j ir) (< (vector-ref ra j) (vector-ref ra (+ j 1))))
|
||||
(set! j (+ j 1))))
|
||||
(cond ((< rra (vector-ref ra j))
|
||||
(vector-set! ra i (vector-ref ra j))
|
||||
(set! i j)
|
||||
(set! j (+ j i)))
|
||||
(else
|
||||
(set! j (+ ir 1)))))
|
||||
(vector-set! ra i rra)))))
|
||||
|
||||
(main (current-command-line-arguments)))
|
||||
(define (main args)
|
||||
(let* ((n (or (and (= (vector-length args) 1) (string->number (vector-ref args 0)))
|
||||
1))
|
||||
(last (+ n 1))
|
||||
(ary (make-vector last 0)))
|
||||
(do ((i 1 (+ i 1)))
|
||||
((= i last))
|
||||
(vector-set! ary i (gen_random 1.0)))
|
||||
(heapsort n ary)
|
||||
(printf "~a~n"
|
||||
(real->decimal-string (vector-ref ary n) 10))))
|
||||
|
||||
(main (current-command-line-arguments))
|
||||
|
|
|
|||
|
|
@ -1,2 +1,2 @@
|
|||
#lang scheme/base
|
||||
#lang racket/base
|
||||
(display "hello world\n")
|
||||
|
|
|
|||
|
|
@ -1,44 +1,45 @@
|
|||
(module lists mzscheme
|
||||
(require scheme/mpair)
|
||||
(define SIZE 10000)
|
||||
#lang racket/base
|
||||
|
||||
(define (sequence start stop)
|
||||
(if (> start stop)
|
||||
'()
|
||||
(mcons start (sequence (+ start 1) stop))))
|
||||
(require racket/mpair)
|
||||
(define SIZE 10000)
|
||||
|
||||
(define (head-to-tail! headlist taillist)
|
||||
(when (null? taillist) (begin
|
||||
(set! taillist (mlist (mcar headlist)))
|
||||
(set! headlist (mcdr headlist))))
|
||||
(letrec ((htt-helper (lambda (dest)
|
||||
(when (not (null? headlist))
|
||||
(let ((headlink headlist))
|
||||
(set-mcdr! dest headlink)
|
||||
(set! headlist (mcdr headlist))
|
||||
(htt-helper headlink))))))
|
||||
(htt-helper taillist)
|
||||
(values headlist taillist)))
|
||||
(define (sequence start stop)
|
||||
(if (> start stop)
|
||||
'()
|
||||
(mcons start (sequence (+ start 1) stop))))
|
||||
|
||||
(define (test-lists)
|
||||
(let* ([L1 (sequence 1 SIZE)]
|
||||
[L2 (mappend L1 '())]
|
||||
[L3 '()])
|
||||
(set!-values (L2 L3) (head-to-tail! L2 L3))
|
||||
(set!-values (L3 L2) (head-to-tail! (mreverse! L3) L2))
|
||||
(set! L1 (mreverse! L1))
|
||||
(cond ((not (= SIZE (mcar L1))) 0)
|
||||
((not (equal? L1 L2)) 0)
|
||||
(else (mlength L1)))))
|
||||
(define (head-to-tail! headlist taillist)
|
||||
(when (null? taillist) (begin
|
||||
(set! taillist (mlist (mcar headlist)))
|
||||
(set! headlist (mcdr headlist))))
|
||||
(letrec ((htt-helper (lambda (dest)
|
||||
(when (not (null? headlist))
|
||||
(let ((headlink headlist))
|
||||
(set-mcdr! dest headlink)
|
||||
(set! headlist (mcdr headlist))
|
||||
(htt-helper headlink))))))
|
||||
(htt-helper taillist)
|
||||
(values headlist taillist)))
|
||||
|
||||
(define (main args)
|
||||
(let ((result #f))
|
||||
(let loop ((counter (if (= (vector-length args) 0)
|
||||
1
|
||||
(string->number (vector-ref args 0)))))
|
||||
(when (> counter 0)
|
||||
(set! result (test-lists))
|
||||
(loop (- counter 1))))
|
||||
(printf "~s~n" result)))
|
||||
(define (test-lists)
|
||||
(let* ([L1 (sequence 1 SIZE)]
|
||||
[L2 (mappend L1 '())]
|
||||
[L3 '()])
|
||||
(set!-values (L2 L3) (head-to-tail! L2 L3))
|
||||
(set!-values (L3 L2) (head-to-tail! (mreverse! L3) L2))
|
||||
(set! L1 (mreverse! L1))
|
||||
(cond ((not (= SIZE (mcar L1))) 0)
|
||||
((not (equal? L1 L2)) 0)
|
||||
(else (mlength L1)))))
|
||||
|
||||
(main (current-command-line-arguments)))
|
||||
(define (main args)
|
||||
(let ((result #f))
|
||||
(let loop ((counter (if (= (vector-length args) 0)
|
||||
1
|
||||
(string->number (vector-ref args 0)))))
|
||||
(when (> counter 0)
|
||||
(set! result (test-lists))
|
||||
(loop (- counter 1))))
|
||||
(printf "~s~n" result)))
|
||||
|
||||
(main (current-command-line-arguments))
|
||||
|
|
|
|||
|
|
@ -1,76 +1,78 @@
|
|||
; Matrix.scm
|
||||
|
||||
(module matrix mzscheme
|
||||
(define size 30)
|
||||
#lang racket/base
|
||||
|
||||
(define (1+ x) (+ x 1))
|
||||
(define size 30)
|
||||
|
||||
(define (mkmatrix rows cols)
|
||||
(let ((mx (make-vector rows 0))
|
||||
(count 1))
|
||||
(do ((i 0 (1+ i)))
|
||||
((= i rows))
|
||||
(let ((row (make-vector cols 0)))
|
||||
(do ((j 0 (1+ j)))
|
||||
((= j cols))
|
||||
(vector-set! row j count)
|
||||
(set! count (+ count 1)))
|
||||
(vector-set! mx i row)))
|
||||
mx))
|
||||
(define (1+ x) (+ x 1))
|
||||
|
||||
(define (num-cols mx)
|
||||
(let ((row (vector-ref mx 0)))
|
||||
(vector-length row)))
|
||||
|
||||
(define (num-rows mx)
|
||||
(vector-length mx))
|
||||
|
||||
(define (mmult rows cols m1 m2)
|
||||
(let ((m3 (make-vector rows 0)))
|
||||
(do ((i 0 (1+ i)))
|
||||
((= i rows))
|
||||
(let ((m1i (vector-ref m1 i))
|
||||
(row (make-vector cols 0)))
|
||||
(do ((j 0 (1+ j)))
|
||||
((= j cols))
|
||||
(let ((val 0))
|
||||
(do ((k 0 (1+ k)))
|
||||
((= k cols))
|
||||
(set! val (+ val (* (vector-ref m1i k)
|
||||
(vector-ref (vector-ref m2 k) j)))))
|
||||
(vector-set! row j val)))
|
||||
(vector-set! m3 i row)))
|
||||
m3))
|
||||
|
||||
(define (matrix-print m)
|
||||
(define (mkmatrix rows cols)
|
||||
(let ((mx (make-vector rows 0))
|
||||
(count 1))
|
||||
(do ((i 0 (1+ i)))
|
||||
((= i (num-rows m)))
|
||||
(let ((row (vector-ref m i)))
|
||||
(do ((j 0 (1+ j)))
|
||||
((= j (num-cols m)))
|
||||
(display (vector-ref row j))
|
||||
(if (< j (num-cols m))
|
||||
(display " ")))
|
||||
(newline))))
|
||||
((= i rows))
|
||||
(let ((row (make-vector cols 0)))
|
||||
(do ((j 0 (1+ j)))
|
||||
((= j cols))
|
||||
(vector-set! row j count)
|
||||
(set! count (+ count 1)))
|
||||
(vector-set! mx i row)))
|
||||
mx))
|
||||
|
||||
(define (print-list . items) (for-each display items) (newline))
|
||||
(define (num-cols mx)
|
||||
(let ((row (vector-ref mx 0)))
|
||||
(vector-length row)))
|
||||
|
||||
(define (main args)
|
||||
(let ((n (or (and (= (vector-length args) 1) (string->number (vector-ref
|
||||
args 0)))
|
||||
1)))
|
||||
(let ((mm 0)
|
||||
(m1 (mkmatrix size size))
|
||||
(m2 (mkmatrix size size)))
|
||||
(let loop ((iter n))
|
||||
(cond ((> iter 0)
|
||||
(set! mm (mmult size size m1 m2))
|
||||
(loop (- iter 1)))))
|
||||
(let ((r0 (vector-ref mm 0))
|
||||
(r2 (vector-ref mm 2))
|
||||
(r3 (vector-ref mm 3))
|
||||
(r4 (vector-ref mm 4)))
|
||||
(print-list (vector-ref r0 0) " " (vector-ref r2 3) " "
|
||||
(vector-ref r3 2) " " (vector-ref r4 4))))))
|
||||
(define (num-rows mx)
|
||||
(vector-length mx))
|
||||
|
||||
(main (current-command-line-arguments)))
|
||||
(define (mmult rows cols m1 m2)
|
||||
(let ((m3 (make-vector rows 0)))
|
||||
(do ((i 0 (1+ i)))
|
||||
((= i rows))
|
||||
(let ((m1i (vector-ref m1 i))
|
||||
(row (make-vector cols 0)))
|
||||
(do ((j 0 (1+ j)))
|
||||
((= j cols))
|
||||
(let ((val 0))
|
||||
(do ((k 0 (1+ k)))
|
||||
((= k cols))
|
||||
(set! val (+ val (* (vector-ref m1i k)
|
||||
(vector-ref (vector-ref m2 k) j)))))
|
||||
(vector-set! row j val)))
|
||||
(vector-set! m3 i row)))
|
||||
m3))
|
||||
|
||||
(define (matrix-print m)
|
||||
(do ((i 0 (1+ i)))
|
||||
((= i (num-rows m)))
|
||||
(let ((row (vector-ref m i)))
|
||||
(do ((j 0 (1+ j)))
|
||||
((= j (num-cols m)))
|
||||
(display (vector-ref row j))
|
||||
(if (< j (num-cols m))
|
||||
(display " ")
|
||||
#t))
|
||||
(newline))))
|
||||
|
||||
(define (print-list . items) (for-each display items) (newline))
|
||||
|
||||
(define (main args)
|
||||
(let ((n (or (and (= (vector-length args) 1) (string->number (vector-ref
|
||||
args 0)))
|
||||
1)))
|
||||
(let ((mm 0)
|
||||
(m1 (mkmatrix size size))
|
||||
(m2 (mkmatrix size size)))
|
||||
(let loop ((iter n))
|
||||
(cond ((> iter 0)
|
||||
(set! mm (mmult size size m1 m2))
|
||||
(loop (- iter 1)))))
|
||||
(let ((r0 (vector-ref mm 0))
|
||||
(r2 (vector-ref mm 2))
|
||||
(r3 (vector-ref mm 3))
|
||||
(r4 (vector-ref mm 4)))
|
||||
(print-list (vector-ref r0 0) " " (vector-ref r2 3) " "
|
||||
(vector-ref r3 2) " " (vector-ref r4 4))))))
|
||||
|
||||
(main (current-command-line-arguments))
|
||||
|
|
|
|||
|
|
@ -1,66 +1,68 @@
|
|||
; Moments.scm
|
||||
|
||||
(module moments mzscheme
|
||||
(require (only mzlib/list sort)
|
||||
(only mzlib/string real->decimal-string))
|
||||
#lang racket/base
|
||||
|
||||
(define (to-str n) (real->decimal-string n 6))
|
||||
(require (only-in mzlib/list sort)
|
||||
(only-in mzlib/string real->decimal-string))
|
||||
|
||||
(let* ((sum 0.0)
|
||||
(numlist (let loop ((line (read-line)) (numlist '()))
|
||||
(cond ((eof-object? line) numlist)
|
||||
(else
|
||||
(let ((num (string->number line)))
|
||||
(set! sum (+ num sum))
|
||||
(loop (read-line) (cons num numlist))))))))
|
||||
(unless (null? numlist)
|
||||
(let ((n (length numlist)))
|
||||
(let ((mean (/ sum n))
|
||||
(average_deviation 0.0)
|
||||
(standard_deviation 0.0)
|
||||
(variance 0.0)
|
||||
(skew 0.0)
|
||||
(kurtosis 0.0)
|
||||
(median 0.0)
|
||||
(deviation 0.0))
|
||||
(let loop ((nums numlist))
|
||||
(if (not (null? nums))
|
||||
(begin
|
||||
(set! deviation (- (car nums) mean))
|
||||
(set! average_deviation (+ average_deviation (abs deviation)))
|
||||
(set! variance (+ variance (expt deviation 2.0)))
|
||||
(set! skew (+ skew (expt deviation 3.0)))
|
||||
(set! kurtosis (+ kurtosis (expt deviation 4)))
|
||||
(loop (cdr nums)))))
|
||||
(define (to-str n) (real->decimal-string n 6))
|
||||
|
||||
(set! average_deviation (/ average_deviation (exact->inexact n)))
|
||||
(set! variance (/ variance (- n 1)))
|
||||
(set! standard_deviation (sqrt variance))
|
||||
(let* ((sum 0.0)
|
||||
(numlist (let loop ((line (read-line)) (numlist '()))
|
||||
(cond ((eof-object? line) numlist)
|
||||
(else
|
||||
(let ((num (string->number line)))
|
||||
(set! sum (+ num sum))
|
||||
(loop (read-line) (cons num numlist))))))))
|
||||
(unless (null? numlist)
|
||||
(let ((n (length numlist)))
|
||||
(let ((mean (/ sum n))
|
||||
(average_deviation 0.0)
|
||||
(standard_deviation 0.0)
|
||||
(variance 0.0)
|
||||
(skew 0.0)
|
||||
(kurtosis 0.0)
|
||||
(median 0.0)
|
||||
(deviation 0.0))
|
||||
(let loop ((nums numlist))
|
||||
(if (not (null? nums))
|
||||
(begin
|
||||
(set! deviation (- (car nums) mean))
|
||||
(set! average_deviation (+ average_deviation (abs deviation)))
|
||||
(set! variance (+ variance (expt deviation 2.0)))
|
||||
(set! skew (+ skew (expt deviation 3.0)))
|
||||
(set! kurtosis (+ kurtosis (expt deviation 4)))
|
||||
(loop (cdr nums)))
|
||||
#t))
|
||||
|
||||
(cond ((> variance 0.0)
|
||||
(set! skew (/ skew (* n variance standard_deviation)))
|
||||
(set! kurtosis (- (/ kurtosis (* n variance variance))
|
||||
3.0))))
|
||||
(set! average_deviation (/ average_deviation (exact->inexact n)))
|
||||
(set! variance (/ variance (- n 1)))
|
||||
(set! standard_deviation (sqrt variance))
|
||||
|
||||
(set! numlist (sort numlist (lambda (x y) (< x y))))
|
||||
(cond ((> variance 0.0)
|
||||
(set! skew (/ skew (* n variance standard_deviation)))
|
||||
(set! kurtosis (- (/ kurtosis (* n variance variance))
|
||||
3.0))))
|
||||
|
||||
(let ((mid (quotient n 2)))
|
||||
(if (zero? (modulo n 2))
|
||||
(set! median (/ (+ (car (list-tail numlist mid))
|
||||
(car (list-tail numlist (- mid 1))))
|
||||
2.0))
|
||||
(set! median (car (list-tail numlist mid)))))
|
||||
(set! numlist (sort numlist (lambda (x y) (< x y))))
|
||||
|
||||
(let ((mid (quotient n 2)))
|
||||
(if (zero? (modulo n 2))
|
||||
(set! median (/ (+ (car (list-tail numlist mid))
|
||||
(car (list-tail numlist (- mid 1))))
|
||||
2.0))
|
||||
(set! median (car (list-tail numlist mid)))))
|
||||
|
||||
|
||||
(set! standard_deviation (/ (round (* standard_deviation 1000000))
|
||||
1000000))
|
||||
(set! standard_deviation (/ (round (* standard_deviation 1000000))
|
||||
1000000))
|
||||
|
||||
(for-each display
|
||||
`("n: " ,n "\n"
|
||||
"median: " ,(to-str median) "\n"
|
||||
"mean: " ,(to-str mean) "\n"
|
||||
"average_deviation: " ,(to-str average_deviation ) "\n"
|
||||
"standard_deviation: " ,(to-str standard_deviation) "\n"
|
||||
"variance: " ,(to-str variance)"\n"
|
||||
"skew: " ,(to-str skew) "\n"
|
||||
"kurtosis: " ,(to-str kurtosis)"\n" )))))))
|
||||
(for-each display
|
||||
`("n: " ,n "\n"
|
||||
"median: " ,(to-str median) "\n"
|
||||
"mean: " ,(to-str mean) "\n"
|
||||
"average_deviation: " ,(to-str average_deviation ) "\n"
|
||||
"standard_deviation: " ,(to-str standard_deviation) "\n"
|
||||
"variance: " ,(to-str variance)"\n"
|
||||
"skew: " ,(to-str skew) "\n"
|
||||
"kurtosis: " ,(to-str kurtosis)"\n" ))))))
|
||||
|
|
|
|||
|
|
@ -1,18 +1,19 @@
|
|||
(module nestedloop mzscheme
|
||||
(require mzlib/defmacro)
|
||||
#lang racket
|
||||
|
||||
(define-macro (nest n expr)
|
||||
(if (> n 0)
|
||||
`(let loop ([i 1]) (unless (> i n)
|
||||
(nest ,(- n 1) ,expr)
|
||||
(loop (add1 i))))
|
||||
expr))
|
||||
(require mzlib/defmacro)
|
||||
|
||||
(define-macro (nest n expr)
|
||||
(if (> n 0)
|
||||
`(let loop ([i 1]) (unless (> i n)
|
||||
(nest ,(- n 1) ,expr)
|
||||
(loop (add1 i))))
|
||||
expr))
|
||||
|
||||
|
||||
(define (main argv)
|
||||
(let* ([n (string->number (vector-ref argv 0))]
|
||||
[x 0])
|
||||
(nest 6 (set! x (+ x 1)))
|
||||
(printf "~s~n" x)))
|
||||
(define (main argv)
|
||||
(let* ([n (string->number (vector-ref argv 0))]
|
||||
[x 0])
|
||||
(nest 6 (set! x (+ x 1)))
|
||||
(printf "~s~n" x)))
|
||||
|
||||
(main (current-command-line-arguments)))
|
||||
(main (current-command-line-arguments))
|
||||
|
|
|
|||
|
|
@ -1,4 +1,3 @@
|
|||
#!/usr/bin/mzscheme -qu
|
||||
;; $Id: nsieve-mzscheme.code,v 1.6 2006/06/10 23:38:29 bfulgham Exp $
|
||||
;; The Great Computer Language Shootout
|
||||
;; http://shootout.alioth.debian.org/
|
||||
|
|
@ -7,8 +6,8 @@
|
|||
;; Written by Dima Dorfman, 2004
|
||||
;; Converted to MzScheme by Brent Fulgham
|
||||
|
||||
#lang scheme/base
|
||||
(require scheme/cmdline)
|
||||
#lang racket/base
|
||||
(require racket/cmdline)
|
||||
|
||||
(define (nsieve m)
|
||||
(let ((a (make-vector m #t)))
|
||||
|
|
|
|||
|
|
@ -1,12 +1,11 @@
|
|||
#!/usr/bin/mzscheme -qu
|
||||
;;; The Great Computer Language Shootout
|
||||
;;; http://shootout.alioth.debian.org/
|
||||
;;
|
||||
;; Adapted from CMUCL code by Dima Dorfman; bit-vector stuff by Alex Shinn;
|
||||
;; cobbled together by felix, converted to MzScheme by Brent Fulgham
|
||||
|
||||
#lang scheme/base
|
||||
(require scheme/cmdline)
|
||||
#lang racket/base
|
||||
(require racket/cmdline)
|
||||
|
||||
(define (make-bit-vector size)
|
||||
(let* ((len (quotient (+ size 7) 8))
|
||||
|
|
|
|||
|
|
@ -8,8 +8,8 @@
|
|||
;; Contributed by Anthony Borla
|
||||
;; ---------------------------------------------------------------------
|
||||
|
||||
#lang scheme/base
|
||||
(require scheme/cmdline)
|
||||
#lang racket/base
|
||||
(require racket/cmdline)
|
||||
|
||||
(let ((n (exact->inexact
|
||||
(string->number
|
||||
|
|
|
|||
|
|
@ -3,35 +3,37 @@
|
|||
;;;
|
||||
;;; Modified for proper string output by Brent Fulgham
|
||||
|
||||
(module random mzscheme
|
||||
(require (only mzlib/string real->decimal-string))
|
||||
#lang racket/base
|
||||
|
||||
(define IM 139968)
|
||||
(define IA 3877)
|
||||
(define IC 29573)
|
||||
(require (only-in mzlib/string real->decimal-string))
|
||||
|
||||
(define gen_random
|
||||
(let ((LAST 42))
|
||||
(lambda (max)
|
||||
(set! LAST (modulo (+ (* LAST IA) IC) IM))
|
||||
(/ (* max LAST) IM))))
|
||||
(define IM 139968)
|
||||
(define IA 3877)
|
||||
(define IC 29573)
|
||||
|
||||
(define (roundto digits num)
|
||||
(let* ([e (expt 10 digits)]
|
||||
[num (round (* e (inexact->exact num)))])
|
||||
(format "~a.~a"
|
||||
(quotient num e)
|
||||
(substring (string-append (number->string (remainder num e))
|
||||
(make-string digits #\0))
|
||||
0 digits))))
|
||||
(define gen_random
|
||||
(let ((LAST 42))
|
||||
(lambda (max)
|
||||
(set! LAST (modulo (+ (* LAST IA) IC) IM))
|
||||
(/ (* max LAST) IM))))
|
||||
|
||||
(let ((n (string->number
|
||||
(vector-ref (current-command-line-arguments)
|
||||
0))))
|
||||
(let loop ((iter n))
|
||||
(if (> iter 1)
|
||||
(begin
|
||||
(gen_random 100.0)
|
||||
(loop (- iter 1)))))
|
||||
(printf "~a~%"
|
||||
(real->decimal-string (gen_random 100.0) 9))))
|
||||
(define (roundto digits num)
|
||||
(let* ([e (expt 10 digits)]
|
||||
[num (round (* e (inexact->exact num)))])
|
||||
(format "~a.~a"
|
||||
(quotient num e)
|
||||
(substring (string-append (number->string (remainder num e))
|
||||
(make-string digits #\0))
|
||||
0 digits))))
|
||||
|
||||
(let ((n (string->number
|
||||
(vector-ref (current-command-line-arguments)
|
||||
0))))
|
||||
(let loop ((iter n))
|
||||
(if (> iter 1)
|
||||
(begin
|
||||
(gen_random 100.0)
|
||||
(loop (- iter 1)))
|
||||
#t))
|
||||
(printf "~a~%"
|
||||
(real->decimal-string (gen_random 100.0) 9)))
|
||||
|
|
|
|||
|
|
@ -8,9 +8,9 @@
|
|||
;; Contributed by Anthony Borla
|
||||
;; ---------------------------------------------------------------------
|
||||
|
||||
#lang scheme/base
|
||||
(require scheme/cmdline
|
||||
scheme/flonum)
|
||||
#lang racket/base
|
||||
(require racket/cmdline
|
||||
racket/flonum)
|
||||
|
||||
;; -------------------------------
|
||||
|
||||
|
|
|
|||
|
|
@ -9,51 +9,52 @@
|
|||
;; NOTE: the running time of this benchmark is dominated by
|
||||
;; construction of the `num' string.
|
||||
|
||||
(module regexmatch mzscheme
|
||||
(define rx
|
||||
(string-append
|
||||
"(?:^|[^0-9\\(])" ; (1) preceding non-digit or bol
|
||||
"(" ; (2) area code
|
||||
"\\(([0-9][0-9][0-9])\\)" ; (3) is either 3 digits in parens
|
||||
"|" ; or
|
||||
"([0-9][0-9][0-9])" ; (4) just 3 digits
|
||||
")" ; end of area code
|
||||
" " ; area code is followed by one space
|
||||
"([0-9][0-9][0-9])" ; (5) exchange is 3 digits
|
||||
"[ -]" ; separator is either space or dash
|
||||
"([0-9][0-9][0-9][0-9])" ; (6) last 4 digits
|
||||
"(?:[^0-9]|$)" ; must be followed by a non-digit
|
||||
))
|
||||
#lang racket/base
|
||||
|
||||
(define rx
|
||||
(string-append
|
||||
"(?:^|[^0-9\\(])" ; (1) preceding non-digit or bol
|
||||
"(" ; (2) area code
|
||||
"\\(([0-9][0-9][0-9])\\)" ; (3) is either 3 digits in parens
|
||||
"|" ; or
|
||||
"([0-9][0-9][0-9])" ; (4) just 3 digits
|
||||
")" ; end of area code
|
||||
" " ; area code is followed by one space
|
||||
"([0-9][0-9][0-9])" ; (5) exchange is 3 digits
|
||||
"[ -]" ; separator is either space or dash
|
||||
"([0-9][0-9][0-9][0-9])" ; (6) last 4 digits
|
||||
"(?:[^0-9]|$)" ; must be followed by a non-digit
|
||||
))
|
||||
|
||||
|
||||
(define (main args)
|
||||
(let ((n (if (= (vector-length args) 0)
|
||||
"1"
|
||||
(vector-ref args 0)))
|
||||
(phonelines '())
|
||||
(rx (byte-regexp (string->bytes/utf-8 rx)))
|
||||
(count 0))
|
||||
(let loop ((line (read-bytes-line)))
|
||||
(cond ((eof-object? line) #f)
|
||||
(else
|
||||
(set! phonelines (cons line phonelines))
|
||||
(loop (read-line)))))
|
||||
(set! phonelines (reverse phonelines))
|
||||
(do ([n (string->number n) (sub1 n)])
|
||||
((negative? n))
|
||||
(let loop ((phones phonelines)
|
||||
(count 0))
|
||||
(if (null? phones)
|
||||
count
|
||||
(let ([m (regexp-match rx (car phones))])
|
||||
(if m
|
||||
(let-values ([(a1 a2 a3 exch numb) (apply values (cdr m))])
|
||||
(let* ([area (and a1 (or a2 a3))]
|
||||
[num (bytes-append #"(" area #") " exch #"-" numb)]
|
||||
[count (add1 count)])
|
||||
(when (zero? n)
|
||||
(printf "~a: ~a~n" count num))
|
||||
(loop (cdr phones) count)))
|
||||
(loop (cdr phones) count))))))))
|
||||
(define (main args)
|
||||
(let ((n (if (= (vector-length args) 0)
|
||||
"1"
|
||||
(vector-ref args 0)))
|
||||
(phonelines '())
|
||||
(rx (byte-regexp (string->bytes/utf-8 rx)))
|
||||
(count 0))
|
||||
(let loop ((line (read-bytes-line)))
|
||||
(cond ((eof-object? line) #f)
|
||||
(else
|
||||
(set! phonelines (cons line phonelines))
|
||||
(loop (read-line)))))
|
||||
(set! phonelines (reverse phonelines))
|
||||
(do ([n (string->number n) (sub1 n)])
|
||||
((negative? n))
|
||||
(let loop ((phones phonelines)
|
||||
(count 0))
|
||||
(if (null? phones)
|
||||
count
|
||||
(let ([m (regexp-match rx (car phones))])
|
||||
(if m
|
||||
(let-values ([(a1 a2 a3 exch numb) (apply values (cdr m))])
|
||||
(let* ([area (and a1 (or a2 a3))]
|
||||
[num (bytes-append #"(" area #") " exch #"-" numb)]
|
||||
[count (add1 count)])
|
||||
(when (zero? n)
|
||||
(printf "~a: ~a~n" count num))
|
||||
(loop (cdr phones) count)))
|
||||
(loop (cdr phones) count))))))))
|
||||
|
||||
(main (current-command-line-arguments)))
|
||||
(main (current-command-line-arguments))
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@
|
|||
;; The Computer Language Benchmarks Game
|
||||
;; http://shootout.alioth.debian.org/
|
||||
|
||||
(require scheme/cmdline)
|
||||
(require racket/cmdline)
|
||||
|
||||
(define translation (make-vector 128))
|
||||
|
||||
|
|
|
|||
|
|
@ -3,11 +3,12 @@
|
|||
;;; http://shootout.alioth.debian.org/
|
||||
;;; Provided by Bengt Kleberg
|
||||
|
||||
(module reversefile mzscheme
|
||||
(let ([inport (current-input-port)])
|
||||
(let rev ([lines null])
|
||||
(let ([line (read-bytes-line inport)])
|
||||
(if (eof-object? line)
|
||||
(for-each (lambda (l) (printf "~a\n" l))
|
||||
lines)
|
||||
(rev (cons line lines)))))))
|
||||
#lang racket/base
|
||||
|
||||
(let ([inport (current-input-port)])
|
||||
(let rev ([lines null])
|
||||
(let ([line (read-bytes-line inport)])
|
||||
(if (eof-object? line)
|
||||
(for-each (lambda (l) (printf "~a\n" l))
|
||||
lines)
|
||||
(rev (cons line lines))))))
|
||||
|
|
|
|||
|
|
@ -18,29 +18,29 @@
|
|||
("lists.rkt" "18")
|
||||
("mandelbrot.rkt" "3000")
|
||||
("matrix.rkt" "600")
|
||||
("moments.rkt") ; 200 somethings...
|
||||
("moments.rkt" #f ,(lambda () (mk-sumcol-input)))
|
||||
("nbody.rkt" "20000000")
|
||||
("nestedloop.rkt" "18")
|
||||
("nsieve.rkt" "9")
|
||||
("nsievebits.rkt" "11")
|
||||
("partialsums.rkt" "2500000")
|
||||
("pidigits.rkt" "2500")
|
||||
("pidigits1.rkt")
|
||||
("pidigits1.rkt" "2500")
|
||||
("random.rkt" "900000")
|
||||
("recursive.rkt" "11")
|
||||
("regexmatch.rkt")
|
||||
("regexpdna.rkt" #f ,(lambda () (mk-regexpdna-input)))
|
||||
("reversecomplement.rkt" #f ,(lambda () (mk-revcomp-input)))
|
||||
("k-nucleotide.rkt" #f ,(lambda () (mk-knuc-input)))
|
||||
("reversefile.rkt")
|
||||
("reversefile.rkt" #f ,(lambda () (mk-sumcol-input)))
|
||||
("sieve.rkt" "1200")
|
||||
("spellcheck.rkt")
|
||||
("spectralnorm.rkt" "5500")
|
||||
("spectralnorm-unsafe.rkt" "5500")
|
||||
("strcat.rkt" "40000")
|
||||
("sumcol.rkt" #f ,(lambda () (mk-sumcol-input)))
|
||||
("wc.rkt")
|
||||
("wordfreq.rkt")
|
||||
("wc.rkt" #f ,(lambda () (mk-sumcol-input)))
|
||||
("wordfreq.rkt" #f ,(lambda () (mk-sumcol-input)))
|
||||
))
|
||||
|
||||
(define-runtime-path here ".")
|
||||
|
|
@ -73,7 +73,7 @@
|
|||
(unless (file-exists? f)
|
||||
(printf "Building sumcol 21000 input: ~a\n" f)
|
||||
(let ([c (with-input-from-file (build-path (collection-path "tests")
|
||||
"mzscheme"
|
||||
"racket"
|
||||
"benchmarks"
|
||||
"shootout"
|
||||
"sumcol-input.txt")
|
||||
|
|
@ -113,6 +113,7 @@
|
|||
(current-input-port)
|
||||
(open-input-file ((caddr m))))])
|
||||
(parameterize ([current-namespace (make-namespace)])
|
||||
(collect-garbage)
|
||||
(collect-garbage)
|
||||
(time (dynreq prog))))
|
||||
(unless (= n 1)
|
||||
|
|
|
|||
|
|
@ -1,25 +1,27 @@
|
|||
(module sieve mzscheme
|
||||
#lang racket/base
|
||||
|
||||
(define (main args)
|
||||
(let ((n (if (= (vector-length args) 0)
|
||||
1
|
||||
(string->number (vector-ref args 0))))
|
||||
(count 0)
|
||||
(flags (make-vector 8192)))
|
||||
(let loop ((iter n))
|
||||
(if (> iter 0)
|
||||
(begin
|
||||
(do ((i 0 (+ i 1))) ((>= i 8192)) (vector-set! flags i #t))
|
||||
(set! count 0)
|
||||
(do ((i 2 (+ 1 i)))
|
||||
((>= i 8192))
|
||||
(if (vector-ref flags i)
|
||||
(begin
|
||||
(do ((k (+ i i) (+ k i)))
|
||||
((>= k 8192))
|
||||
(vector-set! flags k #f))
|
||||
(set! count (+ 1 count)))))
|
||||
(loop (- iter 1)))))
|
||||
(display "Count: ") (display count) (newline)))
|
||||
(define (main args)
|
||||
(let ((n (if (= (vector-length args) 0)
|
||||
1
|
||||
(string->number (vector-ref args 0))))
|
||||
(count 0)
|
||||
(flags (make-vector 8192)))
|
||||
(let loop ((iter n))
|
||||
(if (> iter 0)
|
||||
(begin
|
||||
(do ((i 0 (+ i 1))) ((>= i 8192)) (vector-set! flags i #t))
|
||||
(set! count 0)
|
||||
(do ((i 2 (+ 1 i)))
|
||||
((>= i 8192))
|
||||
(if (vector-ref flags i)
|
||||
(begin
|
||||
(do ((k (+ i i) (+ k i)))
|
||||
((>= k 8192))
|
||||
(vector-set! flags k #f))
|
||||
(set! count (+ 1 count)))
|
||||
#t))
|
||||
(loop (- iter 1)))
|
||||
#t))
|
||||
(display "Count: ") (display count) (newline)))
|
||||
|
||||
(main (current-command-line-arguments)))
|
||||
(main (current-command-line-arguments))
|
||||
|
|
|
|||
|
|
@ -3,21 +3,22 @@
|
|||
;;;
|
||||
;;; spellcheck benchmark
|
||||
|
||||
(module spellcheck mzscheme
|
||||
(define dict (make-hash-table 'equal))
|
||||
#lang racket/base
|
||||
|
||||
(with-input-from-file "Usr.Dict.Words"
|
||||
(lambda ()
|
||||
(let loop ()
|
||||
(let ([r (read-bytes-line)])
|
||||
(unless (eof-object? r)
|
||||
(hash-table-put! dict r #t)
|
||||
(loop))))))
|
||||
(define dict (make-hash))
|
||||
|
||||
(let ([in (current-input-port)])
|
||||
(with-input-from-file "Usr.Dict.Words"
|
||||
(lambda ()
|
||||
(let loop ()
|
||||
(let ([w (read-bytes-line in)])
|
||||
(unless (eof-object? w)
|
||||
(unless (hash-table-get dict w (lambda () #f))
|
||||
(printf "~a\n" w))
|
||||
(loop))))))
|
||||
(let ([r (read-bytes-line)])
|
||||
(unless (eof-object? r)
|
||||
(hash-set! dict r #t)
|
||||
(loop))))))
|
||||
|
||||
(let ([in (current-input-port)])
|
||||
(let loop ()
|
||||
(let ([w (read-bytes-line in)])
|
||||
(unless (eof-object? w)
|
||||
(unless (hash-ref dict w (lambda () #f))
|
||||
(printf "~a\n" w))
|
||||
(loop)))))
|
||||
|
|
|
|||
|
|
@ -19,17 +19,18 @@
|
|||
; s should be a string, string buffer, or character array.
|
||||
; The program should not construct a list of strings and join it.
|
||||
|
||||
(module strcat mzscheme
|
||||
(define p (open-output-bytes))
|
||||
#lang racket/base
|
||||
|
||||
(define hello #"hello\n")
|
||||
(define p (open-output-bytes))
|
||||
|
||||
(let loop ([n (string->number
|
||||
(vector-ref (current-command-line-arguments) 0))])
|
||||
(unless (zero? n)
|
||||
(display hello p)
|
||||
;; At this point, (get-output-bytes p) would
|
||||
;; return the byte string accumulated so far.
|
||||
(loop (sub1 n))))
|
||||
(define hello #"hello\n")
|
||||
|
||||
(printf "~a\n" (file-position p)))
|
||||
(let loop ([n (string->number
|
||||
(vector-ref (current-command-line-arguments) 0))])
|
||||
(unless (zero? n)
|
||||
(display hello p)
|
||||
;; At this point, (get-output-bytes p) would
|
||||
;; return the byte string accumulated so far.
|
||||
(loop (sub1 n))))
|
||||
|
||||
(printf "~a\n" (file-position p))
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
#lang scheme/base
|
||||
#lang racket/base
|
||||
|
||||
(for/fold ([acc 0])
|
||||
([n (in-lines)])
|
||||
|
|
|
|||
|
|
@ -2,17 +2,18 @@
|
|||
; Faster, more idiomatic Scheme by Neil Van Dyke
|
||||
;
|
||||
|
||||
(module wc mzscheme
|
||||
(define (main iport)
|
||||
(apply printf "~s ~s ~s\n"
|
||||
(let wc ((i #f) (lines 0) (words 0) (chars 0))
|
||||
(let ((x (read-char iport)))
|
||||
(if (eof-object? x)
|
||||
(list lines words chars)
|
||||
(case x
|
||||
((#\newline) (wc #f (add1 lines) words (add1 chars)))
|
||||
((#\space #\tab) (wc #f lines words (add1 chars)))
|
||||
(else
|
||||
(wc #t lines (if i words (add1 words)) (add1 chars)))))))))
|
||||
#lang racket/base
|
||||
|
||||
(main (current-input-port)))
|
||||
(define (main iport)
|
||||
(apply printf "~s ~s ~s\n"
|
||||
(let wc ((i #f) (lines 0) (words 0) (chars 0))
|
||||
(let ((x (read-char iport)))
|
||||
(if (eof-object? x)
|
||||
(list lines words chars)
|
||||
(case x
|
||||
((#\newline) (wc #f (add1 lines) words (add1 chars)))
|
||||
((#\space #\tab) (wc #f lines words (add1 chars)))
|
||||
(else
|
||||
(wc #t lines (if i words (add1 words)) (add1 chars)))))))))
|
||||
|
||||
(main (current-input-port))
|
||||
|
|
|
|||
|
|
@ -4,29 +4,30 @@
|
|||
; Updated and corrected by Brent Fulgham
|
||||
; Re-written by Matthew Flatt with some inspriation from the Python example
|
||||
|
||||
(module wordfreq mzscheme
|
||||
(require mzlib/list)
|
||||
#lang racket
|
||||
|
||||
(define t (make-hash-table 'equal))
|
||||
(require mzlib/list)
|
||||
|
||||
(define (register-word! s)
|
||||
(let ([s (string-downcase (bytes->string/utf-8 s))])
|
||||
(hash-table-put! t s (add1 (hash-table-get t s (lambda () 0))))))
|
||||
(define t (make-hash))
|
||||
|
||||
(let ([in (current-input-port)])
|
||||
(let loop ()
|
||||
(let ([m (regexp-match #rx#"[a-zA-Z]+" in)])
|
||||
(when m
|
||||
(register-word! (car m))
|
||||
(loop)))))
|
||||
(define (register-word! s)
|
||||
(let ([s (string-downcase (bytes->string/utf-8 s))])
|
||||
(hash-set! t s (add1 (hash-ref t s (lambda () 0))))))
|
||||
|
||||
(for-each display
|
||||
(sort (hash-table-map
|
||||
t
|
||||
(lambda (word count)
|
||||
(let ((count (number->string count)))
|
||||
(format"~a~a ~a~%"
|
||||
(make-string (- 7 (string-length count)) #\space)
|
||||
count
|
||||
word))))
|
||||
string>?)))
|
||||
(let ([in (current-input-port)])
|
||||
(let loop ()
|
||||
(let ([m (regexp-match #rx#"[a-zA-Z]+" in)])
|
||||
(when m
|
||||
(register-word! (car m))
|
||||
(loop)))))
|
||||
|
||||
(for-each display
|
||||
(sort (hash-map
|
||||
t
|
||||
(lambda (word count)
|
||||
(let ((count (number->string count)))
|
||||
(format"~a~a ~a~%"
|
||||
(make-string (- 7 (string-length count)) #\space)
|
||||
count
|
||||
word))))
|
||||
string>?))
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user