Source file pointSet.ml

(** A PointSet is a set of points in 2d space. Each point has int coordinates and represents
    a square on a chess-like game board (of unspecified/inifinite dimenions)*)

open Knights_tour

include Set.Make(Point)

let of_string image =
  let lines = 
        String.split_on_char '\n' image
        |> List.map String.trim 
  in 
  let points = ref empty in
  lines |> List.iteri (fun y line ->
    line |> String.iteri (fun x c -> match c with
      | '.' | ' ' -> () 
      | _ -> points := add {x;y} !points
    )
  );
  !points

let min_map selector points =
  fold (fun pt acc -> Int.min (selector pt) acc) points Int.max_int

let max_map selector points =
  fold (fun pt acc -> Int.max (selector pt) acc) points Int.min_int
let min_x = min_map (fun p -> p.x)
let max_x = max_map (fun p -> p.x)
let min_y = min_map (fun p -> p.y)
let max_y = max_map (fun p -> p.y)

let%expect_test "min max" =
  let points = of_string "
      .
      ...#
      ..##
      ...#########
      ..."
  in (
    Format.printf "min_x = %d\n" (min_x points);
    Format.printf "max_x = %d\n" (max_x points);
    Format.printf "min_y = %d\n" (min_y points);
    Format.printf "max_y = %d\n" (max_y points);
  )
  ;[%expect{|
    min_x = 2
    max_x = 11
    min_y = 2
    max_y = 4 |}] 
  
let%expect_test "pointset parsed from string image" =
   of_string (
    ".#     
     ##      
     .##"
  ) 
  |> iter (fun {x;y} -> (Format.printf "(%d, %d)\n" x y))
  ;[%expect{|
    (1, 0)
    (0, 1)
    (1, 1)
    (1, 2)
    (2, 2) |}]

let manhatan_distance p1 p2 = 
  let open Point in 
  Int.abs (p1.x - p2.x) + Int.abs (p1.y - p2.y)
 
let is_neighbour p1 p2 = (manhatan_distance p1 p2) = 1
let is_coherent points =
  points |> for_all (fun p -> 
    exists (is_neighbour p) points
  )

let to_string points =
  let image = Buffer.create 60 in
  for y = min_y points to max_y points do 
    for x = min_x points to max_x points do
      Buffer.add_char image (
        if mem {x;y} points then '#' else '.'
      )
    done;
    Buffer.add_char image '\n'
  done;
  Buffer.contents image

let%expect_test "to_string" =
  let points = of_string "
      .
      ...#
      ..##
      ...#########
      ..."
  in print_endline (to_string points)
  ;[%expect{|
    .#........
    ##........
    .######### |}] 

let neighbours Point.{x;y} = Point.[
  { x = x - 1 ; y         };
  { x         ; y = y - 1 };
  { x = x + 1 ; y         };
  { x         ; y = y + 1 }
] |> of_list

let flatmap f points = fold (fun elt acc -> union (f elt) acc) points empty

let adjacent points = 
  let all_neighbours = points |> flatmap neighbours in
  diff all_neighbours points

let%expect_test "adjacent" =
  let input = of_string "
    #
    #
    ##
  " in
  input
  |> adjacent
  |> (fun adjacent -> 
    Printf.printf "org: (%d, %d)\n" (min_x input) (min_y input);
    Printf.printf "adj: (%d, %d)\n" (min_x adjacent) (min_y adjacent);
    Printf.printf "%s\n" (to_string adjacent)
  )
  ;[%expect{|
    org: (0, 1)
    adj: (-1, 0)
    .#..
    #.#.
    #.#.
    #..#
    .##. |}]

let translate (delta : Point.t) = map (fun {x; y} -> {
  x = x + delta.x;
  y = y + delta.y
})

let normalize_translation points =
  let min_x = points |> min_x in
  let min_y = points |> min_y in
  translate {x = -min_x; y = -min_y} points 

let rotate_point Point.{x;y} = Point.{x = -y; y = x}

let mirror_point Point.{x;y} = Point.{y = x; x = y}

let rotate points = map rotate_point points |> normalize_translation
let mirror = map mirror_point
  
let variants ini = 
  let module PointSetSet = Set.Make(struct 
    type nonrec t = t
    let compare = compare 
  end) in
  let open Searchspace in
  (
    int_range 0 1 |=> fun mirror_count ->
    int_range 0 3 |-> fun rot_count -> 
      ini |> normalize_translation
      |> Fun.repeat rot_count rotate 
      |> Fun.repeat mirror_count mirror
  )
  |> Searchspace.to_seq
  |> PointSetSet.of_seq
  |> PointSetSet.to_seq
  |> List.of_seq
  
  
let normalize points = 
  points
  |> variants
  |> List.hd
  
let%expect_test "variants assymetric" =
  of_string
    ".# 
     ##
     .#
     .#"
  |> variants
  |> List.map to_string
  |> List.iter (Format.printf "-------------\n%s")
  ;[%expect{|
    -------------
    ####
    .#..
    -------------
    ####
    ..#.
    -------------
    #.
    ##
    #.
    #.
    -------------
    #.
    #.
    ##
    #.
    -------------
    .#..
    ####
    -------------
    .#
    ##
    .#
    .#
    -------------
    .#
    .#
    ##
    .#
    -------------
    ..#.
    #### |}]

let%expect_test "variants symmetric" = 
  of_string
    ".#
     ###
     .#"
  |> variants
  |> List.map to_string
  |> List.iter (Format.printf "-------------\n%s")
  ;[%expect{|
    -------------
    .#.
    ###
    .#. |}]

  
let%expect_test "normalized rep of variants are equal to one another" =
  let open Printf in
  let vars = of_string
    ".# 
     ##
     .#
     .#"
    |> variants
    |> Array.of_list
  in
    vars |> Array.iteri (fun i1 v1 ->
      printf "%d: " i1;
      vars |> Array.iter (fun v2 ->
        printf "%b " ((compare (normalize v1) (normalize v2)) = 0)
      );
      printf "\n"
    ) ; [%expect{|
      0: true true true true true true true true
      1: true true true true true true true true
      2: true true true true true true true true
      3: true true true true true true true true
      4: true true true true true true true true
      5: true true true true true true true true
      6: true true true true true true true true
      7: true true true true true true true true |}]

let%expect_test "rotate and normalize translation" =
  let points = of_string (
    ".#     
      ##      
      .#
      .#"
  ) in
  for i = 0 to 3 do
    Fun.repeat i rotate points
    |> (fun points -> 
      Printf.printf "=======================\n%!";
      Printf.printf "min_x : %d   min_y : %d\n%!" (min_x points) (min_y points);
      Printf.printf "=======================\n%!";
      Printf.printf "%s\n%!" (to_string points)
    )
  done 
  ; [%expect{|
    =======================
    min_x : 0   min_y : 0
    =======================
    .#
    ##
    .#
    .#

    =======================
    min_x : 0   min_y : 0
    =======================
    ..#.
    ####

    =======================
    min_x : 0   min_y : 0
    =======================
    #.
    #.
    ##
    #.

    =======================
    min_x : 0   min_y : 0
    =======================
    ####
    .#.. |}]