module Combinatorics.Mastermind (
   Eval(..),
   evaluate,
   evaluateAll,
   formatEvalHistogram,
   numberDistinct,
   -- * only for testing
   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)


{- $setup
>>> import qualified Combinatorics.Mastermind as Mastermind
>>> import qualified Combinatorics as Comb
>>> import qualified Test.QuickCheck as QC
>>> import Control.Monad (replicateM)
>>> import Data.List (genericLength)
>>>
>>> genMastermindDistinct :: QC.Gen (Int, Int, Int, Int)
>>> genMastermindDistinct = do
>>>    n <- QC.choose (0,12)
>>>    k <- QC.choose (0, min 5 n)
>>>    b <- QC.choose (0,k)
>>>    w <- QC.choose (0,k-b)
>>>    return (n,k,b,w)
-}


{- |
Cf. @board-games@ package.
-}
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)

{- |
Given the code and a guess, compute the evaluation.

>>> filter ((Mastermind.Eval 2 0 ==) . Mastermind.evaluate "aabbb") $ replicateM 5 ['a'..'c']
["aaaaa","aaaac","aaaca","aaacc","aacaa","aacac","aacca","aaccc","acbcc","accbc","acccb","cabcc","cacbc","caccb","ccbbc","ccbcb","cccbb"]
-}
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 n k b w@ computes the number of matching codes,
given that all codes have distinct symbols.
@n@ is the alphabet size, @k@ the width of the code,
@b@ the number of black evaluation sticks and
@w@ the number of white evaluation sticks.

prop> QC.forAll genMastermindDistinct $ \(n,k,b,w) -> let alphabet = take n ['a'..]; code = take k alphabet in Mastermind.numberDistinct n k b w == (genericLength $ filter ((Mastermind.Eval b w ==) . Mastermind.evaluate code) $ Comb.variate k alphabet)
-}
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

{- |
prop> QC.forAll genMastermindDistinct $ \(n,k,_b,w) -> Mastermind.numberDistinctWhite n k w == Mastermind.numberDistinct n k 0 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)