A000129
A000129
Pell numbers
(0, 1, 2, 5, 12, 29, 70, 169, 408, 985, ...)
Number of lattice paths from (0,0) to the line x=n-1 consisting of
U=(1,1), D=(1,-1) and H=(2,0) steps; for example, a(3)=5, counting the paths
H, UD, UU, DU and DD. -- Emeric Deutsch
download source code
{-# LANGUAGE FlexibleContexts #-}
import Diagrams.Prelude
import Diagrams.Backend.SVG.CmdLine (B, defaultMain)
import Control.Monad (replicateM)
import Data.List (sort, transpose)
import Data.List.Split (chunksOf)
u, d, h, z :: (Int, Int)
u = (1, 1)
d = (1, -1)
h = (2, 0)
z = (0, 0)
add (a, b) (c, d) = (a + c, b + d)
v :: (Int, Int) -> V2 Double
v (a, b) = V2 (fromIntegral a) (fromIntegral b)
vs = map v . scanl add z
l = fst . foldr add z
paths n =
[ q
| m <- [0..n]
, q <- replicateM m [u,d,h]
, l q == n
]
draw n q
= frame 0.5
. (`atop` centerXY (strutY (fromIntegral n)))
. centerXY
$ mconcat
[ circle 0.25
# fc white
# translate pq
# lw thin
| pq <- vs q
] `atop` strokeT (trailFromOffsets (map v q))
grid = vcat . map hcat
diagram n m
= bg white
. centerXY
. grid
. transpose
. chunksOf m
. map (draw n)
. sort
$ paths n
main = defaultMain (diagram 5 10)
A000332
A000332
Binomial coefficient (n,4)
(0, 0, 0, 0, 1, 5, 15, 35, 70, 126, 210, 330, 495, 715, ...)
Number of equilateral triangles with vertices in an equilateral
triangular array of points with n rows (offset 1), with any orientation.
-- Ignacio Larrosa Cañestro
download source code
{-# LANGUAGE FlexibleContexts #-}
import Diagrams.Prelude
import Diagrams.Backend.SVG.CmdLine (B, defaultMain)
import Data.List (sort, sortOn, nub, transpose)
import Data.List.Split (chunksOf)
third :: (Int, Int) -> (Int, Int) -> (Int, Int)
third (p, q) (p', q') =
let (s, t) = (p' - p, q' - q)
in (p - t, q + s + t)
inTriangle :: Int -> (Int, Int) -> Bool
inTriangle n (p, q) = 0 <= p && 0 <= q && p + q < n
sizeSquared :: [(Int, Int)] -> Int
sizeSquared [(p, q), (p', q'), _] =
let (s, t) = (p' - p, q' - q)
in s * s + s * t + t * t
triangles :: Int -> [[(Int, Int)]]
triangles n = sortOn sizeSquared $
nub
[ sort [(a, b), (c, d), (e, f)]
| a <- [0..n]
, b <- [0..n]
, inTriangle n (a, b)
, c <- [0..n]
, d <- [0..n]
, inTriangle n (c, d)
, (a, b) /= (c, d)
, (e, f) <- [ third (a, b) (c, d)
, third (c, d) (a, b)
]
, inTriangle n (e, f)
]
t2 :: (Int, Int) -> V2 Double
t2 (p, q)
= V2
(fromIntegral p + fromIntegral q / 2)
(sqrt 3 * fromIntegral q / 2)
t2' = P . t2
draw n t@[ab,cd,ef]
= frame 0.75
. scale 1.25
. rotate (15 @@ deg)
$ mconcat
[ circle 0.25
# fc (if (p, q) `elem` t then grey else white)
# translate (t2 (p, q))
# lw thin
| p <- [0..n]
, q <- [0..n]
, inTriangle n (p, q)
] `atop` mconcat
[ t2' ab ~~ t2' cd
, t2' cd ~~ t2' ef
, t2' ef ~~ t2' ab
]
grid = vcat . map hcat
diagram n m
= bg white
. grid
. chunksOf m
. map (draw n)
$ triangles n
main = defaultMain (diagram 6 7)
A000984
A000984
Central binomial coefficient (2n,n)
(1, 2, 6, 20, 70, 252, 924, ...)
The number of direct routes from my home to Granny's when Granny lives n
blocks south and n blocks east of my home in Grid City. For example, a(2)=6
because there are 6 direct routes: SSEE, SESE, SEES, EESS, ESES and ESSE.
-- Dennis P. Walsh
download source code
{-# LANGUAGE FlexibleContexts #-}
import Diagrams.Prelude
import Diagrams.Backend.SVG.CmdLine (B, defaultMain)
import Control.Monad (replicateM)
import Data.List.Split (chunksOf)
u, d, z :: (Int, Int)
u = (1, 0)
d = (0, 1)
z = (0, 0)
add (a, b) (c, d) = (a + c, b + d)
v :: (Int, Int) -> V2 Double
v (a, b) = V2 (fromIntegral a) (fromIntegral b)
vs = map v . scanl add z
l = foldr add z
paths n =
[ q
| q <- replicateM (2 * n) [u,d]
, l q == (n, n)
]
draw n q
= frame 0.5
. (`atop` centerXY (strutY (fromIntegral n)))
. centerXY
$ mconcat
[ circle 0.25
# fc white
# translate pq
# lw thin
| pq <- vs q
] `atop` strokeT (trailFromOffsets (map v q))
grid = vcat . map hcat
diagram n m
= bg white
. centerXY
. grid
. chunksOf m
. map (draw n)
$ paths n
main = defaultMain (diagram 4 7)
A001405
A001405
Binomial (n,floor(n/2))
(1, 1, 2, 3, 6, 10, 20, 35, 70, 126, 252, 462, 924, ...)
Number of distinct strings of length n, each of which is a prefix of a
string of balanced parentheses; For n = 4, the a(4) = 6 distinct strings of
length 4 are ((((, (((), (()(, ()((, ()(), and (()).
-- Lee A. Newberg
download source code
{-# LANGUAGE FlexibleContexts #-}
import Diagrams.Prelude
import Diagrams.Backend.SVG.CmdLine (B, defaultMain)
import Control.Monad (replicateM)
import Data.List (sort, transpose)
import Data.List.Split (chunksOf)
u, d, z :: (Int, Int)
u = (1, 1)
d = (1, -1)
z = (0, 0)
add (a, b) (c, d) = (a + c, b + d)
boundedBelow = not . any ((< 0) . snd) . scanl add z
paths n =
[ q
| q <- replicateM n [u,d]
, boundedBelow q
]
v :: (Int, Int) -> V2 Double
v (a, b) = V2 (fromIntegral a) (fromIntegral b)
vs = map v . scanl add z
draw n q
= frame 0.5
. (`atop` centerXY (strutY (fromIntegral n)))
. centerXY
$ mconcat
[ circle 0.25
# fc white
# translate pq
# lw thin
| pq <- vs q
] `atop` strokeT (trailFromOffsets (map v q))
grid = vcat . map hcat
diagram n m
= bg white
. centerXY
. grid
. transpose
. chunksOf m
. map (draw n)
. sort
$ paths n
main = defaultMain (diagram 8 10)
A002623
A002623
Generating function of 1/((1+x)(1-x)^4)
(1, 3, 7, 13, 22, 34, 50, 70, 95, 125, 161, 203, 252, 308, 372, 444, 525, 615, 715, 825, 946, ...)
Number of nondegenerate triangles that can be made from rods of length 1,2,3,4,...,n.
-- Alfred Bruckstein
download source code
{-# LANGUAGE FlexibleContexts #-}
import Diagrams.Prelude
import Diagrams.Backend.SVG.CmdLine (B, defaultMain)
import Data.List (sort, sortOn, nub, transpose)
import Data.List.Split (chunksOf)
nondegenerate :: [Int] -> Bool
nondegenerate [a,b,c] = a + b > c
corners :: [Int] -> [V2 Double]
corners [a',b',c']
= [V2 0 0, V2 c 0, V2 x y]
where
a = fromIntegral a'
b = fromIntegral b'
c = fromIntegral c'
x = (c^2 - a^2 + b^2) / (2 * c)
y = sqrt $ b^2 - x^2
sizeSquared :: [Int] -> Double
sizeSquared [a',b',c']
= s * (s - a) * (s - b) * (s - c)
where
a = fromIntegral a'
b = fromIntegral b'
c = fromIntegral c'
s = (a + b + c) / 2
triangles :: Int -> [([Int], [V2 Double])]
triangles n
= map (\t -> (t, corners t))
. sortOn sizeSquared $
[ abc
| a <- [1..n]
, b <- [a..n]
, c <- [b..n]
, let abc = [a,b,c]
, nondegenerate abc
]
edge k a b
= mconcat
[ circle 0.25
# fc white
# translate p
# lw thin
| p <- [ lerp t a b
| i <- [0..k]
, let t = fromIntegral i / fromIntegral k
]
] `atop`
(P a ~~ P b)
draw n ([a,b,c], t@[ab,cd,ef])
= frame 0.5
. (`atop` centerXY (strut (fromIntegral n)))
. centerXY
. rotate (15 @@ deg)
$ mconcat
[
] `atop` mconcat
[ edge c ab cd
, edge a cd ef
, edge b ef ab
]
grid = vcat . map hcat
diagram n m
= bg white
. grid
. chunksOf m
. map (draw n)
$ triangles n
main = defaultMain (diagram 8 7)
Happy Birthday Mum!