ikarus/benchmarks/new/r6rs-benchmarks/perm9.ss

116 lines
3.6 KiB
Scheme
Raw Normal View History

Added many benchmarks. added: benchmarks/new/r6rs-benchmarks/BUGS benchmarks/new/r6rs-benchmarks/array1.ss benchmarks/new/r6rs-benchmarks/bib benchmarks/new/r6rs-benchmarks/boyer.ss benchmarks/new/r6rs-benchmarks/browse.ss benchmarks/new/r6rs-benchmarks/cat.ss benchmarks/new/r6rs-benchmarks/conform.ss benchmarks/new/r6rs-benchmarks/cpstak.ss benchmarks/new/r6rs-benchmarks/ctak.ss benchmarks/new/r6rs-benchmarks/dderiv.ss benchmarks/new/r6rs-benchmarks/deriv.ss benchmarks/new/r6rs-benchmarks/destruc.ss benchmarks/new/r6rs-benchmarks/diviter.ss benchmarks/new/r6rs-benchmarks/divrec.ss benchmarks/new/r6rs-benchmarks/dynamic.src.ss benchmarks/new/r6rs-benchmarks/dynamic.ss benchmarks/new/r6rs-benchmarks/earley.ss benchmarks/new/r6rs-benchmarks/fibc.ss benchmarks/new/r6rs-benchmarks/fibfp.ss benchmarks/new/r6rs-benchmarks/gcbench.ss benchmarks/new/r6rs-benchmarks/gcold.ss benchmarks/new/r6rs-benchmarks/graphs.ss benchmarks/new/r6rs-benchmarks/lattice.ss benchmarks/new/r6rs-benchmarks/matrix.ss benchmarks/new/r6rs-benchmarks/maze.ss benchmarks/new/r6rs-benchmarks/mazefun.ss benchmarks/new/r6rs-benchmarks/mbrot.ss benchmarks/new/r6rs-benchmarks/nboyer.ss benchmarks/new/r6rs-benchmarks/nqueens.ss benchmarks/new/r6rs-benchmarks/ntakl.ss benchmarks/new/r6rs-benchmarks/paraffins.ss benchmarks/new/r6rs-benchmarks/parsing-test.sch benchmarks/new/r6rs-benchmarks/parsing.ss benchmarks/new/r6rs-benchmarks/perm9.ss benchmarks/new/r6rs-benchmarks/peval.ss benchmarks/new/r6rs-benchmarks/pi.ss benchmarks/new/r6rs-benchmarks/pnpoly.ss benchmarks/new/r6rs-benchmarks/ray.ss benchmarks/new/r6rs-benchmarks/todo-src/ benchmarks/new/r6rs-benchmarks/todo-src/README.flonum-benchmarks benchmarks/new/r6rs-benchmarks/todo-src/compiler.scm benchmarks/new/r6rs-benchmarks/todo-src/fft.scm benchmarks/new/r6rs-benchmarks/todo-src/fpsum.scm benchmarks/new/r6rs-benchmarks/todo-src/nbody.scm benchmarks/new/r6rs-benchmarks/todo-src/nucleic.scm benchmarks/new/r6rs-benchmarks/todo-src/primes.scm benchmarks/new/r6rs-benchmarks/todo-src/puzzle.scm benchmarks/new/r6rs-benchmarks/todo-src/quicksort.scm benchmarks/new/r6rs-benchmarks/todo-src/rn100 benchmarks/new/r6rs-benchmarks/todo-src/sboyer.scm benchmarks/new/r6rs-benchmarks/todo-src/scheme.scm benchmarks/new/r6rs-benchmarks/todo-src/simplex.scm benchmarks/new/r6rs-benchmarks/todo-src/slatex.scm benchmarks/new/r6rs-benchmarks/todo-src/slatex.sty benchmarks/new/r6rs-benchmarks/todo-src/smlboyer.scm benchmarks/new/r6rs-benchmarks/todo-src/string.scm benchmarks/new/r6rs-benchmarks/todo-src/succeed.scm benchmarks/new/r6rs-benchmarks/todo-src/sum.scm benchmarks/new/r6rs-benchmarks/todo-src/sum1.scm benchmarks/new/r6rs-benchmarks/todo-src/sumfp.scm benchmarks/new/r6rs-benchmarks/todo-src/sumloop.scm benchmarks/new/r6rs-benchmarks/todo-src/tail.scm benchmarks/new/r6rs-benchmarks/todo-src/tak.scm benchmarks/new/r6rs-benchmarks/todo-src/takl.scm benchmarks/new/r6rs-benchmarks/todo-src/temp.scm benchmarks/new/r6rs-benchmarks/todo-src/temp2.scm benchmarks/new/r6rs-benchmarks/todo-src/test.scm benchmarks/new/r6rs-benchmarks/todo-src/test.tex benchmarks/new/r6rs-benchmarks/todo-src/tfib.scm benchmarks/new/r6rs-benchmarks/todo-src/trav1.scm benchmarks/new/r6rs-benchmarks/todo-src/trav2.scm benchmarks/new/r6rs-benchmarks/todo-src/triangl.scm benchmarks/new/r6rs-benchmarks/todo-src/wc.scm modified: benchmarks/new/r6rs-benchmarks.ss benchmarks/results.Larceny-r6rs benchmarks/src/ntakl.scm
2007-06-13 07:17:57 -04:00
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; File: perm9.sch
; Description: memory system benchmark using Zaks's permutation generator
; Author: Lars Hansen, Will Clinger, and Gene Luks
; Created: 18-Mar-94
; Language: Scheme
; Status: Public Domain
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; 940720 / lth Added some more benchmarks for the thesis paper.
; 970215 / wdc Increased problem size from 8 to 9; improved tenperm9-benchmark.
; 970531 / wdc Cleaned up for public release.
; 981116 / wdc Simplified to fit in with Feeley's benchmark suite.
; The perm9 benchmark generates a list of all 362880 permutations of
; the first 9 integers, allocating 1349288 pairs (typically 10,794,304
; bytes), all of which goes into the generated list. (That is, the
; perm9 benchmark generates absolutely no garbage.) This represents
; a savings of about 63% over the storage that would be required by
; an unshared list of permutations. The generated permutations are
; in order of a grey code that bears no obvious relationship to a
; lexicographic order.
;
; The 10perm9 benchmark repeats the perm9 benchmark 10 times, so it
; allocates and reclaims 13492880 pairs (typically 107,943,040 bytes).
; The live storage peaks at twice the storage that is allocated by the
; perm9 benchmark. At the end of each iteration, the oldest half of
; the live storage becomes garbage. Object lifetimes are distributed
; uniformly between 10.3 and 20.6 megabytes.
; Date: Thu, 17 Mar 94 19:43:32 -0800
; From: luks@sisters.cs.uoregon.edu
; To: will
; Subject: Pancake flips
(library (r6rs-benchmarks perm9)
(export main)
(import (r6rs) (r6rs-benchmarks))
; Procedure P_n generates a grey code of all perms of n elements
; on top of stack ending with reversal of starting sequence
;
; F_n is flip of top n elements.
;
;
; procedure P_n
;
; if n>1 then
; begin
; repeat P_{n-1},F_n n-1 times;
; P_{n-1}
; end
;
(define (permutations x)
(let ((x x)
(perms (list x)))
(define (P n)
(if (> n 1)
(do ((j (- n 1) (- j 1)))
((zero? j)
(P (- n 1)))
(P (- n 1))
(F n))))
(define (F n)
(set! x (revloop x n (list-tail x n)))
(set! perms (cons x perms)))
(define (revloop x n y)
(if (zero? n)
y
(revloop (cdr x)
(- n 1)
(cons (car x) y))))
(define (list-tail x n)
(if (zero? n)
x
(list-tail (cdr x) (- n 1))))
(P (length x))
perms))
; Given a list of lists of numbers, returns the sum of the sums
; of those lists.
;
; for (; x != NULL; x = x->rest)
; for (y = x->first; y != NULL; y = y->rest)
; sum = sum + y->first;
(define (sumlists x)
(do ((x x (cdr x))
(sum 0 (do ((y (car x) (cdr y))
(sum sum (+ sum (car y))))
((null? y) sum))))
((null? x) sum)))
(define (one..n n)
(do ((n n (- n 1))
(p '() (cons n p)))
((zero? n) p)))
(define (main . args)
(let ((n 9))
(define (factorial n)
(if (zero? n)
1
(* n (factorial (- n 1)))))
(run-benchmark
(string-append "perm" (number->string n))
perm9-iters
(lambda (result)
(= (sumlists result)
(* (quotient (* n (+ n 1)) 2) (factorial n))))
(lambda (lst)
(lambda ()
(permutations lst)))
(one..n n)))))