2016 Update

Task/Sierpinski-triangle/00DESCRIPTION

@@ -1,5 +1,9 @@
-Produce an ASCII representation of a [[wp:Sierpinski triangle|Sierpinski triangle]] of order N.
-For example, the Sierpinski triangle of order 4 should look like this:
+;Task
+Produce an ASCII representation of a [[wp:Sierpinski triangle|Sierpinski triangle]] of order '''N'''.
+
+
+;Example
+The Sierpinski triangle of order '''4''' should look like this:
 <pre>
                        *
                       * *
@@ -19,5 +23,8 @@ For example, the Sierpinski triangle of order 4 should look like this:
         * * * * * * * * * * * * * * * *
 </pre>
 
-See  [[Sierpinski triangle/Graphical]] for graphics images of this pattern.
-See also [[Sierpinski carpet]]
+
+;Related tasks
+* [[Sierpinski triangle/Graphical]] for graphics images of this pattern.
+* [[Sierpinski carpet]]
+<br><br>

Task/Sierpinski-triangle/AppleScript/sierpinski-triangle.applescript

@@ -0,0 +1,149 @@
+-- sierpinskiTriangle :: Int -> String
+on sierpinskiTriangle(intOrder)
+
+    -- A Sierpinski triangle of order N
+    -- is a Pascal triangle (of N^2 rows)
+    -- mod 2
+
+    -- pascalModTwo :: Int -> [[String]]
+    script pascalModTwo
+        on lambda(intRows)
+
+            -- addRow [[Int]] -> [[Int]]
+            script addRow
+
+                -- nextRow :: [Int] -> [Int]
+                on nextRow(row)
+                    -- The composition of AsciiBinary . mod two . add
+                    -- is reduced here to a rule from
+                    -- two parent characters above,
+                    -- to the child character below.
+
+                    -- Rule 90 also reduces to this XOR relationship
+                    -- between left and right neighbours.
+
+                    -- rule :: Character -> Character -> Character
+                    script rule
+                        on lambda(a, b)
+                            cond(a = b, space, "*")
+                        end lambda
+                    end script
+
+                    zipWith(rule, {" "} & row, row & {" "})
+                end nextRow
+
+                on lambda(xs)
+                    xs & {nextRow(item -1 of xs)}
+                end lambda
+            end script
+
+            foldr(addRow, {{"*"}}, range(1, intRows - 1))
+        end lambda
+    end script
+
+    -- The centring foldr (fold right) below starts from the end of the list,
+    -- (the base of the triangle) which has zero indent.
+
+    -- Each preceding row has one more indent space than the row below it.
+
+    script centred
+        on lambda(sofar, row)
+            set strIndent to indent of sofar
+
+            {triangle:strIndent & intercalate(space, row) & linefeed & ¬
+                triangle of sofar, indent:strIndent & space}
+        end lambda
+    end script
+
+    triangle of foldr(centred, {triangle:"", indent:""}, ¬
+        pascalModTwo's lambda(intOrder ^ 2))
+
+end sierpinskiTriangle
+
+
+-- TEST
+on run
+
+    set strTriangle to sierpinskiTriangle(4)
+
+    set the clipboard to strTriangle
+
+    strTriangle
+
+end run
+
+
+-- GENERIC LIBRARY FUNCTIONS
+
+-- 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 lambda(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
+    set my text item delimiters to dlm
+    return strJoined
+end intercalate
+
+-- Lift 2nd class handler function into 1st class script wrapper
+-- mReturn :: Handler -> Script
+on mReturn(f)
+    if class of f is script then
+        f
+    else
+        script
+            property lambda : f
+        end script
+    end if
+end mReturn
+
+-- range :: Int -> Int -> [Int]
+on range(m, n)
+    if n < m then
+        set d to -1
+    else
+        set d to 1
+    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 range
+
+-- zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
+on zipWith(f, xs, ys)
+    set nx to length of xs
+    set ny to length of ys
+    if nx < 1 or ny < 1 then
+        {}
+    else
+        set lng to cond(nx < ny, nx, ny)
+        set lst to {}
+        tell mReturn(f)
+            repeat with i from 1 to lng
+                set end of lst to lambda(item i of xs, item i of ys)
+            end repeat
+            return lst
+        end tell
+    end if
+end zipWith
+
+-- cond :: Bool -> (a -> b) -> (a -> b) -> (a -> b)
+on cond(bool, f, g)
+    if bool then
+        f
+    else
+        g
+    end if
+end cond

Task/Sierpinski-triangle/COBOL/sierpinski-triangle.cobol

@@ -0,0 +1,36 @@
+identification division.
+program-id. sierpinski-triangle-program.
+data division.
+working-storage section.
+01  sierpinski.
+    05 n              pic 99.
+    05 i              pic 999.
+    05 k              pic 999.
+    05 m              pic 999.
+    05 c              pic 9(18).
+    05 i-limit        pic 999.
+    05 q              pic 9(18).
+    05 r              pic 9.
+procedure division.
+control-paragraph.
+    move 4 to n.
+    multiply n by 4 giving i-limit.
+    subtract 1 from i-limit.
+    perform sierpinski-paragraph
+    varying i from 0 by 1 until i is greater than i-limit.
+    stop run.
+sierpinski-paragraph.
+    subtract i from i-limit giving m.
+    multiply m by 2 giving m.
+    perform m times,
+    display space with no advancing,
+    end-perform.
+    move 1 to c.
+    perform inner-loop-paragraph
+    varying k from 0 by 1 until k is greater than i.
+    display ''.
+inner-loop-paragraph.
+    divide c by 2 giving q remainder r.
+    if r is equal to zero then display '  * ' with no advancing.
+    if r is not equal to zero then display '    ' with no advancing.
+    compute c = c * (i - k) / (k + 1).

Task/Sierpinski-triangle/Haskell/sierpinski-triangle-3.hs

@@ -0,0 +1,16 @@
+import Data.List (intersperse)
+
+sierpinski :: Int -> String
+sierpinski n = let
+
+    -- Top down, each row after the first is an XOR rewrite
+    rule90 n = (scanl next ['*'] [1..n-1]) where
+        next line _ = zipWith xor (" " ++ line) (line ++ " ")
+        xor l r | l == r = ' ' | otherwise = '*'
+
+    -- Bottom up, each line above the base is indented 1 more space
+    in fst (foldr spacing ("", "") (rule90 (2^n))) where
+        spacing x (s, w) =
+            (concat [w, intersperse ' ' x, "\n", s], w ++ " ")
+
+main = putStr $ sierpinski 4

Task/Sierpinski-triangle/JavaScript/sierpinski-triangle-1.js

@@ -1,81 +1,58 @@
-// A Sierpinski triangle of order N,
-// constructed as Pascal's triangle mod 2
-// and mapped to 2^N lines of centred {1:asterisk, 0:space} strings
+(function (order) {
 
-(function (n) {
-  var nRows = Math.pow(2, n),
-      lstSierpinski = sierpinski(nRows).map(asciiBinary),
+    // Sierpinski triangle of order N constructed as
+    // Pascal triangle of 2^N rows mod 2
+    // with 1 encoded as "▲"
+    // and 0 encoded as " "
+    function sierpinski(intOrder) {
+        return function asciiPascalMod2(intRows) {
+            return range(1, intRows - 1)
+                .reduce(function (lstRows) {
+                    var lstPrevRow = lstRows.slice(-1)[0];
 
-      nBaseWidth = lstSierpinski[nRows - 1].length;
+                    // Each new row is a function of the previous row
+                    return lstRows.concat([zipWith(function (left, right) {
+                        // The composition ( asciiBinary . mod 2 . add )
+                        // reduces to a rule from 2 parent characters
+                        // to a single child character
+
+                        // Rule 90 also reduces to the same XOR
+                        // relationship between left and right neighbours
+
+                        return left === right ? " " : "▲";
+                    }, [' '].concat(lstPrevRow), lstPrevRow.concat(' '))]);
+                }, [
+                    ["▲"] // Tip of triangle
+                ]);
+        }(Math.pow(2, intOrder))
+
+        // As centred lines, from bottom (0 indent) up (indent below + 1)
+        .reduceRight(function (sofar, lstLine) {
+            return {
+                triangle: sofar.indent + lstLine.join(" ") + "\n" +
+                    sofar.triangle,
+                indent: sofar.indent + " "
+            };
+        }, {
+            triangle: "",
+            indent: ""
+        }).triangle;
+    };
+
+    var zipWith = function (f, xs, ys) {
+            return xs.length === ys.length ? xs
+                .map(function (x, i) {
+                    return f(x, ys[i]);
+                }) : undefined;
+        },
+        range = function (m, n) {
+            return Array.apply(null, Array(n - m + 1))
+                .map(function (x, i) {
+                    return m + i;
+                });
+        };
+
+    // TEST
+    return sierpinski(order);
 
-  return lstSierpinski.map(
-    function (s) {
-      return centreAligned(s, nBaseWidth);
-    }
-  ).join('\n');
 })(4);
-
-// A Sierpinski sieve of n rows
-// (Pascal triangle mod 2)
-// n --> [bool]
-function sierpinski(n) {
-  return pascalTriangle(n).map(
-    function (line) {
-      return line.map(function (x) {
-        return x % 2;
-      });
-    }
-  )
-}
-
-// A Pascal triangle of n rows
-// n --> [[n]]
-function pascalTriangle(n) {
-
-  // Sums of each consecutive pair of numbers
-  // [n] --> [n]
-  function pairSums(lst) {
-    return lst.reduce(function (acc, n, i, l) {
-      var iPrev = i ? i - 1 : 0;
-      return i ? acc.concat(l[iPrev] + l[i]) : acc
-    }, []);
-  }
-
-  // Next line in a Pascal triangle series
-  // [n] --> [n]
-  function nextPascal(lst) {
-    return lst.length ? [1].concat(
-      pairSums(lst)
-    ).concat(1) : [1];
-  }
-
-  // Each row is a function of the preceding row
-  return n ? Array.apply(null, Array(n - 1)).reduce(
-    function (a, _, i) {
-      return a.concat(
-        [nextPascal(a[i])]
-      );
-    }, [
-      [1]
-    ]
-  ) : [];
-}
-
-// [bool] --> s
-function asciiBinary(lst) {
-  return lst.map(
-    function (x) {
-      return x ? '*' : ' ';
-    }
-  ).join(' ');
-}
-
-// Space-padded to left and right
-// s --> n --> s
-function centreAligned(s, n) {
-  var lngWhite = n - s.length,
-    lngMargin = lngWhite > 0 ? Math.ceil(lngWhite / 2) : 0,
-    strMargin = lngMargin ? Array(lngMargin + 1).join(' ') : '';
-
-  return strMargin ? strMargin + s + strMargin : s;
-}

Task/Sierpinski-triangle/JavaScript/sierpinski-triangle-2.js

@@ -1,18 +1,20 @@
 function triangle(o) {
-  var n = 1<<o, line = new Array(2*n), i,j,t,u;
-  for (i=0; i<line.length; ++i) line[i] = '&nbsp;';
-  line[n] = '*';
-  for (i=0; i<n; ++i) {
-    document.write(line.join('')+"\n");
-    u ='*';
-    for(j=n-i; j<n+i+1; ++j) {
-      t = (line[j-1] == line[j+1] ? '&nbsp;' : '*');
-      line[j-1] = u;
-      u = t;
+    var n = 1 << o,
+        line = new Array(2 * n),
+        i, j, t, u;
+    for (i = 0; i < line.length; ++i) line[i] = '&nbsp;';
+    line[n] = '*';
+    for (i = 0; i < n; ++i) {
+        document.write(line.join('') + "\n");
+        u = '*';
+        for (j = n - i; j < n + i + 1; ++j) {
+            t = (line[j - 1] == line[j + 1] ? '&nbsp;' : '*');
+            line[j - 1] = u;
+            u = t;
+        }
+        line[n + i] = t;
+        line[n + i + 1] = '*';
     }
-    line[n+i] = t;
-    line[n+i+1] = '*';
-  }
 }
 document.write("<pre>\n");
 triangle(6);

Task/Sierpinski-triangle/JavaScript/sierpinski-triangle-3.js

@@ -0,0 +1,67 @@
+// A Sierpinski triangle of order N,
+// constructed as 2^N lines of Pascal's triangle mod 2
+// and mapped to centred {1:asterisk, 0:space} strings
+
+(order => {
+
+    // sierpinski :: Int -> [Bool]
+    let sierpinski = intOrder => {
+
+        // asciiPascalMod2 :: Int -> [[Int]]
+        let asciiPascalMod2 = nRows =>
+            range(1, nRows - 1)
+            .reduce(sofar => {
+                let lstPrev = sofar.slice(-1)[0];
+
+                // The composition of (asciiBinary . mod 2 . add)
+                // is reduced here to a rule from two parent characters
+                // to a single child character.
+
+                // Rule 90 also reduces to the same XOR
+                // relationship between left and right neighbours.
+
+                return sofar
+                    .concat([zipWith(
+                        (left, right) => left === right ? ' ' : '*',
+                        [' '].concat(lstPrev),
+                        lstPrev.concat(' ')
+                    )]);
+            }, [
+                ['*'] // Tip of triangle
+            ]);
+
+        // Reduce/folding from the last item (base of list)
+        // which has zero left indent.
+
+        // Each preceding row has one more indent space than the row beneath it
+        return asciiPascalMod2(Math.pow(2, intOrder))
+            .reduceRight((a, x) => {
+                return {
+                    triangle: a.indent + x.join(' ') + '\n' + a.triangle,
+                    indent: a.indent + ' '
+                }
+            }, {
+                triangle: '',
+                indent: ''
+            }).triangle
+    };
+
+    // zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
+    let zipWith = (f, xs, ys) =>
+            xs.length === ys.length ? (
+                xs.map((x, i) => f(x, ys[i]))
+            ) : undefined,
+
+        // range(intFrom, intTo, optional intStep)
+        // Int -> Int -> Maybe Int -> [Int]
+        range = (m, n, step) => {
+            let d = (step || 1) * (n >= m ? 1 : -1);
+
+            return Array.from({
+                length: Math.floor((n - m) / d) + 1
+            }, (_, i) => m + (i * d));
+        };
+
+    return sierpinski(order);
+
+})(4);

Task/Sierpinski-triangle/Julia/sierpinski-triangle.julia

@@ -2,7 +2,7 @@ pprint(matrix) = for i = 1:size(matrix,1) println(join(matrix[i,:])) end
 spaces(m,n) = [" " for i=1:m, j=1:n]
 
 function sierpinski(n)
-  x = ["*" for i=1, j=1]
+  x = ["*" for i=1:1, j=1:1]
   for i = 1:n
     h,w = size(x)
     s = spaces(h,(w+1)/2)

Task/Sierpinski-triangle/Maple/sierpinski-triangle.maple

@@ -0,0 +1,15 @@
+S := proc(n)
+    local i, j, values, position;
+    values := [ seq(" ",i=1..2^n-1), "*" ];
+    printf("%s\n",cat(op(values)));
+    for i from 2 to 2^n do
+        position := [ ListTools:-SearchAll( "*", values ) ];
+        values := Array([ seq(0, i=1..2^n+i-1) ]);
+        for j to numelems(position) do
+            values[position[j]-1] := values[position[j]-1] + 1;
+            values[position[j]+1] := values[position[j]+1] + 1;
+        end do;
+        values := subs( { 2 = " ", 0 = " ", 1 = "*"}, values );
+        printf("%s\n",cat(op(convert(values, list))));
+    end do:
+end proc:

Task/Sierpinski-triangle/Perl-6/sierpinski-triangle.pl6

@@ -2,7 +2,7 @@ sub sierpinski ($n) {
     my @down  = '*';
     my $space = ' ';
     for ^$n {
-        @down = flat @down.map({"$space$_$space"}), @down.map({"$_ $_"});
+        @down = |("$space$_$space" for @down), |("$_ $_" for @down);
         $space x= 2;
     }
     return @down;

Task/Sierpinski-triangle/REXX/sierpinski-triangle.rexx

@@ -1,17 +1,17 @@
-/*REXX program draws a  Sierpinski triangle  of up to around order 10k. */
-parse arg n mk .                       /*get the order of the triangle. */
-if n=='' | n==',' then n=4             /*if none specified, assume  4.  */
-if mk==''         then mk='*'          /*use the default of an asterisk.*/
-if length(mk)==2  then mk=x2c(mk)      /*MK was specified in hexadecimal*/
-if length(mk)==3  then mk=d2c(mk)      /*MK was specified in decimal.   */
-numeric digits 12000                   /*this otta handle the die-hards.*/
-                                       /* [↓]  the blood-'n-guts of pgm.*/
-   do j=0  for n*4;  !=1;  z=left('',n*4-1-j)        /*indent the line. */
-             do k=0  for j+1           /*build the line with  J+1  parts*/
-             if !//2==0  then z=z'  '  /*it's either a blank,  or  ···  */
-                         else z=z mk   /*it's one of them thar character*/
-             !=!*(j-k)%(k+1)           /*calculate a handy-dandy thingy.*/
-             end   /*k*/               /* [↑]  finished building a line.*/
-   say z                               /*display a line of the triangle.*/
-   end             /*j*/               /* [↑]  finished displaying tri. */
-                                       /*stick a fork in it, we're done.*/
+/*REXX program constructs and displays a  Sierpinski triangle of up to around order 10k.*/
+parse arg n mark .                               /*get the order of Sierpinski triangle.*/
+if n==''   | n==","  then n=4                    /*Not specified?  Then use the default.*/
+if mark==''          then mark=  "*"             /*MARK  was specified as  a character. */
+if length(mark)==2   then mark=x2c(mark)         /*  "    "      "     in  hexadecimal. */
+if length(mark)==3   then mark=d2c(mark)         /*  "    "      "      "      decimal. */
+numeric digits 12000                             /*this should handle the biggy numbers.*/
+                                                 /* [↓]  the blood-'n-guts of the pgm.  */
+   do j=0  for n*4;  !=1;  z=left('', n*4 -1-j)  /*indent the line to be displayed.     */
+         do k=0  for j+1                         /*construct the line with  J+1  parts. */
+         if !//2==0  then z=z'  '                /*it's either a    blank,   or    ···  */
+                     else z=z mark               /* ··· it's one of 'em thar characters.*/
+         !=! * (j-k) % (k+1)                     /*calculate handy-dandy thing-a-ma-jig.*/
+         end   /*k*/                             /* [↑]  finished constructing a line.  */
+   say z                                         /*display a line of the triangle.      */
+   end         /*j*/                             /* [↑]  finished showing triangle.     */
+                                                 /*stick a fork in it,  we're all done. */

Task/Sierpinski-triangle/Run-BASIC/sierpinski-triangle.run

@@ -0,0 +1,22 @@
+nOrder=4
+dim xy$(40)
+for i = 1 to 40
+    xy$(i) = "                               "
+next i
+call triangle 1, 1, nOrder
+for i = 1 to 36
+    print xy$(i)
+next i
+end
+
+SUB triangle x, y, n
+    IF n = 0 THEN
+        xy$(y) = left$(xy$(y),x-1) + "*" + mid$(xy$(y),x+1)
+    ELSE
+        n=n-1
+        length=2^n
+        call triangle x, y+length, n
+        call triangle x+length, y, n
+        call triangle x+length*2, y+length, n
+    END IF
+END SUB