divide-and-conquer.ml

(* https://www.infoq.com/presentations/Thinking-Parallel-Programming *)

open Printf
let (=>) left right = printf "%c" (if left = right then '.' else 'F')

let print_list list = printf "[%s]" (String.concat "; " list)
let sprint_list list = sprintf "[%s]" (String.concat "; " list)


module Cat = struct
  type 'a t =
    | List of 'a list
    | Append of 'a t * 'a t

  let of_list l = List l

  let append t1 t2 = Append (t1, t2)

  let rec find predicate = function
    | List l -> List.find_opt predicate l
    | Append (left, right) ->
        match find predicate left with
        | None -> find predicate right
        | result -> result

  let rec head = find (fun _ -> true)

  let rec fold_right f a = function
    | List l -> List.fold_right f l a
    | Append (t1, t2) -> fold_right f (fold_right f a t2) t1

  let to_list = fold_right List.cons []

  let map_to_list f = fold_right (fun head tail -> f head :: tail) []

  let filter_to_list predicate =
    fold_right (fun head tail ->
      if predicate head then head :: tail else tail) []


  let rec fold ~list ~append = function
    | List l -> list l
    | Append (t1, t2) ->
        let left = fold t1 ~list ~append in
        let right = fold t2 ~list ~append in
        append left right

  let length = fold ~list:List.length ~append:(+)
  let iter f = fold ~list:(List.iter f) ~append:(fun _ _ -> ())

  let map f = fold ~list:(fun l -> List (List.map f l)) ~append

  let filter predicate =
    fold ~list:(fun l -> List (List.filter predicate l)) ~append

  let map f t = List (map_to_list f t)

  let filter predicate t = List (filter_to_list predicate t)
end


let (@) = Cat.append

let xy = Cat.of_list ["x"; "y"]
let ab = Cat.of_list ["a"; "b"]
let abxy = Cat.append ab xy
let abab = Cat.append ab ab
let abxyabxy = Cat.append abxy abxy
let abababxy = Cat.append abab abxy

let ab = Cat.of_list ["a"; "b"]
let cd = Cat.of_list ["c"; "d"]
let ef = Cat.of_list ["e"; "f"]
let gh = Cat.of_list ["g"; "h"]
let abcdefgh = (ab @ cd) @ (ef @ gh)

module Test = struct
  Cat.to_list abxyabxy => ["a"; "b"; "x"; "y"; "a"; "b"; "x"; "y"];

  Cat.map_to_list String.uppercase_ascii abxyabxy
    => ["A"; "B"; "X"; "Y"; "A"; "B"; "X"; "Y"];

  Cat.length abxyabxy => 8;

  Cat.find ((<) "f") abcdefgh => Some "g";

  Cat.head abcdefgh => Some "a";
end









open StdLabels




module Slice = struct
  type t = {string: string; index: int; length: int}

  let of_string string = {string; index=0; length=String.length string}

  let slice t ~start ~length =
    assert (start >= 0 && length >= 0);
    assert (start + length <= t.length);
    let index = t.index + start in
    {t with index; length}

  let divide t =
    let middle = t.length / 2 in
    let left = {t with length=middle} in
    let right = {t with index=t.index + middle; length=t.length - middle} in
    left, right

  let to_string {string; index; length} =
    String.sub string ~pos:index ~len:length


  module Test = struct
    let s = of_string "foo bar baz qux" in

    slice s ~start:4 ~length:0 |> to_string => "";
    slice s ~start:4 ~length:7 |> to_string => "bar baz";
    slice s ~start:0 ~length:15 |> to_string => "foo bar baz qux";

    let left, right = divide s in
    left |> to_string => "foo bar";
    right |> to_string => " baz qux";
  end
end


module Words = struct

  let conquer slice =

  let rec divide_and_conquer slice =
    if slice.length < 10 then
      conquer slice
    else
      let left, right = Slice.divide slice in
      Cat.append (divide_and_conquer left) (divide_and_conquer right)

  let parse string =
     let slice = Slice.of_string string in
     let cat = divide_and_conquer slice in
     Cat.to_list cat

end