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

116 lines
3.6 KiB
Scheme

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; 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)))))