open List;;
open Graphics;;
open Lambda;;
let pi = 3.1415926;;
let (offx, offy) = (300, 300);;
let paral_term = App (App (i, i), App (i, i));;
let paral_term2 = App (w, App (App (i, i), Var "a"));;
let print_list = iter (fun x -> print_string (x ^ "\n"));;
let string_of_point p = match p with
[x; y] -> "( " ^ (string_of_float x) ^ ", " ^ (string_of_float y) ^ " )"
|_ -> failwith "point error";;
let string_of_lambda_lambda (a, b) = "( " ^ (string_of_lambda a) ^ ", " ^ (string_of_lambda b) ^ " )";;
let myiter f l =
let rec mi n s =
match s with
[] -> ()
|l1::ls -> f n l1; mi (n + 1) ls in
mi 0 l;;
let mymap f l =
let rec mm n s =
match s with
[] -> []
|l1::ls -> (f n l1)::(mm (n + 1) ls) in
mm 0 l;;
let unsplit l = match split l with (x, y) -> union (unique x) (unique y);;
let getnum a l =
let rec gn n s =
match s with
l1::ls when l1 = a -> n
|l1::ls -> gn (n + 1) ls
|[] -> failwith "Element not found"
in gn 0 l;;
let gen_graph term =
let rec deep t =
let z = all_reductions t in
match z with
[] -> []
|_ -> (map ( fun x -> (t, x) ) z) @ (wide (exclude t z))
and wide l =
match l with
[] -> []
|l1::ls -> (deep l1) @ (wide ls)
in deep term;;
let output redex =
print_string ("\n\nOriginal:\n" ^ (string_of_lambda redex) ^ "\n\nProcessed:\n");
print_list (map (string_of_lambda) (all_reductions redex));;
let turn_point =
let scalar a b =
fold_left (+.) (0.) (map2 ( *. ) a b) in
let mul_vm m v =
map (scalar v) m in
let rotate_point x =
mul_vm [[cos x; -.(sin x)];[sin x; cos x]] in rotate_point;;
let gen_points n =
let angle = 2. *. pi /. (float_of_int n) in
let rec gp pp m =
if m > 0 then let z = turn_point angle pp in z::(gp z (m - 1)) else [] in
rev (gp [0.; 300.] n);;
let mto p = match p with
[x; y] -> moveto ((int_of_float x) + offx) ((int_of_float y) + offy)
|_ -> failwith "point error";;
let lto p = match p with
[x; y] -> lineto ((int_of_float x) + offx) ((int_of_float y) + offy)
|_ -> failwith "point error";;
let draw_text text p = match p with
[x; y] -> moveto ((int_of_float x) + offx) ((int_of_float y) + offy); draw_string text
|_ -> failwith "point error";;
let draw_graph redex =
let z = gen_graph redex in
let s = unsplit z in
let pts = gen_points (length s) in
let assocs = mymap (fun n x -> (x, nth pts n)) s in
iter (fun (x, y) -> mto y; draw_string (string_of_lambda x)) assocs;
iter (fun (x, y) -> mto (assoc x assocs); lto (assoc y assocs)) z;;
print_list (map string_of_lambda_lambda (gen_graph (paral_term2)));;
flush stdout;;
open_graph "";;
draw_graph (paral_term2);;
read_key ();;
close_graph ();;