September Morn Update

Task/Pascals-triangle/AppleScript/pascals-triangle.applescript

@@ -1,94 +1,83 @@
--- PASCAL ---------------------------------------------------------------------
-
--- pascal :: Int -> [[Int]]
-on pascal(intRows)
-
-    script addRow
-        on nextRow(row)
-            script add
-                on |λ|(a, b)
-                    a + b
-                end |λ|
-            end script
-
-            zipWith(add, [0] & row, row & [0])
-        end nextRow
-
-        on |λ|(xs)
-            xs & {nextRow(item -1 of xs)}
+-- pascal :: Generator [[Int]]
+on pascal()
+    script nextRow
+        on |λ|(row)
+            zipWith(my plus, {0} & row, row & {0})
         end |λ|
     end script
-
-    foldr(addRow, {{1}}, enumFromTo(1, intRows - 1))
+    iterate(nextRow, {1})
 end pascal
 
--- TEST -----------------------------------------------------------------------
+
 on run
-    set lstTriangle to pascal(7)
-
-    script spaced
-        on |λ|(xs)
-            script rightAlign
-                on |λ|(x)
-                    text -4 thru -1 of ("    " & x)
-                end |λ|
-            end script
-
-            intercalate("", map(rightAlign, xs))
-        end |λ|
-    end script
-
-    script indented
-        on |λ|(a, x)
-            set strIndent to leftSpace of a
-
-            {rows:¬
-                strIndent & x & linefeed & rows of a, leftSpace:¬
-                leftSpace of a & "  "} ¬
-
-        end |λ|
-    end script
-
-    rows of foldr(indented, ¬
-        {rows:"", leftSpace:""}, map(spaced, lstTriangle))
+    showPascal(take(7, pascal()))
 end run
 
--- GENERIC FUNCTIONS ----------------------------------------------------------
 
--- enumFromTo :: Int -> Int -> [Int]
-on enumFromTo(m, n)
-    if n < m then
-        set d to -1
+-- showPascal :: [[Int]] -> String
+on showPascal(xs)
+    set w to length of intercalate("   ", item -1 of xs)
+    script align
+        on |λ|(x)
+            |center|(w, space, intercalate("   ", x))
+        end |λ|
+    end script
+    unlines(map(align, xs))
+end showPascal
+
+
+-- GENERIC ABSTRACTIONS -------------------------------------------------------
+
+-- center :: Int -> Char -> String -> String
+on |center|(n, cFiller, strText)
+    set lngFill to n - (length of strText)
+    if lngFill > 0 then
+        set strPad to replicate(lngFill div 2, cFiller) as text
+        set strCenter to strPad & strText & strPad
+        if lngFill mod 2 > 0 then
+            cFiller & strCenter
+        else
+            strCenter
+        end if
     else
-        set d to 1
+        strText
     end if
-    set lst to {}
-    repeat with i from m to n by d
-        set end of lst to i
-    end repeat
-    return lst
-end enumFromTo
+end |center|
 
--- foldr :: (a -> b -> a) -> a -> [b] -> a
-on foldr(f, startValue, xs)
-    tell mReturn(f)
-        set v to startValue
-        set lng to length of xs
-        repeat with i from lng to 1 by -1
-            set v to |λ|(v, item i of xs, i, xs)
-        end repeat
-        return v
-    end tell
-end foldr
-
--- intercalate :: Text -> [Text] -> Text
-on intercalate(strText, lstText)
-    set {dlm, my text item delimiters} to {my text item delimiters, strText}
-    set strJoined to lstText as text
+-- intercalate :: String -> [String] -> String
+on intercalate(sep, xs)
+    set {dlm, my text item delimiters} to {my text item delimiters, sep}
+    set s to xs as text
     set my text item delimiters to dlm
-    return strJoined
+    return s
 end intercalate
 
+-- iterate :: (a -> a) -> a -> Generator [a]
+on iterate(f, x)
+    script
+        property v : missing value
+        property g : mReturn(f)'s |λ|
+        on |λ|()
+            if missing value is v then
+                set v to x
+            else
+                set v to g(v)
+            end if
+            return v
+        end |λ|
+    end script
+end iterate
+
+-- 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 ^ 30 -- (simple proxy for non-finite)
+    end if
+end |length|
+
 -- map :: (a -> b) -> [a] -> [b]
 on map(f, xs)
     tell mReturn(f)
@@ -111,7 +100,7 @@ on min(x, y)
 end min
 
 -- Lift 2nd class handler function into 1st class script wrapper
--- mReturn :: Handler -> Script
+-- mReturn :: First-class m => (a -> b) -> m (a -> b)
 on mReturn(f)
     if class of f is script then
         f
@@ -122,13 +111,82 @@ on mReturn(f)
     end if
 end mReturn
 
+-- plus :: Num -> Num -> Num
+on plus(a, b)
+    a + b
+end plus
+
+-- Egyptian multiplication - progressively doubling a list, appending
+-- stages of doubling to an accumulator where needed for binary
+-- assembly of a target length
+-- replicate :: Int -> a -> [a]
+on replicate(n, a)
+    set out to {}
+    if n < 1 then return out
+    set dbl to {a}
+
+    repeat while (n > 1)
+        if (n mod 2) > 0 then set out to out & dbl
+        set n to (n div 2)
+        set dbl to (dbl & dbl)
+    end repeat
+    return out & dbl
+end replicate
+
+-- 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 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
+
+-- unwords :: [String] -> String
+on unwords(xs)
+    set {dlm, my text item delimiters} to {my text item delimiters, space}
+    set s to xs as text
+    set my text item delimiters to dlm
+    return s
+end unwords
+
 -- zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
 on zipWith(f, xs, ys)
-    set lng to min(length of xs, length of ys)
+    set lng to min(|length|(xs), |length|(ys))
+    if 1 > lng then return {}
+    set xs_ to take(lng, xs) -- Allow for non-finite
+    set ys_ to take(lng, ys) -- generators like cycle etc
     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)
+            set end of lst to |λ|(item i of xs_, item i of ys_)
         end repeat
         return lst
     end tell

Task/Pascals-triangle/Haskell/pascals-triangle-6.hs

@@ -1,5 +1,4 @@
-fac = product . enumFromTo 1
-
-binCoef n k = (fac n) `div` ((fac k) * (fac $ n - k))
-
-pascal n = map (binCoef $ n - 1) [0..n-1]
+pascal :: [[Integer]]
+pascal =
+  (1 : [ 0 | _ <- head pascal])
+  : [zipWith (+) (0:row) row | row <- pascal]

Task/Pascals-triangle/Haskell/pascals-triangle-7.hs

@@ -1,11 +1,2 @@
-*Main> putStr $ unlines $ map unwords $ map (map show) $ pascal 10
-1
-1 1
-1 2 1
-1 3 3 1
-1 4 6 4 1
-1 5 10 10 5 1
-1 6 15 20 15 6 1
-1 7 21 35 35 21 7 1
-1 8 28 56 70 56 28 8 1
-1 9 36 84 126 126 84 36 9 1
+*Pascal> take 5 <$> (take 5 $ triangle)
+[[1,0,0,0,0],[1,1,0,0,0],[1,2,1,0,0],[1,3,3,1,0],[1,4,6,4,1]]

Task/Pascals-triangle/Haskell/pascals-triangle-8.hs

@@ -0,0 +1,5 @@
+fac = product . enumFromTo 1
+
+binCoef n k = (fac n) `div` ((fac k) * (fac $ n - k))
+
+pascal n = map (binCoef $ n - 1) [0..n-1]

Task/Pascals-triangle/Haskell/pascals-triangle-9.hs

@@ -0,0 +1,11 @@
+*Main> putStr $ unlines $ map unwords $ map (map show) $ pascal 10
+1
+1 1
+1 2 1
+1 3 3 1
+1 4 6 4 1
+1 5 10 10 5 1
+1 6 15 20 15 6 1
+1 7 21 35 35 21 7 1
+1 8 28 56 70 56 28 8 1
+1 9 36 84 126 126 84 36 9 1

Task/Pascals-triangle/JavaScript/pascals-triangle-4.js

@@ -1,68 +1,120 @@
 (() => {
     'use strict';
 
-    // PASCAL'S TRIANGLE ------------------------------------------------------
-
-    // pascal :: Int -> [[Int]]
-    const pascal = n =>
-        foldl(a => {
-            const xs = a.slice(-1)[0]; // Previous row
-            return append(a, [
-                zipWith(
-                    (a, b) => a + b,
-                    append([0], xs),
-                    append(xs, [0])
-                )
-            ]);
-        }, [
-            [1] // Initial seed row
-        ], enumFromTo(1, n - 1));
+    const main = () =>
+        showPascal(take(7, pascal()));
 
 
-    // GENERIC FUNCTIONS ------------------------------------------------------
+    // pascal :: Generator [[Int]]
+    const pascal = () =>
+        iterate(
+            xs => zipWith(
+                plus,
+                append([0], xs), append(xs, [0])
+            ),
+            [1]
+        );
 
-    // (++) :: [a] -> [a] -> [a]
+    // showPascal :: [[Int]] -> String
+    const showPascal = xs => {
+        const
+            w = length(intercalate('   ', last(xs))),
+            align = xs => center(w, ' ', intercalate('   ', xs));
+        return unlines(map(align, xs));
+    };
+
+
+    // GENERIC FUNCTIONS ----------------------------------
+
+    // Tuple (,) :: a -> b -> (a, b)
+    const Tuple = (a, b) => ({
+        type: 'Tuple',
+        '0': a,
+        '1': b,
+        length: 2
+    });
+
+    // append (++) :: [a] -> [a] -> [a]
+    // append (++) :: String -> String -> String
     const append = (xs, ys) => xs.concat(ys);
 
-    // enumFromTo :: Int -> Int -> [Int]
-    const enumFromTo = (m, n) =>
-        Array.from({
-            length: Math.floor(n - m) + 1
-        }, (_, i) => m + i);
+    // Size of space -> filler Char -> String -> Centered String
 
-    // flip :: (a -> b -> c) -> b -> a -> c
-    const flip = f => (a, b) => f(b, a);
+    // center :: Int -> Char -> String -> String
+    const center = (n, c, s) => {
+        const
+            qr = quotRem(n - s.length, 2),
+            q = qr[0];
+        return replicateString(q, c) +
+            s + replicateString(q + qr[1], c);
+    };
 
-    // foldl :: (b -> a -> b) -> b -> [a] -> b
-    const foldl = (f, a, xs) => xs.reduce(f, a);
+    // intercalate :: String -> [String] -> String
+    const intercalate = (s, xs) =>
+        xs.join(s);
 
-    // foldr (a -> b -> b) -> b -> [a] -> b
-    const foldr = (f, a, xs) => xs.reduceRight(flip(f), a);
+    // iterate :: (a -> a) -> a -> Generator [a]
+    function* iterate(f, x) {
+        let v = x;
+        while (true) {
+            yield(v);
+            v = f(v);
+        }
+    }
+
+    // last :: [a] -> a
+    const last = xs =>
+        0 < xs.length ? xs.slice(-1)[0] : undefined;
+
+    // Returns Infinity over objects without finite length
+    // this enables zip and zipWith to choose the shorter
+    // argument when one non-finite like cycle, repeat etc
+
+    // length :: [a] -> Int
+    const length = xs => xs.length || Infinity;
 
     // map :: (a -> b) -> [a] -> [b]
     const map = (f, xs) => xs.map(f);
 
-    // min :: Ord a => a -> a -> a
-    const min = (a, b) => b < a ? b : a;
+    // plus :: Num -> Num -> Num
+    const plus = (a, b) => a + b;
+
+    // quotRem :: Int -> Int -> (Int, Int)
+    const quotRem = (m, n) =>
+        Tuple(Math.floor(m / n), m % n);
+
+    // replicateString :: Int -> String -> String
+    const replicateString = (n, s) => s.repeat(n);
+
+    // take :: Int -> [a] -> [a]
+    // take :: Int -> String -> String
+    const take = (n, xs) =>
+        xs.constructor.constructor.name !== 'GeneratorFunction' ? (
+            xs.slice(0, n)
+        ) : [].concat.apply([], Array.from({
+            length: n
+        }, () => {
+            const x = xs.next();
+            return x.done ? [] : [x.value];
+        }));
+
+    // unlines :: [String] -> String
+    const unlines = xs => xs.join('\n');
+
+    // Use of `take` and `length` here allows zipping with non-finite lists
+    // i.e. generators like cycle, repeat, iterate.
 
     // zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
-    const zipWith = (f, xs, ys) =>
-        Array.from({
-            length: min(xs.length, ys.length)
-        }, (_, i) => f(xs[i], ys[i]));
+    const zipWith = (f, xs, ys) => {
+        const
+            lng = Math.min(length(xs), length(ys)),
+            as = take(lng, xs),
+            bs = take(lng, ys);
+        return Array.from({
+            length: lng
+        }, (_, i) => f(as[i], bs[i], i));
+    };
 
-    // TEST -------------------------------------------------------------------
-    return foldr((x, a) => {
-            const strIndent = a.indent;
-            return {
-                rows: strIndent + map(n => ('    ' + n)
-                        .slice(-4), x)
-                    .join('') + '\n' + a.rows,
-                indent: strIndent + '  '
-            };
-        }, {
-            rows: '',
-            indent: ''
-        }, pascal(7))
-        .rows;
+    // MAIN ---
+    return main();
 })();

Task/Pascals-triangle/Prolog/pascals-triangle-3.pro

@@ -0,0 +1,29 @@
+%~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+% Produce a pascal's triangle of depth N
+%~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+%  Prolog is declarative.  The predicate pascal/3 below says that to produce
+%  a row of depth N, we can do so by first producing the row at depth(N-1),
+%  and then adding the paired values in that row.  The triangle is produced
+%  by prepending the row at N-1 to the preceding rows as recursion unwinds.
+%  The triangle produced by pascal/3 is upside down and lacks the last row,
+%  so pascal/2 prepends the last row to the triangle and reverses it.
+%  Finally, pascal/1 produces the triangle, iterates each row and prints it.
+%~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+pascal_row([V], [V]).                           % No more value pairs to add
+pascal_row([V0, V1|T], [V|Rest]) :-             % Add values from preceding row
+    V is V0 + V1, !, pascal_row([V1|T], Rest).  % Drops initial value (1).
+
+pascal(1, [1], []).    % at depth 1, this row is [1] and no preceding rows.
+pascal(N, [1|ThisRow], [Last|Preceding]) :- % Produce a row of depth N
+    succ(N0, N),                            % N is the successor to N0
+    pascal(N0, Last, Preceding),            % Get the previous row
+    !, pascal_row(Last, ThisRow).           % Calculate this row from the previous
+
+pascal(N, Triangle) :-
+   pascal(N, Last, Rows),             % Retrieve row at depth N and preceding rows
+   !, reverse([Last|Rows], Triangle). % Add last row to triangle and reverse order
+
+pascal(N) :-
+  pascal(N, Triangle), member(Row, Triangle), % Iterate and write each row
+  write(Row), nl, fail.
+pascal(_).

Task/Pascals-triangle/Prolog/pascals-triangle-4.pro

@@ -0,0 +1,6 @@
+?- pascal(5).
+[1]
+[1,1]
+[1,2,1]
+[1,3,3,1]
+[1,4,6,4,1]

Task/Pascals-triangle/Python/pascals-triangle-3.py

@@ -0,0 +1,127 @@
+'''Pascal's triangle'''
+
+from itertools import (accumulate, chain, islice)
+from operator import (add)
+
+
+# nextPascal :: [Int] -> [Int]
+def nextPascal(xs):
+    '''A row of Pascal's triangle
+       derived from a preceding row.'''
+    return zipWith(add)([0] + xs)(xs + [0])
+
+
+# pascalTriangle :: Generator [[Int]]
+def pascalTriangle():
+    '''A non-finite stream of
+       Pascal's triangle rows.'''
+    return iterate(nextPascal)([1])
+
+
+# finitePascalRows :: Int -> [[Int]]
+def finitePascalRows(n):
+    '''The first n rows of Pascal's triangle.'''
+    def go(a, _):
+        return nextPascal(a)
+    return scanl(go)([1])(
+        range(1, n)
+    )
+
+
+# TESTS ---------------------------------------------------
+# main :: IO ()
+def main():
+    '''Test of two different approaches:
+        - taking from a non-finite stream of rows,
+        - or constructing a finite list of rows.'''
+    print(unlines(map(
+        showPascal,
+        [
+            take(7)(
+                pascalTriangle()        # Non finite,
+            ),
+            finitePascalRows(7)         # finite.
+        ]
+    )))
+
+
+# showPascal :: [[Int]] -> String
+def showPascal(xs):
+    '''Stringification of a list of
+       Pascal triangle rows.'''
+    ys = list(xs)
+
+    def align(w):
+        return lambda ns: center(w)(
+            ' '
+        )('   '.join(map(str, ns)))
+    w = len('   '.join((map(str, ys[-1]))))
+    return '\n'.join(map(align(w), ys))
+
+
+# GENERIC -------------------------------------------------
+
+
+# center :: Int -> Char -> String -> String
+def center(n):
+    '''String s padded with c to approximate centre,
+       fitting in but not truncated to width n.'''
+    def go(c, s):
+        qr = divmod(n - len(s), 2)
+        q = qr[0]
+        return (q * c) + s + ((q + qr[1]) * c)
+    return lambda c: lambda s: go(c, s)
+
+
+# iterate :: (a -> a) -> a -> Gen [a]
+def iterate(f):
+    '''An infinite list of repeated applications of f to x.'''
+    def go(x):
+        v = x
+        while True:
+            yield v
+            v = f(v)
+    return lambda x: go(x)
+
+
+# scanl :: (b -> a -> b) -> b -> [a] -> [b]
+def scanl(f):
+    '''scanl is like reduce, but returns a succession of
+       intermediate values, building from the left.'''
+    return lambda a: lambda xs: (
+        accumulate(chain([a], xs), f)
+    )
+
+
+# take :: Int -> [a] -> [a]
+# take :: Int -> String -> String
+def take(n):
+    '''The prefix of xs of length n,
+       or xs itself if n > length xs.'''
+    return lambda xs: (
+        xs[0:n]
+        if isinstance(xs, list)
+        else list(islice(xs, n))
+    )
+
+
+# unlines :: [String] -> String
+def unlines(xs):
+    '''A single string derived by the intercalation
+       of a list of strings with the newline character.'''
+    return '\n'.join(xs)
+
+
+# zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
+def zipWith(f):
+    '''A list constructed by zipping with a
+       custom function, rather than with the
+       default tuple constructor.'''
+    return lambda xs: lambda ys: (
+        list(map(f, xs, ys))
+    )
+
+
+# MAIN ---
+if __name__ == '__main__':
+    main()

Task/Pascals-triangle/VBA/pascals-triangle.vba

@@ -0,0 +1,30 @@
+Option Base 1
+Private Sub pascal_triangle(n As Integer)
+    Dim odd() As String
+    Dim eve() As String
+    ReDim odd(1)
+    ReDim eve(2)
+    odd(1) = "  1"
+    For i = 1 To n
+        If i Mod 2 = 1 Then
+            Debug.Print String$(2 * n - 2 * i, " ") & Join(odd, " ")
+            eve(1) = "  1"
+            ReDim Preserve eve(i + 1)
+            For j = 2 To i
+                eve(j) = Format(CStr(Val(odd(j - 1)) + Val(odd(j))), "@@@")
+            Next j
+            eve(i + 1) = "  1"
+        Else
+            Debug.Print String$(2 * n - 2 * i, " ") & Join(eve, " ")
+            odd(1) = "  1"
+            ReDim Preserve odd(i + 1)
+            For j = 2 To i
+                odd(j) = Format(CStr(Val(eve(j - 1)) + Val(eve(j))), "@@@")
+            Next j
+            odd(i + 1) = "  1"
+        End If
+    Next i
+End Sub
+Public Sub main()
+    pascal_triangle 13
+End Sub

Task/Pascals-triangle/Visual-Basic-.NET/pascals-triangle.visual

@@ -0,0 +1,42 @@
+Imports System.Numerics
+
+Module Module1
+    Iterator Function GetRow(rowNumber As BigInteger) As IEnumerable(Of BigInteger)
+        Dim denominator As BigInteger = 1
+        Dim numerator = rowNumber
+
+        Dim currentValue As BigInteger = 1
+        For counter = 0 To rowNumber
+            Yield currentValue
+            currentValue = currentValue * numerator
+            numerator = numerator - 1
+            currentValue = currentValue / denominator
+            denominator = denominator + 1
+        Next
+    End Function
+
+    Function GetTriangle(quantityOfRows As Integer) As IEnumerable(Of BigInteger())
+        Dim range = Enumerable.Range(0, quantityOfRows).Select(Function(num) New BigInteger(num))
+        Return range.Select(Function(num) GetRow(num).ToArray())
+    End Function
+
+    Function CenterString(text As String, width As Integer)
+        Dim spaces = width - text.Length
+        Dim padLeft = (spaces / 2) + text.Length
+        Return text.PadLeft(padLeft).PadRight(width)
+    End Function
+
+    Function FormatTriangleString(triangle As IEnumerable(Of BigInteger())) As String
+        Dim maxDigitWidth = triangle.Last().Max().ToString().Length
+        Dim rows = triangle.Select(Function(arr) String.Join(" ", arr.Select(Function(array) CenterString(array.ToString(), maxDigitWidth))))
+        Dim maxRowWidth = rows.Last().Length
+        Return String.Join(Environment.NewLine, rows.Select(Function(row) CenterString(row, maxRowWidth)))
+    End Function
+
+    Sub Main()
+        Dim triangle = GetTriangle(20)
+        Dim output = FormatTriangleString(triangle)
+        Console.WriteLine(output)
+    End Sub
+
+End Module