Sierpinski triangle

From Rosetta Code

Produce an ASCII representation of a Sierpinski triangle of order N. For example, the Sierpinski triangle of order 4 should look like this:

                       *
                      * *
                     *   *
                    * * * *
                   *       *
                  * *     * *
                 *   *   *   *
                * * * * * * * *
               *               *
              * *             * *
             *   *           *   *
            * * * *         * * * *
           *       *       *       *
          * *     * *     * *     * *
         *   *   *   *   *   *   *   *
        * * * * * * * * * * * * * * * *

See also Sierpinski carpet

Contents 1 Ada 2 BASIC 3 Common Lisp 4 D 5 Forth 6 Haskell 7 IDL 8 J 9 Java 10 JavaScript 11 Logo 12 OCaml 13 Perl 14 Pop11 15 Python 16 Ruby 17 Scheme 18 Vedit macro language 18.1 Iterative 18.2 Recursive

[edit] Ada

This Ada example creates a string of the binary value for each line, converting the '0' values to spaces.

with Ada.Text_Io; use Ada.Text_Io;
with Ada.Strings.Fixed;
with Interfaces; use Interfaces;
 
procedure Sieteri_Triangles is
   subtype Practical_Order is Unsigned_32 range 0..4;
 
 
   function Pow(X : Unsigned_32; N : Unsigned_32) return Unsigned_32 is
   begin
      if N = 0 then
         return 1;
      else
         return X * Pow(X, N - 1);
      end if;
   end Pow;
 
   procedure Print(Item : Unsigned_32) is
      use Ada.Strings.Fixed;
      package Ord_Io is new Ada.Text_Io.Modular_Io(Unsigned_32);
      use Ord_Io;
      Temp : String(1..36) := (others => ' ');
      First : Positive;
      Last  : Positive;
   begin
      Put(To => Temp, Item => Item, Base => 2);
      First := Index(Temp, "#") + 1;
      Last  := Index(Temp(First..Temp'Last), "#") - 1;
      for I in reverse First..Last loop
         if Temp(I) = '0' then
            Put(' ');
         else
            Put(Temp(I));
         end if;
      end loop;
      New_Line;
   end Print;
 
   procedure Sierpinski (N : Practical_Order) is
      Size : Unsigned_32 := Pow(2, N);
      V : Unsigned_32 := Pow(2, Size);
   begin
      for I in 0..Size - 1 loop
         Print(V);
         V := Shift_Left(V, 1) xor Shift_Right(V,1);
      end loop;
   end Sierpinski;
 
begin
   for N in Practical_Order loop
      Sierpinski(N);
   end loop;
end Sieteri_Triangles;

[edit] BASIC

Works with: FreeBASIC

Works with: RapidQ

SUB triangle (x AS Integer, y AS Integer, length AS Integer, n AS Integer)
    IF n = 0 THEN
        LOCATE y,x: PRINT "*";
    ELSE
        triangle (x,          y+length, length/2, n-1)
	triangle (x+length,   y,        length/2, n-1)
        triangle (x+length*2, y+length, length/2, n-1)
    END IF
END SUB
 
CLS
triangle 1,1,16,5

Note: The total height of the triangle is 2 * parameter length. It should be power of two so that the pattern matches evenly with the character cells. Value 16 will thus create pattern of 32 lines.

[edit] Common Lisp

(defun print-sierpinski (order)
  (loop with size = (expt 2 order)
        repeat size
        for v = (expt 2 (1- size)) then (logxor (ash v -1) (ash v 1))
        do (fresh-line)
           (loop for i below (integer-length v)
                 do (princ (if (logbitp i v) "*" " ")))))

Printing each row could also be done by printing the integer in base 2 and replacing zeroes with spaces: (princ (substitute #\Space #\0 (format nil "~%~2,vR" (1- (* 2 size)) v)))

Replacing the iteration with for v = 1 then (logxor v (ash v 1)) produces a "right" triangle instead of an "equilateral" one.

[edit] D

Adapted from Java version (this version is slower than the Python one).

import std.stdio, std.string;
 
string[] sierpinski(int n) {
    string[] parts = ["*"];
    string space = " ";
    for (int i; i < n; i++) {
        string[] parts2;
        foreach (x; parts)
            parts2 ~= space ~ x ~ space;
        foreach (x; parts)
            parts2 ~= x ~ " " ~ x;
        parts = parts2;
        space ~= space;
    }
    return parts;
}
 
void main() {
    writefln(sierpinski(4).join("\n"));
}

That sierpinski() function can run at compile time too, so with a compile-time join it can compute the whole result at compile-time:

 
string[] sierpinski(int n) {
    string[] parts = ["*"];
    string space = " ";
    for (int i; i < n; i++) {
        string[] parts2;
        foreach (x; parts)
            parts2 ~= space ~ x ~ space;
        foreach (x; parts)
            parts2 ~= x ~ " " ~ x;
        parts = parts2;
        space ~= space;
    }
    return parts;
}
 
string joinCT(string[] parts, char sep) {
    string result;
    if (parts.length) {
        foreach (part; parts[0 .. $-1]) {
            result ~= part;
            result ~= sep;
        }
        result ~= parts[$-1];
    }
    return result;
}
 
pragma(msg, sierpinski(4).joinCT('\n'));
 
void main() {}
 

[edit] Forth

: stars ( mask -- )
  begin
    dup 1 and if [char] * else bl then emit
    1 rshift  dup
  while space repeat drop ;

: triangle ( order -- )
  1 swap lshift   ( 2^order )
  1 over 0 do
    cr  over i - spaces  dup stars
    dup 2* xor
  loop 2drop ;
 
5 triangle

[edit] Haskell

sierpinski 0     = ["*"]
sierpinski (n+1) =    map ((space ++) . (++ space)) down 
                   ++ map (unwords . replicate 2)   down
  where down = sierpinski n
        space = replicate (2^n) ' '

printSierpinski = mapM_ putStrLn . sierpinski

[edit] IDL

The only 'special' thing here is that the math is done in a byte array, filled with the numbers 32 and 42 and then output through a "string(array)" which prints the ascii representation of each individual element in the array.

pro sierp,n
  s = (t = bytarr(3+2^(n+1))+32b)
  t[2^n+1] = 42b  
  for lines = 1,2^n do begin
        print,string( (s = t) )
        for i=1,n_elements(t)-2 do if s[i-1] eq s[i+1] then t[i]=32b else t[i]=42b
  end
end

[edit] J

There are any number of succinct ways to produce this in J. Here's one that exploits self-similarity:

   |._31]\,(,.~,])^:4,:'* '

Here's one that leverages the relationship between Sierpinski's and Pascal's triangles:

   ' *'{~'1'=(-|."_1[:":2|!/~)i.-16

[edit] Java

Translation of: JavaScript

public static void triangle(int n){
        n= 1 << n;
        StringBuilder line= new StringBuilder(); //use a "mutable String"
        char t= 0;
        char u= 0; // avoid warnings
        for(int i= 0;i <= 2 * n;++i)
                line.append(" "); //start empty
        line.setCharAt(n, '*'); //with the top point of the triangle
        for(int i= 0;i < n;++i){
                System.out.println(line);
                u= '*';
                for(int j= n - i;j < n + i + 1;++j){
                        t= (line.charAt(j - 1) == line.charAt(j + 1) ? ' ' : '*');
                        line.setCharAt(j - 1, u);
                        u= t;
                }
                line.setCharAt(n + i, t);
                line.setCharAt(n + i + 1, '*');
        }
}

Translation of: Haskell

 
import java.util.*;
 
public class Sierpinski
{
    public static List<String> sierpinski(int n)
    {
        List<String> down = Arrays.asList("*");
        String space = " ";
        for (int i = 0; i < n; i++) {
            List<String> newDown = new ArrayList<String>();
            for (String x : down)
                newDown.add(space + x + space);
            for (String x : down)
                newDown.add(x + " " + x);
 
            down = newDown;
            space += space;
        }
        return down;
    }
 
    public static void main(String[] args)
    {
        for (String x : sierpinski(4))
            System.out.println(x);
    }
}
 

[edit] JavaScript

 
 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;
     }
     line[n+i] = t;
     line[n+i+1] = '*';
   }
 }
 document.write("<pre>\n");
 triangle(6);
 document.write("</pre>");
 

[edit] Logo

This will draw a graphical Sierpinski gasket using turtle graphics.

to sierpinski :n :length
  if :n = 0 [stop]
  repeat 3 [sierpinski :n-1 :length/2  fd :length rt 120]
end
seth 30 sierpinski 5 200

[edit] OCaml

 
let sierpinski n =
  let rec loop down space n =
    if n = 0 then
      down
    else
      loop (List.map (fun x -> space ^ x ^ space) down @
              List.map (fun x -> x ^ " " ^ x) down)
        (space ^ space)
        (n - 1)
  in loop ["*"] " " n
 
let () =
  List.iter print_endline (sierpinski 4)
 

[edit] Perl

 
sub sierpinski {
    my ($n) = @_;
    my @down = '*';
    my $space = ' ';
    foreach (1..$n) {
        @down = (map("$space$_$space", @down), map("$_ $_", @down));
        $space = "$space$space";
    }
    return @down;
}
 
print "$_\n" foreach sierpinski 4;
 

[edit] Pop11

Solution using line buffer in an integer array oline, 0 represents ' ' (space), 1 represents '*' (star).

define triangle(n);
    lvars k = 2**n, j, l, oline, nline;
    initv(2*k+3) -> oline;
    initv(2*k+3) -> nline;
    for l from 1 to 2*k+3 do 0 -> oline(l) ; endfor;
    1 -> oline(k+2);
    0 -> nline(1);
    0 -> nline(2*k+3);
    for j from 1 to k do
        for l from 1 to 2*k+3 do
            printf(if oline(l) = 0 then ' ' else '*' endif);
        endfor;
        printf('\n');
        for l from 2 to 2*k+2 do
            (oline(l-1) + oline(l+1)) rem 2 -> nline(l);
        endfor;
        (oline, nline) -> (nline, oline);
    endfor;
enddefine;

triangle(4);

Alternative solution, keeping all triangle as list of strings

define triangle2(n);
    lvars acc = ['*'], spaces = ' ', j;
    for j from 1 to n do
        maplist(acc, procedure(x); spaces >< x >< spaces ; endprocedure)
         <> maplist(acc, procedure(x); x >< ' ' >< x ; endprocedure) -> acc;
        spaces >< spaces -> spaces;
    endfor;
    applist(acc, procedure(x); printf(x, '%p\n'); endprocedure);
enddefine;

triangle2(4);

[edit] Python

 
def sierpinski(n):
    d = ["*"]
    for i in xrange(n):
        sp = " " * (2 ** i)
        d = [sp+x+sp for x in d] + [x+" "+x for x in d]
    return d
 
print "\n".join(sierpinski(4))
 

[edit] Ruby

From the command line:

 
ruby -le'16.times{|y|print" "*(15-y),(0..y).map{|x|~y&x>0?"  ":" *"}}'
 

[edit] Scheme

Translation of: Haskell

 
(define (sierpinski n)
  (for-each
   (lambda (x) (display (list->string x)) (newline))
   (let loop ((acc (list (list #\*))) (spaces (list #\ )) (n n))
     (if (zero? n)
         acc
         (loop
          (append
           (map (lambda (x) (append spaces x spaces)) acc)
           (map (lambda (x) (append x (list #\ ) x)) acc))
          (append spaces spaces)
          (- n 1))))))
 

[edit] Vedit macro language

[edit] Iterative

Translation of: JavaScript

The macro writes the fractal into an edit buffer where it can be viewed and saved to file if required. This allows creating images larger than screen, the size is only limited by free disk space.

#3 = 16    // size (height) of the triangle
Buf_Switch(Buf_Free)				// Open a new buffer for output
Ins_Char(' ', COUNT, #3*2+2)			// fill first line with spaces
Ins_Newline
Line(-1) Goto_Col(#3)
Ins_Char('*', OVERWRITE)			// the top of triangle
for (#10=0; #10 < #3-1; #10++) {
    BOL Reg_Copy(9,1) Reg_Ins(9)		// duplicate the line
    #20 = '*'
    for (#11 = #3-#10; #11 < #3+#10+1; #11++) {
        Goto_Col(#11-1)
	if (Cur_Char==Cur_Char(2)) { #21=' ' } else { #21='*' }
	Ins_Char(#20, OVERWRITE)
	#20 = #21
    }
    Ins_Char(#21, OVERWRITE)
    Ins_Char('*', OVERWRITE)
}

[edit] Recursive

Translation of: BASIC

Vedit macro language does not have recursive functions, so some pushing and popping is needed to implement recursion.

#1 = 1		// x
#2 = 1		// y
#3 = 16		// length (height of the triangle / 2)
#4 = 5		// depth of recursion

Buf_Switch(Buf_Free)		// Open a new buffer for output
Ins_Newline(#3*2)		// Create as many empty lines as needed
Call("Triangle")		// Draw the triangle
BOF
Return

:Triangle:
if (#4 == 0) {
    Goto_Line(#2)
    EOL Ins_Char(' ', COUNT, #1-Cur_Col+1) 	// add spaces if needed
    Goto_Col(#1)
    Ins_Char('*', OVERWRITE)
} else {
    Num_Push(1,4)
    #2 += #3; #3 /= 2; #4--; Call("Triangle")
    Num_Pop(1,4)
    Num_Push(1,4)
    #1 += #3; #3 /= 2; #4--; Call("Triangle")
    Num_Pop(1,4)
    Num_Push(1,4)
    #1 += 2*#3; #2 += #3; #3 /= 2; #4--; Call("Triangle")
    Num_Pop(1,4)
}
Return