module Math.SetCover.Exact.Block (blocksFromSets) where

import Math.SetCover.EnumMap (constMap)

import qualified Data.List as List
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.Monoid.HT as Mn
import Data.Set (Set)
import Data.Tuple.HT (swap)
import Data.Bits (Bits, bitSize, setBit, shiftL, complement)


blocksFromSets ::
   (Ord a, Num block, Bits block) => [Set a] -> ([[block]], [block])
blocksFromSets :: forall a block.
(Ord a, Num block, Bits block) =>
[Set a] -> ([[block]], [block])
blocksFromSets [Set a]
sets =
   let dummyBlock :: block
dummyBlock = block
0
       blockSize :: Int
blockSize = block -> Int
forall a. Bits a => a -> Int
bitSize block
dummyBlock
       complete :: Set a
complete = [Set a] -> Set a
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions [Set a]
sets
       mapToInt :: Map a Int
mapToInt = [(a, Int)] -> Map a Int
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(a, Int)] -> Map a Int) -> [(a, Int)] -> Map a Int
forall a b. (a -> b) -> a -> b
$ [a] -> [Int] -> [(a, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Set a -> [a]
forall a. Set a -> [a]
Set.toList Set a
complete) [Int
0..]
       blocks :: Set a -> [block]
blocks =
         Int -> [Int] -> [block]
forall block. (Num block, Bits block) => Int -> [Int] -> [block]
blocksFromInts Int
blockSize ([Int] -> [block]) -> (Set a -> [Int]) -> Set a -> [block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         Map a Int -> [Int]
forall k a. Map k a -> [a]
Map.elems (Map a Int -> [Int]) -> (Set a -> Map a Int) -> Set a -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map a Int -> Map a () -> Map a Int
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.intersection Map a Int
mapToInt (Map a () -> Map a Int)
-> (Set a -> Map a ()) -> Set a -> Map a Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Set a -> Map a ()
forall a b. Ord a => b -> Set a -> Map a b
constMap ()
   in  ((Set a -> [block]) -> [Set a] -> [[block]]
forall a b. (a -> b) -> [a] -> [b]
map Set a -> [block]
blocks [Set a]
sets,
        case Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
divMod (Set a -> Int
forall a. Set a -> Int
Set.size Set a
complete) Int
blockSize of
            (Int
numBlocks,Int
remd) ->
               Int -> block -> [block]
forall a. Int -> a -> [a]
replicate Int
numBlocks (block -> block
forall a. Bits a => a -> a
complement block
0 block -> block -> block
forall a. a -> a -> a
`asTypeOf` block
dummyBlock) [block] -> [block] -> [block]
forall a. [a] -> [a] -> [a]
++
               Bool -> [block] -> [block]
forall m. Monoid m => Bool -> m -> m
Mn.when (Int
remdInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
0) [block -> Int -> block
forall a. Bits a => a -> Int -> a
shiftL block
1 Int
remd block -> block -> block
forall a. Num a => a -> a -> a
- block
1])

blocksFromInts :: (Num block, Bits block) => Int -> [Int] -> [block]
blocksFromInts :: forall block. (Num block, Bits block) => Int -> [Int] -> [block]
blocksFromInts Int
blockSize =
   (Int -> [Int] -> block) -> [Int] -> [[Int]] -> [block]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> [Int] -> block
forall block. (Num block, Bits block) => Int -> [Int] -> block
blockFromBits ((Int -> Int) -> Int -> [Int]
forall a. (a -> a) -> a -> [a]
iterate (Int
blockSizeInt -> Int -> Int
forall a. Num a => a -> a -> a
+) Int
0) ([[Int]] -> [block]) -> ([Int] -> [[Int]]) -> [Int] -> [block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Int], [[Int]]) -> [[Int]]
forall a b. (a, b) -> b
snd (([Int], [[Int]]) -> [[Int]])
-> ([Int] -> ([Int], [[Int]])) -> [Int] -> [[Int]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   ([Int] -> [Int] -> ([Int], [[Int]]))
-> [Int] -> [Int] -> ([Int], [[Int]])
forall a b c. (a -> b -> c) -> b -> a -> c
flip (([Int] -> Int -> ([Int], [Int]))
-> [Int] -> [Int] -> ([Int], [[Int]])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
List.mapAccumL (\[Int]
elems Int
pivot -> ([Int], [Int]) -> ([Int], [Int])
forall a b. (a, b) -> (b, a)
swap (([Int], [Int]) -> ([Int], [Int]))
-> ([Int], [Int]) -> ([Int], [Int])
forall a b. (a -> b) -> a -> b
$ (Int -> Bool) -> [Int] -> ([Int], [Int])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
pivot) [Int]
elems))
            ((Int -> Int) -> Int -> [Int]
forall a. (a -> a) -> a -> [a]
iterate (Int
blockSizeInt -> Int -> Int
forall a. Num a => a -> a -> a
+) Int
blockSize)

blockFromBits :: (Num block, Bits block) => Int -> [Int] -> block
blockFromBits :: forall block. (Num block, Bits block) => Int -> [Int] -> block
blockFromBits Int
offset = (block -> Int -> block) -> block -> [Int] -> block
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' block -> Int -> block
forall a. Bits a => a -> Int -> a
setBit block
0 ([Int] -> block) -> ([Int] -> [Int]) -> [Int] -> block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
offset)