From 712b12d2f1ebdb78f9dbe3315d4a6ff31eb67900 Mon Sep 17 00:00:00 2001
From: Stavros Polymenis <sp@orbitalfox.eu>
Date: Fri, 23 Feb 2018 00:21:57 +0000
Subject: [PATCH] Add Bijection. https://en.wikipedia.org/wiki/Bijection

Discussion:
http://lists.ocaml.org/pipermail/containers-users/2018-February/000042.html
---
 src/data/CCBijection.ml  | 91 ++++++++++++++++++++++++++++++++++++++++
 src/data/CCBijection.mli | 65 ++++++++++++++++++++++++++++
 2 files changed, 156 insertions(+)
 create mode 100644 src/data/CCBijection.ml
 create mode 100644 src/data/CCBijection.mli

diff --git a/src/data/CCBijection.ml b/src/data/CCBijection.ml
new file mode 100644
index 00000000..e3f5dfba
--- /dev/null
+++ b/src/data/CCBijection.ml
@@ -0,0 +1,91 @@
+(* This file is free software, part of containers. See file "license" for more details. *)
+
+(** {1 Bijection} *)
+module type OrderedType = sig
+  type t
+  val compare : t -> t -> int
+end
+
+module type S = sig
+  type t
+  type left
+  type right
+
+  val empty : t
+  val is_empty : t -> bool
+  val add : left -> right -> t -> t
+  val mem : left -> right -> t -> bool
+  val mem_left : left -> t -> bool
+  val mem_right : right -> t -> bool
+  val find_left : left -> t -> right
+  val find_right : right -> t -> left
+  val remove  : left -> right -> t -> t
+  val remove_left : left -> t -> t
+  val remove_right : right -> t -> t
+  val list_left : t -> (left * right) list
+  val list_right : t -> (right * left) list
+end
+
+module Make(L : OrderedType)(R : OrderedType) = struct
+  type left = L.t
+  type right = R.t
+
+  module MapL = Map.Make(L)
+  module MapR = Map.Make(R)
+
+  exception Incoherence of string
+
+  type t = {
+      left : right MapL.t;
+      right : left MapR.t;
+    }
+
+  let empty = {
+      left = MapL.empty;
+      right = MapR.empty;
+    }
+
+  let is_empty m = match MapL.is_empty m.left, MapR.is_empty m.right with
+    | l, r when l = r -> l
+    | l, r -> raise (Incoherence ("is_empty left: " ^ string_of_bool l ^ ", right: " ^ string_of_bool r))
+
+  let add a b m = {
+      left =
+        (try let found = MapR.find b m.right in
+             if L.compare found a <> 0 then MapL.remove found m.left else m.left
+         with Not_found -> m.left)
+        |> MapL.add a b;
+      right =
+        (try let found = MapL.find a m.left in
+             if R.compare found b <> 0 then MapR.remove found m.right else m.right
+         with Not_found -> m.right)
+        |> MapR.add b a;
+    }
+
+  let find_left  key m = MapL.find key m.left
+  let find_right key m = MapR.find key m.right
+
+  let mem left right m = try R.compare right (find_left left m) = 0 with Not_found -> false
+  let mem_left  key m  = MapL.mem key m.left
+  let mem_right key m  = MapR.mem key m.right
+                       
+  let remove a b m =
+    if mem a b m then
+      {
+        left  = MapL.remove a m.left;
+        right = MapR.remove b m.right;
+      }
+    else m
+
+  let remove_left a m =
+    let right = try MapR.remove (find_left a m) m.right with Not_found -> m.right in
+    { right; left  = MapL.remove a m.left  }
+
+  let remove_right b m =
+    let left = try MapL.remove (find_right b m) m.left  with Not_found -> m.left  in
+    { left;  right = MapR.remove b m.right }
+
+  let list_left  m = MapL.bindings m.left
+  let list_right m = MapR.bindings m.right
+
+end
diff --git a/src/data/CCBijection.mli b/src/data/CCBijection.mli
new file mode 100644
index 00000000..8aaf14cb
--- /dev/null
+++ b/src/data/CCBijection.mli
@@ -0,0 +1,65 @@
+(* This file is free software, part of containers. See file "license" for more details. *)
+
+(** {1 Bijection}
+    Represents 1-to-1 mappings between two types. Each element from the "left"
+    is mapped to one "right" value, and conversely.
+
+    @since NEXT_RELEASE *)
+
+module type OrderedType = sig
+  type t
+  val compare : t -> t -> int
+end
+
+module type S = sig
+  type t
+  type left
+  type right
+
+  val empty : t
+
+  val is_empty : t -> bool
+
+  val add : left -> right -> t -> t
+  (** Add [left] and [right] correspondence to bijection such that
+     [left] and [right] are unique in their respective sets and only
+     correspond to each other. *)
+
+  val mem : left -> right -> t -> bool
+  (** Checks both sides for key membership. Can raise [Incoherence of
+     string] but should never happen *)
+
+  val mem_left : left -> t -> bool
+  (** Checks for membership of correspondence using [left] key *)
+
+  val mem_right : right -> t -> bool
+  (** Checks for membership of correspondence using [right] key *)
+
+  val find_left  : left ->  t -> right
+  (** Raises [Not_found] if left is not found *)
+
+  val find_right : right -> t -> left
+  (** Raises [Not_found] if right is not found *)
+
+  val remove : left -> right -> t -> t
+  (** Removes the [left], [right] binding if it exists. Returns the
+     same bijection otherwise. *)
+
+  val remove_left : left -> t -> t
+  (** Remove the binding with [left] key if it exists. Returns the
+     same bijection otheriwse *)
+
+  val remove_right : right -> t -> t
+  (** Remove the binding with [right] key if it exists. Returns the
+     same bijection otheriwse *)
+
+  val list_left : t -> (left * right) list
+  (** returns the bindings as a list of ([left], [right]) values *)
+
+  val list_right : t -> (right * left) list
+  (** returns the bindings as a list of ([right, [left]) values *)
+
+end
+
+module Make(L : OrderedType)(R : OrderedType) : S
+  with type left = L.t and type right = R.t