{- |
Number of possible games as described in
<http://projecteuler.net/problem=306>.
-}
module Combinatorics.PaperStripGame (
   numbersOfGames,
   numbersOfGamesSeries,
   treeOfGames,
   ) where

import qualified Combinatorics as Combi
import qualified PowerSeries as PS
import qualified Data.List.HT as ListHT
import qualified Data.Tree as Tree
import Data.Tree (Tree, )
import Data.List (inits, tails, )
import Control.Monad (guard, )


{-
representation:
store the original position of every box
-}
_cutEverywhere0 :: [Int] -> [[Int]]
_cutEverywhere0 :: [Int] -> [[Int]]
_cutEverywhere0 [Int]
xs = do
   ([Int]
ys, Int
z0:Int
z1:[Int]
zs) <- forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. [a] -> [[a]]
inits [Int]
xs) (forall a. [a] -> [[a]]
tails [Int]
xs)
   forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> a
succ Int
z0 forall a. Eq a => a -> a -> Bool
== Int
z1
   forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Int]
ysforall a. [a] -> [a] -> [a]
++[Int]
zs

{-
representation:
list the sizes of the parts

cutEverywhere1 [10] ~ cutEverywhere [0..9]
cutEverywhere1 [2,5] ~ cutEverywhere [0,1,3,4,5,6,7]
                  or   cutEverywhere [0,1,4,5,6,7,8]
-}
cutEverywhere1 :: [Int] -> [[Int]]
cutEverywhere1 :: [Int] -> [[Int]]
cutEverywhere1 [Int]
zs = do
   ([Int]
xs,Int
n,[Int]
ys) <- forall a. [a] -> [([a], a, [a])]
ListHT.splitEverywhere [Int]
zs
   (Int
a,Int
b) <- Int -> [(Int, Int)]
cutPart Int
n
   forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Int]
xs forall a. [a] -> [a] -> [a]
++ forall a. (a -> Bool) -> [a] -> [a]
filter (Int
0forall a. Eq a => a -> a -> Bool
/=) [Int
a,Int
b] forall a. [a] -> [a] -> [a]
++ [Int]
ys

cutPart :: Int -> [(Int, Int)]
cutPart :: Int -> [(Int, Int)]
cutPart Int
n =
   forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Ord a => a -> a -> Bool
>=Int
0) forall a b. (a -> b) -> a -> b
$ forall a. (a -> a) -> a -> [a]
iterate forall a. Enum a => a -> a
pred (Int
nforall a. Num a => a -> a -> a
-Int
2)

treeOfGames :: Int -> Tree [Int]
treeOfGames :: Int -> Tree [Int]
treeOfGames Int
n =
   forall b a. (b -> (a, [b])) -> b -> Tree a
Tree.unfoldTree (\[Int]
ns -> ([Int]
ns, if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
ns then [] else [Int] -> [[Int]]
cutEverywhere1 [Int]
ns)) [Int
n]

lengthOfGames :: Int -> [Int]
lengthOfGames :: Int -> [Int]
lengthOfGames =
   let go :: t -> [Int] -> [t]
go t
n [Int]
ls =
          if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Ord a => a -> a -> Bool
<=Int
1) [Int]
ls
            then [t
n]
            else forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (t -> [Int] -> [t]
go (forall a. Enum a => a -> a
succ t
n)) forall a b. (a -> b) -> a -> b
$ [Int] -> [[Int]]
cutEverywhere1 [Int]
ls
   in  forall {t}. Enum t => t -> [Int] -> [t]
go Int
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[])

{-
[1,1,1,2,3,6,12,26,60,144,366,960,2640,7464,21960,66240,206760,660240,2172240,7298640,...
-}
numbersOfGames :: [Int]
numbersOfGames :: [Int]
numbersOfGames =
   forall a b. (a -> b) -> [a] -> [b]
map (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Int]
lengthOfGames) [Int
0..]

{-
directions:
  number of boxes ->
  length of game v

That is, the k-th column contains the histogram of (lengthOfGames n).

  |  0   1   2   3   4   5   6   7   8   9  10
----------------------------------------------
0 |  1   1
1 |          1   2   1
2 |                  2   6   6   2
3 |                          6  24  36  24   6
4 |                                 24 120 240
5 |                                        120


a_n_k = binomial (n+1) (k-2*n) * factorial k
-}


numbersOfGamesSeries :: [Integer]
numbersOfGamesSeries :: [Integer]
numbersOfGamesSeries =
   forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Integer
x0:Integer
x1:[Integer]
xs) [Integer]
ys -> Integer
x0 forall a. a -> [a] -> [a]
: Integer
x1 forall a. a -> [a] -> [a]
: forall a. Num a => [a] -> [a] -> [a]
PS.add [Integer]
xs [Integer]
ys) [] forall a b. (a -> b) -> a -> b
$
   forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. Num a => a -> [a] -> [a]
PS.scale forall a. Num a => [a]
Combi.factorials forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
tail forall a. Num a => [[a]]
Combi.binomials