module Game.Mastermind.CodeSet (
C(..),
cube,
unions,
intersections,
intersectionsPQ,
(*&), (#*&),
) where
import qualified Data.NonEmpty.Class as NonEmptyC
import qualified Data.NonEmpty.Set as NonEmptySet
import qualified Data.NonEmpty as NonEmpty
import qualified Data.Set as Set
import Data.Function.HT (nest, )
import Data.Ord.HT (comparing, )
import Prelude hiding (null, )
class C set where
empty :: set a
union, intersection :: (Ord a) => set a -> set a -> set a
unit :: set a
leftNonEmptyProduct :: NonEmptySet.T a -> set a -> set a
flatten :: (Ord a) => set a -> [[a]]
symbols :: (Ord a) => set a -> Set.Set a
null :: set a -> Bool
size :: set a -> Integer
select :: set a -> Integer -> [a]
representationSize :: set a -> Int
compress :: (Ord a) => set a -> set a
cube :: (C set) => NonEmptySet.T a -> Int -> set a
cube alphabet n =
nest n (leftNonEmptyProduct alphabet) unit
unions :: (C set, Ord a) => [set a] -> set a
unions = foldr union empty
intersectionsPQ :: (C set, Ord a) => NonEmpty.T [] (set a) -> set a
intersectionsPQ =
let go (NonEmpty.Cons (_, set) []) = set
go (NonEmpty.Cons (_,x) ((_,y):rest)) =
let sec = intersection x y
in go $
NonEmpty.insertBy
(comparing fst) (representationSize sec, sec) rest
in go .
NonEmptyC.sortBy (comparing fst) .
fmap (\set -> (representationSize set, set))
intersections :: (C set, Ord a) => NonEmpty.T [] (set a) -> set a
intersections = NonEmpty.foldl1 intersection . nonEmptySortKey size
nonEmptySortKey :: (Ord b) => (a -> b) -> NonEmpty.T [] a -> NonEmpty.T [] a
nonEmptySortKey f =
fmap snd . NonEmptyC.sortBy (comparing fst) . fmap (\x -> (f x, x))
infixr 5 *&, #*&
(*&) :: (C set, Ord a) => Set.Set a -> set a -> set a
c *& set =
case NonEmptySet.fetch c of
Nothing -> empty
Just nec -> leftNonEmptyProduct nec set
(#*&) :: (C set) => a -> set a -> set a
c #*& set =
leftNonEmptyProduct (NonEmptySet.singleton c) set