(* lists.ML *) (* Code from ADG's lectures on "Introduction to Functional Programming" *) (* Based on code by LCP's "ML for the Working Programmer" *) (* Last modified on Thu Jan 26 17:47:57 1995 by Andy Gordon *) (* ==================================================================== *) (* Lecture I: Introduction and Motivation. *) (* ==================================================================== *) fun power (x,k) : real = if k=1 then x else if k mod 2 = 0 then power(x*x, k div 2) else x*power(x*x, k div 2); (* ==================================================================== *) (* Lecture II: Basic Types and Values in ML. *) (* ==================================================================== *) fun fst(x,y) = x; fun snd(x,y) = y; (* ==================================================================== *) (* Lecture III: Basic List Processing. *) (* ==================================================================== *) fun null [] = true | null _ = false; fun hd (x::xs) = x; fun tl (x::xs) = xs; fun take (k, []) = [] | take (k, x::xs) = if k>0 then x::take(k-1,xs) else []; fun drop (k, []) = [] | drop (k, x::xs) = if k>0 then drop(k-1,xs) else x::xs; fun combine ([], []) = [] | combine (x::xs, y::ys) = (x,y) :: combine (xs,ys); fun split [] = ([],[]) | split ((x,y)::pairs) = let val (xs,ys) = split pairs in (x::xs, y::ys) end; fun nlength [] = 0 | nlength (x::xs) = 1 + nlength xs; fun addlen (n,[]) = n | addlen (n,x::xs) = addlen (n+1,xs); fun length xs = addlen(0,xs); (*membership in a list*) infix mem; fun x mem [] = false | x mem (y::l) = (x=y) orelse (x mem l); (*intersection of two sets represented as lists*) fun inter([],ys) = [] | inter(x::xs, ys) = if x mem ys then x::inter(xs, ys) else inter(xs, ys); (*union of two sets represented as lists*) fun union([],ys) = ys | union(x::xs, ys) = union(xs, if x mem ys then ys else x::ys); (* ==================================================================== *) (* Lecture IV: Sorting Case Study. *) (* ==================================================================== *) (* -------------------------------------------------------------------- *) (* Random numbers; Park and Miller, CACM 1988. *) (* -------------------------------------------------------------------- *) local val a = 16807.0 and m = 2147483647.0 in fun nextrand seed = let val t = a*seed in t - m * real(floor(t/m)) end fun truncto k r = 1 + floor((r / m) * (real k)) end; fun randlist (n,seed,tail) = if n=0 then (seed,tail) else randlist(n-1, nextrand seed, seed::tail); val (seed,rs) = randlist(300,1.0,[]); (*Times on a Sun SPARCstation 5 for sorting 30,000 integers.*) (*insort rs; 2440s *) (*quick rs; 8.4s *) (*quik(rs,[]); 6.8s *) (*tmergesort rs; 6.0s *) (*sorting(rs,[],0); 5.4s *) (*samsort rs; 5.9s *) (* -------------------------------------------------------------------- *) (* Insertion sort. *) (* -------------------------------------------------------------------- *) fun ins (x:real, []) = [x] | ins (x:real, y::ys) = if x<=y then x::y::ys else y::ins(x,ys); fun insort [] = [] | insort (x::xs) = ins(x, insort xs); (* -------------------------------------------------------------------- *) (* Quick sort. *) (* -------------------------------------------------------------------- *) fun quick [] = [] | quick [x] = [x] | quick (a::bs) = let fun part (l,r,[]): real list = (quick l) @ (a :: quick r) | part (l,r,x::xs) = if x<=a then part(x::l, r, xs) else part(l, x::r, xs) in part([],[],bs) end; fun quik([], sorted) = sorted | quik([x], sorted) = x::sorted | quik(a::bs, sorted) = let fun part (l,r,[]): real list = quik (l, a::quik(r,sorted)) | part (l,r,x::xs) = if x<=a then part(x::l, r, xs) else part(l, x::r, xs) in part([],[],bs) end; (* -------------------------------------------------------------------- *) (* Top-down Merge sort. *) (* -------------------------------------------------------------------- *) fun merge([],ys) = ys : real list | merge(xs,[]) = xs | merge(x::xs,y::ys) = if x<=y then x::merge(xs, y::ys) else y::merge(x::xs, ys); fun tmergesort [] = [] | tmergesort [x] = [x] | tmergesort xs = let val k = length xs div 2 in merge (tmergesort (take (k, xs)), tmergesort (drop (k, xs))) end; (* -------------------------------------------------------------------- *) (* O'Keefe's Bottom-up merge sort. *) (* *) (* Here's how it works on a 16 element input list [A,B,C,...,O,P]. *) (* The main function accumulates a list of lists lss, together with *) (* a number k, whose binary representation corresponds to the "shape" *) (* of lss. For each element x of the input list, the main function *) (* calls mergepairs ([x]::lss, k+1), which performs a number of list *) (* merges, of equal length lists, according to k+1. The table shows the *) (* sequence of calls to mergepairs, in each row showing k+1, then the *) (* number of merges performed, the argument [x]::lss, and the result, *) (* if different from the argument. *) (* *) (* 1 0 [A] *) (* 10 1 [B,A] [AB] *) (* 11 0 [C,AB] *) (* 100 2 [D,C,AB] [ABCD] *) (* 101 0 [E,ABCD] *) (* 110 1 [F,E,ABCD] [EF,ABCD] *) (* 111 0 [G,EF,ABCD] *) (* 1000 3 [H,G,EF,ABCD] [ABCDEFGH] *) (* 1001 0 [I,ABCDEFGH] *) (* 1010 1 [J,I,ABCDEFGH] [IJ,ABCDEFGH] *) (* 1011 0 [K,IJ,ABCDEFGH] *) (* 1100 2 [L,K,IJ,ABCDEFGH] [IJKL,ABCDEFGH] *) (* 1101 0 [M,IJKL,ABCDEFGH] *) (* 1110 1 [N,M,IJKL,ABCDEFGH] [MN,IJKL,ABCDEFGH] *) (* 1111 0 [O,MN,IJKL,ABCDEFGH] *) (* 10000 4 [P,O,MN,IJKL,ABCDEFGH] [ABCDEFGHIJKLMNOP] *) (* *) (* This method avoids building the 16 singletons at once. Parameter k *) (* ensures "even" merging; otherwise merge degenerates to insert. *) (* -------------------------------------------------------------------- *) fun hd (x::xs) = x; (* First argument is a list of sorted lists, second is its shape. *) fun mergepairs ([l], k) = [l] | mergepairs (ls1::ls2::lss, k) = if k mod 2 = 1 then ls1::ls2::lss (*odd ; do nothing*) else mergepairs(merge(ls1,ls2)::lss, k div 2); (*even*) fun sorting([], lss, k) = hd(mergepairs(lss,0)) | sorting(x::xs, lss, k) = sorting(xs, mergepairs([x]::lss, k+1), k+1); (* -------------------------------------------------------------------- *) (* O'Keefe's smooth merge sort. *) (* *) (* A sort algorithm is *smooth* if it has linear execution time when *) (* its input is nearly sorted, otherwise n log n. *) (* It is an adaptation of the bottom-up merge sort above, except that *) (* the atoms (i.e., A,B,C,...) of the final sorted list are the *) (* ascending runs in the input, rather than singletons from the input. *) (* -------------------------------------------------------------------- *) fun nextrun (run, []) = (rev run, []:real list) | nextrun (run, x::xs) = if x < hd run then (rev run, x::xs) else nextrun(x::run, xs); fun samsorting([], ls, k) = hd(mergepairs(ls,0)) | samsorting(x::xs, ls, k) = let val (run,tail) = nextrun([x],xs) in samsorting(tail, mergepairs(run::ls,k+1), k+1) end; fun samsort [] = [] | samsort xs = samsorting(xs, [], 0);