{-# 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
forall a.
(Count -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Table] -> ShowS
$cshowList :: [Table] -> ShowS
show :: Table -> String
$cshow :: Table -> String
showsPrec :: Count -> Table -> ShowS
$cshowsPrec :: Count -> 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   = forall k a. Map k a
Map.empty
  , fromSetId :: IntMap IntSet
fromSetId = forall a. IntMap a
IntMap.empty
  , invMember :: IntMap (IntMap Count)
invMember = forall a. IntMap a
IntMap.empty
  }

fromList :: [IntSet] -> Table
fromList :: [IntSet] -> Table
fromList = Set IntSet -> Table
fromSet forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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   = forall a. Set a -> Count
Set.size Set IntSet
ss
  , toSetId :: Map IntSet Count
toSetId   = 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 = forall a. [(Count, a)] -> IntMap a
IntMap.fromList [(Count, IntSet)]
l
  , invMember :: IntMap (IntMap Count)
invMember =
      forall (f :: * -> *) a.
Foldable f =>
(a -> a -> a) -> f (IntMap a) -> IntMap a
IntMap.unionsWith forall a. IntMap a -> IntMap a -> IntMap a
IntMap.union
        [ forall a. [(Count, a)] -> IntMap a
IntMap.fromAscList [(Count
e, 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 = forall a b. [a] -> [b] -> [(a, b)]
zip [Count
0..] (forall a. Set a -> [a]
Set.toList Set IntSet
ss)

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

toList :: Table -> [IntSet]
toList :: Table -> [IntSet]
toList = forall a. Set a -> [a]
Set.toList 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 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 :: Count
numSets = Count
n forall a. Num a => a -> a -> a
+ Count
1
      , toSetId :: Map IntSet Count
toSetId = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert IntSet
s Count
n (Table -> Map IntSet Count
toSetId Table
t)
      , fromSetId :: IntMap IntSet
fromSetId = forall a. Count -> a -> IntMap a -> IntMap a
IntMap.insert Count
n IntSet
s (Table -> IntMap IntSet
fromSetId Table
t)
      , invMember :: IntMap (IntMap Count)
invMember =
          forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
IntMap.unionWith forall a. IntMap a -> IntMap a -> IntMap a
IntMap.union
            (forall a. [(Count, a)] -> IntMap a
IntMap.fromAscList [(Count
e, forall a. Count -> a -> IntMap a
IntMap.singleton Count
n Count
1) | Count
e <- IntSet -> [Count]
IntSet.toAscList IntSet
s])
            (Table -> IntMap (IntMap Count)
invMember Table
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
  | forall a. IntMap a -> Bool
IntMap.null IntMap Count
m =
      if IntSet
IntSet.empty forall k a. Ord k => k -> Map k a -> Bool
`Map.member` Table -> Map IntSet Count
toSetId Table
t
      then forall a. a -> Maybe a
Just IntSet
IntSet.empty
      else forall a. Maybe a
Nothing
  | Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! Table -> IntMap IntSet
fromSetId Table
t forall a. IntMap a -> Count -> a
IntMap.! Count
n
  where
    m :: IntMap Count
    m :: IntMap Count
m = forall (f :: * -> *) a.
Foldable f =>
(a -> a -> a) -> f (IntMap a) -> IntMap a
IntMap.unionsWith forall a. Num a => a -> a -> a
(+) [forall a. a -> Count -> IntMap a -> a
IntMap.findWithDefault 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
_) = forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (\(Count
_,Count
c,Count
_) -> Count
c) forall a. Semigroup a => a -> a -> a
<> forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (\(Count
_,Count
_,Count
size) -> Count
size))) forall a b. (a -> b) -> a -> b
$
                [(Count
i, Count
c, IntSet -> Count
IntSet.size (Table -> IntMap IntSet
fromSetId Table
t forall a. IntMap a -> Count -> a
IntMap.! Count
i)) | (Count
i,Count
c) <- forall a. IntMap a -> [(Count, a)]
IntMap.toList IntMap Count
m]