Safe Haskell | None |
---|---|
Language | Haskell2010 |
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:
- data Step
- type LatticePath = [Step]
- asciiPath :: LatticePath -> ASCII
- isValidPath :: LatticePath -> Bool
- isDyckPath :: LatticePath -> Bool
- pathHeight :: LatticePath -> Int
- pathEndpoint :: LatticePath -> (Int, Int)
- pathCoordinates :: LatticePath -> [(Int, Int)]
- pathNumberOfUpSteps :: LatticePath -> Int
- pathNumberOfDownSteps :: LatticePath -> Int
- pathNumberOfUpDownSteps :: LatticePath -> (Int, Int)
- pathNumberOfPeaks :: LatticePath -> Int
- pathNumberOfZeroTouches :: LatticePath -> Int
- pathNumberOfTouches' :: Int -> LatticePath -> Int
- dyckPaths :: Int -> [LatticePath]
- dyckPathsNaive :: Int -> [LatticePath]
- countDyckPaths :: Int -> Integer
- nestedParensToDyckPath :: [Paren] -> LatticePath
- dyckPathToNestedParens :: LatticePath -> [Paren]
- boundedDyckPaths :: Int -> Int -> [LatticePath]
- boundedDyckPathsNaive :: Int -> Int -> [LatticePath]
- latticePaths :: (Int, Int) -> [LatticePath]
- latticePathsNaive :: (Int, Int) -> [LatticePath]
- countLatticePaths :: (Int, Int) -> Integer
- touchingDyckPaths :: Int -> Int -> [LatticePath]
- touchingDyckPathsNaive :: Int -> Int -> [LatticePath]
- countTouchingDyckPaths :: Int -> Int -> Integer
- peakingDyckPaths :: Int -> Int -> [LatticePath]
- peakingDyckPathsNaive :: Int -> Int -> [LatticePath]
- countPeakingDyckPaths :: Int -> Int -> Integer
- randomDyckPath :: RandomGen g => Int -> g -> (LatticePath, g)
Types
A step in a lattice path
type LatticePath = [Step] Source
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).
ascii drawing of paths
asciiPath :: LatticePath -> ASCII Source
Draws the path into a list of lines. For example try:
autotabulate RowMajor (Right 5) (map asciiPath $ dyckPaths 4)
elementary queries
isValidPath :: LatticePath -> Bool Source
A lattice path is called "valid", if it never goes below the y=0
line.
isDyckPath :: LatticePath -> Bool Source
A Dyck path is a lattice path whose last point lies on the y=0
line
pathHeight :: LatticePath -> Int Source
Maximal height of a lattice path
pathEndpoint :: LatticePath -> (Int, Int) Source
Endpoint of a lattice path, which starts from (0,0)
.
pathCoordinates :: LatticePath -> [(Int, Int)] Source
Returns the coordinates of the path (excluding the starting point (0,0)
, but including
the endpoint)
pathNumberOfUpSteps :: LatticePath -> Int Source
Counts the up-steps
pathNumberOfDownSteps :: LatticePath -> Int Source
Counts the down-steps
pathNumberOfUpDownSteps :: LatticePath -> (Int, Int) Source
Counts both the up-steps and down-steps
path-specific queries
pathNumberOfPeaks :: LatticePath -> Int Source
Number of peaks of a path (excluding the endpoint)
pathNumberOfZeroTouches :: LatticePath -> Int Source
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!).
:: Int |
|
-> LatticePath | |
-> Int |
Number of points on the path which touch the level line at height h
(excluding the starting point (0,0)
, but including the endpoint).
Dyck paths
dyckPaths :: Int -> [LatticePath] Source
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)
dyckPathsNaive :: Int -> [LatticePath] Source
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
countDyckPaths :: Int -> Integer Source
The number of Dyck paths from (0,0)
to (2m,0)
is simply the m'th Catalan number.
nestedParensToDyckPath :: [Paren] -> LatticePath Source
The trivial bijection
dyckPathToNestedParens :: LatticePath -> [Paren] Source
The trivial bijection in the other direction
Bounded Dyck paths
:: Int |
|
-> Int |
|
-> [LatticePath] |
boundedDyckPaths h m
lists all Dyck paths from (0,0)
to (2m,0)
whose height is at most h
.
Synonym for boundedDyckPathsNaive
.
:: Int |
|
-> Int |
|
-> [LatticePath] |
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.
More general lattice paths
latticePaths :: (Int, Int) -> [LatticePath] Source
All lattice paths from (0,0)
to (x,y)
. Clearly empty unless x-y
is even.
Synonym for latticePathsNaive
latticePathsNaive :: (Int, Int) -> [LatticePath] Source
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.
countLatticePaths :: (Int, Int) -> Integer Source
Lattice paths are counted by the numbers in the Catalan triangle.
Zero-level touches
:: Int |
|
-> Int |
|
-> [LatticePath] |
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
.
:: Int |
|
-> Int |
|
-> [LatticePath] |
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.
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.
Dyck paths with given number of peaks
:: Int |
|
-> Int |
|
-> [LatticePath] |
peakingDyckPaths k m
lists all Dyck paths from (0,0)
to (2m,0)
with exactly k
peaks.
Synonym for peakingDyckPathsNaive
:: Int |
|
-> Int |
|
-> [LatticePath] |
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.
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
Random lattice paths
randomDyckPath :: RandomGen g => Int -> g -> (LatticePath, g) Source
A uniformly random Dyck path of length 2m