new Sparse_vec structure, used for vectors with "holes"

util/iheap.ml

@@ -11,13 +11,15 @@
 (*                                                                        *)
 (**************************************************************************)
 
-type t = {heap : int Vec.t; indices : int Vec.t }
+module V = Sparse_vec
 
-let dummy = 0
+type t = {heap : int Vec.t; indices : int V.t }
+
+let _absent_index = -1
 
 let init sz =
-  { heap    =  Vec.init sz (fun i -> i) dummy;
+  { heap    =  Vec.init sz (fun i -> i) 0;
-    indices =  Vec.init sz (fun i -> i) dummy}
+    indices =  V.init sz (fun i -> i) _absent_index}
 
 let left i   = (i lsl 1) + 1 (* i*2 + 1 *)
 let right i  = (i + 1) lsl 1 (* (i+1)*2 *)
@@ -38,12 +40,12 @@ let percolate_up cmp {heap=heap;indices=indices} i =
   let i = ref i in
   while !i <> 0 && cmp x (Vec.get heap !pi) do
     Vec.set heap !i (Vec.get heap !pi);
-    Vec.set indices (Vec.get heap !i) !i;
+    V.set indices (Vec.get heap !i) !i;
     i  := !pi;
     pi := parent !i
   done;
   Vec.set heap !i x;
-  Vec.set indices x !i
+  V.set indices x !i
 
 let percolate_down cmp {heap=heap;indices=indices} i =
   let x = Vec.get heap i in
@@ -59,22 +61,22 @@ let percolate_down cmp {heap=heap;indices=indices} i =
        in
        if not (cmp (Vec.get heap child) x) then raise Exit;
        Vec.set heap !i (Vec.get heap child);
-       Vec.set indices (Vec.get heap !i) !i;
+       V.set indices (Vec.get heap !i) !i;
        i  := child;
        li := left !i;
        ri := right !i
      done;
    with Exit -> ());
   Vec.set heap !i x;
-  Vec.set indices x !i
+  V.set indices x !i
 
-let in_heap s n = n < Vec.size s.indices && Vec.get s.indices n >= 0
+let in_heap s n = n < V.length s.indices && V.get s.indices n >= 0
 
 let decrease cmp s n =
-  assert (in_heap s n); percolate_up cmp s (Vec.get s.indices n)
+  assert (in_heap s n); percolate_up cmp s (V.get s.indices n)
 
 let increase cmp s n =
-  assert (in_heap s n); percolate_down cmp s (Vec.get s.indices n)
+  assert (in_heap s n); percolate_down cmp s (V.get s.indices n)
 
 let filter s filt cmp =
   let j = ref 0 in
@@ -82,10 +84,10 @@ let filter s filt cmp =
   for i = 0 to lim - 1 do
     if filt (Vec.get s.heap i) then begin
       Vec.set s.heap !j (Vec.get s.heap i);
-      Vec.set s.indices (Vec.get s.heap i) !j;
+      V.set s.indices (Vec.get s.heap i) !j;
       incr j;
     end
-    else Vec.set s.indices (Vec.get s.heap i) (-1);
+    else V.set s.indices (Vec.get s.heap i) _absent_index;
   done;
   Vec.shrink s.heap (lim - !j);
   for i = (lim / 2) - 1 downto 0 do
@@ -98,19 +100,19 @@ let is_empty s = Vec.is_empty s.heap
 
 let clear {heap; indices} =
   Vec.clear heap;
-  Vec.clear indices;
+  V.clear indices;
   ()
 
 let insert cmp s n =
   if not (in_heap s n) then
     begin
-      Vec.set_unsafe s.indices n (Vec.size s.heap);
+      V.set s.indices n (Vec.size s.heap);
       Vec.push s.heap n;
-      percolate_up cmp s (Vec.get s.indices n)
+      percolate_up cmp s (V.get s.indices n)
     end
 
 let grow_to_by_double s sz =
-  Vec.grow_to_by_double s.indices sz;
+  V.resize s.indices sz;
   Vec.grow_to_by_double s.heap sz
 
 (*
@@ -131,8 +133,8 @@ let remove_min cmp ({heap=heap; indices=indices} as s) =
   if Vec.size heap=0 then raise Not_found;
   let x = Vec.get heap 0 in
   Vec.set heap 0 (Vec.last heap); (*heap.last()*)
-  Vec.set indices (Vec.get heap 0) 0;
+  V.set indices (Vec.get heap 0) 0;
-  Vec.set indices x (-1);
+  V.set indices x (-1);
   Vec.pop s.heap;
   if Vec.size s.heap > 1 then percolate_down cmp s 0;
   x

util/iheap.mli

@@ -41,7 +41,7 @@ val insert : (int -> int -> bool) -> t -> int -> unit
 (** Insert a new integer into the heap, according to the given comparison *)
 
 val grow_to_by_double: t -> int -> unit
-(** Augment the internal capacity of the heap until it reaches at
+(** Hint: augment the internal capacity of the heap until it reaches at
     least the given integer *)
 
 (*val update : (int -> int -> bool) -> t -> int -> unit*)

util/sparse_vec.ml

@@ -0,0 +1,71 @@
+
+(*
+MSAT is free software, using the Apache license, see file LICENSE
+Copyright 2014 Guillaume Bury
+Copyright 2014 Simon Cruanes
+*)
+
+(** {1 Sparse vector, filled with default value} *)
+
+let _size_too_big()=
+    failwith "Sparse_vec: capacity exceeds maximum array size"
+
+type 'a t = { default : 'a; mutable data : 'a array; mutable sz : int }
+
+let make sz default =
+  if sz > Sys.max_array_length then _size_too_big();
+  { default; sz; data=Array.make sz default; }
+
+let init sz f default =
+    if sz > Sys.max_array_length then _size_too_big();
+    {data = Array.init sz (fun i -> f i); sz ; default}
+
+let length {sz} = sz
+
+let grow_to t new_capa =
+  let data = t.data in
+  let capa = Array.length data in
+  t.data <- Array.init new_capa (fun i -> if i < capa then data.(i) else t.default)
+
+let grow_to_double_size t =
+  if Array.length t.data = Sys.max_array_length then _size_too_big();
+  let size = min Sys.max_array_length (2* Array.length t.data) in
+  grow_to t size
+
+let rec grow_to_by_double t new_capa =
+  if new_capa > Sys.max_array_length then _size_too_big ();
+  let data = t.data in
+  let capa = ref (Array.length data + 1) in
+  while !capa < new_capa do
+      capa := min (2 * !capa) Sys.max_array_length;
+  done;
+  grow_to t !capa
+
+let resize v len =
+  assert (len >= 0);
+  if len <= v.sz
+  then v.sz <- len
+  else (
+    grow_to_by_double v len;
+    v.sz <- len
+  )
+
+let incr v = resize v (v.sz + 1)
+
+let decr v =
+  if v.sz = 0 then invalid_arg "Sparse_vec.decr";
+  resize v (v.sz - 1)
+
+let is_empty {sz} = sz=0
+
+let clear v = v.sz <- 0
+
+let get t i =
+  if i < 0 || i >= t.sz then invalid_arg "Sparse_vec.get";
+  Array.unsafe_get t.data i
+
+let set t i v =
+  if i < 0 || i >= t.sz then invalid_arg "Sparse_vec.set";
+  t.sz <- max t.sz i;
+  Array.unsafe_set t.data i v
+

util/sparse_vec.mli

@@ -0,0 +1,45 @@
+
+(*
+MSAT is free software, using the Apache license, see file LICENSE
+Copyright 2014 Guillaume Bury
+Copyright 2014 Simon Cruanes
+*)
+
+(** {1 Sparse vector, filled with default value} *)
+
+type 'a t
+(** Abstract type of sparse vectors of 'a *)
+
+val make : int -> 'a -> 'a t
+(** [make cap default] creates a new vector filled with [default]. The vector's
+    initial length is [cap] *)
+
+val init : int -> (int -> 'a) -> 'a -> 'a t
+(** Same as {!Array.init}, but also with a default element *)
+
+val length : 'a t -> int
+(** Range of valid indices *)
+
+val resize : 'a t -> int -> unit
+(** Set the length of the array to [i] *)
+
+val incr : 'a t -> unit
+(** Increment length size by one *)
+
+val decr : 'a t -> unit
+(** Decrement length by one *)
+
+val is_empty : 'a t -> bool
+(** Check whether length=0 *)
+
+val clear : 'a t -> unit
+(** Set length to 0 *)
+
+val get : 'a t -> int -> 'a
+(** get the element at the given index, or
+    @raise Invalid_argument if the index is not valid *)
+
+val set : 'a t -> int -> 'a -> unit
+(** set the element at the given index, either already set or the first
+    free slot if [not (is_full vec)], or
+    @raise Invalid_argument if the index is not valid *)

util/vec.mli

@@ -70,6 +70,7 @@ val set : 'a t -> int -> 'a -> unit
     @raise Invalid_argument if the index is not valid *)
 
 val set_unsafe : 'a t -> int -> 'a -> unit
+(* undocumented. TODO remove asap *)
 
 val copy : 'a t -> 'a t
 (** Fresh copy *)