(* 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));