Tidy up code

We work through the code giving more sensible names to variables and
commenting where necessary.

bin/main.ml

@@ -1,92 +1,144 @@
 (*let debugf = Format.ifprintf Format.std_formatter*)
 
-let pp_card out ((x, y), n) = Format.fprintf out "((%d, %d), %d)" x y n
+type pos = int * int
+(** A position on the grid, pair of x, y co-ordinates *)
 
-let intersects ((x1l, y1b), n1) ((x2l, y2b), n2) =
+(** Pretty print a position to Format.formatter [out] *)
-  let x1r = x1l + n1 in
+let pp_pos out ((x, y) : pos) = Format.fprintf out "(%d,@ %d)" x y
-  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) =
+(** Get the x co-ordinate of a position *)
-  if x + idx > size then false
+let pos_x = fst
-  else if y + idx > size then false
+
-  else
+(** Get the y co-ordinate of a position *)
-    match placed_cards with
+let pos_y = snd
+
+type square = { pos : pos; length : int }
+(** A type representing a square, consisitng of the bottom-left corner of the
+    square and the length of each side. *)
+
+(** Pretty print a square to Format.formatter [out] *)
+let pp_square out (sq : square) =
+  Format.fprintf out "{%a@ len:%d}" pp_pos sq.pos sq.length
+
+(** Returns true if the squares [sq1] and [sq2] intersect, and false otherwise.
+*)
+let intersects sq1 sq2 =
+  let sq1l = pos_x sq1.pos in
+  let sq1r = sq1.length + sq1l in
+  let sq1b = pos_y sq1.pos in
+  let sq1t = sq1.length + sq1b in
+  let sq2l = pos_x sq2.pos in
+  let sq2r = sq2.length + sq2l in
+  let sq2b = pos_y sq2.pos in
+  let sq2t = sq2.length + sq2b in
+  sq1l < sq2r && sq1r > sq2l && sq1t > sq2b && sq1b < sq2t
+
+(** Returns true if we can place the square [sq] without overlapping any already
+    placed squares in [sqs] and without exceeding the bounds of the grid which
+    is [length] along each side. *)
+let square_fits sq length sqs =
+  let rec impl sq sqs =
+    match sqs with
     | [] -> true
-    | h :: t ->
+    | h :: t -> if intersects h sq then false else impl sq t
-        if intersects h ((x, y), idx) then false else card_fits size idx t (x, y)
+  in
+  if pos_x sq.pos + sq.length > length then false
+  else if pos_y sq.pos + sq.length > length then false
+  else impl sq sqs
 
-let rec in_card (x, y) cards =
+(** Returns true if the position [(x, y)] is in one of the squares [sqs]. *)
-  match cards with
+let rec in_squares ((x, y) : pos) sqs =
+  match sqs with
   | [] -> false
-  | ((a, b), n) :: t ->
+  | h :: t ->
-      if x >= a && x < a + n && y >= b && y < b + n then true
+      let sqx = pos_x h.pos in
-      else in_card (x, y) t
+      let sqy = pos_y h.pos in
+      let len = h.length in
+      if x >= sqx && x < sqx + len && y >= sqy && y < sqy + len then true
+      else in_squares (x, y) t
 
-let next_pos size (x, y) cards =
+(** Returns the next position to consider when working through the grid we are
+    placing squares on. [(x, y)] is the current position, and [sqs] is a list of
+    already placed squares.
+
+    Returns (0, length) when we have filled the grid. *)
+let next_pos length ((x, y) : pos) sqs =
+  (* We basically walk along each row looking for an empty space. *)
   let rec impl x y =
-    if x >= size then impl 0 (y + 1)
+    if x >= length then impl 0 (y + 1)
-    else if in_card (x, y) cards then impl (x + 1) y
+    else if in_squares (x, y) sqs 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 triangle_num n = n * (n + 1) / 2
 
-let rec find_solutions_impl cards size n idx current_alloc current_pos =
+(** Find a solution to the [n]th Partridge problem. Returns a list of squares
-  begin
+    giving the position on the grid. *)
-    (*debugf "find_solutions_impl:@ @[<hov>%a@ %d@ %d@ %d@ %a@ %a@]@;@?"
+let find_solution n =
-	(Format.pp_print_array Format.pp_print_int) cards
+  (* recursive implementation:
-	size n idx
+
-	(Format.pp_print_list pp_card) current_alloc
+	   [avail_sqs] is an array where avail_sqs.(x) returns how many sqs of size 
-	pp_pos current_pos;*)
+	   x are available to be placed.  [length] is the side length of the grid
-    if current_pos = (0, size) then current_alloc
+	   we are placing the squares into.
+
+	   [impl idx pos sqs] implements the recursive implementation.  [idx] is the
+	   current index in [avail_sqs] that we are looking at.
+
+	   If there is a square available of size [idx] (i.e. avail_sqs.(idx) > 0) 
+	   then we try to place a square of size [idx] at [pos].  If this is
+	   successful it adds that to the list [sqs] and tries to find a square that
+	   fits in the next position.
+
+	   If [impl] is not successful it tries again at the current position with
+	   a square of size [idx - 1].
+
+	   If we reach an [idx] of 0 we have failed and return an empty list.
+
+	   If we reach the position [(0, length)] we have succeeded and return [sqs].
+
+	*)
+  let avail_sqs = Array.init (n + 1) Fun.id in
+  let length = triangle_num n in
+  let rec impl idx pos sqs =
+    let sq = { pos; length = idx } in
+    if pos = (0, length) then sqs
     else if idx = 0 then []
-    else if cards.(idx) = 0 then
+    else if avail_sqs.(idx) = 0 then impl (idx - 1) pos sqs
-      find_solutions_impl cards size n (idx - 1) current_alloc current_pos
+    else if square_fits sq length sqs then begin
-    else if card_fits size idx current_alloc current_pos then begin
+      Array.set avail_sqs idx (avail_sqs.(idx) - 1);
-      Array.set cards idx (cards.(idx) - 1);
+      let new_sqs = sq :: sqs in
-      let new_alloc = (current_pos, idx) :: current_alloc in
+      let new_pos = next_pos length pos new_sqs in
-      let new_pos = next_pos size current_pos new_alloc in
+      let result = impl n new_pos new_sqs in
-      let alloc = find_solutions_impl cards size n n new_alloc new_pos in
+      Array.set avail_sqs idx (avail_sqs.(idx) + 1);
-      Array.set cards idx (cards.(idx) + 1);
+      if List.is_empty result then impl (idx - 1) pos sqs else result
-      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
+    else impl (idx - 1) pos sqs
-  end
-
-let find_solutions cards size =
-  find_solutions_impl cards size
-    (Array.length cards - 1)
-    (Array.length cards - 1)
-    [] (0, 0)
-
-exception Overlapping_value
-
-let print_solution size cards =
-  let array = Array.make (size * size) '.' in
-  let set_pos x y c =
-    if array.(x + (y * size)) <> '.' then raise Overlapping_value
-    else Array.set array (x + (y * size)) c
   in
-  let rec write_size x y n =
+  impl n (0, 0) []
+
+(** Exception raised if we find we have overlapping squares when printing the
+    solution. *)
+exception Overlapping_squares of pos
+
+(** Print the layout given in [sqs] for a grid with side-length [size]. *)
+let print_solution length sqs =
+  let array = Array.make (length * length) '.' in
+  let set_pos x y c =
+    if array.(x + (y * length)) <> '.' then raise (Overlapping_squares (x, y))
+    else Array.set array (x + (y * length)) c
+  in
+  let rec write_length x y n =
     if n = 0 then ()
     else begin
-      Array.set array (x + (y * size)) (Char.chr (48 + (n mod 10)));
+      Array.set array (x + (y * length)) (Char.chr (48 + (n mod 10)));
-      write_size (x - 1) y (n / 10)
+      write_length (x - 1) y (n / 10)
     end
   in
-  let rec impl cards =
+  let rec impl sqs =
-    match cards with
+    match sqs with
     | [] -> ()
-    | ((x, y), n) :: t -> begin
+    | { pos = x, y; length = n } :: t -> begin
         if n = 1 then set_pos x y '*'
         else if n = 2 then begin
           set_pos x y '+';
@@ -108,28 +160,23 @@ let print_solution size cards =
             set_pos x (y + a) '|';
             set_pos (x + n - 1) (y + a) '|'
           done;
-          write_size (x + n - 2) (y + 1) n
+          write_length (x + n - 2) (y + 1) n
         end;
         impl t
       end
   in
-  impl cards;
+  impl sqs;
-  for y = 0 to size - 1 do
+  for y = 0 to length - 1 do
-    for x = 0 to size - 1 do
+    for x = 0 to length - 1 do
-      Format.printf "%c" array.(x + (y * size))
+      Format.printf "%c" array.(x + (y * length))
     done;
     Format.printf "\n"
   done
 
 let n = 8
-let tri_n = (n + 1) * n / 2
+let tri_n = triangle_num n
 
-(* Cards is an array initialised so that cards[x] = x for x = [0..9].
+let soln = find_solution n
-
-   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
+let () = Format.printf "Solution: %a@]@\n" (Format.pp_print_list pp_square) soln
 let () = print_solution tri_n soln