(* functions.ML *) (* Last modified on Tue Feb 14 10:55:14 1995 by Andy Gordon *) fun u() = use "functions.ML"; (*shortcut*) (* ==================================================================== *) (* List functional map. *) (* ==================================================================== *) fun map f [] = [] | map f (x::xs) = (f x) :: map f xs; fun hd (x::_) = x; fun tl (_::xs) = xs; (* ==================================================================== *) (* Matrix processing. *) (* ==================================================================== *) (*transpose a matrix (list of lists)*) fun transpose ([]::_) = [] | transpose rows = (map hd rows) :: transpose (map tl rows) (*dot product*) fun dotprod [] [] = 0.0 | dotprod (x::xs) (y::ys) = x*y + dotprod xs ys; (*matrix product*) fun matprod (Arows, Brows) = let val Bcols = transpose Brows in map (fn Arow => map (dotprod Arow) Bcols) Arows end; val I2 = [[1.0, 0.0], [0.0, 1.0]]; val J = [[0.0, 1.0], [1.0, 0.0]]; val A = [[1.0, 2.0], [3.0, 4.0]]; matprod (A,I2); matprod (I2,A); matprod (A,J); matprod (J,A); (* ==================================================================== *) (* Fold functionals on lists. *) (* Only foldl uses constant space. *) (* *) (* foldl ** (e, [x1,x2,...,xn]) = (...((e ** x1) ** x2)...) ** xn *) (* foldr ** ([x1,x2,...,xn], e) = x1 ** (x2 **...(xn ** e)...) *) (* ==================================================================== *) fun foldl f (e, []) = e | foldl f (e, x::xs) = foldl f (f(e,x), xs); fun foldr f ([], e) = e | foldr f (x::xs, e) = f(x, foldr f (xs,e)); fun sum xs = foldl op+ (0.0,xs); fun sum_of_sums xss = foldl (foldl op+) (0.0,xss); fun rev xs = foldl (fn(e,x)=>x::e) ([],xs); fun append (xs,ys) = foldr op:: (xs,ys); fun length xs = foldl (fn(e,x)=>e+1) (0,xs); fun map f xs = foldr (fn(x,e)=> f x :: e) (xs,[]); (* ==================================================================== *) (* List functionals for predicates. *) (* ==================================================================== *) fun exists p [] = false | exists p (x::xs) = (p x) orelse exists p xs; fun filter p [] = [] | filter p (x::xs) = if p x then x :: filter p xs else filter p xs; fun member (y,xs) = exists (fn x => x=y) xs; fun inter (xs,ys) = filter (fn x => member(x,ys)) xs; (* ==================================================================== *) (* Lazy lists in ML. *) (* ==================================================================== *) datatype 'a seq = Nil | Cons of 'a * (unit -> 'a seq); fun from k = Cons(k, fn()=> from(k+1)); fun takeq(0,xq) = [] | takeq(n,Nil) = [] | takeq(n,Cons(x,xf)) = x :: takeq(n-1,xf()); val xs = takeq(2, from 6); (* ==================================================================== *) (* Joining two sequences. *) (* ==================================================================== *) fun appendq (Nil, yq) = yq | appendq (Cons(x,xf), yq) = Cons(x, fn()=> appendq(xf(),yq)); fun interleave (Nil, yq) = yq | interleave (Cons(x,xf), yq) = Cons(x, fn()=> interleave(yq, xf())); (* ==================================================================== *) (* Filtering, iterating, mapping. *) (* ==================================================================== *) fun filterq p Nil = Nil | filterq p (Cons(x,xf)) = if p x then Cons(x, fn()=> filterq p (xf())) else filterq p (xf()); fun iterates f x = Cons(x, fn()=> iterates f (f x)); fun mapq f Nil = Nil | mapq f (Cons(x,xf)) = Cons(f x, fn()=> mapq f (xf())); (* ==================================================================== *) (* Numerical computations. *) (* ==================================================================== *) fun next a x = (a/x + x) / 2.0; fun within (eps:real) (Cons(x,xf)) = let val Cons(y,yf) = xf() in if abs(x-y) <= eps then y else within eps (Cons(y,yf)) end; (*square roots*) fun root eps a = within eps (iterates (next a) 1.0); root 0.01 2.0; root 0.001 2.0; root 1E~6 2.0; (* ==================================================================== *) (* Searching infinite trees. *) (* Tree is represented by a function *) (* next: 'node -> 'node list *) (* where 'node is a type variable representing the nodes of the tree. *) (* ==================================================================== *) (*depth first search*) fun depth next x = let fun dfs [] = Nil | dfs (y::ys) = Cons(y, fn()=> dfs(next y @ ys)) in dfs [x] end; (*breadth first search*) fun nbreadth next x = let fun bfs [] = Nil | bfs (y::ys) = Cons (y, fn()=> bfs(ys @ next y)) in bfs [x] end; (* ==================================================================== *) (* Example: palindromes. *) (* ==================================================================== *) fun nextl l = ["A"::l, "B"::l, "C"::l]; fun is_pal l = (l = rev l); val strip_spaces = filter (fn c => c<>" ") o explode; is_pal (strip_spaces "satan oscillate my metallic sonatas"); filterq is_pal (depth nextl []); (*depth-first: boring palindromes*) filterq is_pal (nbreadth nextl []); (*breadth-first: more interesting*) map implode (takeq(20, it));