let set = [|1; 2; 3; 4; 5;6|];; let relation = [(1,2); (1,3); (2,3); (4,6); (2,4); (3,4);(1,5);(5,2)];; let all_assocs l a = let rec aa l acc = match l with (x, y)::ls when x = a -> aa ls (y::acc) |_::ls -> aa ls acc |[] -> acc in aa l [];; let rec qsort l = match l with l1::ls -> (List.filter (fun x -> x < l1) ls) @ [l1] @ (List.filter (fun x -> x > l1) ls) |[] -> [];; let comparable a b rel = let rec find prev = let cur = qsort (List.flatten (List.map (all_assocs rel) prev)) in if prev = cur then false else if List.mem b cur then true else find cur in find [a];; let closure rel = let res = ref [] in for i = 0 to Array.length set - 1 do for j = 0 to Array.length set - 1 do if comparable set.(i) set.(j) rel then res := (set.(i), set.(j))::!res; done; done; List.rev !res;; let cycle start cond step func = let rec cycle cur = if cond cur then (func cur; cycle (step cur)) in cycle start;; let linear rel = let res = ref true in for i = 0 to Array.length set - 1 do for j = i + 1 to Array.length set - 1 do res := !res && ((comparable set.(i) set.(j) rel) || (comparable set.(j) set.(i) rel)) done; done; !res;; List.iter (fun (x, y) -> Printf.printf "(%d, %d) " x y) (closure relation);; Printf.printf "\n%s %s" (string_of_bool (linear relation)) (string_of_bool (linear (closure relation)));;