Commit | Line | Data |
---|---|---|
7f918cf1 CE |
1 | (*kitknuth_bendix36c.sml*) |
2 | ||
3 | (* quicksort-random.sml | |
4 | * | |
5 | * Input....: Random list (pseudo-random integers) | |
6 | * Optimised: 'arg as ...' in quickSort'() and partition(). | |
7 | * Copying left-parts after partitioning inside quickSort'(). | |
8 | * `Bertelsen transformation' of argument to tail-recursive | |
9 | * call to quickSort'(). | |
10 | * | |
11 | * Sestoft & Bertelsen, December 1995 | |
12 | *) | |
13 | ||
14 | val _ = | |
15 | let | |
16 | fun map f nil = nil | |
17 | | map f (x :: L) = f x :: map f L | |
18 | fun rev l = | |
19 | let fun rev_rec(p as ([], acc)) = p | |
20 | | rev_rec(x::xs, acc) = rev_rec(xs, x::acc) | |
21 | in #2 (rev_rec(l,nil)) | |
22 | end | |
23 | fun length [] = 0 | |
24 | | length (x::xs) = 1 + length xs | |
25 | fun app f [] = () | |
26 | | app f (x::xs) = (f x; app f xs) | |
27 | ||
28 | ||
29 | (* Quicksort -- Paulson p. 98 and answer to exercise 3.29 *) | |
30 | (* Optimised for the Kit with Regions *) | |
31 | ||
32 | (* NOTE: | |
33 | * This is the most space efficient version of quicksort with the current | |
34 | * storage mode analysis (implemented in 25q); copyList() will be called "sat" | |
35 | * inside partition() and the `innermost' recursive call to quickSort'() will | |
36 | * be "atbot" for the regions holding right'. Unfortunately, calling | |
37 | * copyList() after (the `innermost' recursive call to) quickSort'() means | |
38 | * that we keep the regions holding the `original list' live during the | |
39 | * call to quickSort'(). This should not be necessary, since a::bs will be | |
40 | * copied (i.e. partitioned) into to left and right parts, but rules 28 and 26 | |
41 | * in the region analysis are a bit too conservative in this case... | |
42 | *) | |
43 | ||
44 | fun say(s) = print s | |
45 | ||
46 | type elem = int | |
47 | ||
48 | fun copyList [] = [] | |
49 | | copyList (x::xr) = x::(copyList xr) | |
50 | ||
51 | fun quickSort' (arg as ([], sorted)) = arg | |
52 | | quickSort' ([a], sorted) = ([], a::sorted) | |
53 | | quickSort' (a::bs, sorted) = (* "a" is the pivot *) | |
54 | let | |
55 | fun partition (arg as (_, _, []: elem list)) = arg | |
56 | | partition (left, right, x::xr) = | |
57 | if x<=a then partition(x::left, right, xr) | |
58 | else partition(left, x::right, xr) | |
59 | val arg' = | |
60 | let val (left', right) = | |
61 | let val (left, right, _) = partition([], [], bs) | |
62 | in (*forceResetting bs; *) | |
63 | (copyList left, right) | |
64 | end | |
65 | val sorted' = #2 (quickSort'(right, sorted)) | |
66 | in | |
67 | (left', a::sorted') | |
68 | end | |
69 | in | |
70 | quickSort' arg' | |
71 | end | |
72 | fun quickSort l = #2 (quickSort'(l, [])) | |
73 | ||
74 | ||
75 | (* Generating random numbers. Paulson, page 96 *) | |
76 | ||
77 | val min = 1 | |
78 | val max = 100000 | |
79 | val a = 16807.0 | |
80 | val m = 2147483647.0 | |
81 | val w = real(max - min)/m | |
82 | fun seed0() = 117.0 | |
83 | ||
84 | fun nextRand seed = | |
85 | let val t = a*seed | |
86 | in | |
87 | t - m*real(floor(t/m)) | |
88 | end | |
89 | ||
90 | fun randomList' (arg as (0, _, res)) = arg | |
91 | | randomList' (i, seed, res) = | |
92 | let val res' = min+floor(seed*w) :: res | |
93 | (* NOTE: It is significant to use seed for | |
94 | * calculating res' before calling nextRand()... | |
95 | *) | |
96 | in | |
97 | randomList'(i-1, nextRand seed, res') | |
98 | end | |
99 | fun randomList n = #3 (randomList'(n, seed0(), [])) | |
100 | ||
101 | ||
102 | (* Building input list, sorting it and testing the result *) | |
103 | ||
104 | fun isSorted [] = true | |
105 | | isSorted [x: elem] = true | |
106 | | isSorted (x::(xr as (y::yr))) = (x <= y) andalso (isSorted xr) | |
107 | ||
108 | in | |
109 | if isSorted (quickSort(randomList 100000)) then say("Ok!\n") | |
110 | else say("Oops...\n") | |
111 | end |