[auto ekmett@gmail.com**20090405152157 Ignore-this: 72e1d074a904dd50f9de6899c486d595 ] { hunk ./doc/html/monoids/Data-Ring-Semi-BitSet.html 248 +>union :: BitSet a -> BitSet a -> BitSet aintersection :: BitSet a -> BitSet a -> BitSet aOrd (BitSet a)union :: BitSet a -> BitSet a -> BitSet aSourceO(d). May force size to take O(d) if ranges overlap, preserves order of null +
intersection :: BitSet a -> BitSet a -> BitSet aSource
O(d). May force size and null both to take O(d). +,complement -,insert -,delete -,(\\) --- * Construction -,fromList -,fromDistinctAscList --- * Destruction -,toInteger --- * Membership -,member --- * Size -,size -,isComplemented -)where - -importPreludehiding(null,exponent,toInteger) -importData.Bitshiding(complement) -importqualifiedData.BitsasBits -importData.Data -importData.Ring.Semi.Natural -importData.Ring.Semi -importData.Monoid.Reducer -importData.Generator -importData.Ring.Algebra -importText.Read -importText.Show - -dataBitSeta=BS -{_countAtLeast::{-# UNPACK #-}!Int-- ^ A conservative upper bound on the element count. --- If negative, we are complemented with respect to the universe -,_countAtMost::{-# UNPACK #-}!Int-- ^ A conservative lower bound on the element count. +,union +,intersection +,complement +,insert +,delete +,(\\) +-- * Construction +,fromList +,fromDistinctAscList +-- * Destruction +,toInteger +-- * Membership +,member +-- * Size +,size +,isComplemented +)where + +importPreludehiding(null,exponent,toInteger) +importData.Bitshiding(complement) +importqualifiedData.BitsasBits +importData.Data +importData.Ring.Semi.Natural +importData.Ring.Semi +importData.Monoid.Reducer +importData.Generator +importData.Ring.Algebra +importText.Read +importText.Show + +dataBitSeta=BS +{_countAtLeast::{-# UNPACK #-}!Int-- ^ A conservative upper bound on the element count. hunk ./doc/html/monoids/src/Data-Ring-Semi-BitSet.html 70 -,_count::Int-- ^ Lazy element count used when the above two disagree. O(1) environment size -,exponent::{-# UNPACK #-}!Int-- ^ Low water mark. index of the least element potentially in the set. -,_hwm::{-# UNPACK #-}!Int-- ^ High water mark. index of the greatest element potentially in the set. -,mantissa::{-# UNPACK #-}!Integer-- ^ the set of bits starting from the exponent. --- if negative, then we are complmenented with respect to universe -,_universe::(Int,Int)-- ^ invariant: whenever mantissa < 0 => universe = (fromEnum minBound,fromEnum maxBound) -}deriving(Data,Typeable) - --- | Internal smart constructor. Forces count whenever it is pigeonholed. -bs::Int->Int->Int->Int->Int->Integer->(Int,Int)->BitSeta -bs!a!bc!l!h!mu|a==b=BSaaalhmu -|otherwise=BSabclhmu -{-# INLINE bs #-} - --- | /O(d)/ where /d/ is absolute deviation in fromEnum over the set -toList::Enuma=>BitSeta->[a] -toList(BS___lhmu) -|m<0=maptoEnum[ul..max(predl)ul]++toList'l(maptoEnum[min(succh)uh..uh]) -|otherwise=toList'0[] -where -~(ul,uh)=u -toList'::Enuma=>Int->[a]->[a] -toList'!nt|n>h=t -|testBitm(n-l)=toEnumn:toList'(n+1)t -|otherwise=toList'(n+1)t -{-# INLINE toList #-} - --- | /O(1)/ The empty set. Permits /O(1)/ null and size. -empty::BitSeta -empty=BS000000undefined -{-# INLINE empty #-} - --- | /O(1)/ Construct a @BitSet@ with a single element. Permits /O(1)/ null and size -singleton::Enuma=>a->BitSeta -singletonx=BS111ee1undefinedwheree=fromEnumx -{-# INLINE singleton #-} - --- | /O(1|d)/ Is the 'BitSet' empty? May be faster than checking if @'size' == 0@ after union. --- Operations that require a recount are noted. -null::BitSeta->Bool -null(BSabc____) -|a>0=False -|b==0=True -|otherwise=c==0 -{-# INLINE null #-} - --- | /O(1|d)/ The number of elements in the bit set. -size::BitSeta->Int -size(BSabc__m(ul,uh)) -|a==b,m>=0=a -|a==b=uh-ul-a -|m>=0=c -|otherwise=uh-ul-c -{-# INLINE size #-} - --- | /O(d)/ A 'BitSet' containing every member of the enumeration of @a@. -full::(Enuma,Boundeda)=>BitSeta -full=complementempty -{-# INLINE full #-} - --- | /O(d)/ Complements a 'BitSet' with respect to the bounds of @a@. Preserves order of 'null' and 'size' -complement::(Enuma,Boundeda)=>BitSeta->BitSeta -complementr@(BSabclhm_)=BS(Bits.complementb)(Bits.complementa)(Bits.complementc)lh(Bits.complementm)uwhere -u=(fromEnum(minBound`asArgTypeOf`r),fromEnum(maxBound`asArgTypeOf`r)) -{-# INLINE complement #-} - --- | /O(d)/ unsafe internal method: complement a set that has already been complemented at least once. -recomplement::BitSeta->BitSeta -recomplement(BSabclhmu)=BS(Bits.complementb)(Bits.complementa)(Bits.complementc)lh(Bits.complementm)u -{-# INLINE recomplement #-} - --- | /O(d)/ unsafe internal method: complement a set that has already been complemented at least once. -pseudoComplement::BitSeta->(Int,Int)->BitSeta -pseudoComplement(BSabclhm_)u=BS(Bits.complementb)(Bits.complementa)(Bits.complementc)lh(Bits.complementm)u -{-# INLINE pseudoComplement #-} - --- | /O(d * n)/ Make a 'BitSet' from a list of items. -fromList::Enuma=>[a]->BitSeta -fromList=foldrinsertempty -{-# INLINE fromList #-} - --- | /O(d * n)/ Make a 'BitSet' from a distinct ascending list of items -fromDistinctAscList::Enuma=>[a]->BitSeta -fromDistinctAscList[]=empty -fromDistinctAscList(c:cs)=fromDistinctAscList'cs101 -where -l=fromEnumc -fromDistinctAscList'::Enuma=>[a]->Int->Int->Integer->BitSeta -fromDistinctAscList'[]!n!h!m=BSnnnlhmundefined -fromDistinctAscList'(c':cs')!n_!m=fromDistinctAscList'cs'(n+1)h'(setBitm(h'-l)) -where -h'=fromEnumc' -{-# INLINE fromDistinctAscList #-} - --- | /O(d)/ Insert a single element of type @a@ into the 'BitSet'. Preserves order of 'null' and 'size' -insert::Enuma=>a->BitSeta->BitSeta -insertxr@(BSabclhmu) -|m<0,e<l=r -|m<0,e>h=r -|e<l=bs(a+1)(b+1)(c+1)eh(shiftLm(l-e).|.1)u -|e>h=bs(a+1)(b+1)(c+1)lp(setBitmp)u -|testBitmp=r -|otherwise=bs(a+1)(b+1)(c+1)lh(setBitmp)u -where -e=fromEnumx -p=e-l -{-# INLINE insert #-} - --- | /O(d)/ Delete a single item from the 'BitSet'. Preserves order of 'null' and 'size' -delete::Enuma=>a->BitSeta->BitSeta -deletexr@(BSabclhmu) -|m<0,e<l=bs(a+1)(b+1)(c+1)eh(shiftLm(l-e).&.Bits.complement1)u -|m<0,e>h=bs(a+1)(b+1)(c+1)lp(clearBitmp)u -|e<l=r -|e>h=r -|testBitmp=bs(a-1)(b-1)(c-1)lh(clearBitmp)u -|otherwise=r -where -e=fromEnumx -p=e-l -{-# INLINE delete #-} - --- | /O(1)/ Test for membership in a 'BitSet' -member::Enuma=>a->BitSeta->Bool -memberx(BS___lhm_) -|e<l=m<0 -|e>h=m>0 -|otherwise=testBitm(e-l) -where -e=fromEnumx -{-# INLINE member #-} - --- | /O(d)/ convert to an Integer representation. Discards negative elements -toInteger::BitSeta->Integer -toIntegerx=mantissax`shift`exponentx - --- | /O(d)/. May force 'size' to take /O(d)/ if ranges overlap, preserves order of 'null' -union::BitSeta->BitSeta->BitSeta -unionx@(BSabclhmu)y@(BSa'b'c'l'h'm'u') -|l'<l=unionyx-- ensure left side has lower exponent -|b==0=y-- fast empty union -|b'==0=x-- fast empty union -|a==-1=entireu-- fast full union, recomplement obligation met by negative size -|a'==-1=entireu'-- fast full union, recomplement obligation met by negative size -|m<0,m'<0=recomplement(intersection(recomplementx)(recomplementy))-- appeal to intersection, recomplement obligation met by 2s complement -|m'<0=recomplement(pseudoDiff(recomplementy)xu')-- union with complement, recomplement obligation met by 2s complement -|m<0=recomplement(pseudoDiff(recomplementx)yu)-- union with complement, recomplement obligation met by 2s complement -|h<l'=bs(a+a')(b+b')(c+c')lh'm''u-- disjoint positive ranges -|otherwise=bs(a`max`a')(b+b')(recountm'')l(h`max`h')m''u-- overlapped positives -where -m''=m.|.shiftLm'(l'-l) -entire=BS(-1)(-1)(-1)00(-1) - --- | /O(1)/ check to see if we are represented as a complemented 'BitSet'. -isComplemented::BitSeta->Bool -isComplemented=(<0).mantissa - --- | /O(d)/. May force 'size' and 'null' both to take /O(d)/. -intersection::BitSeta->BitSeta->BitSeta -intersectionx@(BSab_lhmu)y@(BSa'b'_l'h'm'u') -|l'<l=intersectionyx -|b==0=empty -|b'==0=empty -|a==-1=y -|a'==-1=x -|m<0,m'<0=recomplement(union(recomplementx)(recomplementy)) -|m'<0=pseudoDiffx(recomplementy)u' -|m<0=pseudoDiffy(recomplementx)u -|h<l'=empty -|otherwise=bs0(b`min`b')(recountm'')l''(h`min`h')m''u -where -l''=maxll' -m''=shiftm(l''-l).&.shiftm'(l''-l') - --- | Unsafe internal method for computing differences in a particular universe of discourse --- preconditions: --- m >= 0, m' >= 0, a /= -1, a' /= -1, b /= 0, b' /= 0, u'' is the universe of discourse -pseudoDiff::BitSeta->BitSeta->(Int,Int)->BitSeta -pseudoDiffx@(BSa__lhm_)(BS_b'_l'h'm'_)u'' -|h<l'=x -|h'<l=x -|otherwise=bs(max(a-b')0)a(recountm'')lhm''u'' -where -m''=m.&.shift(Bits.complementm')(l'-l) - --- | /O(d)/. Preserves order of 'null'. May force /O(d)/ 'size'. -difference::Enuma=>BitSeta->BitSeta->BitSeta -differencex@(BSab___mu)y@(BSa'b'___m'_) -|a==-1=pseudoComplementyu -|a'==-1=empty -|b==0=empty -|b'==0=x -|m<0,m'<0=pseudoDiff(recomplementy)(recomplementx)u -|m<0=pseudoComplement(recomplementx`union`y)u -|m'<0=x`union`recomplementy -|otherwise=pseudoDiffxyu - --- | /O(d)/. Preserves order of 'null'. May force /O(d)/ 'size'. -(\\)::Enuma=>BitSeta->BitSeta->BitSeta -(\\)=difference - -instanceEq(BitSeta)where -x@(BS___l_mu)==y@(BS___l'_m'_) -|signumm==signumm'=shiftm(l-l'')==shiftm'(l-l'') -|m'<0=y==x -|otherwise=mask.&.shiftm(l-ul)==shiftm'(l-ul) -where -l''=minll' -mask=setBit0(uh-ul+1)-1 -ul=fstu -uh=sndu - --- TODO finish -instanceOrd(BitSeta)where -BS___l_m_`compare`BS___l'_m'_=shiftm(l''-l)`compare`shiftm'(l''-l)wherel''=minll' - -instance(Enuma,Boundeda)=>Bounded(BitSeta)where -minBound=empty -maxBound=resultwhere -result=BSnnnlhm(l,h) -n=h-l+1 -l=fromEnum(minBound`asArgTypeOf`result) -h=fromEnum(maxBound`asArgTypeOf`result) -m=setBit0n-1 - --- | Utility function to avoid requiring ScopedTypeVariables -asArgTypeOf::a->fa->a -asArgTypeOf=const -{-# INLINE asArgTypeOf #-} - --- | /O(d)/ -recount::Integer->Int -recount!n -|n<0=Bits.complement(recount(Bits.complementn)) -|otherwise=recount'00 -where -h=hwmn -recount'!i!c -|i>h=c -|otherwise=recount'(i+1)(iftestBitnithenc+1elsec) - --- | /O(d)/. Computes the equivalent of (truncate . logBase 2 . abs) extended with 0 at 0 -hwm::Integer->Int -hwm!n -|n<0=hwm(-n) -|n>1=scanp(2*p) -|otherwise=0 -where -p=probe1 --- incrementally compute 2^(2^(i+1)) until it exceeds n -probe::Int->Int -probe!i -|bit(2*i)>n=i -|otherwise=probe(2*i) - --- then scan the powers for the highest set bit -scan::Int->Int->Int -scan!l!h -|l==h=l -|bit(m+1)>n=scanlm -|otherwise=scan(m+1)h -wherem=l+(h-l)`div`2 - -instance(Enuma,Showa)=>Show(BitSeta)where -showsPrecdx@(BS_____mu) -|m<0=showParen(d>10)$showString"pseudoComplement ".showsPrec11(recomplementx).showString" ".showsPrec11u -|otherwise=showParen(d>10)$showString"fromDistinctAscList ".showsPrec11(toListx) - -instance(Enuma,Reada)=>Read(BitSeta)where -readPrec=parens$complemented+++normalwhere -complemented=prec10$do -Ident"pseudoComplement"<-lexP -x<-stepreadPrec -pseudoComplementx`fmap`stepreadPrec -normal=prec10$do -Ident"fromDistinctAscList"<-lexP -fromDistinctAscList`fmap`stepreadPrec - --- note that operations on values generated by toEnum are pretty slow because the bounds are suboptimal -instance(Enuma,Boundeda)=>Enum(BitSeta)where -fromEnumb@(BS___l_m_)=fromInteger(shiftLm(l-l')) -where -l'=fromEnum(minBound`asArgTypeOf`b) -toEnumi=result -where -result=BSai(recountm)lhmundefined-- n <= 2^n, so i serves as a valid upper bound -l=fromEnum(minBound`asArgTypeOf`result) -h=fromEnum(maxBound`asArgTypeOf`result) -m=fromIntegrali -a|m/=0=1-- allow a fast null check, but not much else -|otherwise=0 - -instanceEnuma=>Monoid(BitSeta)where -mempty=empty -mappend=union - -instanceEnuma=>Reducera(BitSeta)where -unit=singleton -snoc=flipinsert -cons=insert - -instance(Boundeda,Enuma)=>Multiplicative(BitSeta)where -one=full -times=intersection - -instance(Boundeda,Enuma)=>LeftSemiNearRing(BitSeta) -instance(Boundeda,Enuma)=>RightSemiNearRing(BitSeta) -instance(Boundeda,Enuma)=>SemiRing(BitSeta) - --- idempotent monoid -instanceEnuma=>LeftModuleNatural(BitSeta)where -0*._=empty -_*.m=m -instanceEnuma=>RightModuleNatural(BitSeta)where -_.*0=empty -m.*_=m -instanceEnuma=>ModuleNatural(BitSeta) - -instance(Boundeda,Enuma)=>LeftModule(BitSeta)(BitSeta)where(*.)=times -instance(Boundeda,Enuma)=>RightModule(BitSeta)(BitSeta)where(.*)=times -instance(Boundeda,Enuma)=>Module(BitSeta)(BitSeta) - -instance(Boundeda,Enuma)=>AlgebraNatural(BitSeta) - -instanceEnuma=>Generator(BitSeta)where -typeElem(BitSeta)=a -mapReducef=mapReducef.toList +,_countAtMost::{-# UNPACK #-}!Int-- ^ A conservative lower bound on the element count. +-- If negative, we are complemented with respect to the universe +,_count::Int-- ^ Lazy element count used when the above two disagree. O(1) environment size +,exponent::{-# UNPACK #-}!Int-- ^ Low water mark. index of the least element potentially in the set. +,_hwm::{-# UNPACK #-}!Int-- ^ High water mark. index of the greatest element potentially in the set. +,mantissa::{-# UNPACK #-}!Integer-- ^ the set of bits starting from the exponent. +-- if negative, then we are complmenented with respect to universe +,_universe::(Int,Int)-- ^ invariant: whenever mantissa < 0 => universe = (fromEnum minBound,fromEnum maxBound) +}deriving(Data,Typeable) + +-- | Internal smart constructor. Forces count whenever it is pigeonholed. +bs::Int->Int->Int->Int->Int->Integer->(Int,Int)->BitSeta +bs!a!bc!l!h!mu|a==b=BSaaalhmu +|otherwise=BSabclhmu +{-# INLINE bs #-} + +-- | /O(d)/ where /d/ is absolute deviation in fromEnum over the set +toList::Enuma=>BitSeta->[a] +toList(BS___lhmu) +|m<0=maptoEnum[ul..max(predl)ul]++toList'l(maptoEnum[min(succh)uh..uh]) +|otherwise=toList'0[] +where +~(ul,uh)=u +toList'::Enuma=>Int->[a]->[a] +toList'!nt|n>h=t +|testBitm(n-l)=toEnumn:toList'(n+1)t +|otherwise=toList'(n+1)t +{-# INLINE toList #-} + +-- | /O(1)/ The empty set. Permits /O(1)/ null and size. +empty::BitSeta +empty=BS000000undefined +{-# INLINE empty #-} + +-- | /O(1)/ Construct a @BitSet@ with a single element. Permits /O(1)/ null and size +singleton::Enuma=>a->BitSeta +singletonx=BS111ee1undefinedwheree=fromEnumx +{-# INLINE singleton #-} + +-- | /O(1|d)/ Is the 'BitSet' empty? May be faster than checking if @'size' == 0@ after union. +-- Operations that require a recount are noted. +null::BitSeta->Bool +null(BSabc____) +|a>0=False +|b==0=True +|otherwise=c==0 +{-# INLINE null #-} + +-- | /O(1|d)/ The number of elements in the bit set. +size::BitSeta->Int +size(BSabc__m(ul,uh)) +|a==b,m>=0=a +|a==b=uh-ul-a +|m>=0=c +|otherwise=uh-ul-c +{-# INLINE size #-} + +-- | /O(d)/ A 'BitSet' containing every member of the enumeration of @a@. +full::(Enuma,Boundeda)=>BitSeta +full=complementempty +{-# INLINE full #-} + +-- | /O(d)/ Complements a 'BitSet' with respect to the bounds of @a@. Preserves order of 'null' and 'size' +complement::(Enuma,Boundeda)=>BitSeta->BitSeta +complementr@(BSabclhm_)=BS(Bits.complementb)(Bits.complementa)(Bits.complementc)lh(Bits.complementm)uwhere +u=(fromEnum(minBound`asArgTypeOf`r),fromEnum(maxBound`asArgTypeOf`r)) +{-# INLINE complement #-} + +-- | /O(d)/ unsafe internal method: complement a set that has already been complemented at least once. +recomplement::BitSeta->BitSeta +recomplement(BSabclhmu)=BS(Bits.complementb)(Bits.complementa)(Bits.complementc)lh(Bits.complementm)u +{-# INLINE recomplement #-} + +-- | /O(d)/ unsafe internal method: complement a set that has already been complemented at least once. +pseudoComplement::BitSeta->(Int,Int)->BitSeta +pseudoComplement(BSabclhm_)u=BS(Bits.complementb)(Bits.complementa)(Bits.complementc)lh(Bits.complementm)u +{-# INLINE pseudoComplement #-} + +-- | /O(d * n)/ Make a 'BitSet' from a list of items. +fromList::Enuma=>[a]->BitSeta +fromList=foldrinsertempty +{-# INLINE fromList #-} + +-- | /O(d * n)/ Make a 'BitSet' from a distinct ascending list of items +fromDistinctAscList::Enuma=>[a]->BitSeta +fromDistinctAscList[]=empty +fromDistinctAscList(c:cs)=fromDistinctAscList'cs101 +where +l=fromEnumc +fromDistinctAscList'::Enuma=>[a]->Int->Int->Integer->BitSeta +fromDistinctAscList'[]!n!h!m=BSnnnlhmundefined +fromDistinctAscList'(c':cs')!n_!m=fromDistinctAscList'cs'(n+1)h'(setBitm(h'-l)) +where +h'=fromEnumc' +{-# INLINE fromDistinctAscList #-} + +-- | /O(d)/ Insert a single element of type @a@ into the 'BitSet'. Preserves order of 'null' and 'size' +insert::Enuma=>a->BitSeta->BitSeta +insertxr@(BSabclhmu) +|m<0,e<l=r +|m<0,e>h=r +|e<l=bs(a+1)(b+1)(c+1)eh(shiftLm(l-e).|.1)u +|e>h=bs(a+1)(b+1)(c+1)lp(setBitmp)u +|testBitmp=r +|otherwise=bs(a+1)(b+1)(c+1)lh(setBitmp)u +where +e=fromEnumx +p=e-l +{-# INLINE insert #-} + +-- | /O(d)/ Delete a single item from the 'BitSet'. Preserves order of 'null' and 'size' +delete::Enuma=>a->BitSeta->BitSeta +deletexr@(BSabclhmu) +|m<0,e<l=bs(a+1)(b+1)(c+1)eh(shiftLm(l-e).&.Bits.complement1)u +|m<0,e>h=bs(a+1)(b+1)(c+1)lp(clearBitmp)u +|e<l=r +|e>h=r +|testBitmp=bs(a-1)(b-1)(c-1)lh(clearBitmp)u +|otherwise=r +where +e=fromEnumx +p=e-l +{-# INLINE delete #-} + +-- | /O(1)/ Test for membership in a 'BitSet' +member::Enuma=>a->BitSeta->Bool +memberx(BS___lhm_) +|e<l=m<0 +|e>h=m>0 +|otherwise=testBitm(e-l) +where +e=fromEnumx +{-# INLINE member #-} + +-- | /O(d)/ convert to an Integer representation. Discards negative elements +toInteger::BitSeta->Integer +toIntegerx=mantissax`shift`exponentx + +-- | /O(d)/. May force 'size' to take /O(d)/ if ranges overlap, preserves order of 'null' +union::BitSeta->BitSeta->BitSeta +unionx@(BSabclhmu)y@(BSa'b'c'l'h'm'u') +|l'<l=unionyx-- ensure left side has lower exponent +|b==0=y-- fast empty union +|b'==0=x-- fast empty union +|a==-1=entireu-- fast full union, recomplement obligation met by negative size +|a'==-1=entireu'-- fast full union, recomplement obligation met by negative size +|m<0,m'<0=recomplement(intersection(recomplementx)(recomplementy))-- appeal to intersection, recomplement obligation met by 2s complement +|m'<0=recomplement(pseudoDiff(recomplementy)xu')-- union with complement, recomplement obligation met by 2s complement +|m<0=recomplement(pseudoDiff(recomplementx)yu)-- union with complement, recomplement obligation met by 2s complement +|h<l'=bs(a+a')(b+b')(c+c')lh'm''u-- disjoint positive ranges +|otherwise=bs(a`max`a')(b+b')(recountm'')l(h`max`h')m''u-- overlapped positives +where +m''=m.|.shiftLm'(l'-l) +entire=BS(-1)(-1)(-1)00(-1) + +-- | /O(1)/ check to see if we are represented as a complemented 'BitSet'. +isComplemented::BitSeta->Bool +isComplemented=(<0).mantissa + +-- | /O(d)/. May force 'size' and 'null' both to take /O(d)/. +intersection::BitSeta->BitSeta->BitSeta +intersectionx@(BSab_lhmu)y@(BSa'b'_l'h'm'u') +|l'<l=intersectionyx +|b==0=empty +|b'==0=empty +|a==-1=y +|a'==-1=x +|m<0,m'<0=recomplement(union(recomplementx)(recomplementy)) +|m'<0=pseudoDiffx(recomplementy)u' +|m<0=pseudoDiffy(recomplementx)u +|h<l'=empty +|otherwise=bs0(b`min`b')(recountm'')l''(h`min`h')m''u +where +l''=maxll' +m''=shiftm(l''-l).&.shiftm'(l''-l') + +-- | Unsafe internal method for computing differences in a particular universe of discourse +-- preconditions: +-- m >= 0, m' >= 0, a /= -1, a' /= -1, b /= 0, b' /= 0, u'' is the universe of discourse +pseudoDiff::BitSeta->BitSeta->(Int,Int)->BitSeta +pseudoDiffx@(BSa__lhm_)(BS_b'_l'h'm'_)u'' +|h<l'=x +|h'<l=x +|otherwise=bs(max(a-b')0)a(recountm'')lhm''u'' +where +m''=m.&.shift(Bits.complementm')(l'-l) + +-- | /O(d)/. Preserves order of 'null'. May force /O(d)/ 'size'. +difference::Enuma=>BitSeta->BitSeta->BitSeta +differencex@(BSab___mu)y@(BSa'b'___m'_) +|a==-1=pseudoComplementyu +|a'==-1=empty +|b==0=empty +|b'==0=x +|m<0,m'<0=pseudoDiff(recomplementy)(recomplementx)u +|m<0=pseudoComplement(recomplementx`union`y)u +|m'<0=x`union`recomplementy +|otherwise=pseudoDiffxyu + +-- | /O(d)/. Preserves order of 'null'. May force /O(d)/ 'size'. +(\\)::Enuma=>BitSeta->BitSeta->BitSeta +(\\)=difference + +instanceEq(BitSeta)where +x@(BS___l_mu)==y@(BS___l'_m'_) +|signumm==signumm'=shiftm(l-l'')==shiftm'(l-l'') +|m'<0=y==x +|otherwise=mask.&.shiftm(l-ul)==shiftm'(l-ul) +where +l''=minll' +mask=setBit0(uh-ul+1)-1 +ul=fstu +uh=sndu + +-- instance Ord (BitSet a) where +-- BS _ _ _ l _ m _ `compare` BS _ _ _ l' _ m' _ = shift m (l'' - l) `compare` shift m' (l'' - l) where l'' = min l l' + +instance(Enuma,Boundeda)=>Bounded(BitSeta)where +minBound=empty +maxBound=resultwhere +result=BSnnnlhm(l,h) +n=h-l+1 +l=fromEnum(minBound`asArgTypeOf`result) +h=fromEnum(maxBound`asArgTypeOf`result) +m=setBit0n-1 + +-- | Utility function to avoid requiring ScopedTypeVariables +asArgTypeOf::a->fa->a +asArgTypeOf=const +{-# INLINE asArgTypeOf #-} + +-- | /O(d)/ +recount::Integer->Int +recount!n +|n<0=Bits.complement(recount(Bits.complementn)) +|otherwise=recount'00 +where +h=hwmn +recount'!i!c +|i>h=c +|otherwise=recount'(i+1)(iftestBitnithenc+1elsec) + +-- | /O(d)/. Computes the equivalent of (truncate . logBase 2 . abs) extended with 0 at 0 +hwm::Integer->Int +hwm!n +|n<0=hwm(-n) +|n>1=scanp(2*p) +|otherwise=0 +where +p=probe1 +-- incrementally compute 2^(2^(i+1)) until it exceeds n +probe::Int->Int +probe!i +|bit(2*i)>n=i +|otherwise=probe(2*i) + +-- then scan the powers for the highest set bit +scan::Int->Int->Int +scan!l!h +|l==h=l +|bit(m+1)>n=scanlm +|otherwise=scan(m+1)h +wherem=l+(h-l)`div`2 + +instance(Enuma,Showa)=>Show(BitSeta)where +showsPrecdx@(BS_____mu) +|m<0=showParen(d>10)$showString"pseudoComplement ".showsPrec11(recomplementx).showString" ".showsPrec11u +|otherwise=showParen(d>10)$showString"fromDistinctAscList ".showsPrec11(toListx) + +instance(Enuma,Reada)=>Read(BitSeta)where +readPrec=parens$complemented+++normalwhere +complemented=prec10$do +Ident"pseudoComplement"<-lexP +x<-stepreadPrec +pseudoComplementx`fmap`stepreadPrec +normal=prec10$do +Ident"fromDistinctAscList"<-lexP +fromDistinctAscList`fmap`stepreadPrec + +-- note that operations on values generated by toEnum are pretty slow because the bounds are suboptimal +instance(Enuma,Boundeda)=>Enum(BitSeta)where +fromEnumb@(BS___l_m_)=fromInteger(shiftLm(l-l')) +where +l'=fromEnum(minBound`asArgTypeOf`b) +toEnumi=result +where +result=BSai(recountm)lhmundefined-- n <= 2^n, so i serves as a valid upper bound +l=fromEnum(minBound`asArgTypeOf`result) +h=fromEnum(maxBound`asArgTypeOf`result) +m=fromIntegrali +a|m/=0=1-- allow a fast null check, but not much else +|otherwise=0 + +instanceEnuma=>Monoid(BitSeta)where +mempty=empty +mappend=union + +instanceEnuma=>Reducera(BitSeta)where +unit=singleton +snoc=flipinsert +cons=insert + +instance(Boundeda,Enuma)=>Multiplicative(BitSeta)where +one=full +times=intersection + +instance(Boundeda,Enuma)=>LeftSemiNearRing(BitSeta) +instance(Boundeda,Enuma)=>RightSemiNearRing(BitSeta) +instance(Boundeda,Enuma)=>SemiRing(BitSeta) + +-- idempotent monoid +instanceEnuma=>LeftModuleNatural(BitSeta)where +0*._=empty +_*.m=m +instanceEnuma=>RightModuleNatural(BitSeta)where +_.*0=empty +m.*_=m +instanceEnuma=>ModuleNatural(BitSeta) + +instance(Boundeda,Enuma)=>LeftModule(BitSeta)(BitSeta)where(*.)=times +instance(Boundeda,Enuma)=>RightModule(BitSeta)(BitSeta)where(.*)=times +instance(Boundeda,Enuma)=>Module(BitSeta)(BitSeta) + +instance(Boundeda,Enuma)=>AlgebraNatural(BitSeta) + +instanceEnuma=>Generator(BitSeta)where +typeElem(BitSeta)=a +mapReducef=mapReducef.toList }
intersection
1 (Function)2 (Function)