regression/kitqsort.sml

   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