ikarus/benchmarks/r6rs-benchmarks/perm9.ss

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