myers_diff.ml

open Base

module Make (Eq : sig
    type t

    val equal : t -> t -> bool
  end) =
struct
  type operation = Delete of int | Insert of int [@@deriving show]

  (* pos means vertex in the grid not the subscript of inputs *)
  (* i from 0 to lena; j from 0 to lenb *)
  type markup = {operations: operation list; pos: int * int}

  let search arra arrb =
    let la = Array.length arra in
    let lb = Array.length arrb in
    let rec walk_diagonal (i, j) =
      if i < la && j < lb && Eq.equal arra.(i) arrb.(j) then
        walk_diagonal (i + 1, j + 1)
      else (i, j)
    in
    (* operations count: from 0 to lena + lenb *)
    let markups =
      Array.init (la + lb + 1) ~f:(fun d -> Hashtbl.create (module Int))
    in
    let aux d k =
      let juest_deleted =
        match Hashtbl.find markups.(d - 1) (k - 1) with
        | Some {operations; pos= i, j} when i < la ->
          Some
            { operations= Delete (i + 1) :: operations
            ; pos= walk_diagonal (i + 1, j) }
        | _ ->
          None
      in
      let just_inserted =
        match Hashtbl.find markups.(d - 1) (k + 1) with
        | Some {operations; pos= i, j} when j < lb ->
          Some
            { operations= Insert (j + 1) :: operations
            ; pos= walk_diagonal (i, j + 1) }
        | _ ->
          None
      in
      match (juest_deleted, just_inserted) with
      | Some ({pos= ia, ja} as md), Some ({pos= ib, jb} as mi) ->
        (* we prefer more deletion *)
        Some (if ia - 1 >= ib then md else mi)
      | Some m, None | None, Some m ->
        Some m
      | None, None ->
        None
    in
    let rec find (d, k) =
      if d > la + lb then failwith "Wrong implementation."
      else
        match aux d k with
        | Some {operations; pos= i, j} when i = la && j = lb ->
          operations
        | Some ({operations; pos= i, j} as result) ->
          Hashtbl.set markups.(d) ~key:k ~data:result ;
          (* the longest common subsequence determines a unique i, j pair *)
          (* for each d, k varents from -d, -d + 2, ..., d - 2, d *)
          find (if k > -d then (d, k - 2) else (d + 1, d + 1))
        | None ->
          find (if k > -d then (d, k - 2) else (d + 1, d + 1))
    in
    match walk_diagonal (0, 0) with
    | i, j when i = la && j = lb ->
      []
    | pos ->
      Hashtbl.set markups.(0) ~key:0 ~data:{operations= []; pos} ;
      find (1, 1)

  let get_operations lista listb =
    let arra = Array.of_list lista and arrb = Array.of_list listb in
    search arra arrb |> List.rev
end