regression/kittmergesort.sml

   1 (*kittmergesort.sml*)
   2
   3 (* This is tmergesort taken from Paulson's book , page 99 *)
   4
   5 (* The merge function has been modified slightly, to
   6    traverse and rebuild both arguments fully, even when
   7    the one argument is empty. This ensures that both
   8    recursive calls of tmergesort in itself can put their
   9    results in regions local to the body of tmergesort.
  10
  11    One can show that the maximum number of live list elements
  12    is 3n, where n is the number of elements to be sorted.
  13    For n=50000 this should give an approximate memory usage of
  14    3 * 50.000 list elements * 5 words/list element * 4 bytes/word=
  15    3Mb. The actual memory usage (run24d) is 4.5Mb. The remaining
  16    1.5Mb is probably largely due to the fact that merge puts
  17    stuff on the stack (as it is not tail recursive).
  18
  19 *)
  20
  21 exception Take and Drop
  22
  23 fun take(0, _ ) = []
  24   | take(n, x::xs) = x::take(n-1, xs)
  25   | take(n, []) = raise Take
  26
  27 fun drop(0, l) = l
  28   | drop(n, x::xs) = drop(n-1, xs)
  29   | drop(n, []) = raise Drop
  30
  31 fun digit n = chr(ord #"0" + n)
  32
  33 fun digits(n,acc) =
  34       if n >=0 andalso n<=9 then digit n:: acc
  35       else digits (n div 10, digit(n mod 10) :: acc)
  36 fun int_to_string(n) = implode(digits(n,[#"\n"]))
  37
  38 fun snd(x,y) = y
  39
  40 val a = 167
  41 val m = 2147
  42 fun nextrand(seed) =
  43    let val t = a*seed
  44    in t - (m*(t div m))
  45    end
  46
  47 fun randlist(n,seed,tail)=
  48     if n=0 then (seed,tail)
  49     else randlist(n-1, nextrand seed, seed::tail)
  50
  51
  52 fun length [] = 0
  53   | length (_::xs) = 1+length xs
  54
  55 fun merge([], ys) = (ys:int list)@[]
  56   | merge(xs, []) = xs @[]
  57   | merge(l as x::xs, r as y:: ys) =
  58       if x<= y then x::merge(xs, r)
  59       else y:: merge(l, ys)
  60
  61 fun tmergesort [] = []
  62   | tmergesort [x] = [x]
  63   | tmergesort xs =
  64       let val k = length xs div 2
  65       in merge(tmergesort(take(k, xs)),
  66                tmergesort(drop(k, xs)))
  67       end
  68
  69
  70 val result =
  71 let
  72   val n = 50000
  73   val xs = snd(randlist(n,1,[]))
  74   val _ = print "\n List generated\n"
  75   fun report msg = print(msg^"\n")
  76 in
  77   report "Doing tmergesort...";
  78   tmergesort xs;
  79   report("Sorted " ^ int_to_string n ^ " numbers\n")
  80 end
  81