-- | Dyck paths, lattice paths, etc
--
-- For example, the following figure represents a Dyck path of height 5 with 3 zero-touches (not counting the starting point,
-- but counting the endpoint) and 7 peaks:
--
-- <<svg/dyck_path.svg>>
--

{-# LANGUAGE BangPatterns, FlexibleInstances, TypeSynonymInstances #-}
module Math.Combinat.LatticePaths where

--------------------------------------------------------------------------------

import Data.List
import System.Random

import Math.Combinat.Classes
import Math.Combinat.Numbers
import Math.Combinat.Trees.Binary
import Math.Combinat.ASCII as ASCII

--------------------------------------------------------------------------------
-- * Types

-- | A step in a lattice path
data Step 
  = UpStep         -- ^ the step @(1,1)@
  | DownStep       -- ^ the step @(1,-1)@
  deriving (Step -> Step -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Step -> Step -> Bool
$c/= :: Step -> Step -> Bool
== :: Step -> Step -> Bool
$c== :: Step -> Step -> Bool
Eq,Eq Step
Step -> Step -> Bool
Step -> Step -> Ordering
Step -> Step -> Step
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 :: Step -> Step -> Step
$cmin :: Step -> Step -> Step
max :: Step -> Step -> Step
$cmax :: Step -> Step -> Step
>= :: Step -> Step -> Bool
$c>= :: Step -> Step -> Bool
> :: Step -> Step -> Bool
$c> :: Step -> Step -> Bool
<= :: Step -> Step -> Bool
$c<= :: Step -> Step -> Bool
< :: Step -> Step -> Bool
$c< :: Step -> Step -> Bool
compare :: Step -> Step -> Ordering
$ccompare :: Step -> Step -> Ordering
Ord,Int -> Step -> ShowS
[Step] -> ShowS
Step -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Step] -> ShowS
$cshowList :: [Step] -> ShowS
show :: Step -> String
$cshow :: Step -> String
showsPrec :: Int -> Step -> ShowS
$cshowsPrec :: Int -> Step -> ShowS
Show)

-- | A lattice path is a path using only the allowed steps, never going below the zero level line @y=0@. 
--
-- Note that if you rotate such a path by 45 degrees counterclockwise,
-- you get a path which uses only the steps @(1,0)@ and @(0,1)@, and stays
-- above the main diagonal (hence the name, we just use a different convention).
--
type LatticePath = [Step]

--------------------------------------------------------------------------------
-- * ascii drawing of paths

-- | Draws the path into a list of lines. For example try:
--
-- > autotabulate RowMajor (Right 5) (map asciiPath $ dyckPaths 4)
--
asciiPath :: LatticePath -> ASCII
asciiPath :: [Step] -> ASCII
asciiPath [Step]
p = [String] -> ASCII
asciiFromLines forall a b. (a -> b) -> a -> b
$ forall a. [[a]] -> [[a]]
transpose (Int -> [Step] -> [String]
go Int
0 [Step]
p) where

  go :: Int -> [Step] -> [String]
go !Int
h [] = []
  go !Int
h (Step
x:[Step]
xs) = case Step
x of
    Step
UpStep   -> Int -> Step -> String
ee  Int
h    Step
x forall a. a -> [a] -> [a]
: Int -> [Step] -> [String]
go (Int
hforall a. Num a => a -> a -> a
+Int
1) [Step]
xs
    Step
DownStep -> Int -> Step -> String
ee (Int
hforall a. Num a => a -> a -> a
-Int
1) Step
x forall a. a -> [a] -> [a]
: Int -> [Step] -> [String]
go (Int
hforall a. Num a => a -> a -> a
-Int
1) [Step]
xs

  maxh :: Int
maxh   = [Step] -> Int
pathHeight [Step]
p

  ee :: Int -> Step -> String
ee Int
h Step
x = forall a. Int -> a -> [a]
replicate (Int
maxhforall a. Num a => a -> a -> a
-Int
hforall a. Num a => a -> a -> a
-Int
1) Char
' ' forall a. [a] -> [a] -> [a]
++ [Step -> Char
ch Step
x] forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate Int
h Char
' '
  ch :: Step -> Char
ch Step
x   = case Step
x of 
    Step
UpStep   -> Char
'/' 
    Step
DownStep -> Char
'\\' 

instance DrawASCII LatticePath where 
  ascii :: [Step] -> ASCII
ascii = [Step] -> ASCII
asciiPath

--------------------------------------------------------------------------------
-- * elementary queries

-- | A lattice path is called \"valid\", if it never goes below the @y=0@ line.
isValidPath :: LatticePath -> Bool
isValidPath :: [Step] -> Bool
isValidPath = Int -> [Step] -> Bool
go Int
0 where
  go :: Int -> LatticePath -> Bool
  go :: Int -> [Step] -> Bool
go !Int
y []     = Int
yforall a. Ord a => a -> a -> Bool
>=Int
0
  go !Int
y (Step
t:[Step]
ts) = let y' :: Int
y' = case Step
t of { Step
UpStep -> Int
yforall a. Num a => a -> a -> a
+Int
1 ; Step
DownStep -> Int
yforall a. Num a => a -> a -> a
-Int
1 }
                 in  if Int
y'forall a. Ord a => a -> a -> Bool
<Int
0 then Bool
False 
                             else Int -> [Step] -> Bool
go Int
y' [Step]
ts

-- | A Dyck path is a lattice path whose last point lies on the @y=0@ line
isDyckPath :: LatticePath -> Bool
isDyckPath :: [Step] -> Bool
isDyckPath = Int -> [Step] -> Bool
go Int
0 where
  go :: Int -> LatticePath -> Bool
  go :: Int -> [Step] -> Bool
go !Int
y []     = Int
yforall a. Eq a => a -> a -> Bool
==Int
0
  go !Int
y (Step
t:[Step]
ts) = let y' :: Int
y' = case Step
t of { Step
UpStep -> Int
yforall a. Num a => a -> a -> a
+Int
1 ; Step
DownStep -> Int
yforall a. Num a => a -> a -> a
-Int
1 }
                 in  if Int
y'forall a. Ord a => a -> a -> Bool
<Int
0 then Bool
False 
                             else Int -> [Step] -> Bool
go Int
y' [Step]
ts

-- | Maximal height of a lattice path
pathHeight :: LatticePath -> Int
pathHeight :: [Step] -> Int
pathHeight = Int -> Int -> [Step] -> Int
go Int
0 Int
0 where
  go :: Int -> Int -> LatticePath -> Int
  go :: Int -> Int -> [Step] -> Int
go !Int
h !Int
y []     = Int
h
  go !Int
h !Int
y (Step
t:[Step]
ts) = case Step
t of
    Step
UpStep   -> Int -> Int -> [Step] -> Int
go (forall a. Ord a => a -> a -> a
max Int
h (Int
yforall a. Num a => a -> a -> a
+Int
1)) (Int
yforall a. Num a => a -> a -> a
+Int
1) [Step]
ts
    Step
DownStep -> Int -> Int -> [Step] -> Int
go      Int
h        (Int
yforall a. Num a => a -> a -> a
-Int
1) [Step]
ts

instance HasHeight LatticePath where
  height :: [Step] -> Int
height = [Step] -> Int
pathHeight

instance HasWidth LatticePath where
  width :: [Step] -> Int
width = forall (t :: * -> *) a. Foldable t => t a -> Int
length

-- | Endpoint of a lattice path, which starts from @(0,0)@.
pathEndpoint :: LatticePath -> (Int,Int)
pathEndpoint :: [Step] -> (Int, Int)
pathEndpoint = Int -> Int -> [Step] -> (Int, Int)
go Int
0 Int
0 where
  go :: Int -> Int -> LatticePath -> (Int,Int)
  go :: Int -> Int -> [Step] -> (Int, Int)
go !Int
x !Int
y []     = (Int
x,Int
y)
  go !Int
x !Int
y (Step
t:[Step]
ts) = case Step
t of                         
    Step
UpStep   -> Int -> Int -> [Step] -> (Int, Int)
go (Int
xforall a. Num a => a -> a -> a
+Int
1) (Int
yforall a. Num a => a -> a -> a
+Int
1) [Step]
ts
    Step
DownStep -> Int -> Int -> [Step] -> (Int, Int)
go (Int
xforall a. Num a => a -> a -> a
+Int
1) (Int
yforall a. Num a => a -> a -> a
-Int
1) [Step]
ts

-- | Returns the coordinates of the path (excluding the starting point @(0,0)@, but including
-- the endpoint)
pathCoordinates :: LatticePath -> [(Int,Int)]
pathCoordinates :: [Step] -> [(Int, Int)]
pathCoordinates = Int -> Int -> [Step] -> [(Int, Int)]
go Int
0 Int
0 where
  go :: Int -> Int -> LatticePath -> [(Int,Int)]
  go :: Int -> Int -> [Step] -> [(Int, Int)]
go Int
_  Int
_  []     = []
  go !Int
x !Int
y (Step
t:[Step]
ts) = let x' :: Int
x' = Int
x forall a. Num a => a -> a -> a
+ Int
1
                        y' :: Int
y' = case Step
t of { Step
UpStep -> Int
yforall a. Num a => a -> a -> a
+Int
1 ; Step
DownStep -> Int
yforall a. Num a => a -> a -> a
-Int
1 }
                    in  (Int
x',Int
y') forall a. a -> [a] -> [a]
: Int -> Int -> [Step] -> [(Int, Int)]
go Int
x' Int
y' [Step]
ts

-- | Counts the up-steps
pathNumberOfUpSteps :: LatticePath -> Int
pathNumberOfUpSteps :: [Step] -> Int
pathNumberOfUpSteps   = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Step] -> (Int, Int)
pathNumberOfUpDownSteps

-- | Counts the down-steps
pathNumberOfDownSteps :: LatticePath -> Int
pathNumberOfDownSteps :: [Step] -> Int
pathNumberOfDownSteps = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Step] -> (Int, Int)
pathNumberOfUpDownSteps

-- | Counts both the up-steps and down-steps
pathNumberOfUpDownSteps :: LatticePath -> (Int,Int)
pathNumberOfUpDownSteps :: [Step] -> (Int, Int)
pathNumberOfUpDownSteps = Int -> Int -> [Step] -> (Int, Int)
go Int
0 Int
0 where 
  go :: Int -> Int -> LatticePath -> (Int,Int)
  go :: Int -> Int -> [Step] -> (Int, Int)
go !Int
u !Int
d (Step
p:[Step]
ps) = case Step
p of 
    Step
UpStep   -> Int -> Int -> [Step] -> (Int, Int)
go (Int
uforall a. Num a => a -> a -> a
+Int
1)  Int
d    [Step]
ps  
    Step
DownStep -> Int -> Int -> [Step] -> (Int, Int)
go  Int
u    (Int
dforall a. Num a => a -> a -> a
+Int
1) [Step]
ps    
  go !Int
u !Int
d []     = (Int
u,Int
d)

--------------------------------------------------------------------------------
-- * path-specific queries

-- | Number of peaks of a path (excluding the endpoint)
pathNumberOfPeaks :: LatticePath -> Int
pathNumberOfPeaks :: [Step] -> Int
pathNumberOfPeaks = Int -> [Step] -> Int
go Int
0 where
  go :: Int -> LatticePath -> Int
  go :: Int -> [Step] -> Int
go !Int
k (Step
x:xs :: [Step]
xs@(Step
y:[Step]
_)) = Int -> [Step] -> Int
go (if Step
xforall a. Eq a => a -> a -> Bool
==Step
UpStep Bool -> Bool -> Bool
&& Step
yforall a. Eq a => a -> a -> Bool
==Step
DownStep then Int
kforall a. Num a => a -> a -> a
+Int
1 else Int
k) [Step]
xs
  go !Int
k [Step
x] = Int
k
  go !Int
k [ ] = Int
k

-- | Number of points on the path which touch the @y=0@ zero level line
-- (excluding the starting point @(0,0)@, but including the endpoint; that is, for Dyck paths it this is always positive!).
pathNumberOfZeroTouches :: LatticePath -> Int
pathNumberOfZeroTouches :: [Step] -> Int
pathNumberOfZeroTouches = Int -> [Step] -> Int
pathNumberOfTouches' Int
0

-- | Number of points on the path which touch the level line at height @h@
-- (excluding the starting point @(0,0)@, but including the endpoint).
pathNumberOfTouches' 
  :: Int       -- ^ @h@ = the touch level
  -> LatticePath -> Int
pathNumberOfTouches' :: Int -> [Step] -> Int
pathNumberOfTouches' Int
h = Int -> Int -> Int -> [Step] -> Int
go Int
0 Int
0 Int
0 where
  go :: Int -> Int -> Int -> LatticePath -> Int
  go :: Int -> Int -> Int -> [Step] -> Int
go !Int
cnt Int
_  Int
_  []     = Int
cnt
  go !Int
cnt !Int
x !Int
y (Step
t:[Step]
ts) = let y' :: Int
y'   = case Step
t of { Step
UpStep -> Int
yforall a. Num a => a -> a -> a
+Int
1 ; Step
DownStep -> Int
yforall a. Num a => a -> a -> a
-Int
1 }
                             cnt' :: Int
cnt' = if Int
y'forall a. Eq a => a -> a -> Bool
==Int
h then Int
cntforall a. Num a => a -> a -> a
+Int
1 else Int
cnt
                         in  Int -> Int -> Int -> [Step] -> Int
go Int
cnt' (Int
xforall a. Num a => a -> a -> a
+Int
1) Int
y' [Step]
ts

--------------------------------------------------------------------------------
-- * Dyck paths

-- | @dyckPaths m@ lists all Dyck paths from @(0,0)@ to @(2m,0)@. 
-- 
-- Remark: Dyck paths are obviously in bijection with nested parentheses, and thus
-- also with binary trees.
--
-- Order is reverse lexicographical:
--
-- > sort (dyckPaths m) == reverse (dyckPaths m)
-- 
dyckPaths :: Int -> [LatticePath]
dyckPaths :: Int -> [[Step]]
dyckPaths = forall a b. (a -> b) -> [a] -> [b]
map [Paren] -> [Step]
nestedParensToDyckPath forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [[Paren]]
nestedParentheses 

-- | @dyckPaths m@ lists all Dyck paths from @(0,0)@ to @(2m,0)@. 
--
-- > sort (dyckPathsNaive m) == sort (dyckPaths m) 
--  
-- Naive recursive algorithm, order is ad-hoc
--
dyckPathsNaive :: Int -> [LatticePath]
dyckPathsNaive :: Int -> [[Step]]
dyckPathsNaive = forall {a}. (Eq a, Enum a, Num a) => a -> [[Step]]
worker where
  worker :: a -> [[Step]]
worker  a
0 = [[]]
  worker  a
m = [[Step]]
as forall a. [a] -> [a] -> [a]
++ [[Step]]
bs where
    as :: [[Step]]
as = [ [Step] -> [Step]
bracket [Step]
p      | [Step]
p <- a -> [[Step]]
worker (a
mforall a. Num a => a -> a -> a
-a
1) ] 
    bs :: [[Step]]
bs = [ [Step] -> [Step]
bracket [Step]
p forall a. [a] -> [a] -> [a]
++ [Step]
q | a
k <- [a
1..a
mforall a. Num a => a -> a -> a
-a
1] , [Step]
p <- a -> [[Step]]
worker (a
kforall a. Num a => a -> a -> a
-a
1) , [Step]
q <- a -> [[Step]]
worker (a
mforall a. Num a => a -> a -> a
-a
k) ]
  bracket :: [Step] -> [Step]
bracket [Step]
p = Step
UpStep forall a. a -> [a] -> [a]
: [Step]
p forall a. [a] -> [a] -> [a]
++ [Step
DownStep]

-- | The number of Dyck paths from @(0,0)@ to @(2m,0)@ is simply the m\'th Catalan number.
countDyckPaths :: Int -> Integer
countDyckPaths :: Int -> Integer
countDyckPaths Int
m = forall a. Integral a => a -> Integer
catalan Int
m

-- | The trivial bijection
nestedParensToDyckPath :: [Paren] -> LatticePath
nestedParensToDyckPath :: [Paren] -> [Step]
nestedParensToDyckPath = forall a b. (a -> b) -> [a] -> [b]
map Paren -> Step
f where
  f :: Paren -> Step
f Paren
p = case Paren
p of { Paren
LeftParen -> Step
UpStep ; Paren
RightParen -> Step
DownStep }

-- | The trivial bijection in the other direction
dyckPathToNestedParens :: LatticePath -> [Paren]
dyckPathToNestedParens :: [Step] -> [Paren]
dyckPathToNestedParens = forall a b. (a -> b) -> [a] -> [b]
map Step -> Paren
g where
  g :: Step -> Paren
g Step
s = case Step
s of { Step
UpStep -> Paren
LeftParen ; Step
DownStep -> Paren
RightParen }

--------------------------------------------------------------------------------
-- * Bounded Dyck paths

-- | @boundedDyckPaths h m@ lists all Dyck paths from @(0,0)@ to @(2m,0)@ whose height is at most @h@.
-- Synonym for 'boundedDyckPathsNaive'.
--
boundedDyckPaths
  :: Int   -- ^ @h@ = maximum height
  -> Int   -- ^ @m@ = half-length
  -> [LatticePath]
boundedDyckPaths :: Int -> Int -> [[Step]]
boundedDyckPaths = Int -> Int -> [[Step]]
boundedDyckPathsNaive 

-- | @boundedDyckPathsNaive h m@ lists all Dyck paths from @(0,0)@ to @(2m,0)@ whose height is at most @h@.
--
-- > sort (boundedDyckPaths h m) == sort [ p | p <- dyckPaths m , pathHeight p <= h ]
-- > sort (boundedDyckPaths m m) == sort (dyckPaths m) 
--
-- Naive recursive algorithm, resulting order is pretty ad-hoc.
--
boundedDyckPathsNaive
  :: Int   -- ^ @h@ = maximum height
  -> Int   -- ^ @m@ = half-length
  -> [LatticePath]
boundedDyckPathsNaive :: Int -> Int -> [[Step]]
boundedDyckPathsNaive = Int -> Int -> [[Step]]
worker where
  worker :: Int -> Int -> [[Step]]
worker !Int
h !Int
m 
    | Int
hforall a. Ord a => a -> a -> Bool
<Int
0        = []
    | Int
mforall a. Ord a => a -> a -> Bool
<Int
0        = []
    | Int
mforall a. Eq a => a -> a -> Bool
==Int
0       = [[]]
    | Int
hforall a. Ord a => a -> a -> Bool
<=Int
0       = []
    | Bool
otherwise  = [[Step]]
as forall a. [a] -> [a] -> [a]
++ [[Step]]
bs 
    where
      bracket :: [Step] -> [Step]
bracket [Step]
p = Step
UpStep forall a. a -> [a] -> [a]
: [Step]
p forall a. [a] -> [a] -> [a]
++ [Step
DownStep]
      as :: [[Step]]
as = [ [Step] -> [Step]
bracket [Step]
p      |                 [Step]
p <- Int -> Int -> [[Step]]
boundedDyckPaths (Int
hforall a. Num a => a -> a -> a
-Int
1) (Int
mforall a. Num a => a -> a -> a
-Int
1)                                 ]
      bs :: [[Step]]
bs = [ [Step] -> [Step]
bracket [Step]
p forall a. [a] -> [a] -> [a]
++ [Step]
q | Int
k <- [Int
1..Int
mforall a. Num a => a -> a -> a
-Int
1] , [Step]
p <- Int -> Int -> [[Step]]
boundedDyckPaths (Int
hforall a. Num a => a -> a -> a
-Int
1) (Int
kforall a. Num a => a -> a -> a
-Int
1) , [Step]
q <- Int -> Int -> [[Step]]
boundedDyckPaths Int
h (Int
mforall a. Num a => a -> a -> a
-Int
k) ]

--------------------------------------------------------------------------------
-- * More general lattice paths

-- | All lattice paths from @(0,0)@ to @(x,y)@. Clearly empty unless @x-y@ is even.
-- Synonym for 'latticePathsNaive'
--
latticePaths :: (Int,Int) -> [LatticePath]
latticePaths :: (Int, Int) -> [[Step]]
latticePaths = (Int, Int) -> [[Step]]
latticePathsNaive

-- | All lattice paths from @(0,0)@ to @(x,y)@. Clearly empty unless @x-y@ is even.
--
-- Note that
--
-- > sort (dyckPaths n) == sort (latticePaths (0,2*n))
--
-- Naive recursive algorithm, resulting order is pretty ad-hoc.
--
latticePathsNaive :: (Int,Int) -> [LatticePath]
latticePathsNaive :: (Int, Int) -> [[Step]]
latticePathsNaive (Int
x,Int
y) = Int -> Int -> [[Step]]
worker Int
x Int
y where
  worker :: Int -> Int -> [[Step]]
worker !Int
x !Int
y 
    | forall a. Integral a => a -> Bool
odd (Int
xforall a. Num a => a -> a -> a
-Int
y)     = []
    | Int
xforall a. Ord a => a -> a -> Bool
<Int
0           = []
    | Int
yforall a. Ord a => a -> a -> Bool
<Int
0           = []
    | Int
yforall a. Eq a => a -> a -> Bool
==Int
0          = Int -> [[Step]]
dyckPaths (forall a. Integral a => a -> a -> a
div Int
x Int
2)
    | Int
xforall a. Eq a => a -> a -> Bool
==Int
1 Bool -> Bool -> Bool
&& Int
yforall a. Eq a => a -> a -> Bool
==Int
1  = [[Step
UpStep]]
    | Bool
otherwise     = [[Step]]
as forall a. [a] -> [a] -> [a]
++ [[Step]]
bs
    where
      bracket :: [Step] -> [Step]
bracket [Step]
p = Step
UpStep forall a. a -> [a] -> [a]
: [Step]
p forall a. [a] -> [a] -> [a]
++ [Step
DownStep] 
      as :: [[Step]]
as = [ Step
UpStep forall a. a -> [a] -> [a]
: [Step]
p     | [Step]
p <- Int -> Int -> [[Step]]
worker (Int
xforall a. Num a => a -> a -> a
-Int
1) (Int
yforall a. Num a => a -> a -> a
-Int
1) ]
      bs :: [[Step]]
bs = [ [Step] -> [Step]
bracket [Step]
p forall a. [a] -> [a] -> [a]
++ [Step]
q | Int
k <- [Int
1..(forall a. Integral a => a -> a -> a
div Int
x Int
2)] , [Step]
p <- Int -> [[Step]]
dyckPaths (Int
kforall a. Num a => a -> a -> a
-Int
1) , [Step]
q <- Int -> Int -> [[Step]]
worker (Int
xforall a. Num a => a -> a -> a
-Int
2forall a. Num a => a -> a -> a
*Int
k) Int
y ]

-- | Lattice paths are counted by the numbers in the Catalan triangle.
countLatticePaths :: (Int,Int) -> Integer
countLatticePaths :: (Int, Int) -> Integer
countLatticePaths (Int
x,Int
y) 
  | forall a. Integral a => a -> Bool
even (Int
xforall a. Num a => a -> a -> a
+Int
y)  = forall a. Integral a => a -> a -> Integer
catalanTriangle (forall a. Integral a => a -> a -> a
div (Int
xforall a. Num a => a -> a -> a
+Int
y) Int
2) (forall a. Integral a => a -> a -> a
div (Int
xforall a. Num a => a -> a -> a
-Int
y) Int
2)
  | Bool
otherwise   = Integer
0

--------------------------------------------------------------------------------
-- * Zero-level touches

-- | @touchingDyckPaths k m@ lists all Dyck paths from @(0,0)@ to @(2m,0)@ which touch the 
-- zero level line @y=0@ exactly @k@ times (excluding the starting point, but including the endpoint;
-- thus, @k@ should be positive). Synonym for 'touchingDyckPathsNaive'.
touchingDyckPaths
  :: Int   -- ^ @k@ = number of zero-touches
  -> Int   -- ^ @m@ = half-length
  -> [LatticePath]
touchingDyckPaths :: Int -> Int -> [[Step]]
touchingDyckPaths = Int -> Int -> [[Step]]
touchingDyckPathsNaive


-- | @touchingDyckPathsNaive k m@ lists all Dyck paths from @(0,0)@ to @(2m,0)@ which touch the 
-- zero level line @y=0@ exactly @k@ times (excluding the starting point, but including the endpoint;
-- thus, @k@ should be positive).
--
-- > sort (touchingDyckPathsNaive k m) == sort [ p | p <- dyckPaths m , pathNumberOfZeroTouches p == k ]
-- 
-- Naive recursive algorithm, resulting order is pretty ad-hoc.
--
touchingDyckPathsNaive
  :: Int   -- ^ @k@ = number of zero-touches
  -> Int   -- ^ @m@ = half-length
  -> [LatticePath]
touchingDyckPathsNaive :: Int -> Int -> [[Step]]
touchingDyckPathsNaive = forall {t}. (Num t, Ord t) => t -> Int -> [[Step]]
worker where
  worker :: t -> Int -> [[Step]]
worker !t
k !Int
m 
    | Int
m forall a. Eq a => a -> a -> Bool
== Int
0    = if t
kforall a. Eq a => a -> a -> Bool
==t
0 then [[]] else []
    | t
k forall a. Ord a => a -> a -> Bool
<= t
0    = []
    | Int
m forall a. Ord a => a -> a -> Bool
<  Int
0    = []
    | t
k forall a. Eq a => a -> a -> Bool
== t
1    = [ [Step] -> [Step]
bracket [Step]
p      |                 [Step]
p <- Int -> [[Step]]
dyckPaths (Int
mforall a. Num a => a -> a -> a
-Int
1)                           ]
    | Bool
otherwise = [ [Step] -> [Step]
bracket [Step]
p forall a. [a] -> [a] -> [a]
++ [Step]
q | Int
l <- [Int
1..Int
mforall a. Num a => a -> a -> a
-Int
1] , [Step]
p <- Int -> [[Step]]
dyckPaths (Int
lforall a. Num a => a -> a -> a
-Int
1) , [Step]
q <- t -> Int -> [[Step]]
worker (t
kforall a. Num a => a -> a -> a
-t
1) (Int
mforall a. Num a => a -> a -> a
-Int
l) ]
    where
      bracket :: [Step] -> [Step]
bracket [Step]
p = Step
UpStep forall a. a -> [a] -> [a]
: [Step]
p forall a. [a] -> [a] -> [a]
++ [Step
DownStep] 


-- | There is a bijection from the set of non-empty Dyck paths of length @2n@ which touch the zero lines @t@ times,
-- to lattice paths from @(0,0)@ to @(2n-t-1,t-1)@ (just remove all the down-steps just before touching
-- the zero line, and also the very first up-step). This gives us a counting formula.
countTouchingDyckPaths 
  :: Int   -- ^ @k@ = number of zero-touches
  -> Int   -- ^ @m@ = half-length
  -> Integer
countTouchingDyckPaths :: Int -> Int -> Integer
countTouchingDyckPaths Int
t Int
n
  | Int
tforall a. Eq a => a -> a -> Bool
==Int
0 Bool -> Bool -> Bool
&& Int
nforall a. Eq a => a -> a -> Bool
==Int
0   = Integer
1
  | Bool
otherwise      = (Int, Int) -> Integer
countLatticePaths (Int
2forall a. Num a => a -> a -> a
*Int
nforall a. Num a => a -> a -> a
-Int
tforall a. Num a => a -> a -> a
-Int
1,Int
tforall a. Num a => a -> a -> a
-Int
1)

--------------------------------------------------------------------------------
-- * Dyck paths with given number of peaks

-- | @peakingDyckPaths k m@ lists all Dyck paths from @(0,0)@ to @(2m,0)@ with exactly @k@ peaks.
--
-- Synonym for 'peakingDyckPathsNaive'
--
peakingDyckPaths
  :: Int      -- ^ @k@ = number of peaks
  -> Int      -- ^ @m@ = half-length
  -> [LatticePath]
peakingDyckPaths :: Int -> Int -> [[Step]]
peakingDyckPaths = Int -> Int -> [[Step]]
peakingDyckPathsNaive 

-- | @peakingDyckPathsNaive k m@ lists all Dyck paths from @(0,0)@ to @(2m,0)@ with exactly @k@ peaks.
--
-- > sort (peakingDyckPathsNaive k m) = sort [ p | p <- dyckPaths m , pathNumberOfPeaks p == k ]
--  
-- Naive recursive algorithm, resulting order is pretty ad-hoc.
--
peakingDyckPathsNaive 
  :: Int      -- ^ @k@ = number of peaks
  -> Int      -- ^ @m@ = half-length
  -> [LatticePath]
peakingDyckPathsNaive :: Int -> Int -> [[Step]]
peakingDyckPathsNaive = forall {a}. (Ord a, Enum a, Num a) => a -> Int -> [[Step]]
worker where
  worker :: a -> Int -> [[Step]]
worker !a
k !Int
m
    | Int
m forall a. Eq a => a -> a -> Bool
== Int
0    = if a
kforall a. Eq a => a -> a -> Bool
==a
0 then [[]] else []       
    | a
k forall a. Ord a => a -> a -> Bool
<= a
0    = []
    | Int
m forall a. Ord a => a -> a -> Bool
<  Int
0    = []
    | a
k forall a. Eq a => a -> a -> Bool
== a
1    = [ Int -> [Step]
singlePeak Int
m ] 
    | Bool
otherwise = [[Step]]
as forall a. [a] -> [a] -> [a]
++ [[Step]]
bs forall a. [a] -> [a] -> [a]
++ [[Step]]
cs
    where
      as :: [[Step]]
as = [ [Step] -> [Step]
bracket [Step]
p      |                                 [Step]
p <- a -> Int -> [[Step]]
worker a
k (Int
mforall a. Num a => a -> a -> a
-Int
1)                           ]
      bs :: [[Step]]
bs = [ [Step]
smallHill forall a. [a] -> [a] -> [a]
++ [Step]
q |                                                       [Step]
q <- a -> Int -> [[Step]]
worker (a
kforall a. Num a => a -> a -> a
-a
1) (Int
mforall a. Num a => a -> a -> a
-Int
1) ]
      cs :: [[Step]]
cs = [ [Step] -> [Step]
bracket [Step]
p forall a. [a] -> [a] -> [a]
++ [Step]
q | Int
l <- [Int
2..Int
mforall a. Num a => a -> a -> a
-Int
1] , a
a <- [a
1..a
kforall a. Num a => a -> a -> a
-a
1] , [Step]
p <- a -> Int -> [[Step]]
worker a
a (Int
lforall a. Num a => a -> a -> a
-Int
1) , [Step]
q <- a -> Int -> [[Step]]
worker (a
kforall a. Num a => a -> a -> a
-a
a) (Int
mforall a. Num a => a -> a -> a
-Int
l) ]
      smallHill :: [Step]
smallHill     = [ Step
UpStep , Step
DownStep ]
      singlePeak :: Int -> [Step]
singlePeak !Int
m = forall a. Int -> a -> [a]
replicate Int
m Step
UpStep forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate Int
m Step
DownStep 
      bracket :: [Step] -> [Step]
bracket [Step]
p = Step
UpStep forall a. a -> [a] -> [a]
: [Step]
p forall a. [a] -> [a] -> [a]
++ [Step
DownStep] 

-- | Dyck paths of length @2m@ with @k@ peaks are counted by the Narayana numbers @N(m,k) = \binom{m}{k} \binom{m}{k-1} / m@
countPeakingDyckPaths
  :: Int      -- ^ @k@ = number of peaks
  -> Int      -- ^ @m@ = half-length
  -> Integer
countPeakingDyckPaths :: Int -> Int -> Integer
countPeakingDyckPaths Int
k Int
m 
  | Int
m forall a. Eq a => a -> a -> Bool
== Int
0    = if Int
kforall a. Eq a => a -> a -> Bool
==Int
0 then Integer
1 else Integer
0
  | Int
k forall a. Ord a => a -> a -> Bool
<= Int
0    = Integer
0
  | Int
m forall a. Ord a => a -> a -> Bool
<  Int
0    = Integer
0
  | Int
k forall a. Eq a => a -> a -> Bool
== Int
1    = Integer
1
  | Bool
otherwise = forall a. Integral a => a -> a -> a
div (forall a. Integral a => a -> a -> Integer
binomial Int
m Int
k forall a. Num a => a -> a -> a
* forall a. Integral a => a -> a -> Integer
binomial Int
m (Int
kforall a. Num a => a -> a -> a
-Int
1)) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m)

--------------------------------------------------------------------------------
-- * Random lattice paths

-- | A uniformly random Dyck path of length @2m@
randomDyckPath :: RandomGen g => Int -> g -> (LatticePath,g)
randomDyckPath :: forall g. RandomGen g => Int -> g -> ([Step], g)
randomDyckPath Int
m g
g0 = ([Paren] -> [Step]
nestedParensToDyckPath [Paren]
parens, g
g1) where
  ([Paren]
parens,g
g1) = forall g. RandomGen g => Int -> g -> ([Paren], g)
randomNestedParentheses Int
m g
g0

--------------------------------------------------------------------------------