module Math.SetCover.BitPosition
         (C, Sized, unpack, singleton, bitPosition) where

import qualified Math.SetCover.BitSet as BitSet
import qualified Math.SetCover.Bit as Bit
import Math.SetCover.Bit ((.&.))

import qualified Data.IntSet as IntSet; import Data.IntSet (IntSet)
import qualified Data.Bits as Bits
import Data.Bits (Bits, shiftR, complement)
import Data.Word (Word8, Word16, Word32, Word64)

import qualified Data.List.HT as ListHT
import qualified Data.List as List
import Data.Maybe.HT (toMaybe)


unpackGen :: (C bits) => BitSet.Set bits -> [Int]
unpackGen :: forall bits. C bits => Set bits -> [Int]
unpackGen = (Set bits -> Int) -> [Set bits] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Set bits -> Int
forall bits. C bits => Set bits -> Int
bitPosition ([Set bits] -> [Int])
-> (Set bits -> [Set bits]) -> Set bits -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set bits -> [Set bits]
forall bits. C bits => Set bits -> [Set bits]
decompose

decompose :: (Bit.C bits) => BitSet.Set bits -> [BitSet.Set bits]
decompose :: forall bits. C bits => Set bits -> [Set bits]
decompose =
   (Set bits -> Maybe (Set bits, Set bits)) -> Set bits -> [Set bits]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
List.unfoldr ((Set bits -> Maybe (Set bits, Set bits))
 -> Set bits -> [Set bits])
-> (Set bits -> Maybe (Set bits, Set bits))
-> Set bits
-> [Set bits]
forall a b. (a -> b) -> a -> b
$ \Set bits
set ->
      Bool -> (Set bits, Set bits) -> Maybe (Set bits, Set bits)
forall a. Bool -> a -> Maybe a
toMaybe (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Set bits -> Bool
forall bits. C bits => Set bits -> Bool
BitSet.null Set bits
set) ((Set bits, Set bits) -> Maybe (Set bits, Set bits))
-> (Set bits, Set bits) -> Maybe (Set bits, Set bits)
forall a b. (a -> b) -> a -> b
$
         let x :: Set bits
x = Set bits -> Set bits
forall bits. C bits => Set bits -> Set bits
BitSet.keepMinimum Set bits
set
         in  (Set bits
x, Set bits -> Set bits -> Set bits
forall bits. C bits => Set bits -> Set bits -> Set bits
BitSet.difference Set bits
set Set bits
x)

{-# INLINE positionMasks #-}
positionMasks :: (Integral bits, Bits bits, Bit.C bits) => [bits]
positionMasks :: forall bits. (Integral bits, Bits bits, C bits) => [bits]
positionMasks =
   (bits -> bits) -> [bits] -> [bits]
forall a b. (a -> b) -> [a] -> [b]
map (bits -> bits
forall a. Bits a => a -> a
complement (bits -> bits) -> (bits -> bits) -> bits -> bits
forall b c a. (b -> c) -> (a -> b) -> a -> c
. bits -> bits -> bits
forall a. Integral a => a -> a -> a
div (-bits
1) (bits -> bits) -> (bits -> bits) -> bits -> bits
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (bits
1bits -> bits -> bits
forall a. Num a => a -> a -> a
+)) ([bits] -> [bits]) -> [bits] -> [bits]
forall a b. (a -> b) -> a -> b
$
   (bits -> Bool) -> [bits] -> [bits]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (bits -> bits -> Bool
forall a. Eq a => a -> a -> Bool
/=bits
0) ([bits] -> [bits]) -> [bits] -> [bits]
forall a b. (a -> b) -> a -> b
$ (bits -> bits) -> bits -> [bits]
forall a. (a -> a) -> a -> [a]
iterate (\bits
w -> bits
wbits -> bits -> bits
forall a. Num a => a -> a -> a
*bits
w) bits
2

{-
Alternative: @bits-extras:Data.Bits.Extras.lowestBitPlus1@
-}
{-# INLINE bitPositionGen #-}
bitPositionGen ::
   (Integral bits, Bits bits, Bit.C bits) => [bits] -> bits -> Int
bitPositionGen :: forall bits.
(Integral bits, Bits bits, C bits) =>
[bits] -> bits -> Int
bitPositionGen [bits]
masks bits
w =
   (bits -> Int -> Int) -> Int -> [bits] -> Int
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
      (\bits
mask Int
acc -> Bool -> Int
forall a. Enum a => a -> Int
fromEnum (bits
mask bits -> bits -> bits
forall bits. C bits => bits -> bits -> bits
.&. bits
w bits -> bits -> Bool
forall a. Eq a => a -> a -> Bool
/= bits
forall bits. C bits => bits
Bit.empty) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
acc)
      Int
0 [bits]
masks

class Bit.C bits => C bits where
   bit :: Int -> bits
   bitPositionPlain :: bits -> Int
   unpack :: BitSet.Set bits -> [Int]

instance C Word8 where
   bit :: Int -> Word8
bit = Int -> Word8
forall a. Bits a => Int -> a
Bits.bit
   bitPositionPlain :: Word8 -> Int
bitPositionPlain = [Word8] -> Word8 -> Int
forall bits.
(Integral bits, Bits bits, C bits) =>
[bits] -> bits -> Int
bitPositionGen [Word8]
forall bits. (Integral bits, Bits bits, C bits) => [bits]
positionMasks
   unpack :: Set Word8 -> [Int]
unpack = Set Word8 -> [Int]
forall bits. C bits => Set bits -> [Int]
unpackGen

instance C Word16 where
   bit :: Int -> Word16
bit = Int -> Word16
forall a. Bits a => Int -> a
Bits.bit
   bitPositionPlain :: Word16 -> Int
bitPositionPlain = [Word16] -> Word16 -> Int
forall bits.
(Integral bits, Bits bits, C bits) =>
[bits] -> bits -> Int
bitPositionGen [Word16]
forall bits. (Integral bits, Bits bits, C bits) => [bits]
positionMasks
   unpack :: Set Word16 -> [Int]
unpack = Set Word16 -> [Int]
forall bits. C bits => Set bits -> [Int]
unpackGen

instance C Word32 where
   bit :: Int -> Word32
bit = Int -> Word32
forall a. Bits a => Int -> a
Bits.bit
   bitPositionPlain :: Word32 -> Int
bitPositionPlain = [Word32] -> Word32 -> Int
forall bits.
(Integral bits, Bits bits, C bits) =>
[bits] -> bits -> Int
bitPositionGen [Word32]
forall bits. (Integral bits, Bits bits, C bits) => [bits]
positionMasks
   unpack :: Set Word32 -> [Int]
unpack = Set Word32 -> [Int]
forall bits. C bits => Set bits -> [Int]
unpackGen

instance C Word64 where
   bit :: Int -> Word64
bit = Int -> Word64
forall a. Bits a => Int -> a
Bits.bit
   bitPositionPlain :: Word64 -> Int
bitPositionPlain = [Word64] -> Word64 -> Int
forall bits.
(Integral bits, Bits bits, C bits) =>
[bits] -> bits -> Int
bitPositionGen [Word64]
forall bits. (Integral bits, Bits bits, C bits) => [bits]
positionMasks
   unpack :: Set Word64 -> [Int]
unpack = Set Word64 -> [Int]
forall bits. C bits => Set bits -> [Int]
unpackGen

instance C Integer where
   bit :: Int -> Integer
bit = Int -> Integer
forall a. Bits a => Int -> a
Bits.bit
   bitPositionPlain :: Integer -> Int
bitPositionPlain =
      Int
-> ([(Int, Integer)] -> (Int, Integer) -> Int)
-> [(Int, Integer)]
-> Int
forall b a. b -> ([a] -> a -> b) -> [a] -> b
ListHT.switchR
         ([Char] -> Int
forall a. HasCallStack => [Char] -> a
error [Char]
"bitPosition: zero Integer")
         (\[(Int, Integer)]
_ (Int
offset,Integer
x) -> Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word64 -> Int
forall bits. C bits => bits -> Int
bitPositionPlain (Integer -> Word64
word64 Integer
x)) ([(Int, Integer)] -> Int)
-> (Integer -> [(Int, Integer)]) -> Integer -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      [Int] -> [Integer] -> [(Int, Integer)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0, Int
64 ..] ([Integer] -> [(Int, Integer)])
-> (Integer -> [Integer]) -> Integer -> [(Int, Integer)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Bool) -> [Integer] -> [Integer]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/=Integer
0) ([Integer] -> [Integer])
-> (Integer -> [Integer]) -> Integer -> [Integer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer) -> Integer -> [Integer]
forall a. (a -> a) -> a -> [a]
iterate ((Integer -> Int -> Integer) -> Int -> Integer -> Integer
forall a b c. (a -> b -> c) -> b -> a -> c
flip Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
shiftR Int
64)
   unpack :: Set Integer -> [Int]
unpack =
      ((Int, Word64) -> [Int]) -> [(Int, Word64)] -> [Int]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Int
offset,Word64
x) -> (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int
offsetInt -> Int -> Int
forall a. Num a => a -> a -> a
+) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ Set Word64 -> [Int]
forall bits. C bits => Set bits -> [Int]
unpack (Word64 -> Set Word64
forall bits. bits -> Set bits
BitSet.Set Word64
x)) ([(Int, Word64)] -> [Int])
-> (Set Integer -> [(Int, Word64)]) -> Set Integer -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      [Int] -> [Word64] -> [(Int, Word64)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0, Int
64 ..] ([Word64] -> [(Int, Word64)])
-> (Set Integer -> [Word64]) -> Set Integer -> [(Int, Word64)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      (Integer -> Word64) -> [Integer] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map (\Integer
w -> Integer -> Word64
word64 (Integer -> Word64) -> Integer -> Word64
forall a b. (a -> b) -> a -> b
$ Integer
w Integer -> Integer -> Integer
forall bits. C bits => bits -> bits -> bits
.&. Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word64
forall a. Bits a => a -> a
complement Word64
0 :: Word64)) ([Integer] -> [Word64])
-> (Set Integer -> [Integer]) -> Set Integer -> [Word64]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      (Integer -> Bool) -> [Integer] -> [Integer]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/=Integer
0) ([Integer] -> [Integer])
-> (Set Integer -> [Integer]) -> Set Integer -> [Integer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer) -> Integer -> [Integer]
forall a. (a -> a) -> a -> [a]
iterate ((Integer -> Int -> Integer) -> Int -> Integer -> Integer
forall a b c. (a -> b -> c) -> b -> a -> c
flip Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
shiftR Int
64) (Integer -> [Integer])
-> (Set Integer -> Integer) -> Set Integer -> [Integer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Integer -> Integer
forall bits. Set bits -> bits
BitSet.getBits

instance C IntSet where
   bit :: Int -> IntSet
bit = Int -> IntSet
IntSet.singleton
   bitPositionPlain :: IntSet -> Int
bitPositionPlain = IntSet -> Int
IntSet.findMin
   unpack :: Set IntSet -> [Int]
unpack = IntSet -> [Int]
IntSet.toList (IntSet -> [Int]) -> (Set IntSet -> IntSet) -> Set IntSet -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set IntSet -> IntSet
forall bits. Set bits -> bits
BitSet.getBits

word64 :: Integer -> Word64
word64 :: Integer -> Word64
word64 = Integer -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral


newtype Size bits = Size Int

class C bits => Sized bits where size :: Size bits
instance Sized Word8  where size :: Size Word8
size = Int -> Size Word8
forall bits. Int -> Size bits
Size Int
8
instance Sized Word16 where size :: Size Word16
size = Int -> Size Word16
forall bits. Int -> Size bits
Size Int
16
instance Sized Word32 where size :: Size Word32
size = Int -> Size Word32
forall bits. Int -> Size bits
Size Int
32
instance Sized Word64 where size :: Size Word64
size = Int -> Size Word64
forall bits. Int -> Size bits
Size Int
64

instance (Sized a, C b) => C (Bit.Sum a b) where
   bit :: Int -> Sum a b
bit = Size a -> Int -> Sum a b
forall a b. (C a, C b) => Size a -> Int -> Sum a b
bitSum Size a
forall bits. Sized bits => Size bits
size
   bitPositionPlain :: Sum a b -> Int
bitPositionPlain = Size a -> Sum a b -> Int
forall a b. (C a, C b) => Size a -> Sum a b -> Int
bitSumPosition Size a
forall bits. Sized bits => Size bits
size
   unpack :: Set (Sum a b) -> [Int]
unpack = Size a -> Set (Sum a b) -> [Int]
forall a b. (C a, C b) => Size a -> Set (Sum a b) -> [Int]
bitSumUnpack Size a
forall bits. Sized bits => Size bits
size

bitSum :: (C a, C b) => Size a -> Int -> Bit.Sum a b
bitSum :: forall a b. (C a, C b) => Size a -> Int -> Sum a b
bitSum (Size Int
offset) Int
pos =
   if Int
pos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
offset
     then a -> b -> Sum a b
forall a b. a -> b -> Sum a b
Bit.Sum (Int -> a
forall bits. C bits => Int -> bits
bit Int
pos) b
forall bits. C bits => bits
Bit.empty
     else a -> b -> Sum a b
forall a b. a -> b -> Sum a b
Bit.Sum a
forall bits. C bits => bits
Bit.empty (Int -> b
forall bits. C bits => Int -> bits
bit (Int -> b) -> Int -> b
forall a b. (a -> b) -> a -> b
$ Int
posInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
offset)

bitSumPosition :: (C a, C b) => Size a -> Bit.Sum a b -> Int
bitSumPosition :: forall a b. (C a, C b) => Size a -> Sum a b -> Int
bitSumPosition (Size Int
offset) (Bit.Sum a
a b
b) =
   if a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall bits. C bits => bits
Bit.empty
     then Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ b -> Int
forall bits. C bits => bits -> Int
bitPositionPlain b
b
     else a -> Int
forall bits. C bits => bits -> Int
bitPositionPlain a
a

bitSumUnpack :: (C a, C b) => Size a -> BitSet.Set (Bit.Sum a b) -> [Int]
bitSumUnpack :: forall a b. (C a, C b) => Size a -> Set (Sum a b) -> [Int]
bitSumUnpack (Size Int
offset) (BitSet.Set (Bit.Sum a
a b
b)) =
   Set a -> [Int]
forall bits. C bits => Set bits -> [Int]
unpack (a -> Set a
forall bits. bits -> Set bits
BitSet.Set a
a) [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Set b -> [Int]
forall bits. C bits => Set bits -> [Int]
unpack (b -> Set b
forall bits. bits -> Set bits
BitSet.Set b
b))

bitPosition :: (C bits) => BitSet.Set bits -> Int
bitPosition :: forall bits. C bits => Set bits -> Int
bitPosition = bits -> Int
forall bits. C bits => bits -> Int
bitPositionPlain (bits -> Int) -> (Set bits -> bits) -> Set bits -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set bits -> bits
forall bits. Set bits -> bits
BitSet.getBits

singleton :: (C bits) => Int -> BitSet.Set bits
singleton :: forall bits. C bits => Int -> Set bits
singleton = bits -> Set bits
forall bits. bits -> Set bits
BitSet.Set (bits -> Set bits) -> (Int -> bits) -> Int -> Set bits
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> bits
forall bits. C bits => Int -> bits
bit