module Math.SetCover.Exact (
Assign(..), assign,
bitVectorFromSetAssigns, intSetFromSetAssigns,
partitions, search, step,
State(..), initState, updateState,
Set(..),
Tree(..), decisionTree, completeTree,
Choose(..),
) where
import qualified Math.SetCover.BitMap as BitMap
import qualified Math.SetCover.BitSet as BitSet
import qualified Math.SetCover.Bit as Bit
import Math.SetCover.EnumMap (constMap)
import Control.Applicative ((<$>), (<$))
import qualified Data.IntSet as IntSet
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.List.Match as Match
import qualified Data.List as List
import qualified Data.Foldable as Fold
import Data.Function.HT (compose2)
import Data.Maybe.HT (toMaybe)
import Data.Tuple.HT (mapFst, mapSnd)
import Data.Bits (setBit)
import Prelude hiding (null)
class Set set where
null :: set -> Bool
disjoint :: set -> set -> Bool
unions :: [set] -> set
difference :: set -> set -> set
minimize :: set -> [Assign label set] -> [Assign label set]
class Set set => Choose set where
chooseMinimize :: set -> [Assign label set] -> (set, [Assign label set])
instance (Ord a) => Set (Set.Set a) where
null :: Set a -> Bool
null = Set a -> Bool
forall a. Set a -> Bool
Set.null
disjoint :: Set a -> Set a -> Bool
disjoint Set a
x Set a
y = Set a -> Bool
forall a. Set a -> Bool
Set.null (Set a -> Bool) -> Set a -> Bool
forall a b. (a -> b) -> a -> b
$ Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection Set a
x Set a
y
unions :: [Set a] -> Set a
unions = [Set a] -> Set a
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions
difference :: Set a -> Set a -> Set a
difference = Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.difference
minimize :: forall label.
Set a -> [Assign label (Set a)] -> [Assign label (Set a)]
minimize Set a
free = ([Assign label (Set a)] -> [Assign label (Set a)] -> Ordering)
-> Map a [Assign label (Set a)] -> [Assign label (Set a)]
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
Fold.minimumBy [Assign label (Set a)] -> [Assign label (Set a)] -> Ordering
forall a b. [a] -> [b] -> Ordering
Match.compareLength (Map a [Assign label (Set a)] -> [Assign label (Set a)])
-> ([Assign label (Set a)] -> Map a [Assign label (Set a)])
-> [Assign label (Set a)]
-> [Assign label (Set a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> [Assign label (Set a)] -> Map a [Assign label (Set a)]
forall k label.
Ord k =>
Set k -> [Assign label (Set k)] -> Map k [Assign label (Set k)]
histogramSet Set a
free
instance (Ord a) => Choose (Set.Set a) where
chooseMinimize :: forall label.
Set a -> [Assign label (Set a)] -> (Set a, [Assign label (Set a)])
chooseMinimize Set a
free =
(a -> Set a)
-> (a, [Assign label (Set a)]) -> (Set a, [Assign label (Set a)])
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst a -> Set a
forall a. a -> Set a
Set.singleton ((a, [Assign label (Set a)]) -> (Set a, [Assign label (Set a)]))
-> ([Assign label (Set a)] -> (a, [Assign label (Set a)]))
-> [Assign label (Set a)]
-> (Set a, [Assign label (Set a)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
((a, [Assign label (Set a)])
-> (a, [Assign label (Set a)]) -> Ordering)
-> [(a, [Assign label (Set a)])] -> (a, [Assign label (Set a)])
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
List.minimumBy (([Assign label (Set a)] -> [Assign label (Set a)] -> Ordering)
-> ((a, [Assign label (Set a)]) -> [Assign label (Set a)])
-> (a, [Assign label (Set a)])
-> (a, [Assign label (Set a)])
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
compose2 [Assign label (Set a)] -> [Assign label (Set a)] -> Ordering
forall a b. [a] -> [b] -> Ordering
Match.compareLength (a, [Assign label (Set a)]) -> [Assign label (Set a)]
forall a b. (a, b) -> b
snd) ([(a, [Assign label (Set a)])] -> (a, [Assign label (Set a)]))
-> ([Assign label (Set a)] -> [(a, [Assign label (Set a)])])
-> [Assign label (Set a)]
-> (a, [Assign label (Set a)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Map a [Assign label (Set a)] -> [(a, [Assign label (Set a)])]
forall k a. Map k a -> [(k, a)]
Map.toList (Map a [Assign label (Set a)] -> [(a, [Assign label (Set a)])])
-> ([Assign label (Set a)] -> Map a [Assign label (Set a)])
-> [Assign label (Set a)]
-> [(a, [Assign label (Set a)])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> [Assign label (Set a)] -> Map a [Assign label (Set a)]
forall k label.
Ord k =>
Set k -> [Assign label (Set k)] -> Map k [Assign label (Set k)]
histogramSet Set a
free
histogramSet ::
Ord k =>
Set.Set k ->
[Assign label (Set.Set k)] ->
Map.Map k [Assign label (Set.Set k)]
histogramSet :: forall k label.
Ord k =>
Set k -> [Assign label (Set k)] -> Map k [Assign label (Set k)]
histogramSet Set k
free =
(Map k [Assign label (Set k)]
-> Map k [Assign label (Set k)] -> Map k [Assign label (Set k)])
-> Map k [Assign label (Set k)]
-> [Map k [Assign label (Set k)]]
-> Map k [Assign label (Set k)]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (([Assign label (Set k)]
-> [Assign label (Set k)] -> [Assign label (Set k)])
-> Map k [Assign label (Set k)]
-> Map k [Assign label (Set k)]
-> Map k [Assign label (Set k)]
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith [Assign label (Set k)]
-> [Assign label (Set k)] -> [Assign label (Set k)]
forall a. [a] -> [a] -> [a]
(++)) ([Assign label (Set k)] -> Set k -> Map k [Assign label (Set k)]
forall a b. Ord a => b -> Set a -> Map a b
constMap [] Set k
free) ([Map k [Assign label (Set k)]] -> Map k [Assign label (Set k)])
-> ([Assign label (Set k)] -> [Map k [Assign label (Set k)]])
-> [Assign label (Set k)]
-> Map k [Assign label (Set k)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Assign label (Set k) -> Map k [Assign label (Set k)])
-> [Assign label (Set k)] -> [Map k [Assign label (Set k)]]
forall a b. (a -> b) -> [a] -> [b]
map (\Assign label (Set k)
a -> [Assign label (Set k)] -> Set k -> Map k [Assign label (Set k)]
forall a b. Ord a => b -> Set a -> Map a b
constMap [Assign label (Set k)
a] (Set k -> Map k [Assign label (Set k)])
-> Set k -> Map k [Assign label (Set k)]
forall a b. (a -> b) -> a -> b
$ Assign label (Set k) -> Set k
forall label set. Assign label set -> set
labeledSet Assign label (Set k)
a)
instance (Ord k, Set set) => Set (Map.Map k set) where
null :: Map k set -> Bool
null = Map k set -> Bool
forall k a. Map k a -> Bool
Map.null
disjoint :: Map k set -> Map k set -> Bool
disjoint Map k set
x Map k set
y = Map k Bool -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
Fold.and (Map k Bool -> Bool) -> Map k Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (set -> set -> Bool) -> Map k set -> Map k set -> Map k Bool
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith set -> set -> Bool
forall set. Set set => set -> set -> Bool
disjoint Map k set
x Map k set
y
unions :: [Map k set] -> Map k set
unions =
([set] -> set) -> Map k [set] -> Map k set
forall a b. (a -> b) -> Map k a -> Map k b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [set] -> set
forall set. Set set => [set] -> set
unions (Map k [set] -> Map k set)
-> ([Map k set] -> Map k [set]) -> [Map k set] -> Map k set
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map k [set] -> Map k [set] -> Map k [set])
-> Map k [set] -> [Map k [set]] -> Map k [set]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (([set] -> [set] -> [set])
-> Map k [set] -> Map k [set] -> Map k [set]
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith [set] -> [set] -> [set]
forall a. [a] -> [a] -> [a]
(++)) Map k [set]
forall k a. Map k a
Map.empty ([Map k [set]] -> Map k [set])
-> ([Map k set] -> [Map k [set]]) -> [Map k set] -> Map k [set]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map k set -> Map k [set]) -> [Map k set] -> [Map k [set]]
forall a b. (a -> b) -> [a] -> [b]
map ((set -> [set]) -> Map k set -> Map k [set]
forall a b. (a -> b) -> Map k a -> Map k b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (set -> [set] -> [set]
forall a. a -> [a] -> [a]
:[]))
difference :: Map k set -> Map k set -> Map k set
difference =
(set -> set -> Maybe set) -> Map k set -> Map k set -> Map k set
forall k a b.
Ord k =>
(a -> b -> Maybe a) -> Map k a -> Map k b -> Map k a
Map.differenceWith
(\set
x set
y -> let z :: set
z = set -> set -> set
forall set. Set set => set -> set -> set
difference set
x set
y in Bool -> set -> Maybe set
forall a. Bool -> a -> Maybe a
toMaybe (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ set -> Bool
forall set. Set set => set -> Bool
null set
z) set
z)
minimize :: forall label.
Map k set
-> [Assign label (Map k set)] -> [Assign label (Map k set)]
minimize Map k set
free =
(Assign (Assign label (Map k set)) set -> Assign label (Map k set))
-> [Assign (Assign label (Map k set)) set]
-> [Assign label (Map k set)]
forall a b. (a -> b) -> [a] -> [b]
map Assign (Assign label (Map k set)) set -> Assign label (Map k set)
forall label set. Assign label set -> label
label ([Assign (Assign label (Map k set)) set]
-> [Assign label (Map k set)])
-> ([Assign label (Map k set)]
-> [Assign (Assign label (Map k set)) set])
-> [Assign label (Map k set)]
-> [Assign label (Map k set)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Assign (Assign label (Map k set)) set]
-> [Assign (Assign label (Map k set)) set] -> Ordering)
-> Map k [Assign (Assign label (Map k set)) set]
-> [Assign (Assign label (Map k set)) set]
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
Fold.minimumBy [Assign (Assign label (Map k set)) set]
-> [Assign (Assign label (Map k set)) set] -> Ordering
forall a b. [a] -> [b] -> Ordering
Match.compareLength (Map k [Assign (Assign label (Map k set)) set]
-> [Assign (Assign label (Map k set)) set])
-> ([Assign label (Map k set)]
-> Map k [Assign (Assign label (Map k set)) set])
-> [Assign label (Map k set)]
-> [Assign (Assign label (Map k set)) set]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(set
-> [Assign (Assign label (Map k set)) set]
-> [Assign (Assign label (Map k set)) set])
-> Map k set
-> Map k [Assign (Assign label (Map k set)) set]
-> Map k [Assign (Assign label (Map k set)) set]
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith set
-> [Assign (Assign label (Map k set)) set]
-> [Assign (Assign label (Map k set)) set]
forall label. set -> [Assign label set] -> [Assign label set]
forall set label.
Set set =>
set -> [Assign label set] -> [Assign label set]
minimize Map k set
free (Map k [Assign (Assign label (Map k set)) set]
-> Map k [Assign (Assign label (Map k set)) set])
-> ([Assign label (Map k set)]
-> Map k [Assign (Assign label (Map k set)) set])
-> [Assign label (Map k set)]
-> Map k [Assign (Assign label (Map k set)) set]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k set
-> [Assign label (Map k set)]
-> Map k [Assign (Assign label (Map k set)) set]
forall k set label.
(Ord k, Set set) =>
Map k set
-> [Assign label (Map k set)]
-> Map k [Assign (Assign label (Map k set)) set]
histogramMap Map k set
free
instance (Ord k, Choose set) => Choose (Map.Map k set) where
chooseMinimize :: forall label.
Map k set
-> [Assign label (Map k set)]
-> (Map k set, [Assign label (Map k set)])
chooseMinimize Map k set
free =
(\(k
k,(set
minSet,[Assign (Assign label (Map k set)) set]
asns)) -> (k -> set -> Map k set
forall k a. k -> a -> Map k a
Map.singleton k
k set
minSet, (Assign (Assign label (Map k set)) set -> Assign label (Map k set))
-> [Assign (Assign label (Map k set)) set]
-> [Assign label (Map k set)]
forall a b. (a -> b) -> [a] -> [b]
map Assign (Assign label (Map k set)) set -> Assign label (Map k set)
forall label set. Assign label set -> label
label [Assign (Assign label (Map k set)) set]
asns)) ((k, (set, [Assign (Assign label (Map k set)) set]))
-> (Map k set, [Assign label (Map k set)]))
-> ([Assign label (Map k set)]
-> (k, (set, [Assign (Assign label (Map k set)) set])))
-> [Assign label (Map k set)]
-> (Map k set, [Assign label (Map k set)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
((k, (set, [Assign (Assign label (Map k set)) set]))
-> (k, (set, [Assign (Assign label (Map k set)) set])) -> Ordering)
-> [(k, (set, [Assign (Assign label (Map k set)) set]))]
-> (k, (set, [Assign (Assign label (Map k set)) set]))
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
List.minimumBy (([Assign (Assign label (Map k set)) set]
-> [Assign (Assign label (Map k set)) set] -> Ordering)
-> ((k, (set, [Assign (Assign label (Map k set)) set]))
-> [Assign (Assign label (Map k set)) set])
-> (k, (set, [Assign (Assign label (Map k set)) set]))
-> (k, (set, [Assign (Assign label (Map k set)) set]))
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
compose2 [Assign (Assign label (Map k set)) set]
-> [Assign (Assign label (Map k set)) set] -> Ordering
forall a b. [a] -> [b] -> Ordering
Match.compareLength ((set, [Assign (Assign label (Map k set)) set])
-> [Assign (Assign label (Map k set)) set]
forall a b. (a, b) -> b
snd((set, [Assign (Assign label (Map k set)) set])
-> [Assign (Assign label (Map k set)) set])
-> ((k, (set, [Assign (Assign label (Map k set)) set]))
-> (set, [Assign (Assign label (Map k set)) set]))
-> (k, (set, [Assign (Assign label (Map k set)) set]))
-> [Assign (Assign label (Map k set)) set]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(k, (set, [Assign (Assign label (Map k set)) set]))
-> (set, [Assign (Assign label (Map k set)) set])
forall a b. (a, b) -> b
snd)) ([(k, (set, [Assign (Assign label (Map k set)) set]))]
-> (k, (set, [Assign (Assign label (Map k set)) set])))
-> ([Assign label (Map k set)]
-> [(k, (set, [Assign (Assign label (Map k set)) set]))])
-> [Assign label (Map k set)]
-> (k, (set, [Assign (Assign label (Map k set)) set]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k (set, [Assign (Assign label (Map k set)) set])
-> [(k, (set, [Assign (Assign label (Map k set)) set]))]
forall k a. Map k a -> [(k, a)]
Map.toList (Map k (set, [Assign (Assign label (Map k set)) set])
-> [(k, (set, [Assign (Assign label (Map k set)) set]))])
-> ([Assign label (Map k set)]
-> Map k (set, [Assign (Assign label (Map k set)) set]))
-> [Assign label (Map k set)]
-> [(k, (set, [Assign (Assign label (Map k set)) set]))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(set
-> [Assign (Assign label (Map k set)) set]
-> (set, [Assign (Assign label (Map k set)) set]))
-> Map k set
-> Map k [Assign (Assign label (Map k set)) set]
-> Map k (set, [Assign (Assign label (Map k set)) set])
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith set
-> [Assign (Assign label (Map k set)) set]
-> (set, [Assign (Assign label (Map k set)) set])
forall label.
set -> [Assign label set] -> (set, [Assign label set])
forall set label.
Choose set =>
set -> [Assign label set] -> (set, [Assign label set])
chooseMinimize Map k set
free (Map k [Assign (Assign label (Map k set)) set]
-> Map k (set, [Assign (Assign label (Map k set)) set]))
-> ([Assign label (Map k set)]
-> Map k [Assign (Assign label (Map k set)) set])
-> [Assign label (Map k set)]
-> Map k (set, [Assign (Assign label (Map k set)) set])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k set
-> [Assign label (Map k set)]
-> Map k [Assign (Assign label (Map k set)) set]
forall k set label.
(Ord k, Set set) =>
Map k set
-> [Assign label (Map k set)]
-> Map k [Assign (Assign label (Map k set)) set]
histogramMap Map k set
free
histogramMap ::
(Ord k, Set set) =>
Map.Map k set ->
[Assign label (Map.Map k set)] ->
Map.Map k [Assign (Assign label (Map.Map k set)) set]
histogramMap :: forall k set label.
(Ord k, Set set) =>
Map k set
-> [Assign label (Map k set)]
-> Map k [Assign (Assign label (Map k set)) set]
histogramMap Map k set
free =
(Map k [Assign (Assign label (Map k set)) set]
-> Map k [Assign (Assign label (Map k set)) set]
-> Map k [Assign (Assign label (Map k set)) set])
-> Map k [Assign (Assign label (Map k set)) set]
-> [Map k [Assign (Assign label (Map k set)) set]]
-> Map k [Assign (Assign label (Map k set)) set]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (([Assign (Assign label (Map k set)) set]
-> [Assign (Assign label (Map k set)) set]
-> [Assign (Assign label (Map k set)) set])
-> Map k [Assign (Assign label (Map k set)) set]
-> Map k [Assign (Assign label (Map k set)) set]
-> Map k [Assign (Assign label (Map k set)) set]
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith [Assign (Assign label (Map k set)) set]
-> [Assign (Assign label (Map k set)) set]
-> [Assign (Assign label (Map k set)) set]
forall a. [a] -> [a] -> [a]
(++)) ([] [Assign (Assign label (Map k set)) set]
-> Map k set -> Map k [Assign (Assign label (Map k set)) set]
forall a b. a -> Map k b -> Map k a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Map k set
free) ([Map k [Assign (Assign label (Map k set)) set]]
-> Map k [Assign (Assign label (Map k set)) set])
-> ([Assign label (Map k set)]
-> [Map k [Assign (Assign label (Map k set)) set]])
-> [Assign label (Map k set)]
-> Map k [Assign (Assign label (Map k set)) set]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Assign label (Map k set)
-> Map k [Assign (Assign label (Map k set)) set])
-> [Assign label (Map k set)]
-> [Map k [Assign (Assign label (Map k set)) set]]
forall a b. (a -> b) -> [a] -> [b]
map (\Assign label (Map k set)
asn -> (Assign (Assign label (Map k set)) set
-> [Assign (Assign label (Map k set)) set]
-> [Assign (Assign label (Map k set)) set]
forall a. a -> [a] -> [a]
:[]) (Assign (Assign label (Map k set)) set
-> [Assign (Assign label (Map k set)) set])
-> (set -> Assign (Assign label (Map k set)) set)
-> set
-> [Assign (Assign label (Map k set)) set]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Assign label (Map k set)
-> set -> Assign (Assign label (Map k set)) set
forall label set. label -> set -> Assign label set
assign Assign label (Map k set)
asn (set -> [Assign (Assign label (Map k set)) set])
-> Map k set -> Map k [Assign (Assign label (Map k set)) set]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Assign label (Map k set) -> Map k set
forall label set. Assign label set -> set
labeledSet Assign label (Map k set)
asn)
instance (Bit.C a) => Set (BitSet.Set a) where
null :: Set a -> Bool
null = Set a -> Bool
forall a. C a => Set a -> Bool
BitSet.null
disjoint :: Set a -> Set a -> Bool
disjoint = Set a -> Set a -> Bool
forall a. C a => Set a -> Set a -> Bool
BitSet.disjoint
unions :: [Set a] -> Set a
unions = [Set a] -> Set a
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
Fold.fold
difference :: Set a -> Set a -> Set a
difference = Set a -> Set a -> Set a
forall a. C a => Set a -> Set a -> Set a
BitSet.difference
minimize :: forall label.
Set a -> [Assign label (Set a)] -> [Assign label (Set a)]
minimize Set a
free = (Set a, [Assign label (Set a)]) -> [Assign label (Set a)]
forall a b. (a, b) -> b
snd ((Set a, [Assign label (Set a)]) -> [Assign label (Set a)])
-> ([Assign label (Set a)] -> (Set a, [Assign label (Set a)]))
-> [Assign label (Set a)]
-> [Assign label (Set a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> [Assign label (Set a)] -> (Set a, [Assign label (Set a)])
forall label.
Set a -> [Assign label (Set a)] -> (Set a, [Assign label (Set a)])
forall set label.
Choose set =>
set -> [Assign label set] -> (set, [Assign label set])
chooseMinimize Set a
free
instance (Bit.C a) => Choose (BitSet.Set a) where
chooseMinimize :: forall label.
Set a -> [Assign label (Set a)] -> (Set a, [Assign label (Set a)])
chooseMinimize Set a
free [Assign label (Set a)]
available =
let singleMin :: Set a
singleMin =
Set a -> Set a
forall bits. C bits => Set bits -> Set bits
BitSet.keepMinimum (Set a -> Set a) -> Set a -> Set a
forall a b. (a -> b) -> a -> b
$ Set a -> Map a -> Set a
forall bits. C bits => Set bits -> Map bits -> Set bits
BitMap.minimumSet Set a
free (Map a -> Set a) -> Map a -> Set a
forall a b. (a -> b) -> a -> b
$
(Assign label (Set a) -> Map a) -> [Assign label (Set a)] -> Map a
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Fold.foldMap (Set a -> Map a
forall bits. C bits => Set bits -> Map bits
BitMap.fromSet (Set a -> Map a)
-> (Assign label (Set a) -> Set a) -> Assign label (Set a) -> Map a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Assign label (Set a) -> Set a
forall label set. Assign label set -> set
labeledSet) [Assign label (Set a)]
available
in (Set a
singleMin,
(Assign label (Set a) -> Bool)
-> [Assign label (Set a)] -> [Assign label (Set a)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (Assign label (Set a) -> Bool) -> Assign label (Set a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> Set a -> Bool
forall a. C a => Set a -> Set a -> Bool
BitSet.disjoint Set a
singleMin (Set a -> Bool)
-> (Assign label (Set a) -> Set a) -> Assign label (Set a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Assign label (Set a) -> Set a
forall label set. Assign label set -> set
labeledSet) [Assign label (Set a)]
available)
instance Set IntSet.IntSet where
null :: IntSet -> Bool
null = IntSet -> Bool
IntSet.null
disjoint :: IntSet -> IntSet -> Bool
disjoint IntSet
x IntSet
y = IntSet -> Bool
IntSet.null (IntSet -> Bool) -> IntSet -> Bool
forall a b. (a -> b) -> a -> b
$ IntSet -> IntSet -> IntSet
IntSet.intersection IntSet
x IntSet
y
unions :: [IntSet] -> IntSet
unions = [IntSet] -> IntSet
forall (f :: * -> *). Foldable f => f IntSet -> IntSet
IntSet.unions
difference :: IntSet -> IntSet -> IntSet
difference = IntSet -> IntSet -> IntSet
IntSet.difference
minimize :: forall label.
IntSet -> [Assign label IntSet] -> [Assign label IntSet]
minimize IntSet
free = (IntSet, [Assign label IntSet]) -> [Assign label IntSet]
forall a b. (a, b) -> b
snd ((IntSet, [Assign label IntSet]) -> [Assign label IntSet])
-> ([Assign label IntSet] -> (IntSet, [Assign label IntSet]))
-> [Assign label IntSet]
-> [Assign label IntSet]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> [Assign label IntSet] -> (IntSet, [Assign label IntSet])
forall label.
IntSet -> [Assign label IntSet] -> (IntSet, [Assign label IntSet])
forall set label.
Choose set =>
set -> [Assign label set] -> (set, [Assign label set])
chooseMinimize IntSet
free
instance Choose IntSet.IntSet where
chooseMinimize :: forall label.
IntSet -> [Assign label IntSet] -> (IntSet, [Assign label IntSet])
chooseMinimize IntSet
free [Assign label IntSet]
available =
let singleMin :: Key
singleMin =
IntSet -> Key
IntSet.findMin (IntSet -> Key) -> IntSet -> Key
forall a b. (a -> b) -> a -> b
$ Set IntSet -> IntSet
forall bits. Set bits -> bits
BitSet.getBits (Set IntSet -> IntSet) -> Set IntSet -> IntSet
forall a b. (a -> b) -> a -> b
$
Set IntSet -> Map IntSet -> Set IntSet
forall bits. C bits => Set bits -> Map bits -> Set bits
BitMap.minimumSet (IntSet -> Set IntSet
forall bits. bits -> Set bits
BitSet.Set IntSet
free) (Map IntSet -> Set IntSet) -> Map IntSet -> Set IntSet
forall a b. (a -> b) -> a -> b
$
(Assign label IntSet -> Map IntSet)
-> [Assign label IntSet] -> Map IntSet
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Fold.foldMap (Set IntSet -> Map IntSet
forall bits. C bits => Set bits -> Map bits
BitMap.fromSet (Set IntSet -> Map IntSet)
-> (Assign label IntSet -> Set IntSet)
-> Assign label IntSet
-> Map IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> Set IntSet
forall bits. bits -> Set bits
BitSet.Set (IntSet -> Set IntSet)
-> (Assign label IntSet -> IntSet)
-> Assign label IntSet
-> Set IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Assign label IntSet -> IntSet
forall label set. Assign label set -> set
labeledSet) [Assign label IntSet]
available
in (Key -> IntSet
IntSet.singleton Key
singleMin,
(Assign label IntSet -> Bool)
-> [Assign label IntSet] -> [Assign label IntSet]
forall a. (a -> Bool) -> [a] -> [a]
filter (Key -> IntSet -> Bool
IntSet.member Key
singleMin (IntSet -> Bool)
-> (Assign label IntSet -> IntSet) -> Assign label IntSet -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Assign label IntSet -> IntSet
forall label set. Assign label set -> set
labeledSet) [Assign label IntSet]
available)
data Assign label set =
Assign {
forall label set. Assign label set -> label
label :: label,
forall label set. Assign label set -> set
labeledSet :: set
}
assign :: label -> set -> Assign label set
assign :: forall label set. label -> set -> Assign label set
assign = label -> set -> Assign label set
forall label set. label -> set -> Assign label set
Assign
bitVectorFromSetAssigns ::
(Ord a) =>
[Assign label (Set.Set a)] -> [Assign label (BitSet.Set Integer)]
bitVectorFromSetAssigns :: forall a label.
Ord a =>
[Assign label (Set a)] -> [Assign label (Set Integer)]
bitVectorFromSetAssigns [Assign label (Set a)]
asns =
let bitVec :: Set a -> Integer
bitVec = (Integer -> Key -> Integer) -> Integer -> Map a Key -> Integer
forall b a. (b -> a -> b) -> b -> Map a a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Fold.foldl' Integer -> Key -> Integer
forall a. Bits a => a -> Key -> a
setBit Integer
0 (Map a Key -> Integer) -> (Set a -> Map a Key) -> Set a -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Assign label (Set a)] -> Set a -> Map a Key
forall a label.
Ord a =>
[Assign label (Set a)] -> Set a -> Map a Key
mapIntFromSet [Assign label (Set a)]
asns
in (Assign label (Set a) -> Assign label (Set Integer))
-> [Assign label (Set a)] -> [Assign label (Set Integer)]
forall a b. (a -> b) -> [a] -> [b]
map ((Set a -> Set Integer)
-> Assign label (Set a) -> Assign label (Set Integer)
forall a b. (a -> b) -> Assign label a -> Assign label b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Integer -> Set Integer
forall bits. bits -> Set bits
BitSet.Set (Integer -> Set Integer)
-> (Set a -> Integer) -> Set a -> Set Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> Integer
bitVec)) [Assign label (Set a)]
asns
intSetFromSetAssigns ::
(Ord a) => [Assign label (Set.Set a)] -> [Assign label IntSet.IntSet]
intSetFromSetAssigns :: forall a label.
Ord a =>
[Assign label (Set a)] -> [Assign label IntSet]
intSetFromSetAssigns [Assign label (Set a)]
asns =
let intSet :: Set a -> IntSet
intSet = [Key] -> IntSet
IntSet.fromList ([Key] -> IntSet) -> (Set a -> [Key]) -> Set a -> IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map a Key -> [Key]
forall k a. Map k a -> [a]
Map.elems (Map a Key -> [Key]) -> (Set a -> Map a Key) -> Set a -> [Key]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Assign label (Set a)] -> Set a -> Map a Key
forall a label.
Ord a =>
[Assign label (Set a)] -> Set a -> Map a Key
mapIntFromSet [Assign label (Set a)]
asns
in (Assign label (Set a) -> Assign label IntSet)
-> [Assign label (Set a)] -> [Assign label IntSet]
forall a b. (a -> b) -> [a] -> [b]
map ((Set a -> IntSet) -> Assign label (Set a) -> Assign label IntSet
forall a b. (a -> b) -> Assign label a -> Assign label b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Set a -> IntSet
intSet) [Assign label (Set a)]
asns
mapIntFromSet ::
(Ord a) => [Assign label (Set.Set a)] -> Set.Set a -> Map.Map a Int
mapIntFromSet :: forall a label.
Ord a =>
[Assign label (Set a)] -> Set a -> Map a Key
mapIntFromSet [Assign label (Set a)]
asns =
let mapToInt :: Map a Key
mapToInt =
[(a, Key)] -> Map a Key
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(a, Key)] -> Map a Key) -> [(a, Key)] -> Map a Key
forall a b. (a -> b) -> a -> b
$ [a] -> [Key] -> [(a, Key)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Set a -> [a]
forall a. Set a -> [a]
Set.toList (Set a -> [a]) -> Set a -> [a]
forall a b. (a -> b) -> a -> b
$ [Set a] -> Set a
forall set. Set set => [set] -> set
unions ([Set a] -> Set a) -> [Set a] -> Set a
forall a b. (a -> b) -> a -> b
$ (Assign label (Set a) -> Set a)
-> [Assign label (Set a)] -> [Set a]
forall a b. (a -> b) -> [a] -> [b]
map Assign label (Set a) -> Set a
forall label set. Assign label set -> set
labeledSet [Assign label (Set a)]
asns) [Key
0..]
in Map a Key -> Map a () -> Map a Key
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.intersection Map a Key
mapToInt (Map a () -> Map a Key)
-> (Set a -> Map a ()) -> Set a -> Map a Key
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 ()
data State label set =
State {
forall label set. State label set -> [Assign label set]
availableSubsets :: [Assign label set],
forall label set. State label set -> set
freeElements :: set,
forall label set. State label set -> [label]
usedSubsets :: [label]
}
instance Functor (Assign label) where
fmap :: forall a b. (a -> b) -> Assign label a -> Assign label b
fmap a -> b
f (Assign label
lab a
set) = label -> b -> Assign label b
forall label set. label -> set -> Assign label set
Assign label
lab (a -> b
f a
set)
instance Functor (State label) where
fmap :: forall a b. (a -> b) -> State label a -> State label b
fmap a -> b
f (State [Assign label a]
ab a
fp [label]
pb) =
[Assign label b] -> b -> [label] -> State label b
forall label set.
[Assign label set] -> set -> [label] -> State label set
State ((Assign label a -> Assign label b)
-> [Assign label a] -> [Assign label b]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> b) -> Assign label a -> Assign label b
forall a b. (a -> b) -> Assign label a -> Assign label b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) [Assign label a]
ab) (a -> b
f a
fp) [label]
pb
initState :: Set set => [Assign label set] -> State label set
initState :: forall set label. Set set => [Assign label set] -> State label set
initState [Assign label set]
subsets =
State {
availableSubsets :: [Assign label set]
availableSubsets = [Assign label set]
subsets,
freeElements :: set
freeElements = [set] -> set
forall set. Set set => [set] -> set
unions ([set] -> set) -> [set] -> set
forall a b. (a -> b) -> a -> b
$ (Assign label set -> set) -> [Assign label set] -> [set]
forall a b. (a -> b) -> [a] -> [b]
map Assign label set -> set
forall label set. Assign label set -> set
labeledSet [Assign label set]
subsets,
usedSubsets :: [label]
usedSubsets = []
}
{-# INLINE updateState #-}
updateState :: Set set => Assign label set -> State label set -> State label set
updateState :: forall set label.
Set set =>
Assign label set -> State label set -> State label set
updateState (Assign label
attemptLabel set
attemptedSet) State label set
s =
State {
availableSubsets :: [Assign label set]
availableSubsets =
(Assign label set -> Bool)
-> [Assign label set] -> [Assign label set]
forall a. (a -> Bool) -> [a] -> [a]
filter (set -> set -> Bool
forall set. Set set => set -> set -> Bool
disjoint set
attemptedSet (set -> Bool)
-> (Assign label set -> set) -> Assign label set -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Assign label set -> set
forall label set. Assign label set -> set
labeledSet) ([Assign label set] -> [Assign label set])
-> [Assign label set] -> [Assign label set]
forall a b. (a -> b) -> a -> b
$
State label set -> [Assign label set]
forall label set. State label set -> [Assign label set]
availableSubsets State label set
s,
freeElements :: set
freeElements = set -> set -> set
forall set. Set set => set -> set -> set
difference (State label set -> set
forall label set. State label set -> set
freeElements State label set
s) set
attemptedSet,
usedSubsets :: [label]
usedSubsets = label
attemptLabel label -> [label] -> [label]
forall a. a -> [a] -> [a]
: State label set -> [label]
forall label set. State label set -> [label]
usedSubsets State label set
s
}
{-# INLINE step #-}
step :: Set set => State label set -> [State label set]
step :: forall set label. Set set => State label set -> [State label set]
step State label set
s =
(Assign label set -> State label set)
-> [Assign label set] -> [State label set]
forall a b. (a -> b) -> [a] -> [b]
map ((Assign label set -> State label set -> State label set)
-> State label set -> Assign label set -> State label set
forall a b c. (a -> b -> c) -> b -> a -> c
flip Assign label set -> State label set -> State label set
forall set label.
Set set =>
Assign label set -> State label set -> State label set
updateState State label set
s) ([Assign label set] -> [State label set])
-> [Assign label set] -> [State label set]
forall a b. (a -> b) -> a -> b
$ set -> [Assign label set] -> [Assign label set]
forall label. set -> [Assign label set] -> [Assign label set]
forall set label.
Set set =>
set -> [Assign label set] -> [Assign label set]
minimize (State label set -> set
forall label set. State label set -> set
freeElements State label set
s) (State label set -> [Assign label set]
forall label set. State label set -> [Assign label set]
availableSubsets State label set
s)
{-# INLINE search #-}
search :: Set set => State label set -> [[label]]
search :: forall set label. Set set => State label set -> [[label]]
search State label set
s =
if set -> Bool
forall set. Set set => set -> Bool
null (State label set -> set
forall label set. State label set -> set
freeElements State label set
s)
then [State label set -> [label]
forall label set. State label set -> [label]
usedSubsets State label set
s]
else State label set -> [State label set]
forall set label. Set set => State label set -> [State label set]
step State label set
s [State label set] -> (State label set -> [[label]]) -> [[label]]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= State label set -> [[label]]
forall set label. Set set => State label set -> [[label]]
search
{-# INLINE partitions #-}
partitions :: Set set => [Assign label set] -> [[label]]
partitions :: forall set label. Set set => [Assign label set] -> [[label]]
partitions = State label set -> [[label]]
forall set label. Set set => State label set -> [[label]]
search (State label set -> [[label]])
-> ([Assign label set] -> State label set)
-> [Assign label set]
-> [[label]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Assign label set] -> State label set
forall set label. Set set => [Assign label set] -> State label set
initState
data Tree label set = Leaf | Branch set [(label, Tree label set)]
deriving (Tree label set -> Tree label set -> Bool
(Tree label set -> Tree label set -> Bool)
-> (Tree label set -> Tree label set -> Bool)
-> Eq (Tree label set)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall label set.
(Eq set, Eq label) =>
Tree label set -> Tree label set -> Bool
$c== :: forall label set.
(Eq set, Eq label) =>
Tree label set -> Tree label set -> Bool
== :: Tree label set -> Tree label set -> Bool
$c/= :: forall label set.
(Eq set, Eq label) =>
Tree label set -> Tree label set -> Bool
/= :: Tree label set -> Tree label set -> Bool
Eq)
completeTree :: Choose set => State label set -> Tree label set
completeTree :: forall set label. Choose set => State label set -> Tree label set
completeTree State label set
s =
if set -> Bool
forall set. Set set => set -> Bool
null (State label set -> set
forall label set. State label set -> set
freeElements State label set
s)
then Tree label set
forall label set. Tree label set
Leaf
else
(set -> [(label, Tree label set)] -> Tree label set)
-> (set, [(label, Tree label set)]) -> Tree label set
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry set -> [(label, Tree label set)] -> Tree label set
forall label set.
set -> [(label, Tree label set)] -> Tree label set
Branch ((set, [(label, Tree label set)]) -> Tree label set)
-> (set, [(label, Tree label set)]) -> Tree label set
forall a b. (a -> b) -> a -> b
$
([Assign label set] -> [(label, Tree label set)])
-> (set, [Assign label set]) -> (set, [(label, Tree label set)])
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd ((Assign label set -> (label, Tree label set))
-> [Assign label set] -> [(label, Tree label set)]
forall a b. (a -> b) -> [a] -> [b]
map (\Assign label set
asn -> (Assign label set -> label
forall label set. Assign label set -> label
label Assign label set
asn, State label set -> Tree label set
forall set label. Choose set => State label set -> Tree label set
completeTree (State label set -> Tree label set)
-> State label set -> Tree label set
forall a b. (a -> b) -> a -> b
$ Assign label set -> State label set -> State label set
forall set label.
Set set =>
Assign label set -> State label set -> State label set
updateState Assign label set
asn State label set
s))) ((set, [Assign label set]) -> (set, [(label, Tree label set)]))
-> (set, [Assign label set]) -> (set, [(label, Tree label set)])
forall a b. (a -> b) -> a -> b
$
set -> [Assign label set] -> (set, [Assign label set])
forall label.
set -> [Assign label set] -> (set, [Assign label set])
forall set label.
Choose set =>
set -> [Assign label set] -> (set, [Assign label set])
chooseMinimize (State label set -> set
forall label set. State label set -> set
freeElements State label set
s) (State label set -> [Assign label set]
forall label set. State label set -> [Assign label set]
availableSubsets State label set
s)
decisionTree :: Choose set => [Assign label set] -> Tree label set
decisionTree :: forall set label.
Choose set =>
[Assign label set] -> Tree label set
decisionTree = State label set -> Tree label set
forall set label. Choose set => State label set -> Tree label set
completeTree (State label set -> Tree label set)
-> ([Assign label set] -> State label set)
-> [Assign label set]
-> Tree label set
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Assign label set] -> State label set
forall set label. Set set => [Assign label set] -> State label set
initState