(**** Matrix addition ****)

(* cadd = fn : (real * real) * (real * real) -> real * real *)
fun cadd ((x0,y0),(x1,y1)) = (x0+x1,y0+y1):(real*real);

(* madd = fn: (real * real) list list * (real * real) list list
 *             -> (real * real) list list *)
fun madd (A,B) = ListPair.map (fn (rA,rB) => ListPair.map cadd (rA,rB)) (A,B);
			      

(**** Scalar multiplication ****)

(* cmult = fn : real * real -> real * real -> real * real *)
fun cmult (x0,y0) (x1,y1) = (x0*x1-y0*y1,x0*y1+x1*y0):(real*real);

(* smult = fn: real * real -> (real * real) list list 
 *                                -> (real * real) list list *)
fun smult c A = map (fn row => map (cmult c) row) A;



(**** Matrix trace ****)

(* trace = fn : (real * real) list list -> real * real *)
fun trace A = 
    let 
	fun tailtrace ([], t) = t
	  | tailtrace (A, t)  = tailtrace (map tl (tl A), cadd (hd (hd A), t))
    in
	tailtrace (A, (0.0,0.0))
    end


(**** Conjugate transpose ****)

(* conj = fn : real * real -> real * real *)
fun conj (x,y) = (x,~y):(real*real);

(* trans = fn : (real * real) list list -> (real * real) list list *)
fun trans [] = []
  | trans ([]::_) = []
  | trans A  = (map conj (map hd A))::trans (map tl A);


(**** Matrix multiplication ****)

(* vmult = fn : (real * real) list * (real * real) list -> real * real *)
fun vmult (A,B) = 
    let
	fun multc ((x0,y0),(x1,y1)) = (x0*x1-y0*y1,x0*y1+x1*y0)
    in
	foldr cadd (0.0,0.0) (ListPair.map multc (A,B))
    end


(* mmult = fn : (real * real) list list * (real * real) list list
 *            -> (real * real) list list *)
fun mmult (A,B) = 
    let 
	fun transpose [] = []
	  | transpose ([]::_) = []
	  | transpose M  = (map hd M)::transpose (map tl M)
	val trB = transpose B
    in
	foldr (fn (curr,prev)=>
                  (foldr (fn (r,acc)=>vmult(curr,r)::acc) [] trB)::prev) [] A
    end

(******* Weather prediction *******)

fun start () = ref (fn () => true); 
 
fun forecast fcn = 
    let
	fun flip fcn = fn () => not (fcn ())
    in
	(fcn := flip (!fcn);!fcn ())
    end


(********** Question 3 *************************)

datatype nonterm = S | N | Det | Adj | V | NP | VP | NBar;
type term = string;
datatype chartedge = edge of int * nonterm * int;
datatype cnfrule = binary of nonterm * nonterm * nonterm
		 | unary of nonterm * term;

fun append(l1)(l2) = l1@l2;
fun reduce(f,[],z) = z
  | reduce(f,x::xs,z) = f(x)(reduce(f,xs,z));

fun member(x,y::l) = if (x=y) then true else member(x,l)
  | member(x,[]) = false;

fun seek_catr(cat,r,[]) = []
  | seek_catr(cat,r,edge(left,category,right)::edges) = 
    if (r=right) andalso (cat=category)
    then left::seek_catr(cat,r,edges)
    else seek_catr(cat,r,edges);

fun seek_lex(w,[]) = []
  | seek_lex(w,binary(_,_,_)::rules) = seek_lex(w,rules)
  | seek_lex(w,unary(cat,x)::rules) = if (w=x) then cat::seek_lex(w,rules) 
				      else seek_lex(w,rules);

fun close_edge(e,chart,cnfgrammar) =
    let fun close_edge(e,chart,cnfgrammar,[]) = [e]
	  | close_edge(e,chart,cnfgrammar,unary(_,_)::cnfrules) = 
  	      close_edge(e,chart,cnfgrammar,cnfrules)
	  | close_edge(e as edge(m,cat,r),chart,cnfgrammar,
		       binary(mother,left,right)::cnfrules) =
	      if (cat=right) then 
		  close_edges(map(fn l => edge(l,mother,r))(seek_catr(left,m,chart)),
			      chart,cnfgrammar,close_edge(e,chart,cnfgrammar,cnfrules))
	      else close_edge(e,chart,cnfgrammar,cnfrules)
    in close_edge(e,chart,cnfgrammar,cnfgrammar)
    end
and close_edges(edges,chart,cnfgrammar,rest) =
    reduce(append,map(fn e => close_edge(e,chart,cnfgrammar))(edges),rest);

fun build_chart([],i,cnfgrammar,chart) = chart
  | build_chart(w::ws,i,cnfgrammar,chart) =
      build_chart(ws,i+1,cnfgrammar,
		  close_edges(map(fn c => edge(i,c,i+1))(seek_lex(w,cnfgrammar)),
			      chart,cnfgrammar,chart));

fun recognize(input,cnfgrammar) = 
    member(0,seek_catr(S,length(input),build_chart(input,0,cnfgrammar,[])));

(*
val g = [unary(NP,"Felix"),unary(VP,"walks"),unary(V,"sees"),unary(NP,"Fido"),
	 unary(N,"dog"),unary(Adj,"happy"),unary(Det,"the"),
	 binary(S,NP,VP),binary(VP,V,NP),binary(NP,Det,NBar),binary(NBar,Adj,N)];

val chart = [edge(0,Det,1),edge(1,Adj,2)];
val chart = [edge(1,Adj,2),edge(0,Det,1)];

val edges = [edge(2,N,3)];

close_edges(edges,chart,g,[]);

recognize(["Felix","walks"],g);
recognize(["walks","Felix"],g);
recognize(["Felix","sees"],g);
recognize(["Felix","sees","Fido"],g);
recognize(["Felix","Fido","sees"],g);
recognize(["sees","Felix","Fido"],g);
recognize(["Felix","sees","the","happy","dog"],g);
recognize(["the","happy","dog","sees","Felix"],g);
*)