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

type SetId = Int
type Count = Int

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