let randMax = 32767.0
let filled = 1
let rightWall = 2
let bottomWall = 4

final class Percolate {
  let height: Int
  let width: Int

  private var grid: [Int]
  private var end: Int

  init(height: Int, width: Int) {
    self.height = height
    self.width = width
    self.end = width
    self.grid = [Int](repeating: 0, count: width * (height + 2))
  }

  private func fill(at p: Int) -> Bool {
    guard grid[p] & filled == 0 else { return false }

    grid[p] |= filled

    guard p < end else { return true }

    return (((grid[p + 0] & bottomWall) == 0) && fill(at: p + width)) ||
            (((grid[p + 0] & rightWall) == 0) && fill(at: p + 1)) ||
            (((grid[p - 1] & rightWall) == 0) && fill(at: p - 1)) ||
            (((grid[p - width] & bottomWall) == 0) && fill(at: p - width))
  }

  func makeGrid(porosity p: Double) {
    grid = [Int](repeating: 0, count: width * (height + 2))
    end = width

    let thresh = Int(randMax * p)

    for i in 0..<width {
      grid[i] = bottomWall | rightWall
    }

    for _ in 0..<height {
      for _ in stride(from: width - 1, through: 1, by: -1) {
        let r1 = Int.random(in: 0..<Int(randMax)+1)
        let r2 = Int.random(in: 0..<Int(randMax)+1)

        grid[end] = (r1 < thresh ? bottomWall : 0) | (r2 < thresh ? rightWall : 0)

        end += 1
      }

      let r3 = Int.random(in: 0..<Int(randMax)+1)

      grid[end] = rightWall | (r3 < thresh ? bottomWall : 0)

      end += 1
    }
  }

  @discardableResult
  func percolate() -> Bool {
    var i = 0

    while i < width && !fill(at: width + i) {
      i += 1
    }

    return i < width
  }

  func showGrid() {
    for _ in 0..<width {
      print("+--", terminator: "")
    }

    print("+")

    for i in 0..<height {
      print(i == height ? " " : "|", terminator: "")

      for j in 0..<width {
        print(grid[i * width + j + width] & filled != 0 ? "[]" : "  ", terminator: "")
        print(grid[i * width + j + width] & rightWall != 0 ? "|" : " ", terminator: "")
      }

      print()

      guard i != height else { return }

      for j in 0..<width {
        print(grid[i * width + j + width] & bottomWall != 0 ? "+--" : "+  ", terminator: "")
      }

      print("+")
    }
  }
}

let p = Percolate(height: 10, width: 10)

p.makeGrid(porosity: 0.5)
p.percolate()
p.showGrid()

print("Running \(p.height) x \(p.width) grid 10,000 times for each porosity")

for factor in 1...10 {
  var count = 0
  let porosity = Double(factor) / 10.0

  for _ in 0..<10_000 {
    p.makeGrid(porosity: porosity)

    if p.percolate() {
      count += 1
    }
  }

  print("p = \(porosity): \(Double(count) / 10_000.0)")
}


package require Tcl 8.6

# Structure the bond percolation system as a class
oo::class create BondPercolation {
    variable hwall vwall cells M N
    constructor {width height probability} {
	set M $height
	set N $width
	for {set i 0} {$i <= $height} {incr i} {
	    for {set j 0;set walls {}} {$j < $width} {incr j} {
		lappend walls [expr {rand() < $probability}]
	    }
	    lappend hwall $walls
	}
	for {set i 0} {$i <= $height} {incr i} {
	    for {set j 0;set walls {}} {$j <= $width} {incr j} {
		lappend walls [expr {$j==0 || $j==$width || rand() < $probability}]
	    }
	    lappend vwall $walls
	}
	set cells [lrepeat $height [lrepeat $width 0]]
    }

    method print {{percolated ""}} {
	set nw [string length $M]
	set grid $cells
	if {$percolated ne ""} {
	    lappend grid [lrepeat $N 0]
	    lset grid end $percolated 1
	}
	foreach hws $hwall vws [lrange $vwall 0 end-1] r $grid {
	    incr row
	    puts -nonewline [string repeat " " [expr {$nw+2}]]
	    foreach w $hws {
		puts -nonewline [if {$w} {subst "+-"} {subst "+ "}]
	    }
	    puts "+"
	    puts -nonewline [format "%-*s" [expr {$nw+2}] [expr {
		$row>$M ? $percolated eq "" ? " " : ">" : "$row)"
	    }]]
	    foreach v $vws c $r {
		puts -nonewline [if {$v==1} {subst "|"} {subst " "}]
		puts -nonewline [if {$c==1} {subst "#"} {subst " "}]
	    }
	    puts ""
	}
    }

    method percolate {} {
	try {
	    for {set i 0} {$i < $N} {incr i} {
		if {![lindex $hwall 0 $i]} {
		    my FloodFill $i 0
		}
	    }
	    return ""
	} trap PERCOLATED n {
	    return $n
	}
    }
    method FloodFill {x y} {
	# fill cell
	lset cells $y $x 1
	# bottom
	if {![lindex $hwall [expr {$y+1}] $x]} {
	    if {$y == $N-1} {
		# THE bottom
		throw PERCOLATED $x
	    }
	    if {$y < $N-1 && ![lindex $cells [expr {$y+1}] $x]} {
		my FloodFill $x [expr {$y+1}]
	    }
	}
	# left
	if {![lindex $vwall $y $x] && ![lindex $cells $y [expr {$x-1}]]} {
	    my FloodFill [expr {$x-1}] $y
	}
	# right
	if {![lindex $vwall $y [expr {$x+1}]] && ![lindex $cells $y [expr {$x+1}]]} {
	    my FloodFill [expr {$x+1}] $y
	}
	# top
	if {$y>0 && ![lindex $hwall $y $x] && ![lindex $cells [expr {$y-1}] $x]} {
	    my FloodFill $x [expr {$y-1}]
	}
    }
}

# Demonstrate one run
puts "Sample percolation, 10x10 p=0.5"
BondPercolation create bp 10 10 0.5
bp print [bp percolate]
bp destroy
puts ""

# Collect some aggregate statistics
apply {{} {
    puts "Percentage of tries that percolate, varying p"
    set tries 100
    for {set pint 0} {$pint <= 10} {incr pint} {
	set p [expr {$pint * 0.1}]
	set tot 0
	for {set i 0} {$i < $tries} {incr i} {
	    set bp [BondPercolation new 10 10 $p]
	    if {[$bp percolate] ne ""} {
		incr tot
	    }
	    $bp destroy
	}
	puts [format "p=%.2f: %2.1f%%" $p [expr {$tot*100./$tries}]]
    }
}}


import "random" for Random
import "/fmt" for Fmt

var rand = Random.new()
var RAND_MAX = 32767

// cell states
var FILL  = 1
var RWALL = 2  // right wall
var BWALL = 4  // bottom wall

var x = 10
var y = 10
var grid = List.filled(x * (y + 2), 0)
var cells = 0
var end = 0
var m = 0
var n = 0

var makeGrid = Fn.new { |p|
    var thresh = (p * RAND_MAX).truncate
    m = x
    n = y
    for (i in 0...grid.count) grid[i] = 0  // clears grid
    for (i in 0...m) grid[i] = BWALL | RWALL
    cells = m
    end = m
    for (i in 0...y) {
        for (j in x - 1..1) {
            var r1 = rand.int(RAND_MAX + 1)
            var r2 = rand.int(RAND_MAX + 1)
            grid[end] = ((r1 < thresh) ? BWALL : 0) |
                        ((r2 < thresh) ? RWALL : 0)
            end = end + 1
        }
        var r3 = rand.int(RAND_MAX + 1)
        grid[end] = RWALL | ((r3 < thresh) ? BWALL : 0)
        end = end + 1
    }
}

var showGrid = Fn.new {
    for (j in 0...m) System.write("+--")
    System.print("+")

    for (i in 0..n) {
        System.write((i == n) ? " " : "|")
        for (j in 0...m) {
            System.write(((grid[i * m + j + cells] & FILL) != 0) ? "[]" : "  ")
            System.write(((grid[i * m + j + cells] & RWALL) != 0) ? "|" : " ")
        }
        System.print()
        if (i == n) return
        for (j in 0...m) {
            System.write(((grid[i * m + j + cells] & BWALL) != 0) ? "+--" : "+  ")
        }
        System.print("+")
    }
}

var fill // recursive
fill = Fn.new { |p|
    if ((grid[p] & FILL) != 0) return false
    grid[p] = grid[p] | FILL
    if (p >= end) return true  // success: reached bottom row
    return (((grid[p + 0] & BWALL) == 0) && fill.call(p + m)) ||
           (((grid[p + 0] & RWALL) == 0) && fill.call(p + 1)) ||
           (((grid[p - 1] & RWALL) == 0) && fill.call(p - 1)) ||
           (((grid[p - m] & BWALL) == 0) && fill.call(p - m))
}

var percolate = Fn.new {
    var i = 0
    while (i < m && !fill.call(cells + i)) i = i + 1
    return i < m
}

makeGrid.call(0.5)
percolate.call()
showGrid.call()

System.print("\nRunning %(x) x %(y) grids 10,000 times for each p:")
for (p in 1..9) {
    var cnt = 0
    var pp = p / 10
    for (i in 0...10000) {
        makeGrid.call(pp)
        if (percolate.call()) cnt = cnt + 1
    }
    Fmt.print("p = $3g: $.4f", pp, cnt / 10000)
}


// cell states
const FILLED=1; // and odd
const RWALL =2; // right wall
const BWALL =4; // bottom wall
fcn P(p,wall){ (0.0).random(1)<p and wall or 0 }

fcn makeGrid(m,n,p){
    // Allocate two addition rows to avoid checking bounds.
    // Bottom row is also required by drippage
   grid:=Data(m*(n+2));
   do(m){ grid.write(BWALL + RWALL); } // grid is topped with walls
   do(n){
      do(m-1){ grid.write( P(p,BWALL) + P(p,RWALL) ) }
      grid.write(RWALL + P(p,BWALL));  // right border is all right wall, as is left border
   }
   do(m){ grid.write(0); } // for drips off the bottom of grid
   grid
}
fcn show(grid,m,n){ n+=1;
    println("+--"*m,"+");
    foreach i in ([1..n]){ y:=i*m;
       print(i==n and " " or "|"); // bottom row is special, otherwise always have left wall
       foreach j in (m){ c:=grid[y + j];
          print(c.bitAnd(FILLED) and "**" or "  ", c.bitAnd(RWALL)and"|"or" ");
       }
       println();

       if(i==n) return();  // nothing under the bottom row

       foreach j in (m){ print((grid[y + j].bitAnd(BWALL)) and "+--" or "+  "); }
       println("+");
    }
}
fcn fill(grid,x,m){
   if(grid[x].isOdd) return(False); // aka .bitAnd(FILLED) aka already been here
   grid[x]+=FILLED;
   if(x+m>=grid.len()) return(True); // success: reached bottom row
   return(( not grid[x]    .bitAnd(BWALL) and fill(grid,x + m,m) ) or // down
          ( not grid[x]    .bitAnd(RWALL) and fill(grid,x + 1,m) ) or // right
          ( not grid[x - 1].bitAnd(RWALL) and fill(grid,x - 1,m) ) or // left
          ( not grid[x - m].bitAnd(BWALL) and fill(grid,x - m,m) ));  // up
}
fcn percolate(grid,m){
   i:=0; while(i<m and not fill(grid,i+m,m)){ i+=1; }  // pour juice on top row
   return(i<m);  // percolated through the grid?
}


UInt32 seed = 0
F nonrandom()
   :seed = 1664525 * :seed + 1013904223
   R Int(:seed >> 16) / Float(FF'FF)

V (M, nn, t) = (15, 15, 100)

V cell2char = ‘ #abcdefghijklmnopqrstuvwxyz’
V NOT_VISITED = 1

T PercolatedException
   (Int, Int) t

   F (t)
      .t = t

F newgrid(p)
   R (0 .< :nn).map(n -> (0 .< :M).map(m -> Int(nonrandom() < @@p)))

F pgrid(cell, percolated)
   L(n) 0 .< :nn
      print(‘#.)  ’.format(n % 10)‘’(0 .< :M).map(m -> :cell2char[@cell[@n][m]]).join(‘ ’))
   I percolated != (-1, -1)
      V where = percolated[0]
      print(‘!)  ’(‘  ’ * where)‘’:cell2char[cell[:nn - 1][where]])

F walk_maze(m, n, &cell, indx) -> N
   cell[n][m] = indx
   I n < :nn - 1 & cell[n + 1][m] == :NOT_VISITED
      walk_maze(m, n + 1, &cell, indx)
   E I n == :nn - 1
      X PercolatedException((m, indx))
   I m & cell[n][m - 1] == :NOT_VISITED
      walk_maze(m - 1, n, &cell, indx)
   I m < :M - 1 & cell[n][m + 1] == :NOT_VISITED
      walk_maze(m + 1, n, &cell, indx)
   I n & cell[n - 1][m] == :NOT_VISITED
      walk_maze(m, n - 1, &cell, indx)

F check_from_top(&cell) -> (Int, Int)?
   V (n, walk_index) = (0, 1)
   X.try
      L(m) 0 .< :M
         I cell[n][m] == :NOT_VISITED
            walk_index++
            walk_maze(m, n, &cell, walk_index)
   X.catch PercolatedException ex
      R ex.t
   R N

V sample_printed = 0B
[Float = Int] pcount
L(p10) 11
   V p = p10 / 10.0
   pcount[p] = 0
   L(tries) 0 .< t
      V cell = newgrid(p)
      (Int, Int)? percolated = check_from_top(&cell)
      I percolated != N
         pcount[p]++
         I !sample_printed
            print("\nSample percolating #. x #., p = #2.2 grid\n".format(M, nn, p))
            pgrid(cell, percolated)
            sample_printed = 1B
print("\n p: Fraction of #. tries that percolate through\n".format(t))

L(p, c) sorted(pcount.items())
   print(‘#.1: #.’.format(p, c / Float(t)))


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

char *cell, *start, *end;
int m, n;

void make_grid(int x, int y, double p)
{
	int i, j, thresh = p * RAND_MAX;

	m = x, n = y;
	end = start = realloc(start, (x+1) * (y+1) + 1);

	memset(start, 0, m + 1);

	cell = end = start + m + 1;
	for (i = 0; i < n; i++) {
		for (j = 0; j < m; j++)
			*end++ = rand() < thresh ? '+' : '.';
		*end++ = '\n';
	}

	end[-1] = 0;
	end -= ++m; // end is the first cell of bottom row
}

int ff(char *p) // flood fill
{
	if (*p != '+') return 0;

	*p = '#';
	return p >= end || ff(p+m) || ff(p+1) || ff(p-1) || ff(p-m);
}

int percolate(void)
{
	int i;
	for (i = 0; i < m && !ff(cell + i); i++);
	return i < m;
}

int main(void)
{
	make_grid(15, 15, .5);
	percolate();

	puts("15x15 grid:");
	puts(cell);

	puts("\nrunning 10,000 tests for each case:");

	double p;
	int ip, i, cnt;
	for (ip = 0; ip <= 10; ip++) {
		p = ip / 10.;
		for (cnt = i = 0; i < 10000; i++) {
			make_grid(15, 15, p);
			cnt += percolate();
		}
		printf("p=%.1f:  %.4f\n", p, cnt / 10000.);
	}

	return 0;
}


import std.stdio, std.random, std.array, std.datetime;

enum size_t nCols = 15,
            nRows = 15,
            nSteps = 11,     // Probability granularity.
            nTries = 20_000; // Simulation tries.

enum Cell : char { empty   = ' ', filled  = '#', visited = '.' }
alias Grid = Cell[nCols][nRows];

void initialize(ref Grid grid, in double probability, ref Xorshift rng) {
    foreach (ref row; grid)
        foreach (ref cell; row)
            cell = (rng.uniform01 < probability) ? Cell.empty : Cell.filled;
}

void show(in ref Grid grid) @safe {
    writefln("%(|%(%c%)|\n%)|", grid);
}

bool percolate(ref Grid grid) pure nothrow @safe @nogc {
    bool walk(in size_t r, in size_t c) nothrow @safe @nogc {
        enum bottom = nRows - 1;
        grid[r][c] = Cell.visited;

        if (r < bottom && grid[r + 1][c] == Cell.empty) { // Down.
            if (walk(r + 1, c))
                return true;
        } else if (r == bottom)
            return true;

        if (c && grid[r][c - 1] == Cell.empty) // Left.
            if (walk(r, c - 1))
                return true;

        if (c < nCols - 1 && grid[r][c + 1] == Cell.empty) // Right.
            if (walk(r, c + 1))
                return true;

        if (r && grid[r - 1][c] == Cell.empty) // Up.
            if (walk(r - 1, c))
                return true;

        return false;
    }

    enum startR = 0;
    foreach (immutable c; 0 .. nCols)
        if (grid[startR][c] == Cell.empty)
            if (walk(startR, c))
                return true;
    return false;
}

void main() {
    static struct Counter {
        double prob;
        size_t count;
    }

    StopWatch sw;
    sw.start;

    enum probabilityStep = 1.0 / (nSteps - 1);
    Counter[nSteps] counters;
    foreach (immutable i, ref co; counters)
        co.prob = i * probabilityStep;

    Grid grid;
    bool sampleShown = false;
    auto rng = Xorshift(unpredictableSeed);

    foreach (ref co; counters) {
        foreach (immutable _; 0 .. nTries) {
            grid.initialize(co.prob, rng);
            if (grid.percolate) {
                co.count++;
                if (!sampleShown) {
                    writefln("Percolating sample (%dx%d, probability =%5.2f):",
                             nCols, nRows, co.prob);
                    grid.show;
                    sampleShown = true;
                }
            }
        }
    }
    sw.stop;

    writefln("\nFraction of %d tries that percolate through:", nTries);
    foreach (const co; counters)
        writefln("%1.3f %1.3f", co.prob, co.count / double(nTries));

    writefln("\nSimulations and grid printing performed" ~
             " in %3.2f seconds.", sw.peek.msecs / 1000.0);
}


USING: arrays combinators combinators.short-circuit formatting
fry generalizations io kernel math math.matrices math.order
math.ranges math.vectors prettyprint random sequences ;
IN: rosetta-code.site-percolation

SYMBOLS: ▓ . v ;

: randomly-filled-matrix ( m n probability -- matrix )
    [ random-unit > ▓ . ? ] curry make-matrix ;

: in-bounds? ( matrix loc -- ? )
    [ dim { 1 1 } v- ] dip [ 0 rot between? ] 2map [ t = ] all? ;

: set-coord ( obj loc matrix -- ) [ reverse ] dip set-index ;
: get-coord ( matrix loc -- elt ) swap [ first2 ] dip nth nth ;

: (can-percolate?) ( matrix loc -- ? )
    {
        { [ 2dup in-bounds? not ] [ 2drop f ] }
        { [ 2dup get-coord { v ▓ } member? ] [ 2drop f ] }
        {
            [ 2dup second [ dim second 1 - ] dip = ]
            [ [ v ] 2dip swap set-coord t ]
        }
        [
            2dup get-coord . =
            [ [ v ] 2dip swap [ set-coord ] 2keep swap ] when
            {
                [ { 1 0 } v+ ] [ { 1 0 } v- ]
                [ { 0 1 } v+ ] [ { 0 1 } v- ]
            } [ (can-percolate?) ] map-compose 2||
        ]
    } cond ;

: can-percolate? ( matrix -- ? )
    dup dim first <iota> [ 0 2array (can-percolate?) ] with find
    drop >boolean ;

: show-sample ( -- )
    f [ [ can-percolate? ] keep swap ]
    [ drop 15 15 0.6 randomly-filled-matrix ] do until
    "Sample percolation, p = 0.6" print simple-table. ;

: percolation-rate ( p -- rate )
    [ 500 1 ] dip -
    '[ 15 15 _ randomly-filled-matrix can-percolate? ] replicate
    [ t = ] count 500 / ;

: site-percolation ( -- )
    show-sample nl "Running 500 trials at each porosity:" print
    10 [1,b] [
        10 / dup percolation-rate "p = %.1f: %.3f\n" printf
    ] each ;

MAIN: site-percolation


! loosely translated from python.
! compilation: gfortran -Wall -std=f2008 thisfile.f08

!$ a=site && gfortran -o $a -g -O0 -Wall -std=f2008 $a.f08 && $a
!100 trials per
!Fill Fraction goal(%)    simulated through paths(%)
!           0                          0
!          10                          0
!          20                          0
!          30                          0
!          40                          0
!          50                          6
!
!
!    b b b   b   h   j     m m m
!  b b   b b b   h h   m m m m m
!    b b b       h h h     m
!    b     h h h   h h h h
!  b b   h h   h h h h   h h h
!  b b b   h h h   h h h h h h h
!  b b   @   h   h   h h h h h
!      @ @       h h h h h h h h
!    @ @ @ @       h h   h   h
!      @ @ @ @       h h h h h h
!      @ @ @   h h h h     h h h
!  @ @ @     h h   h   h     h h
!    @       h         h h h h h
!  @     h h   h     h h h     h
!  @ @   h h h h h h h   h h   h
!          60                         59
!          70                         97
!          80                        100
!          90                        100
!         100                        100

program percolation_site
  implicit none
  integer, parameter :: m=15,n=15,t=100
  !integer, parameter :: m=2,n=2,t=8
  integer(kind=1), dimension(m, n) :: grid
  real :: p
  integer :: i, ip, trial, successes
  logical :: success, unseen, q
  data unseen/.true./
  write(6,'(i3,a11)') t,' trials per'
  write(6,'(a21,a30)') 'Fill Fraction goal(%)','simulated through paths(%)'
  do ip=0, 10
     p = ip/10.0
     successes = 0
     do trial = 1, t
        call newgrid(grid, p)
        success = .false.
        do i=1, m
           q = walk(grid, i)    ! deliberately compute all paths
           success = success .or. q
        end do
        if ((ip == 6) .and. unseen) then
           call display(grid)
           unseen = .false.
        end if
        successes = successes + merge(1, 0, success)
     end do
     write(6,'(9x,i3,24x,i3)')ip*10,nint(100*real(successes)/real(t))
  end do

contains

  logical function walk(grid, start)
    integer(kind=1), dimension(m,n), intent(inout) :: grid
    integer, intent(in) :: start
    walk = rwalk(grid, 1, start, int(start+1,1))
  end function walk

  recursive function rwalk(grid, i, j, k) result(through)
    logical :: through
    integer(kind=1), dimension(m,n), intent(inout) :: grid
    integer, intent(in) :: i, j
    integer(kind=1), intent(in) :: k
    logical, dimension(4) :: q
    !out of bounds
    through = .false.
    if (i < 1) return
    if (m < i) return
    if (j < 1) return
    if (n < j) return
    !visited or non-pore
    if (1_1 /= grid(i, j)) return
    !update grid and recurse with neighbors.  deny 'shortcircuit' evaluation
    grid(i, j) = k
    q(1) = rwalk(grid,i+0,j+1,k)
    q(2) = rwalk(grid,i+0,j-1,k)
    q(3) = rwalk(grid,i+1,j+0,k)
    q(4) = rwalk(grid,i-1,j+0,k)
    !newly discovered outlet
    through = (i == m) .or. any(q)
  end function rwalk

  subroutine newgrid(grid, probability)
    implicit none
    real :: probability
    integer(kind=1), dimension(m,n), intent(out) :: grid
    real, dimension(m,n) :: harvest
    call random_number(harvest)
    grid = merge(1_1, 0_1, harvest < probability)
  end subroutine newgrid

  subroutine display(grid)
    integer(kind=1), dimension(m,n), intent(in) :: grid
    integer :: i, j, k, L
    character(len=n*2) :: lineout
    write(6,'(/)')
    lineout = ' '
    do i=1,m
       do j=1,n
          k = j+j
          L = grid(i,j)+1
          lineout(k:k) = ' @abcdefghijklmnopqrstuvwxyz'(L:L)
       end do
       write(6,*) lineout
    end do
  end subroutine display

end program percolation_site


#define SOLID "#"
#define EMPTY " "
#define WET   "v"

Dim Shared As String grid()
Dim Shared As Integer last, lastrow, m, n

Sub make_grid(x As Integer, y As Integer, p As Double)
    m = x
    n = y
    Redim Preserve grid(x*(y+1)+1)
    last = Len(grid)
    Dim As Integer lastrow = last-n
    Dim As Integer i, j

    For i = 0 To x-1
        For j = 1 To y
            grid(1+i*(y+1)+j) = Iif(Rnd < p, EMPTY, SOLID)
        Next j
    Next i
End Sub

Function ff(i As Integer) As Boolean
    If i <= 0 Or i >= last Or grid(i) <> EMPTY Then Return 0
    grid(i) = WET
    Return i >= lastrow Or (ff(i+m+1) Or ff(i+1) Or ff(i-1) Or ff(i-m-1))
End Function

Function percolate() As Integer
    For i As Integer = 2 To m+1
        If ff(i) Then Return 1
    Next i
    Return 0
End Function

Dim As Double p
Dim As Integer ip, i, cont

make_grid(15, 15, 0.55)
Print "15x15 grid:"
For i = 1 To Ubound(grid)
    Print grid(i);
    If i Mod 15 = 0 Then Print
Next i

Print !"\nrunning 10,000 tests for each case:"
For ip As Ubyte = 0 To 10
    p = ip / 10
    cont = 0
    For i = 1 To 10000
        make_grid(15, 15, p)
        cont += percolate()
    Next i
    Print Using "p=#.#:  #.####"; p; cont/10000
Next ip
Sleep


package main

import (
	"bytes"
	"fmt"
	"math/rand"
	"time"
)

func main() {
	const (
		m, n           = 15, 15
		t              = 1e4
		minp, maxp, Δp = 0, 1, 0.1
	)

	rand.Seed(2) // Fixed seed for repeatable example grid
	g := NewGrid(.5, m, n)
	g.Percolate()
	fmt.Println(g)

	rand.Seed(time.Now().UnixNano()) // could pick a better seed
	for p := float64(minp); p < maxp; p += Δp {
		count := 0
		for i := 0; i < t; i++ {
			g := NewGrid(p, m, n)
			if g.Percolate() {
				count++
			}
		}
		fmt.Printf("p=%.2f, %.4f\n", p, float64(count)/t)
	}
}

const (
	full  = '.'
	used  = '#'
	empty = ' '
)

type grid struct {
	cell [][]byte // row first, i.e. [y][x]
}

func NewGrid(p float64, xsize, ysize int) *grid {
	g := &grid{cell: make([][]byte, ysize)}
	for y := range g.cell {
		g.cell[y] = make([]byte, xsize)
		for x := range g.cell[y] {
			if rand.Float64() < p {
				g.cell[y][x] = full
			} else {
				g.cell[y][x] = empty
			}
		}
	}
	return g
}

func (g *grid) String() string {
	var buf bytes.Buffer
	// Don't really need to call Grow but it helps avoid multiple
	// reallocations if the size is large.
	buf.Grow((len(g.cell) + 2) * (len(g.cell[0]) + 3))

	buf.WriteByte('+')
	for _ = range g.cell[0] {
		buf.WriteByte('-')
	}
	buf.WriteString("+\n")

	for y := range g.cell {
		buf.WriteByte('|')
		buf.Write(g.cell[y])
		buf.WriteString("|\n")
	}

	buf.WriteByte('+')
	ly := len(g.cell) - 1
	for x := range g.cell[ly] {
		if g.cell[ly][x] == used {
			buf.WriteByte(used)
		} else {
			buf.WriteByte('-')
		}
	}
	buf.WriteByte('+')
	return buf.String()
}

func (g *grid) Percolate() bool {
	for x := range g.cell[0] {
		if g.use(x, 0) {
			return true
		}
	}
	return false
}

func (g *grid) use(x, y int) bool {
	if y < 0 || x < 0 || x >= len(g.cell[0]) || g.cell[y][x] != full {
		return false // Off the edges, empty, or used
	}
	g.cell[y][x] = used
	if y+1 == len(g.cell) {
		return true // We're on the bottom
	}

	// Try down, right, left, up in that order.
	return g.use(x, y+1) ||
		g.use(x+1, y) ||
		g.use(x-1, y) ||
		g.use(x, y-1)
}


{-# LANGUAGE OverloadedStrings #-}
import Control.Monad
import Control.Monad.Random
import Data.Array.Unboxed
import Data.List
import Formatting

type Field = UArray (Int, Int) Char

-- Start percolating some seepage through a field.
-- Recurse to continue percolation with new seepage.
percolateR :: [(Int, Int)] -> Field -> (Field, [(Int,Int)])
percolateR [] f = (f, [])
percolateR seep f =
    let ((xLo,yLo),(xHi,yHi)) = bounds f
        validSeep = filter (\p@(x,y) ->    x >= xLo
                                        && x <= xHi
                                        && y >= yLo
                                        && y <= yHi
                                        && f!p == ' ') $ nub $ sort seep

        neighbors (x,y) = [(x,y-1), (x,y+1), (x-1,y), (x+1,y)]

    in  percolateR
            (concatMap neighbors validSeep)
            (f // map (\p -> (p,'.')) validSeep)

-- Percolate a field.  Return the percolated field.
percolate :: Field -> Field
percolate start =
    let ((_,_),(xHi,_)) = bounds start
        (final, _) = percolateR [(x,0) | x <- [0..xHi]] start
    in final

-- Generate a random field.
initField :: Int -> Int -> Double -> Rand StdGen Field
initField w h threshold = do
    frnd <- fmap (\rv -> if rv<threshold then ' ' else  '#') <$> getRandoms
    return $ listArray ((0,0), (w-1, h-1)) frnd

-- Get a list of "leaks" from the bottom of a field.
leaks :: Field -> [Bool]
leaks f =
    let ((xLo,_),(xHi,yHi)) = bounds f
    in [f!(x,yHi)=='.'| x <- [xLo..xHi]]

-- Run test once; Return bool indicating success or failure.
oneTest :: Int -> Int -> Double -> Rand StdGen Bool
oneTest w h threshold =
    or.leaks.percolate <$> initField w h threshold

-- Run test multple times; Return the number of tests that pass.
multiTest :: Int -> Int -> Int -> Double -> Rand StdGen Double
multiTest testCount w h threshold = do
    results <- replicateM testCount $ oneTest w h threshold
    let leakyCount = length $ filter id results
    return $ fromIntegral leakyCount / fromIntegral testCount

-- Display a field with walls and leaks.
showField :: Field -> IO ()
showField a =  do
    let ((xLo,yLo),(xHi,yHi)) = bounds a
    mapM_ print [ [ a!(x,y) | x <- [xLo..xHi]] | y <- [yLo..yHi]]

main :: IO ()
main = do
  g <- getStdGen
  let w = 15
      h = 15
      threshold = 0.6
      (startField, g2) = runRand (initField w h threshold) g

  putStrLn ("Unpercolated field with " ++ show threshold ++ " threshold.")
  putStrLn ""
  showField startField

  putStrLn ""
  putStrLn "Same field after percolation."
  putStrLn ""
  showField $ percolate startField

  let testCount = 10000
      densityCount = 10

  putStrLn ""
  putStrLn (   "Results of running percolation test " ++ show testCount
            ++ " times with thresholds ranging from 0/" ++ show densityCount
            ++ " to " ++ show densityCount ++ "/" ++ show densityCount ++ " .")

  let densities = [0..densityCount]
      tests = sequence [multiTest testCount w h v
                           | density <- densities,
                             let v = fromIntegral density / fromIntegral densityCount ]
      results = zip densities (evalRand tests g2)
  mapM_ print [format ("p=" % int % "/" % int % " -> " % fixed 4) density densityCount x | (density,x) <- results]


using Printf, Distributions

newgrid(p::Float64, M::Int=15, N::Int=15) = rand(Bernoulli(p), M, N)

function walkmaze!(grid::Matrix{Int}, r::Int, c::Int, indx::Int)
    NOT_VISITED = 1 # const
    N, M = size(grid)
    dirs = [[1, 0], [-1, 0], [0, 1], [1, 0]]
    # fill cell
    grid[r, c] = indx

    # is the bottom line?
    rst = r == N

    # for each direction, if has not reached the bottom yet and can continue go to that direction
    for d in dirs
        rr, cc = (r, c) .+ d
        if !rst && checkbounds(Bool, grid, rr, cc) && grid[rr, cc] == NOT_VISITED
            rst = walkmaze!(grid, rr, cc, indx)
        end
    end
    return rst
end

function checkpath!(grid::Matrix{Int})
    NOT_VISITED = 1 # const
    N, M = size(grid)
    walkind = 1
    for m in 1:M
        if grid[1, m] == NOT_VISITED
            walkind += 1
            if walkmaze!(grid, 1, m, walkind)
                return true
            end
        end
    end
    return false
end

function printgrid(G::Matrix{Int})
    LETTERS = vcat(' ', '#', 'A':'Z')
    for r in 1:size(G, 1)
        println(r % 10, ") ", join(LETTERS[G[r, :] .+ 1], ' '))
    end
    if any(G[end, :] .> 1)
        println("!) ", join((ifelse(c > 1, LETTERS[c+1], ' ') for c in G[end, :]), ' '))
    end
end

const nrep = 1000 # const
sampleprinted = false

p = collect(0.0:0.1:1.0)
f = similar(p)
for i in linearindices(f)
    c = 0
    for _ in 1:nrep
        G = newgrid(p[i])
        perc = checkpath!(G)
        if perc
            c += 1
            if !sampleprinted
                @printf("Sample percolation, %i×%i grid, p = %.2f\n\n", size(G, 1), size(G, 2), p[i])
                printgrid(G)
                sampleprinted = true
            end
        end
    end
    f[i] = c / nrep
end

println("\nFrequencies for $nrep tries that percolate through\n")
for (pi, fi) in zip(p, f)
    @printf("p = %.1f ⇛ f = %.3f\n", pi, fi)
end


// version 1.2.10

import java.util.Random

val rand = Random()
const val RAND_MAX = 32767
const val NUL = '\u0000'

val x = 15
val y = 15
var grid = StringBuilder((x + 1) * (y + 1) + 1)
var cell = 0
var end = 0
var m = 0
var n = 0

fun makeGrid(p: Double) {
    val thresh = (p * RAND_MAX).toInt()
    m = x
    n = y
    grid.setLength(0)  // clears grid
    grid.setLength(m + 1)  // sets first (m + 1) chars to NUL
    end = m + 1
    cell = m + 1
    for (i in 0 until n) {
        for (j in 0 until m) {
            val r = rand.nextInt(RAND_MAX + 1)
            grid.append(if (r < thresh) '+' else '.')
            end++
        }
        grid.append('\n')
        end++
    }
    grid[end - 1] = NUL
    end -= ++m  // end is the index of the first cell of bottom row
}

fun ff(p: Int): Boolean { // flood fill
    if (grid[p] != '+') return false
    grid[p] = '#'
    return p >= end || ff(p + m) || ff(p + 1) || ff(p - 1) || ff(p - m)
}

fun percolate(): Boolean {
    var i = 0
    while (i < m && !ff(cell + i)) i++
    return i < m
}

fun main(args: Array<String>) {
    makeGrid(0.5)
    percolate()

    println("$x x $y grid:")
    println(grid)

    println("\nrunning 10,000 tests for each case:")
    for (ip in 0..10) {
        val p = ip / 10.0
        var cnt = 0
        for (i in 0 until 10_000) {
            makeGrid(p)
            if (percolate()) cnt++
        }
        println("p = %.1f:  %.4f".format(p, cnt / 10000.0))
    }
}


import random, sequtils, strformat, strutils

type Grid = seq[string]   # Row first, i.e. [y][x].

const
  Full = '.'
  Used = '#'
  Empty = ' '

proc newGrid(p: float; xsize, ysize: Positive): Grid =

  result = newSeqWith(ysize, newString(xsize))
  for row in result.mitems:
    for cell in row.mitems:
      cell = if rand(1.0) < p: Full else: Empty

proc `$`(grid: Grid): string =

  # Preallocate result to avoid multiple reallocations.
  result = newStringOfCap((grid.len + 2) * (grid[0].len + 3))

  result.add '+'
  result.add repeat('-', grid[0].len)
  result.add "+\n"

  for row in grid:
    result.add '|'
    result.add row
    result.add "|\n"

  result.add '+'
  for cell in grid[^1]:
    result.add if cell == Used: Used else: '-'
  result.add '+'

proc use(grid: var Grid; x, y: int): bool =
  if y < 0 or x < 0 or x >= grid[0].len or grid[y][x] != Full:
    return false    # Off the edges, empty, or used.
  grid[y][x] = Used
  if y == grid.high: return true    # On the bottom.

  # Try down, right, left, up in that order.
  result = grid.use(x, y + 1) or grid.use(x + 1, y) or
           grid.use(x - 1, y) or grid.use(x, y - 1)

proc percolate(grid: var Grid): bool =
  for x in 0..grid[0].high:
    if grid.use(x, 0): return true

const
  M = 15
  N = 15

  T = 1000
  MinP = 0.0
  MaxP = 1.0
  ΔP = 0.1

randomize()
var grid = newGrid(0.5, M, N)
discard grid.percolate()
echo grid
echo ""

var p = MinP
while p < MaxP:
  var count = 0
  for _ in 1..T:
    var grid = newGrid(p, M, N)
    if grid.percolate(): inc count
  echo &"p = {p:.2f}: {count / T:.4f}"
  p += ΔP


my $block = '▒';
my $water = '+';
my $pore  = ' ';
my $grid  = 15;
my @site;

$D{$_} = $i++ for qw<DeadEnd Up Right Down Left>;

sub deq { defined $_[0] && $_[0] eq $_[1] }

sub percolate {
    my($prob) = shift || 0.6;
    $site[0] = [($pore) x $grid];
    for my $y (1..$grid) {
        for my $x (0..$grid-1) {
            $site[$y][$x] = rand() < $prob ? $pore : $block;
        }
    }
    $site[$grid + 1] = [($pore) x $grid];
    $site[0][0] = $water;

    my $x = 0;
    my $y = 0;
    my @stack;

    while () {
        if (my $dir = direction($x,$y)) {
            push @stack, [$x,$y];
            ($x,$y) = move($dir, $x, $y)
        } else {
            return 0 unless @stack;
            ($x,$y) = @{pop @stack}
        }
        return 1 if $y > $grid;
    }
}

sub direction {
    my($x, $y) = @_;
    return $D{Down}  if deq($site[$y+1][$x  ], $pore);
    return $D{Right} if deq($site[$y  ][$x+1], $pore);
    return $D{Left}  if deq($site[$y  ][$x-1], $pore);
    return $D{Up}    if deq($site[$y-1][$x  ], $pore);
    return $D{DeadEnd};
}

sub move {
    my($dir,$x,$y) = @_;
    $site[--$y][   $x] = $water if $dir == $D{Up};
    $site[++$y][   $x] = $water if $dir == $D{Down};
    $site[  $y][ --$x] = $water if $dir == $D{Left};
    $site[  $y][ ++$x] = $water if $dir == $D{Right};
    $x, $y
}

my $prob = 0.65;
percolate($prob);

print "Sample percolation at $prob\n";
print join '', @$_, "\n" for @site;
print "\n";

my $tests = 100;
print "Doing $tests trials at each porosity:\n";
my @table;
for my $p (1 .. 10) {
    $p = $p/10;
    my $total = 0;
    $total += percolate($p) for 1..$tests;
    push @table, sprintf "p = %0.1f: %0.2f", $p, $total / $tests
}

print "$_\n" for @table;


with javascript_semantics
string grid
integer m, n, last, lastrow

enum SOLID = '#', EMPTY=' ', WET = 'v'

procedure make_grid(integer x, y, atom p)
    m = x
    n = y
    grid = repeat('\n',x*(y+1)+1)
    last = length(grid)
    lastrow = last-n
    for i=0 to x-1 do
        for j=1 to y do
            grid[1+i*(y+1)+j] = iff(rnd()<p?EMPTY:SOLID)
        end for
    end for
end procedure

function ff(integer i) -- flood_fill
    if i<=0 or i>=last or grid[i]!=EMPTY then return 0 end if
    grid[i] = WET
    return i>=lastrow or ff(i+m+1) or ff(i+1) or ff(i-1) or ff(i-m-1)
end function

function percolate()
    for i=2 to m+1 do
        if ff(i) then return true end if
    end for
    return false
end function

procedure main()
    make_grid(15,15,0.55)
    {} = percolate()
    printf(1,"%dx%d grid:%s",{15,15,grid})
    puts(1,"\nrunning 10,000 tests for each case:\n")
    for ip=0 to 10 do
        atom p = ip/10
        integer count = 0
        for i=1 to 10000 do
            make_grid(15, 15, p)
            count += percolate()
        end for
        printf(1,"p=%.1f:  %6.4f\n", {p, count/10000})
    end for
end procedure
main()


from random import random
import string
from pprint import pprint as pp

M, N, t = 15, 15, 100

cell2char = ' #' + string.ascii_letters
NOT_VISITED = 1     # filled cell not walked

class PercolatedException(Exception): pass

def newgrid(p):
    return [[int(random() < p) for m in range(M)] for n in range(N)] # cell

def pgrid(cell, percolated=None):
    for n in range(N):
        print( '%i)  ' % (n % 10)
               + ' '.join(cell2char[cell[n][m]] for m in range(M)))
    if percolated:
        where = percolated.args[0][0]
        print('!)  ' + '  ' * where + cell2char[cell[n][where]])

def check_from_top(cell):
    n, walk_index = 0, 1
    try:
        for m in range(M):
            if cell[n][m] == NOT_VISITED:
                walk_index += 1
                walk_maze(m, n, cell, walk_index)
    except PercolatedException as ex:
        return ex
    return None

def walk_maze(m, n, cell, indx):
    # fill cell
    cell[n][m] = indx
    # down
    if n < N - 1 and cell[n+1][m] == NOT_VISITED:
        walk_maze(m, n+1, cell, indx)
    # THE bottom
    elif n == N - 1:
        raise PercolatedException((m, indx))
    # left
    if m and cell[n][m - 1] == NOT_VISITED:
        walk_maze(m-1, n, cell, indx)
    # right
    if m < M - 1 and cell[n][m + 1] == NOT_VISITED:
        walk_maze(m+1, n, cell, indx)
    # up
    if n and cell[n-1][m] == NOT_VISITED:
        walk_maze(m, n-1, cell, indx)

if __name__ == '__main__':
    sample_printed = False
    pcount = {}
    for p10 in range(11):
        p = p10 / 10.0
        pcount[p] = 0
        for tries in range(t):
            cell = newgrid(p)
            percolated = check_from_top(cell)
            if percolated:
                pcount[p] += 1
                if not sample_printed:
                    print('\nSample percolating %i x %i, p = %5.2f grid\n' % (M, N, p))
                    pgrid(cell, percolated)
                    sample_printed = True
    print('\n p: Fraction of %i tries that percolate through\n' % t )

    pp({p:c/float(t) for p, c in pcount.items()})


#lang racket
(require racket/require (only-in racket/fixnum for*/fxvector))
(require (filtered-in (lambda (name) (regexp-replace #rx"unsafe-" name ""))
                      racket/unsafe/ops))

(define cell-empty   0)
(define cell-filled  1)
(define cell-wall    2)
(define cell-visited 3)
(define cell-exit    4)

(define ((percol->generator p)) (if (< (random) p) cell-filled cell-empty))

(define t (make-parameter 1000))

(define ((make-percol-grid M N) p)
  (define p->10 (percol->generator p))
  (define M+1 (fx+ 1 M))
  (define M+2 (fx+ 2 M))
  (for*/fxvector
   #:length (fx* N M+2)
   ((n (in-range N)) (m (in-range M+2)))
   (cond
     [(fx= 0 m) cell-wall]
     [(fx= m M+1) cell-wall]
     [else (p->10)])))

(define (cell->str c) (substring " #|+*" c (fx+ 1 c)))

(define ((draw-percol-grid M N) g)
  (define M+2 (fx+ M 2))
  (for ((row N))
    (for ((col (in-range M+2)))
      (define idx (fx+ (fx* M+2 row) col))
      (printf "~a" (cell->str (fxvector-ref g idx))))
    (newline)))

(define ((percolate-percol-grid?! M N) g)
  (define M+2 (fx+ M 2))
  (define N-1 (fx- N 1))
  (define max-idx (fx* N M+2))
  (define (inner-percolate g idx)
    (define row (fxquotient idx M+2))
    (cond
      ((fx< idx 0) #f)
      ((fx>= idx max-idx) #f)
      ((fx= N-1 row) (fxvector-set! g idx cell-exit) #t)
      ((fx= cell-filled (fxvector-ref g idx))
       (fxvector-set! g idx cell-visited)
       (or
        ; gravity first (thanks Mr Newton)
        (inner-percolate g (fx+ idx M+2))
        ; stick-to-the-left
        (inner-percolate g (fx- idx 1))
        (inner-percolate g (fx+ idx 1))
        ; go uphill only if we have to!
        (inner-percolate g (fx- idx M+2))))
      (else #f)))
  (for/first ((m (in-range 1 M+2)) #:when (inner-percolate g m)) g))

(define make-15x15-grid (make-percol-grid 15 15))
(define draw-15x15-grid (draw-percol-grid 15 15))
(define perc-15x15-grid?! (percolate-percol-grid?! 15 15))

(define (display-sample-percolation p)
  (printf "Percolation sample: p=~a~%" p)
  (for*/first
      ((i (in-naturals))
       (g (in-value (make-15x15-grid 0.6)))
       #:when (perc-15x15-grid?! g))
    (draw-15x15-grid g))
  (newline))

(display-sample-percolation 0.4)

(for ((p (sequence-map (curry * 1/10) (in-range 0 (add1 10)))))
  (define n-percolated-grids
    (for/sum
     ((i (in-range (t))) #:when (perc-15x15-grid?! (make-15x15-grid p))) 1))
  (define proportion-percolated (/ n-percolated-grids (t)))
  (printf "p=~a\t->\t~a~%" p (real->decimal-string proportion-percolated 4)))


my $block = '▒';
my $water = '+';
my $pore  = ' ';
my $grid  = 15;
my @site;

enum Direction <DeadEnd Up Right Down Left>;

say 'Sample percolation at .6';
percolate(.6);
.join.say for @site;
say "\n";

my $tests = 1000;
say "Doing $tests trials at each porosity:";
for .1, .2 ... 1 -> $p {
    printf "p = %0.1f: %0.3f\n", $p, (sum percolate($p) xx $tests) / $tests
}

sub infix:<deq> ( $a, $b ) { $a.defined && ($a eq $b) }

sub percolate ( $prob  = .6 ) {
    @site[0] = [$pore xx $grid];
    @site[$grid + 1] = [$pore xx $grid];

    for ^$grid X 1..$grid -> ($x, $y) {
        @site[$y;$x] = rand < $prob ?? $pore !! $block
    }
    @site[0;0] = $water;

    my @stack;
    my $current = [0;0];

    loop {
        if my $dir = direction( $current ) {
            @stack.push: $current;
            $current = move( $dir, $current )
        }
        else {
            return False unless @stack;
            $current = @stack.pop
        }
        return True if $current[1] > $grid
    }

    sub direction( [$x, $y] ) {
        (Down  if @site[$y + 1][$x] deq $pore) ||
        (Left  if @site[$y][$x - 1] deq $pore) ||
        (Right if @site[$y][$x + 1] deq $pore) ||
        (Up    if @site[$y - 1][$x] deq $pore) ||
        DeadEnd
    }

    sub move ( $dir, @cur ) {
        my ( $x, $y ) = @cur;
        given $dir {
            when Up    { @site[--$y][$x] = $water }
            when Down  { @site[++$y][$x] = $water }
            when Left  { @site[$y][--$x] = $water }
            when Right { @site[$y][++$x] = $water }
        }
        [$x, $y]
    }
}


class Percolate {

    has block = '▒'
    has water = '+'
    has pore  = ' '
    has grid  = 15
    has site  = []

    enum <DeadEnd, Up, Right, Down, Left>

    method direction(x, y) {
        ((site[y + 1][x] == pore) && Down ) ||
        ((site[y][x - 1] == pore) && Left ) ||
        ((site[y][x + 1] == pore) && Right) ||
        ((site[y - 1][x] == pore) && Up   ) ||
        DeadEnd
    }

    method move(dir, x, y) {
        given (dir) {
            when (Up)    { site[--y][x] = water }
            when (Down)  { site[++y][x] = water }
            when (Left)  { site[y][--x] = water }
            when (Right) { site[y][++x] = water }
        }
        return (x, y)
    }

    method percolate (prob  = 0.6) {
        site[0] = grid.of(pore)
        site[grid + 1] = grid.of(pore)

        for x = ^grid, y = 1..grid {
            site[y][x] = (1.rand < prob ? pore : block)
        }

        site[0][0] = water

        var stack = []
        var (x, y) = (0, 0)

        loop {
            if (var dir = self.direction(x, y)) {
                stack << [x, y]
                (x,y) = self.move(dir, x, y)
            }
            else {
                stack || return 0
                (x,y) = stack.pop...
            }
            return 1 if (y > grid)
        }
    }
}

var obj = Percolate()
say 'Sample percolation at 0.6'
obj.percolate(0.6)
obj.site.each { .join.say }
say ''

var tests = 100
say "Doing #{tests} trials at each porosity:"
for p in (0.1..1 `by` 0.1) {
    printf("p = %0.1f: %0.3f\n", p, tests.of { obj.percolate(p) }.sum / tests)
}


package require Tcl 8.6

oo::class create SitePercolation {
    variable cells w h
    constructor {width height probability} {
	set w $width
	set h $height
	for {set cells {}} {[llength $cells] < $h} {lappend cells $row} {
	    for {set row {}} {[llength $row] < $w} {lappend row $cell} {
		set cell [expr {rand() < $probability}]
	    }
	}
    }
    method print {out} {
	array set map {0 "#" 1 " " -1 .}
	puts "+[string repeat . $w]+"
	foreach row $cells {
	    set s "|"
	    foreach cell $row {
		append s $map($cell)
	    }
	    puts [append s "|"]
	}
	set outline [lrepeat $w "-"]
	foreach index $out {
	    lset outline $index "."
	}
	puts "+[join $outline {}]+"
    }
    method percolate {} {
	for {set work {}; set i 0} {$i < $w} {incr i} {
	    if {[lindex $cells 0 $i]} {lappend work 0 $i}
	}
	try {
	    my Fill $work
	    return {}
	} trap PERCOLATED x {
	    return [list $x]
	}
    }
    method Fill {queue} {
	while {[llength $queue]} {
	    set queue [lassign $queue y x]
	    if {$y >= $h} {throw PERCOLATED $x}
	    if {$y < 0 || $x < 0 || $x >= $w} continue
	    if {[lindex $cells $y $x]<1} continue
	    lset cells $y $x -1
	    lappend queue [expr {$y+1}] $x [expr {$y-1}] $x
	    lappend queue $y [expr {$x-1}] $y [expr {$x+1}]
	}
    }
}

# Demonstrate one run
puts "Sample percolation, 15x15 p=0.6"
SitePercolation create bp 15 15 0.6
bp print [bp percolate]
bp destroy
puts ""

# Collect statistics
apply {{} {
    puts "Percentage of tries that percolate, varying p"
    set tries 100
    for {set pint 0} {$pint <= 10} {incr pint} {
	set p [expr {$pint * 0.1}]
	set tot 0
	for {set i 0} {$i < $tries} {incr i} {
	    set bp [SitePercolation new 15 15 $p]
	    if {[$bp percolate] ne ""} {
		incr tot
	    }
	    $bp destroy
	}
	puts [format "p=%.2f: %2.1f%%" $p [expr {$tot*100./$tries}]]
    }
}}


import "random" for Random
import "/fmt" for Fmt

var rand = Random.new()
var RAND_MAX = 32767
var EMPTY = ""

var x = 15
var y = 15
var grid = List.filled((x + 1) * (y + 1) + 1, EMPTY)
var cell = 0
var end = 0
var m = 0
var n = 0

var makeGrid = Fn.new { |p|
    var thresh = (p * RAND_MAX).truncate
    m = x
    n = y
    grid.clear()
    grid = List.filled(m + 1, EMPTY)
    end = m + 1
    cell = m + 1
    for (i in 0...n) {
        for (j in 0...m) {
            var r = rand.int(RAND_MAX+1)
            grid.add((r < thresh) ? "+" : ".")
            end = end + 1
        }
        grid.add("\n")
        end = end + 1
    }
    grid[end-1] = EMPTY
    m = m + 1
    end = end - m  // end is the index of the first cell of bottom row
}

var ff // recursive
ff = Fn.new { |p|  // flood fill
   if (grid[p] != "+") return false
   grid[p] = "#"
   return p >= end || ff.call(p + m) || ff.call(p + 1) || ff.call(p - 1) ||
        ff.call(p - m)
}

var percolate = Fn.new {
    var i = 0
    while (i < m && !ff.call(cell + i)) i = i + 1
    return i < m
}

makeGrid.call(0.5)
percolate.call()
System.print("%(x) x %(y) grid:")
System.print(grid.join(""))
System.print("\nRunning 10,000 tests for each case:")
for (ip in 0..10) {
    var p = ip / 10
    var cnt = 0
    for (i in 0...10000) {
        makeGrid.call(p)
        if (percolate.call()) cnt = cnt + 1
    }
    Fmt.print("p = $.1f:  $.4f", p, cnt / 10000)
}


fcn makeGrid(m,n,p){
   grid:=Data((m+1)*(n+1));  // first row and right edges are buffers
   grid.write(" "*m); grid.write("\r");
   do(n){
      do(m){ grid.write(((0.0).random(1)<p) and "+" or "."); }  // cell is porous or not
      grid.write("\n");
   }
   grid
}
fcn ff(grid,x,m){ // walk across row looking for a porous cell
   if(grid[x]!=43) return(0); // '+' == 43 ASCII == porous
   grid[x]="#";
   return(x+m>=grid.len() or
	  ff(grid,x+m,m) or ff(grid,x+1,m) or ff(grid,x-1,m) or ff(grid,x-m,m));
}
fcn percolate(grid,m){
   x:=m+1; i:=0; while(i<m and not ff(grid,x,m)){ x+=1; i+=1; }
   return(i<m);  // percolated through the grid?
}

grid:=makeGrid(15,15,0.60);
println("Did liquid percolate: ",percolate(grid,15));
println("15x15 grid:\n",grid.text);

println("Running 10,000 tests for each case:");
foreach p in ([0.0 .. 1.0, 0.1]){
   cnt:=0.0; do(10000){ cnt+=percolate(makeGrid(15,15,p),15); }
   "p=%.1f:  %.4f".fmt(p, cnt/10000).println();
}


INCLUDE "D2:REAL.ACT" ;from the Action! Tool Kit

DEFINE REALPTR="CARD"
TYPE PointR=[REALPTR x,y]

INT ARRAY SinTab=[
  0 4 9 13 18 22 27 31 36 40 44 49 53 58 62 66 71 75 79 83
  88 92 96 100 104 108 112 116 120 124 128 132 136 139 143
  147 150 154 158 161 165 168 171 175 178 181 184 187 190
  193 196 199 202 204 207 210 212 215 217 219 222 224 226
  228 230 232 234 236 237 239 241 242 243 245 246 247 248
  249 250 251 252 253 254 254 255 255 255 256 256 256 256]

INT FUNC Sin(INT a)
  WHILE a<0 DO a==+360 OD
  WHILE a>360 DO a==-360 OD
  IF a<=90 THEN
    RETURN (SinTab(a))
  ELSEIF a<=180 THEN
    RETURN (SinTab(180-a))
  ELSEIF a<=270 THEN
    RETURN (-SinTab(a-180))
  ELSE
    RETURN (-SinTab(360-a))
  FI
RETURN (0)

INT FUNC Cos(INT a)
RETURN (Sin(a-90))

PROC Det(REAL POINTER x1,y1,x2,y2,res)
  REAL tmp1,tmp2

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

BYTE FUNC IsZero(REAL POINTER a)
  CHAR ARRAY s(10)

  StrR(a,s)
  IF s(0)=1 AND s(1)='0 THEN
    RETURN (1)
  FI
RETURN (0)

BYTE FUNC Intersection(PointR POINTER p1,p2,p3,p4,res)
  REAL det1,det2,dx1,dx2,dy1,dy2,nom,denom

  Det(p1.x,p1.y,p2.x,p2.y,det1)
  Det(p3.x,p3.y,p4.x,p4.y,det2)
  RealSub(p1.x,p2.x,dx1)
  RealSub(p1.y,p2.y,dy1)
  RealSub(p3.x,p4.x,dx2)
  RealSub(p3.y,p4.y,dy2)
  Det(dx1,dy1,dx2,dy2,denom)

  IF IsZero(denom) THEN
    RETURN (0)
  FI

  Det(det1,dx1,det2,dx2,nom)
  RealDiv(nom,denom,res.x)
  Det(det1,dy1,det2,dy2,nom)
  RealDiv(nom,denom,res.y)
RETURN (1)

PROC FloodFill(BYTE x0,y0)
  BYTE ARRAY xs(300),ys(300)
  INT first,last

  first=0 last=0
  xs(first)=x0
  ys(first)=y0

  WHILE first<=last
  DO
    x0=xs(first) y0=ys(first)
    first==+1
    IF Locate(x0,y0)=0 THEN
      Plot(x0,y0)
      IF Locate(x0-1,y0)=0 THEN
        last==+1 xs(last)=x0-1 ys(last)=y0
      FI
      IF Locate(x0+1,y0)=0 THEN
        last==+1 xs(last)=x0+1 ys(last)=y0
      FI
      IF Locate(x0,y0-1)=0 THEN
        last==+1 xs(last)=x0 ys(last)=y0-1
      FI
      IF Locate(x0,y0+1)=0 THEN
        last==+1 xs(last)=x0 ys(last)=y0+1
      FI
    FI
  OD
RETURN

PROC Pentagram(INT x0,y0,r,a0 BYTE c1,c2)
  INT ARRAY xs(16),ys(16)
  INT angle
  BYTE i
  PointR p1,p2,p3,p4,p
  REAL p1x,p1y,p2x,p2y,p3x,p3y,p4x,p4y,px,py

  p1.x=p1x p1.y=p1y
  p2.x=p2x p2.y=p2y
  p3.x=p3x p3.y=p3y
  p4.x=p4x p4.y=p4y
  p.x=px p.y=py

  ;outer points
  angle=a0
  FOR i=0 TO 4
  DO
    xs(i)=r*Sin(angle)/256+x0
    ys(i)=r*Cos(angle)/256+y0
    angle==+144
  OD

  ;intersection points
  FOR i=0 TO 4
  DO
    IntToReal(xs(i MOD 5),p1x)
    IntToReal(ys(i MOD 5),p1y)
    IntToReal(xs((1+i) MOD 5),p2x)
    IntToReal(ys((1+i) MOD 5),p2y)
    IntToReal(xs((2+i) MOD 5),p3x)
    IntToReal(ys((2+i) MOD 5),p3y)
    IntToReal(xs((3+i) MOD 5),p4x)
    IntToReal(ys((3+i) MOD 5),p4y)
    Intersection(p1,p2,p3,p4,p)
    xs(5+i)=RealToInt(px)
    ys(5+i)=RealToInt(py)
  OD

  ;centers of triangles
  FOR i=0 TO 4
  DO
    xs(10+i)=(xs(i)+xs(5+i)+xs(5+(i+2) MOD 5))/3
    ys(10+i)=(ys(i)+ys(5+i)+ys(5+(i+2) MOD 5))/3
  OD

  ;center of pentagon
  xs(15)=0 ys(15)=0
  FOR i=5 TO 9
  DO
    xs(15)==+xs(i)
    ys(15)==+ys(i)
  OD
  xs(15)==/5 ys(15)==/5

  ;draw lines
  COLOR=c1
  FOR i=0 TO 5
  DO
    IF i=0 THEN
      Plot(xs(i MOD 5),ys(i MOD 5))
    ELSE
      DrawTo(xs(i MOD 5),ys(i MOD 5))
    FI
  OD

  ;fill
  COLOR=c2
  FOR i=10 TO 15
  DO
    FloodFill(xs(i),ys(i))
  OD
RETURN

PROC Main()
  BYTE CH=$02FC

  Graphics(7+16)
  SetColor(0,8,4)
  SetColor(1,8,8)
  SetColor(2,8,12)
  Pentagram(40,48,40,0,1,2)
  Pentagram(119,48,40,15,2,3)

  DO UNTIL CH#$FF OD
  CH=$FF
RETURN


with Ada.Numerics.Elementary_Functions;

with SDL.Video.Windows.Makers;
with SDL.Video.Renderers.Makers;
with SDL.Video.Rectangles;
with SDL.Events.Events;

procedure Pentagram is

   Width  : constant := 600;
   Height : constant := 600;
   Offset : constant := 300.0;
   Radius : constant := 250.0;

   use SDL.Video.Rectangles;
   use SDL.C;

   Window   : SDL.Video.Windows.Window;
   Renderer : SDL.Video.Renderers.Renderer;
   Event    : SDL.Events.Events.Events;

   type Node_Id is mod 5;
   Nodes : array (Node_Id) of Point;

   procedure Calculate is
      use Ada.Numerics.Elementary_Functions;
   begin
      for I in Nodes'Range loop
         Nodes (I) := (X => int (Offset + Radius * Sin (Float (I), Cycle => 5.0)),
                       Y => int (Offset - Radius * Cos (Float (I), Cycle => 5.0)));
      end loop;
   end Calculate;

   function Orient_2D (A, B, C : Point) return int is
      ((B.X - A.X) * (C.Y - A.Y) - (B.Y - A.Y) * (C.X - A.X));

   procedure Fill is
      Count : Natural;
   begin
      for Y in int (Offset - Radius) .. int (Offset + Radius) loop
         for X in int (Offset - Radius) .. int (Offset + Radius) loop
            Count := 0;
            for Node in Nodes'Range loop
               Count := Count +
                 (if Orient_2D (Nodes (Node), Nodes (Node + 2), (X, Y)) > 0 then 1 else 0);
            end loop;
            if Count in 4 .. 5 then
               Renderer.Draw (Point => (X, Y));
            end if;
         end loop;
      end loop;
   end Fill;

   procedure Draw_Outline is
   begin
      for Node in Nodes'Range loop
         Renderer.Draw (Line => (Nodes (Node), Nodes (Node + 2)));
      end loop;
   end Draw_Outline;

   procedure Wait is
      use type SDL.Events.Event_Types;
   begin
      loop
         SDL.Events.Events.Wait (Event);
         exit when Event.Common.Event_Type = SDL.Events.Quit;
      end loop;
   end Wait;

begin
   if not SDL.Initialise (Flags => SDL.Enable_Screen) then
      return;
   end if;

   SDL.Video.Windows.Makers.Create (Win      => Window,
                                    Title    => "Pentagram",
                                    Position => SDL.Natural_Coordinates'(X => 10, Y => 10),
                                    Size     => SDL.Positive_Sizes'(Width, Height),
                                    Flags    => 0);
   SDL.Video.Renderers.Makers.Create (Renderer, Window.Get_Surface);
   Renderer.Set_Draw_Colour ((0, 0, 0, 255));
   Renderer.Fill (Rectangle => (0, 0, Width, Height));

   Calculate;
   Renderer.Set_Draw_Colour ((50, 50, 150, 255));
   Fill;
   Renderer.Set_Draw_Colour ((0, 220, 0, 255));
   Draw_Outline;
   Window.Update_Surface;

   Wait;
   Window.Finalize;
   SDL.Finalise;
end Pentagram;


100 XO = 140
110 YO = 96
120 S = 90
130 B = 7
140 F = 6
150 C = 4
200 POKE 230,64
210 HCOLOR= B
220 HPLOT 0,0
230 CALL 62454
240 A = 49232
250 I =  PEEK (A + 7) +  PEEK (A + 2)
260 I =  PEEK (A + 5) +  PEEK (A)
300 SX = S
310 SY = S
320 PI = 3.1415926535
330 E = PI * 4
340 S = PI / 1.25
350 X =  SIN (0)
360 Y =  COS (0)
370 HCOLOR= F
380 PX = XO + X * SX
390 PY = YO - Y * SY
400 FOR I = 0 TO E STEP S
410     X =  SIN (I)
420     Y =  COS (I)
430     FOR J = 0 TO SX
440         HPLOT PX,PY TO XO + X * J,YO - Y * J
450     NEXT J
460     PX = XO + X * SX
470     PY = YO - Y * SY
480 NEXT I
500 HCOLOR= C
510 PX = XO + X * SX
520 PY = YO - Y * SY
600 FOR I = S TO E STEP S
610     X =  SIN (I)
620     Y =  COS (I)
630     HPLOT PX,PY TO XO + X * SX,YO - Y * SY
640     HPLOT PX + 1,PY TO XO + X * SX + 1,YO - Y * SY
650     HPLOT PX,PY + 1 TO XO + X * SX,YO - Y * SY + 1
660     HPLOT PX + 1,PY + 1 TO XO + X * SX + 1,YO - Y * SY + 1
670     PX = XO + X * SX
680     PY = YO - Y * SY
690 NEXT I


#Include Gdip.ahk	; https://autohotkey.com/boards/viewtopic.php?f=6&t=6517
Width :=A_ScreenWidth, Height := A_ScreenHeight
Gui, 1: +E0x20 +Caption +E0x80000 +LastFound +AlwaysOnTop +ToolWindow +OwnDialogs
Gui, 1: Show, NA
hwnd1 := WinExist()
OnExit, Exit

If !pToken := Gdip_Startup()
{
	MsgBox, 48, gdiplus error!, Gdiplus failed to start.
	. Please ensure you have gdiplus on your system
	ExitApp
}

hbm := CreateDIBSection(Width, Height)
hdc := CreateCompatibleDC()
obm := SelectObject(hdc, hbm)
G := Gdip_GraphicsFromHDC(hdc)
Gdip_SetSmoothingMode(G, 4)
pBrush 	:= Gdip_BrushCreateSolid(0xFF6495ED)
pPen 	:= Gdip_CreatePen(0xff000000, 3)

;---------------------------------
LL := 165
Cx := Floor(A_ScreenWidth/2)
Cy := Floor(A_ScreenHeight/2)
phi := 54
;---------------------------------
loop, 5
{
	theta := abs(180-144-phi)
	p1x := Floor(Cx + LL * Cos(phi * 0.01745329252))
	p1y := Floor(Cy + LL * Sin(phi * 0.01745329252))
	p2x := Floor(Cx - LL * Cos(theta * 0.01745329252))
	p2y := Floor(Cy - LL * Sin(theta * 0.01745329252))
	phi+= 72
	Gdip_FillPolygon(G, pBrush, p1x "," p1y "|" Cx "," Cy "|" p2x "," p2y)
}
loop, 5
{
	theta := abs(180-144-phi)
	p1x := Floor(Cx + LL * Cos(phi * 0.01745329252))
	p1y := Floor(Cy + LL * Sin(phi * 0.01745329252))
	p2x := Floor(Cx - LL * Cos(theta * 0.01745329252))
	p2y := Floor(Cy - LL * Sin(theta * 0.01745329252))
	phi+= 72
	Gdip_DrawLines(G, pPen, p1x "," p1y "|" p2x "," p2y ) ; "|" Cx "," Cy )
}
UpdateLayeredWindow(hwnd1, hdc, 0, 0, Width, Height)
Gdip_DeleteBrush(pBrush)
SelectObject(hdc, obm)
DeleteObject(hbm)
DeleteDC(hdc)
Gdip_DeleteGraphics(G)
return
;----------------------------------------------------------------------
Esc::
Exit:
Gdip_Shutdown(pToken)
ExitApp
Return


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

#define pi M_PI

int main(){

	char colourNames[][14] = { "BLACK", "BLUE", "GREEN", "CYAN", "RED", "MAGENTA", "BROWN", "LIGHTGRAY", "DARKGRAY",
              "LIGHTBLUE", "LIGHTGREEN", "LIGHTCYAN", "LIGHTRED", "LIGHTMAGENTA", "YELLOW", "WHITE" };

	int stroke=0,fill=0,back=0,i;

	double centerX = 300,centerY = 300,coreSide,armLength,pentaLength;

	printf("Enter core pentagon side length : ");
	scanf("%lf",&coreSide);

	printf("Enter pentagram arm length : ");
	scanf("%lf",&armLength);

	printf("Available colours are :\n");

	for(i=0;i<16;i++){
		printf("%d. %s\t",i+1,colourNames[i]);
		if((i+1) % 3 == 0){
			printf("\n");
		}
	}

	while(stroke==fill && fill==back){
		printf("\nEnter three diffrenet options for stroke, fill and background : ");
		scanf("%d%d%d",&stroke,&fill,&back);
	}

	pentaLength = coreSide/(2 * tan(pi/5)) + sqrt(armLength*armLength - coreSide*coreSide/4);

	initwindow(2*centerX,2*centerY,"Pentagram");

	setcolor(stroke-1);

	setfillstyle(SOLID_FILL,back-1);

	bar(0,0,2*centerX,2*centerY);

	floodfill(centerX,centerY,back-1);

	setfillstyle(SOLID_FILL,fill-1);

	for(i=0;i<5;i++){
		line(centerX + coreSide*cos(i*2*pi/5)/(2*sin(pi/5)),centerY + coreSide*sin(i*2*pi/5)/(2*sin(pi/5)),centerX + coreSide*cos((i+1)*2*pi/5)/(2*sin(pi/5)),centerY + coreSide*sin((i+1)*2*pi/5)/(2*sin(pi/5)));
		line(centerX + coreSide*cos(i*2*pi/5)/(2*sin(pi/5)),centerY + coreSide*sin(i*2*pi/5)/(2*sin(pi/5)),centerX + pentaLength*cos(i*2*pi/5 + pi/5),centerY + pentaLength*sin(i*2*pi/5 + pi/5));
		line(centerX + coreSide*cos((i+1)*2*pi/5)/(2*sin(pi/5)),centerY + coreSide*sin((i+1)*2*pi/5)/(2*sin(pi/5)),centerX + pentaLength*cos(i*2*pi/5 + pi/5),centerY + pentaLength*sin(i*2*pi/5 + pi/5));

		floodfill(centerX + coreSide*cos(i*2*pi/5 + pi/10)/(2*sin(pi/5)),centerY + coreSide*sin(i*2*pi/5 + pi/10)/(2*sin(pi/5)),stroke-1);
	}

	floodfill(centerX,centerY,stroke-1);

	getch();

	closegraph();
}


unit Main;

interface

uses
    Winapi.Windows, Vcl.Graphics, Vcl.Forms, System.Math;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private
    procedure DrawPentagram(len, x, y: Integer; fill, stoke: TColor);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  degrees144: double;
  degrees72: double;
  degrees18: double;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  ClientHeight := 640;
  ClientWidth := 640;
  degrees144 := DegToRad(144);
  degrees72 := DegToRad(72);
  degrees18 := DegToRad(18);
end;

procedure CreatePolygon(len, x, y, n: integer; ang: double; var points: TArray<TPoint>);
var
  angle: Double;
  index, i, x2, y2: Integer;
begin
  angle := 0;
  index := 0;
  SetLength(points, n + 1);
  points[index].Create(x, y);

  for i := 1 to n do
  begin
    x2 := x + round(len * cos(angle));
    y2 := y + round(len * sin(-angle));
    x := x2;
    y := y2;
    angle := angle - ang;

    points[index].Create(x2, y2);
    inc(index);
  end;
  points[index].Create(points[0]);
end;

procedure TForm1.DrawPentagram(len, x, y: Integer; fill, stoke: TColor);
var
  points, points_internal: TArray<TPoint>;
  L, H: Integer;
begin
  // Calc of sides for draw internal pollygon
  // 2H+L = len -> 2H = len - L
  // L = 2H*sin(36/2) (Pythagorean theorem)
  // L = (len-L)sin(18)
  // L = len*sin(18)/[1+sin(18)]

  L := round(len * sin(degrees18) / (1 + sin(degrees18)));

  // H = (len - L)/2

  H := (len - L) div 2;

  CreatePolygon(L, x + H, y, 5, degrees72, points_internal);
  CreatePolygon(len, x, y, 5, degrees144, points);

  with Canvas, Canvas.Brush do
  begin
    with pen do
    begin
      Color := stoke;
      Style := psSolid;
      Width := 5;
    end;
    Color := fill;
    Polygon(points_internal);
    Polygon(points);
  end;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  with Canvas, Brush do
  begin
    Style := bsSolid;
    Color := clWhite;
    // fill background with white
    FillRect(ClientRect);
  end;
  drawPentagram(500, 70, 250, $ED9564, clDkGray);
end;

end.


xp = 10
yp = 40
linewidth 2
move xp yp
while angle > -720
  x = xp + cos angle * 80
  y = yp + sin -angle * 80
  line x y
  f[] &= x
  f[] &= y
  xp = x
  yp = y
  angle -= 144
.
color 900
polygon f[]


package main

import (
    "github.com/fogleman/gg"
    "math"
)

func Pentagram(x, y, r float64) []gg.Point {
    points := make([]gg.Point, 5)
    for i := 0; i < 5; i++ {
        fi := float64(i)
        angle := 2*math.Pi*fi/5 - math.Pi/2
        points[i] = gg.Point{x + r*math.Cos(angle), y + r*math.Sin(angle)}
    }
    return points
}

func main() {
    points := Pentagram(320, 320, 250)
    dc := gg.NewContext(640, 640)
    dc.SetRGB(1, 1, 1) // White
    dc.Clear()
    for i := 0; i <= 5; i++ {
        index := (i * 2) % 5
        p := points[index]
        dc.LineTo(p.X, p.Y)
    }
    dc.SetHexColor("#6495ED") // Cornflower Blue
    dc.SetFillRule(gg.FillRuleWinding)
    dc.FillPreserve()
    dc.SetRGB(0, 0, 0) // Black
    dc.SetLineWidth(5)
    dc.Stroke()
    dc.SavePNG("pentagram.png")
}


with Ada.Text_Io;
with Ada.Numerics.Elementary_Functions;
with Ada.Numerics.Big_Numbers.Big_Integers;

procedure Pells_Equation is
   use Ada.Numerics.Big_Numbers.Big_Integers;

   type Pair is
      record
         V1, V2 : Big_Integer;
      end record;

   procedure Solve_Pell (N : Natural; X, Y : out Big_Integer) is
      use Ada.Numerics.Elementary_Functions;
      Big_N : constant Big_Integer := To_Big_Integer (N);
      XX    : constant Big_Integer := To_Big_Integer (Natural (Float'Floor (Sqrt (Float (N)))));
   begin
      if XX**2 = Big_N then
         X := 1; Y := 0;
         return;
      end if;

      declare
         YY   : Big_Integer := XX;
         Z    : Big_Integer := 1;
         R    : Big_Integer := 2 * XX;
         E    : Pair        := Pair'(V1 => 1, V2 => 0);
         F    : Pair        := Pair'(V1 => 0, V2 => 1);
      begin
         loop
            YY := R * Z - YY;
            Z  := (Big_N - YY**2) / Z;
            R  := (XX + YY) / Z;
            E  := Pair'(V1 => E.V2, V2 => R * E.V2 + E.V1);
            F  := Pair'(V1 => F.V2, V2 => R * F.V2 + F.V1);
            X  := E.V2 + XX * F.V2;
            Y  := F.V2;
            exit when X**2 - Big_N * Y**2 = 1;
         end loop;
      end;
   end Solve_Pell;

   procedure Test (N : Natural) is

      package Natural_Io is new Ada.Text_Io.Integer_Io (Natural);
      use Ada.Text_Io, Natural_Io;

      X, Y : Big_Integer;
   begin
      Solve_Pell (N, X => X, Y => Y);
      Put ("X**2 - ");
      Put (N, Width => 3);
      Put (" * Y**2 = 1 for X = ");
      Put (To_String (X, Width => 22));
      Put (" and Y = ");
      Put (To_String (Y, Width => 20));
      New_Line;
   end Test;

begin
   Test (61);
   Test (109);
   Test (181);
   Test (277);
end Pells_Equation;


BEGIN
    # find solutions to Pell's eqauation: x^2 - ny^2 = 1 for integer x, y, n #
    MODE BIGINT     = LONG LONG INT;
    MODE BIGPAIR    = STRUCT( BIGINT v1, v2 );
    PROC solve pell = ( INT n )BIGPAIR:
         IF INT x = ENTIER( sqrt( n ) );
            x * x = n
         THEN
            # n is a erfect square - no solution otheg than 1,0              #
            BIGPAIR( 1, 0 )
         ELSE
            # there are non-trivial solutions                                #
            INT     y := x;
            INT     z := 1;
            INT     r := 2*x;
            BIGPAIR e := BIGPAIR( 1, 0 );
            BIGPAIR f := BIGPAIR( 0, 1 );
            BIGINT  a := 0;
            BIGINT  b := 0;
            WHILE
                y := (r*z - y);
                z := ENTIER ((n - y*y) / z);
                r := ENTIER ((x + y) / z);
                e := BIGPAIR( v2 OF e, r * v2 OF e + v1 OF e );
                f := BIGPAIR( v2 OF f, r * v2 OF f + v1 OF f );
                a := (v2 OF e + x*v2 OF f);
                b := v2 OF f;
                a*a - n*b*b /= 1
            DO SKIP OD;
            BIGPAIR( a, b )
         FI # solve pell # ;
    # task test cases                                                        #
    []INT nv = (61, 109, 181, 277);
    FOR i FROM LWB nv TO UPB nv DO
        INT  n = nv[ i ];
        BIGPAIR r = solve pell(n);
        print( ("x^2 - ", whole( n, -3 ), " * y^2 = 1 for x = ", whole( v1 OF r, -21), " and y = ", whole( v2 OF r, -21 ), newline ) )
    OD
END


100 PROGRAM "Pentagra.bas"
110 OPTION ANGLE DEGREES
120 GRAPHICS HIRES 4
130 SET PALETTE BLUE,CYAN,YELLOW,BLACK
140 PLOT 640,700,ANGLE 288;
150 FOR I=1 TO 5
160   PLOT FORWARD 700,RIGHT 144;
170 NEXT
180 SET INK 3
190 SET BEAM OFF:PLOT 0,0,PAINT


import java.awt.*;
import java.awt.geom.Path2D;
import javax.swing.*;

public class Pentagram extends JPanel {

    final double degrees144 = Math.toRadians(144);

    public Pentagram() {
        setPreferredSize(new Dimension(640, 640));
        setBackground(Color.white);
    }

    private void drawPentagram(Graphics2D g, int len, int x, int y,
            Color fill, Color stroke) {
        double angle = 0;

        Path2D p = new Path2D.Float();
        p.moveTo(x, y);

        for (int i = 0; i < 5; i++) {
            int x2 = x + (int) (Math.cos(angle) * len);
            int y2 = y + (int) (Math.sin(-angle) * len);
            p.lineTo(x2, y2);
            x = x2;
            y = y2;
            angle -= degrees144;
        }
        p.closePath();

        g.setColor(fill);
        g.fill(p);

        g.setColor(stroke);
        g.draw(p);
    }

    @Override
    public void paintComponent(Graphics gg) {
        super.paintComponent(gg);
        Graphics2D g = (Graphics2D) gg;

        g.setRenderingHint(RenderingHints.KEY_ANTIALIASING,
                RenderingHints.VALUE_ANTIALIAS_ON);

        g.setStroke(new BasicStroke(5, BasicStroke.CAP_ROUND, 0));

        drawPentagram(g, 500, 70, 250, new Color(0x6495ED), Color.darkGray);
    }

    public static void main(String[] args) {
        SwingUtilities.invokeLater(() -> {
            JFrame f = new JFrame();
            f.setDefaultCloseOperation(JFrame.EXIT_ON_CLOSE);
            f.setTitle("Pentagram");
            f.setResizable(false);
            f.add(new Pentagram(), BorderLayout.CENTER);
            f.pack();
            f.setLocationRelativeTo(null);
            f.setVisible(true);
        });
    }
}


#include <math.h>
#include <stdbool.h>
#include <stdint.h>
#include <stdio.h>

struct Pair {
    uint64_t v1, v2;
};

struct Pair makePair(uint64_t a, uint64_t b) {
    struct Pair r;
    r.v1 = a;
    r.v2 = b;
    return r;
}

struct Pair solvePell(int n) {
    int x = (int) sqrt(n);

    if (x * x == n) {
        // n is a perfect square - no solution other than 1,0
        return makePair(1, 0);
    } else {
        // there are non-trivial solutions
        int y = x;
        int z = 1;
        int r = 2 * x;
        struct Pair e = makePair(1, 0);
        struct Pair f = makePair(0, 1);
        uint64_t a = 0;
        uint64_t b = 0;

        while (true) {
            y = r * z - y;
            z = (n - y * y) / z;
            r = (x + y) / z;
            e = makePair(e.v2, r * e.v2 + e.v1);
            f = makePair(f.v2, r * f.v2 + f.v1);
            a = e.v2 + x * f.v2;
            b = f.v2;
            if (a * a - n * b * b == 1) {
                break;
            }
        }

        return makePair(a, b);
    }
}

void test(int n) {
    struct Pair r = solvePell(n);
    printf("x^2 - %3d * y^2 = 1 for x = %21llu and y = %21llu\n", n, r.v1, r.v2);
}

int main() {
    test(61);
    test(109);
    test(181);
    test(277);

    return 0;
}


# Input: {svg, minx, miny, maxx, maxy}
def svg:
  # viewBox = <min-x> <min-y> <width> <height>
  "<svg viewBox='\(.minx - 4|floor) \(.miny - 4 |floor) \(6 + .maxx - .minx|ceil) \(6 + .maxy - .miny|ceil)'",
  "     preserveAspectRatio='xMinYmin meet'",
  "     xmlns='http://www.w3.org/2000/svg' >",
  .svg,
  "</svg>" ;

# Input: an array of [x,y] points
def minmax:
  {minx: (map(.[0])|min),
   miny: (map(.[1])|min),
   maxx: (map(.[0])|max),
   maxy: (map(.[1])|max)} ;

# Input: an array of [x,y] points
def Polyline($fill; $stroke; $transform):
  def rnd: 1000*.|round/1000;
  def linearize: map( map(rnd) | join(" ") ) | join(", ");

  "<polyline points='"
   + linearize
   + "'\n style='fill:\($fill); stroke: \($stroke); stroke-width:3;'"
   + "\n transform='\($transform)' />" ;

# Output: {minx, miny, maxx, maxy, svg}
def pentagram($dim):
  (8 * (1|atan)) as $tau
  | 5 as $sides
  | [ (0, 2, 4, 1, 3, 0)
     | [  0.9 * $dim * (($tau * $v / $sides) | cos),
          0.9 * $dim * (($tau * $v / $sides) | sin) ] ]
  | minmax
    + {svg: Polyline("seashell"; "blue"; "rotate(-18)" )} ;

pentagram(200)
| svg


using Luxor

function drawpentagram(path::AbstractString, w::Integer=1000, h::Integer=1000)
    Drawing(h, w, path)
    origin()
    setline(16)

    # To get a different color border from the fill, draw twice, first with fill, then without.
    sethue("aqua")
    star(0, 0, 500, 5, 0.39, 3pi/10, :fill)

    sethue("navy")
    verts = star(0, 0, 500, 5, 0.5, 3pi/10, vertices=true)
    poly([verts[i] for i in [1,5,9,3,7,1]], :stroke)
    finish()
    preview()
end

drawpentagram("data/pentagram.png")


// version 1.1.2

import java.awt.*
import java.awt.geom.Path2D
import javax.swing.*

class Pentagram : JPanel() {
    init {
        preferredSize = Dimension(640, 640)
        background = Color.white
    }

    private fun drawPentagram(g: Graphics2D, len: Int, x: Int, y: Int,
                              fill: Color, stroke: Color) {
        var x2 = x.toDouble()
        var y2 = y.toDouble()
        var angle = 0.0
        val p = Path2D.Float()
        p.moveTo(x2, y2)

        for (i in 0..4) {
            x2 += Math.cos(angle) * len
            y2 += Math.sin(-angle) * len
            p.lineTo(x2, y2)
            angle -= Math.toRadians(144.0)
        }

        p.closePath()
        with(g) {
            color = fill
            fill(p)
            color = stroke
            draw(p)
        }
    }

    override fun paintComponent(gg: Graphics) {
        super.paintComponent(gg)
        val g = gg as Graphics2D
        g.setRenderingHint(RenderingHints.KEY_ANTIALIASING,
                           RenderingHints.VALUE_ANTIALIAS_ON)
        g.stroke = BasicStroke(5.0f, BasicStroke.CAP_ROUND, 0)
        drawPentagram(g, 500, 70, 250, Color(0x6495ED), Color.darkGray)
    }
}

fun main(args: Array<String>) {
    SwingUtilities.invokeLater {
        val f = JFrame()
        with(f) {
            defaultCloseOperation = JFrame.EXIT_ON_CLOSE
            title = "Pentagram"
            isResizable = false
            add(Pentagram(), BorderLayout.CENTER)
            pack()
            setLocationRelativeTo(null)
            isVisible = true
        }
    }
}


#include <iomanip>
#include <iostream>
#include <tuple>

std::tuple<uint64_t, uint64_t> solvePell(int n) {
    int x = (int)sqrt(n);

    if (x * x == n) {
        // n is a perfect square - no solution other than 1,0
        return std::make_pair(1, 0);
    }

    // there are non-trivial solutions
    int y = x;
    int z = 1;
    int r = 2 * x;
    std::tuple<uint64_t, uint64_t> e = std::make_pair(1, 0);
    std::tuple<uint64_t, uint64_t> f = std::make_pair(0, 1);
    uint64_t a = 0;
    uint64_t b = 0;

    while (true) {
        y = r * z - y;
        z = (n - y * y) / z;
        r = (x + y) / z;
        e = std::make_pair(std::get<1>(e), r * std::get<1>(e) + std::get<0>(e));
        f = std::make_pair(std::get<1>(f), r * std::get<1>(f) + std::get<0>(f));
        a = std::get<1>(e) + x * std::get<1>(f);
        b = std::get<1>(f);
        if (a * a - n * b * b == 1) {
            break;
        }
    }

    return std::make_pair(a, b);
}

void test(int n) {
    auto r = solvePell(n);
    std::cout << "x^2 - " << std::setw(3) << n << " * y^2 = 1 for x = " << std::setw(21) << std::get<0>(r) << " and y = " << std::setw(21) << std::get<1>(r) << '\n';
}

int main() {
    test(61);
    test(109);
    test(181);
    test(277);

    return 0;
}


local cos, sin, floor, pi = math.cos, math.sin, math.floor, math.pi

function Bitmap:render()
  for y = 1, self.height do
    print(table.concat(self.pixels[y]))
  end
end

function Bitmap:pentagram(x, y, radius, rotation, outlcolor, fillcolor)
  local function pxy(i) return x+radius*cos(i*pi*2/5+rotation), y+radius*sin(i*pi*2/5+rotation) end
  local x1, y1 = pxy(0)
  for i = 1, 5 do
    local x2, y2 = pxy(i*2) -- btw: pxy(i) ==> pentagon
    self:line(floor(x1*2), floor(y1), floor(x2*2), floor(y2), outlcolor)
    x1, y1 = x2, y2
  end
  self:floodfill(floor(x*2), floor(y), fillcolor)
  radius = radius / 2
  for i = 1, 5 do
    x1, y1 = pxy(i)
    self:floodfill(floor(x1*2), floor(y1), fillcolor)
  end
end

bitmap = Bitmap(40*2,40)
bitmap:clear(".")
bitmap:pentagram(20, 22, 20, -pi/2, "@", '+')
bitmap:render()


with(geometry):
RegularStarPolygon(middle, 5/2, point(c, 0, 0), 1):
v := [seq(coordinates(i), i in DefinedAs(middle))]:
pentagram := plottools[rotate](plottools[polygon](v), Pi/2):
plots[display](pentagram, colour = yellow, axes = none);


Graphics[{
    EdgeForm[Directive[Thickness[0.01], RGBColor[0, 0, 1]]],(*Edge coloring*)
    RGBColor[0.5, 0.5, .50], (*Fill coloring*)
    Polygon[AnglePath[Table[6 Pi/5, 5]]]}
    ]


using System;
using System.Numerics;

static class Program
{
    static void Fun(ref BigInteger a, ref BigInteger b, int c)
    {
        BigInteger t = a; a = b; b = b * c + t;
    }

    static void SolvePell(int n, ref BigInteger a, ref BigInteger b)
    {
        int x = (int)Math.Sqrt(n), y = x, z = 1, r = x << 1;
        BigInteger e1 = 1, e2 = 0, f1 = 0, f2 = 1;
        while (true)
        {
            y = r * z - y; z = (n - y * y) / z; r = (x + y) / z;
            Fun(ref e1, ref e2, r); Fun(ref f1, ref f2, r); a = f2; b = e2; Fun(ref b, ref a, x);
            if (a * a - n * b * b == 1) return;
        }
    }

    static void Main()
    {
        BigInteger x, y; foreach (int n in new[] { 61, 109, 181, 277 })
        {
            SolvePell(n, ref x, ref y);
            Console.WriteLine("x^2 - {0,3} * y^2 = 1 for x = {1,27:n0} and y = {2,25:n0}", n, x, y);
        }
    }
}


import std.bigint;
import std.math;
import std.stdio;

void fun(ref BigInt a, ref BigInt b, int c) {
    auto t = a;
    a = b;
    b = b * c + t;
}

void solvePell(int n, ref BigInt a, ref BigInt b) {
    int x = cast(int) sqrt(cast(real) n);
    int y = x;
    int z = 1;
    int r = x << 1;
    BigInt e1 = 1;
    BigInt e2 = 0;
    BigInt f1 = 0;
    BigInt f2 = 1;
    while (true) {
        y = r * z - y;
        z = (n - y * y) / z;
        r = (x + y) / z;
        fun(e1, e2, r);
        fun(f1, f2, r);
        a = f2;
        b = e2;
        fun(b, a, x);
        if (a * a - n * b * b == 1) {
            return;
        }
    }
}

void main() {
    BigInt x, y;
    foreach(n; [61, 109, 181, 277]) {
        solvePell(n, x, y);
        writefln("x^2 - %3d * y^2 = 1 for x = %27d and y = %25d", n, x, y);
    }
}


import libgd
from math import sin, cos, degToRad

const
  width = 500
  height = width
  outerRadius = 200

proc main() =

  proc calcPosition(x: int, y: int, radius: int, posAngle: float): (cint, cint) =
    var width = int(radius.float * sin(degToRad(posAngle)))
    var height = int(radius.float * cos(degToRad(posAngle)))
    return (cast[cint](x + width), cast[cint](y - height))

  proc getPentagonPoints(startAngle = 0, radius: int): array[5, array[2, int]] =
    let spacingAngle = 360 / 5

    var posAngle = (90 - startAngle).float

    var n = 0
    var points: array[5, array[2, int]]
    while n < 5:
      (points[n][0], points[n][1]) = calcPosition(250, 250, radius, posAngle)
      n += 1
      posAngle -= spacingAngle

    return points

  let outerPentagon = getPentagonPoints(18, outerRadius) # rotate 18 degrees
  let innerPentagon = getPentagonPoints(54, int((cos(degToRad(72.0))/cos(degToRad(36.0))) * outerRadius)) # rotate 54 degrees

  var pentagram: array[10, array[2, int]]
  var n = 0
  for i in countup(0, 4):
    pentagram[n] = outerPentagon[i]
    inc(n)
    pentagram[n] = innerPentagon[i]
    inc(n)

  withGd imageCreate(width, height) as img:
    discard img.setColor(255, 255, 255)

    let black = img.setColor(0x404040)
    let blue = img.setColor(0x6495ed)

    img.drawPolygon(
      points=pentagram,
      color=blue,
      fill=true,
      open=false)

    img.setThickness(4)

    img.drawPolygon(
      points=pentagram,
      color=black,
      fill=false,
      open=false)

    img.drawPolygon(
      points=innerPentagon,
      color=black,
      fill=false,
      open=false)

    let png_out = open("pentagram.png", fmWrite)
    img.writePng(png_out)

    png_out.close()

main()


/* REXX ***************************************************************
* Create a BMP file showing a pentagram
**********************************************************************/
pentagram='pentagram.bmp'
'erase' pentagram
s='424d4600000000000000360000002800000038000000280000000100180000000000'X
s=s'1000000000000000000000000000000000000000'x
Say 'sl='length(s)
z.0=0
white='ffffff'x
red  ='00ff00'x
green='ff0000'x
blue ='0000ff'x
rd6=copies(rd,6)
m=133
m=80
n=80
hor=m*8      /* 56 */
ver=n*8      /* 40 */
Say 'hor='hor
Say 'ver='ver
Say 'sl='length(s)
s=overlay(lend(hor),s,19,4)
s=overlay(lend(ver),s,23,4)
Say 'sl='length(s)
z.=copies('ffffff'x,3192%3)
z.=copies('ffffff'x,8*m)
z.0=648
s72 =RxCalcsin(72,,'D')
c72 =RxCalccos(72,,'D')
s144=RxCalcsin(144,,'D')
c144=RxCalccos(144,,'D')
xm=300
ym=300
r=200
p.0x.1=xm
p.0y.1=ym+r
p.0x.2=format(xm+r*s72,3,0)
p.0y.2=format(ym+r*c72,3,0)
p.0x.3=format(xm+r*s144,3,0)
p.0y.3=format(ym+r*c144,3,0)
p.0x.4=format(xm-r*s144,3,0)
p.0y.4=p.0y.3
p.0x.5=format(xm-r*s72,3,0)
p.0y.5=p.0y.2
Do i=1 To 5
  Say p.0x.i p.0y.i
  End
Call line p.0x.1,p.0y.1,p.0x.3,p.0y.3
Call line p.0x.1,p.0y.1,p.0x.4,p.0y.4
Call line p.0x.2,p.0y.2,p.0x.4,p.0y.4
Call line p.0x.2,p.0y.2,p.0x.5,p.0y.5
Call line p.0x.3,p.0y.3,p.0x.5,p.0y.5

Do i=1 To z.0
  s=s||z.i
  End

Call lineout pentagram,s
Call lineout pentagram
Exit

lend:
Return reverse(d2c(arg(1),4))

line: Procedure Expose z. red green blue
Parse Arg x0, y0, x1, y1
Say 'line'  x0  y0  x1  y1
dx = abs(x1-x0)
dy = abs(y1-y0)
if x0 < x1 then sx = 1
           else sx = -1
if y0 < y1 then sy = 1
           else sy = -1
err = dx-dy

Do Forever
  xxx=x0*3+2
  Do yy=y0-1 To y0+1
    z.yy=overlay(copies(blue,5),z.yy,xxx)
    End
  if x0 = x1 & y0 = y1 Then Leave
  e2 = 2*err
  if e2 > -dy then do
    err = err - dy
    x0 = x0 + sx
    end
  if e2 < dx then do
    err = err + dx
    y0 = y0 + sy
    end
  end
Return
::requires RxMath Library


program Pells_equation;

{$APPTYPE CONSOLE}

uses
  System.SysUtils,
  Velthuis.BigIntegers;

type
  TPellResult = record
    x, y: BigInteger;
  end;

function SolvePell(nn: UInt64): TPellResult;
var
  n, x, y, z, r, e1, e2, f1,  t, u, a, b: BigInteger;
begin
  n := nn;
  x := nn;
  x := BigInteger.Sqrt(x);
  y := BigInteger(x);
  z := BigInteger.One;
  r := x shl 1;

  e1 := BigInteger.One;
  e2 := BigInteger.Zero;
  f1 := BigInteger.Zero;
  b := BigInteger.One;

  while True do
  begin
    y := (r * z) - y;
    z := (n - (y * y)) div z;
    r := (x + y) div z;

    u := BigInteger(e1);
    e1 := BigInteger(e2);
    e2 := (r * e2) + u;

    u := BigInteger(f1);
    f1 := BigInteger(b);

    b := r * b + u;
    a := e2 + x * b;

    t := (a * a) - (n * b * b);

    if t = 1 then
    begin
      with Result do
      begin
        x := BigInteger(a);
        y := BigInteger(b);
      end;
      Break;
    end;
  end;
end;

const
  ns: TArray<UInt64> = [61, 109, 181, 277];
  fmt = 'x^2 - %3d*y^2 = 1 for x = %-21s and y = %s';

begin
  for var n in ns do
    with SolvePell(n) do
      writeln(format(fmt, [n, x.ToString, y.ToString]));

  {$IFNDEF UNIX} readln; {$ENDIF}
end.


USING: formatting kernel locals math math.functions sequences ;

:: solve-pell ( n -- a b )

    n sqrt >integer :> x!
    x :> y!
    1 :> z!
    2 x * :> r!

    1 0 :> ( e1! e2! )
    0 1 :> ( f1! f2! )
    0 0 :> ( a! b! )

    [ a sq b sq n * - 1 = ] [

        r z * y - y!
        n y sq - z / floor z!
        x y + z / floor r!

        e2 r e2 * e1 + e2! e1!
        f2 r f2 * f1 + f2! f1!

        e2 x f2 * + a!
        f2 b!

    ] until
    a b ;

{ 61 109 181 277 } [
    dup solve-pell
    "x^2 - %3d*y^2 = 1 for x = %-21d and y = %d\n" printf
] each


use SVG;

my $tau   = 2 * 4*atan2(1, 1);
my $dim   = 200;
my $sides = 5;

for $v (0, 2, 4, 1, 3, 0) {
    push @vx, 0.9 * $dim * cos($tau * $v / $sides);
    push @vy, 0.9 * $dim * sin($tau * $v / $sides);
}

my $svg= SVG->new( width => 2*$dim, height => 2*$dim);

my $points = $svg->get_path(
    x     => \@vx,
    y     => \@vy,
    -type => 'polyline',
);

$svg->rect (
    width  => "100%",
    height => "100%",
    style  => {
        'fill' => 'bisque'
    }
);

$svg->polyline (
    %$points,
    style => {
        'fill'         => 'seashell',
        'stroke'       => 'blue',
        'stroke-width' => 3,
    },
    transform => "translate($dim,$dim) rotate(-18)"
);

open  $fh, '>', 'pentagram.svg';
print $fh  $svg->xmlify(-namespace=>'svg');
close $fh;


--
-- demo\rosetta\Pentagram.exw
-- ==========================
--
-- Start/stop rotation by pressing space. Resizeable.
-- ZXYV stop any rotation and orient up/down/left/right.
--
with javascript_semantics
include pGUI.e

Ihandle dlg, canvas, timer
cdCanvas cdcanvas

integer rot = 0
enum FILL,BORDER
constant colours = {CD_BLUE,CD_RED},
         modes = {CD_FILL,CD_CLOSED_LINES}

function redraw_cb(Ihandle /*ih*/, integer /*posx*/, /*posy*/)
    integer {w, h} = IupGetIntInt(canvas, "DRAWSIZE"),
            cx = floor(w/2),
            cy = floor(h/2),
            radius = floor(min(cx,cy)*0.9)
    cdCanvasActivate(cdcanvas)
    cdCanvasClear(cdcanvas)
    cdCanvasSetFillMode(cdcanvas, CD_WINDING)
    cdCanvasSetLineWidth(cdcanvas, round(radius/100)+1)
    for mode=FILL to BORDER do
        cdCanvasSetForeground(cdcanvas,colours[mode])
        cdCanvasBegin(cdcanvas,modes[mode])
        for a=90 to 666 by 144 do
            atom r = (a+rot)*CD_DEG2RAD,
                 x = floor(radius*cos(r)+cx),
                 y = floor(radius*sin(r)+cy)
            cdCanvasVertex(cdcanvas, x, y)
        end for
        cdCanvasEnd(cdcanvas)
    end for
    cdCanvasFlush(cdcanvas)
    return IUP_DEFAULT
end function

function map_cb(Ihandle ih)
    cdcanvas = cdCreateCanvas(CD_IUP, ih)
    cdCanvasSetBackground(cdcanvas, CD_PARCHMENT)
    return IUP_DEFAULT
end function

function timer_cb(Ihandle /*ih*/)
    rot = mod(rot+359,360)
    IupRedraw(canvas)
    return IUP_IGNORE
end function

function key_cb(Ihandle /*ih*/, atom c)
    if c=K_ESC then return IUP_CLOSE end if
    c = upper(c)
    if c=' ' then
        IupSetInt(timer,"RUN",not IupGetInt(timer,"RUN"))
    else
        c = find(c,"ZYXV")
        if c then
            IupSetInt(timer,"RUN",false)
            rot = (c-1)*90
            IupRedraw(canvas)
        end if
    end if
    return IUP_CONTINUE
end function

procedure main()
    IupOpen()
    canvas = IupCanvas("RASTERSIZE=640x640")
    IupSetCallback(canvas, "MAP_CB", Icallback("map_cb"))
    IupSetCallback(canvas, "ACTION", Icallback("redraw_cb"))
    dlg = IupDialog(canvas,`TITLE="Pentagram"`)
    IupSetCallback(dlg, "KEY_CB", Icallback("key_cb"))
    IupShow(dlg)
    IupSetAttribute(canvas, "RASTERSIZE", NULL)
    timer = IupTimer(Icallback("timer_cb"), 80, active:=false)
    if platform()!=JS then
        IupMainLoop()
        IupClose()
    end if
end procedure

main()


Sub Fun(Byref a As LongInt, Byref b As LongInt, c As Integer)
    Dim As LongInt t
    t = a : a = b : b = b * c + t
End Sub

Sub SolvePell(n As Integer, Byref a As LongInt, Byref b As LongInt)
    Dim As Integer z, r
    Dim As LongInt x, y, e1, e2, f1, f2
    x = Sqr(n) : y = x : z  = 1 : r  = 2 * x
    e1 = 1 : e2 = 0 : f1 = 0 : f2 = 1
    While True
        y = r * z - y : z = (n - y * y) / z : r = (x + y) / z
        Fun(e1, e2, r) : Fun(f1, f2, r) : a = f2 : b = e2 : Fun(b, a, x)
        If a * a - n * b * b = 1 Then Exit Sub
    Wend
End Sub

Dim As Integer i
Dim As LongInt x, y
Dim As Integer n(0 To 3) = {61, 109, 181, 277}
For i = 0 To 3 ''n In {61, 109, 181, 277}
    SolvePell(n(i), x, y)
    Print Using "x^2 - ### * y^2 = 1 for x = ##################### and y = #####################"; n(i); x; y
Next i


package main

import (
    "fmt"
    "math/big"
)

var big1 = new(big.Int).SetUint64(1)

func solvePell(nn uint64) (*big.Int, *big.Int) {
    n := new(big.Int).SetUint64(nn)
    x := new(big.Int).Set(n)
    x.Sqrt(x)
    y := new(big.Int).Set(x)
    z := new(big.Int).SetUint64(1)
    r := new(big.Int).Lsh(x, 1)

    e1 := new(big.Int).SetUint64(1)
    e2 := new(big.Int)
    f1 := new(big.Int)
    f2 := new(big.Int).SetUint64(1)

    t := new(big.Int)
    u := new(big.Int)
    a := new(big.Int)
    b := new(big.Int)
    for {
        t.Mul(r, z)
        y.Sub(t, y)
        t.Mul(y, y)
        t.Sub(n, t)
        z.Quo(t, z)
        t.Add(x, y)
        r.Quo(t, z)
        u.Set(e1)
        e1.Set(e2)
        t.Mul(r, e2)
        e2.Add(t, u)
        u.Set(f1)
        f1.Set(f2)
        t.Mul(r, f2)
        f2.Add(t, u)
        t.Mul(x, f2)
        a.Add(e2, t)
        b.Set(f2)
        t.Mul(a, a)
        u.Mul(n, b)
        u.Mul(u, b)
        t.Sub(t, u)
        if t.Cmp(big1) == 0 {
            return a, b
        }
    }
}

func main() {
    ns := []uint64{61, 109, 181, 277}
    for _, n := range ns {
        x, y := solvePell(n)
        fmt.Printf("x^2 - %3d*y^2 = 1 for x = %-21s and y = %s\n", n, x, y)
    }
}


%!PS-Adobe-3.0 EPSF
%%BoundingBox: 0 0 200 600

/n 5 def % 5-star; can be set to other odd numbers

/s { gsave } def
/r { grestore } def
/g { .7 setgray } def
/t { 100 exch translate } def
/p {
	180 90 n div sub rotate
	0 0 moveto
	n { 0 160 rlineto 180 180 n div sub rotate } repeat
	closepath
} def

s 570 t p s g eofill r stroke r		% even-odd fill
s 370 t p s g fill r stroke r		% non-zero fill
s 170 t p s 2 setlinewidth stroke r g fill r % non-zero, but hide inner strokes

%%EOF


import turtle

turtle.bgcolor("green")
t = turtle.Turtle()
t.color("red", "blue")
t.begin_fill()
for i in range(0, 5):
    t.forward(200)
    t.right(144)
t.end_fill()


[ $ "turtleduck.qky" loadfile ] now!

[ [ 1 1
    30 times
       [ tuck + ]
   swap join ] constant
   do ]                is phi       (    --> n/d )

[ 5 times
    [ 2dup walk
      1 5 turn
      2dup walk
      3 5 turn ]
  2drop ]             is star      ( n/d -->     )

[ 5 times
    [ 2dup walk
      2 5 turn ]
  2drop ]             is pentagram ( n/d -->     )

turtle
' [ 79 126 229 ] fill [ 200 1 star ]
10 wide
-1 10 turn
200 1 phi v* phi v* pentagram
1 10 turn


#lang racket
(require 2htdp/image)

(overlay
 (star-polygon 100 5 2 "outline" (make-pen "blue" 4 "solid" "round" "round"))
 (star-polygon 100 5 2 "solid" "cyan"))


use SVG;

constant $dim = 200;
constant $sides = 5;

my @vertices = map { 0.9 * $dim * cis($_ * τ / $sides) }, ^$sides;

my @points   = map |*.reals.fmt("%0.3f"),
  flat @vertices[0, 2 ... *], @vertices[1, 3 ... *], @vertices[0];

say SVG.serialize(
    svg => [
        :width($dim*2), :height($dim*2),
        :rect[:width<100%>, :height<100%>, :style<fill:bisque;>],
        :polyline[ :points(@points.join: ','),
          :style("stroke:blue; stroke-width:3; fill:seashell;"),
          :transform("translate($dim,$dim) rotate(-90)")
        ],
    ],
);


NB. sqrt representation for continued fraction
sqrt_cf =: 3 : 0
rep=. '' [ 'm d'=. 0 1 [ a =. a0=. <. %: y
while. a ~: +: a0 do.
  rep=. rep , a=. <. (a0+m) % d=. d %~ y - *: m=. m -~ a*d
end. a0;rep
)

NB. find x,y such that x^2 - n*y^2 = 1 using continued fractions
pell =: 3 : 0
n =. 1 [ 'a0 as' =. x: &.> sqrt_cf y
while. 1 do. cs =. 2 x: (+%)/\ a0, n$as NB. convergents
  if. # sols =. I. 1 = (*: cs) +/ . * 1 , -y do. cs {~ {. sols return. end.
  n =. +: n
end.
)


import java.math.BigInteger;
import java.text.NumberFormat;
import java.util.ArrayList;
import java.util.List;

public class PellsEquation {

    public static void main(String[] args) {
        NumberFormat format = NumberFormat.getInstance();
        for ( int n : new int[] {61, 109, 181, 277, 8941} ) {
            BigInteger[] pell = pellsEquation(n);
            System.out.printf("x^2 - %3d * y^2 = 1 for:%n    x = %s%n    y = %s%n%n", n,  format.format(pell[0]),  format.format(pell[1]));
        }
    }

    private static final BigInteger[] pellsEquation(int n) {
        int a0 = (int) Math.sqrt(n);
        if ( a0*a0 == n ) {
            throw new IllegalArgumentException("ERROR 102:  Invalid n = " + n);
        }
        List<Integer> continuedFrac = continuedFraction(n);
        int count = 0;
        BigInteger ajm2 = BigInteger.ONE;
        BigInteger ajm1 = new BigInteger(a0 + "");
        BigInteger bjm2 = BigInteger.ZERO;
        BigInteger bjm1 = BigInteger.ONE;
        boolean stop = (continuedFrac.size() % 2 == 1);
        if ( continuedFrac.size() == 2 ) {
            stop = true;
        }
        while ( true ) {
            count++;
            BigInteger bn = new BigInteger(continuedFrac.get(count) + "");
            BigInteger aj = bn.multiply(ajm1).add(ajm2);
            BigInteger bj = bn.multiply(bjm1).add(bjm2);
            if ( stop && (count == continuedFrac.size()-2 || continuedFrac.size() == 2) ) {
                return new BigInteger[] {aj, bj};
            }
            else if (continuedFrac.size() % 2 == 0 && count == continuedFrac.size()-2 ) {
                stop = true;
            }
            if ( count == continuedFrac.size()-1 ) {
                count = 0;
            }
            ajm2 = ajm1;
            ajm1 = aj;
            bjm2 = bjm1;
            bjm1 = bj;
        }
    }

    private static final List<Integer> continuedFraction(int n) {
        List<Integer> answer = new ArrayList<Integer>();
        int a0 = (int) Math.sqrt(n);
        answer.add(a0);
        int a = -a0;
        int aStart = a;
        int b = 1;
        int bStart = b;

        while ( true ) {
            //count++;
            int[] values = iterateFrac(n, a, b);
            answer.add(values[0]);
            a = values[1];
            b = values[2];
            if (a == aStart && b == bStart) break;
        }
        return answer;
    }

    //  array[0] = new part of cont frac
    //  array[1] = new a
    //  array[2] = new b
    private static final int[] iterateFrac(int n, int a, int b) {
        int x = (int) Math.floor((b * Math.sqrt(n) - b * a)/(n - a * a));
        int[] answer = new int[3];
        answer[0] = x;
        answer[1] = -(b * a + x *(n - a * a)) / b;
        answer[2] = (n - a * a) / b;
        return answer;
    }

}


Red [
	Source:     https://github.com/vazub/rosetta-red
	Tabs:       4
	Needs:       'View
]

canvas: 500x500
center: as-pair canvas/x / 2 canvas/y / 2
radius: 200

points: collect [
	repeat vertex 10 [
		angle: vertex * 36 + 18 ;-- +18 is required for pentagram rotation
		either vertex // 2 = 1 [
			keep as-pair (cosine angle) * radius + center/x (sine angle) * radius + center/y
		][
			keep as-pair (cosine angle) * radius * 0.382 + center/x (sine angle) * radius * 0.382 + center/y
		]
	]
]

view [
	title "Pentagram"
	base canvas white
	draw compose/deep [
		fill-pen mint
		polygon (points)
		line-width 3
		line (points/1) (points/5) (points/9) (points/3) (points/7) (points/1)
	]
]


/* REXX ***************************************************************
* Create a BMP file showing a pentagram
**********************************************************************/
Parse Version v
If pos('Regina',v)>0 Then
  pentagram='pentagrama.bmp'
Else
  pentagram='pentagramx.bmp'
'erase' pentagram
s='424d4600000000000000360000002800000038000000280000000100180000000000'X||,
  '1000000000000000000000000000000000000000'x
Say 'sl='length(s)
z.0=0
white='ffffff'x
red  ='00ff00'x
green='ff0000'x
blue ='0000ff'x
rd6=copies(rd,6)
m=133
m=80
n=80
hor=m*8      /* 56 */
ver=n*8      /* 40 */
Say 'hor='hor
Say 'ver='ver
Say 'sl='length(s)
s=overlay(lend(hor),s,19,4)
s=overlay(lend(ver),s,23,4)
Say 'sl='length(s)
z.=copies('ffffff'x,3192%3)
z.=copies('ffffff'x,8*m)
z.0=648
pi_5=2*3.14159/5
s72 =sin(pi_5  )
c72 =cos(pi_5  )
s144=sin(pi_5*2)
c144=cos(pi_5*2)
xm=300
ym=300
r=200
p.0x.1=xm
p.0y.1=ym+r

p.0x.2=format(xm+r*s72,3,0)
p.0y.2=format(ym+r*c72,3,0)
p.0x.3=format(xm+r*s144,3,0)
p.0y.3=format(ym+r*c144,3,0)
p.0x.4=format(xm-r*s144,3,0)
p.0y.4=p.0y.3
p.0x.5=format(xm-r*s72,3,0)
p.0y.5=p.0y.2
Do i=1 To 5
  Say p.0x.i p.0y.i
  End
Call line p.0x.1,p.0y.1,p.0x.3,p.0y.3
Call line p.0x.1,p.0y.1,p.0x.4,p.0y.4
Call line p.0x.2,p.0y.2,p.0x.4,p.0y.4
Call line p.0x.2,p.0y.2,p.0x.5,p.0y.5
Call line p.0x.3,p.0y.3,p.0x.5,p.0y.5

Do i=1 To z.0
  s=s||z.i
  End

Call lineout pentagram,s
Call lineout pentagram
Exit

lend:
Return reverse(d2c(arg(1),4))

line: Procedure Expose z. red green blue
Parse Arg x0, y0, x1, y1
Say 'line'  x0  y0  x1  y1
dx = abs(x1-x0)
dy = abs(y1-y0)
if x0 < x1 then sx = 1
           else sx = -1
if y0 < y1 then sy = 1
           else sy = -1
err = dx-dy

Do Forever
  xxx=x0*3+2
  Do yy=y0-1 To y0+1
    z.yy=overlay(copies(blue,5),z.yy,xxx)
    End
  if x0 = x1 & y0 = y1 Then Leave
  e2 = 2*err
  if e2 > -dy then do
    err = err - dy
    x0 = x0 + sx
    end
  if e2 < dx then do
    err = err + dx
    y0 = y0 + sy
    end
  end
Return

sin: Procedure
/* REXX ****************************************************************
* Return sin(x<,p>) -- with the specified precision
***********************************************************************/
  Parse Arg x,prec
  If prec='' Then prec=9
  Numeric Digits (2*prec)
  Numeric Fuzz   3
  pi=3.14159
  Do While x>pi
    x=x-pi
    End
  Do While x<-pi
    x=x+pi
    End
  o=x
  u=1
  r=x
  Do i=3 By 2
    ra=r
    o=-o*x*x
    u=u*i*(i-1)
    r=r+(o/u)
    If r=ra Then Leave
    End
  Numeric Digits prec
  Return r+0

cos: Procedure
/* REXX ****************************************************************
* Return cos(x) -- with specified precision
***********************************************************************/
  Parse Arg x,prec
  If prec='' Then prec=9
  Numeric Digits (2*prec)
  Numeric Fuzz 3
  o=1
  u=1
  r=1
  Do i=1 By 2
    ra=r
    o=-o*x*x
    u=u*i*(i+1)
    r=r+(o/u)
    If r=ra Then Leave
    End
  Numeric Digits prec
  Return r+0

sqrt: Procedure
/* REXX ***************************************************************
* EXEC to calculate the square root of a = 2 with high precision
**********************************************************************/
  Parse Arg x,prec
  If prec<9 Then prec=9
  prec1=2*prec
  eps=10**(-prec1)
  k = 1
  Numeric Digits 3
  r0= x
  r = 1
  Do i=1 By 1 Until r=r0 | (abs(r*r-x)<eps)
    r0 = r
    r  = (r + x/r) / 2
    k  = min(prec1,2*k)
    Numeric Digits (k + 5)
    End
  Numeric Digits prec
  Return r+0


# If $j is 0, then an error condition is raised;
# otherwise, assuming infinite-precision integer arithmetic,
# if the input and $j are integers, then the result will be an integer.
def idivide($i; $j):
  ($i % $j) as $mod
  | ($i - $mod) / $j ;
def idivide($j):
  idivide(.; $j);

# input should be a non-negative integer for accuracy
# but may be any non-negative finite number
def isqrt:
  def irt:
  . as $x
    | 1 | until(. > $x; . * 4) as $q
    | {$q, $x, r: 0}
    | until( .q <= 1;
        .q |= idivide(4)
        | .t = .x - .r - .q
        | .r |= idivide(2)
        | if .t >= 0
          then .x = .t
          | .r += .q
          else .
          end)
    | .r ;
  if type == "number" and (isinfinite|not) and (isnan|not) and . >= 0
  then irt
  else "isqrt requires a non-negative integer for accuracy" | error
  end ;


function pell(n)
    x = BigInt(floor(sqrt(n)))
    y, z, r = x, BigInt(1), x << 1
    e1, e2, f1, f2 = BigInt(1), BigInt(0), BigInt(0), BigInt(1)
    while true
        y = r * z - y
        z = div(n - y * y, z)
        r = div(x + y, z)
        e1, e2 = e2, e2 * r + e1
        f1, f2 = f2, f2 * r + f1
        a, b = f2, e2
        b, a = a, a * x + b
        if a * a - n * b * b == 1
            return a, b
        end
    end
end

for target in BigInt[61, 109, 181, 277]
    x, y = pell(target)
    println("x\u00b2 - $target", "y\u00b2 = 1 for x = $x and y = $y")
end


# Project : Pentagram

load "guilib.ring"

paint = null

new qapp
        {
        win1 = new qwidget() {
                  setwindowtitle("Pentagram")
                  setgeometry(100,100,500,600)
                  label1 = new qlabel(win1) {
                              setgeometry(10,10,400,400)
                              settext("")
                  }
                  new qpushbutton(win1) {
                          setgeometry(150,500,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(5)
        }
        paint = new qpainter() {
                  begin(p1)
                  setpen(pen)

        nn = 165
        cx = 800
        cy = 600
        phi = 54

        color = new qcolor()
        color.setrgb(0, 0, 255,255)
        mybrush = new qbrush() {setstyle(1) setcolor(color)}
        setbrush(mybrush)

       for n = 1 to 5
             theta = fabs(180-144-phi)
	     p1x = floor(cx + nn * cos(phi * 0.01745329252))
	     p1y = floor(cy + nn * sin(phi * 0.01745329252))
	     p2x = floor(cx - nn * cos(theta * 0.01745329252))
	     p2y = floor(cy - nn * sin(theta * 0.01745329252))
	     phi+= 72
	     drawpolygon([[p1x,p1y],[cx,cy],[p2x,p2y]],0)
        next

        endpaint()
        }
        label1 { setpicture(p1) show() }
        return


import java.awt._
import java.awt.geom.Path2D

import javax.swing._

object Pentagram extends App {

  SwingUtilities.invokeLater(() =>
    new JFrame("Pentagram") {

      class Pentagram extends JPanel {
        setPreferredSize(new Dimension(640, 640))
        setBackground(Color.white)
        final private val degrees144 = Math.toRadians(144)

        override def paintComponent(gg: Graphics): Unit = {
          val g = gg.asInstanceOf[Graphics2D]

          def drawPentagram(g: Graphics2D, x: Int, y: Int, fill: Color): Unit = {
            var (_x, _y, angle) = (x, y, 0.0)
            val p = new Path2D.Float
            p.moveTo(_x, _y)
            for (i <- 0 until 5) {
              val (x2, y2) = (_x + (Math.cos(angle) * 500).toInt, _y + (Math.sin(-angle) * 500).toInt)
              p.lineTo(x2, y2)
              _x = x2
              _y = y2
              angle -= degrees144
            }
            p.closePath()
            g.setColor(fill)
            g.fill(p)
            g.setColor(Color.darkGray)
            g.draw(p)
          }

          super.paintComponent(gg)
          g.setRenderingHint(RenderingHints.KEY_ANTIALIASING, RenderingHints.VALUE_ANTIALIAS_ON)
          g.setStroke(new BasicStroke(5, BasicStroke.CAP_ROUND, BasicStroke.JOIN_MITER))
          drawPentagram(g, 70, 250, new Color(0x6495ED))
        }
      }

      add(new Pentagram, BorderLayout.CENTER)
      pack()
      setDefaultCloseOperation(WindowConstants.EXIT_ON_CLOSE)
      setLocationRelativeTo(null)
      setResizable(false)
      setVisible(true)
    }
  )

}