{- |
Compute how often it happens
that a Queen and a King are adjacent in a randomly ordered card set.
-}
module Combinatorics.CardPairs (
   -- * general
   Card(..), CardCount(..),
   charFromCard,
   allPossibilities,
   numberOfAllPossibilities,
   possibilitiesCardsNaive,
   possibilitiesCardsDynamic,
   possibilitiesCardsBorderNaive,
   possibilitiesCardsBorderDynamic,
   possibilitiesCardsBorder2Dynamic,
   -- * examples
   cardSetSizeSkat, numberOfPossibilitiesSkat, probabilitySkat,
   cardSetSizeRummy, numberOfPossibilitiesRummy, probabilityRummy,
   cardSetSizeRummyJK, numberOfPossibilitiesRummyJK, probabilityRummyJK,
   -- * tests
   exampleOutput,
   adjacentCouplesSmall,
   allPossibilitiesSmall,
   allPossibilitiesMedium,
   allPossibilitiesSkat,
   ) where

import qualified Combinatorics as Comb

import Data.Array (Array, (!), array, )
import Data.Ix (Ix, )
import qualified Data.List.HT as ListHT

import qualified Control.Monad.Trans.State as State
import Control.Monad (liftM, liftM2, liftM3, replicateM, )

import Data.Ratio ((%), )


{- $setup
>>> import qualified Combinatorics.CardPairs as CardPairs
>>> import Combinatorics.CardPairs (CardCount(CardCount))
>>>
>>> import qualified Test.QuickCheck as QC
>>> import Control.Applicative (liftA3)
>>> import Data.List.HT (allEqual)
>>> import Data.Array ((!))
>>>
>>> genCardCount :: QC.Gen (CardPairs.CardCount Int)
>>> genCardCount =
>>>    liftA3 CardPairs.CardCount
>>>       (QC.choose (0,5)) (QC.choose (0,5)) (QC.choose (0,5))
-}


type CardSet a = [(a, Int)]

data Card = Other | Queen | King
   deriving (Card -> Card -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Card -> Card -> Bool
$c/= :: Card -> Card -> Bool
== :: Card -> Card -> Bool
$c== :: Card -> Card -> Bool
Eq, Eq Card
Card -> Card -> Bool
Card -> Card -> Ordering
Card -> Card -> Card
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 :: Card -> Card -> Card
$cmin :: Card -> Card -> Card
max :: Card -> Card -> Card
$cmax :: Card -> Card -> Card
>= :: Card -> Card -> Bool
$c>= :: Card -> Card -> Bool
> :: Card -> Card -> Bool
$c> :: Card -> Card -> Bool
<= :: Card -> Card -> Bool
$c<= :: Card -> Card -> Bool
< :: Card -> Card -> Bool
$c< :: Card -> Card -> Bool
compare :: Card -> Card -> Ordering
$ccompare :: Card -> Card -> Ordering
Ord, Int -> Card
Card -> Int
Card -> [Card]
Card -> Card
Card -> Card -> [Card]
Card -> Card -> Card -> [Card]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Card -> Card -> Card -> [Card]
$cenumFromThenTo :: Card -> Card -> Card -> [Card]
enumFromTo :: Card -> Card -> [Card]
$cenumFromTo :: Card -> Card -> [Card]
enumFromThen :: Card -> Card -> [Card]
$cenumFromThen :: Card -> Card -> [Card]
enumFrom :: Card -> [Card]
$cenumFrom :: Card -> [Card]
fromEnum :: Card -> Int
$cfromEnum :: Card -> Int
toEnum :: Int -> Card
$ctoEnum :: Int -> Card
pred :: Card -> Card
$cpred :: Card -> Card
succ :: Card -> Card
$csucc :: Card -> Card
Enum, Int -> Card -> ShowS
[Card] -> ShowS
Card -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Card] -> ShowS
$cshowList :: [Card] -> ShowS
show :: Card -> [Char]
$cshow :: Card -> [Char]
showsPrec :: Int -> Card -> ShowS
$cshowsPrec :: Int -> Card -> ShowS
Show)

charFromCard :: Card -> Char
charFromCard :: Card -> Char
charFromCard Card
card =
   case Card
card of
      Card
Other -> Char
' '
      Card
Queen -> Char
'q'
      Card
King  -> Char
'k'

removeEach :: State.StateT (CardSet a) [] a
removeEach :: forall a. StateT (CardSet a) [] a
removeEach =
   forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
State.StateT forall a b. (a -> b) -> a -> b
$
   forall a b. (a -> b) -> [a] -> [b]
map (\(CardSet a
pre,(a
x,Int
n),CardSet a
post) ->
          (a
x, CardSet a
pre forall a. [a] -> [a] -> [a]
++
              let m :: Int
m = forall a. Enum a => a -> a
pred Int
n
              in (if Int
mforall a. Ord a => a -> a -> Bool
>Int
0 then ((a
x,Int
m)forall a. a -> [a] -> [a]
:) else forall a. a -> a
id)
              CardSet a
post)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall a. [a] -> [([a], a, [a])]
ListHT.splitEverywhere

normalizeSet :: CardSet a -> CardSet a
normalizeSet :: forall a. CardSet a -> CardSet a
normalizeSet = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Ord a => a -> a -> Bool
>Int
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)

allPossibilities :: CardSet a -> [[a]]
allPossibilities :: forall a. CardSet a -> [[a]]
allPossibilities CardSet a
set =
   forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
State.evalStateT
      (forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd CardSet a
set)) forall a. StateT (CardSet a) [] a
removeEach)
      (forall a. CardSet a -> CardSet a
normalizeSet CardSet a
set)

allPossibilitiesSmall :: [[Card]]
allPossibilitiesSmall :: [[Card]]
allPossibilitiesSmall =
   forall a. CardSet a -> [[a]]
allPossibilities [(Card
Other, Int
4), (Card
Queen, Int
2), (Card
King, Int
2)]

allPossibilitiesMedium :: [[Card]]
allPossibilitiesMedium :: [[Card]]
allPossibilitiesMedium =
   forall a. CardSet a -> [[a]]
allPossibilities [(Card
Other, Int
4), (Card
Queen, Int
4), (Card
King, Int
4)]

allPossibilitiesSkat :: [[Card]]
allPossibilitiesSkat :: [[Card]]
allPossibilitiesSkat =
   forall a. CardSet a -> [[a]]
allPossibilities [(Card
Other, Int
24), (Card
Queen, Int
4), (Card
King, Int
4)]


adjacentCouple :: [Card] -> Bool
adjacentCouple :: [Card] -> Bool
adjacentCouple =
   forall (t :: * -> *). Foldable t => t Bool -> Bool
or forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall a b. (a -> a -> b) -> [a] -> [b]
ListHT.mapAdjacent
      (\Card
x Card
y -> (Card
xforall a. Eq a => a -> a -> Bool
==Card
Queen Bool -> Bool -> Bool
&& Card
yforall a. Eq a => a -> a -> Bool
==Card
King) Bool -> Bool -> Bool
|| (Card
xforall a. Eq a => a -> a -> Bool
==Card
King Bool -> Bool -> Bool
&& Card
yforall a. Eq a => a -> a -> Bool
==Card
Queen))

adjacentCouplesSmall :: [[Card]]
adjacentCouplesSmall :: [[Card]]
adjacentCouplesSmall =
   forall a. (a -> Bool) -> [a] -> [a]
filter [Card] -> Bool
adjacentCouple forall a b. (a -> b) -> a -> b
$
   forall a. CardSet a -> [[a]]
allPossibilities [(Card
Other, Int
4), (Card
Queen, Int
2), (Card
King, Int
2)]

exampleOutput :: IO ()
exampleOutput :: IO ()
exampleOutput =
   forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a. Show a => a -> IO ()
print forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Card -> Char
charFromCard) [[Card]]
allPossibilitiesSmall


{- |
Candidate for utility-ht:
-}
sample :: (a -> b) -> [a] -> [(a,b)]
sample :: forall a b. (a -> b) -> [a] -> [(a, b)]
sample a -> b
f = forall a b. (a -> b) -> [a] -> [b]
map (\a
x -> (a
x, a -> b
f a
x))


data CardCount i =
   CardCount {forall i. CardCount i -> i
otherCount, forall i. CardCount i -> i
queenCount, forall i. CardCount i -> i
kingCount :: i}
      deriving (CardCount i -> CardCount i -> Bool
forall i. Eq i => CardCount i -> CardCount i -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CardCount i -> CardCount i -> Bool
$c/= :: forall i. Eq i => CardCount i -> CardCount i -> Bool
== :: CardCount i -> CardCount i -> Bool
$c== :: forall i. Eq i => CardCount i -> CardCount i -> Bool
Eq, CardCount i -> CardCount i -> Bool
CardCount i -> CardCount i -> Ordering
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
forall {i}. Ord i => Eq (CardCount i)
forall i. Ord i => CardCount i -> CardCount i -> Bool
forall i. Ord i => CardCount i -> CardCount i -> Ordering
forall i. Ord i => CardCount i -> CardCount i -> CardCount i
min :: CardCount i -> CardCount i -> CardCount i
$cmin :: forall i. Ord i => CardCount i -> CardCount i -> CardCount i
max :: CardCount i -> CardCount i -> CardCount i
$cmax :: forall i. Ord i => CardCount i -> CardCount i -> CardCount i
>= :: CardCount i -> CardCount i -> Bool
$c>= :: forall i. Ord i => CardCount i -> CardCount i -> Bool
> :: CardCount i -> CardCount i -> Bool
$c> :: forall i. Ord i => CardCount i -> CardCount i -> Bool
<= :: CardCount i -> CardCount i -> Bool
$c<= :: forall i. Ord i => CardCount i -> CardCount i -> Bool
< :: CardCount i -> CardCount i -> Bool
$c< :: forall i. Ord i => CardCount i -> CardCount i -> Bool
compare :: CardCount i -> CardCount i -> Ordering
$ccompare :: forall i. Ord i => CardCount i -> CardCount i -> Ordering
Ord, (CardCount i, CardCount i) -> [CardCount i]
(CardCount i, CardCount i) -> CardCount i -> Bool
(CardCount i, CardCount i) -> CardCount i -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
forall {i}. Ix i => Ord (CardCount i)
forall i. Ix i => (CardCount i, CardCount i) -> Int
forall i. Ix i => (CardCount i, CardCount i) -> [CardCount i]
forall i. Ix i => (CardCount i, CardCount i) -> CardCount i -> Bool
forall i. Ix i => (CardCount i, CardCount i) -> CardCount i -> Int
unsafeRangeSize :: (CardCount i, CardCount i) -> Int
$cunsafeRangeSize :: forall i. Ix i => (CardCount i, CardCount i) -> Int
rangeSize :: (CardCount i, CardCount i) -> Int
$crangeSize :: forall i. Ix i => (CardCount i, CardCount i) -> Int
inRange :: (CardCount i, CardCount i) -> CardCount i -> Bool
$cinRange :: forall i. Ix i => (CardCount i, CardCount i) -> CardCount i -> Bool
unsafeIndex :: (CardCount i, CardCount i) -> CardCount i -> Int
$cunsafeIndex :: forall i. Ix i => (CardCount i, CardCount i) -> CardCount i -> Int
index :: (CardCount i, CardCount i) -> CardCount i -> Int
$cindex :: forall i. Ix i => (CardCount i, CardCount i) -> CardCount i -> Int
range :: (CardCount i, CardCount i) -> [CardCount i]
$crange :: forall i. Ix i => (CardCount i, CardCount i) -> [CardCount i]
Ix, Int -> CardCount i -> ShowS
forall i. Show i => Int -> CardCount i -> ShowS
forall i. Show i => [CardCount i] -> ShowS
forall i. Show i => CardCount i -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [CardCount i] -> ShowS
$cshowList :: forall i. Show i => [CardCount i] -> ShowS
show :: CardCount i -> [Char]
$cshow :: forall i. Show i => CardCount i -> [Char]
showsPrec :: Int -> CardCount i -> ShowS
$cshowsPrec :: forall i. Show i => Int -> CardCount i -> ShowS
Show)


possibilitiesCardsNaive ::
   CardCount Int -> Integer
possibilitiesCardsNaive :: CardCount Int -> Integer
possibilitiesCardsNaive (CardCount Int
no Int
nq Int
nk) =
   forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$
   forall a. (a -> Bool) -> [a] -> [a]
filter [Card] -> Bool
adjacentCouple forall a b. (a -> b) -> a -> b
$
   forall a. CardSet a -> [[a]]
allPossibilities [(Card
Other,Int
no), (Card
Queen,Int
nq), (Card
King,Int
nk)]

possibilitiesCardsDynamic ::
   CardCount Int -> Array (CardCount Int) Integer
possibilitiesCardsDynamic :: CardCount Int -> Array (CardCount Int) Integer
possibilitiesCardsDynamic (CardCount Int
mo Int
mq Int
mk) =
   let border :: [CardCount Int]
border =
          forall (m :: * -> *) a1 a2 a3 r.
Monad m =>
(a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
liftM3 forall i. i -> i -> i -> CardCount i
CardCount [Int
0,Int
1]   [Int
0..Int
mq] [Int
0..Int
mk] forall a. [a] -> [a] -> [a]
++
          forall (m :: * -> *) a1 a2 a3 r.
Monad m =>
(a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
liftM3 forall i. i -> i -> i -> CardCount i
CardCount [Int
0..Int
mo] [Int
0,Int
1]   [Int
0..Int
mk] forall a. [a] -> [a] -> [a]
++
          forall (m :: * -> *) a1 a2 a3 r.
Monad m =>
(a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
liftM3 forall i. i -> i -> i -> CardCount i
CardCount [Int
0..Int
mo] [Int
0..Int
mq] [Int
0,Int
1]
       p :: Array (CardCount Int) Integer
p =
          forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array (forall i. i -> i -> i -> CardCount i
CardCount Int
0 Int
0 Int
0, forall i. i -> i -> i -> CardCount i
CardCount Int
mo Int
mq Int
mk) forall a b. (a -> b) -> a -> b
$
             forall a b. (a -> b) -> [a] -> [(a, b)]
sample CardCount Int -> Integer
possibilitiesCardsNaive [CardCount Int]
border forall a. [a] -> [a] -> [a]
++
             forall a b. (a -> b) -> [a] -> [(a, b)]
sample
                (\(CardCount Int
no Int
nq Int
nk) ->
                   -- " ******"
                   Array (CardCount Int) Integer
pforall i e. Ix i => Array i e -> i -> e
!(forall i. i -> i -> i -> CardCount i
CardCount (Int
noforall a. Num a => a -> a -> a
-Int
1) Int
nq Int
nk) forall a. Num a => a -> a -> a
+
                   -- "q *****"
                   Array (CardCount Int) Integer
pforall i e. Ix i => Array i e -> i -> e
!(forall i. i -> i -> i -> CardCount i
CardCount (Int
noforall a. Num a => a -> a -> a
-Int
1) (Int
nqforall a. Num a => a -> a -> a
-Int
1) Int
nk) forall a. Num a => a -> a -> a
+
                   -- "k *****"
                   Array (CardCount Int) Integer
pforall i e. Ix i => Array i e -> i -> e
!(forall i. i -> i -> i -> CardCount i
CardCount (Int
noforall a. Num a => a -> a -> a
-Int
1) Int
nq (Int
nkforall a. Num a => a -> a -> a
-Int
1)) forall a. Num a => a -> a -> a
+
                   -- The following case is not handled correctly,
                   -- because the second 'q' can be part of a "qk".
                   -- "qq*****"
                   Array (CardCount Int) Integer
pforall i e. Ix i => Array i e -> i -> e
!(forall i. i -> i -> i -> CardCount i
CardCount Int
no (Int
nqforall a. Num a => a -> a -> a
-Int
2) Int
nk) forall a. Num a => a -> a -> a
+
                   -- "kk*****"
                   Array (CardCount Int) Integer
pforall i e. Ix i => Array i e -> i -> e
!(forall i. i -> i -> i -> CardCount i
CardCount Int
no Int
nq (Int
nkforall a. Num a => a -> a -> a
-Int
2)) forall a. Num a => a -> a -> a
+
                   -- "kq*****"
                   -- "qk*****"
                   Integer
2 forall a. Num a => a -> a -> a
* forall a. Integral a => [a] -> a
Comb.multinomial [forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
no, forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nqforall a. Num a => a -> a -> a
-Integer
1, forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nkforall a. Num a => a -> a -> a
-Integer
1])
                (forall (m :: * -> *) a1 a2 a3 r.
Monad m =>
(a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
liftM3 forall i. i -> i -> i -> CardCount i
CardCount [Int
2..Int
mo] [Int
2..Int
mq] [Int
2..Int
mk])
   in  Array (CardCount Int) Integer
p


sumCard :: Num i => CardCount i -> i
sumCard :: forall i. Num i => CardCount i -> i
sumCard (CardCount i
x i
y i
z) = i
xforall a. Num a => a -> a -> a
+i
yforall a. Num a => a -> a -> a
+i
z

{-
Candidate for utility-ht: slice

http://hackage.haskell.org/packages/archive/event-list/0.1/doc/html/Data-EventList-Relative-TimeBody.html#v:slice
could be rewritten for plain lists.
-}

{- |
Count the number of card set orderings
with adjacent queen and king.
We return a triple where the elements count with respect to an additional condition:
(card set starts with an ordinary card ' ',
 start with queen 'q',
 start with king 'k')

prop> allEqual [CardPairs.possibilitiesCardsBorderNaive (CardCount 2 3 5), CardPairs.possibilitiesCardsBorderDynamic (CardCount 5 5 5) ! (CardCount 2 3 5), CardPairs.possibilitiesCardsBorder2Dynamic (CardCount 5 5 5) ! (CardCount 2 3 5)]
prop> QC.forAll genCardCount $ \cc -> allEqual [CardPairs.possibilitiesCardsBorderNaive cc, CardPairs.possibilitiesCardsBorderDynamic cc ! cc, CardPairs.possibilitiesCardsBorder2Dynamic cc ! cc]
-}
possibilitiesCardsBorderNaive ::
   CardCount Int -> CardCount Integer
possibilitiesCardsBorderNaive :: CardCount Int -> CardCount Integer
possibilitiesCardsBorderNaive (CardCount Int
no Int
nq Int
nk) =
   forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\CardCount Integer
n (Card
card:[Card]
_) ->
      case Card
card of
         Card
Other -> CardCount Integer
n{otherCount :: Integer
otherCount = Integer
1 forall a. Num a => a -> a -> a
+ forall i. CardCount i -> i
otherCount CardCount Integer
n}
         Card
Queen -> CardCount Integer
n{queenCount :: Integer
queenCount = Integer
1 forall a. Num a => a -> a -> a
+ forall i. CardCount i -> i
queenCount CardCount Integer
n}
         Card
King  -> CardCount Integer
n{kingCount :: Integer
kingCount  = Integer
1 forall a. Num a => a -> a -> a
+ forall i. CardCount i -> i
kingCount CardCount Integer
n})
      (forall i. i -> i -> i -> CardCount i
CardCount Integer
0 Integer
0 Integer
0) forall a b. (a -> b) -> a -> b
$
   forall a. (a -> Bool) -> [a] -> [a]
filter [Card] -> Bool
adjacentCouple forall a b. (a -> b) -> a -> b
$
   forall a. CardSet a -> [[a]]
allPossibilities [(Card
Other,Int
no), (Card
Queen,Int
nq), (Card
King,Int
nk)]

possibilitiesCardsBorderDynamic ::
   CardCount Int -> Array (CardCount Int) (CardCount Integer)
possibilitiesCardsBorderDynamic :: CardCount Int -> Array (CardCount Int) (CardCount Integer)
possibilitiesCardsBorderDynamic (CardCount Int
mo Int
mq Int
mk) =
   let p :: Array (CardCount Int) (CardCount Integer)
p =
          forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array (forall i. i -> i -> i -> CardCount i
CardCount Int
0 Int
0 Int
0, forall i. i -> i -> i -> CardCount i
CardCount Int
mo Int
mq Int
mk) forall a b. (a -> b) -> a -> b
$
             forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM  (\ Int
nq -> (forall i. i -> i -> i -> CardCount i
CardCount Int
0 Int
nq Int
0, forall i. i -> i -> i -> CardCount i
CardCount Integer
0 Integer
0 Integer
0)) [Int
1..Int
mq] forall a. [a] -> [a] -> [a]
++
             forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM  (\ Int
nk -> (forall i. i -> i -> i -> CardCount i
CardCount Int
0 Int
0 Int
nk, forall i. i -> i -> i -> CardCount i
CardCount Integer
0 Integer
0 Integer
0)) [Int
1..Int
mk] forall a. [a] -> [a] -> [a]
++
             forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (\ Int
nq Int
nk -> ((forall i. i -> i -> i -> CardCount i
CardCount Int
0 Int
nq Int
nk),
                       let s :: Integer
s = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Int
nqforall a. Num a => a -> a -> a
+Int
nkforall a. Num a => a -> a -> a
-Int
1
                       in  forall i. i -> i -> i -> CardCount i
CardCount Integer
0
                              (forall a. Integral a => a -> a -> a
Comb.binomial Integer
s (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nk))
                              (forall a. Integral a => a -> a -> a
Comb.binomial Integer
s (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nq))))
                [Int
1..Int
mq] [Int
1..Int
mk] forall a. [a] -> [a] -> [a]
++
             -- (CardCount 0 0 0) is redundant in the list,
             -- its number is not needed anyway
             forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (\ Int
no Int
nk -> (forall i. i -> i -> i -> CardCount i
CardCount Int
no Int
0 Int
nk, forall i. i -> i -> i -> CardCount i
CardCount Integer
0 Integer
0 Integer
0)) [Int
0..Int
mo] [Int
0..Int
mk] forall a. [a] -> [a] -> [a]
++
             forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (\ Int
no Int
nq -> (forall i. i -> i -> i -> CardCount i
CardCount Int
no Int
nq Int
0, forall i. i -> i -> i -> CardCount i
CardCount Integer
0 Integer
0 Integer
0)) [Int
0..Int
mo] [Int
0..Int
mq] forall a. [a] -> [a] -> [a]
++
             forall a b. (a -> b) -> [a] -> [(a, b)]
sample
                (\(CardCount Int
no Int
nq Int
nk) ->
                   let allP :: Integer
allP = forall a. Integral a => [a] -> a
Comb.multinomial [forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
no, forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nqforall a. Num a => a -> a -> a
-Integer
1, forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nkforall a. Num a => a -> a -> a
-Integer
1]
                   in  forall i. i -> i -> i -> CardCount i
CardCount
                          (-- " ******"
                           forall i. Num i => CardCount i -> i
sumCard (Array (CardCount Int) (CardCount Integer)
p forall i e. Ix i => Array i e -> i -> e
! forall i. i -> i -> i -> CardCount i
CardCount (Int
noforall a. Num a => a -> a -> a
-Int
1) Int
nq Int
nk))
                          (-- "q *****"
                           forall i. CardCount i -> i
otherCount (Array (CardCount Int) (CardCount Integer)
p forall i e. Ix i => Array i e -> i -> e
! forall i. i -> i -> i -> CardCount i
CardCount Int
no (Int
nqforall a. Num a => a -> a -> a
-Int
1) Int
nk) forall a. Num a => a -> a -> a
+
                           -- "qq*****"
                           forall i. CardCount i -> i
queenCount (Array (CardCount Int) (CardCount Integer)
p forall i e. Ix i => Array i e -> i -> e
! forall i. i -> i -> i -> CardCount i
CardCount Int
no (Int
nqforall a. Num a => a -> a -> a
-Int
1) Int
nk) forall a. Num a => a -> a -> a
+
                           -- "qk*****"
                           Integer
allP)
                          (-- "k *****"
                           forall i. CardCount i -> i
otherCount (Array (CardCount Int) (CardCount Integer)
p forall i e. Ix i => Array i e -> i -> e
! forall i. i -> i -> i -> CardCount i
CardCount Int
no Int
nq (Int
nkforall a. Num a => a -> a -> a
-Int
1)) forall a. Num a => a -> a -> a
+
                           -- "kk*****"
                           forall i. CardCount i -> i
kingCount  (Array (CardCount Int) (CardCount Integer)
p forall i e. Ix i => Array i e -> i -> e
! forall i. i -> i -> i -> CardCount i
CardCount Int
no Int
nq (Int
nkforall a. Num a => a -> a -> a
-Int
1)) forall a. Num a => a -> a -> a
+
                           -- "kq*****"
                           Integer
allP))
                (forall (m :: * -> *) a1 a2 a3 r.
Monad m =>
(a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
liftM3 forall i. i -> i -> i -> CardCount i
CardCount [Int
1..Int
mo] [Int
1..Int
mq] [Int
1..Int
mk])
   in  Array (CardCount Int) (CardCount Integer)
p

possibilitiesCardsBorder2Dynamic ::
   CardCount Int -> Array (CardCount Int) (CardCount Integer)
possibilitiesCardsBorder2Dynamic :: CardCount Int -> Array (CardCount Int) (CardCount Integer)
possibilitiesCardsBorder2Dynamic (CardCount Int
mo Int
mq Int
mk) =
   let p :: Array (CardCount Int) (CardCount Integer)
p =
          forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array (forall i. i -> i -> i -> CardCount i
CardCount Int
0 Int
0 Int
0, forall i. i -> i -> i -> CardCount i
CardCount Int
mo Int
mq Int
mk) forall a b. (a -> b) -> a -> b
$
          forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> [a] -> [(a, b)]
sample (forall (m :: * -> *) a1 a2 a3 r.
Monad m =>
(a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
liftM3 forall i. i -> i -> i -> CardCount i
CardCount [Int
0..Int
mo] [Int
0..Int
mq] [Int
0..Int
mk]) forall a b. (a -> b) -> a -> b
$
          \(CardCount Int
no Int
nq Int
nk) ->
             let allP :: Integer
allP = forall a. Integral a => [a] -> a
Comb.multinomial [forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
no, forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nqforall a. Num a => a -> a -> a
-Integer
1, forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nkforall a. Num a => a -> a -> a
-Integer
1]
                 test0 :: t -> (t -> CardCount Int) -> (CardCount Integer -> a) -> a
test0 t
n t -> CardCount Int
f CardCount Integer -> a
g =
                    if t
nforall a. Eq a => a -> a -> Bool
==t
0
                      then a
0
                      else CardCount Integer -> a
g forall a b. (a -> b) -> a -> b
$ Array (CardCount Int) (CardCount Integer)
p forall i e. Ix i => Array i e -> i -> e
! t -> CardCount Int
f (t
nforall a. Num a => a -> a -> a
-t
1)
             in  forall i. i -> i -> i -> CardCount i
CardCount
                    (forall {t} {a}.
(Eq t, Num t, Num a) =>
t -> (t -> CardCount Int) -> (CardCount Integer -> a) -> a
test0 Int
no (\Int
io -> forall i. i -> i -> i -> CardCount i
CardCount Int
io Int
nq Int
nk) forall a b. (a -> b) -> a -> b
$
                       -- " ******"
                       forall i. Num i => CardCount i -> i
sumCard)
                    (forall {t} {a}.
(Eq t, Num t, Num a) =>
t -> (t -> CardCount Int) -> (CardCount Integer -> a) -> a
test0 Int
nq (\Int
iq -> forall i. i -> i -> i -> CardCount i
CardCount Int
no Int
iq Int
nk) forall a b. (a -> b) -> a -> b
$ \CardCount Integer
pc ->
                       -- "q *****"
                       forall i. CardCount i -> i
otherCount CardCount Integer
pc forall a. Num a => a -> a -> a
+
                       -- "qq*****"
                       forall i. CardCount i -> i
queenCount CardCount Integer
pc forall a. Num a => a -> a -> a
+
                       -- "qk*****"
                       Integer
allP)
                    (forall {t} {a}.
(Eq t, Num t, Num a) =>
t -> (t -> CardCount Int) -> (CardCount Integer -> a) -> a
test0 Int
nk (\Int
ik -> forall i. i -> i -> i -> CardCount i
CardCount Int
no Int
nq Int
ik) forall a b. (a -> b) -> a -> b
$ \CardCount Integer
pc ->
                       -- "k *****"
                       forall i. CardCount i -> i
otherCount CardCount Integer
pc forall a. Num a => a -> a -> a
+
                       -- "kk*****"
                       forall i. CardCount i -> i
kingCount  CardCount Integer
pc forall a. Num a => a -> a -> a
+
                       -- "kq*****"
                       Integer
allP)
   in  Array (CardCount Int) (CardCount Integer)
p

{-
for \{o,q,k\} \subset \{1,2,\dots\}
O_{o,q,k} = O_{o-1,q,k} + Q_{o-1,q,k} + K_{o-1,q,k}
Q_{o,q,k} = O_{o,q-1,k} + Q_{o,q-1,k} + M(o,q-1,k-1)
K_{o,q,k} = O_{o,q,k-1} + K_{o,q,k-1} + M(o,q-1,k-1)

O = (O+Q+K)->(1,0,0)
Q = (O+Q)->(0,1,0) + M->(0,1,1)
K = (O+K)->(0,0,1) + M->(0,1,1)

O = (O+Q+K)·x
Q = (O+Q)·y + y·z/(1-x-y-z)
K = (O+K)·z + y·z/(1-x-y-z)

Q·(1-y) = O·y + y·z/(1-x-y-z)
K·(1-z) = O·z + y·z/(1-x-y-z)

O = (O + (O·y + y·z/(1-x-y-z))/(1-y) + (O·z + y·z/(1-x-y-z))/(1-z))·x
O·(1-x-y-z)·(1-x)
   = ((O·y·(1-x-y-z) + y·z)/(1-y) + (O·z·(1-x-y-z) + y·z)/(1-z))·x
O·(1-x-y-z)·(1-x)·(1-y)·(1-z)
   = ((O·(1-x-y-z) + z)·y·(1-z) + (O·(1-x-y-z) + y)·z·(1-y))·x
O·(1-x-y-z + (1+x)·y·z)·(1-x-y-z) = x·y·z·(2-y-z)

O+Q+K = O/x
  = y·z·(2-y-z) / (1-x-y-z + (1+x)·y·z) / (1-x-y-z)
-}


{-
Pascalsches Dreieck als Potenzreihe von 1/(1-x-y)
ausgerechnet mit Matrizen.

/n_{0,2}\   /n_{0,1}\
|n_{1,1}| = |n_{1,0}|
\n_{1,2}/   \n_{1,1}/

/n_{1,1}\   /n_{0,1}\
|n_{2,0}| = |n_{1,0}|
\n_{2,1}/   \n_{1,1}/
-}


numberOfAllPossibilities :: CardCount Int -> Integer
numberOfAllPossibilities :: CardCount Int -> Integer
numberOfAllPossibilities (CardCount Int
no Int
nq Int
nk) =
   forall a. Integral a => [a] -> a
Comb.multinomial [forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
no, forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nq, forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nk]


cardSetSizeSkat :: CardCount Int
cardSetSizeSkat :: CardCount Int
cardSetSizeSkat = forall i. i -> i -> i -> CardCount i
CardCount Int
24 Int
4 Int
4

numberOfPossibilitiesSkat :: Integer
numberOfPossibilitiesSkat :: Integer
numberOfPossibilitiesSkat =
   forall i. Num i => CardCount i -> i
sumCard forall a b. (a -> b) -> a -> b
$ CardCount Int -> Array (CardCount Int) (CardCount Integer)
possibilitiesCardsBorder2Dynamic CardCount Int
cardSetSizeSkat forall i e. Ix i => Array i e -> i -> e
! CardCount Int
cardSetSizeSkat

probabilitySkat :: Double
probabilitySkat :: Double
probabilitySkat =
   forall a. Fractional a => Rational -> a
fromRational forall a b. (a -> b) -> a -> b
$
   Integer
numberOfPossibilitiesSkat forall a. Integral a => a -> a -> Ratio a
% CardCount Int -> Integer
numberOfAllPossibilities CardCount Int
cardSetSizeSkat


cardSetSizeRummy :: CardCount Int
cardSetSizeRummy :: CardCount Int
cardSetSizeRummy = forall i. i -> i -> i -> CardCount i
CardCount Int
44 Int
4 Int
4

numberOfPossibilitiesRummy :: Integer
numberOfPossibilitiesRummy :: Integer
numberOfPossibilitiesRummy =
   forall i. Num i => CardCount i -> i
sumCard forall a b. (a -> b) -> a -> b
$ CardCount Int -> Array (CardCount Int) (CardCount Integer)
possibilitiesCardsBorder2Dynamic CardCount Int
cardSetSizeRummy forall i e. Ix i => Array i e -> i -> e
! CardCount Int
cardSetSizeRummy

probabilityRummy :: Double
probabilityRummy :: Double
probabilityRummy =
   forall a. Fractional a => Rational -> a
fromRational forall a b. (a -> b) -> a -> b
$
   Integer
numberOfPossibilitiesRummy forall a. Integral a => a -> a -> Ratio a
% CardCount Int -> Integer
numberOfAllPossibilities CardCount Int
cardSetSizeRummy


{- |
Allow both Jack and King adjacent to Queen.
-}
cardSetSizeRummyJK :: CardCount Int
cardSetSizeRummyJK :: CardCount Int
cardSetSizeRummyJK = forall i. i -> i -> i -> CardCount i
CardCount Int
40 Int
4 Int
8

numberOfPossibilitiesRummyJK :: Integer
numberOfPossibilitiesRummyJK :: Integer
numberOfPossibilitiesRummyJK =
   forall i. Num i => CardCount i -> i
sumCard forall a b. (a -> b) -> a -> b
$ CardCount Int -> Array (CardCount Int) (CardCount Integer)
possibilitiesCardsBorder2Dynamic CardCount Int
cardSetSizeRummyJK forall i e. Ix i => Array i e -> i -> e
! CardCount Int
cardSetSizeRummyJK

probabilityRummyJK :: Double
probabilityRummyJK :: Double
probabilityRummyJK =
   forall a. Fractional a => Rational -> a
fromRational forall a b. (a -> b) -> a -> b
$
   Integer
numberOfPossibilitiesRummyJK forall a. Integral a => a -> a -> Ratio a
% CardCount Int -> Integer
numberOfAllPossibilities CardCount Int
cardSetSizeRummyJK