3 files changed, 99 insertions(+), 0 deletions(-)

A 8/lex.mll
A 8/t1.ml
A 8/t2.ml

@@ 0,0 1,9 @@
+{
+type token =
+	| Line of string
+	| Eof
+}
+
+rule token = parse
+	| (['0'-'9']+ as s) '\n' { Line s }
+	| eof { Eof }

@@ 0,0 1,42 @@
+open Lex
+
+let int_of_char c = Char.code c - Char.code '0'
+
+let array_of_string s =
+	let fn i = int_of_char (String.get s i) in
+	Array.init (String.length s) fn
+
+let rec f lexbuf =
+	match Lex.token lexbuf with
+	| Eof -> []
+	| Line l -> array_of_string l :: f lexbuf
+
+let indexify arr =
+	let fn = (fun i -> Array.init (Array.length arr) (fun j -> arr.(i).(j), (i, j))) in
+	Array.init (Array.length (arr.(0))) fn
+
+let transpose arr =
+	let fn = (fun i -> Array.init (Array.length arr) (fun j -> arr.(j).(i))) in
+	Array.init (Array.length (arr.(0))) fn
+
+module PairSet = Set.Make(
+	struct
+		type t = int * int
+		let compare = compare
+	end
+)
+
+let count arr =
+	let merge (c, m) (a, pos) =
+		if m < a then (PairSet.add pos c, a) else (c, m) in
+	let swap f a b = f b a in
+	let left = Array.fold_left merge (PairSet.empty, -1) arr |> fst
+	and right = Array.fold_right (swap merge) arr (PairSet.empty, -1) |> fst in
+	PairSet.union left right
+
+let () =
+	let arr = stdin |> Lexing.from_channel |> f |> Array.of_list |> indexify in
+	let app = Array.fold_left (fun c a -> PairSet.union c (count a)) PairSet.empty in
+	PairSet.union (app arr) (app (transpose arr))
+		|> PairSet.cardinal
+		|> Printf.printf "%d\n"

@@ 0,0 1,48 @@
+open Lex
+
+let int_of_char c = Char.code c - Char.code '0'
+
+let array_of_string s =
+	let fn i = int_of_char (String.get s i) in
+	Array.init (String.length s) fn
+
+let rec f lexbuf =
+	match Lex.token lexbuf with
+	| Eof -> []
+	| Line l -> array_of_string l :: f lexbuf
+
+let indexify arr =
+	let fn = (fun i -> Array.init (Array.length arr) (fun j -> arr.(i).(j), (i, j))) in
+	Array.init (Array.length (arr.(0))) fn
+
+let transpose arr =
+	let fn = (fun i -> Array.init (Array.length arr) (fun j -> arr.(j).(i))) in
+	Array.init (Array.length (arr.(0))) fn
+
+let arr = stdin |> Lexing.from_channel |> f |> Array.of_list
+let results = ref (Array.make_matrix (Array.length arr) (Array.length arr.(0)) 1)
+
+let dists arr =
+	let rec merge l (a, (y, x)) =
+		match l with
+		| [] ->
+				!results.(y).(x) <- 0;
+				[a, x]
+		| (h, _) :: es when h < a ->
+				merge es (a, (y, x))
+		| (h, x') :: es ->
+				!results.(y).(x) <- !results.(y).(x) * (0 + abs (x - x'));
+				(a, x) :: (h, x') :: es
+	in
+	let swap f a b = f b a in
+	Array.fold_left merge [10, 0] arr |> ignore;
+	Array.fold_right (swap merge) arr [10, Array.length arr - 1] |> ignore;
+	()
+
+let () =
+	Array.iter dists (arr |> indexify);
+	results := transpose !results;
+	Array.iter dists (arr |> transpose |> indexify);
+	!results
+		|> Array.fold_left (fun a b -> max a (Array.fold_left max 0 b)) 0
+		|> Printf.printf "%d\n"