PrettyPrinting/graphs.ml

1511 lines
56 KiB
OCaml

open Graphics ;;
(* SOMMAIRE
- misc functions : 20
- main function : 68
- type 2 printing: 122
- DFS : 373
- BFS : 630
- Dijkstra :
*)
Random.self_init () ;;
let pi = 3.14159265358979343 ;;
let rec ln10 n = match n with
| k when k < 0 -> failwith "Are you sure about that ?"
| k when k < 10 -> 0
| k -> 1 + ln10 (k/10) ;;
let delta i j =
if i = j then 1 else 0 ;;
let draw_integer x0 y n0 r =
(* 7-seg display *)
let n = ref n0 in
let size = ln10 n0 in
let len = r/3 in
let offset = size*(len*11/7)/2 in
for i = 0 to size do
let x = x0 + offset - i*(len*11/7) in
if Array.mem (!n mod 10) [|0; 4; 5; 6; 7; 8; 9|] then
draw_poly_line [|(x-len/2, y+len); (x-len/2, y)|];
if Array.mem (!n mod 10) [|0; 2; 3; 5; 6; 7; 8; 9|] then
draw_poly_line [|(x-len/2, y+len); (x+len/2, y+len)|];
if Array.mem (!n mod 10) [|0; 1; 2; 3; 4; 7; 8; 9|] then
draw_poly_line [|(x+len/2, y+len); (x+len/2, y)|];
if Array.mem (!n mod 10) [|2; 3; 4; 5; 6; 8; 9|] then
draw_poly_line [|(x-len/2, y); (x+len/2, y)|];
if Array.mem (!n mod 10) [|0; 1; 3; 4; 5; 6; 7; 8; 9|] then
draw_poly_line [|(x+len/2, y-len); (x+len/2, y)|];
if Array.mem (!n mod 10) [|0; 2; 3; 5; 6; 8; 9|] then
draw_poly_line [|(x-len/2, y-len); (x+len/2, y-len)|];
if Array.mem (!n mod 10) [|0; 2; 6; 8|] then
draw_poly_line [|(x-len/2, y-len); (x-len/2, y)|];
n := !n/10;
done ;;
let identity n = n ;;
let square x = x *. x ;;
let norm_int v1 v2 =
Float.sqrt (square (float_of_int ((fst v2) - (fst v1))) +. square (float_of_int ((snd v2) - -snd v1))) ;;
let improved_pretty_printing g wd ht r =
let n = Array.length g in
let coords = Array.make n (0, 0) in
let colors = Array.make n (rgb 0 0 0) in
for i = 0 to n-1 do
colors.(i) <- rgb ((255 * i) / n) ((255*(i+n/3)) / n) ((255*(2*i+n/3)) / n)
done;
for k = 0 to n-1 do
let theta = 2. *. pi *. (float_of_int k) /. (float_of_int (n)) +. pi /. (float_of_int (n)) in
let i = ref (int_of_float ((float_of_int wd) /. 2.) + int_of_float ((float_of_int wd) /. 2.2 *. cos theta)) in
let j = ref (int_of_float ((float_of_int ht) /. 2.) + int_of_float ((float_of_int ht) /. 2.2 *. sin theta)) in
set_line_width 8 ;
set_color colors.(k) ;
draw_circle !i !j r;
coords.(k) <- (!i, !j)
done ;
set_line_width 4 ;
set_color black ;
for k = 0 to n-1 do
for l = 0 to (Array.length g.(k))-1 do
if g.(k).(l) <> (-1) then begin
draw_poly_line [|coords.(k); coords.(g.(k).(l))|]
end
done
done;
set_line_width 8 ;
for k = 0 to n-1 do
set_color colors.(k) ;
for l = 0 to (Array.length g.(k))-1 do
if g.(k).(l) <> (-1) then begin
let slope = Float.atan2 (float_of_int (snd coords.(g.(k).(l)) - snd coords.(k))) (float_of_int (fst coords.(g.(k).(l)) - fst coords.(k))) in
let nexi = int_of_float (float_of_int (fst coords.(k)) +. (float_of_int r) *. 1.75 *. cos slope) in
let nexj = int_of_float (float_of_int (snd coords.(k)) +. (float_of_int r) *. 1.75 *. sin slope) in
draw_poly_line [|coords.(k); (nexi, nexj)|]
end
done
done;
for k = 0 to n-1 do
set_line_width 10 ;
set_color black ;
fill_circle (fst coords.(k)) (snd coords.(k)) r;
set_color colors.(k) ;
set_line_width 5 ;
draw_integer (fst coords.(k)) (snd coords.(k)) k r
done;
ignore (Scanf.bscanf Scanf.Scanning.stdin "%d\n" identity) ;;
(* Another version *)
type node = {tag : int; edges : int array} ;;
type type2graph = {width : int ; height : int ; g : node array array} ;;
(*
array is length 8 and indicate if there-s a path with the nodes
[| SO ; O ; NO ; N ; NE ; E ; SE ; S |]
*)
let generate_type2_graph w h freq inf sup =
let weighted_d100 i =
let res = Random.int 100 in
if res <= freq then
try
(inf + Random.int (sup-inf))
with
| Invalid_argument _ -> inf
else (-1)
in
let gr = {width = w ; height = h ; g = Array.make w [||]} in
for i = 0 to w-1 do
let init_fct j = {tag = i*h + j; edges = Array.init 8 weighted_d100}
in
gr.g.(i) <- Array.init h init_fct;
done;
gr ;;
let another_type_of_graph_printing (gr : type2graph) r dx dy is_weighted =
let colors = Array.make_matrix gr.width gr.height (rgb 0 0 0) in
for i = 0 to gr.width -1 do
for j = 0 to gr.height -1 do
if (i*gr.width + j) mod 7 = 0 then
colors.(i).(j) <- rgb 0 0 200
else if (i*gr.width + j) mod 7 = 1 then
colors.(i).(j) <- rgb 0 200 0
else if (i*gr.width + j) mod 7 = 2 then
colors.(i).(j) <- rgb 0 200 200
else if (i*gr.width + j) mod 7 = 3 then
colors.(i).(j) <- rgb 200 0 0
else if (i*gr.width + j) mod 7 = 4 then
colors.(i).(j) <- rgb 200 0 200
else if (i*gr.width + j) mod 7 = 5 then
colors.(i).(j) <- rgb 200 200 0
else
colors.(i).(j) <- rgb 200 200 200
done
done;
set_line_width 4;
set_color black ;
for i = 0 to gr.width -1 do
for j = 0 to gr.height -1 do
let node_xy = ((r + (2*r + dx)*i), (r + (2*r + dy)*j)) in
if (i > 0 && j > 0) && gr.g.(i).(j).edges.(0) <> (-1) then begin (* SO *)
draw_poly_line [|node_xy; (r + (2*r + dx)*(i-1)), (r + (2*r + dy)*(j-1))|] ;
end;
if (i > 0) && gr.g.(i).(j).edges.(1) <> (-1) then begin (* O *)
draw_poly_line [|node_xy; (r + (2*r + dx)*(i-1)), (r + (2*r + dy)*j)|] ;
end;
if (i > 0 && j < gr.height -1) && gr.g.(i).(j).edges.(2) <> (-1) then begin (* NO *)
draw_poly_line [|node_xy; (r + (2*r + dx)*(i-1)), (r + (2*r + dy)*(j+1))|] ;
end;
if (j < gr.height -1) && gr.g.(i).(j).edges.(3) <> (-1) then begin (* N *)
draw_poly_line [|node_xy; (r + (2*r + dx)*i), (r + (2*r + dy)*(j+1))|] ;
end;
if (i < gr.width-1 && j < gr.height -1) && gr.g.(i).(j).edges.(4) <> (-1) then begin (* NE *)
draw_poly_line [|node_xy; (r + (2*r + dx)*(i+1)), (r + (2*r + dy)*(j+1))|] ;
end;
if (i < gr.width-1) && gr.g.(i).(j).edges.(5) <> (-1) then begin (* E *)
draw_poly_line [|node_xy; (r + (2*r + dx)*(i+1)), (r + (2*r + dy)*j)|] ;
end;
if (i < gr.width-1 && j > 0) && gr.g.(i).(j).edges.(6) <> (-1) then begin (* SE *)
draw_poly_line [|node_xy; (r + (2*r + dx)*(i+1)), (r + (2*r + dy)*(j-1))|] ;
end;
if (j > 0) && gr.g.(i).(j).edges.(7) <> (-1) then begin (* S *)
draw_poly_line [|node_xy; (r + (2*r + dx)*i), (r + (2*r + dy)*(j-1))|] ;
end;
done
done;
let roff = (9*r)/8 in
let roff2 = (7*r)/5 in
let rsize = (3*r)/4 in
let wcolor = rgb 255 255 255 in
let bcolor = rgb 0 0 0 in
set_line_width 8;
for i = 0 to gr.width -1 do
for j = 0 to gr.height -1 do
let node_xy = ((r + (2*r + dx)*i), (r + (2*r + dy)*j)) in
if (i > 0 && j > 0) && gr.g.(i).(j).edges.(0) <> (-1) then begin (* SO *)
if is_weighted then begin
set_color bcolor;
fill_circle (fst node_xy - roff) (snd node_xy - roff) (3*rsize/4) ;
set_color wcolor;
set_line_width 3;
draw_integer (fst node_xy - roff) (snd node_xy - roff) gr.g.(i).(j).edges.(0) rsize;
end
else begin
set_line_width 8;
set_color colors.(i).(j) ;
draw_poly_line [|node_xy; (2 * (fst node_xy) + r + (2*r + dx)*(i-1))/3, (2 * (snd node_xy) + r + (2*r + dy)*(j-1))/3|] ;
end
end;
if (i > 0) && gr.g.(i).(j).edges.(1) <> (-1) then begin (* O *)
if is_weighted then begin
set_color bcolor;
fill_circle (fst node_xy - roff2) (snd node_xy) (3*rsize/4) ;
set_color wcolor;
set_line_width 3;
draw_integer (fst node_xy - roff2) (snd node_xy) gr.g.(i).(j).edges.(1) rsize;
end
else begin
set_line_width 8;
set_color colors.(i).(j) ;
draw_poly_line [|node_xy; (2 * (fst node_xy) + r + (2*r + dx)*(i-1))/3, (2 * (snd node_xy) + r + (2*r + dy)*j)/3|] ;
end
end;
if (i > 0 && j < gr.height -1) && gr.g.(i).(j).edges.(2) <> (-1) then begin (* NO *)
if is_weighted then begin
set_color bcolor;
fill_circle (fst node_xy - roff) (snd node_xy + roff) (3*rsize/4) ;
set_color wcolor;
set_line_width 3;
draw_integer (fst node_xy - roff) (snd node_xy + roff) gr.g.(i).(j).edges.(2) rsize;
end
else begin
set_line_width 8;
set_color colors.(i).(j) ;
draw_poly_line [|node_xy; (2 * (fst node_xy) + r + (2*r + dx)*(i-1))/3, (2 * (snd node_xy) + r + (2*r + dy)*(j+1))/3|] ;
end
end;
if (j < gr.height -1) && gr.g.(i).(j).edges.(3) <> (-1) then begin (* N *)
if is_weighted then begin
set_color bcolor;
fill_circle (fst node_xy) (snd node_xy + roff2) (3*rsize/4) ;
set_color wcolor;
set_line_width 3;
draw_integer (fst node_xy) (snd node_xy + roff2) gr.g.(i).(j).edges.(3) rsize;
end
else begin
set_line_width 8;
set_color colors.(i).(j) ;
draw_poly_line [|node_xy; (2 * (fst node_xy) + r + (2*r + dx)*i)/3, (2 * (snd node_xy) + r + (2*r + dy)*(j+1))/3|] ;
end
end;
if (i < gr.width-1 && j < gr.height -1) && gr.g.(i).(j).edges.(4) <> (-1) then begin (* NE *)
if is_weighted then begin
set_color bcolor;
fill_circle (fst node_xy + roff) (snd node_xy + roff) (3*rsize/4) ;
set_color wcolor;
set_line_width 3;
draw_integer (fst node_xy + roff) (snd node_xy + roff) gr.g.(i).(j).edges.(4) rsize;
end
else begin
set_line_width 8;
set_color colors.(i).(j) ;
draw_poly_line [|node_xy; (2 * (fst node_xy) + r + (2*r + dx)*(i+1))/3, (2 * (snd node_xy) + r + (2*r + dy)*(j+1))/3|] ;
end
end;
if (i < gr.width-1) && gr.g.(i).(j).edges.(5) <> (-1) then begin (* E *)
if is_weighted then begin
set_color bcolor;
fill_circle (fst node_xy + roff2) (snd node_xy) (3*rsize/4) ;
set_color wcolor;
set_line_width 3;
draw_integer (fst node_xy + roff2) (snd node_xy) gr.g.(i).(j).edges.(5) rsize;
end
else begin
set_line_width 8;
set_color colors.(i).(j) ;
draw_poly_line [|node_xy; (2 * (fst node_xy) + r + (2*r + dx)*(i+1))/3, (2 * (snd node_xy) + r + (2*r + dy)*j)/3|] ;
end
end;
if (i < gr.width-1 && j > 0) && gr.g.(i).(j).edges.(6) <> (-1) then begin (* SE *)
if is_weighted then begin
set_color bcolor;
fill_circle (fst node_xy + roff) (snd node_xy - roff) (3*rsize/4) ;
set_color wcolor;
set_line_width 3;
draw_integer (fst node_xy + roff) (snd node_xy - roff) gr.g.(i).(j).edges.(6) rsize;
end
else begin
set_line_width 8;
set_color colors.(i).(j) ;
draw_poly_line [|node_xy; (2 * (fst node_xy) + r + (2*r + dx)*(i+1))/3, (2 * (snd node_xy) + r + (2*r + dy)*(j-1))/3|] ;
end
end;
if (j > 0) && gr.g.(i).(j).edges.(7) <> (-1) then begin (* S *)
if is_weighted then begin
set_color bcolor;
fill_circle (fst node_xy) (snd node_xy - roff2) (3*rsize/4) ;
set_color wcolor;
set_line_width 3;
draw_integer (fst node_xy) (snd node_xy - roff2) gr.g.(i).(j).edges.(7) rsize;
end
else begin
set_line_width 8;
set_color colors.(i).(j) ;
draw_poly_line [|node_xy; (2 * (fst node_xy) + r + (2*r + dx)*i)/3, (2 * (snd node_xy) + r + (2*r + dy)*(j-1))/3|] ;
end
end;
done
done;
set_line_width 5;
for i = 0 to gr.width -1 do
for j = 0 to gr.height -1 do
set_color (rgb 48 48 48) ;
fill_circle (r + (2*r + dx)*i) (r + (2*r + dy)*j) r ;
set_color black ;
draw_circle (r + (2*r + dx)*i) (r + (2*r + dy)*j) r ;
set_color colors.(i).(j) ;
draw_integer (r + (2*r + dx)*i) (r + (2*r + dy)*j) gr.g.(i).(j).tag r
done
done ;
ignore (Scanf.bscanf Scanf.Scanning.stdin "%d\n" identity) ;;
(* ------------------------------------------------------------*)
(* ------------------------------------------------------------*)
(* ------------------------------------------------------------*)
let another_type_of_dfs (gr : type2graph) r dx dy dt =
let colors = Array.make_matrix gr.width gr.height (rgb 0 0 0) in
for i = 0 to gr.width -1 do
for j = 0 to gr.height -1 do
if (i*gr.width + j) mod 6 = 0 then
colors.(i).(j) <- rgb 0 0 200
else if (i*gr.width + j) mod 6 = 1 then
colors.(i).(j) <- rgb 0 200 0
else if (i*gr.width + j) mod 6 = 2 then
colors.(i).(j) <- rgb 0 200 200
else if (i*gr.width + j) mod 6 = 3 then
colors.(i).(j) <- rgb 200 0 0
else if (i*gr.width + j) mod 6 = 4 then
colors.(i).(j) <- rgb 200 0 200
else
colors.(i).(j) <- rgb 200 200 0
done
done;
set_line_width 4;
set_color (rgb 192 192 192) ;
for i = 0 to gr.width -1 do
for j = 0 to gr.height -1 do
let node_xy = ((r + (2*r + dx)*i), (r + (2*r + dy)*j)) in
if (i > 0 && j > 0) && gr.g.(i).(j).edges.(0) <> (-1) then begin (* SO *)
draw_poly_line [|node_xy; (r + (2*r + dx)*(i-1)), (r + (2*r + dy)*(j-1))|] ;
end;
if (i > 0) && gr.g.(i).(j).edges.(1) <> (-1) then begin (* O *)
draw_poly_line [|node_xy; (r + (2*r + dx)*(i-1)), (r + (2*r + dy)*j)|] ;
end;
if (i > 0 && j < gr.height -1) && gr.g.(i).(j).edges.(2) <> (-1) then begin (* NO *)
draw_poly_line [|node_xy; (r + (2*r + dx)*(i-1)), (r + (2*r + dy)*(j+1))|] ;
end;
if (j < gr.height -1) && gr.g.(i).(j).edges.(3) <> (-1) then begin (* N *)
draw_poly_line [|node_xy; (r + (2*r + dx)*i), (r + (2*r + dy)*(j+1))|] ;
end;
if (i < gr.width-1 && j < gr.height -1) && gr.g.(i).(j).edges.(4) <> (-1) then begin (* NE *)
draw_poly_line [|node_xy; (r + (2*r + dx)*(i+1)), (r + (2*r + dy)*(j+1))|] ;
end;
if (i < gr.width-1) && gr.g.(i).(j).edges.(5) <> (-1) then begin (* E *)
draw_poly_line [|node_xy; (r + (2*r + dx)*(i+1)), (r + (2*r + dy)*j)|] ;
end;
if (i < gr.width-1 && j > 0) && gr.g.(i).(j).edges.(6) <> (-1) then begin (* SE *)
draw_poly_line [|node_xy; (r + (2*r + dx)*(i+1)), (r + (2*r + dy)*(j-1))|] ;
end;
if (j > 0) && gr.g.(i).(j).edges.(7) <> (-1) then begin (* S *)
draw_poly_line [|node_xy; (r + (2*r + dx)*i), (r + (2*r + dy)*(j-1))|] ;
end;
done
done;
set_line_width 8;
for i = 0 to gr.width -1 do
for j = 0 to gr.height -1 do
let node_xy = ((r + (2*r + dx)*i), (r + (2*r + dy)*j)) in
if (i > 0 && j > 0) && gr.g.(i).(j).edges.(0) <> (-1) then begin (* SO *)
draw_poly_line [|node_xy; (2 * (fst node_xy) + r + (2*r + dx)*(i-1))/3, (2 * (snd node_xy) + r + (2*r + dy)*(j-1))/3|] ;
end;
if (i > 0) && gr.g.(i).(j).edges.(1) <> (-1) then begin (* O *)
draw_poly_line [|node_xy; (2 * (fst node_xy) + r + (2*r + dx)*(i-1))/3, (2 * (snd node_xy) + r + (2*r + dy)*j)/3|] ;
end;
if (i > 0 && j < gr.height -1) && gr.g.(i).(j).edges.(2) <> (-1) then begin (* NO *)
draw_poly_line [|node_xy; (2 * (fst node_xy) + r + (2*r + dx)*(i-1))/3, (2 * (snd node_xy) + r + (2*r + dy)*(j+1))/3|] ;
end;
if (j < gr.height -1) && gr.g.(i).(j).edges.(3) <> (-1) then begin (* N *)
draw_poly_line [|node_xy; (2 * (fst node_xy) + r + (2*r + dx)*i)/3, (2 * (snd node_xy) + r + (2*r + dy)*(j+1))/3|] ;
end;
if (i < gr.width-1 && j < gr.height -1) && gr.g.(i).(j).edges.(4) <> (-1) then begin (* NE *)
draw_poly_line [|node_xy; (2 * (fst node_xy) + r + (2*r + dx)*(i+1))/3, (2 * (snd node_xy) + r + (2*r + dy)*(j+1))/3|] ;
end;
if (i < gr.width-1) && gr.g.(i).(j).edges.(5) <> (-1) then begin (* E *)
draw_poly_line [|node_xy; (2 * (fst node_xy) + r + (2*r + dx)*(i+1))/3, (2 * (snd node_xy) + r + (2*r + dy)*j)/3|] ;
end;
if (i < gr.width-1 && j > 0) && gr.g.(i).(j).edges.(6) <> (-1) then begin (* SE *)
draw_poly_line [|node_xy; (2 * (fst node_xy) + r + (2*r + dx)*(i+1))/3, (2 * (snd node_xy) + r + (2*r + dy)*(j-1))/3|] ;
end;
if (j > 0) && gr.g.(i).(j).edges.(7) <> (-1) then begin (* S *)
draw_poly_line [|node_xy; (2 * (fst node_xy) + r + (2*r + dx)*i)/3, (2 * (snd node_xy) + r + (2*r + dy)*(j-1))/3|] ;
end;
done
done;
set_line_width 5;
for i = 0 to gr.width -1 do
for j = 0 to gr.height -1 do
set_color (rgb 192 192 192) ;
fill_circle (r + (2*r + dx)*i) (r + (2*r + dy)*j) r ;
set_color (rgb 100 100 100) ;
draw_circle (r + (2*r + dx)*i) (r + (2*r + dy)*j) r ;
draw_integer (r + (2*r + dx)*i) (r + (2*r + dy)*j) gr.g.(i).(j).tag r
done
done ;
let draw_tile i j =
set_line_width 5;
set_color (rgb 48 48 48) ;
fill_circle (r + (2*r + dx)*i) (r + (2*r + dy)*j) r ;
set_color black;
draw_circle (r + (2*r + dx)*i) (r + (2*r + dy)*j) r ;
set_color colors.(i).(j);
draw_integer (r + (2*r + dx)*i) (r + (2*r + dy)*j) gr.g.(i).(j).tag r ;
in
(* Now for the actual DFS *)
let visited = Array.make_matrix gr.width gr.height false in
let rec explore i j depth =
if visited.(i).(j) = false then begin
visited.(i).(j) <- true;
draw_tile i j;
set_color white;
fill_circle (r + (2*r + dx)*(gr.width/2)) (r + (2*r + dy)*(gr.height/2)) r;
set_color black;
draw_integer (r + (2*r + dx)*(gr.width/2)) (r + (2*r + dy)*(gr.height/2)) depth r;
Unix.sleepf dt;
let node_xy = ((r + (2*r + dx)*i), (r + (2*r + dy)*j)) in
if (i > 0 && j > 0) && gr.g.(i).(j).edges.(0) <> (-1) && (visited.(i-1).(j-1) = false) then begin (* SO *)
set_line_width 4;
set_color black;
draw_poly_line [|node_xy; (r + (2*r + dx)*(i-1)), (r + (2*r + dy)*(j-1))|] ;
set_color colors.(i).(j);
set_line_width 8;
draw_poly_line [|node_xy; (2 * (fst node_xy) + r + (2*r + dx)*(i-1))/3, (2 * (snd node_xy) + r + (2*r + dy)*(j-1))/3|] ;
draw_tile i j;
explore (i-1) (j-1) (depth+1) ;
end;
if (i > 0) && gr.g.(i).(j).edges.(1) <> (-1) && (visited.(i-1).(j) = false) then begin (* O *)
set_line_width 4;
set_color black;
draw_poly_line [|node_xy; (r + (2*r + dx)*(i-1)), (r + (2*r + dy)*j)|] ;
set_color colors.(i).(j);
set_line_width 8;
draw_poly_line [|node_xy; (2 * (fst node_xy) + r + (2*r + dx)*(i-1))/3, (2 * (snd node_xy) + r + (2*r + dy)*j)/3|] ;
draw_tile i j;
explore (i-1) j (depth+1);
end;
if (i > 0 && j < gr.height -1) && gr.g.(i).(j).edges.(2) <> (-1) && (visited.(i-1).(j+1) = false) then begin (* NO *)
set_line_width 4;
set_color black;
draw_poly_line [|node_xy; (r + (2*r + dx)*(i-1)), (r + (2*r + dy)*(j+1))|] ;
set_color colors.(i).(j);
set_line_width 8;
draw_poly_line [|node_xy; (2 * (fst node_xy) + r + (2*r + dx)*(i-1))/3, (2 * (snd node_xy) + r + (2*r + dy)*(j+1))/3|] ;
draw_tile i j;
explore (i-1) (j+1) (depth+1);
end;
if (j < gr.height -1) && gr.g.(i).(j).edges.(3) <> (-1) && (visited.(i).(j+1) = false) then begin (* N *)
set_line_width 4;
set_color black;
draw_poly_line [|node_xy; (r + (2*r + dx)*i), (r + (2*r + dy)*(j+1))|] ;
set_color colors.(i).(j);
set_line_width 8;
draw_poly_line [|node_xy; (2 * (fst node_xy) + r + (2*r + dx)*i)/3, (2 * (snd node_xy) + r + (2*r + dy)*(j+1))/3|] ;
draw_tile i j;
explore i (j+1) (depth+1);
end;
if (i < gr.width-1 && j < gr.height -1) && gr.g.(i).(j).edges.(4) <> (-1) && (visited.(i+1).(j+1) = false) then begin (* NE *)
set_line_width 4;
set_color black;
draw_poly_line [|node_xy; (r + (2*r + dx)*(i+1)), (r + (2*r + dy)*(j+1))|] ;
set_color colors.(i).(j);
set_line_width 8;
draw_poly_line [|node_xy; (2 * (fst node_xy) + r + (2*r + dx)*(i+1))/3, (2 * (snd node_xy) + r + (2*r + dy)*(j+1))/3|] ;
draw_tile i j;
explore (i+1) (j+1) (depth+1);
end;
if (i < gr.width-1) && gr.g.(i).(j).edges.(5) <> (-1) && (visited.(i+1).(j) = false) then begin (* E *)
set_line_width 4;
set_color black;
draw_poly_line [|node_xy; (r + (2*r + dx)*(i+1)), (r + (2*r + dy)*j)|] ;
set_color colors.(i).(j);
set_line_width 8;
draw_poly_line [|node_xy; (2 * (fst node_xy) + r + (2*r + dx)*(i+1))/3, (2 * (snd node_xy) + r + (2*r + dy)*j)/3|] ;
draw_tile i j;
explore (i+1) j (depth+1);
end;
if (i < gr.width-1 && j > 0) && gr.g.(i).(j).edges.(6) <> (-1) && (visited.(i+1).(j-1) = false) then begin (* SE *)
set_line_width 4;
set_color black;
draw_poly_line [|node_xy; (r + (2*r + dx)*(i+1)), (r + (2*r + dy)*(j-1))|] ;
set_color colors.(i).(j);
set_line_width 8;
draw_poly_line [|node_xy; (2 * (fst node_xy) + r + (2*r + dx)*(i+1))/3, (2 * (snd node_xy) + r + (2*r + dy)*(j-1))/3|] ;
draw_tile i j;
explore (i+1) (j-1) (depth+1);
end;
if (j > 0) && gr.g.(i).(j).edges.(7) <> (-1) && (visited.(i).(j-1) = false) then begin (* S *)
set_line_width 4;
set_color black;
draw_poly_line [|node_xy; (r + (2*r + dx)*i), (r + (2*r + dy)*(j-1))|] ;
set_color colors.(i).(j);
set_line_width 8;
draw_poly_line [|node_xy; (2 * (fst node_xy) + r + (2*r + dx)*i)/3, (2 * (snd node_xy) + r + (2*r + dy)*(j-1))/3|] ;
draw_tile i j;
explore i (j-1) (depth+1);
end;
end
in
explore (gr.width/2) (gr.height/2) 0;
ignore (Scanf.bscanf Scanf.Scanning.stdin "%d\n" identity) ;;
(* ------------------------------------------------------------*)
(* ------------------------------------------------------------*)
(* ------------------------------------------------------------*)
let another_type_of_bfs (gr : type2graph) r dx dy gwd ght dt =
let colors = Array.make_matrix gr.width gr.height (rgb 0 0 0) in
for i = 0 to gr.width -1 do
for j = 0 to gr.height -1 do
if (i*gr.width + j) mod 6 = 0 then
colors.(i).(j) <- rgb 0 0 200
else if (i*gr.width + j) mod 6 = 1 then
colors.(i).(j) <- rgb 0 200 0
else if (i*gr.width + j) mod 6 = 2 then
colors.(i).(j) <- rgb 0 200 200
else if (i*gr.width + j) mod 6 = 3 then
colors.(i).(j) <- rgb 200 0 0
else if (i*gr.width + j) mod 6 = 4 then
colors.(i).(j) <- rgb 200 0 200
else
colors.(i).(j) <- rgb 200 200 0
done
done;
set_line_width 4;
set_color (rgb 192 192 192) ;
for i = 0 to gr.width -1 do
for j = 0 to gr.height -1 do
let node_xy = ((r + (2*r + dx)*i), (r + (2*r + dy)*j)) in
if (i > 0 && j > 0) && gr.g.(i).(j).edges.(0) <> (-1) then begin (* SO *)
draw_poly_line [|node_xy; (r + (2*r + dx)*(i-1)), (r + (2*r + dy)*(j-1))|] ;
end;
if (i > 0) && gr.g.(i).(j).edges.(1) <> (-1) then begin (* O *)
draw_poly_line [|node_xy; (r + (2*r + dx)*(i-1)), (r + (2*r + dy)*j)|] ;
end;
if (i > 0 && j < gr.height -1) && gr.g.(i).(j).edges.(2) <> (-1) then begin (* NO *)
draw_poly_line [|node_xy; (r + (2*r + dx)*(i-1)), (r + (2*r + dy)*(j+1))|] ;
end;
if (j < gr.height -1) && gr.g.(i).(j).edges.(3) <> (-1) then begin (* N *)
draw_poly_line [|node_xy; (r + (2*r + dx)*i), (r + (2*r + dy)*(j+1))|] ;
end;
if (i < gr.width-1 && j < gr.height -1) && gr.g.(i).(j).edges.(4) <> (-1) then begin (* NE *)
draw_poly_line [|node_xy; (r + (2*r + dx)*(i+1)), (r + (2*r + dy)*(j+1))|] ;
end;
if (i < gr.width-1) && gr.g.(i).(j).edges.(5) <> (-1) then begin (* E *)
draw_poly_line [|node_xy; (r + (2*r + dx)*(i+1)), (r + (2*r + dy)*j)|] ;
end;
if (i < gr.width-1 && j > 0) && gr.g.(i).(j).edges.(6) <> (-1) then begin (* SE *)
draw_poly_line [|node_xy; (r + (2*r + dx)*(i+1)), (r + (2*r + dy)*(j-1))|] ;
end;
if (j > 0) && gr.g.(i).(j).edges.(7) <> (-1) then begin (* S *)
draw_poly_line [|node_xy; (r + (2*r + dx)*i), (r + (2*r + dy)*(j-1))|] ;
end;
done
done;
set_line_width 8;
for i = 0 to gr.width -1 do
for j = 0 to gr.height -1 do
let node_xy = ((r + (2*r + dx)*i), (r + (2*r + dy)*j)) in
if (i > 0 && j > 0) && gr.g.(i).(j).edges.(0) <> (-1) then begin (* SO *)
draw_poly_line [|node_xy; (2 * (fst node_xy) + r + (2*r + dx)*(i-1))/3, (2 * (snd node_xy) + r + (2*r + dy)*(j-1))/3|] ;
end;
if (i > 0) && gr.g.(i).(j).edges.(1) <> (-1) then begin (* O *)
draw_poly_line [|node_xy; (2 * (fst node_xy) + r + (2*r + dx)*(i-1))/3, (2 * (snd node_xy) + r + (2*r + dy)*j)/3|] ;
end;
if (i > 0 && j < gr.height -1) && gr.g.(i).(j).edges.(2) <> (-1) then begin (* NO *)
draw_poly_line [|node_xy; (2 * (fst node_xy) + r + (2*r + dx)*(i-1))/3, (2 * (snd node_xy) + r + (2*r + dy)*(j+1))/3|] ;
end;
if (j < gr.height -1) && gr.g.(i).(j).edges.(3) <> (-1) then begin (* N *)
draw_poly_line [|node_xy; (2 * (fst node_xy) + r + (2*r + dx)*i)/3, (2 * (snd node_xy) + r + (2*r + dy)*(j+1))/3|] ;
end;
if (i < gr.width-1 && j < gr.height -1) && gr.g.(i).(j).edges.(4) <> (-1) then begin (* NE *)
draw_poly_line [|node_xy; (2 * (fst node_xy) + r + (2*r + dx)*(i+1))/3, (2 * (snd node_xy) + r + (2*r + dy)*(j+1))/3|] ;
end;
if (i < gr.width-1) && gr.g.(i).(j).edges.(5) <> (-1) then begin (* E *)
draw_poly_line [|node_xy; (2 * (fst node_xy) + r + (2*r + dx)*(i+1))/3, (2 * (snd node_xy) + r + (2*r + dy)*j)/3|] ;
end;
if (i < gr.width-1 && j > 0) && gr.g.(i).(j).edges.(6) <> (-1) then begin (* SE *)
draw_poly_line [|node_xy; (2 * (fst node_xy) + r + (2*r + dx)*(i+1))/3, (2 * (snd node_xy) + r + (2*r + dy)*(j-1))/3|] ;
end;
if (j > 0) && gr.g.(i).(j).edges.(7) <> (-1) then begin (* S *)
draw_poly_line [|node_xy; (2 * (fst node_xy) + r + (2*r + dx)*i)/3, (2 * (snd node_xy) + r + (2*r + dy)*(j-1))/3|] ;
end;
done
done;
set_line_width 5;
for i = 0 to gr.width -1 do
for j = 0 to gr.height -1 do
set_color (rgb 192 192 192) ;
fill_circle (r + (2*r + dx)*i) (r + (2*r + dy)*j) r ;
set_color (rgb 100 100 100) ;
draw_circle (r + (2*r + dx)*i) (r + (2*r + dy)*j) r ;
draw_integer (r + (2*r + dx)*i) (r + (2*r + dy)*j) gr.g.(i).(j).tag r
done
done ;
let draw_tile i j =
set_line_width 5;
set_color (rgb 48 48 48) ;
fill_circle (r + (2*r + dx)*i) (r + (2*r + dy)*j) r ;
set_color black;
draw_circle (r + (2*r + dx)*i) (r + (2*r + dy)*j) r ;
set_color colors.(i).(j);
draw_integer (r + (2*r + dx)*i) (r + (2*r + dy)*j) gr.g.(i).(j).tag r ;
in
(* Actual BFS *)
let pq = Queue.create () in
Queue.add (0, gr.width/2, gr.height/2, gr.width/2, gr.height/2, [||], [||]) pq ;
let visited = Array.make_matrix gr.width gr.height false in
try
while true do
let (depth, i0, j0, i, j, path_arr, bigpath_arr) = Queue.take pq in
if visited.(i).(j) = false then begin
set_line_width 4;
set_color black;
draw_poly_line path_arr ;
set_color colors.(i).(j);
set_line_width 8;
draw_poly_line bigpath_arr ;
draw_tile i j;
set_color colors.(i0).(j0) ;
draw_tile i0 j0;
visited.(i).(j) <- true;
set_color white;
fill_circle (r + (2*r + dx)*(gr.width/2)) (r + (2*r + dy)*(gr.height/2)) r;
set_color black;
draw_integer (r + (2*r + dx)*(gr.width/2)) (r + (2*r + dy)*(gr.height/2)) depth r;
Unix.sleepf dt;
let node_xy = ((r + (2*r + dx)*i), (r + (2*r + dy)*j)) in
if (i > 0 && j > 0) && gr.g.(i).(j).edges.(0) <> (-1) && (visited.(i-1).(j-1) = false) then begin (* SO *)
Queue.add (depth+1, i, j, i-1, j-1, [|node_xy; (r + (2*r + dx)*(i-1)), (r + (2*r + dy)*(j-1))|], [|node_xy; (2 * (fst node_xy) + r + (2*r + dx)*(i-1))/3, (2 * (snd node_xy) + r + (2*r + dy)*(j-1))/3|]) pq;
end;
if (i > 0) && gr.g.(i).(j).edges.(1) <> (-1) && (visited.(i-1).(j) = false) then begin (* O *)
Queue.add (depth+1, i, j, i-1, j, [|node_xy; (r + (2*r + dx)*(i-1)), (r + (2*r + dy)*j)|], [|node_xy; (2 * (fst node_xy) + r + (2*r + dx)*(i-1))/3, (2 * (snd node_xy) + r + (2*r + dy)*j)/3|]) pq;
end;
if (i > 0 && j < gr.height -1) && gr.g.(i).(j).edges.(2) <> (-1) && (visited.(i-1).(j+1) = false) then begin (* NO *)
Queue.add (depth+1, i, j, i-1, j+1, [|node_xy; (r + (2*r + dx)*(i-1)), (r + (2*r + dy)*(j+1))|], [|node_xy; (2 * (fst node_xy) + r + (2*r + dx)*(i-1))/3, (2 * (snd node_xy) + r + (2*r + dy)*(j+1))/3|]) pq;
end;
if (j < gr.height -1) && gr.g.(i).(j).edges.(3) <> (-1) && (visited.(i).(j+1) = false) then begin (* N *)
Queue.add (depth+1, i, j, i, j+1, [|node_xy; (r + (2*r + dx)*i), (r + (2*r + dy)*(j+1))|], [|node_xy; (2 * (fst node_xy) + r + (2*r + dx)*i)/3, (2 * (snd node_xy) + r + (2*r + dy)*(j+1))/3|]) pq;
end;
if (i < gr.width-1 && j < gr.height -1) && gr.g.(i).(j).edges.(4) <> (-1) && (visited.(i+1).(j+1) = false) then begin (* NE *)
Queue.add (depth+1, i, j, i+1, j+1, [|node_xy; (r + (2*r + dx)*(i+1)), (r + (2*r + dy)*(j+1))|], [|node_xy; (2 * (fst node_xy) + r + (2*r + dx)*(i+1))/3, (2 * (snd node_xy) + r + (2*r + dy)*(j+1))/3|]) pq;
end;
if (i < gr.width-1) && gr.g.(i).(j).edges.(5) <> (-1) && (visited.(i+1).(j) = false) then begin (* E *)
Queue.add (depth+1, i, j, i+1, j, [|node_xy; (r + (2*r + dx)*(i+1)), (r + (2*r + dy)*j)|], [|node_xy; (2 * (fst node_xy) + r + (2*r + dx)*(i+1))/3, (2 * (snd node_xy) + r + (2*r + dy)*j)/3|]) pq;
end;
if (i < gr.width-1 && j > 0) && gr.g.(i).(j).edges.(6) <> (-1) && (visited.(i+1).(j-1) = false) then begin (* SE *)
Queue.add (depth+1, i, j, i+1, j-1, [|node_xy; (r + (2*r + dx)*(i+1)), (r + (2*r + dy)*(j-1))|], [|node_xy; (2 * (fst node_xy) + r + (2*r + dx)*(i+1))/3, (2 * (snd node_xy) + r + (2*r + dy)*(j-1))/3|]) pq;
end;
if (j > 0) && gr.g.(i).(j).edges.(7) <> (-1) && (visited.(i).(j-1) = false) then begin (* S *)
Queue.add (depth+1, i, j, i, j-1, [|node_xy; (r + (2*r + dx)*i), (r + (2*r + dy)*(j-1))|], [|node_xy; (2 * (fst node_xy) + r + (2*r + dx)*i)/3, (2 * (snd node_xy) + r + (2*r + dy)*(j-1))/3|]) pq;
end
end;
done;
()
with
| Stdlib.Queue.Empty -> ignore (Scanf.bscanf Scanf.Scanning.stdin "%d\n" identity) ;;
(* ------------------------------------------------------------*)
(* ------------------------------------------------------------*)
(* ------------------------------------------------------------*)
(* ------------------------------------------------------------*)
(* ------------------------------------------------------------*)
type 'a dynamic_array = { mutable arr : 'a array ; mutable len : int } ;;
let create () =
{ arr = [||] ; len = 0 } ;;
let init a =
{ arr = a ; len = Array.length a } ;;
let length a = a.len ;;
let get a i =
assert(0 <= i && i < a.len) ;
a.arr.(i) ;;
let set a i x =
assert(0 <= i && i < a.len) ;
a.arr.(i) <- x ;;
let resize a newlen e =
a.arr <- Array.init newlen (fun i -> if i < a.len then a.arr.(i) else e) ;;
let append a e =
if a.len = Array.length a.arr then
resize a (a.len * 2 + 1) e ;
a.arr.(a.len) <- e ;
a.len <- a.len + 1 ;;
let pop a =
assert(a.len > 0) ;
a.len <- a.len - 1 ;
let x = a.arr.(a.len) in
if a.len < (Array.length a.arr) / 4 then
resize a (a.len * 2) a.arr.(0) ;
x ;;
module H = Hashtbl ;;
(*
'a : type for elements
'b : type for priorities (hypothesis : totally ordered type).
*)
type ('a, 'b) priority_queue = { heap : ('a * 'b) dynamic_array ; locate : ('a, int) H.t } ;;
let pq_create () =
{ heap = create () ; locate = H.create 200 } ;;
let pq_is_empty pq =
length pq.heap = 0 ;;
let pq_mem pq elt =
H.mem pq.locate elt ;;
(* SWAPS indexes i and j in the heap AND the hash table : *)
let pq_swap pq i j =
let elt1 = fst (get pq.heap i)
and elt2 = fst (get pq.heap j) in
let tmp = (get pq.heap i) in
set pq.heap i (get pq.heap j) ;
set pq.heap j tmp ;
H.replace pq.locate elt1 j ;
H.replace pq.locate elt2 i ;;
(* PERCOLATE UP AND DOWN *)
let pq_get_priority pq i =
snd (get pq.heap i) ;;
let rec pq_percolate_up pq i =
let father = ((i-1)/2) in
if i > 0 && (pq_get_priority pq i) < (pq_get_priority pq father) then begin
pq_swap pq i father ;
pq_percolate_up pq father
end ;;
let rec pq_percolate_down pq i =
let n = length pq.heap in
let left_child = 2*i+1 and right_child = 2*i+2 in
let m = ref (pq_get_priority pq i) in
let max_node = ref i in
if left_child < n && pq_get_priority pq left_child < !m then begin
m := pq_get_priority pq left_child ;
max_node := left_child
end ;
if right_child < n && pq_get_priority pq right_child < !m then begin
m := pq_get_priority pq right_child ;
max_node := right_child
end ;
if !max_node <> i then
pq_swap pq i !max_node ;;
(* ACTUAL FUNCTIONS *)
exception BreakOfLoop ;;
let pq_add elt pq prio =
append pq.heap (elt, prio) ;
H.add pq.locate elt (length pq.heap - 1) ;
pq_percolate_up pq (length pq.heap - 1) ;;
let pq_min pq =
assert(length pq.heap > 0 ) ;
get pq.heap 0 ;;
let pq_extract_min pq =
let n = length pq.heap in
if n <= 0 then raise BreakOfLoop;
pq_swap pq 0 (n-1) ;
let (elt, prio) = pop pq.heap in
H.remove pq.locate elt ;
if n > 1 then
pq_percolate_down pq 0 ;
(elt, prio) ;;
let pq_priority pq elt =
pq_get_priority pq (H.find pq.locate elt) ;;
let pq_update_priority pq elt prio =
let index = H.find pq.locate elt in
let p = pq_get_priority pq index in
set pq.heap index (elt, prio) ;
if p > prio then
pq_percolate_up pq index
else
pq_percolate_down pq index ;;
let pq_init a default_priority =
let pq = pq_create () in
Array.iter (fun x -> pq_add x pq default_priority) a ;
pq ;;
(* ------------------------------------------------------------*)
(* ------------------------------------------------------------*)
(* ------------------------------------------------------------*)
let another_type_of_dijkstra (gr : type2graph) r dx dy dt gwd ght =
let colors = Array.make_matrix gr.width gr.height (rgb 0 0 0) in
for i = 0 to gr.width -1 do
for j = 0 to gr.height -1 do
if (i*gr.width + j) mod 7 = 0 then
colors.(i).(j) <- rgb 0 0 200
else if (i*gr.width + j) mod 7 = 1 then
colors.(i).(j) <- rgb 0 200 0
else if (i*gr.width + j) mod 7 = 2 then
colors.(i).(j) <- rgb 0 200 200
else if (i*gr.width + j) mod 7 = 3 then
colors.(i).(j) <- rgb 200 0 0
else if (i*gr.width + j) mod 7 = 4 then
colors.(i).(j) <- rgb 200 0 200
else if (i*gr.width + j) mod 7 = 5 then
colors.(i).(j) <- rgb 200 200 0
else
colors.(i).(j) <- rgb 200 200 200
done
done;
set_line_width 4;
set_color black ;
for i = 0 to gr.width -1 do
for j = 0 to gr.height -1 do
let node_xy = ((r + (2*r + dx)*i), (r + (2*r + dy)*j)) in
if (i > 0 && j > 0) && gr.g.(i).(j).edges.(0) <> (-1) then begin (* SO *)
draw_poly_line [|node_xy; (r + (2*r + dx)*(i-1)), (r + (2*r + dy)*(j-1))|] ;
end;
if (i > 0) && gr.g.(i).(j).edges.(1) <> (-1) then begin (* O *)
draw_poly_line [|node_xy; (r + (2*r + dx)*(i-1)), (r + (2*r + dy)*j)|] ;
end;
if (i > 0 && j < gr.height -1) && gr.g.(i).(j).edges.(2) <> (-1) then begin (* NO *)
draw_poly_line [|node_xy; (r + (2*r + dx)*(i-1)), (r + (2*r + dy)*(j+1))|] ;
end;
if (j < gr.height -1) && gr.g.(i).(j).edges.(3) <> (-1) then begin (* N *)
draw_poly_line [|node_xy; (r + (2*r + dx)*i), (r + (2*r + dy)*(j+1))|] ;
end;
if (i < gr.width-1 && j < gr.height -1) && gr.g.(i).(j).edges.(4) <> (-1) then begin (* NE *)
draw_poly_line [|node_xy; (r + (2*r + dx)*(i+1)), (r + (2*r + dy)*(j+1))|] ;
end;
if (i < gr.width-1) && gr.g.(i).(j).edges.(5) <> (-1) then begin (* E *)
draw_poly_line [|node_xy; (r + (2*r + dx)*(i+1)), (r + (2*r + dy)*j)|] ;
end;
if (i < gr.width-1 && j > 0) && gr.g.(i).(j).edges.(6) <> (-1) then begin (* SE *)
draw_poly_line [|node_xy; (r + (2*r + dx)*(i+1)), (r + (2*r + dy)*(j-1))|] ;
end;
if (j > 0) && gr.g.(i).(j).edges.(7) <> (-1) then begin (* S *)
draw_poly_line [|node_xy; (r + (2*r + dx)*i), (r + (2*r + dy)*(j-1))|] ;
end;
done
done;
let roff = (9*r)/8 in
let roff2 = (7*r)/5 in
let rsize = (3*r)/4 in
let wcolor = rgb 64 64 64 in
let bcolor = rgb 0 0 0 in
let is_weighted = true in
set_line_width 8;
for i = 0 to gr.width -1 do
for j = 0 to gr.height -1 do
let node_xy = ((r + (2*r + dx)*i), (r + (2*r + dy)*j)) in
if (i > 0 && j > 0) && gr.g.(i).(j).edges.(0) <> (-1) then begin (* SO *)
if is_weighted then begin
set_color bcolor;
fill_circle (fst node_xy - roff) (snd node_xy - roff) (3*rsize/4) ;
set_color wcolor;
set_line_width 3;
draw_integer (fst node_xy - roff) (snd node_xy - roff) gr.g.(i).(j).edges.(0) rsize;
end
end;
if (i > 0) && gr.g.(i).(j).edges.(1) <> (-1) then begin (* O *)
if is_weighted then begin
set_color bcolor;
fill_circle (fst node_xy - roff2) (snd node_xy) (3*rsize/4) ;
set_color wcolor;
set_line_width 3;
draw_integer (fst node_xy - roff2) (snd node_xy) gr.g.(i).(j).edges.(1) rsize;
end
end;
if (i > 0 && j < gr.height -1) && gr.g.(i).(j).edges.(2) <> (-1) then begin (* NO *)
if is_weighted then begin
set_color bcolor;
fill_circle (fst node_xy - roff) (snd node_xy + roff) (3*rsize/4) ;
set_color wcolor;
set_line_width 3;
draw_integer (fst node_xy - roff) (snd node_xy + roff) gr.g.(i).(j).edges.(2) rsize;
end
end;
if (j < gr.height -1) && gr.g.(i).(j).edges.(3) <> (-1) then begin (* N *)
if is_weighted then begin
set_color bcolor;
fill_circle (fst node_xy) (snd node_xy + roff2) (3*rsize/4) ;
set_color wcolor;
set_line_width 3;
draw_integer (fst node_xy) (snd node_xy + roff2) gr.g.(i).(j).edges.(3) rsize;
end
end;
if (i < gr.width-1 && j < gr.height -1) && gr.g.(i).(j).edges.(4) <> (-1) then begin (* NE *)
if is_weighted then begin
set_color bcolor;
fill_circle (fst node_xy + roff) (snd node_xy + roff) (3*rsize/4) ;
set_color wcolor;
set_line_width 3;
draw_integer (fst node_xy + roff) (snd node_xy + roff) gr.g.(i).(j).edges.(4) rsize;
end
end;
if (i < gr.width-1) && gr.g.(i).(j).edges.(5) <> (-1) then begin (* E *)
if is_weighted then begin
set_color bcolor;
fill_circle (fst node_xy + roff2) (snd node_xy) (3*rsize/4) ;
set_color wcolor;
set_line_width 3;
draw_integer (fst node_xy + roff2) (snd node_xy) gr.g.(i).(j).edges.(5) rsize;
end
end;
if (i < gr.width-1 && j > 0) && gr.g.(i).(j).edges.(6) <> (-1) then begin (* SE *)
if is_weighted then begin
set_color bcolor;
fill_circle (fst node_xy + roff) (snd node_xy - roff) (3*rsize/4) ;
set_color wcolor;
set_line_width 3;
draw_integer (fst node_xy + roff) (snd node_xy - roff) gr.g.(i).(j).edges.(6) rsize;
end
end;
if (j > 0) && gr.g.(i).(j).edges.(7) <> (-1) then begin (* S *)
if is_weighted then begin
set_color bcolor;
fill_circle (fst node_xy) (snd node_xy - roff2) (3*rsize/4) ;
set_color wcolor;
set_line_width 3;
draw_integer (fst node_xy) (snd node_xy - roff2) gr.g.(i).(j).edges.(7) rsize;
end
end;
done
done;
set_line_width 5;
for i = 0 to gr.width -1 do
for j = 0 to gr.height -1 do
set_color (rgb 48 48 48) ;
fill_circle (r + (2*r + dx)*i) (r + (2*r + dy)*j) r ;
set_color black ;
draw_circle (r + (2*r + dx)*i) (r + (2*r + dy)*j) r ;
set_color (rgb 48 48 48) ;
draw_integer (r + (2*r + dx)*i) (r + (2*r + dy)*j) gr.g.(i).(j).tag r
done
done ;
let draw_tile i j =
set_line_width 5;
set_color (rgb 48 48 48) ;
fill_circle (r + (2*r + dx)*i) (r + (2*r + dy)*j) r ;
set_color black;
draw_circle (r + (2*r + dx)*i) (r + (2*r + dy)*j) r ;
set_color colors.(i).(j);
draw_integer (r + (2*r + dx)*i) (r + (2*r + dy)*j) gr.g.(i).(j).tag r ;
let fcolor = rgb 255 0 0 in
let node_xy = ((r + (2*r + dx)*i), (r + (2*r + dy)*j)) in
if (i > 0 && j > 0) && gr.g.(i).(j).edges.(0) <> (-1) then begin (* SO *)
if is_weighted then begin
set_color bcolor;
fill_circle (fst node_xy - roff) (snd node_xy - roff) (3*rsize/4) ;
set_color fcolor;
set_line_width 3;
draw_integer (fst node_xy - roff) (snd node_xy - roff) gr.g.(i).(j).edges.(0) rsize;
end
end;
if (i > 0) && gr.g.(i).(j).edges.(1) <> (-1) then begin (* O *)
if is_weighted then begin
set_color bcolor;
fill_circle (fst node_xy - roff2) (snd node_xy) (3*rsize/4) ;
set_color fcolor;
set_line_width 3;
draw_integer (fst node_xy - roff2) (snd node_xy) gr.g.(i).(j).edges.(1) rsize;
end
end;
if (i > 0 && j < gr.height -1) && gr.g.(i).(j).edges.(2) <> (-1) then begin (* NO *)
if is_weighted then begin
set_color bcolor;
fill_circle (fst node_xy - roff) (snd node_xy + roff) (3*rsize/4) ;
set_color fcolor;
set_line_width 3;
draw_integer (fst node_xy - roff) (snd node_xy + roff) gr.g.(i).(j).edges.(2) rsize;
end
end;
if (j < gr.height -1) && gr.g.(i).(j).edges.(3) <> (-1) then begin (* N *)
if is_weighted then begin
set_color bcolor;
fill_circle (fst node_xy) (snd node_xy + roff2) (3*rsize/4) ;
set_color fcolor;
set_line_width 3;
draw_integer (fst node_xy) (snd node_xy + roff2) gr.g.(i).(j).edges.(3) rsize;
end
end;
if (i < gr.width-1 && j < gr.height -1) && gr.g.(i).(j).edges.(4) <> (-1) then begin (* NE *)
if is_weighted then begin
set_color bcolor;
fill_circle (fst node_xy + roff) (snd node_xy + roff) (3*rsize/4) ;
set_color fcolor;
set_line_width 3;
draw_integer (fst node_xy + roff) (snd node_xy + roff) gr.g.(i).(j).edges.(4) rsize;
end
end;
if (i < gr.width-1) && gr.g.(i).(j).edges.(5) <> (-1) then begin (* E *)
if is_weighted then begin
set_color bcolor;
fill_circle (fst node_xy + roff2) (snd node_xy) (3*rsize/4) ;
set_color fcolor;
set_line_width 3;
draw_integer (fst node_xy + roff2) (snd node_xy) gr.g.(i).(j).edges.(5) rsize;
end
end;
if (i < gr.width-1 && j > 0) && gr.g.(i).(j).edges.(6) <> (-1) then begin (* SE *)
if is_weighted then begin
set_color bcolor;
fill_circle (fst node_xy + roff) (snd node_xy - roff) (3*rsize/4) ;
set_color fcolor;
set_line_width 3;
draw_integer (fst node_xy + roff) (snd node_xy - roff) gr.g.(i).(j).edges.(6) rsize;
end
end;
if (j > 0) && gr.g.(i).(j).edges.(7) <> (-1) then begin (* S *)
if is_weighted then begin
set_color bcolor;
fill_circle (fst node_xy) (snd node_xy - roff2) (3*rsize/4) ;
set_color fcolor;
set_line_width 3;
draw_integer (fst node_xy) (snd node_xy - roff2) gr.g.(i).(j).edges.(7) rsize;
end
end;
in
(* Actual Dijkstra *)
let pq = pq_create () in
pq_add (gr.width/2, gr.height/2, gr.width/2, gr.height/2, [||], [||]) pq 0 ;
let drawn = Array.make_matrix gr.width gr.height false in
let loops = Array.make_matrix gr.width gr.height [||] in
for i = 0 to gr.width-1 do
for j = 0 to gr.height-1 do
loops.(i).(j) <- Array.make 8 false;
done
done;
let dcolor = rgb 0 255 0 in
let done_smth = ref true in
let mindists = Array.make_matrix gr.width gr.height 999 in
try
while true do
done_smth := false;
let ((i0, j0, i, j, path_arr, bigpath_arr), depth) = pq_extract_min pq in
if true then begin
if drawn.(i).(j) = false then begin
drawn.(i).(j) <- true;
draw_tile i j;
done_smth := true;
end;
if drawn.(i0).(j0) = false then begin
drawn.(i0).(j0) <- true;
draw_tile i0 j0;
done_smth := true;
end;
if mindists.(i).(j) > depth then begin
mindists.(i).(j) <- depth;
set_color (rgb 48 48 48) ;
fill_circle (r + (2*r + dx)*i) (r + (2*r + dy)*j) r ;
set_color black ;
draw_circle (r + (2*r + dx)*i) (r + (2*r + dy)*j) r ;
set_color colors.(i).(j);
draw_integer (r + (2*r + dx)*i) (r + (2*r + dy)*j) depth r
end;
let node_xy = ((r + (2*r + dx)*i0), (r + (2*r + dy)*j0)) in
let dxx = i - i0 and dyy = j - j0 in
if (dxx, dyy) = (1, 1) then begin
set_color dcolor;
set_line_width 3;
draw_integer (fst node_xy + roff) (snd node_xy + roff) gr.g.(i0).(j0).edges.(4) rsize;
done_smth := true;
end
else if (dxx, dyy) = (1, 0) then begin
set_color dcolor;
set_line_width 3;
draw_integer (fst node_xy + roff2) (snd node_xy) gr.g.(i0).(j0).edges.(5) rsize;
done_smth := true;
end
else if (dxx, dyy) = (1, -1) then begin
set_color dcolor;
set_line_width 3;
draw_integer (fst node_xy + roff) (snd node_xy - roff) gr.g.(i0).(j0).edges.(6) rsize;
done_smth := true;
end
else if (dxx, dyy) = (0, -1) then begin
set_color dcolor;
set_line_width 3;
draw_integer (fst node_xy) (snd node_xy - roff2) gr.g.(i0).(j0).edges.(7) rsize;
done_smth := true;
end
else if (dxx, dyy) = (-1, -1) then begin
set_color dcolor;
set_line_width 3;
draw_integer (fst node_xy - roff) (snd node_xy - roff) gr.g.(i0).(j0).edges.(0) rsize;
done_smth := true;
end
else if (dxx, dyy) = (-1, 0) then begin
set_color dcolor;
set_line_width 3;
draw_integer (fst node_xy - roff2) (snd node_xy) gr.g.(i0).(j0).edges.(1) rsize;
done_smth := true;
end
else if (dxx, dyy) = (-1, 1) then begin
set_color dcolor;
set_line_width 3;
draw_integer (fst node_xy - roff) (snd node_xy + roff) gr.g.(i0).(j0).edges.(2) rsize;
done_smth := true;
end
else if (dxx, dyy) = (0, 1) then begin
set_color dcolor;
set_line_width 3;
draw_integer (fst node_xy) (snd node_xy + roff2) gr.g.(i0).(j0).edges.(3) rsize;
done_smth := true;
end;
set_color white;
fill_circle (r + (2*r + dx)*(gr.width/2)) (r + (2*r + dy)*(gr.height/2)) r;
set_color black;
draw_integer (r + (2*r + dx)*(gr.width/2)) (r + (2*r + dy)*(gr.height/2)) depth r;
if !done_smth then
Unix.sleepf dt;
let node_xy = ((r + (2*r + dx)*i), (r + (2*r + dy)*j)) in
if (i > 0 && j > 0) && gr.g.(i).(j).edges.(0) <> (-1) && ((i >= 0) && (j >= 0) && (i < gr.width) && (j < gr.height)) && loops.(i).(j).(0) = false then begin (* SO *)
loops.(i).(j).(0) <- true;
pq_add (i, j, i-1, j-1, [|node_xy; (r + (2*r + dxx)*(i-1)), (r + (2*r + dyy)*(j-1))|], [|node_xy; (2 * (fst node_xy) + r + (2*r + dxx)*(i-1))/3, (2 * (snd node_xy) + r + (2*r + dyy)*(j-1))/3|]) pq (depth+gr.g.(i).(j).edges.(0));
end;
if (i > 0) && gr.g.(i).(j).edges.(1) <> (-1) && ((i >= 0) && (j >= 0) && (i < gr.width) && (j < gr.height)) && loops.(i).(j).(1) = false then begin (* O *)
loops.(i).(j).(1) <- true;
pq_add (i, j, i-1, j, [|node_xy; (r + (2*r + dxx)*(i-1)), (r + (2*r + dyy)*j)|], [|node_xy; (2 * (fst node_xy) + r + (2*r + dxx)*(i-1))/3, (2 * (snd node_xy) + r + (2*r + dyy)*j)/3|]) pq (depth+gr.g.(i).(j).edges.(1));
end;
if (i > 0 && j < gr.height -1) && gr.g.(i).(j).edges.(2) <> (-1) && ((i >= 0) && (j >= 0) && (i < gr.width) && (j < gr.height)) && loops.(i).(j).(2) = false then begin (* NO *)
loops.(i).(j).(2) <- true;
pq_add (i, j, i-1, j+1, [|node_xy; (r + (2*r + dxx)*(i-1)), (r + (2*r + dyy)*(j+1))|], [|node_xy; (2 * (fst node_xy) + r + (2*r + dxx)*(i-1))/3, (2 * (snd node_xy) + r + (2*r + dyy)*(j+1))/3|]) pq (depth+gr.g.(i).(j).edges.(2));
end;
if (j < gr.height -1) && gr.g.(i).(j).edges.(3) <> (-1) && ((i >= 0) && (j >= 0) && (i < gr.width) && (j < gr.height)) && loops.(i).(j).(3) = false then begin (* N *)
loops.(i).(j).(3) <- true;
pq_add (i, j, i, j+1, [|node_xy; (r + (2*r + dxx)*i), (r + (2*r + dyy)*(j+1))|], [|node_xy; (2 * (fst node_xy) + r + (2*r + dxx)*i)/3, (2 * (snd node_xy) + r + (2*r + dyy)*(j+1))/3|]) pq (depth+gr.g.(i).(j).edges.(3));
end;
if (i < gr.width-1 && j < gr.height -1) && gr.g.(i).(j).edges.(4) <> (-1) && ((i >= 0) && (j >= 0) && (i < gr.width) && (j < gr.height)) && loops.(i).(j).(4) = false then begin (* NE *)
loops.(i).(j).(4) <- true;
pq_add (i, j, i+1, j+1, [|node_xy; (r + (2*r + dxx)*(i+1)), (r + (2*r + dyy)*(j+1))|], [|node_xy; (2 * (fst node_xy) + r + (2*r + dxx)*(i+1))/3, (2 * (snd node_xy) + r + (2*r + dyy)*(j+1))/3|]) pq (depth+gr.g.(i).(j).edges.(4));
end;
if (i < gr.width-1) && gr.g.(i).(j).edges.(5) <> (-1) && ((i >= 0) && (j >= 0) && (i < gr.width) && (j < gr.height)) && loops.(i).(j).(5) = false then begin (* E *)
loops.(i).(j).(5) <- true;
pq_add (i, j, i+1, j, [|node_xy; (r + (2*r + dxx)*(i+1)), (r + (2*r + dyy)*j)|], [|node_xy; (2 * (fst node_xy) + r + (2*r + dxx)*(i+1))/3, (2 * (snd node_xy) + r + (2*r + dyy)*j)/3|]) pq (depth+gr.g.(i).(j).edges.(5));
end;
if (i < gr.width-1 && j > 0) && gr.g.(i).(j).edges.(6) <> (-1) && ((i >= 0) && (j >= 0) && (i < gr.width) && (j < gr.height)) && loops.(i).(j).(6) = false then begin (* SE *)
loops.(i).(j).(6) <- true;
pq_add (i, j, i+1, j-1, [|node_xy; (r + (2*r + dxx)*(i+1)), (r + (2*r + dyy)*(j-1))|], [|node_xy; (2 * (fst node_xy) + r + (2*r + dxx)*(i+1))/3, (2 * (snd node_xy) + r + (2*r + dyy)*(j-1))/3|]) pq (depth+gr.g.(i).(j).edges.(6));
end;
if (j > 0) && gr.g.(i).(j).edges.(7) <> (-1) && ((i >= 0) && (j >= 0) && (i < gr.width) && (j < gr.height)) && loops.(i).(j).(7) = false then begin (* S *)
loops.(i).(j).(7) <- true;
pq_add (i, j, i, j-1, [|node_xy; (r + (2*r + dxx)*i), (r + (2*r + dyy)*(j-1))|], [|node_xy; (2 * (fst node_xy) + r + (2*r + dxx)*i)/3, (2 * (snd node_xy) + r + (2*r + dyy)*(j-1))/3|]) pq (depth+gr.g.(i).(j).edges.(7));
end
end;
done;
()
with
| BreakOfLoop -> ignore (Scanf.bscanf Scanf.Scanning.stdin "%d\n" identity) ;;
(* ------------------------------------------------------------*)
(* ------------------------------------------------------------*)
(* ------------------------------------------------------------*)
(* ----------------------- Tests --------------------------- *)
let main r =
Stdlib.print_endline "Enter the width of the graph (use 8 for weighted): ";
let wd = Scanf.bscanf Scanf.Scanning.stdin "%d\n" identity in
if wd <= 0 then failwith "Error : invalid input";
Stdlib.print_endline "Enter the height of the graph (use 6 for weighted): ";
let ht = Scanf.bscanf Scanf.Scanning.stdin "%d\n" identity in
Stdlib.print_endline "Enter the density of the graph (0 ~ 100): ";
let density = ref (Scanf.bscanf Scanf.Scanning.stdin "%d\n" identity) in
if(!density < 0 || !density > 100) then begin
Stdlib.print_endline "Invalid input, will use 50 instead";
density := 50;
end;
if ht <= 0 then failwith "Error : invalid input";
Stdlib.print_endline "Is the grap weighted ? (0/1)";
let is_weighted = Scanf.bscanf Scanf.Scanning.stdin "%d\n" identity in
let weighted = ref false in
if is_weighted = 1 then weighted := true;
Stdlib.print_endline "Enter the mode :\n0 for display\n1 for BFS\n2 for DFS\n3 for Dijkstra\n";
let choice = Scanf.bscanf Scanf.Scanning.stdin "%d\n" identity in
open_graph " 1500x1000" ;
set_window_title "Graphs" ;
let gwd = 1500-r and ght = 1000-r in
let offset_x = (gwd - r)/(wd-1) - 2*r in
let offset_y = (ght - r)/(ht-1) - 2*r in
let type2 = generate_type2_graph wd ht !density 1 60 in
let dt = 0.25 in
if choice = 0 then begin another_type_of_graph_printing type2 r offset_x offset_y !weighted; close_graph () end
else if choice = 1 then begin another_type_of_dfs type2 r offset_x offset_y dt ; close_graph () end
else if choice = 2 then begin another_type_of_bfs type2 r offset_x offset_y gwd ght dt ; close_graph () end
else if choice = 3 then begin another_type_of_dijkstra type2 r offset_x offset_y dt gwd ght ; close_graph () end
else failwith "Error : invalid input";;
main 35;;
(* ----------------------- Tests --------------------------- *)
open_graph " 1200x800" ;;
set_window_title "Graphs" ;;
let generate_full_graph k =
let res = Array.make k [||] in
for i = 0 to k-1 do
res.(i) <- Array.make (k-1) 0
done;
for x = 0 to k-1 do
for y = 0 to k-1 do
if x < y then
res.(x).(y-1) <- y
else if x > y then
res.(x).(y) <- y
done
done;
res ;;
let generate_random_graph k freq =
let res = Array.make k [||] in
for i = 0 to k-1 do
res.(i) <- Array.make (k-1) (-1)
done;
for x = 0 to k-1 do
for y = 0 to k-1 do
if (Random.int 100) < freq then
if x < y then
res.(x).(y-1) <- y
else if x > y then
res.(x).(y) <- y
done
done;
res ;;
let gr = [|[|3; 5; 7|]; [|0|]; [|1; 7; 8|]; [|2; 6; 9; 10|]; [|0; 1; 3|]; [|6; 7|]; [|0; 1; 2|]; [|8|]; [|0; 7; 6|]; [|10; 11|]; [|3; 5; 7|]; [|0; 9|]|] ;;
let fulg = generate_full_graph 16 ;;
let rang = generate_random_graph 9 50 ;;
(*improved_pretty_printing gr 1200 800 50*) ;;
(*improved_pretty_printing fulg 1200 800 25 ;;*)
improved_pretty_printing rang 1200 800 45 ;;
close_graph () ;;
(* compilation command : ocamlfind ocamlc -linkpkg -package unix -linkpkg -package graphics graphs.ml *)