#load "camlp4o.cma";;
#load "listcompr.cmo";;

(* 1 *)
let rec map_aux f xs ys = 
  match xs with
  | [] -> ys
  | x :: xs -> map_aux f xs (f x :: ys);;

let map f xs = List.rev (map_aux f xs []);;

assert ([2;3;4] = map (fun x -> x + 1) [1;2;3]);;

(* 2(a) *)
let rec ordered = function
  | [] | [_] -> true
  | x1 :: x2 :: xs -> x1 <= x2 && ordered (x2 :: xs);;

(* 2(b) *)
let rec prefix = function
  | [] -> [[]]
  | x :: xs -> [] :: List.map (fun ys -> x :: ys) (prefix xs)

let rec suffix = function
  | [] -> [[]]
  | _ :: xs as l -> l :: suffix xs

let interleave x ys =
  List.map2 (fun ls rs -> ls @ [x] @ rs) (prefix ys) (suffix ys)

let rec permutation = function
  | [] -> [[]]
  | x :: xs ->
      List.concat 
	(List.map (fun ys -> interleave x ys) (permutation xs))

let slowsort l = List.find ordered (permutation l);;

assert ([1;2;3] = slowsort [3;1;2]);;


(* 3(a) *)
let inter xs ys = [ x | x <- xs when List.mem x ys ];;

(* 3(b) *)
let union xs ys = xs @ [ y | y <- ys when not (List.mem y xs) ];;

(* 3(c) *)
let subset xs ys = List.for_all (fun x -> List.mem x ys) xs;;

let equal xs ys = subset xs ys && subset ys xs;;

(* 3(d) *)
let rec powerset = function
  | [] -> [[]]
  | x :: xs -> 
      let yss = powerset xs in
      yss @ List.map (fun ys -> x :: ys) yss

assert ([[]; [3];

(* 4(a) *)
let succ g x = List.assoc x g;;

(* 4(b) *)
let rec fixpoint f xs =
  let ys = f xs in
  if equal xs ys then xs else fixpoint f ys;;

let reachable_from g x = 
  let f ys = union ys [ z | y <- ys; z <- succ g y ] in
  fixpoint f [x];;

let g1 = [1,[1;3]; 2,[3]; 3,[4]; 4,[5;6]; 5,[]; 6,[]];;
assert (equal [3;4;5;6] (reachable_from g1 3));;

(* 4(c) *)
let pred g x = [ src | (src, dsts) <- g when List.mem x dsts ];;

assert (equal [1;2] (pred g1 3));;

(* 4(d) *)
let reachable_to g x =
  let f ys = union ys [ z | y <- ys; z <- pred g y ] in
  fixpoint f [x];;

assert (equal [1; 2; 3] (reachable_to g1 3));;

(* 4(e) *)
let transitive_closure g =
  [ (src, [ y | x <- succ g src; y <- reachable_from g x ]) 
  | (src, _) <- g ];;

(* 5 *)
let rec segments xs =
  [ zs | ys <- suffix xs; zs <- prefix ys when zs <> [] ];;

assert (equal [[1]; [1;2]; [1;2;3]; [2]; [2;3]; [3]]
              (segments [1;2;3]));;