{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_HADDOCK show-extensions #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  ToySolver.Converter.PB.Internal.LargestIntersectionFinder
-- Copyright   :  (c) Masahiro Sakai 2018
-- License     :  BSD-style
--
-- Maintainer  :  masahiro.sakai@gmail.com
-- Stability   :  provisional
-- Portability :  non-portable
--
-----------------------------------------------------------------------------
module ToySolver.Converter.PB.Internal.LargestIntersectionFinder
  ( Table
  , empty
  , fromSet
  , fromList
  , toSet
  , toList
  , insert
  , findLargestIntersectionSet
  ) where

import Data.IntMap (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import Data.List hiding (insert)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Ord
import Data.Set (Set)
import qualified Data.Set as Set

data Table
  = Table
  { Table -> Count
numSets   :: !Int
  , Table -> Map IntSet Count
toSetId   :: Map IntSet SetId
  , Table -> IntMap IntSet
fromSetId :: IntMap IntSet
  , Table -> IntMap (IntMap Count)
invMember :: IntMap (IntMap Count) -- e ↦ {s ↦ 1 | e∈s}
  }
  deriving (Count -> Table -> ShowS
[Table] -> ShowS
Table -> String
(Count -> Table -> ShowS)
-> (Table -> String) -> ([Table] -> ShowS) -> Show Table
forall a.
(Count -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Count -> Table -> ShowS
showsPrec :: Count -> Table -> ShowS
$cshow :: Table -> String
show :: Table -> String
$cshowList :: [Table] -> ShowS
showList :: [Table] -> ShowS
Show)

type SetId = Int
type Count = Int

empty :: Table
empty :: Table
empty =
  Table
  { numSets :: Count
numSets   = Count
0
  , toSetId :: Map IntSet Count
toSetId   = Map IntSet Count
forall k a. Map k a
Map.empty
  , fromSetId :: IntMap IntSet
fromSetId = IntMap IntSet
forall a. IntMap a
IntMap.empty
  , invMember :: IntMap (IntMap Count)
invMember = IntMap (IntMap Count)
forall a. IntMap a
IntMap.empty
  }

fromList :: [IntSet] -> Table
fromList :: [IntSet] -> Table
fromList = Set IntSet -> Table
fromSet (Set IntSet -> Table)
-> ([IntSet] -> Set IntSet) -> [IntSet] -> Table
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [IntSet] -> Set IntSet
forall a. Ord a => [a] -> Set a
Set.fromList

fromSet :: Set IntSet -> Table
fromSet :: Set IntSet -> Table
fromSet Set IntSet
ss =
  Table
  { numSets :: Count
numSets   = Set IntSet -> Count
forall a. Set a -> Count
Set.size Set IntSet
ss
  , toSetId :: Map IntSet Count
toSetId   = [(IntSet, Count)] -> Map IntSet Count
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(IntSet
s,Count
i) | (Count
i,IntSet
s) <- [(Count, IntSet)]
l]
  , fromSetId :: IntMap IntSet
fromSetId = [(Count, IntSet)] -> IntMap IntSet
forall a. [(Count, a)] -> IntMap a
IntMap.fromList [(Count, IntSet)]
l
  , invMember :: IntMap (IntMap Count)
invMember =
      (IntMap Count -> IntMap Count -> IntMap Count)
-> [IntMap (IntMap Count)] -> IntMap (IntMap Count)
forall (f :: * -> *) a.
Foldable f =>
(a -> a -> a) -> f (IntMap a) -> IntMap a
IntMap.unionsWith IntMap Count -> IntMap Count -> IntMap Count
forall a. IntMap a -> IntMap a -> IntMap a
IntMap.union
        [ [(Count, IntMap Count)] -> IntMap (IntMap Count)
forall a. [(Count, a)] -> IntMap a
IntMap.fromAscList [(Count
e, Count -> Count -> IntMap Count
forall a. Count -> a -> IntMap a
IntMap.singleton Count
i Count
1) | Count
e <- IntSet -> [Count]
IntSet.toAscList IntSet
s]
        | (Count
i,IntSet
s) <- [(Count, IntSet)]
l
        ]
  }
  where
    l :: [(Count, IntSet)]
l = [Count] -> [IntSet] -> [(Count, IntSet)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Count
0..] (Set IntSet -> [IntSet]
forall a. Set a -> [a]
Set.toList Set IntSet
ss)

toSet :: Table -> Set IntSet
toSet :: Table -> Set IntSet
toSet = Map IntSet Count -> Set IntSet
forall k a. Map k a -> Set k
Map.keysSet (Map IntSet Count -> Set IntSet)
-> (Table -> Map IntSet Count) -> Table -> Set IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Table -> Map IntSet Count
toSetId

toList :: Table -> [IntSet]
toList :: Table -> [IntSet]
toList = Set IntSet -> [IntSet]
forall a. Set a -> [a]
Set.toList (Set IntSet -> [IntSet])
-> (Table -> Set IntSet) -> Table -> [IntSet]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Table -> Set IntSet
toSet

insert :: IntSet -> Table -> Table
insert :: IntSet -> Table -> Table
insert IntSet
s Table
t
  | IntSet
s IntSet -> Map IntSet Count -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` Table -> Map IntSet Count
toSetId Table
t = Table
t
  | Bool
otherwise =
      Table
t
      { numSets = n + 1
      , toSetId = Map.insert s n (toSetId t)
      , fromSetId = IntMap.insert n s (fromSetId t)
      , invMember =
          IntMap.unionWith IntMap.union
            (IntMap.fromAscList [(e, IntMap.singleton n 1) | e <- IntSet.toAscList s])
            (invMember t)
      }
  where
    n :: Count
n = Table -> Count
numSets Table
t

-- | Given a set S and a family of sets U, find a T∈S such that S∩T has maximum cardinality.
-- In case of tie, smaller T is preferred.
findLargestIntersectionSet :: IntSet -> Table -> Maybe IntSet
findLargestIntersectionSet :: IntSet -> Table -> Maybe IntSet
findLargestIntersectionSet IntSet
s Table
t
  | IntMap Count -> Bool
forall a. IntMap a -> Bool
IntMap.null IntMap Count
m =
      if IntSet
IntSet.empty IntSet -> Map IntSet Count -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` Table -> Map IntSet Count
toSetId Table
t
      then IntSet -> Maybe IntSet
forall a. a -> Maybe a
Just IntSet
IntSet.empty
      else Maybe IntSet
forall a. Maybe a
Nothing
  | Bool
otherwise = IntSet -> Maybe IntSet
forall a. a -> Maybe a
Just (IntSet -> Maybe IntSet) -> IntSet -> Maybe IntSet
forall a b. (a -> b) -> a -> b
$! Table -> IntMap IntSet
fromSetId Table
t IntMap IntSet -> Count -> IntSet
forall a. IntMap a -> Count -> a
IntMap.! Count
n
  where
    m :: IntMap Count
    m :: IntMap Count
m = (Count -> Count -> Count) -> [IntMap Count] -> IntMap Count
forall (f :: * -> *) a.
Foldable f =>
(a -> a -> a) -> f (IntMap a) -> IntMap a
IntMap.unionsWith Count -> Count -> Count
forall a. Num a => a -> a -> a
(+) [IntMap Count -> Count -> IntMap (IntMap Count) -> IntMap Count
forall a. a -> Count -> IntMap a -> a
IntMap.findWithDefault IntMap Count
forall a. IntMap a
IntMap.empty Count
e (Table -> IntMap (IntMap Count)
invMember Table
t) | Count
e <- IntSet -> [Count]
IntSet.toList IntSet
s]
    (Count
n,Count
_,Count
_) = ((Count, Count, Count) -> (Count, Count, Count) -> Ordering)
-> [(Count, Count, Count)] -> (Count, Count, Count)
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (((Count, Count, Count) -> Count)
-> (Count, Count, Count) -> (Count, Count, Count) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (\(Count
_,Count
c,Count
_) -> Count
c) ((Count, Count, Count) -> (Count, Count, Count) -> Ordering)
-> ((Count, Count, Count) -> (Count, Count, Count) -> Ordering)
-> (Count, Count, Count)
-> (Count, Count, Count)
-> Ordering
forall a. Semigroup a => a -> a -> a
<> ((Count, Count, Count) -> (Count, Count, Count) -> Ordering)
-> (Count, Count, Count) -> (Count, Count, Count) -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip (((Count, Count, Count) -> Count)
-> (Count, Count, Count) -> (Count, Count, Count) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (\(Count
_,Count
_,Count
size) -> Count
size))) ([(Count, Count, Count)] -> (Count, Count, Count))
-> [(Count, Count, Count)] -> (Count, Count, Count)
forall a b. (a -> b) -> a -> b
$
                [(Count
i, Count
c, IntSet -> Count
IntSet.size (Table -> IntMap IntSet
fromSetId Table
t IntMap IntSet -> Count -> IntSet
forall a. IntMap a -> Count -> a
IntMap.! Count
i)) | (Count
i,Count
c) <- IntMap Count -> [(Count, Count)]
forall a. IntMap a -> [(Count, a)]
IntMap.toList IntMap Count
m]