

The Padovan sequence is similar to the Fibonacci sequence in several ways.
Some are given in the table below, and the referenced video shows some of the geometric
similarities.



 Comment 
 Padovan 
 Fibonacci


 
 



 Named after. 
 Richard Padovan 
 Leonardo of Pisa: Fibonacci


 
 



 Recurrence initial values. 
 P(0)=P(1)=P(2)=1 
 F(0)=0, F(1)=1


 Recurrence relation. 
 P(n)=P(n-2)+P(n-3) 
 F(n)=F(n-1)+F(n-2)


 
 



 First 10 terms. 
 1,1,1,2,2,3,4,5,7,9 
 0,1,1,2,3,5,8,13,21,34


 
 



 Ratio of successive terms... 
 Plastic ratio, p 
 Golden ratio, g


 
 1.324717957244746025960908854… 
 1.6180339887498948482...


 Exact formula of ratios p and q. 
 ((9+69**.5)/18)**(1/3) + ((9-69**.5)/18)**(1/3) 
 (1+5**0.5)/2


 Ratio is real root of polynomial. 
 p: x**3-x-1 
 g: x**2-x-1


 
 



 Spirally tiling the plane using. 
 Equilateral triangles 
 Squares


 
 



 Constants for ... 
 s= 1.0453567932525329623 
 a=5**0.5


 ... Computing by truncation. 
 P(n)=floor(p**(n-1) / s + .5) 
 F(n)=floor(g**n / a + .5)


 
 



 L-System Variables. 
 A,B,C 
 A,B


 L-System Start/Axiom. 
 A 
 A


 L-System Rules. 
 A->B,B->C,C->AB 
 A->B,B->AB

Task

 Write a function/method/subroutine to compute successive members of the Padovan series using the recurrence relation.
 Write a function/method/subroutine to compute successive members of the Padovan series using the floor function.
 Show the first twenty terms of the sequence.
 Confirm that the recurrence and floor based functions give the same results for 64 terms,
 Write a function/method/... using the L-system to generate successive strings.
 Show the first 10 strings produced from the L-system
 Confirm that the length of the first 32 strings produced is the Padovan sequence.
Show output here, on this page.

Ref

 The Plastic Ratio - Numberphile video.


--------------------- PADOVAN NUMBERS --------------------
 
-- padovans :: [Int]
on padovans()
    script f
        on |λ|(abc)
            set {a, b, c} to abc
 
            {a, {b, c, a + b}}
        end |λ|
    end script
 
    unfoldr(f, {1, 1, 1})
end padovans
 
 
-- padovanFloor :: [Int]
on padovanFloor()
    script f
        property p : 1.324717957245
        property s : 1.045356793253
        on |λ|(n)
            {floor(0.5 + ((p ^ (n - 1)) / s)), 1 + n}
        end |λ|
    end script
 
    unfoldr(f, 0)
end padovanFloor
 
 
-- padovanLSystem :: [String]
on padovanLSystem()
    script rule
        on |λ|(c)
            if "A" = c then
                "B"
            else if "B" = c then
                "C"
            else
                "AB"
            end if
        end |λ|
    end script
 
    script f
        on |λ|(s)
            {s, concatMap(rule, characters of s) as string}
        end |λ|
    end script
 
    unfoldr(f, "A")
end padovanLSystem
 
 
--------------------------- TEST -------------------------
on run
    unlines({"First 20 padovans:", ¬
        showList(take(20, padovans())), ¬
        "", ¬
        "The recurrence and floor-based functions", ¬
        "match over the first 64 terms:\n", ¬
        prefixesMatch(padovans(), padovanFloor(), 64), ¬
        "", ¬
        "First 10 L-System strings:", ¬
        showList(take(10, padovanLSystem())), ¬
        "", ¬
        "The lengths of the first 32 L-System", ¬
        "strings match the Padovan sequence:\n", ¬
        prefixesMatch(padovans(), fmap(|length|, padovanLSystem()), 32)})
end run
 
 
-- prefixesMatch :: [a] -> [a] -> Bool
on prefixesMatch(xs, ys, n)
    take(n, xs) = take(n, ys)
end prefixesMatch
 
 
------------------------- GENERIC ------------------------
 
-- concatMap :: (a -> [b]) -> [a] -> [b]
on concatMap(f, xs)
    set lng to length of xs
    set acc to {}
    tell mReturn(f)
        repeat with i from 1 to lng
            set acc to acc & (|λ|(item i of xs, i, xs))
        end repeat
    end tell
    return acc
end concatMap
 
 
-- floor :: Num -> Int
on floor(x)
    if class of x is record then
        set nr to properFracRatio(x)
    else
        set nr to properFraction(x)
    end if
    set n to item 1 of nr
    if 0 > item 2 of nr then
        n - 1
    else
        n
    end if
end floor
 
 
-- fmap <$> :: (a -> b) -> Gen [a] -> Gen [b]
on fmap(f, gen)
    script
        property g : mReturn(f)
        on |λ|()
            set v to gen's |λ|()
            if v is missing value then
                v
            else
                g's |λ|(v)
            end if
        end |λ|
    end script
end fmap
 
 
-- intercalate :: String -> [String] -> String
on intercalate(delim, xs)
    set {dlm, my text item delimiters} to ¬
        {my text item delimiters, delim}
    set s to xs as text
    set my text item delimiters to dlm
    s
end intercalate
 
 
-- length :: [a] -> Int
on |length|(xs)
    set c to class of xs
    if list is c or string is c then
        length of xs
    else
        (2 ^ 29 - 1) -- (maxInt - simple proxy for non-finite)
    end if
end |length|
 
 
-- map :: (a -> b) -> [a] -> [b]
on map(f, xs)
    -- The list obtained by applying f
    -- to each element of xs.
    tell mReturn(f)
        set lng to length of xs
        set lst to {}
        repeat with i from 1 to lng
            set end of lst to |λ|(item i of xs, i, xs)
        end repeat
        return lst
    end tell
end map
 
 
-- min :: Ord a => a -> a -> a
on min(x, y)
    if y < x then
        y
    else
        x
    end if
end min
 
 
-- mReturn :: First-class m => (a -> b) -> m (a -> b)
on mReturn(f)
    -- 2nd class handler function lifted into 1st class script wrapper. 
    if script is class of f then
        f
    else
        script
            property |λ| : f
        end script
    end if
end mReturn
 
 
-- properFraction :: Real -> (Int, Real)
on properFraction(n)
    set i to (n div 1)
    {i, n - i}
end properFraction
 
 
-- showList :: [a] -> String
on showList(xs)
    "[" & intercalate(",", map(my str, xs)) & "]"
end showList
 
 
-- str :: a -> String
on str(x)
    x as string
end str
 
 
-- take :: Int -> [a] -> [a]
-- take :: Int -> String -> String
on take(n, xs)
    set c to class of xs
    if list is c then
        if 0 < n then
            items 1 thru min(n, length of xs) of xs
        else
            {}
        end if
    else if string is c then
        if 0 < n then
            text 1 thru min(n, length of xs) of xs
        else
            ""
        end if
    else if script is c then
        set ys to {}
        repeat with i from 1 to n
            set v to |λ|() of xs
            if missing value is v then
                return ys
            else
                set end of ys to v
            end if
        end repeat
        return ys
    else
        missing value
    end if
end take
 
 
-- unfoldr :: (b -> Maybe (a, b)) -> b -> [a]
on unfoldr(f, v)
    -- A lazy (generator) list unfolded from a seed value
    -- by repeated application of f to a value until no
    -- residue remains. Dual to fold/reduce.
    -- f returns either nothing (missing value),
    -- or just (value, residue).
    script
        property valueResidue : {v, v}
        property g : mReturn(f)
        on |λ|()
            set valueResidue to g's |λ|(item 2 of (valueResidue))
            if missing value ≠ valueResidue then
                item 1 of (valueResidue)
            else
                missing value
            end if
        end |λ|
    end script
end unfoldr
 
 
-- unlines :: [String] -> String
on unlines(xs)
    -- A single string formed by the intercalation
    -- of a list of strings with the newline character.
    set {dlm, my text item delimiters} to ¬
        {my text item delimiters, linefeed}
    set s to xs as text
    set my text item delimiters to dlm
    s
end unlines