{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE CPP #-}
-----------------------------------------------------------------------------
-- |
-- 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
#if !MIN_VERSION_base(4,11,0)
import Data.Monoid
#endif
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]