type 'a t = { mask : int; ar : 'a array} (* mask is bitmap of non-empty elements *) (* each 1-bit of mask refers to an element *) (* the number of 1-bits in 'mask lsr (x/31)' gives the array element containing the element x *) let card_byte = let t = Array.make 256 0 in for i = 0 to 255 do for j = 0 to 7 do if (i lsr j) land 1 <> 0 then t.(i) <- t.(i) + 1 done done; t let cardinal_word i = card_byte.(i land 0xFF) + card_byte.((i lsr 8) land 0xFF) + card_byte.((i lsr 16) land 0xFF) + card_byte.((i lsr 24) land 0xFF) let get_i x e = let b = e.mask lsr x in assert (b land 1 <> 0); cardinal_word b let get_word x e = let b = e.(0) lsr x in if b land 1 = 0 then raise Not_found else e.ar.(cardinal_word b) let get_index x e = (* returns coordinates of bit x in e *) let x1, x2 = x / 31, x mod 31 in let b = e.(0) lsr x1 in if b land 1 = 0 then (cardinal_word b + 1, x1, x2, false) else (cardinal_word b, x1, x2, true) let test i x2 = (i lsr x2) land 1 <> 0 let set i x2 = i lor (1 lsl x2) let reset i x2 = i land ((-1) - (1 lsl x2)) let empty = [| 0|] let is_empty e = e = [| 0|] let cardinal e = let n = Array.length e in let res = ref 0 in for i = 1 to n-1 do res := !res + cardinal_word e.(i) done; !res let mem x e = let i, _, x2, present = get_index x e in present && test e.(i) x2 let singleton x = assert (x < 961); let x1, x2 = x / 31, x mod 31 in [| 1 lsl x1; 1 lsl x2 |] let add x e = assert (x < 961); let i, x1, x2, present = get_index x e in if present then if test e.(i) x2 then e else begin let e' = Array.copy e in (* unsafe not to make a copy *) e'.(i) <- set e'.(i) x2; e' end else begin let n = Array.length e in let e' = Array.make (n+1) 0 in e'.(0) <- set e.(0) x1; for k = 1 to i-1 do e'.(k) <- e.(k) done; for k = Array.length e' - 1 downto i+1 do e'.(k) <- e.(k-1) done; e'.(i) <- set 0 x2; e' end let remove x e = let i, x1, x2, present = get_index x e in if present then if test e.(i) x2 then let e'_i = reset e.(i) x2 in if e'_i = 0 then begin let n = Array.length e in let e' = Array.make (n-1) 0 in e'.(0) <- reset e.(0) x1; for k = 1 to i-1 do e'.(k) <- e.(k) done; for k = i to n-2 do e'.(k) <- e.(k+1) done; e' end else begin let e' = Array.copy e in e'.(i) <- e'_i; e' end else e else e let subset e1 e2 = let subset_word i1 i2 = i1 land (lnot i2) = 0 in if not (subset_word e1.(0) e2.(0)) then false else begin let res = ref true in let x1 = ref 0 in while !res && !x1 < 31 do res := test e1.(0) !x1 && subset_word (get_word !x1 e1) (get_word !x1 e2); incr x1 done; !res end let union e1 e2 = let union_word i1 i2 = i1 lor i2 in let e_0 = union_word e1.(0) e2.(0) in let n = cardinal_word e_0 in let e = Array.make (n+1) 0 in e.(0) <- e_0; for x1 = 0 to 31 - 1 do if test e_0 x1 then e.(get_i x1 e) <- union_word (get_word x1 e1) (get_word x1 e2) done; e let inter e1 e2 = let inter_word i1 i2 = i1 land i2 in let e_0 = inter_word e1.(0) e2.(0) in let n = cardinal_word e_0 in let e = Array.make (n+1) 0 in e.(0) <- e_0; for x1 = 31 - 1 downto 0 do if test e.(0) x1 then let e_x1 = inter_word (get_word x1 e1) (get_word x1 e2) in if e_x1 = 0 then e.(0) <- reset e.(0) x1 else e.(get_i x1 e) <- e_x1 done; Array.sub e 0 (1 + cardinal_word e.(0)) (* for removing extra words *) let diff e1 e2 = let diff_word i1 i2 = i1 land (lnot i2) in let e_0 = e1.(0) in let n = cardinal_word e_0 in let e = Array.make (n+1) 0 in e.(0) <- e_0; for x1 = 31 - 1 downto 0 do if test e.(0) x1 then let e_x1 = diff_word (get_word x1 e1) (get_word x1 e2) in if e_x1 = 0 then e.(0) <- reset e.(0) x1 else e.(get_i x1 e) <- e_x1 done; Array.sub e 0 (1 + cardinal_word e.(0)) (* for removing extra words *) let union_r l = List.fold_left (fun res set -> union res set) empty l let inter_r = function | [] -> raise (Invalid_argument "Intset.Bitmap961.inter_r : empty list of sets") | set::sets -> List.fold_right (fun set res -> inter set res) sets set let fold f init e = let res = ref init in for x1 = 0 to 31 - 1 do if test e.(0) x1 then begin let i = get_word x1 e in let x0 = 31 * x1 in for x2 = 0 to 31 - 1 do if test i x2 then begin res := f !res (x0 + x2) end done end done; !res let iter f e = for x1 = 0 to 31 - 1 do if test e.(0) x1 then begin let i = get_word x1 e in let x0 = 31 * x1 in for x2 = 0 to 31 - 1 do if test i x2 then begin f (x0 + x2) end done end done let map f e = fold (fun res x -> f x::res) [] e let filter p e1 = let filter_word x0 i = let res = ref i in for x2 = 0 to 31 - 1 do if test !res x2 && not (p (x0 + x2)) then res := reset !res x2 done; !res in let e_0 = e1.(0) in let n = cardinal_word e_0 in let e = Array.make (n+1) 0 in e.(0) <- e_0; for x1 = 31 - 1 downto 0 do if test e.(0) x1 then let e_x1 = filter_word (31*x1) (get_word x1 e1) in if e_x1 = 0 then e.(0) <- reset e.(0) x1 else e.(get_i x1 e) <- e_x1 done; Array.sub e 0 (1 + cardinal_word e.(0)) (* for removing extra words *) let elements e = List.rev (fold (fun res x -> x::res) [] e) let memory_size e = 2 + Array.length e