File: perm9.sml

package info (click to toggle)
smlsharp 4.1.0-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 123,732 kB
  • sloc: ansic: 16,725; sh: 4,347; makefile: 2,191; java: 742; haskell: 493; ruby: 305; cpp: 284; pascal: 256; ml: 255; lisp: 141; asm: 97; sql: 74
file content (148 lines) | stat: -rw-r--r-- 4,596 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
(*
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; 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.
; 990624 / wdc Translated into Standard ML

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

fun permutations x0 =
  let val x = ref x0
      val perms = ref [x0]
      fun P n =
        if n > 1
          then let fun loop j =
                      if j = 0
                        then P (n - 1)
                        else ( P (n - 1);
                               F n;
                               loop (j - 1) )
               in loop (n - 1)
               end
          else ()
      and F n =
        ( x := revloop (!x, n, list_tail (!x, n));
          perms := !x :: !perms )
      and revloop (x, n, y) =
        if n = 0
          then y
          else revloop (tl x, n - 1, (hd x) :: y)
      and list_tail (x, n) =
        if n = 0
          then x
          else list_tail (tl x, n - 1)
  in (P (length (!x)); !perms)
  end

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

fun sumlists x =
  let fun loop1 (x, sum) =
        if x = []
          then sum
          else let fun loop2 (y, sum) =
                     if y = []
                       then sum
                       else loop2 (tl y, sum + (hd y))
               in loop1 (tl x, loop2 (hd x, sum))
               end
  in loop1 (x, 0)
  end

val perms : int list list ref = ref []

fun one2n n =
  let fun loop (n, p) =
        if n = 0
          then p
          else loop (n - 1, n :: p)
  in loop (n, [])
  end

fun run_benchmark x = x

fun perm9_benchmark (m, n : int) =
  let fun factorial n =
        if n = 1
          then 1
          else n * factorial (n - 1)
  in run_benchmark (concat ([Int.toString (m), "perm", Int.toString (n)]),
                    1,
                    fn () =>
                      ( perms := permutations (one2n n);
                        let fun loop m =
                              if m = 0
                                then !perms
                                else ( perms := permutations (hd (!perms));
                                       loop (m - 1) )
                        in loop m
                        end ),
                    fn (result) =>
                      (sumlists result)
                        = Int.quot ((n * (n + 1) * factorial (n)), 2))
  end

fun main () = perm9_benchmark (5, 9)

structure Main =
struct
  fun testit out =
      let val (_,_,f,t) = main ()
      in TextIO.output (out, if t (f ()) then "OK\n" else "Fail\n") end
  fun doit () =
      let val (_,n,f,_) = main ()
          fun loop 0 = () | loop n = (f (); loop (n-1))
      in loop n end
end