Commits

camlspotter committed 37536e6

added a version with session cache

Comments (0)

Files changed (2)

         get (get matrix m) n
 end
 
+(** With inter-query cache by hashtbl *)
+
+type result = 
+  | Exact of int
+  | GEQ of int (* the result is culled by upper_bound. We know it is GEQ to this value *)
+
+exception No_cache 
+
+module type WithCache = sig
+  type t
+  module Cache : Hashtbl.S with type key = t * t
+  val distance : result Cache.t -> ?upper_bound: int -> t -> t -> int
+end
+
+module MakeWithCache(A : sig 
+  type t
+  type elem
+  val compare : elem -> elem -> int
+  val get : t -> int -> elem
+  val size : t -> int
+    
+  module Pair : sig
+    val equal : (t*t) -> (t*t) -> bool
+    val hash : (t*t) -> int
+  end
+end) = struct
+
+  type t = A.t
+
+  module Cache = Hashtbl.Make(struct
+    type t = A.t * A.t
+    include A.Pair
+  end)
+
+  module WithoutCache = Make(A)
+
+  let distance cache ?(upper_bound=max_int) xs ys =
+    (* This accesses the hashtbl twice with the same key,
+       but OCaml's stdlib provides no good way... 
+    *)
+    let k = (xs, ys) in
+    try
+      begin match try Some (Cache.find cache k) with Not_found -> None with
+      | Some (Exact res) when res > upper_bound -> GEQ upper_bound
+      | Some (Exact res) -> Exact res
+      | Some (GEQ res) when res >= upper_bound -> GEQ upper_bound
+      | None (* no cache *)
+      | Some (GEQ _) (* inaccurate with this upper_bound *) ->
+          let res = 
+            let res = WithoutCache.distance ~upper_bound xs ys in
+            if res >= upper_bound then GEQ upper_bound
+            else Exact res
+          in
+          Cache.add cache k res;
+          res
+      end 
+      |> function
+          | Exact n -> n
+          | GEQ n   -> n
+    with
+    | No_cache -> WithoutCache.distance ~upper_bound xs ys
+end
+
+module StringWithCache = MakeWithCache(struct
+  type t = string
+  type elem = char
+  let compare (c1 : char) c2 = compare c1 c2
+  let get = String.unsafe_get
+  let size = String.length
+  module Pair = struct
+    let equal = (=)
+    let hash = Hashtbl.hash
+  end
+end)
+
 module String = struct
 
   include Make(struct
 
 end) : S with type t = A.t
 
+(** With inter-query cache by hashtbl *)
+
+(** Cached result *)
+type result = 
+  | Exact of int
+  | GEQ of int (** the result is culled by upper_bound. We know it is GEQ to this value *)
+
+exception No_cache 
+(** An exception used to skip caching. See WithCache *)
+
+module type WithCache = sig
+  type t
+  module Cache : Hashtbl.S with type key = t * t
+  val distance : result Cache.t -> ?upper_bound: int -> t -> t -> int
+end
+
+module MakeWithCache
+  (A : sig
+    (* these are the same as the Make's argument *)
+    type t
+    type elem
+    val compare : elem -> elem -> int
+    val get : t -> int -> elem
+    val size : t -> int
+
+    module Pair : sig
+      val equal : (t*t) -> (t*t) -> bool
+      val hash : (t*t) -> int
+    end
+  end) : WithCache with type t = A.t
+
 module String : S with type t = string
 
+module StringWithCache : WithCache with type t = string