82 lines
2.6 KiB
OCaml
82 lines
2.6 KiB
OCaml
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
|