public class ShortestCommonSuperSequence {
    private static boolean isEmpty(String s) {
        return null == s || s.isEmpty();
    }

    private static String scs(String x, String y) {
        if (isEmpty(x)) {
            return y;
        }
        if (isEmpty(y)) {
            return x;
        }

        if (x.charAt(0) == y.charAt(0)) {
            return x.charAt(0) + scs(x.substring(1), y.substring(1));
        }

        if (scs(x, y.substring(1)).length() <= scs(x.substring(1), y).length()) {
            return y.charAt(0) + scs(x, y.substring(1));
        } else {
            return x.charAt(0) + scs(x.substring(1), y);
        }
    }

    public static void main(String[] args) {
        System.out.println(scs("abcbdab", "bdcaba"));
    }
}


-- demo\rosetta\SierpinskyTriangle.exw
include pGUI.e

Ihandle dlg, canvas
cdCanvas cddbuffer, cdcanvas

procedure SierpinskyTriangle(integer level, atom x, atom y, atom w, atom h)
    atom w2 = w/2, w4 = w/4, h2 = h/2
    if level=1 then
        cdCanvasBegin(cddbuffer,CD_CLOSED_LINES)
        cdCanvasVertex(cddbuffer, x, y)
        cdCanvasVertex(cddbuffer, x+w2, y+h)
        cdCanvasVertex(cddbuffer, x+w, y)
        cdCanvasEnd(cddbuffer)
    else
        SierpinskyTriangle(level-1, x,    y,    w2, h2)
        SierpinskyTriangle(level-1, x+w4, y+h2, w2, h2)
        SierpinskyTriangle(level-1, x+w2, y,    w2, h2)
    end if
end procedure

integer level = 7

function redraw_cb(Ihandle /*ih*/, integer /*posx*/, integer /*posy*/)
    integer {w, h} = IupGetIntInt(canvas, "DRAWSIZE")
    cdCanvasActivate(cddbuffer)
    cdCanvasClear(cddbuffer)
    SierpinskyTriangle(level, w*0.05, h*0.05, w*0.9, h*0.9)
    cdCanvasFlush(cddbuffer)
    IupSetStrAttribute(dlg, "TITLE", "Sierpinsky Triangle (level %d)",{level})
    return IUP_DEFAULT
end function

function map_cb(Ihandle ih)
    cdcanvas = cdCreateCanvas(CD_IUP, ih)
    cddbuffer = cdCreateCanvas(CD_DBUFFER, cdcanvas)
    cdCanvasSetBackground(cddbuffer, CD_WHITE)
    cdCanvasSetForeground(cddbuffer, CD_GRAY)
    return IUP_DEFAULT
end function

function esc_close(Ihandle /*ih*/, atom c)
    if c=K_ESC then return IUP_CLOSE end if
    if find(c,"+-") then
        level = max(1,min(12,level+','-c))
        IupRedraw(canvas)
    end if
    return IUP_CONTINUE
end function

procedure main()
    IupOpen()

    canvas = IupCanvas(NULL)
    IupSetAttribute(canvas, "RASTERSIZE", "640x640")
    IupSetCallback(canvas, "MAP_CB", Icallback("map_cb"))
    IupSetCallback(canvas, "ACTION", Icallback("redraw_cb"))

    dlg = IupDialog(canvas)
    IupSetAttribute(dlg, "TITLE", "Sierpinsky Triangle")
    IupSetCallback(dlg, "K_ANY",     Icallback("esc_close"))

    IupShow(dlg)
    IupSetAttribute(canvas, "RASTERSIZE", NULL)
    if platform()!=JS then
        IupMainLoop()
        IupClose()
    end if
end procedure
main()


# largest common substring
# Uses recursion, taking advantage of jq's TCO
def lcs:
  . as [$x, $y]
  | if ($x|length == 0) or ($y|length == 0) then ""
    else $x[:-1] as $x1
    | $y[:-1] as $y1
    | if $x[-1:] == $y[-1:] then ([$x1, $y1] | lcs) + $x[-1:]
      else ([$x, $y1] | lcs) as $x2
      | ([$x1, $y] | lcs) as $y2
      | if ($x2|length) > ($y2|length) then $x2 else $y2 end
      end
    end;

def scs:
  def eq($s;$i; $t;$j): $s[$i:$i+1] == $t[$j:$j+1];

  . as [$u, $v]
  | lcs as $lcs
  | reduce range(0; $lcs|length) as $i ( { ui: 0, vi: 0, sb: "" };
        until(  .ui == ($u|length) or eq($u;.ui; $lcs;$i);
	    .ui as $ui
            | .sb += $u[$ui:$ui+1]
            | .ui += 1 )
	| until(.vi == ($v|length) or eq($v;.vi; $lcs;$i);
	    .vi as $vi
            | .sb += $v[$vi:$vi+1]
            | .vi += 1 )
        | .sb += $lcs[$i:$i+1]
        | .ui += 1
        | .vi += 1
    )
    | if .ui < ($u|length) then .sb = .sb + $u[.ui:] else . end
    | if .vi < ($v|length) then .sb = .sb + $v[.vi:] else . end
    | .sb ;

[ "abcbdab", "bdcaba" ] | scs


using Memoize

@memoize function scs(x, y)
    if x == ""
        return y
    elseif y == ""
        return x
    elseif x[1] == y[1]
        return "$(x[1])$(scs(x[2:end], y[2:end]))"
    elseif length(scs(x, y[2:end])) <= length(scs(x[2:end], y))
        return "$(y[1])$(scs(x, y[2:end]))"
    else
        return "$(x[1])$(scs(x[2:end], y))"
    end
end

println(scs("abcbdab", "bdcaba"))


// version 1.1.2

fun lcs(x: String, y: String): String {
    if (x.length == 0 || y.length == 0) return ""
    val x1 = x.dropLast(1)
    val y1 = y.dropLast(1)
    if (x.last() == y.last()) return lcs(x1, y1) + x.last()
    val x2 = lcs(x, y1)
    val y2 = lcs(x1, y)
    return if (x2.length > y2.length) x2 else y2
}

fun scs(u: String, v: String): String{
    val lcs = lcs(u, v)
    var ui = 0
    var vi = 0
    val sb = StringBuilder()
    for (i in 0 until lcs.length) {
        while (ui < u.length && u[ui] != lcs[i]) sb.append(u[ui++])
        while (vi < v.length && v[vi] != lcs[i]) sb.append(v[vi++])
        sb.append(lcs[i])
        ui++; vi++
    }
    if (ui < u.length) sb.append(u.substring(ui))
    if (vi < v.length) sb.append(v.substring(vi))
    return sb.toString()
}

fun main(args: Array<String>) {
    val u = "abcbdab"
    val v = "bdcaba"
    println(scs(u, v))
}


(de sierpinski (N)
   (let (D '("1")  S "0")
      (do N
         (setq
            D (conc
               (mapcar '((X) (pack S X S)) D)
               (mapcar '((X) (pack X "0" X)) D) )
            S (pack S S) ) )
      D ) )

(out '(display -)
   (let Img (sierpinski 7)
      (prinl "P1")
      (prinl (length (car Img)) " " (length Img))
      (mapc prinl Img) ) )


%!PS

/sierp { % level ax ay bx by cx cy
    6 cpy triangle
    sierpr
} bind def

/sierpr {
    12 cpy
    10 -4 2 {
        5 1 roll exch 4 -1 roll
        add 0.5 mul 3 1 roll
        add 0.5 mul 3 -1 roll
        2 roll
    } for       % l a b c bc ac ab
    13 -1 roll dup 0 gt {
        1 sub
        dup 4 cpy 18 -2 roll sierpr
        dup 7 index 7 index 2 cpy 16 -2 roll sierpr
        9 3 roll 1 index 1 index 2 cpy 13 4 roll sierpr
    } { 13 -6 roll 7 { pop } repeat } ifelse
    triangle
} bind def

/cpy { { 5 index } repeat } bind def

/triangle {
    newpath moveto lineto lineto closepath stroke
} bind def

6 50 100 550 100 300 533 sierp
showpage


PVector [] coord = {new PVector(0, 0), new PVector(150, 300), new PVector(300, 0)};

void setup()
{
  size(400,400);
  background(32);
  sierpinski(new PVector(150,150), 8);
  noLoop();
}

void sierpinski(PVector cPoint, int cDepth)
{
  if (cDepth == 0) {
    set(50+int(cPoint.x), (height-50)-int(cPoint.y), color(192));
    return;
  }
  for (int v=0; v<3; v++) {
    sierpinski(new PVector((cPoint.x+coord[v].x)/2, (cPoint.y+coord[v].y)/2), cDepth-1);
  }
}


sierpinski(N) :-
	sformat(A, 'Sierpinski order ~w', [N]),
	new(D, picture(A)),
	draw_Sierpinski(D, N, point(350,50), 600),
	send(D, size, size(690,690)),
	send(D, open).

draw_Sierpinski(Window, 1, point(X, Y), Len) :-
	X1 is X - round(Len/2),
	X2 is X + round(Len/2),
	Y1 is Y + Len * sqrt(3) / 2,
	send(Window, display, new(Pa, path)),
        (
	   send(Pa, append, point(X, Y)),
	   send(Pa, append, point(X1, Y1)),
	   send(Pa, append, point(X2, Y1)),
	   send(Pa, closed, @on),
	   send(Pa, fill_pattern,  colour(@default, 0, 0, 0))
	).

draw_Sierpinski(Window, N, point(X, Y), Len) :-
	Len1 is round(Len/2),
	X1 is X - round(Len/4),
	X2 is X + round(Len/4),
	Y1 is Y + Len * sqrt(3) / 4,
	N1 is N - 1,
	draw_Sierpinski(Window, N1, point(X, Y), Len1),
	draw_Sierpinski(Window, N1, point(X1, Y1), Len1),
	draw_Sierpinski(Window, N1, point(X2, Y1), Len1).


ClearAll[RosettaShortestCommonSuperSequence]
RosettaShortestCommonSuperSequence[aa_String, bb_String] :=
 Module[{lcs, scs, a = aa, b = bb},
  lcs = LongestCommonSubsequence[aa, bb];
  scs = "";
  While[StringLength[lcs] > 0,
   If[StringTake[a, 1] == StringTake[lcs, 1] \[And] StringTake[b, 1] == StringTake[lcs, 1],
    scs = StringJoin[scs, StringTake[lcs, 1]];
    lcs = StringDrop[lcs, 1];
    a = StringDrop[a, 1];
    b = StringDrop[b, 1];
    ,
    If[StringTake[a, 1] == StringTake[lcs, 1],
     scs = StringJoin[scs, StringTake[b, 1]];
     b = StringDrop[b, 1];
     ,
     scs = StringJoin[scs, StringTake[a, 1]];
     a = StringDrop[a, 1];
     ]
    ]
   ];
  StringJoin[scs, a, b]
  ]
RosettaShortestCommonSuperSequence["abcbdab", "bdcaba"]
RosettaShortestCommonSuperSequence["WEASELS", "WARDANCE"]


proc lcs(x, y: string): string =
  if x.len == 0 or y.len == 0: return
  let x1 = x[0..^2]
  let y1 = y[0..^2]
  if x[^1] == y[^1]: return lcs(x1, y1) & x[^1]
  let x2 = lcs(x, y1)
  let y2 = lcs(x1, y)
  result = if x2.len > y2.len: x2 else: y2

proc scs(u, v: string): string =
  let lcs = lcs(u, v)
  var ui, vi = 0
  for ch in lcs:
    while ui < u.len and u[ui] != ch:
      result.add u[ui]
      inc ui
    while vi < v.len and v[vi] != ch:
      result.add v[vi]
      inc vi
    result.add ch
    inc ui
    inc vi
  if ui < u.len: result.add u.substr(ui)
  if vi < v.len: result.add v.substr(vi)

when isMainModule:
  let u = "abcbdab"
  let v = "bdcaba"
  echo scs(u, v)


sub lcs { # longest common subsequence
    my( $u, $v ) = @_;
    return '' unless length($u) and length($v);
    my $longest = '';
    for my $first ( 0..length($u)-1 ) {
        my $char = substr $u, $first, 1;
        my $i = index( $v, $char );
        next if -1==$i;
        my $next = $char;
        $next .= lcs( substr( $u, $first+1), substr( $v, $i+1 ) ) unless $i==length($v)-1;
        $longest = $next if length($next) > length($longest);
    }
    return $longest;
}

sub scs { # shortest common supersequence
    my( $u, $v ) = @_;
    my @lcs = split //, lcs $u, $v;
    my $pat = "(.*)".join("(.*)",@lcs)."(.*)";
    my @u = $u =~ /$pat/;
    my @v = $v =~ /$pat/;
    my $scs = shift(@u).shift(@v);
    $scs .= $_.shift(@u).shift(@v) for @lcs;
    return $scs;
}

my $u = "abcbdab";
my $v = "bdcaba";
printf "Strings %s %s\n", $u, $v;
printf "Longest common subsequence:   %s\n", lcs $u, $v;
printf "Shortest common supersquence: %s\n", scs $u, $v;


# a very simple version
import turtle as t
def sier(n,length):
    if n == 0:
        return
    for i in range(3):
        sier(n - 1, length / 2)
        t.fd(length)
        t.rt(120)


  [ $ "turtleduck.qky" loadfile ] now!

  [ 1 & ]                 is odd        (   n --> b )

  [ 4 times
      [ 2dup walk
        1 4 turn ]
    2drop ]               is square     ( n/d -->   )

  [ dup
    witheach
      [ odd if
          [ ' [ 0 0 0 ] fill
              [ 2 1 square ] ]
        2 1 fly ]
     size -2 * 1 fly
     1 4 turn
     2 1 fly
     -1 4 turn ]          is showline   (   [ -->   )

  [ [] 0 rot 0 join
    witheach
     [ tuck +
       rot join swap ]
    drop ]                is nextline   (   [ --> [ )

  [ ' [ 1 ] swap
    bit
    1 - times
      [ dup showline
        nextline ]
    showline ]            is sierpinski (   n -->   )

  turtle
  5 8 turn
  400 1 fly
  3 8 turn
  8 sierpinski


## Plotting Sierpinski triangle. aev 4/1/17
## ord - order, fn - file name, ttl - plot title, clr - color
pSierpinskiT <- function(ord, fn="", ttl="", clr="navy") {
  m=640; abbr="STR"; dftt="Sierpinski triangle";
  n=2^ord; M <- matrix(c(0), ncol=n, nrow=n, byrow=TRUE);
  cat(" *** START", abbr, date(), "\n");
  if(fn=="") {pf=paste0(abbr,"o", ord)} else {pf=paste0(fn, ".png")};
  if(ttl!="") {dftt=ttl}; ttl=paste0(dftt,", order ", ord);
  cat(" *** Plot file:", pf,".png", "title:", ttl, "\n");
  for(y in 1:n) {
    for(x in 1:n) {
      if(bitwAnd(x, y)==0) {M[x,y]=1}
    ##if(bitwAnd(x, y)>0) {M[x,y]=1}   ## Try this for "reversed" ST
  }}
  plotmat(M, pf, clr, ttl);
  cat(" *** END", abbr, date(), "\n");
}
## Executing:
pSierpinskiT(6,,,"red");
pSierpinskiT(8);


#lang racket
(require 2htdp/image)
(define (sierpinski n)
  (if (zero? n)
    (triangle 2 'solid 'red)
    (let ([t (sierpinski (- n 1))])
      (freeze (above t (beside t t))))))


my $levels = 8;
my $side   = 512;
my $height = get_height($side);

sub get_height ($side) { $side * 3.sqrt / 2 }

sub triangle ( $x1, $y1, $x2, $y2, $x3, $y3, $fill?, $animate? ) {
    my $svg;
    $svg ~= qq{<polygon points="$x1,$y1 $x2,$y2 $x3,$y3"};
    $svg ~= qq{ style="fill: $fill; stroke-width: 0;"} if $fill;
    $svg ~= $animate
        ?? qq{>\n  <animate attributeType="CSS" attributeName="opacity"\n  values="1;0;1" keyTimes="0;.5;1" dur="20s" repeatCount="indefinite" />\n</polygon>}
        !! ' />';
    return $svg;
}

sub fractal ( $x1, $y1, $x2, $y2, $x3, $y3, $r is copy ) {
    my $svg;
    $svg ~= triangle( $x1, $y1, $x2, $y2, $x3, $y3 );
    return $svg unless --$r;
    my $side = abs($x3 - $x2) / 2;
    my $height = get_height($side);
    $svg ~= fractal( $x1, $y1-$height*2, $x1-$side/2, $y1-3*$height, $x1+$side/2, $y1-3*$height, $r);
    $svg ~= fractal( $x2, $y1, $x2-$side/2, $y1-$height, $x2+$side/2, $y1-$height, $r);
    $svg ~= fractal( $x3, $y1, $x3-$side/2, $y1-$height, $x3+$side/2, $y1-$height, $r);
}

my $fh = open('sierpinski_triangle.svg', :w) orelse .die;
$fh.print: qq:to/EOD/,
<?xml version="1.0" standalone="no"?>
<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN" "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">
<svg width="100%" height="100%" version="1.1" xmlns="http://www.w3.org/2000/svg">
<defs>
  <radialGradient id="basegradient" cx="50%" cy="65%" r="50%" fx="50%" fy="65%">
    <stop offset="10%" stop-color="#ff0" />
    <stop offset="60%" stop-color="#f00" />
    <stop offset="99%" stop-color="#00f" />
  </radialGradient>
</defs>
EOD

triangle( $side/2, 0, 0, $height, $side, $height, 'url(#basegradient)' ),
triangle( $side/2, 0, 0, $height, $side, $height, '#000', 'animate' ),
'<g style="fill: #fff; stroke-width: 0;">',
fractal( $side/2, $height, $side*3/4, $height/2, $side/4, $height/2, $levels ),
'</g></svg>';


with javascript_semantics
function longest_common_subsequence(sequence a, b)
    sequence res = ""
    if length(a) and length(b) then
        if a[$]=b[$] then
            res = longest_common_subsequence(a[1..-2],b[1..-2])&a[$]
        else
            sequence l = longest_common_subsequence(a,b[1..-2]),
                     r = longest_common_subsequence(a[1..-2],b)
            res = iff(length(l)>length(r)?l:r)
        end if
    end if
    return res
end function

function shortest_common_supersequence(string a, b)
    string lcs = longest_common_subsequence(a, b),
           scs = ""
    -- Consume lcs
    while length(lcs) do
        integer c = lcs[1]
        if a[1]==c and b[1]==c then
            -- Part of the lcs, so consume from all strings
            scs &= c
            lcs = lcs[2..$]
            a = a[2..$]
            b = b[2..$]
        elsif a[1]==c then
            scs &= b[1]
            b = b[2..$]
        else
            scs &= a[1]
            a = a[2..$]
        end if
    end while
    -- append remaining characters
    return scs & a & b
end function

?shortest_common_supersequence("abcbdab", "bdcaba")
?shortest_common_supersequence("WEASELS", "WARDANCE")


# Use the Longest Common Subsequence algorithm

def shortest_common_supersequence(a, b):
    lcs = longest_common_subsequence(a, b)
    scs = ""
    # Consume lcs
    while len(lcs) > 0:
        if a[0]==lcs[0] and b[0]==lcs[0]:
        # Part of the LCS, so consume from all strings
            scs += lcs[0]
            lcs = lcs[1:]
            a = a[1:]
            b = b[1:]
        elif a[0]==lcs[0]:
            scs += b[0]
            b = b[1:]
        else:
            scs += a[0]
            a = a[1:]
    # append remaining characters
    return scs + a + b


load "guilib.ring"

new qapp
    {
    win1 = new qwidget() {
           setwindowtitle("drawing using qpainter")
           setgeometry(100,100,500,500)
           label1 = new qlabel(win1) {
                    setgeometry(10,10,400,400)
                    settext("")
                    }
           new qpushbutton(win1) {
               setgeometry(200,400,100,30)
               settext("draw")
               setclickevent("draw()")
               }
           show()
           }
           exec()
    }

func draw
     p1 = new qpicture()
          color = new qcolor() {
          setrgb(0,0,255,255)
          }
     pen = new qpen() {
           setcolor(color)
           setwidth(1)
           }
     new qpainter() {
         begin(p1)
         setpen(pen)

         order = 7
         size = pow(2,order)
         for y = 0 to size-1
             for x = 0 to size-1
                 if (x & y)=0 drawpoint(x*2,y*2) ok
             next
         next
         endpaint()
         }
         label1 { setpicture(p1) show() }


Shoes.app(:height=>540,:width=>540, :title=>"Sierpinski Triangle") do
  def triangle(slot, tri, color)
    x, y, len = tri
    slot.append do
      fill color
      shape do
        move_to(x,y)
        dx = len * Math::cos(Math::PI/3)
        dy = len * Math::sin(Math::PI/3)
        line_to(x-dx, y+dy)
        line_to(x+dx, y+dy)
        line_to(x,y)
      end
    end
  end
  @s = stack(:width => 520, :height => 520) {}
  @s.move(10,10)

  length = 512
  @triangles = [[length/2,0,length]]
  triangle(@s, @triangles[0], rgb(0,0,0))

  @n = 1
  animate(1) do
    if @n <= 7
      @triangles = @triangles.inject([]) do |sum, (x, y, len)|
        dx = len/2 * Math::cos(Math::PI/3)
        dy = len/2 * Math::sin(Math::PI/3)
        triangle(@s, [x, y+2*dy, -len/2], rgb(255,255,255))
        sum += [[x, y, len/2], [x-dx, y+dy, len/2], [x+dx, y+dy, len/2]]
      end
    end
    @n += 1
  end

  keypress do |key|
    case key
    when :control_q, "\x11" then exit
    end
  end
end


#lang racket

(struct link (len letters))

(define (link-add li n letter)
  (link (+ n (link-len li))
        (cons letter (link-letters li))))

(define (memoize f)
  (local ([define table (make-hash)])
    (lambda args
      (dict-ref! table args (λ () (apply f args))))))

(define scs/list
  (memoize
   (lambda (x y)
     (cond
       [(null? x)
        (link (length y) y)]
       [(null? y)
        (link (length x) x)]
       [(eq? (car x) (car y))
        (link-add (scs/list (cdr x) (cdr y)) 1 (car x))]
       [(<= (link-len (scs/list x (cdr y)))
            (link-len (scs/list (cdr x) y)))
        (link-add (scs/list x (cdr y)) 1 (car y))]
       [else
        (link-add (scs/list (cdr x) y) 1 (car x))]))))

(define (scs x y)
  (list->string (link-letters (scs/list (string->list x) (string->list y)))))

(scs "abcbdab" "bdcaba")


sub lcs(Str $xstr, Str $ystr) { # longest common subsequence
    return "" unless $xstr && $ystr;
    my ($x, $xs, $y, $ys) = $xstr.substr(0, 1), $xstr.substr(1), $ystr.substr(0, 1), $ystr.substr(1);
    return $x eq $y
        ?? $x ~ lcs($xs, $ys)
        !! max(:by{ $^a.chars }, lcs($xstr, $ys), lcs($xs, $ystr) );
}

sub scs ($u, $v) { # shortest common supersequence
    my @lcs = (lcs $u, $v).comb;
    my $pat = '(.*)' ~ join('(.*)',@lcs) ~ '(.*)';
    my $regex = "rx/$pat/".EVAL;
    my @u = ($u ~~ $regex).list;
    my @v = ($v ~~ $regex).list;
    my $scs = shift(@u) ~ shift(@v);
    $scs ~= $_ ~ shift(@u) ~ shift(@v) for @lcs;
    return $scs;
}

my $u = 'abcbdab';
my $v = 'bdcaba';
printf "Strings: %s %s\n", $u, $v;
printf "Longest common subsequence:   %s\n", lcs $u, $v;
printf "Shortest common supersquence: %s\n", scs $u, $v;


/*REXX program finds the  Shortest common supersequence (SCS)  of two character strings.*/
parse arg u v .                                  /*obtain optional arguments from the CL*/
if u=='' | u==","  then u= 'abcbdab'             /*Not specified?  Then use the default.*/
if v=='' | v==","  then v= 'bdcaba'              /* "      "         "   "   "     "    */
say '                     string u='  u          /*echo the value of string  U  to term.*/
say '                     string v='  v          /*  "   "    "    "    "    V   "   "  */
$= u                                             /*define initial value for the output. */
      do n=1    to length(u)                     /*process the whole length of string U.*/
        do m=n  to length(v) - 1                 /*   "    right─ish  part   "    "   V.*/
        p= pos( substr(v, m, 1), $)              /*position of mTH  V  char in $ string.*/
        _= substr(v, m+1, 1)                     /*obtain a single character of string V*/
        if p\==0  &  _\==substr($, p+1, 1)  then $= insert(_, $, p)
        end   /*m*/                              /* [↑]  insert _ in $ after position P.*/
      end     /*n*/
say
say 'shortest common supersequence='  $          /*stick a fork in it,  we're all done. */


// [dependencies]
// svg = "0.8.0"

const SQRT3_2: f64 = 0.86602540378444;

fn sierpinski_triangle(
    mut document: svg::Document,
    mut x: f64,
    mut y: f64,
    mut side: f64,
    order: usize,
) -> svg::Document {
    use svg::node::element::Polygon;

    if order == 1 {
        let mut points = Vec::new();
        points.push((x, y));
        y += side * SQRT3_2;
        x -= side * 0.5;
        points.push((x, y));
        x += side;
        points.push((x, y));
        let polygon = Polygon::new()
            .set("fill", "black")
            .set("stroke", "none")
            .set("points", points);
        document = document.add(polygon);
    } else {
        side *= 0.5;
        document = sierpinski_triangle(document, x, y, side, order - 1);
        y += side * SQRT3_2;
        x -= side * 0.5;
        document = sierpinski_triangle(document, x, y, side, order - 1);
        x += side;
        document = sierpinski_triangle(document, x, y, side, order - 1);
    }
    document
}

fn write_sierpinski_triangle(file: &str, size: usize, order: usize) -> std::io::Result<()> {
    use svg::node::element::Rectangle;

    let margin = 20.0;
    let side = (size as f64) - 2.0 * margin;
    let y = 0.5 * ((size as f64) - SQRT3_2 * side);
    let x = margin + side * 0.5;

    let rect = Rectangle::new()
        .set("width", "100%")
        .set("height", "100%")
        .set("fill", "white");

    let mut document = svg::Document::new()
        .set("width", size)
        .set("height", size)
        .add(rect);

    document = sierpinski_triangle(document, x, y, side, order);
    svg::save(file, &document)
}

fn main() {
    write_sierpinski_triangle("sierpinski_triangle.svg", 600, 8).unwrap();
}


$ include "seed7_05.s7i";
  include "draw.s7i";
  include "keybd.s7i";
  include "bin64.s7i";

const proc: main is func
  local
    const integer: order is 8;
    const integer: width is 1 << order;
    const integer: margin is 10;
    var integer: x is 0;
    var integer: y is 0;
  begin
    screen(width + 2 * margin, width + 2 * margin);
    clear(curr_win, white);
    KEYBOARD := GRAPH_KEYBOARD;
    for y range 0 to pred(width) do
      for x range 0 to pred(width) do
        if bin64(x) & bin64(y) = bin64(0) then
          point(margin + x, margin + y, black);
        end if;
      end for;
    end for;
    ignore(getc(KEYBOARD));
  end func;


func sierpinski_triangle(n) -> Array {
  var triangle = ['*']
  { |i|
    var sp = (' ' * 2**i)
    triangle = (triangle.map {|x| sp + x + sp} +
                triangle.map {|x| x + ' ' + x})
  } * n
  triangle
}

class Array {
  method to_png(scale=1, bgcolor='white', fgcolor='black') {

    static gd = require('GD::Simple')
    var width = self.max_by{.len}.len
    self.map!{|r| "%-#{width}s" % r}

    var img = gd.new(width * scale, self.len * scale)

    for i in ^self {
      for j in RangeNum(i*scale, i*scale + scale) {
        img.moveTo(0, j)
        for line in (self[i].scan(/(\s+|\S+)/)) {
          img.fgcolor(line.contains(/\S/) ? fgcolor : bgcolor)
          img.line(scale * line.len)
        }
      }
    }
    img.png
  }
}

var triangle = sierpinski_triangle(8)
var raw_png = triangle.to_png(bgcolor:'black', fgcolor:'red')
File('triangle.png').write(raw_png, :raw)


# Project : Shortest common supersequence

str1 = "a b c b d a b"
str2 = "bdcaba"
str3 = str2list(substr(str1, " ", nl))
for n = 1 to len(str3)
     for m = n to len(str2)-1
          pos = find(str3, str2[m])
          if pos > 0 and str2[m+1] != str3[pos+1]
             insert(str3, pos, str2[m+1])
          ok
     next
next
showarray(str3)

func showarray(vect)
       svect = ""
       for n = 1 to len(vect)
             svect = svect + vect[n]
       next
       see svect


require 'lcs'

def scs(u, v)
  lcs = lcs(u, v)
  u, v = u.dup, v.dup
  scs = ""
  # Iterate over the characters until LCS processed
  until lcs.empty?
    if u[0]==lcs[0] and v[0]==lcs[0]
      # Part of the LCS, so consume from all strings
      scs << lcs.slice!(0)
      u.slice!(0)
      v.slice!(0)
    elsif u[0]==lcs[0]
      # char of u = char of LCS, but char of LCS v doesn't so consume just that
      scs << v.slice!(0)
    else
      # char of u != char of LCS, so consume just that
      scs << u.slice!(0)
    end
  end
  # append remaining characters, which are not in common
  scs + u + v
end

u = "abcbdab"
v = "bdcaba"
puts "SCS(#{u}, #{v}) = #{scs(u, v)}"


func scs(u, v) {
    var ls = lcs(u, v).chars
    var pat = Regex('(.*)'+ls.join('(.*)')+'(.*)')
    u.scan!(pat)
    v.scan!(pat)
    var ss = (u.shift + v.shift)
    ls.each { |c| ss += (c + u.shift + v.shift) }
    return ss
}

say scs("abcbdab", "bdcaba")


proc scs {u v} {
    set lcs [lcs $u $v]
    set scs ""

    # Iterate over the characters until LCS processed
    for {set ui [set vi [set li 0]]} {$li<[string length $lcs]} {} {
	set uc [string index $u $ui]
	set vc [string index $v $vi]
	set lc [string index $lcs $li]
	if {$uc eq $lc} {
	    if {$vc eq $lc} {
		# Part of the LCS, so consume from all strings
		append scs $lc
		incr ui
		incr li
	    } else {
		# char of u = char of LCS, but char of LCS v doesn't so consume just that
		append scs $vc
	    }
	    incr vi
	} else {
	    # char of u != char of LCS, so consume just that
	    append scs $uc
	    incr ui
	}
    }

    # append remaining characters, which are not in common
    append scs [string range $u $ui end] [string range $v $vi end]
    return $scs
}


package require Tcl 8.5
package require Tk

proc mean args {expr {[::tcl::mathop::+ {*}$args] / [llength $args]}}
proc sierpinski {canv coords order} {
    $canv create poly $coords -fill black -outline {}
    set queue [list [list {*}$coords $order]]
    while {[llength $queue]} {
	lassign [lindex $queue 0] x1 y1 x2 y2 x3 y3 order
	set queue [lrange $queue 1 end]
	if {[incr order -1] < 0} continue
	set x12 [mean $x1 $x2]; set y12 [mean $y1 $y2]
	set x23 [mean $x2 $x3]; set y23 [mean $y2 $y3]
	set x31 [mean $x3 $x1]; set y31 [mean $y3 $y1]
	$canv create poly $x12 $y12 $x23 $y23 $x31 $y31 -fill white -outline {}
	update idletasks;	# So we can see progress
	lappend queue [list $x1 $y1 $x12 $y12 $x31 $y31 $order] \
	    [list $x12 $y12 $x2 $y2 $x23 $y23 $order] \
	    [list $x31 $y31 $x23 $y23 $x3 $y3 $order]
    }
}

pack [canvas .c -width 400 -height 400 -background white]
update;				# So we can see progress
sierpinski .c {200 10 390 390 10 390} 7


import "graphics" for Canvas, Color
import "dome" for Window

class Game {
    static init() {
        Window.title = "Sierpinski Triangle"
        var size = 800
        Window.resize(size, size)
        Canvas.resize(size, size)
        Canvas.cls(Color.white)
        var level = 8
        sierpinskiTriangle(level, 20, 20, size - 40)
    }

    static update() {}

    static draw(alpha) {}

    static sierpinskiTriangle(level, x, y, size) {
        if (level > 0) {
            var col = Color.black
            Canvas.line(x, y, x + size, y, col)
            Canvas.line(x, y, x, y + size, col)
            Canvas.line(x + size, y, x, y + size, col)
            var size2 = (size/2).floor
            sierpinskiTriangle(level - 1, x, y, size2)
            sierpinskiTriangle(level - 1, x + size/2, y, size2)
            sierpinskiTriangle(level - 1, x, y + size/2, size2)
        }
    }
}


var lcs // recursive
lcs = Fn.new { |x, y|
    if (x.count == 0 || y.count == 0) return ""
    var x1 = x[0...-1]
    var y1 = y[0...-1]
    if (x[-1] == y[-1]) return lcs.call(x1, y1) + x[-1]
    var x2 = lcs.call(x, y1)
    var y2 = lcs.call(x1, y)
    return (x2.count > y2.count) ? x2 : y2
}

var scs = Fn.new { |u, v|
    var lcs = lcs.call(u, v)
    var ui = 0
    var vi = 0
    var sb = ""
    for (i in 0...lcs.count) {
        while (ui < u.count && u[ui] != lcs[i]) {
            sb = sb + u[ui]
            ui = ui + 1
        }
        while (vi < v.count && v[vi] != lcs[i]) {
            sb = sb + v[vi]
            vi = vi + 1
        }
        sb = sb + lcs[i]
        ui = ui + 1
        vi = vi + 1
    }
    if (ui < u.count) sb = sb + u[ui..-1]
    if (vi < v.count) sb = sb + v[vi..-1]
    return sb
}

var u = "abcbdab"
var v = "bdcaba"
System.print(scs.call(u, v))


class Link{ var len,letter,next;
   fcn init(l=0,c="",lnk=Void){ len,letter,next=l,c,lnk; }
}
fcn scs(x,y,out){
   lx,ly:=x.len(),y.len();
   lnk:=(ly+1).pump(List,'wrap(_){ (lx+1).pump(List(),Link.create) });

   foreach i in (ly){ lnk[i][lx]=Link(ly-i, y[i]) }
   foreach j in (lx){ lnk[ly][j]=Link(lx-j, x[j]) }

   foreach i,j in ([ly-1..0,-1],[lx-1..0,-1]){
      lp:=lnk[i][j];
      if (y[i]==x[j]){
	 lp.next  =lnk[i+1][j+1];
	 lp.letter=x[j];
      }else if(lnk[i][j+1].len < lnk[i+1][j].len){
	 lp.next  =lnk[i][j+1];
	 lp.letter=x[j];
      }else{
	 lp.next  =lnk[i+1][j];
	 lp.letter=y[i];
      }
      lp.len=lp.next.len + 1;
   }

   lp:=lnk[0][0]; while(lp){ out.write(lp.letter); lp=lp.next; }
   out.close()
}


include c:\cxpl\codes;          \intrinsic 'code' declarations
def Order=7, Size=1<<Order;
int X, Y;
[SetVid($13);                   \set 320x200 graphics video mode
for Y:= 0 to Size-1 do
    for X:= 0 to Size-1 do
        if (X&Y)=0 then Point(X, Y, 4\red\);
X:= ChIn(1);                    \wait for keystroke
SetVid(3);                      \restore normal text display
]


const Order=8, Size=(1).shiftLeft(Order);
img:=PPM(300,300);
foreach y,x in (Size,Size){ if(x.bitAnd(y)==0) img[x,y]=0xff0000 }
img.write(File("sierpinskiTriangle.ppm","wb"));


F sierpinski(n)
   V d = [String(‘*’)]
   L(i) 0 .< n
      V sp = ‘ ’ * (2 ^ i)
      d = d.map(x -> @sp‘’x‘’@sp) [+] d.map(x -> x‘ ’x)
   R d

print(sierpinski(4).join("\n"))


argmt:	equ	5Dh	; Command line argument
puts:	equ	9	; CP/M syscall to print a string
putch:	equ	2	; CP/M syscall to print a character
	org	100h
	mvi	b,4	; Default order is 4
	mvi	e,' '	; Keep space in E since we're saving it anyway
	lda	argmt	; Argument given?
	cmp	e	; If not, use default
	jz	start
	sui	'0'	; Make sure given N makes sense
	cpi	3	; <3?
	jc	start
	cpi	8	; >=8?
	jnc	start
	mov	b,a
start:	mvi	a,1	; Find size (2 ** order)
shift:	rlc
	dcr	b
	jnz	shift
	mov	b,a	; B = size
	mov	c,a	; C = current line
line:	mov	d,c	; D = column
indent:	mov	a,e	; Indent line
	call	chout
	dcr	d
	jnz	indent
column:	mov	a,c	; line + col <= size?
	add	d
	dcr	a
	cmp	b
	jnc 	cdone
	mov	a,c	; (line - 1) & col == 0?
	dcr	a
	ana	d
	mov	a,e	; space if not, star if so
	jnz	print
	mvi	a,'*'
print:	call	chout
	mov	a,e
	call	chout
	inr	d
	jmp	column
cdone:	push	b	; done, print newline
	push 	d
	lxi	d,nl
	mvi	c,puts
	call	5
	pop	d
	pop	b
	dcr	c	; next line
	jnz	line
	ret
chout:	push	b	; save BC and DE
	push	d
	mov	e,a	; print character
	mvi	c,putch
	call	5
	pop	d	; restore BC and DE
	pop	b
	ret
nl:	db	13,10,'$'


putch:	equ	2		; MS-DOS syscall to print character
puts:	equ	9 		; MS-DOS syscall to print string
argmt:	equ	5Dh		; MS-DOS still has FCB in same place as CP/M
	cpu	8086
	org	100h
section	.text
	mov	cx,4		; Default order is 4
	mov	al,[argmt]
	sub	al,'3'		; Argument is there and makes sense? (3 - 7)
	cmp	al,7-3
	ja	start		; If not, use default
	add	al,3		; If so, use it
	mov	cl,al
start:	mov	bl,1		; Let BL be the size (2 ** order)
	shl	bl,cl
	mov	bh,bl		; Let BH be the current line
line:	mov	cl,bh		; Let CL be the column
	mov	dl,' '		; Indent line with spaces
	mov	ah,putch
indent:	int	21h
	loop	indent
column:	mov	al,cl		; line + column <= size?
	add	al,bh
	cmp	al,bl
	ja	.done		; then column is done
	mov	al,bh		; (line - 1) & column == 0?
	dec	al
	test	al,cl
	jnz	.print		; space if not, star if so
	mov	dl,'*'
.print:	int	21h
	mov	dl,' '
	int	21h
	inc	cx		; next column
	jmp	column
.done:	mov	dx,nl		; done, print newline
	mov	ah,puts
	int	21h
	dec	bh		; next line
	jnz	line
	ret
nl:	db	13,10,'$'


(defun pascal-row (prev)
   (if (endp (rest prev))
       (list 1)
       (cons (+ (first prev) (second prev))
             (pascal-row (rest prev)))))

(defun pascal-triangle-r (rows prev)
   (if (zp rows)
       nil
       (let ((curr (cons 1 (pascal-row prev))))
          (cons curr (pascal-triangle-r (1- rows) curr)))))

(defun pascal-triangle (rows)
   (cons (list 1)
         (pascal-triangle-r rows (list 1))))

(defun print-odds-row (row)
   (if (endp row)
       (cw "~%")
       (prog2$ (cw (if (oddp (first row)) "[]" "  "))
               (print-odds-row (rest row)))))

(defun print-spaces (n)
   (if (zp n)
       nil
       (prog2$ (cw " ")
               (print-spaces (1- n)))))

(defun print-odds (triangle height)
   (if (endp triangle)
       nil
       (progn$ (print-spaces height)
               (print-odds-row (first triangle))
               (print-odds (rest triangle) (1- height)))))

(defun print-sierpenski (levels)
   (let ((height (1- (expt 2 levels))))
      (print-odds (pascal-triangle height)
                  height)))


PROC Main()
  BYTE x,y,size=[16]

  Graphics(0)
  PutE() PutE()

  y=size-1
  DO
    FOR x=1 TO y+2
    DO Put(' ) OD

    FOR x=0 TO size-y-1
    DO
      IF (x&y)=0 THEN
        Print("* ")
      ELSE
        Print("  ")
      FI
    OD
    PutE()

    IF y=0 THEN
      EXIT
    FI
    y==-1
  OD


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;


PROC sierpinski = (INT n)[]STRING: (
    FLEX[0]STRING d := "*";
    FOR i TO n DO
        [UPB d * 2]STRING next;
        STRING sp := " " * (2 ** (i-1));
        FOR x TO UPB d DO
          STRING dx = d[x];
          next[x] := sp+dx+sp;
          next[UPB d+x] := dx+" "+dx
        OD;
        d := next
    OD;
    d
);

printf(($gl$,sierpinski(4)))


begin
    integer SIZE;
    SIZE := 16;
    for y := SIZE - 1 step - 1 until 0 do begin
        integer x;
        for i := 0 until y - 1 do writeon( " " );
        x := 0;
        while x + y < SIZE do begin
            writeon( if number( bitstring( x ) and bitstring( y ) ) not = 0 then "  " else "* " );
            x := x + 1
        end while_x_plus_y_lt_SIZE ;
        write();
    end for_y
end.


------------------- SIERPINKSI TRIANGLE ------------------

-- sierpinski :: Int -> [String]
on sierpinski(n)
    if n > 0 then
        set previous to sierpinski(n - 1)
        set padding to replicate(2 ^ (n - 1), space)

        script alignedCentre
            on |λ|(s)
                concat(padding & s & padding)
            end |λ|
        end script

        script adjacentDuplicates
            on |λ|(s)
                unwords(replicate(2, s))
            end |λ|
        end script

        -- Previous triangle block centered,
        -- and placed on 2 adjacent duplicates.
        map(alignedCentre, previous) & map(adjacentDuplicates, previous)
    else
        {"*"}
    end if
end sierpinski

--------------------------- TEST -------------------------
on run
    unlines(sierpinski(4))
end run

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

-- concat :: [[a]] -> [a] | [String] -> String
on concat(xs)
    if length of xs > 0 and class of (item 1 of xs) is string then
        set acc to ""
    else
        set acc to {}
    end if
    repeat with i from 1 to length of xs
        set acc to acc & item i of xs
    end repeat
    acc
end concat

-- 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

-- 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

-- 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 |λ| : f
        end script
    end if
end mReturn

-- 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

-- unlines, unwords :: [String] -> String
on unlines(xs)
    intercalate(linefeed, xs)
end unlines

on unwords(xs)
    intercalate(space, xs)
end unwords


sierpinski: function [order][
    s: shl 1 order
    loop (s-1)..0 'y [
        do.times: y -> prints " "
        loop 0..dec s-y 'x [
            if? zero? and x y -> prints "* "
            else -> prints "  "
        ]
        print ""
    ]
]

sierpinski 4


(* ****** ****** *)
//
// How to compile:
//
// patscc -DATS_MEMALLOC_LIBC -o sierpinski sierpinski.dats
//
(* ****** ****** *)
//
#include
"share/atspre_staload.hats"
//
(* ****** ****** *)

#define SIZE 16

implement
main0 () =
{
//
var x: int
//
val () =
for (x := SIZE-1; x >= 0; x := x-1)
{
  var i: int
  val () =
  for (i := 0; i < x; i := i+1)
  {
    val () = print_char(' ')
  }
  var y: int
  val () =
  for (y := 0; y + x < SIZE; y := y+1)
  {
    val y = g0int2uint_int_uint(y)
    val x = g0int2uint_int_uint(x)
    val () = print_string(if (x land y) != 0 then "  " else "* ")
  }
  val ((*flushed*)) = print_newline()
}
//
} (* end of [main0] *)


Loop 6
   MsgBox % Triangle(A_Index)

Triangle(n,x=0,y=1) { ; Triangle(n) -> string of dots and spaces of Sierpinski triangle
   Static t, l                                  ; put chars in a static string
   If (x < 1) {                                 ; when called with one parameter
      l := 2*x := 1<<(n-1)                      ; - compute location, string size
      VarSetCapacity(t,l*x,32)                  ; - allocate memory filled with spaces
      Loop %x%
         NumPut(13,t,A_Index*l-1,"char")        ; - new lines in the end of rows
   }
   If (n = 1)                                   ; at the bottom of recursion
      Return t, NumPut(46,t,x-1+(y-1)*l,"char") ; - write "." (better at proportional fonts)
   u := 1<<(n-2)
   Triangle(n-1,x,y)                            ; draw smaller triangle here
   Triangle(n-1,x-u,y+u)                        ; smaller triangle down-left
   Triangle(n-1,x+u,y+u)                        ; smaller triangle down right
   Return t
}


# WST.AWK - Waclaw Sierpinski's triangle contributed by Dan Nielsen
# syntax: GAWK -f WST.AWK [-v X=anychar] iterations
# example: GAWK -f WST.AWK -v X=* 2
BEGIN {
    n = ARGV[1] + 0 # iterations
    if (n !~ /^[0-9]+$/) { exit(1) }
    if (n == 0) { width = 3 }
    row = split("X,X X,X   X,X X X X",A,",") # seed the array
    for (i=1; i<=n; i++) { # build triangle
      width = length(A[row])
      for (j=1; j<=row; j++) {
        str = A[j]
        A[j+row] = sprintf("%-*s %-*s",width,str,width,str)
      }
      row *= 2
    }
    for (j=1; j<=row; j++) { # print triangle
      if (X != "") { gsub(/X/,substr(X,1,1),A[j]) }
      sub(/ +$/,"",A[j])
      printf("%*s%s\n",width-j+1,"",A[j])
    }
    exit(0)
}


#!/bin/bash

# Basic principle:
#
#
#  x ->  dxd       d -> dd      s -> s
#        xsx            dd           s
#
# In the end all 'd' and 's' are removed.
# 0x7F800000
function rec(){
  if [ $1 == 0 ]
  then
    echo "x"
  else
    rec $[ $1 - 1 ] | while read line ; do
      echo "$line" | sed "s/d/dd/g" | sed "s/x/dxd/g"
      echo "$line" | sed "s/d/dd/g" | sed "s/x/xsx/g"
    done
  fi
}

rec $1 | tr 'dsx' '  *'


DECLARE SUB triangle (x AS INTEGER, y AS INTEGER, length AS INTEGER, n AS INTEGER)

CLS
triangle 1, 1, 16, 5

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


get "libhdr"

manifest $( SIZE = 1 << 4 $)

let start() be
$(  for y = SIZE-1 to 0 by -1 do
    $(  for i=1 to y do wrch(' ')
        for x=0 to SIZE-y-1 do
            writes((x & y) ~= 0 -> "  ", "** ")
        wrch('*N')
    $)
$)


Sierp ← {" •" ⊏˜ (⌽↕2⋆𝕩)⌽˘∾˘∾⟜0¨∧´∘∨⌜˜⥊↕2⥊˜𝕩}


#include <stdio.h>

#define SIZE (1 << 4)
int main()
{
	int x, y, i;
	for (y = SIZE - 1; y >= 0; y--, putchar('\n')) {
		for (i = 0; i < y; i++) putchar(' ');
		for (x = 0; x + y < SIZE; x++)
			printf((x & y) ? "  " : "* ");
	}
	return 0;
}


using System;
using System.Collections;

namespace RosettaCode {
    class SierpinskiTriangle {
        int len;
        BitArray b;

        public SierpinskiTriangle(int n) {
            if (n < 1) {
                throw new ArgumentOutOfRangeException("Order must be greater than zero");
            }
            len = 1 << (n+1);
            b = new BitArray(len+1, false);
            b[len>>1] = true;
        }

        public void Display() {
            for (int j = 0; j < len / 2; j++) {
                for (int i = 0; i < b.Count; i++) {
                    Console.Write("{0}", b[i] ? "*" : " ");
                }
                Console.WriteLine();
                NextGen();
            }
        }

        private void NextGen() {
            BitArray next = new BitArray(b.Count, false);
            for (int i = 0; i < b.Count; i++) {
                if (b[i]) {
                    next[i - 1] = next[i - 1] ^ true;
                    next[i + 1] = next[i + 1] ^ true;
                }
            }
            b = next;
        }
    }
}


#include <iostream>
#include <string>
#include <list>
#include <algorithm>
#include <iterator>

using namespace std;

template<typename OutIt>
void sierpinski(int n, OutIt result)
{
    if( n == 0 )
    {
        *result++ = "*";
    }
    else
    {
        list<string> prev;
        sierpinski(n-1, back_inserter(prev));

        string sp(1 << (n-1), ' ');
        result = transform(prev.begin(), prev.end(),
            result,
            [sp](const string& x) { return sp + x + sp; });
        transform(prev.begin(), prev.end(),
            result,
            [sp](const string& x) { return x + " " + x; });
    }
}

int main()
{
    sierpinski(4, ostream_iterator<string>(cout, "\n"));
    return 0;
}


(ns example
  (:require [clojure.contrib.math :as math]))

; Length of integer in binary
; (copied from a private multimethod in clojure.contrib.math)
(defmulti #^{:private true} integer-length class)

(defmethod integer-length java.lang.Integer [n]
  (count (Integer/toBinaryString n)))
(defmethod integer-length java.lang.Long [n]
  (count (Long/toBinaryString n)))
(defmethod integer-length java.math.BigInteger [n]
  (count (.toString n 2)))

(defn sierpinski-triangle [order]
  (loop [size (math/expt 2 order)
         v    (math/expt 2 (- size 1))]
    (when (pos? size)
      (println
       (apply str (map #(if (bit-test v %) "*" " ")
		       (range (integer-length v)))))
      (recur
       (dec size)
       (bit-xor (bit-shift-left v 1) (bit-shift-right v 1))))))

(sierpinski-triangle 4)


sierpinski = proc (size: int) returns (string)
    ss: stream := stream$create_output()

    for i: int in int$from_to(0, size*4-1) do
        c: int := 1
        for j: int in int$from_to(1, size*4-1-i) do
            stream$putc(ss, ' ')
        end
        for k: int in int$from_to(0, i) do
            if c//2=0 then
                stream$puts(ss, "  ")
            else
                stream$puts(ss, " *")
            end
            c := c*(i-k)/(k+1)
        end
        stream$putc(ss, '\n')
    end
    return(stream$get_contents(ss))
end sierpinski

start_up = proc ()
    stream$puts(
        stream$primary_output(),
        sierpinski(4)
    )
end start_up


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).


0010 DIM part$(FALSE:TRUE) OF 2
0020 part$(FALSE):="  ";part$(TRUE):="* "
0030 INPUT "Order? ":order#
0040 size#:=2^order#
0050 FOR y#:=size#-1 TO 0 STEP -1 DO
0060   PRINT " "*y#,
0070   FOR x#:=0 TO size#-y#-1 DO PRINT part$(x# BITAND y#=0),
0080   PRINT
0090 ENDFOR y#
0100 END


(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) "*" " ")))))


include "cowgol.coh";
include "argv.coh";

var order: uint8 := 4; # default order

# Read order from command line if there is an argument
ArgvInit();
var argmt := ArgvNext();
if argmt != 0 as [uint8] then
    var a: int32;
    (a, argmt) := AToI(argmt);
    if a<3 or 7<a then
        print("Order must be between 3 and 7.");
        print_nl();
        ExitWithError();
    end if;
    order := a as uint8;
end if;

var one: uint8 := 1; # shift argument can't be constant...
var size: uint8 := one << order;

var y: uint8 := size;
while y > 0 loop
    var x: uint8 := 0;
    while x < y-1 loop
        print_char(' ');
        x := x + 1;
    end loop;
    x := 0;
    while x + y <= size loop
        if x & (y-1) != 0 then
            print("  ");
        else
            print("* ");
        end if;
        x := x + 1;
    end loop;
    print_nl();
    y := y - 1;
end loop;


void main() /*@safe*/ {
    import std.stdio, std.algorithm, std.string, std.array;

    enum level = 4;
    auto d = ["*"];
    foreach (immutable n; 0 .. level) {
        immutable sp = " ".replicate(2 ^^ n);
        d = d.map!(a => sp ~ a ~ sp).array ~
            d.map!(a => a ~ " " ~ a).array;
    }
    d.join('\n').writeln;
}


program SierpinskiTriangle;

{$APPTYPE CONSOLE}

procedure PrintSierpinski(order: Integer);
var
  x, y, size: Integer;
begin
  size := (1 shl order) - 1;
  for y := size downto 0 do
  begin
    Write(StringOfChar(' ', y));
    for x := 0 to size - y do
    begin
      if (x and y) = 0 then
        Write('* ')
      else
        Write('  ');
    end;
    Writeln;
  end;
end;

begin
  PrintSierpinski(4);
end.


word SIZE = 1 << 4;

proc nonrec main() void:
    unsigned SIZE x, y;
    for y from SIZE-1 downto 0 do
        for x from 1 upto y do write(' ') od;
        for x from 0 upto SIZE - y - 1 do
            write(if x & y ~= 0 then "  " else "* " fi)
        od;
        writeln()
    od
corp


procedure PrintSierpinski(order : Integer);
var
   x, y, size : Integer;
begin
   size := (1 shl order)-1;
   for y:=size downto 0 do begin
      Print(StringOfChar(' ', y));
      for x:=0 to size-y do begin
         if (x and y)=0 then
            Print('* ')
         else Print('  ');
      end;
      PrintLn('');
   end;
end;

PrintSierpinski(4);


def printSierpinski(order, out) {
    def size := 2**order
    for y in (0..!size).descending() {
        out.print(" " * y)
        for x in 0..!(size-y) {
            out.print((x & y).isZero().pick("* ", "  "))
        }
        out.println()
    }
}


defmodule RC do
  def sierpinski_triangle(n) do
    f = fn(x) -> IO.puts "#{x}" end
    Enum.each(triangle(n, ["*"], " "), f)
  end

  defp triangle(0, down, _), do: down
  defp triangle(n, down, sp) do
    newDown = (for x <- down, do: sp<>x<>sp) ++ (for x <- down, do: x<>" "<>x)
    triangle(n-1, newDown, sp<>sp)
  end
end

RC.sierpinski_triangle(4)


import String exposing (..)
import Html exposing (..)
import Html.Attributes as A exposing (..)
import Html.Events exposing (..)
import Html.App exposing (beginnerProgram)
import Result exposing (..)

sierpinski : Int -> List String
sierpinski n =
  let down n = sierpinski (n - 1)
      space n = repeat (2 ^ (n - 1)) " "
  in case n of
       0 -> ["*"]
       _ ->    List.map ((\st -> space n ++ st) << (\st -> st ++ space n)) (down n)
            ++ List.map (join " " << List.repeat 2) (down n)

main = beginnerProgram { model = "4", view = view, update = update }

update newStr oldStr = newStr

view : String -> Html String
view levelString =
  div []
    ([ Html.form
          []
          [ label [ myStyle ] [ text "Level: "]
          , input
            [ placeholder "triangle level."
            , value levelString
            , on "input" targetValue
            , type' "number"
            , A.min "0"
            , myStyle
            ]
            []
          ]
     ] ++
     [ pre [] (levelString
               |> toInt
               |> withDefault 0
               |> sierpinski
               |> List.map (\s -> div [] [text s]))
     ])

myStyle : Attribute msg
myStyle =
  style
    [ ("height", "20px")
    , ("padding", "5px 0 0 5px")
    , ("font-size", "1em")
    , ("text-align", "left")
    ]


-module(sierpinski).
-export([triangle/1]).

triangle(N) ->
    F = fun(X) -> io:format("~s~n",[X]) end,
    lists:foreach(F, triangle(N, ["*"], " ")).

triangle(0, Down, _) -> Down;
triangle(N, Down, Sp) ->
    NewDown = [Sp++X++Sp || X<-Down]++[X++" "++X || X <- Down],
    triangle(N-1, NewDown, Sp++Sp).


procedure triangle(integer x, integer y, integer len, integer n)
    if n = 0 then
        position(y,x) puts(1,'*')
    else
        triangle (x,       y+len, floor(len/2), n-1)
        triangle (x+len,   y,     floor(len/2), n-1)
        triangle (x+len*2, y+len, floor(len/2), n-1)
    end if
end procedure

clear_screen()
triangle(1,1,8,4)


sierpinskiTriangle
=LAMBDA(c,
    LAMBDA(n,
        IF(0 = n,
            c,
            LET(
                prev, sierpinskiTriangle(c)(n - 1),

                APPENDROWS(
                    sierpCentered(prev)
                )(
                    sierpDoubled(prev)
                )
            )
        )
    )
)

sierpCentered
=LAMBDA(grid,
    LET(
        nRows, ROWS(grid),
        padding, IF(
            SEQUENCE(nRows, nRows, 1, 1),
            " "
        ),

        APPENDCOLS(
            APPENDCOLS(padding)(grid)
        )(padding)
    )
)

sierpDoubled
=LAMBDA(grid,
    APPENDCOLS(
        APPENDCOLS(grid)(
            IF(SEQUENCE(ROWS(grid), 1, 1, 1),
                " "
            )
        )
    )(grid)
)


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 (fun (i:string) -> System.Console.WriteLine(i)) (sierpinski 4)


USING: io kernel math sequences ;
IN: sierpinski

: iterate-triangle ( triange spaces -- triangle' )
    [ [ dup surround ] curry map ]
    [ drop [ dup " " glue ] map ] 2bi append ;

: (sierpinski) ( triangle spaces n -- triangle' )
    dup 0 = [ 2drop "\n" join ] [
        [
            [ iterate-triangle ]
            [ nip dup append ] 2bi
        ] dip 1 - (sierpinski)
    ] if ;

: sierpinski ( n -- )
    [ { "*" } " " ] dip (sierpinski) print ;


: 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


program Sierpinski_triangle
  implicit none

  call Triangle(4)

contains

subroutine Triangle(n)
  implicit none
  integer, parameter :: i64 = selected_int_kind(18)
  integer, intent(in) :: n
  integer :: i, k
  integer(i64) :: c

  do i = 0, n*4-1
    c = 1
    write(*, "(a)", advance="no") repeat(" ", 2 * (n*4 - 1 - i))
    do k = 0, i
      if(mod(c, 2) == 0) then
        write(*, "(a)", advance="no") "    "
      else
        write(*, "(a)", advance="no") "  * "
      end if
      c = c * (i - k) / (k + 1)
    end do
    write(*,*)
  end do
end subroutine Triangle
end program Sierpinski_triangle


# Using parity of binomial coefficients
SierpinskiTriangle := function(n)
	local i, j, s, b;
	n := 2^n - 1;
	b := " ";
	while Size(b) < n do
		b := Concatenation(b, b);
	od;
	for i in [0 .. n] do
		s := "";
		for j in [0 .. i] do
			if IsEvenInt(Binomial(i, j)) then
				Append(s, "  ");
			else
				Append(s, "* ");
			fi;
		od;
		Print(b{[1 .. n - i]}, s, "\n");
	od;
end;

SierpinskiTriangle(4);
               *
              * *
             *   *
            * * * *
           *       *
          * *     * *
         *   *   *   *
        * * * * * * * *
       *               *
      * *             * *
     *   *           *   *
    * * * *         * * * *
   *       *       *       *
  * *     * *     * *     * *
 *   *   *   *   *   *   *   *
* * * * * * * * * * * * * * * *


# Return a string space or star to print at x,y.
# Must have x<y.  x<0 is the left side of the triangle.
# If x<-y then it's before the left edge and the return is a space.
char(x,y) = (y+x>=0 && ((y+x)%2)==0 && ((y+x)&(y-x))==0 ? "*" : " ")

# Return a string which is row y of the triangle from character
# position x through to the right hand end x==y, inclusive.
row(x,y) = (x<=y ? char(x,y).row(x+1,y) : "\n")

# Return a string of stars, spaces and newlines which is the
# Sierpinski triangle from row y to limit, inclusive.
# The first row is y=0.
triangle(y,limit) = (y <= limit ? row(-limit,y).triangle(y+1,limit) : "")

# Print rows 0 to 15, which is the order 4 triangle per the task.
print triangle(0,15)


package main

import (
    "fmt"
    "strings"
    "unicode/utf8"
)

var order = 4
var grain = "*"

func main() {
    t := []string{grain + strings.Repeat(" ", utf8.RuneCountInString(grain))}
    for ; order > 0; order-- {
        sp := strings.Repeat(" ", utf8.RuneCountInString(t[0])/2)
        top := make([]string, len(t))
        for i, s := range t {
            top[i] = sp + s + sp
            t[i] += s
        }
        t = append(top, t...)
    }
    for _, r := range t {
        fmt.Println(r)
    }
}


def stPoints;
stPoints = { order, base=[0,0] ->
    def right = [base[0], base[1]+2**order]
    def up = [base[0]+2**(order-1), base[1]+2**(order-1)]
    (order == 0) \
        ? [base]
        : (stPoints(order-1, base) + stPoints(order-1, right) + stPoints(order-1, up))
}

def stGrid = { order ->
    def h = 2**order
    def w = 2**(order+1) - 1
    def grid = (0..<h).collect { (0..<w).collect { ' ' } }
    stPoints(order).each { grid[it[0]][it[1]] = (order%10).toString() }
    grid
}


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

main = mapM_ putStrLn $ sierpinski 4


class Main
{
	static function main()
	{
		triangle(3);
	}

	static inline var SPACE = ' ';
	static inline var STAR = '*';

	static function triangle(o) {
		var n = 1 << o;
		var line = new Array<String>();

		for (i in 0...(n*2)) line[i] = SPACE;

		line[n] = '*';

		for (i in 0...n) {
			Sys.println(line.join(''));
			var u ='*';
			var start = n - i;
			var end = n + i + 1;
			var t = SPACE;
			for (j in start...end) {
				t = (line[j-1] == line[j+1] ? SPACE : STAR);
				line[j-1] = u;
				u = t;
			}

			line[n+i] = t;
			line[n+i+1] = STAR;
		}
	}
}


|=  [email protected]
=+  m=0
=+  o=(reap 1 '*')
|^  ?:  =(m n)  o
    $(m +(m), o (weld top bot))
++  gap  (fil 3 (pow 2 m) ' ')
++  top  (turn o |=([email protected] (rap 3 gap l gap ~)))
++  bot  (turn o |=([email protected] (rap 3 l ' ' l ~)))
--


# text based adaptaion of

procedure main(A)

   width := 2 ^ ( 1 + (order := 0 < integer(\A[1]) | 4))  # order of arg[1] or 4
   write("Triangle order= ",order)

   every !(canvas := list(width)) := list(width," ")      # prime the canvas
   every y := 1 to width & x := 1 to width do             # traverse it
      if iand(x - 1, y - 1) = 0 then canvas[x,y] := "*"   # fill

   every x := 1 to width & y := 1 to width do
      writes((y=1,"\n")|"",canvas[x,y]," ")               # print

end


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


public class SierpinskiTriangle {

    public static void main(String[] args) {
        System.out.println(getSierpinskiTriangle(4));
    }

    private static final String getSierpinskiTriangle(int n) {
        if ( n == 0 ) {
            return "*";
        }

        String s = getSierpinskiTriangle(n-1);
        String [] split = s.split("\n");
        int length = split.length;

        //  Top triangle
        StringBuilder sb = new StringBuilder();
        String top = buildSpace((int)Math.pow(2, n-1));
        for ( int i = 0 ; i < length ;i++ ) {
            sb.append(top);
            sb.append(split[i]);
            sb.append("\n");
        }

        //  Two triangles side by side
        for ( int i = 0 ; i < length ;i++ ) {
            sb.append(split[i]);
            sb.append(buildSpace(length-i));
            sb.append(split[i]);
            sb.append("\n");
        }
        return sb.toString();
    }

    private static String buildSpace(int n) {
        StringBuilder sb = new StringBuilder();
        while ( n > 0 ) {
            sb.append(" ");
            n--;
        }
        return sb.toString();
    }

}


function sierpinski(n : Integer) {
  var down = ["*"];
  var space = " ";
  for (i in [1..n]) {
    down = [for (x in down) "{space}{x}{space}", for (x in down) "{x} {x}"];
    space = "{space}{space}";
  }

  for (x in down) {
    println("{x}")
  }
}

sierpinski(4);


(function (order) {

    // 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];

                    // 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);

})(4);


def elementwise(f):
  transpose | map(f) ;

# input: an array of decimal numbers
def bitwise_and:
  # Input: an integer
  # Output: a stream of 0s and 1s
  def stream:
    recurse(if . > 0 then ./2|floor else empty end) | . % 2 ;

  # Input: a 0-1 array
  def toi:
    reduce .[] as $c ( {power:1 , ans: 0};
      .ans += ($c * .power) | .power *= 2 )
    | .ans;

  if any(.==0) then 0
  else map([stream])
  | (map(length) | min) as $min
  | map( .[:$min] ) | elementwise(min) | toi
  end;


function sierpinski(n, token::AbstractString="*")
	x = fill(token, 1, 1)
	for _ in 1:n
		h, w = size(x)
		s = fill(" ", h,(w + 1) ÷ 2)
		t = fill(" ", h,1)
		x = [[s x s] ; [x t x]]
	end
	return x
end

function printsierpinski(m::Matrix)
    for r in 1:size(m, 1)
        println(join(m[r, :]))
    end
end

sierpinski(4) |> printsierpinski


// version 1.1.2

const val ORDER = 4
const val SIZE  = 1 shl ORDER

fun main(args: Array<String>) {
    for (y in SIZE - 1 downTo 0) {
        for (i in 0 until y) print(" ")
        for (x in 0 until SIZE - y) print(if ((x and y) != 0) "  " else "* ")
        println()
    }
}


nOrder=4
call triangle 1, 1, nOrder
end

SUB triangle x, y, n
    IF n = 0 THEN
        LOCATE x,y: PRINT "*";
    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


; Print rows of the triangle from 0 to :limit inclusive.
; limit=15 gives the order 4 form per the task.
; The range of :y is arbitrary, any rows of the triangle can be printed.

make "limit 15
for [y 0 :limit] [
  for [x -:limit :y] [
    type ifelse (and :y+:x >= 0                ; blank left of triangle
                     (remainder :y+:x 2) = 0   ; only "even" squares
                     (bitand :y+:x :y-:x) = 0  ; Sierpinski bit test
                ) ["*] ["| |]                  ; star or space
  ]
  print []
]


function sierpinski(depth)
   lines = {}
   lines[1] = '*'

   for i = 2, depth+1 do
      sp = string.rep(' ', 2^(i-2))
      tmp = {}
      for idx, line in ipairs(lines) do
         tmp[idx] = sp .. line .. sp
         tmp[idx+#lines] = line .. ' ' .. line
      end
      lines = tmp
   end
   return table.concat(lines, '\n')
end

print(sierpinski(4))


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:


n = 4;
d = string('*');
for k = 0 : n - 1
  sp = repelem(' ', 2 ^ k);
  d = [sp + d + sp, d + ' ' + d];
end
disp(d.join(char(10)))


/* NetRexx */
options replace format comments java crossref symbols nobinary

numeric digits 1000
runSample(arg)
return

-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
method runSample(arg) public static
  BLACK_UPPOINTING_TRIANGLE = '\u25b2'
  parse arg ordr filr .
  if ordr = '' | ordr = '.' then ordr = 4
  if filr = '' | filr = '.' then filler = BLACK_UPPOINTING_TRIANGLE
  else                           filler = filr
  drawSierpinskiTriangle(ordr, filler)
  return

-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
method drawSierpinskiTriangle(ordr, filler = Rexx '^') public static
  n = 1 * (2 ** ordr)
  line = ' '.copies(2 * n)
  line = line.overlay(filler, n + 1) -- set the top point of the triangle
  loop row = 1 to n -- NetRexx arrays, lists etc. index from 1
    say line.strip('t')
    u = filler
    loop col = 2 + n - row to n + row
      cl = line.substr(col - 1, 1)
      cr = line.substr(col + 1, 1)
      if cl == cr then t = ' '
      else             t = filler
      line = line.overlay(u, col - 1)
      u = t
      end col
      j2 = n + row - 1
      j3 = n + row
      line = line.overlay(t, j2 + 1)
      line = line.overlay(filler, j3 + 1)
    end row
  return


const size = 1 shl 4 - 1

for y in countdown(size, 0):
  for i in 0 .. <y:
    stdout.write " "
  for x in 0 .. size-y:
    if (x and y) != 0:
      stdout.write "  "
    else:
      stdout.write "* "
  stdout.write "\n"


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)


: nextGen(l, r)
| i |
   StringBuffer new
   l size loop: i [
      l at(i 1 -) '*' == 4 *
      l at(i)     '*' == 2 * +
      l at(i 1 +) '*' == +
      2 swap pow r bitAnd ifTrue: [ '*' ] else: [ ' ' ] over addChar
      ] ;

: automat(rule, n)
   StringBuffer new " " <<n(n) "*" over + +
   #[ dup println rule nextGen ] times(n) drop ;

: sierpinskiTriangle(n)
   90 4 n * automat ;


declare
  fun {NextTriangle Triangle}
     Sp = {Spaces {Length Triangle}}
  in
   {Flatten
      [{Map Triangle fun {$ X} Sp#X#Sp end}
       {Map Triangle fun {$ X} X#" "#X end}
      ]}
  end

  fun {Spaces N} if N == 0 then nil else & |{Spaces N-1} end end

  fun lazy {Iterate F X}
     X|{Iterate F {F X}}
  end

  SierpinskiTriangles = {Iterate NextTriangle ["*"]}
in
  {ForAll {Nth SierpinskiTriangles 5} System.showInfo}


Sierpinski(n)={
  my(s=2^n-1);
  forstep(y=s,0,-1,
    for(i=1,y,print1(" "));
    for(x=0,s-y,
      print1(if(bitand(x,y)," ","*"))
    );
    print()
  )
};
Sierpinski(4)


program Sierpinski;

function ipow(b, n	: Integer) : Integer;
var
   i : Integer;
begin
   ipow := 1;
   for i := 1 to n do
      ipow := ipow * b
end;

function truth(a : Char) : Boolean;
begin
   if a = '*' then
      truth := true
   else
      truth := false
end;


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;


procedure sierpinski(integer n)
integer lim = power(2,n)-1
    for y=lim to 0 by -1 do
        puts(1,repeat(' ',y))
        for x=0 to lim-y do
            puts(1,iff(and_bits(x,y)?"  ":"* "))
        end for
        puts(1,"\n")
    end for
end procedure

for i=1 to 5 do
    sierpinski(i)
end for


def sierpinski
    2 swap power 1 - var lim
    lim 0 -1 3 tolist for
        var y
        32 y 1 + repeat print
        0 lim y - 2 tolist for
            y bitand if 32 32 chain else "* " endif print
        endfor
        nl
    endfor
enddef

5 for
    sierpinski
endfor


<?php

function sierpinskiTriangle($order) {
    $char = '#';
    $n = 1 << $order;
    $line = array();
    for ($i = 0 ; $i <= 2 * $n ; $i++) {
        $line[$i] = ' ';
    }
    $line[$n] = $char;
    for ($i = 0 ; $i < $n ; $i++) {
        echo implode('', $line), PHP_EOL;
        $u = $char;
        for ($j = $n - $i ; $j < $n + $i + 1 ; $j++) {
            $t = ($line[$j - 1] == $line[$j + 1] ? ' ' : $char);
            $line[$j - 1] = $u;
            $u = $t;
        }
        $line[$n + $i] = $t;
        $line[$n + $i + 1] = $char;
    }
}

sierpinskiTriangle(4);


go =>
   foreach(N in 1..4)
     sierpinski(N),
     nl
   end,
   nl.

sierpinski(N)  =>
  Size = 2**N,
  foreach(Y in Size-1..-1..0)
    printf("%s", [' ' : _I in 1..Y]),
    foreach(X in 0..Size-Y-1)
      printf("%s ", cond(X /\ Y == 0, "*", " "))
    end,
    nl
  end.


(de sierpinski (N)
   (let (D '("*")  S " ")
      (do N
         (setq
            D (conc
               (mapcar '((X) (pack S X S)) D)
               (mapcar '((X) (pack X " " X)) D) )
            S (pack S S) ) )
      D ) )

(mapc prinl (sierpinski 4))


sierpinski: procedure options (main); /* 2010-03-30 */
   declare t (79,79) char (1);
   declare (i, j, k) fixed binary;
   declare (y, xs, ys, xll, xrr, ixrr, limit) fixed binary;

   t = ' ';
   xs = 40; ys = 1;
   /* Make initial triangle */
   call make_triangle (xs, ys);
   y = ys + 4;
   xll = xs-4; xrr = xs+4;
   do k = 1 to 3;
      limit = 0;
      do forever;
         ixrr = xrr;
         do i = xll to xll+limit by 8;
            if t(y-1, i) = ' ' then
               do;
                  call make_triangle (i, y);
                  if t(y+3,i-5) = '*' then
                     t(y+3,i-4), t(y+3,ixrr+4) = '*';
                  call make_triangle (ixrr, y);
               end;
            ixrr = ixrr - 8;
         end;
         xll = xll - 4; xrr = xrr + 4;
         y = y + 4;
         limit = limit + 8;
         if xll+limit > xs-1 then leave;
      end;
      t(y-1,xs) = '*';
   end;

   /* Finished generation; now print the Sierpinski triangle. */
   put edit (t) (skip, (hbound(t,2)) a);

make_triangle: procedure (x, y);
   declare (x, y) fixed binary;
   declare i fixed binary;

   do i = 0 to 3;
      t(y+i, x-i), t(y+i, x+i) = '*';
   end;
   do i = x-2 to x+2;  /* The base of the triangle. */
      t(y+3, i) = '*';
   end;
end make_triangle;

end sierpinski;


100H:

DECLARE ORDER LITERALLY '4';

/* CP/M BDOS CALL */
BDOS: PROCEDURE (FN, ARG);
    DECLARE FN BYTE, ARG ADDRESS;
    GO TO 5;
END BDOS;

PUT$CHAR: PROCEDURE (CHAR);
    DECLARE CHAR BYTE;
    CALL BDOS(2, CHAR);
END PUT$CHAR;

/* PRINT SIERPINSKI TRIANGLE */
DECLARE (X, Y, SIZE) BYTE;
SIZE = SHL(1, ORDER);

Y = SIZE - 1;
DO WHILE Y <> -1;
    DO X = 0 TO Y;
        CALL PUT$CHAR(' ');
    END;
    DO X = 0 TO SIZE-Y-1;
        IF (X AND Y) = 0
            THEN CALL PUT$CHAR('*');
            ELSE CALL PUT$CHAR(' ');
        CALL PUT$CHAR(' ');
    END;
    Y = Y - 1;
    CALL PUT$CHAR(13);
    CALL PUT$CHAR(10);
END;

CALL BDOS(0,0);
EOF


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);


%!PS-Adobe-3.0
%%BoundingBox 0 0 300 300

/F { 1 0 rlineto } def
/+ { 120 rotate } def
/- {-120 rotate } def
/v {.5 .5 scale } def
/^ { 2  2 scale } def
/!0{ dup 1 sub dup -1 eq not } def

/X { !0 { v X + F - X - F + X ^ } { F } ifelse pop } def

0 1 8 { 300 300 scale 0 1 12 div moveto
        X + F + F fill showpage         } for
%%EOF


void setup() {
  size(410, 230);
  background(255);
  fill(0);
  sTriangle (10, 25, 100, 5);
}

void sTriangle(int x, int y, int l, int n) {
    if( n == 0) text("*", x, y);
    else {
        sTriangle(x, y+l, l/2, n-1);
        sTriangle(x+l, y, l/2, n-1);
        sTriangle(x+l*2, y+l, l/2, n-1);
    }
}


Procedure Triangle (X,Y, Length, N)
   If N = 0
      DrawText( Y,X, "*",#Blue)
   Else
      Triangle (X+Length,          Y, Length/2, N-1)
      Triangle (X,   Y+Length,        Length/2, N-1)
      Triangle (X+Length, Y+Length*2, Length/2, N-1)
   EndIf
EndProcedure

OpenWindow(0, 100, 100,700,500 ,"Sierpinski triangle",  #PB_Window_SystemMenu |1)
StartDrawing(WindowOutput(0))
   DrawingMode(#PB_2DDrawing_Transparent )
   Triangle(10,10,120,5)
StopDrawing()

Repeat
Until WaitWindowEvent()=#PB_Event_CloseWindow
End


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))


  [ [ dup 1 &
      iff char * else space
      emit
      1 >> dup while
      sp again ]
    drop ]                    is stars    (  mask --> )

  [ bit
    1 over times
      [ cr over i^ - times sp
        dup stars
        dup 1 << ^ ]
    2drop ]                   is triangle ( order --> )

  4 triangle


sierpinski.triangle = function(n) {
	len <- 2^(n+1)
	b <- c(rep(FALSE,len/2),TRUE,rep(FALSE,len/2))
	for (i in 1:(len/2))
	{
		cat(paste(ifelse(b,"*"," "),collapse=""),"\n")
		n <- rep(FALSE,len+1)
		n[which(b)-1]<-TRUE
		n[which(b)+1]<-xor(n[which(b)+1],TRUE)
		b <- n
	}
}
sierpinski.triangle(5)


#lang racket
(define (sierpinski n)
  (if (zero? n)
    '("*")
    (let ([spaces (make-string (expt 2 (sub1 n)) #\space)]
          [prev   (sierpinski (sub1 n))])
      (append (map (λ(x) (~a spaces x spaces)) prev)
              (map (λ(x) (~a x " " x)) prev)))))
(for-each displayln (sierpinski 5))


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

.say for sierpinski 4;


/*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. */


# Project : Sierpinski triangle

norder=4
xy = list(40)
for i = 1 to 40
    xy[i] = "                               "
next
triangle(1, 1, norder)
for i = 1 to 36
    see xy[i] + nl
next

func triangle(x, y, n)
     if n = 0
        xy[y] = left(xy[y],x-1) + "*" + substr(xy[y],x+1)
     else
        n=n-1
        length=pow(2,n)
        triangle(x, y+length, n)
        triangle(x+length, y, n)
        triangle(x+length*2, y+length, n)
     ok


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


use std::iter::repeat;

fn sierpinski(order: usize) {
    let mut triangle = vec!["*".to_string()];
    for i in 0..order {
        let space = repeat(' ').take(2_usize.pow(i as u32)).collect::<String>();

        // save original state
        let mut d = triangle.clone();

        // extend existing lines
        d.iter_mut().for_each(|r| {
            let new_row = format!("{}{}{}", space, r, space);
            *r = new_row;
        });

        // add new lines
        triangle.iter().for_each(|r| {
            let new_row = format!("{}{}{}", r, " ", r);
            d.push(new_row);
        });

        triangle = d;
    }

    triangle.iter().for_each(|r| println!("{}", r));
}
fn main() {
    let order = std::env::args()
        .nth(1)
        .unwrap_or_else(|| "4".to_string())
        .parse::<usize>()
        .unwrap();

    sierpinski(order);
}


(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))))))


$ include "seed7_05.s7i";

const func array string: sierpinski (in integer: n) is func
  result
    var array string: parts is 1 times "*";
  local
    var integer: i is 0;
    var string: space is " ";
    var array string: parts2 is 0 times "";
    var string: x is "";
  begin
    for i range 1 to n do
      parts2 := 0 times "";
      for x range parts do
        parts2 &:= [] (space & x & space);
      end for;
      for x range parts do
        parts2 &:= [] (x & " " & x);
      end for;
      parts := parts2;
      space &:= space;
    end for;
  end func;

const proc: main is func
  begin
    writeln(join(sierpinski(4), "\n"));
  end func;


func sierpinski_triangle(n) {
    var triangle = ['*']
    { |i|
        var sp = (' ' * 2**i)
        triangle = (triangle.map {|x| sp + x + sp} +
                    triangle.map {|x| x + ' ' + x})
    } * n
    triangle.join("\n")
}

say sierpinski_triangle(4)


import Foundation

// Easy get/set of charAt
extension String {
    subscript(index:Int) -> String {
        get {
            var array = Array(self)
            var charAtIndex = array[index]
            return String(charAtIndex)
        }

        set(newValue) {
            var asChar = Character(newValue)
            var array = Array(self)
            array[index] = asChar
            self = String(array)
        }
    }
}

func triangle(var n:Int) {
    n = 1 << n
    var line = ""
    var t = ""
    var u = ""

    for (var i = 0; i <= 2 * n; i++) {
        line += " "
    }

    line[n] = "*"

    for (var i = 0; i < n; i++) {
        println(line)
        u = "*"
        for (var j = n - i; j < n + i + 1; j++) {
            t = line[j-1] == line[j + 1] ? " " : "*"
            line[j - 1] = u
            u = t
        }
        line[n + i] = t
        line[n + i + 1] = "*"
    }
}


package require Tcl 8.5

proc map {lambda list} {
    foreach elem $list {
        lappend result [apply $lambda $elem]
    }
    return $result
}

proc sierpinski_triangle n {
    set down [list *]
    set space " "
    for {set i 1} {$i <= $n} {incr i} {
        set down [concat \
            [map [subst -nocommands {x {expr {"$space[set x]$space"}}}] $down] \
            [map {x {expr {"$x $x"}}} $down] \
        ]
        append space $space
    }
    return [join $down \n]
}

puts [sierpinski_triangle 4]


Input "Triangle order: ";n
n = 2^n

For y = n - 1 To 0 Step -1

  For i = 0 To y
    Print " ";
  Next

  x = 0

  For x = 0 Step 1 While ((x + y) < n)
     If AND (x,y) Then
        Print "  ";
     Else
        Print "* ";
     EndIf
  Next

  Print
Next
End


#import nat

triangle = ~&a^?\<<&>>! ^|RNSiDlrTSPxSxNiCK9xSx4NiCSplrTSPT/~& predecessor


Sub sierpinski(n As Integer)
    Dim lim As Integer: lim = 2 ^ n - 1
    For y = lim To 0 Step -1
        Debug.Print String$(y, " ")
        For x = 0 To lim - y
            Debug.Print IIf(x And y, "  ", "# ");
        Next
        Debug.Print
    Next y
End Sub
Public Sub main()
    Dim i As Integer
    For i = 1 To 5
        sierpinski i
    Next i
End Sub


Sub triangle(o)
	n = 2 ^ o
	Dim line()
	ReDim line(2*n)
	line(n) = "*"
	i = 0
	Do While i < n
		WScript.StdOut.WriteLine Join(line,"")
		u = "*"
		j = n - i
		Do While j < (n+i+1)
			If line(j-1) = line(j+1) Then
				t = " "
			Else
				t = "*"
			End If
			line(j-1) = u
			u = t
			j = j + 1
		Loop
		line(n+i) = t
		line(n+i+1) = "*"
		i = i + 1
	Loop
End Sub

triangle(4)


#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)
}


var size = 1 << 4
for (y in size-1..0) {
    System.write(" " * y)
    for (x in 0...size-y) System.write((x&y != 0) ? "  " : "* ")
    System.print()
}


        .model  tiny
        .code
        .486
        org     100h
start:  xor     ebx, ebx        ;S1:= 0
        mov     edx, 8000h      ;S2:= $8000
        mov     cx, 16          ;for I:= Size downto 1
tri10:  mov     ebx, edx        ; S1:= S2
tri15:  test    edx, edx        ; while S2#0
        je      tri20
         mov    al, '*'         ; ChOut
         test   dl, 01h         ;  if S2&1 then '*' else ' '
         jne    tri18
          mov   al, ' '
tri18:   int    29h
         shr    edx, 1          ; S2>>1
         jmp    tri15
tri20:  mov     al, 0Dh         ;new line
        int     29h
        mov     al, 0Ah
        int     29h
        shl     ebx, 1          ;S2:= S2 xor S1<<1
        xor     edx, ebx
        shr     ebx, 2          ;S2:= S2 xor S1>>1
        xor     edx, ebx
        loop    tri10           ;next I
        ret
        end     start


code ChOut=8, CrLf=9;
def Order=4, Size=1<<Order;
int S1, S2, I;
[S1:= 0;  S2:= $8000;
for I:= 0 to Size-1 do
    [S1:= S2;
    while S2 do
        [ChOut(0, if S2&1 then ^* else ^ );  S2:= S2>>1];
    CrLf(0);
    S2:= S2 xor S1<<1;
    S2:= S2 xor S1>>1;
    ];
]


sub rep$(n, c$)
    local i, s$

    for i = 1 to n
	s$ = s$ + c$
    next
    return s$
end sub

sub sierpinski(n)
    local lim, y, x

    lim = 2**n - 1
    for y = lim to 0 step -1
        print rep$(y, " ");
        for x = 0 to lim-y
            if and(x, y) then print "  "; else print "* "; end if
        next
        print
    next
end sub

for i = 1 to 5
    sierpinski(i)
next


level,d := 3,T("*");
foreach n in (level + 1){
   sp:=" "*(2).pow(n);
   d=d.apply('wrap(a){ String(sp,a,sp) }).extend(
     d.apply(fcn(a){ String(a," ",a) }));
}
d.concat("\n").println();


*        SHOELACE                  25/02/2019
SHOELACE CSECT
         USING  SHOELACE,R15       base register
         MVC    SUPS(8),POINTS     x(nt+1)=x(1); y(nt+1)=y(1)
         LA     R9,0               area=0
         LA     R7,POINTS          @x(1)
         LA     R6,NT              do i=1 to nt
LOOP     L      R3,0(R7)             x(i)
         M      R2,12(R7)            *y(i+1)
         L      R5,8(R7)             x(i+1)
         M      R4,4(R7)             *y(i)
         SR     R3,R5                x(i)*y(i+1)-x(i+1)*y(i)
         AR     R9,R3                area=area+x(i)*y(i+1)-x(i+1)*y(i)
         LA     R7,8(R7)             @x(i++)
         BCT    R6,LOOP            enddo
         LPR    R9,R9              area=abs(area)
         SRA    R9,1               area=area/2
         XDECO  R9,PG              edit area
         XPRNT  PG,L'PG            print area
         BR     R14                return to caller
NT       EQU    (SUPS-POINTS)/8    nt  number of points
POINTS   DC     F'3',F'4',F'5',F'11',F'12',F'8',F'9',F'5',F'5',F'6'
SUPS     DS     2F                 x(nt+1),y(nt+1)
PG       DC     CL12' '            buffer
         REGEQU
         END    SHOELACE


INCLUDE "H6:REALMATH.ACT"

PROC Area(INT ARRAY xs,ys BYTE count REAL POINTER res)
  BYTE i,next
  REAL x1,y1,x2,y2,tmp1,tmp2

  IntToReal(0,res)
  IntToReal(xs(0),x1) IntToReal(ys(0),y1)
  FOR i=0 TO count-1
  DO
    next=i+1
    IF next=count THEN
      next=0
    FI
    IntToReal(xs(next),x2) IntToReal(ys(next),y2)

    RealMult(x1,y2,tmp1)
    RealAdd(res,tmp1,tmp2)
    RealMult(x2,y1,tmp1)
    RealSub(tmp2,tmp1,res)

    RealAssign(x2,x1) RealAssign(y2,y1)
  OD

  RealAbs(res,tmp1)
  IntToReal(2,tmp2)
  RealDiv(tmp1,tmp2,res)
RETURN

PROC PrintPolygon(INT ARRAY xs,ys BYTE count)
  BYTE i

  FOR i=0 TO count-1
  DO
    PrintF("(%I,%I)",xs(i),ys(i))
    IF i<count-1 THEN
      Print(", ")
    ELSE
      PutE()
    FI
  OD
RETURN

PROC Test(INT ARRAY xs,ys BYTE count)
  REAL res

  Area(xs,ys,count,res)
  Print("Polygon: ")
  PrintPolygon(xs,ys,count)

  Print("Area: ")
  PrintRE(res) PutE()
RETURN

PROC Main()
  INT ARRAY
    xs(5)=[3 5 12 9 5],
    ys(5)=[4 11 8 5 6]

  Put(125) PutE() ;clear screen

  Test(xs,ys,5)
RETURN


with Ada.Text_IO;

procedure Shoelace_Formula_For_Polygonal_Area
is
   type Point is record
      x, y : Float;
   end record;

   type Polygon is array (Positive range <>) of Point;

   function Shoelace(input : in Polygon) return Float
   is
      sum_1 : Float := 0.0;
      sum_2 : Float := 0.0;
      tmp : constant Polygon := input & input(input'First);
   begin
      for I in tmp'First .. tmp'Last - 1 loop
         sum_1 := sum_1 + tmp(I).x * tmp(I+1).y;
         sum_2 := sum_2 + tmp(I+1).x * tmp(I).y;
      end loop;
      return abs(sum_1 - sum_2) / 2.0;
   end Shoelace;

   my_polygon : constant Polygon :=
     ((3.0, 4.0),
      (5.0, 11.0),
      (12.0, 8.0),
      (9.0, 5.0),
      (5.0, 6.0));
begin
   Ada.Text_IO.Put_Line(Shoelace(my_polygon)'Img);
end Shoelace_Formula_For_Polygonal_Area;


begin
    comment Shoelace formula for polygonal area - Algol 60;
    real array x[1:33],y[1:33];
    integer i,n;
    real a;
    ininteger(0,n);
    for i:=1 step 1 until n do
    begin
        inreal(0,x[i]);
        inreal(0,y[i])
    end;
    x[i]:=x[1];
    y[i]:=y[1];
    a:=0;
    for i:=1 step 1 until n do
        a:=a+x[i]*y[i+1]-x[i+1]*y[i];
    a:=abs(a/2.);
    outreal(1,a)
end


BEGIN
    # returns the area of the polygon defined by the points p using the Shoelace formula #
    OP  AREA = ( [,]REAL p )REAL:
        BEGIN
            [,]REAL points = p[ AT 1, AT 1 ]; # normalise array bounds to start at 1 #
            IF 2 UPB points /= 2 THEN
                # the points do not have 2 coordinates #
                -1
            ELSE
                REAL   result := 0;
                INT    n       = 1 UPB points;
                IF n > 1 THEN
                    # there at least two points #
                    []REAL x   = points[ :, 1 ];
                    []REAL y   = points[ :, 2 ];
                    FOR i TO 1 UPB points - 1 DO
                        result +:= x[ i     ] * y[ i + 1 ];
                        result -:= x[ i + 1 ] * y[ i     ]
                    OD;
                    result     +:= x[ n ] * y[ 1 ];
                    result     -:= x[ 1 ] * y[ n ]
                FI;
                ( ABS result ) / 2
            FI
        END # AREA # ;

    # test case as per the task #
    print( ( fixed( AREA [,]REAL( ( 3.0, 4.0 ), ( 5.0, 11.0 ), ( 12.0, 8.0 ), ( 9.0, 5.0 ), ( 5.0, 6.0 ) ), -6, 2 ), newline ) )
END


shoelace ← 2÷⍨|∘(((1⊃¨⊢)+.×1⌽2⊃¨⊢)-(1⌽1⊃¨⊢)+.×2⊃¨⊢)


arraybase 1
dim array = {{3,4}, {5,11}, {12,8}, {9,5}, {5,6}}

print "The area of the polygon = "; Shoelace(array)
end

function Shoelace(p)
    sum = 0
    for i = 1 to p[?][] -1
        sum += p[i][1] * p[i +1][2]
        sum -= p[i +1][1] * p[i][2]
    next i
    sum += p[i][1] * p[1][2]
    sum -= p[1][1] * p[i][2]
    return abs(sum) \ 2
end function


#include<stdlib.h>
#include<stdio.h>
#include<math.h>

typedef struct{
	double x,y;
}point;

double shoelace(char* inputFile){
	int i,numPoints;
	double leftSum = 0,rightSum = 0;

	point* pointSet;
	FILE* fp = fopen(inputFile,"r");

	fscanf(fp,"%d",&numPoints);

	pointSet = (point*)malloc((numPoints + 1)*sizeof(point));

	for(i=0;i<numPoints;i++){
		fscanf(fp,"%lf %lf",&pointSet[i].x,&pointSet[i].y);
	}

	fclose(fp);

	pointSet[numPoints] = pointSet[0];

	for(i=0;i<numPoints;i++){
		leftSum += pointSet[i].x*pointSet[i+1].y;
		rightSum += pointSet[i+1].x*pointSet[i].y;
	}

	free(pointSet);

	return 0.5*fabs(leftSum - rightSum);
}

int main(int argC,char* argV[])
{
	if(argC==1)
		printf("\nUsage : %s <full path of polygon vertices file>",argV[0]);

	else
		printf("The polygon area is %lf square units.",shoelace(argV[1]));

	return 0;
}


using System;
using System.Collections.Generic;

namespace ShoelaceFormula {
    using Point = Tuple<double, double>;

    class Program {
        static double ShoelaceArea(List<Point> v) {
            int n = v.Count;
            double a = 0.0;
            for (int i = 0; i < n - 1; i++) {
                a += v[i].Item1 * v[i + 1].Item2 - v[i + 1].Item1 * v[i].Item2;
            }
            return Math.Abs(a + v[n - 1].Item1 * v[0].Item2 - v[0].Item1 * v[n - 1].Item2) / 2.0;
        }

        static void Main(string[] args) {
            List<Point> v = new List<Point>() {
                new Point(3,4),
                new Point(5,11),
                new Point(12,8),
                new Point(9,5),
                new Point(5,6),
            };
            double area = ShoelaceArea(v);
            Console.WriteLine("Given a polygon with vertices [{0}],", string.Join(", ", v));
            Console.WriteLine("its area is {0}.", area);
        }
    }
}


#include <iostream>
#include <tuple>
#include <vector>

using namespace std;

double shoelace(vector<pair<double, double>> points) {
	double leftSum = 0.0;
	double rightSum = 0.0;

	for (int i = 0; i < points.size(); ++i) {
		int j = (i + 1) % points.size();
		leftSum  += points[i].first * points[j].second;
		rightSum += points[j].first * points[i].second;
	}

	return 0.5 * abs(leftSum - rightSum);
}

void main() {
	vector<pair<double, double>> points = {
		make_pair( 3,  4),
		make_pair( 5, 11),
		make_pair(12,  8),
		make_pair( 9,  5),
		make_pair( 5,  6),
	};

	auto ans = shoelace(points);
	cout << ans << endl;
}


include "cowgol.coh";

typedef Coord is uint16; # floating point types are not supported

record Point is
    x: Coord;
    y: Coord;
end record;

sub shoelace(p: [Point], length: intptr): (area: Coord) is
    var left: Coord := 0;
    var right: Coord := 0;

    var y0 := p.y;
    var x0 := p.x;

    while length > 1 loop
        var xp := p.x;
        var yp := p.y;
        p := @next p;
        left := left + xp * p.y;
        right := right + yp * p.x;
        length := length - 1;
    end loop;

    left := left + y0 * p.x;
    right := right + x0 * p.y;
    if left < right then
        area := right - left;
    else
        area := left - right;
    end if;

    area := area / 2;
end sub;

var polygon: Point[] := {{3,4},{5,11},{12,8},{9,5},{5,6}};
print_i16(shoelace(&polygon[0], @sizeof polygon));
print_nl();


import std.stdio;

Point[] pnts = [{3,4}, {5,11}, {12,8}, {9,5}, {5,6}];

void main() {
    auto ans = shoelace(pnts);
    writeln(ans);
}

struct Point {
    real x, y;
}

real shoelace(Point[] pnts) {
    real leftSum = 0, rightSum = 0;

    for (int i=0; i<pnts.length; ++i) {
        int j = (i+1) % pnts.length;
        leftSum  += pnts[i].x * pnts[j].y;
        rightSum += pnts[j].x * pnts[i].y;
    }

    import std.math : abs;
    return 0.5 * abs(leftSum - rightSum);
}

unittest {
    auto ans = shoelace(pnts);
    assert(ans == 30);
}


// Shoelace formula for area of polygon. Nigel Galloway: April 11th., 2018
let fN(n::g) = abs(List.pairwise(n::[email protected][n])|>List.fold(fun n ((nα,gα),(nβ,gβ))->n+(nα*gβ)-(gα*nβ)) 0.0)/2.0
printfn "%f" (fN [(3.0,4.0); (5.0,11.0); (12.0,8.0); (9.0,5.0); (5.0,6.0)])


USING: circular kernel math prettyprint sequences ;
IN: rosetta-code.shoelace

CONSTANT: input { { 3 4 } { 5 11 } { 12 8 } { 9 5 } { 5 6 } }

: align-pairs ( pairs-seq -- seq1 seq2 )
    <circular> dup clone [ 1 ] dip
    [ change-circular-start ] keep ;

: shoelace-sum ( seq1 seq2 -- n )
    [ [ first ] [ second ] bi* * ] 2map sum ;

: shoelace-area ( pairs-seq -- area )
    [ align-pairs ] [ align-pairs swap ] bi
    [ shoelace-sum ] [email protected] - abs 2 / ;

input shoelace-area .


      DOUBLE PRECISION FUNCTION AREA(N,P)	!Calculates the area enclosed by the polygon P.
C   Uses the mid-point rule for integration. Consider the line joining (x1,y1) to (x2,y2)
C The area under that line (down to the x-axis) is the y-span midpoint (y1 + y2)/2 times the width (x2 - x1)
C This is the trapezoidal rule for a single interval, and follows from simple geometry.
C Now consider a sequence of such points heading in the +x direction: each successive interval's area is positive.
C Follow with a sequence of points heading in the -x direction, back to the first point: their areas are all negative.
C The resulting sum is the area below the +x sequence and above the -x sequence: the area of the polygon.
C   The point sequence can wobble as it wishes and can meet the other side, but it must not cross itself
c as would be done in a figure 8 drawn with a crossover instead of a meeting.
C   A clockwise traversal (as for an island) gives a positive area; use anti-clockwise for a lake.
       INTEGER N		!The number of points.
       DOUBLE COMPLEX P(N)	!The points.
       DOUBLE COMPLEX PP,PC	!Point Previous and Point Current.
       DOUBLE COMPLEX W		!Polygon centre. Map coordinates usually have large offsets.
       DOUBLE PRECISION A	!The area accumulator.
       INTEGER I		!A stepper.
        IF (N.LT.3) STOP "Area: at least three points are needed!"	!Good grief.
        W = (P(1) + P(N/3) + P(2*N/3))/3	!An initial working average.
        W = SUM(P(1:N) - W)/N + W	!A good working average is the average itself.
        A = 0			!The area enclosed by the point sequence.
        PC = P(N) - W		!The last point is implicitly joined to the first.
        DO I = 1,N		!Step through the positions.
          PP = PC			!Previous position.
          PC = P(I) - W			!Current position.
          A = (DIMAG(PC) + DIMAG(PP))*(DBLE(PC) - DBLE(PP)) + A	!Area integral component.
        END DO			!On to the next position.
        AREA = A/2		!Divide by two once.
      END FUNCTION AREA		!The units are those of the points.

      DOUBLE PRECISION FUNCTION AREASL(N,P)	!Area enclosed by polygon P, by the "shoelace" method.
       INTEGER N		!The number of points.
       DOUBLE COMPLEX P(N)	!The points.
       DOUBLE PRECISION A	!A scratchpad.
        A = SUM(DBLE(P(1:N - 1)*DIMAG(P(2:N)))) + DBLE(P(N))*DIMAG(P(1))
     1    - SUM(DBLE(P(2:N)*DIMAG(P(1:N - 1)))) - DBLE(P(1))*DIMAG(P(N))
        AREASL = A/2		!The midpoint formula requires a halving.
      END FUNCTION AREASL	!Negative for clockwise, positive for anti-clockwise.

      INTEGER ENUFF
      DOUBLE PRECISION AREA,AREASL	!The default types are not correct.
      DOUBLE PRECISION A1,A2		!Scratchpads, in case of a debugging WRITE within the functions.
      PARAMETER (ENUFF = 5)		!The specification.
      DOUBLE COMPLEX POINT(ENUFF)	!Could use X and Y arrays instead.
      DATA POINT/(3D0,4D0),(5D0,11D0),(12D0,8D0),(9D0,5D0),(5D0,6D0)/	!"D" for double precision.

      WRITE (6,*) POINT
      A1 = AREA(5,POINT)
      A2 = AREASL(5,POINT)
      WRITE (6,*) "A=",A1,A2
      END


' version 18-08-2017
' compile with: fbc -s console

Type _point_
    As Double x, y
End Type

Function shoelace_formula(p() As _point_ ) As Double

    Dim As UInteger i
    Dim As Double sum

    For i = 1 To UBound(p) -1
        sum += p(i   ).x * p(i +1).y
        sum -= p(i +1).x * p(i   ).y
    Next
    sum += p(i).x * p(1).y
    sum -= p(1).x * p(i).y

    Return Abs(sum) / 2
End Function

' ------=< MAIN >=------

Dim As _point_ p_array(1 To ...) = {(3,4), (5,11), (12,8), (9,5), (5,6)}

Print "The area of the polygon ="; shoelace_formula(p_array())

' empty keyboard buffer
While Inkey <> "" : Wend
Print : Print "hit any key to end program"
Sleep
End


package main

import "fmt"

type point struct{ x, y float64 }

func shoelace(pts []point) float64 {
    sum := 0.
    p0 := pts[len(pts)-1]
    for _, p1 := range pts {
        sum += p0.y*p1.x - p0.x*p1.y
        p0 = p1
    }
    return sum / 2
}

func main() {
    fmt.Println(shoelace([]point{{3, 4}, {5, 11}, {12, 8}, {9, 5}, {5, 6}}))
}


import Data.Bifunctor (bimap)

----------- SHOELACE FORMULA FOR POLYGONAL AREA ----------

-- The area of a polygon formed by
-- the list of (x, y) coordinates.

shoelace :: [(Double, Double)] -> Double
shoelace =
  let calcSums ((x, y), (a, b)) = bimap (x * b +) (a * y +)
   in (/ 2)
        . abs
        . uncurry (-)
        . foldr calcSums (0, 0)
        . (<*>) zip (tail . cycle)

--------------------------- TEST -------------------------
main :: IO ()
main =
  print $
    shoelace [(3, 4), (5, 11), (12, 8), (9, 5), (5, 6)]