Initial solution implementation

Slow and hard-wired to a certain size, but I think it works!

bin/main.ml

@@ -1 +1,81 @@
-let () = print_endline "Hello, World!"
+let debugf = Format.ifprintf Format.std_formatter
+
+let pp_card out ((x, y), n) = Format.fprintf out "((%d, %d), %d)" x y n
+
+let intersects ((x1l, y1b), n1) ((x2l, y2b), n2) =
+  let x1r = x1l + n1 in
+  let x2r = x2l + n2 in
+  let y1t = y1b + n1 in
+  let y2t = y2b + n2 in
+  let result = x1l < x2r && x1r > x2l && y1t > y2b && y1b < y2t in
+  begin
+    result
+  end
+
+let rec card_fits size idx placed_cards (x, y) =
+  if x + idx > size then false
+  else if y + idx > size then false
+  else
+    match placed_cards with
+    | [] -> true
+    | h :: t ->
+        if intersects h ((x, y), idx) then false else card_fits size idx t (x, y)
+
+let rec in_card (x, y) cards =
+  match cards with
+  | [] -> false
+  | ((a, b), n) :: t ->
+      if x >= a && x < a + n && y >= b && y < b + n then true
+      else in_card (x, y) t
+
+let next_pos size (x, y) cards =
+  let rec impl x y =
+    if x >= size then impl 0 (y + 1)
+    else if in_card (x, y) cards then impl (x + 1) y
+    else (x, y)
+  in
+  impl (x + 1) y
+
+let pp_pos out (x, y) = Format.fprintf out "(@[%d,@ %d@])" x y
+
+let rec find_solutions_impl cards size n idx current_alloc current_pos = begin
+	debugf "find_solutions_impl:@ @[<hov>%a@ %d@ %d@ %d@ %a@ %a@]@;@?"
+	(Format.pp_print_array Format.pp_print_int) cards
+	size n idx
+	(Format.pp_print_list pp_card) current_alloc
+	pp_pos current_pos;
+
+  if current_pos = (0, size) then current_alloc
+  else if idx = 0 then []
+  else if cards.(idx) = 0 then
+    find_solutions_impl cards size n (idx - 1) current_alloc current_pos
+  else if card_fits size idx current_alloc current_pos then begin
+    Array.set cards idx (cards.(idx) - 1);
+    let new_alloc = (current_pos, idx) :: current_alloc in
+    let new_pos = next_pos size current_pos new_alloc in
+    let alloc = find_solutions_impl cards size n n new_alloc new_pos in
+    Array.set cards idx (cards.(idx) + 1);
+    if List.is_empty alloc then
+    find_solutions_impl cards size n (idx - 1) current_alloc current_pos
+    else alloc
+  end
+  else find_solutions_impl cards size n (idx - 1) current_alloc current_pos
+end
+
+let find_solutions cards size =
+  find_solutions_impl cards size
+    (Array.length cards - 1)
+    (Array.length cards - 1)
+    [] (0, 0)
+
+let n = 8
+let tri_n = (n + 1) * n / 2
+
+(* Cards is an array initialised so that cards[x] = x for x = [0..9].
+
+   These are the cards we need to fit into the square of length tri_n.
+ *)
+let cards = Array.init (n + 1) Fun.id
+let soln = find_solutions cards tri_n
+let () = Format.printf "@[<hov>Base number: %d,@;side length: %d@;" n tri_n
+let () = Format.printf "Solution: %a@]@\n" (Format.pp_print_list pp_card) soln