| 1 | % (c) 2025-2025 Lehrstuhl fuer Softwaretechnik und Programmiersprachen, | |
| 2 | % Heinrich Heine Universitaet Duesseldorf | |
| 3 | % This software is licenced under EPL 1.0 (http://www.eclipse.org/org/documents/epl-v10.html) | |
| 4 | ||
| 5 | :- module(bit_sets,[ordlist_to_bitset/2, bitset_to_ordlist/2, | |
| 6 | member_bitset/2, | |
| 7 | empty_bit_set/1, | |
| 8 | bitset_union/3, bitset_intersection/3]). | |
| 9 | ||
| 10 | :- use_module(module_information). | |
| 11 | :- module_info(group,kernel). | |
| 12 | :- module_info(description,'This module packs and upacks sets as integers.'). | |
| 13 | ||
| 14 | % uses less memory | |
| 15 | % intersection and union are faster | |
| 16 | % membership is slower | |
| 17 | ||
| 18 | empty_bit_set(0). | |
| 19 | ||
| 20 | ordlist_to_bitset(ListOfInts,Integer) :- | |
| 21 | pack_list_aux(ListOfInts,0,Integer). | |
| 22 | ||
| 23 | % Note: until max_tagged_pow2(MaxBound) this will result in a tagged integer; otherwise we get multi-precision ints | |
| 24 | pack_list_aux([],A,A). | |
| 25 | pack_list_aux([Nr|T],Acc,Res) :- | |
| 26 | NewAcc is Acc \/ (1<<Nr), | |
| 27 | pack_list_aux(T,NewAcc,Res). | |
| 28 | ||
| 29 | bitset_to_ordlist(PackedInteger,ResList) :- | |
| 30 | unpack_fd_set_aux(PackedInteger,0,ResList). | |
| 31 | ||
| 32 | unpack_fd_set_aux(0,_,Res) :- !, Res=[]. | |
| 33 | %xunpack_fd_set_aux(Nr,X,Res) :- | |
| 34 | % M is Nr mod 4, | |
| 35 | % ( (M=1 ; M=3) -> Res = [X|T] ; Res=T), | |
| 36 | % ( (M=0 ; M=1) | |
| 37 | % -> X1 is X+2, Nr1 is (Nr>>2) | |
| 38 | % ; X1 is X+1, Nr1 is (Nr>>1) | |
| 39 | % ), | |
| 40 | % unpack_fd_set_aux(Nr1,X1,T). | |
| 41 | ||
| 42 | unpack_fd_set_aux(Nr,X,Res) :- Nr mod 32 =:= 0,!, | |
| 43 | X1 is X+5, Nr1 is (Nr>>5), | |
| 44 | unpack_fd_set_aux(Nr1,X1,Res). | |
| 45 | unpack_fd_set_aux(Nr,X,Res) :- Nr mod 8 =:= 0,!, | |
| 46 | X1 is X+3, Nr1 is (Nr>>3), | |
| 47 | unpack_fd_set_aux(Nr1,X1,Res). | |
| 48 | unpack_fd_set_aux(Nr,X,Res) :- | |
| 49 | (Nr mod 2 =:= 1 -> Res = [X|T] ; Res=T), | |
| 50 | X1 is X+1, Nr1 is (Nr>>1), | |
| 51 | unpack_fd_set_aux(Nr1,X1,T). | |
| 52 | ||
| 53 | bitset_intersection(BSet1,BSet2,Inter) :- | |
| 54 | Inter is BSet1 /\ BSet2. | |
| 55 | ||
| 56 | bitset_union(BSet1,BSet2,Inter) :- | |
| 57 | Inter is BSet1 \/ BSet2. | |
| 58 | ||
| 59 | member_bitset(Nr,BitSet) :- integer(Nr),!, | |
| 60 | member_grchk_bitset(Nr,BitSet). | |
| 61 | %member_bitset(Nr,BitSet) :- bitset_to_ordlist(BitSet,OL), member(Nr,OL). % strange: seems slightly faster? | |
| 62 | member_bitset(Nr,BitSet) :- | |
| 63 | ? | mem_bitset_aux(Nr,0,BitSet). |
| 64 | ||
| 65 | mem_bitset_aux(Nr,Index,BitSet) :- BitSet mod 32 =:= 0,!, BitSet \= 0, B1 is BitSet >> 5, I1 is Index+5, | |
| 66 | ? | mem_bitset_aux(Nr,I1,B1). |
| 67 | mem_bitset_aux(Nr,Index,BitSet) :- BitSet mod 8 =:= 0,!, BitSet \= 0, B1 is BitSet >> 3, I1 is Index+3, | |
| 68 | ? | mem_bitset_aux(Nr,I1,B1). |
| 69 | mem_bitset_aux(Nr,Index,BitSet) :- BitSet mod 2 =:= 1, Nr=Index. | |
| 70 | mem_bitset_aux(Nr,Index,BitSet) :- BitSet \= 0, B1 is BitSet >> 1, I1 is Index+1, | |
| 71 | ? | mem_bitset_aux(Nr,I1,B1). |
| 72 | ||
| 73 | % check if a ground Nr is element of a bitset | |
| 74 | member_grchk_bitset(Nr,BitSet) :- | |
| 75 | 0 =\= BitSet /\ (1<<Nr). | |
| 76 | ||
| 77 | % use_module(probsrc(bit_sets)), ordlist_to_bitset([1,10,20],B1), bitset_intersection(B1,B1,B2), bitset_to_ordlist(B2,L2), member_bitset(N,B2). | |
| 78 | ||
| 79 | ||
| 80 | test(N) :- L = [1,20,21,23, 44,50,51], | |
| 81 | tools:start_ms_timer(T1), | |
| 82 | t1(N,L,R), | |
| 83 | tools:stop_ms_timer_with_msg(T1,test1_inter(N,R)), | |
| 84 | ordlist_to_bitset(L,B), | |
| 85 | tools:start_ms_timer(T1b), | |
| 86 | t1bs(N,B,RBS), bitset_to_ordlist(RBS,R1BS), | |
| 87 | tools:stop_ms_timer_with_msg(T1b,test1_bitset(N,RBS,R1BS)), | |
| 88 | tools:start_ms_timer(T2), | |
| 89 | t2(N,L,R2), | |
| 90 | tools:stop_ms_timer_with_msg(T2,test2_member(N,R2)), | |
| 91 | tools:start_ms_timer(T2b), | |
| 92 | t2bs(N,B,R22), | |
| 93 | tools:stop_ms_timer_with_msg(T2b,test2_bitset(N,R22)). | |
| 94 | ||
| 95 | t1(0,A,A) :- !. | |
| 96 | t1(N,A,R) :- ordsets:ord_intersection(A,A,A1), ordsets:ord_intersection(A1,A1,A2), | |
| 97 | N1 is N-1, t1(N1,A2,R). | |
| 98 | t1bs(0,A,A) :- !. | |
| 99 | t1bs(N,A,R) :- bitset_intersection(A,A,A1), bitset_intersection(A1,A1,A2), | |
| 100 | N1 is N-1, t1bs(N1,A2,R). | |
| 101 | % use_module(probsrc(bit_sets)), bit_sets:test(100000). | |
| 102 | % Runtime for test1(1000000,[1,20,21,23,44,50,51]): 442 ms (with gc: 476 ms, walltime: 478 ms); since start: 2 h 15 min 18 sec 395 ms | |
| 103 | % Runtime for test1_bitset(1000000,3395291918106626,[1,20,21,23,44,50,51]): 34 ms (with gc: 34 ms, walltime: 34 ms); since start: 2 h 15 min 18 sec 429 ms | |
| 104 | ||
| 105 | t2(0,A,R) :- member(R,A),!. | |
| 106 | t2(N,A,R) :- (member(I,A), I=N -> true ; true), | |
| 107 | N1 is N-1, t2(N1,A,R). | |
| 108 | t2bs(0,A,R) :- member_bitset(R,A),!. | |
| 109 | t2bs(N,A,R) :- (member_bitset(I,A), I=N -> true ; true), | |
| 110 | N1 is N-1, t2bs(N1,A,R). | |
| 111 | ||
| 112 | % Runtime for test2_member(1000000,1): 149 ms (with gc: 149 ms, walltime: 149 ms); since start: 3 h 29 min 29 sec 541 ms | |
| 113 | % Runtime for test2_bitset(1000000,1): 1896 ms (with gc: 1896 ms, walltime: 1903 ms); since start: 3 h 29 min 31 sec 444 ms |