module Combinatorics.Mastermind (
Eval(..),
evaluate,
evaluateAll,
formatEvalHistogram,
numberDistinct,
numberDistinctWhite,
) where
import qualified Combinatorics.Permutation.WithoutSomeFixpoints as PermWOFP
import Combinatorics (binomial)
import Text.Printf (printf)
import qualified Data.Map as Map; import Data.Map (Map)
import qualified Data.Foldable as Fold
import qualified Data.List.HT as ListHT
import Data.Tuple.HT (mapPair)
data Eval = Eval {Eval -> Int
black, Eval -> Int
white :: Int}
deriving (Eval -> Eval -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Eval -> Eval -> Bool
$c/= :: Eval -> Eval -> Bool
== :: Eval -> Eval -> Bool
$c== :: Eval -> Eval -> Bool
Eq, Eq Eval
Eval -> Eval -> Bool
Eval -> Eval -> Ordering
Eval -> Eval -> Eval
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Eval -> Eval -> Eval
$cmin :: Eval -> Eval -> Eval
max :: Eval -> Eval -> Eval
$cmax :: Eval -> Eval -> Eval
>= :: Eval -> Eval -> Bool
$c>= :: Eval -> Eval -> Bool
> :: Eval -> Eval -> Bool
$c> :: Eval -> Eval -> Bool
<= :: Eval -> Eval -> Bool
$c<= :: Eval -> Eval -> Bool
< :: Eval -> Eval -> Bool
$c< :: Eval -> Eval -> Bool
compare :: Eval -> Eval -> Ordering
$ccompare :: Eval -> Eval -> Ordering
Ord, Int -> Eval -> ShowS
[Eval] -> ShowS
Eval -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Eval] -> ShowS
$cshowList :: [Eval] -> ShowS
show :: Eval -> String
$cshow :: Eval -> String
showsPrec :: Int -> Eval -> ShowS
$cshowsPrec :: Int -> Eval -> ShowS
Show)
evaluate :: (Ord a) => [a] -> [a] -> Eval
evaluate :: forall a. Ord a => [a] -> [a] -> Eval
evaluate [a]
code [a]
attempt =
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Int -> Eval
Eval forall a b. (a -> b) -> a -> b
$
forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair
(forall (t :: * -> *) a. Foldable t => t a -> Int
length,
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Fold.sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith forall a. Ord a => a -> a -> a
min) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair (forall a. Ord a => [a] -> Map a Int
histogram,forall a. Ord a => [a] -> Map a Int
histogram) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [(a, b)] -> ([a], [b])
unzip) forall a b. (a -> b) -> a -> b
$
forall a. (a -> Bool) -> [a] -> ([a], [a])
ListHT.partition (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Eq a => a -> a -> Bool
(==)) forall a b. (a -> b) -> a -> b
$
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
code [a]
attempt
evaluateAll :: (Ord a) => [[a]] -> [a] -> Map Eval Int
evaluateAll :: forall a. Ord a => [[a]] -> [a] -> Map Eval Int
evaluateAll [[a]]
codes [a]
attempt = forall a. Ord a => [a] -> Map a Int
histogram forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. Ord a => [a] -> [a] -> Eval
evaluate [a]
attempt) [[a]]
codes
formatEvalHistogram :: Map Eval Int -> String
formatEvalHistogram :: Map Eval Int -> String
formatEvalHistogram Map Eval Int
m =
let n :: Int
n = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(Eval Int
b Int
w) -> Int
bforall a. Num a => a -> a -> a
+Int
w) forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [k]
Map.keys Map Eval Int
m
in [String] -> String
unlines forall a b. (a -> b) -> a -> b
$
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
(\Int
b ->
[String] -> String
unwords forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a b. (a -> b) -> [a] -> [b]
map (\Int
w -> forall r. PrintfType r => String -> r
printf String
"%6d" forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Int
0 (Int -> Int -> Eval
Eval Int
b Int
w) Map Eval Int
m))
[Int
0..] (forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
tail forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [[a]]
ListHT.inits [Int
0..Int
n])
histogram :: (Ord a) => [a] -> Map a Int
histogram :: forall a. Ord a => [a] -> Map a Int
histogram = forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith forall a. Num a => a -> a -> a
(+) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\a
a -> (a
a,Int
1))
numberDistinct :: Int -> Int -> Int -> Int -> Integer
numberDistinct :: Int -> Int -> Int -> Int -> Integer
numberDistinct Int
n Int
k Int
b Int
w =
forall a. Integral a => a -> a -> a
binomial (forall a. Integral a => a -> Integer
toInteger Int
k) (forall a. Integral a => a -> Integer
toInteger Int
b)
forall a. Num a => a -> a -> a
*
Int -> Int -> Int -> Integer
numberDistinctWhite (Int
nforall a. Num a => a -> a -> a
-Int
b) (Int
kforall a. Num a => a -> a -> a
-Int
b) Int
w
numberDistinctWhite :: Int -> Int -> Int -> Integer
numberDistinctWhite :: Int -> Int -> Int -> Integer
numberDistinctWhite Int
n Int
k Int
w =
let ni :: Integer
ni = forall a. Integral a => a -> Integer
toInteger Int
n
ki :: Integer
ki = forall a. Integral a => a -> Integer
toInteger Int
k
wi :: Integer
wi = forall a. Integral a => a -> Integer
toInteger Int
w
in forall a. Integral a => a -> a -> a
binomial Integer
ki Integer
wi forall a. Num a => a -> a -> a
* forall a. Num a => [[a]]
PermWOFP.numbers forall a. [a] -> Int -> a
!! Int
k forall a. [a] -> Int -> a
!! Int
w forall a. Num a => a -> a -> a
* forall a. Integral a => a -> a -> a
binomial (Integer
niforall a. Num a => a -> a -> a
-Integer
ki) (Integer
kiforall a. Num a => a -> a -> a
-Integer
wi)