Infinite list of repeated applications of f to x


#1

Python and JavaScript both give us generators, and the keyword yield, allowing us to draw an arbitrary number of values from an infinite stream.

Haskell, similarly, allows us to draw values from infinite lists, without knowing in advance how many we will need, by writing things like:

take 10 (iterate (2*) 1) --> [1,2,4,8,16,32,64,128,256,512]
or
take 10 (iterate (\x -> (x+3)*2) 1) --> [1,8,22,50,106,218,442,890,1786,3578]

(see iterate either here, with examples or on Hoogle)

Applescript, not to be outdone, also lets us write things like:

take(10, iterate(dbl, 1)) --> {1, 2, 4, 8, 16, 32, 64, 128, 256, 512}

by recruiting a script object as a generator:

on run
    take(10, iterate(succ, 0)) --> {0, 1, 2, 3, 4, 5, 6, 7, 8, 9}
    
    take(10, iterate(dbl, 1)) --> {1, 2, 4, 8, 16, 32, 64, 128, 256, 512}
    
    take(10, iterate(etc, 1)) --> {1, 8, 22, 50, 106, 218, 442, 890, 1786, 3578}
end run

-- SAMPLE TEST FUNCTIONS 

-- succ :: Int -> Int
on succ(x)
    1 + x
end succ

-- dbl :: Num -> Num
on dbl(x)
    2 * x
end dbl

-- etc :: Num -> Num
on etc(x)
    (x + 3) * 2
end etc

-- ITERATE AND TAKE --------------------------------------

-- https://github.com/RobTrew/prelude-applescript

-- iterate :: (a -> a) -> a -> Generator [a]
on iterate(f, x)
    script
        property v : missing value
        property g : mReturn(f)'s |λ|
        on |λ|()
            if v is missing value then
                set v to x
            else
                set v to g(v)
            end if
            return v
        end |λ|
    end script
end iterate

-- Lift 2nd class handler function into 1st class script wrapper 
-- mReturn :: First-class m => (a -> b) -> m (a -> b)
on mReturn(f)
    if class of f is script then
        f
    else
        script
            property |λ| : f
        end script
    end if
end mReturn

-- min :: Ord a => a -> a -> a
on min(x, y)
    if y < x then
        y
    else
        x
    end if
end min

-- take :: Int -> [a] -> [a]
-- take :: Int -> String -> String
on take(n, xs)
    set c to class of xs
    if c is list then
        if 0 < n then
            items 1 thru min(n, length of xs) of xs
        else
            {}
        end if
    else if c is string then
        if 0 < n then
            text 1 thru min(n, length of xs) of xs
        else
            ""
        end if
    else if c is script then
        set ys to {}
        repeat with i from 1 to n
            set end of ys to xs's |λ|()
        end repeat
        return ys
    else
        missing value
    end if
end take


(CK) #2

Could these constructs be used to generate power series that ultimately converge to an infinite sum ? For example, 𝑒ˣ = 1 + 𝑥 + 𝑥²/2! + 𝑥³/3! + ...; or sin 𝑥 = 𝑥 - x³/3! + x⁵/5! - ... ?


#3

You can certainly use generators to:

  • define the value of a series,
  • take a finite number of terms, and
  • sum them

tho:

  • the basic iterate function is itself adequate only for series in which N can be derived simply as f(N-1), and
  • given the (Applescript]) constraint of 32 bit signed numeric values, you probably can’t make much use of (ie probably don’t need) a very large number of successive terms to sum trigonometic values or powers of e.

For a basic value of e^1, for example, Applescript can only make use of about the first 15 terms of this series (beyond that the resulting value no longer changes significantly at a 32 bit resolution)

on run
    
    sum(map(inverse, ¬
        scanl(product, 1, take(15, iterate(my succ, 1)))))
    
    --> 2.718281828459
    
end run

-- inverse :: Float -> Float
on inverse(x)
    1 / x
end inverse

-- product :: Float -> Float -> Float
on product(a, b)
    a * b
end product


-- GENERIC FUNCTIONS ----------------------------------------

-- https://github.com/RobTrew/prelude-applescript

-- foldl :: (a -> b -> a) -> a -> [b] -> a
on foldl(f, startValue, xs)
    tell mReturn(f)
        set v to startValue
        set lng to length of xs
        repeat with i from 1 to lng
            set v to |λ|(v, item i of xs, i, xs)
        end repeat
        return v
    end tell
end foldl

-- iterate :: (a -> a) -> a -> Generator [a]
on iterate(f, x)
    script
        property v : missing value
        property g : mReturn(f)'s |λ|
        on |λ|()
            if v is missing value then
                set v to x
            else
                set v to g(v)
            end if
            return v
        end |λ|
    end script
end iterate

-- Lift 2nd class handler function into 1st class script wrapper 
-- mReturn :: First-class m => (a -> b) -> m (a -> b)
on mReturn(f)
    if class of f is script then
        f
    else
        script
            property |λ| : f
        end script
    end if
end mReturn

-- map :: (a -> b) -> [a] -> [b]
on map(f, 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

-- scanl :: (b -> a -> b) -> b -> [a] -> [b]
on scanl(f, startValue, xs)
    tell mReturn(f)
        set v to startValue
        set lng to length of xs
        set lst to {startValue}
        repeat with i from 1 to lng
            set v to |λ|(v, item i of xs, i, xs)
            set end of lst to v
        end repeat
        return lst
    end tell
end scanl

-- succ :: Int -> Int
on succ(x)
    1 + x
end succ

-- sum :: [Num] -> Num
on sum(xs)
    script add
        on |λ|(a, b)
            a + b
        end |λ|
    end script
    
    foldl(add, 0, xs)
end sum

-- take :: Int -> [a] -> [a]
-- take :: Int -> String -> String
on take(n, xs)
    set c to class of xs
    if c is list then
        if 0 < n then
            items 1 thru min(n, length of xs) of xs
        else
            {}
        end if
    else if c is string then
        if 0 < n then
            text 1 thru min(n, length of xs) of xs
        else
            ""
        end if
    else if c is script then
        set ys to {}
        repeat with i from 1 to n
            set end of ys to xs's |λ|()
        end repeat
        return ys
    else
        missing value
    end if
end take

(Shane Stanley) #4

I’m not sure what you’re referring to here, but AppleScripts reals are doubles, not floats. Its integers are SInt32, but it generally rolls them to reals outside that range.


#5

Thanks ! So the exhaustion of significand precision after 15 terms here expresses the limits of about 52 bits, once sign and exponent have taken their share ?


(Shane Stanley) #6

That sounds about right — see IEEE 754.


#7

In the case of your sin 𝑥 = 𝑥 - x³/3! + x⁵/5! series, it turns out that we are already making full use of Applescript’s significand precision after taking only the first 4 members of the infinite series.

(the iterate generator adapted slightly here to keep track of the number of terms drawn from it)

We get the following approximations for sin(x) from that series

0.1 -> 0.099833333333

0.2 -> 0.198666666667

0.3 -> 0.2955

0.4 -> 0.389333333332

0.5 -> 0.479166666634

0.6 -> 0.563999999496

0.7 -> 0.642833328245

0.8 -> 0.714666628961

0.9 -> 0.778499779352

1.0 -> 0.83333226166

by writing something like:

-- APPROXIMATIONS TO SINE X (increasingly rough as x approaches 1) 

-- sin(x) as the sum of n terms in the series sin 𝑥 = 𝑥 - x³/3! + x⁵/5! ...
-- sin :: Num -> Num
on sin(x)
    sum(take(4, iterate(my sineTerm, x)))
end sin

-- sin 𝑥 = 𝑥 - x³/3! + x⁵/5!
on sineTerm(x, i)
    set n to (2 * i) - 1
    set v to (x ^ n) / (product(enumFromTo(1, n)))
    if even(i) then
        -v
    else
        v
    end if
end sineTerm

on run
    -- sin(0.1), sin(0.2) ... sin(0.9), sin(1.0)
    
    set ns to enumFromTo(1, 10)
    script fraction
        on |λ|(x)
            x / 10
        end |λ|
    end script
    set xs to map(fraction, ns)
    
    set sines to map(sin, xs)
    
    script show
        on |λ|(x, y)
            (x as text) & " -> " & (y as text)
        end |λ|
    end script
    unlines(zipWith(show, xs, sines))
end run


-- ITERATE AND TAKE --------------------------------------

-- https://github.com/RobTrew/prelude-applescript

-- iterate :: (a -> a) -> a -> Generator [a]
on iterate(f, x)
    script
        property v : missing value
        property i : missing value
        property g : mReturn(f)'s |λ|
        on |λ|()
            if v is missing value then
                set v to x
                set i to 1
            else
                set i to 1 + i
                set v to g(v, i)
            end if
            return v
        end |λ|
    end script
end iterate

-- enumFromTo :: Int -> Int -> [Int]
on enumFromTo(m, n)
    if m ≤ n then
        set lst to {}
        repeat with i from m to n
            set end of lst to i
        end repeat
        return lst
    else
        return {}
    end if
end enumFromTo

-- even :: Int -> Bool
on even(x)
    x mod 2 = 0
end even

-- foldl :: (a -> b -> a) -> a -> [b] -> a
on foldl(f, startValue, xs)
    tell mReturn(f)
        set v to startValue
        set lng to length of xs
        repeat with i from 1 to lng
            set v to |λ|(v, item i of xs, i, xs)
        end repeat
        return v
    end tell
end foldl

-- Lift 2nd class handler function into 1st class script wrapper 
-- mReturn :: First-class m => (a -> b) -> m (a -> b)
on mReturn(f)
    if class of f is script then
        f
    else
        script
            property |λ| : f
        end script
    end if
end mReturn

-- map :: (a -> b) -> [a] -> [b]
on map(f, 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

-- product :: [Num] -> Num
on product(xs)
    script multiply
        on |λ|(a, b)
            a * b
        end |λ|
    end script
    
    foldl(multiply, 1, xs)
end product

-- sum :: [Num] -> Num
on sum(xs)
    script add
        on |λ|(a, b)
            a + b
        end |λ|
    end script
    
    foldl(add, 0, xs)
end sum

-- take :: Int -> [a] -> [a]
-- take :: Int -> String -> String
on take(n, xs)
    set c to class of xs
    if c is list then
        if 0 < n then
            items 1 thru min(n, length of xs) of xs
        else
            {}
        end if
    else if c is string then
        if 0 < n then
            text 1 thru min(n, length of xs) of xs
        else
            ""
        end if
    else if c is script then
        set ys to {}
        repeat with i from 1 to n
            set end of ys to xs's |λ|()
        end repeat
        return ys
    else
        missing value
    end if
end take

-- unlines :: [String] -> String
on unlines(xs)
    set {dlm, my text item delimiters} to ¬
        {my text item delimiters, linefeed}
    set str to xs as text
    set my text item delimiters to dlm
    str
end unlines

-- zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
on zipWith(f, xs, ys)
    set lng to min(length of xs, length of ys)
    if 1 > lng then return {}
    set lst to {}
    tell mReturn(f)
        repeat with i from 1 to lng
            set end of lst to |λ|(item i of xs, item i of ys)
        end repeat
        return lst
    end tell
end zipWith

and bumping take(4) up to take(5), doesn’t, I think, improve (or even change) the approximation within the constraints of applescript numbers.


#8

As a footnote, if we encode the slightly more general formulation of that series at:

http://mathworld.wolfram.com/Sine.html (graphic 6)

-- sin :: Num -> Num
on sin(x)
    -- http://mathworld.wolfram.com/Sine.html
    script sineTerm2
        on |λ|(x, n)
            set m to (2 * n) - 1
            
            (((-1) ^ (n - 1)) / (product(enumFromTo(1, m)))) * (x ^ m)
        end |λ|
    end script
    sum(take(4, iterate(sineTerm2, x)))
end sin

We obtain the same values (useful approximations where x is small, increasingly rough as x rises towards 1), but they exhaust the Applescript significand precision after we have taken only three terms from the infinite series.

The challenge of summing infinitesimal values over a larger number of terms is that many of the small contributing values will fail to accumulate (being treated as zero) in a finite-precision computation.


#9

and finally, restoring a simpler and more classic iterate, we can explicitly define our series function over an (x, N) tuple, rather than relying on a magic term-counter inside the generator:

-- APPROXIMATE VALUES FOR SIN(X)
-- (where x is small)


-- sin :: Num -> Num
on sin(x)
    -- http://mathworld.wolfram.com/Sine.html
    script sineTerm3
        on |λ|({x, n})
            set m to (2 * n) - 1
            
            {(((-1) ^ (n - 1)) / (product(enumFromTo(1, m)))) * (x ^ m), 1 + n}
        end |λ|
    end script
    sum(map(my fst, take(4, iterate(sineTerm3, {x, 1}))))
end sin


on run
    -- approx sin(0.1), sin(0.2) ... sin(0.9), sin(1.0)
    
    set ns to enumFromTo(1, 10)
    script fraction
        on |λ|(x)
            x / 10
        end |λ|
    end script
    set xs to map(fraction, ns)
    
    set sines to map(sin, xs)
    
    script show
        on |λ|(x, y)
            (x as text) & " ~> " & (y as text)
        end |λ|
    end script
    unlines(zipWith(show, xs, sines))
end run


-- ITERATE, TAKE, AND OTHER GENERICS -----------------------------

-- https://github.com/RobTrew/prelude-applescript

-- iterate :: (a -> a) -> a -> Generator [a]
on iterate(f, x)
    script
        property v : missing value
        property g : mReturn(f)'s |λ|
        on |λ|()
            if v is missing value then
                set v to x
            else
                set v to g(v)
            end if
            return v
        end |λ|
    end script
end iterate

-- enumFromTo :: Int -> Int -> [Int]
on enumFromTo(m, n)
    if m ≤ n then
        set lst to {}
        repeat with i from m to n
            set end of lst to i
        end repeat
        return lst
    else
        return {}
    end if
end enumFromTo

-- even :: Int -> Bool
on even(x)
    x mod 2 = 0
end even

-- foldl :: (a -> b -> a) -> a -> [b] -> a
on foldl(f, startValue, xs)
    tell mReturn(f)
        set v to startValue
        set lng to length of xs
        repeat with i from 1 to lng
            set v to |λ|(v, item i of xs, i, xs)
        end repeat
        return v
    end tell
end foldl

-- fst :: (a, b) -> a
on fst(tpl)
    if class of tpl is record then
        |1| of tpl
    else
        item 1 of tpl
    end if
end fst

-- Lift 2nd class handler function into 1st class script wrapper 
-- mReturn :: First-class m => (a -> b) -> m (a -> b)
on mReturn(f)
    if class of f is script then
        f
    else
        script
            property |λ| : f
        end script
    end if
end mReturn

-- map :: (a -> b) -> [a] -> [b]
on map(f, 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

-- product :: [Num] -> Num
on product(xs)
    script multiply
        on |λ|(a, b)
            a * b
        end |λ|
    end script
    
    foldl(multiply, 1, xs)
end product

-- sum :: [Num] -> Num
on sum(xs)
    script add
        on |λ|(a, b)
            a + b
        end |λ|
    end script
    
    foldl(add, 0, xs)
end sum

-- take :: Int -> [a] -> [a]
-- take :: Int -> String -> String
on take(n, xs)
    set c to class of xs
    if c is list then
        if 0 < n then
            items 1 thru min(n, length of xs) of xs
        else
            {}
        end if
    else if c is string then
        if 0 < n then
            text 1 thru min(n, length of xs) of xs
        else
            ""
        end if
    else if c is script then
        set ys to {}
        repeat with i from 1 to n
            set end of ys to xs's |λ|()
        end repeat
        return ys
    else
        missing value
    end if
end take

-- unlines :: [String] -> String
on unlines(xs)
    set {dlm, my text item delimiters} to ¬
        {my text item delimiters, linefeed}
    set str to xs as text
    set my text item delimiters to dlm
    str
end unlines

-- zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
on zipWith(f, xs, ys)
    set lng to min(length of xs, length of ys)
    if 1 > lng then return {}
    set lst to {}
    tell mReturn(f)
        repeat with i from 1 to lng
            set end of lst to |λ|(item i of xs, item i of ys)
        end repeat
        return lst
    end tell
end zipWith

[*] for alternatives to the definition of factorial(x) as product(enumFromTo(1, x)), see the classic Evolution of a Haskell programmer.


#10

Just had another look at this, and it turns out that f(f(f(x))) iteration is just multiplying the precision errors.

We can get much better approximations from 8 terms of the Taylor series by sampling them separately, so:

-- sin :: Num -> Num
on sin(x)
    -- http://mathworld.wolfram.com/Sine.html
    script sineTerm
        on |λ|(n)
            set m to (2 * n) - 1
            (((-1) ^ (n - 1)) / (product(enumFromTo(1, m)))) * (x ^ m)
        end |λ|
    end script
    sum(map(sineTerm, enumFromTo(1, 8)))
end sin

or, fusing a few off-the-shelf generics down to folds and a fixed list, for fewer dependencies and fractionally more performance:

-- sin :: Num -> Num
on sin(x)
    -- http://mathworld.wolfram.com/Sine.html
    script sineTerm
        script prod
            on |λ|(a, x)
                a * x
            end |λ|
        end script
        on |λ|(a, n)
            set m to (2 * n) - 1
            a + (((-1) ^ (n - 1)) / (foldl(prod, 1, enumFromTo(1, m)))) * (x ^ m)
        end |λ|
    end script
    foldl(sineTerm, 0, {1, 2, 3, 4, 5, 6, 7, 8})
end s

and for further compression of time and space:

-- sin :: Num -> Num
on sin(x)
    set scale to -(x ^ 2)
    script
        on |λ|({acc, n, d}, i)
            {acc + n / d, scale * n, d * (i ^ 2 - i)}
        end |λ|
    end script
    item 1 of foldl(result, {0, x, 1}, {3, 5, 7, 9, 11, 13, 15, 17})
end sin

(Generic functions at https://github.com/RobTrew/prelude-jxa )

yields:

0.1 ~> 0.099833416647
0.2 ~> 0.198669330795
0.3 ~> 0.295520206661
0.4 ~> 0.389418342309
0.5 ~> 0.479425538604
0.6 ~> 0.564642473395
0.7 ~> 0.644217687238
0.8 ~> 0.7173560909
0.9 ~> 0.783326909627
1.0 ~> 0.841470984808

#11

FWIW I’ve updated takeWhile to work with these infinite generators, so that we can write things like:

script small
    on |λ|(x)
        5000 > x
    end |λ|
end script

script dbl
    on |λ|(x)
        2 * x
    end |λ|
end script

takeWhile(small, iterate(dbl, 1))
--> {1, 2, 4, 8, 16, 32, 64, 128, 256, 512, 1024, 2048, 4096}

take(8, cycle({"hi", "mid", "lo"}))
--> {"hi", "mid", "lo", "hi", "mid", "lo", "hi", "mid"}

Fuller example, using asPrelude.applescript from

use framework "Foundation"
use scripting additions

property _ : missing value

-- prelude :: FilePath -> Script
on prelude(filePath)
    set ca to current application
    set {bln, int} to (ca's NSFileManager's defaultManager's ¬
        fileExistsAtPath:((ca's NSString's stringWithString:filePath)'s ¬
            stringByStandardizingPath) isDirectory:(reference))
    
    if (bln and (int ≠ 1)) then
        set strPath to filePath
    else
        set strPath to "~/prelude-applescript/asPrelude.applescript"
        -- https://github.com/RobTrew/prelude-applescript
    end if
    
    run script (((ca's NSString's ¬
        stringWithString:strPath)'s ¬
        stringByStandardizingPath) as string)
end prelude

on run
    if _ is missing value then set _ to prelude("")
    tell _
        
        script small
            on |λ|(x)
                5000 > x
            end |λ|
        end script
        
        script dbl
            on |λ|(x)
                2 * x
            end |λ|
        end script
        
        take(8, cycle({"hi", "mid", "lo"}))
        --> {"hi", "mid", "lo", "hi", "mid", "lo", "hi", "mid"}
        
        takeWhile(small, iterate(dbl, 1))
        --> {1, 2, 4, 8, 16, 32, 64, 128, 256, 512, 1024, 2048, 4096}
        
    end tell
end run