function gcd(a, b)
    if b == 0 then
        return a
    end
    return gcd(b, a % b)
end

function printArray(a)
    io.write('[')
    for i,v in pairs(a) do
        if i > 1 then
            io.write(', ')
        end
        io.write(v)
    end
    io.write(']')
    return nil
end

function removeAt(a, i)
    local na = {}
    for j,v in pairs(a) do
        if j ~= i then
            table.insert(na, v)
        end
    end
    return na
end

function yellowstone(sequenceCount)
    local yellow = {1, 2, 3}
    local num = 4
    local notYellow = {}
    local yellowSize = 3
    while yellowSize < sequenceCount do
        local found = -1
        for i,test in pairs(notYellow) do
            if gcd(yellow[yellowSize - 1], test) > 1 and gcd(yellow[yellowSize - 0], test) == 1 then
                found = i
                break
            end
        end
        if found >= 0 then
            table.insert(yellow, notYellow[found])
            notYellow = removeAt(notYellow, found)
            yellowSize = yellowSize + 1
        else
            while true do
                if gcd(yellow[yellowSize - 1], num) > 1 and gcd(yellow[yellowSize - 0], num) == 1 then
                    table.insert(yellow, num)
                    yellowSize = yellowSize + 1
                    num = num + 1
                    break
                end
                table.insert(notYellow, num)
                num = num + 1
            end
        end
    end
    return yellow
end

function main()
    print("First 30 values in the yellowstone sequence:")
    printArray(yellowstone(30))
    print()
end

main()


zz(n)={
	my(M=matrix(n,n),i,j,d=-1,start,end=n^2-1);
	while(ct--,
		M[i+1,j+1]=start;
		M[n-i,n-j]=end;
		start++;
		end--;
		i+=d;
		j-=d;
		if(i<0,
			i++;
			d=-d
		,
			if(j<0,
				j++;
				d=-d
			)
		);
		if(start>end,return(M))
	)
};


package main

import (
    "bytes"
    "fmt"
    "strings"
)

var in = `
00000000000000000000000000000000
01111111110000000111111110000000
01110001111000001111001111000000
01110000111000001110000111000000
01110001111000001110000000000000
01111111110000001110000000000000
01110111100000001110000111000000
01110011110011101111001111011100
01110001111011100111111110011100
00000000000000000000000000000000`

func main() {
    b := wbFromString(in, '1')
    b.zhangSuen()
    fmt.Println(b)
}

const (
    white = 0
    black = 1
)

type wbArray [][]byte // elements are white or black.

// parameter blk is character to read as black.  otherwise kinda rigid,
// expects ascii, leading newline, no trailing newline,
// takes color from low bit of character.
func wbFromString(s string, blk byte) wbArray {
    lines := strings.Split(s, "\n")[1:]
    b := make(wbArray, len(lines))
    for i, sl := range lines {
        bl := make([]byte, len(sl))
        for j := 0; j < len(sl); j++ {
            bl[j] = sl[j] & 1
        }
        b[i] = bl
    }
    return b
}

// rigid again, hard coded to output space for white, # for black,
// no leading or trailing newline.
var sym = [2]byte{
    white: ' ',
    black: '#',
}

func (b wbArray) String() string {
    b2 := bytes.Join(b, []byte{'\n'})
    for i, b1 := range b2 {
        if b1 > 1 {
            continue
        }
        b2[i] = sym[b1]
    }
    return string(b2)
}

// neighbor offsets
var nb = [...][2]int{
    2: {-1, 0}, // p2 offsets
    3: {-1, 1}, // ...
    4: {0, 1},
    5: {1, 1},
    6: {1, 0},
    7: {1, -1},
    8: {0, -1},
    9: {-1, -1}, // p9 offsets
}

func (b wbArray) reset(en []int) (rs bool) {
    var r, c int
    var p [10]byte

    readP := func() {
        for nx := 1; nx <= 9; nx++ {
            n := nb[nx]
            p[nx] = b[r+n[0]][c+n[1]]
        }
    }

    shiftRead := func() {
        n := nb[3]
        p[9], p[2], p[3] = p[2], p[3], b[r+n[0]][c+n[1]]
        n = nb[4]
        p[8], p[1], p[4] = p[1], p[4], b[r+n[0]][c+n[1]]
        n = nb[5]
        p[7], p[6], p[5] = p[6], p[5], b[r+n[0]][c+n[1]]
    }

    // returns "A", count of white->black transitions in circuit of neighbors
    // of an interior pixel b[r][c]
    countA := func() (ct byte) {
        bit := p[9]
        for nx := 2; nx <= 9; nx++ {
            last := bit
            bit = p[nx]
            if last == white {
                ct += bit
            }
        }
        return ct
    }

    // returns "B", count of black pixels neighboring interior pixel b[r][c].
    countB := func() (ct byte) {
        for nx := 2; nx <= 9; nx++ {
            ct += p[nx]
        }
        return ct
    }

    lastRow := len(b) - 1
    lastCol := len(b[0]) - 1

    mark := make([][]bool, lastRow)
    for r = range mark {
        mark[r] = make([]bool, lastCol)
    }

    for r = 1; r < lastRow; r++ {
        c = 1
        readP()
        for { // column loop
            m := false
            // test for failure of any of the five conditions,
            if !(p[1] == black) {
                goto markDone
            }
            if b1 := countB(); !(2 <= b1 && b1 <= 6) {
                goto markDone
            }
            if !(countA() == 1) {
                goto markDone
            }
            {
                e1, e2 := p[en[1]], p[en[2]]
                if !(p[en[0]]&e1&e2 == 0) {
                    goto markDone
                }
                if !(e1&e2&p[en[3]] == 0) {
                    goto markDone
                }
            }
            // no conditions failed, mark this pixel for reset
            m = true
            rs = true // and mark that image changes
        markDone:
            mark[r][c] = m
            c++
            if c == lastCol {
                break
            }
            shiftRead()
        }
    }
    if rs {
        for r = 1; r < lastRow; r++ {
            for c = 1; c < lastCol; c++ {
                if mark[r][c] {
                    b[r][c] = white
                }
            }
        }
    }
    return rs
}

var step1 = []int{2, 4, 6, 8}
var step2 = []int{4, 2, 8, 6}

func (b wbArray) zhangSuen() {
    for {
        rs1 := b.reset(step1)
        rs2 := b.reset(step2)
        if !rs1 && !rs2 {
            break
        }
    }
}


n = 100	// doors
ppa = 1	// next open door
p2 = 1

for i = 1 to n
	print "Door ", i, " is ";
	if i < p2 then
		print "closed."
	else
		ppa = ppa + 1
		p2 = ppa^2
		print "OPEN."
	end if
next


doors = array(0, 100);
for(i = 1; i <= 100; i++)
    for(j = i; j <= 100; j += i)
        doors(j) ~= 1;
print, where(doors);


state = {1, 2, 3};
MakeNext[state_List] := Module[{i = First[state], done = False, out},
  While[! done,
   If[FreeQ[state, i],
    If[GCD[Last[state], i] == 1,
     If[GCD[state[[-2]], i] > 1,
      out = Append[state, i];
      done = True;
      ]
     ]
    ];
   i++;
   ];
  out
  ]
Nest[MakeNext, state, 30 - 3]
ListPlot[%]


import math

proc yellowstone(n: int): seq[int] =
  assert n >= 3
  result = @[1, 2, 3]
  var present = {1, 2, 3}
  var start = 4
  while result.len < n:
    var candidate = start
    while true:
      if candidate notin present and gcd(candidate, result[^1]) == 1 and gcd(candidate, result[^2]) != 1:
        result.add candidate
        present.incl candidate
        while start in present: inc start
        break
      inc candidate

echo yellowstone(30)


use strict;
use warnings;
use feature 'say';

use List::Util qw(first);
use GD::Graph::bars;

use constant Inf  => 1e5;

sub gcd {
  my ($u, $v) = @_;
  while ($v) {
    ($u, $v) = ($v, $u % $v);
  }
  return abs($u);
}

sub yellowstone {
    my($terms) = @_;
    my @s = (1, 2, 3);
    my @used = (1) x 4;
    my $min  = 3;
    while (1) {
        my $index = first { not defined $used[$_] and gcd($_,$s[-2]) != 1 and gcd($_,$s[-1]) == 1 } $min .. Inf;
        $used[$index] = 1;
        $min = (first { not defined $used[$_] } 0..@used-1) || @used-1;
        push @s, $index;
        last if @s == $terms;
    }
    @s;
}

say "The first 30 terms in the Yellowstone sequence:\n" . join ' ', yellowstone(30);

my @data = ( [1..500], [yellowstone(500)]);
my $graph = GD::Graph::bars->new(800, 600);
$graph->set(
    title          => 'Yellowstone sequence',
    y_max_value    => 1400,
    x_tick_number  => 5,
    r_margin       => 10,
    dclrs          => [ 'blue' ],
) or die $graph->error;
my $gd = $graph->plot(\@data) or die $graph->error;

open my $fh, '>', 'yellowstone-sequence.png';
binmode $fh;
print $fh $gd->png();
close $fh;


Program zigzag( input, output );

const
  size = 5;
var
  zzarray: array [1..size, 1..size] of integer;
  element, i, j: integer;
  direction: integer;
  width, n: integer;

begin
  i := 1;
  j := 1;
  direction := 1;
  for element := 0 to (size*size) - 1 do
  begin
    zzarray[i,j] := element;
    i := i + direction;
    j := j - direction;
    if (i = 0) then
      begin
        direction := -direction;
        i := 1;
        if (j > size) then
        begin
          j := size;
          i := 2;
        end;
      end
    else if (i > size) then
      begin
        direction := -direction;
        i := size;
        j := j + 2;
      end
    else if (j = 0) then
      begin
        direction := -direction;
        j := 1;
        if (i > size) then
        begin
          j := 2;
          i := size;
        end;
      end
    else if (j > size) then
      begin
        direction := -direction;
        j := size;
        i := i + 2;
      end;
  end;

  width := 2;
  n     := size;
  while (n > 0) do
  begin
    width := width + 1;
    n     := n div 10;
  end;
  for j := 1 to size do
  begin
    for i := 1 to size do
      write(zzarray[i,j]:width);
    writeln;
  end;
end.


def zhangSuen(text) {
    def image = text.split('\n').collect { line -> line.collect { it == '#' ? 1 : 0} }
    def p2, p3, p4, p5, p6, p7, p8, p9
    def step1 = { (p2 * p4 * p6 == 0) && (p4 * p6 * p8 == 0) }
    def step2 = { (p2 * p4 * p8 == 0) && (p2 * p6 * p8 == 0) }
    def reduce = { step ->
        def toWhite = []
        image.eachWithIndex{ line, y ->
            line.eachWithIndex{ pixel, x ->
                if (!pixel) return
                (p2, p3, p4, p5, p6, p7, p8, p9) = [image[y-1][x], image[y-1][x+1], image[y][x+1], image[y+1][x+1], image[y+1][x], image[y+1][x-1], image[y][x-1], image[y-1][x-1]]
                def a = [[p2,p3],[p3,p4],[p4,p5],[p5,p6],[p6,p7],[p7,p8],[p8,p9],[p9,p2]].collect { a1, a2 -> (a1 == 0 && a2 ==1) ? 1 : 0 }.sum()
                def b = [p2, p3, p4, p5, p6, p7, p8, p9].sum()
                if (a != 1 || b < 2 || b > 6) return

                if (step.call()) toWhite << [y,x]
            }
        }
        toWhite.each { y, x -> image[y][x] = 0 }
        !toWhite.isEmpty()
    }

    while (reduce(step1) | reduce(step2));
    image.collect { line -> line.collect { it ? '#' : '.' }.join('') }.join('\n')
}


pub fn main() !void {
    const stdout = @import("std").io.getStdOut().writer();

    var doors = [_]bool{false} ** 101;
    var pass: u8 = 1;
    var door: u8 = undefined;

    while (pass <= 100) : (pass += 1) {
        door = pass;
        while (door <= 100) : (door += pass)
            doors[door] = !doors[door];
    }

    for (doors) |open, num|
        if (open)
            try stdout.print("Door {d} is open.\n", .{num});
}


--
-- demo\rosetta\Yellowstone_sequence.exw
--
with javascript_semantics
requires("1.0.2")

function yellowstone(integer N)
    sequence a = {1, 2, 3},
             b = repeat(true,3)
    integer i = 4
    while length(a) < N do
        if (i>length(b) or b[i]=false)
        and gcd(i,a[$])=1
        and gcd(i,a[$-1])>1 then
            a &= i
            if i>length(b) then
                b &= repeat(false,i-length(b))
            end if
            b[i] = true
            i = 4
        end if
        i += 1
    end while
    return a
end function

printf(1,"The first 30 entries of the Yellowstone permutation:\n%v\n", {yellowstone(30)})

-- a simple plot:
include pGUI.e
include IupGraph.e

function get_data(Ihandle graph)
    sequence y500 = yellowstone(500)
    integer {w,h} = IupGetIntInt(graph,"DRAWSIZE")
    IupSetInt(graph,"XTICK",iff(w<640?iff(h<300?100:50):20))
    IupSetInt(graph,"YTICK",iff(h<250?iff(h<140?iff(h<120?700:350):200):100))
    return {{tagset(500),y500,CD_RED}}
end function

IupOpen()
Ihandle graph = IupGraph(get_data,"RASTERSIZE=960x600")
IupSetAttributes(graph,`GTITLE="Yellowstone Numbers"`)
IupSetInt(graph,"TITLESTYLE",CD_ITALIC)
IupSetAttributes(graph,`XNAME="n", YNAME="a(n)"`)
IupSetAttributes(graph,"XTICK=20,XMIN=0,XMAX=500")
IupSetAttributes(graph,"YTICK=100,YMIN=0,YMAX=1400")
Ihandle dlg = IupDialog(graph,`TITLE="Yellowstone Names"`)
IupSetAttributes(dlg,"MINSIZE=290x140")
IupShow(dlg)
if platform()!=JS then
    IupMainLoop()
    IupClose()
end if


use 5.010;

sub zig_zag {
    my $n          = shift;
    my $max_number = $n**2;
    my @matrix;
    my $number = 0;
    for my $j ( 0 .. --$n ) {
        for my $i (
            $j % 2
            ? 0 .. $j
            : reverse 0 .. $j
          )
        {
            $matrix[$i][ $j - $i ] = $number++;
            #next if $j == $n;
            $matrix[ $n - $i ][ $n - ( $j - $i ) ] = $max_number - $number;
        }
    }
    return @matrix;
}

my @zig_zag_matrix = zig_zag(5);
say join "\t", @{$_} foreach @zig_zag_matrix;


import Data.Array
import qualified Data.List as List

data BW = Black | White
        deriving (Eq, Show)

type Index = (Int, Int)
type BWArray = Array Index BW

toBW :: Char -> BW
toBW '0' = White
toBW '1' = Black
toBW ' ' = White
toBW '#' = Black
toBW _   = error "toBW: illegal char"

toBWArray :: [String] -> BWArray
toBWArray strings = arr
  where
    height = length strings
    width  = minimum $ map length strings
    arr    = listArray ((0, 0), (width - 1, height - 1))
             . map toBW . concat . List.transpose $ map (take width) strings

toChar :: BW -> Char
toChar White = ' '
toChar Black = '#'

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf n xs = take n xs : (chunksOf n $ drop n xs)

showBWArray :: BWArray -> String
showBWArray arr =
  List.intercalate "\n" . List.transpose
  . chunksOf (height + 1) . map toChar $ elems arr
  where
    (_, (_, height)) = bounds arr

add :: Num a => (a, a) -> (a, a) -> (a, a)
add (a, b) (x, y) = (a + x, b + y)

within :: Ord a => ((a, a), (a, a)) -> (a, a) -> Bool
within ((a, b), (c, d)) (x, y) =
  a <= x && x <= c &&
  b <= y && y <= d

p2, p3, p4, p5, p6, p7, p8, p9 :: Index
p2 = ( 0, -1)
p3 = ( 1, -1)
p4 = ( 1,  0)
p5 = ( 1,  1)
p6 = ( 0,  1)
p7 = (-1,  1)
p8 = (-1,  0)
p9 = (-1, -1)

ixamap :: Ix i => ((i, a) -> b) -> Array i a -> Array i b
ixamap f a = listArray (bounds a) $ map f $ assocs a

thin :: BWArray -> BWArray
thin arr =
  if pass2 == arr then pass2 else thin pass2
  where
    (low, high)     = bounds arr
    lowB            = low `add` (1, 1)
    highB           = high `add` (-1, -1)
    isInner         = within (lowB, highB)
    offs p          = map (add p) [p2, p3, p4, p5, p6, p7, p8, p9]
    trans c (a, b)  = if a == White && b == Black then c + 1 else c
    zipshift xs     = zip xs (drop 1 xs ++ xs)
    transitions a   = (== (1 :: Int)) . foldl trans 0 . zipshift . map (a !) . offs
    within2to6 n    = 2 <= n && n <= 6
    blacks a p      = within2to6 . length . filter ((== Black) . (a !)) $ offs p
    oneWhite xs a p = any ((== White) . (a !) . add p) xs
    oneRight        = oneWhite [p2, p4, p6]
    oneDown         = oneWhite [p4, p6, p8]
    oneUp           = oneWhite [p2, p4, p8]
    oneLeft         = oneWhite [p2, p6, p8]
    precond a p     = (a ! p == Black) && isInner p && blacks a p && transitions a p
    stage1 a p      = precond a p && oneRight a p && oneDown a p
    stage2 a p      = precond a p && oneUp a p && oneLeft a p
    stager f (p, d) = if f p then White else d
    pass1           = ixamap (stager $ stage1 arr) arr
    pass2           = ixamap (stager $ stage2 pass1) pass1

sampleExA :: [String]
sampleExA =
  ["00000000000000000000000000000000"
  ,"01111111110000000111111110000000"
  ,"01110001111000001111001111000000"
  ,"01110000111000001110000111000000"
  ,"01110001111000001110000000000000"
  ,"01111111110000001110000000000000"
  ,"01110111100000001110000111000000"
  ,"01110011110011101111001111011100"
  ,"01110001111011100111111110011100"
  ,"00000000000000000000000000000000"]

sampleExB :: [String]
sampleExB =
  ["                                                          "
  ," #################                   #############        "
  ," ##################               ################        "
  ," ###################            ##################        "
  ," ########     #######          ###################        "
  ,"   ######     #######         #######       ######        "
  ,"   ######     #######        #######                      "
  ,"   #################         #######                      "
  ,"   ################          #######                      "
  ,"   #################         #######                      "
  ,"   ######     #######        #######                      "
  ,"   ######     #######        #######                      "
  ,"   ######     #######         #######       ######        "
  ," ########     #######          ###################        "
  ," ########     ####### ######    ################## ###### "
  ," ########     ####### ######      ################ ###### "
  ," ########     ####### ######         ############# ###### "
  ,"                                                          "]

main :: IO ()
main = mapM_ (putStrLn . showBWArray . thin . toBWArray) [sampleExA, sampleExB]


doors:=List.createLong(100,False);	// list of 100 Falses
foreach n,m in (100,[n..99,n+1]){ doors[m]=(not doors[m]); } //foreach{ foreach{} }
doors.filterNs().apply('+(1)).println();


include ..\Utilitys.pmt

def gcd /# u v -- n #/
    abs int swap abs int swap

    dup
    while
        over over mod rot drop dup
    endwhile
    drop
enddef

def test enddef

def yellow var n
  ( 1 2 3 ) var a
  newd ( 1 true ) setd ( 2 true ) setd ( 3 true ) setd var b
  4 var i
  test
  while
    b i getd "Unfound" == >ps
    a -1 get >ps -2 get
    i gcd 1 > ps> i gcd 1 == ps>
    and and if
      i 0 put var a
      ( i true ) setd var b
      4 var i
    else
      drop drop
    endif
    i 1 + var i
    test
  endwhile
  a
enddef

def test n a len nip > enddef

"The first 30 entries of the Yellowstone permutation:" ? 30 yellow ?


(load "@lib/frac.l")
(de yellow (N)
   (let (L (list 3 2 1)  I 4  C 3  D)
      (while (> N C)
         (when
            (and
               (not (idx 'D I))
               (=1 (gcd I (get L 1)))
               (> (gcd I (get L 2)) 1) )
            (push 'L I)
            (idx 'D I T)
            (setq I 4)
            (inc 'C) )
         (inc 'I) )
      (flip L) ) )
(println (yellow 30))


Procedure.i gcd(x.i,y.i)
  While y<>0 : t=x : x=y : y=t%y : Wend : ProcedureReturn x
EndProcedure

If OpenConsole()
  Dim Y.i(100)
  For i=1 To 100
    If i<=3 : Y(i)=i : Continue : EndIf : k=3
    Repeat
      RepLoop:
      k+1
      For j=1 To i-1 : If Y(j)=k : Goto RepLoop : EndIf : Next
      If gcd(k,Y(i-2))=1 Or gcd(k,Y(i-1))>1 : Continue : EndIf
      Y(i)=k : Break
    ForEver
  Next
  For i=1 To 30 : Print(Str(Y(i))+" ") : Next : Input()
EndIf


with javascript_semantics
integer n = 9
integer zstart = 0, zend = n*n-1
--integer zstart = 1, zend = n*n
string fmt = sprintf("%%%dd",length(sprintf("%d",zend)))
sequence m = repeat(repeat("??",n),n)
integer x = 1, y = 1, d = -1
while 1 do
    m[x][y] = sprintf(fmt,zstart)
    if zstart=zend then exit end if
    zstart += 1
    m[n-x+1][n-y+1] = sprintf(fmt,zend)
    zend -= 1
    x += d
    y -= d
    if x<1 then
        x += 1
        d = -d
    elsif y<1 then
        y += 1
        d = -d
    end if
end while

for i=1 to n do
    m[i] = join(m[i])
end for
puts(1,join(m,"\n"))


isBlackPx=: '1'&=;._2             NB. boolean array of black pixels
toImage=: [: , LF ,.~ '01' {~ ]   NB. convert to original representation
frameImg=: 0 ,. 0 , >:@$ {. ]     NB. adds border of 0's to image

neighbrs=: 1 :'(1 1 ,: 3 3)&(u;._3)'  NB. applies verb u to neighbourhoods

Bdry=: 1 2 5 8 7 6 3 0 1          NB. map pixel index to neighbour order
getPx=: { ,                       NB. get desired pixels from neighbourhood
Ap1=: [: +/ 2 </\ Bdry&getPx      NB. count 0->1 transitions
Bp1=: [: +/ [: }. Bdry&getPx      NB. count black neighbours

c11=: (2&<: *. <:&6)@Bp1          NB. step 1, condition 1
c12=: 1 = Ap1                     NB. ...
c13=: 0 e. 1 5 7&getPx
c14=: 0 e. 5 7 3&getPx
c23=: 0 e. 1 5 3&getPx            NB. step2, condition 3
c24=: 0 e. 1 7 3&getPx

cond1=: c11 *. c12 *. c13 *. c14  NB. step1 conditions
cond2=: c11 *. c12 *. c23 *. c24  NB. step2 conditions
whiten=: [ * [email protected]:*.               NB. make black pixels white
step1=: whiten [email protected](cond1 neighbrs)
step2=: whiten [email protected](cond2 neighbrs)

zhangSuen=: [: toImage [: [email protected]^:_ isBlackPx


 10 REM 100 doors open/closed?
 20 DIM d(100)
 25 LET o=0
 30 FOR a=1 TO 100
 40 FOR b=a TO 100 STEP a
 50 LET d(b)=NOT d(b)
 55 LET o=o+(d(b)=1)-(d(b)=0)
 60 NEXT b
 70 NEXT a
 80 PRINT o;" open doors"


'''Yellowstone permutation OEIS A098550'''

from itertools import chain, count, islice
from operator import itemgetter
from math import gcd

from matplotlib import pyplot

# yellowstone :: [Int]
def yellowstone():
    '''A non-finite stream of terms from
       the Yellowstone permutation.
       OEIS A098550.
    '''
    # relativelyPrime :: Int -> Int -> Bool
    def relativelyPrime(a):
        return lambda b: 1 == gcd(a, b)

    # nextWindow :: (Int, Int, [Int]) -> (Int, Int, [Int])
    def nextWindow(triple):
        p2, p1, rest = triple
        [rp2, rp1] = map(relativelyPrime, [p2, p1])

        # match :: [Int] -> (Int, [Int])
        def match(xxs):
            x, xs = uncons(xxs)['Just']
            return (x, xs) if rp1(x) and not rp2(x) else (
                second(cons(x))(
                    match(xs)
                )
            )
        n, residue = match(rest)
        return (p1, n, residue)

    return chain(
        range(1, 3),
        map(
            itemgetter(1),
            iterate(nextWindow)(
                (2, 3, count(4))
            )
        )
    )

# TEST ----------------------------------------------------
# main :: IO ()
def main():
    '''Terms of the Yellowstone permutation.'''

    print(showList(
        take(30)(yellowstone())
    ))
    pyplot.plot(
        take(100)(yellowstone())
    )
    pyplot.xlabel(main.__doc__)
    pyplot.show()

# GENERIC -------------------------------------------------

# Just :: a -> Maybe a
def Just(x):
    '''Constructor for an inhabited Maybe (option type) value.
       Wrapper containing the result of a computation.
    '''
    return {'type': 'Maybe', 'Nothing': False, 'Just': x}

# Nothing :: Maybe a
def Nothing():
    '''Constructor for an empty Maybe (option type) value.
       Empty wrapper returned where a computation is not possible.
    '''
    return {'type': 'Maybe', 'Nothing': True}

# cons :: a -> [a] -> [a]
def cons(x):
    '''Construction of a list from x as head,
       and xs as tail.
    '''
    return lambda xs: [x] + xs if (
        isinstance(xs, list)
    ) else x + xs if (
        isinstance(xs, str)
    ) else chain([x], xs)

# iterate :: (a -> a) -> a -> Gen [a]
def iterate(f):
    '''An infinite list of repeated
       applications of f to x.
    '''
    def go(x):
        v = x
        while True:
            yield v
            v = f(v)
    return go

# second :: (a -> b) -> ((c, a) -> (c, b))
def second(f):
    '''A simple function lifted to a function over a tuple,
       with f applied only to the second of two values.
    '''
    return lambda xy: (xy[0], f(xy[1]))

# showList :: [a] -> String
def showList(xs):
    '''Stringification of a list.'''
    return '[' + ','.join(repr(x) for x in xs) + ']'

# take :: Int -> [a] -> [a]
# take :: Int -> String -> String
def take(n):
    '''The prefix of xs of length n,
       or xs itself if n > length xs.
    '''
    return lambda xs: (
        xs[0:n]
        if isinstance(xs, (list, tuple))
        else list(islice(xs, n))
    )

# uncons :: [a] -> Maybe (a, [a])
def uncons(xs):
    '''The deconstruction of a non-empty list
       (or generator stream) into two parts:
       a head value, and the remaining values.
    '''
    if isinstance(xs, list):
        return Just((xs[0], xs[1:])) if xs else Nothing()
    else:
        nxt = take(1)(xs)
        return Just((nxt[0], xs)) if nxt else Nothing()

# MAIN ---
if __name__ == '__main__':
    main()


5 var Size
0 Size repeat Size repeat

1 var i 1 var j

Size 2 power for
    swap i get rot j set i set
    i j + 1 bitand 0 == IF
        j Size < IF j 1 + var j ELSE i 2 + var i ENDIF
        i 1 > IF i 1 - var i ENDIF
    ELSE
        i Size < IF i 1 + var i ELSE j 2 + var j ENDIF
        j 1 > IF j 1 - var j ENDIF
    ENDIF
endfor

Size FOR
    var row
    Size FOR
        var col
        row get col get tostr 32 32 chain chain 1 3 slice print drop drop
    ENDFOR
    nl
ENDFOR


  [ stack ]                 is seqbits      (   --> s )

  [ bit
    seqbits take |
    seqbits put ]           is seqadd       ( n -->   )

  [ bit
    seqbits share & not ]   is notinseq     ( n --> b )

 [ temp put
   ' [ 1 2 3 ]
   7 seqbits put
   4
   [ dip
       [ dup -1 peek
         over -2 peek ]
     dup dip
       [ tuck gcd 1 !=
         unrot gcd 1 =
         and ]
     swap if
       [ dup dip join
         seqadd
         3 ]
    [ 1+
      dup notinseq until ]
     over size temp share
     < not until ]
     drop
     seqbits release
     temp take split drop ] is yellowstones ( n --> [ )

  30 yellowstones echo


#lang racket

(require plot)

(define a098550
  (let ((hsh# (make-hash '((1 . 1) (2 . 2) (3 . 3))))
        (rev# (make-hash '((1 . 1) (2 . 2) (3 . 3)))))
    (λ (n)
      (hash-ref hsh# n
                (λ ()
                  (let ((a_n (for/first ((i (in-naturals 4))
                                         #:unless (hash-has-key? rev# i)
                                         #:when (and (= (gcd i (a098550 (- n 1))) 1)
                                                     (> (gcd i (a098550 (- n 2))) 1)))
                               i)))
                    (hash-set! hsh# n a_n)
                    (hash-set! rev# a_n n)
                    a_n))))))

(map a098550 (range 1 (add1 30)))

(plot (points
       (map (λ (i) (vector i (a098550 i))) (range 1 (add1 100)))))


my @yellowstone = 1, 2, 3, -> $q, $p {
    state @used = True xx 4;
    state $min  = 3;
    my \index = ($min .. *).first: { not @used[$_] and $_ gcd $q != 1 and $_ gcd $p == 1 };
    @used[index] = True;
    $min = @used.first(!*, :k) // +@used - 1;
    index
} … *;

put "The first 30 terms in the Yellowstone sequence:\n", @yellowstone[^30];

use SVG;
use SVG::Plot;

my @x = ^500;

my $chart = SVG::Plot.new(
    background  => 'white',
    width       => 1000,
    height      => 600,
    plot-width  => 950,
    plot-height => 550,
    x           => @x,
    x-tick-step => { 10 },
    y-tick-step => { 50 },
    min-y-axis  => 0,
    values      => [@yellowstone[@x],],
    title       => "Yellowstone Sequence - First {[email protected]} values (zero indexed)",
);

my $line = './Yellowstone-sequence-line-perl6.svg'.IO;
my $bars = './Yellowstone-sequence-bars-perl6.svg'.IO;

$line.spurt: SVG.serialize: $chart.plot: :lines;
$bars.spurt: SVG.serialize: $chart.plot: :bars;


(load "@lib/simul.l")

(de zigzag (N)
   (prog1 (grid N N)
      (let (D '(north west  south east  .)  E '(north east .)  This 'a1)
         (for Val (* N N)
            (=: val Val)
            (setq This
               (or
                  ((cadr D) ((car D) This))
                  (prog
                     (setq D (cddr D))
                     ((pop 'E) This) )
                  ((pop 'E) This) ) ) ) ) ) )

(mapc
   '((L)
      (for This L (prin (align 3 (: val))))
      (prinl) )
   (zigzag 5) )


/* Fill a square matrix with the values 0 to N**2-1,     */
/* in a zig-zag fashion.                                 */
/* N is the length of one side of the square.            */
/* Written 22 February 2010.                             */

   declare n fixed binary;

   put skip list ('Please type the size of the matrix:');
   get list (n);

begin;
   declare A(n,n) fixed binary;
   declare (i, j, inc, q) fixed binary;

   on subrg snap begin;
      declare i fixed binary;
      do  i = 1 to n;
         put skip edit (a(i,*)) (f(4));
      end;
      stop;
   end;

   A = -1;
   inc = -1;
   i, j = 1;

loop:
   do q = 0 to n**2-1;
      a(i,j) = q;
      if q = n**2-1 then leave;
      if i = 1 & j = n then
         if iand(j,1) = 1 then /* odd-sided matrix */
            do; i = i + 1; inc = -inc; iterate loop; end;
         else  /* an even-sided matrix */
            do; i = i + inc; j = j - inc; iterate loop; end;
      if inc = -1 then if i+inc < 1 then
         do; inc = -inc; j = j + 1; a(i,j) = q; iterate loop; end;
      if inc = 1 then if i+inc > n then
         do; inc = -inc; j = j + 1; a(i,j) = q; iterate loop; end;
      if inc = 1 then if j-inc < 1 then
         do; inc = -inc; i = i + 1; a(i,j) = q; iterate loop; end;
      if inc = -1 then if j - inc > n then
         do; inc = -inc; i = i + 1; a(i,j) = q; iterate loop; end;
      i = i + inc; j = j - inc;
   end;

   /* Display the square. */
   do  i = 1 to n;
      put skip edit (a(i,*)) (f(4));
   end;
end;


/*REXX program calculates any number of terms in the Yellowstone (permutation) sequence.*/
parse arg m .                                    /*obtain optional argument from the CL.*/
if m=='' | m==","  then m= 30                    /*Not specified?  Then use the default.*/
!.= 0                                            /*initialize an array of numbers(used).*/
# = 0                                            /*count of Yellowstone numbers in seq. */
$=                                               /*list   "      "         "     "  "   */
      do j=1  until #==m;  prev= # - 1
      if j<5  then do;  #= #+1;   @.#= j;  !.#= j;  !.j= 1;  $= strip($ j);  iterate;  end

         do k=1;   if !.k  then iterate          /*Already used?  Then skip this number.*/
         if gcd(k, @.prev)<2  then iterate       /*Not meet requirement?  Then skip it. */
         if gcd(k, @.#) \==1  then iterate       /* "    "       "          "    "   "  */
         #= #+1;   @.#= k;     !.k= 1;   $= $ k  /*bump ctr; assign; mark used; add list*/
         leave                                   /*find the next Yellowstone seq. number*/
         end   /*k*/
      end      /*j*/
say $                                            /*display a list of a Yellowstone seq. */
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
gcd: parse arg x,y;  do until y==0;  parse value  x//y  y   with   y  x;  end;    return x


see "working..." + nl
row = 3
num = 2
numbers = 1:51
first = 2
second = 3
see "Yellowstone numbers are:" + nl
see "1 " + first + " " + second + " "

     for n = 4 to len(numbers)
         flag1 = 1
         flag2 = 1
         if first < numbers[n]
            min = first
         else
            min = numbers[n]
         ok
         for m = 2 to min
             if first%m = 0 and numbers[n]%m = 0
                flag1 = 0
                exit
             ok
         next
         if second < numbers[n]
            min = second
         else
            min = numbers[n]
         ok
         for m = 2 to min
             if second%m = 0 and numbers[n]%m = 0
                flag2 = 0
                exit
             ok
         next
         if flag1 = 0 and flag2 = 1
            see "" + numbers[n] + " "
            first = second
            second = numbers[n]
            del(numbers,n)
            row = row+1
            if row%10 = 0
               see nl
            ok
            num = num + 1
            if num = 29
               exit
            ok
            n = 3
         ok
    next

    see "Found " + row + " Yellowstone numbers" + nl
    see "done..." + nl


def yellow(n)
  a = [1, 2, 3]
  b = { 1 => true, 2 => true, 3 => true }
  i = 4
  while n > a.length
    if !b[i] && i.gcd(a[-1]) == 1 && i.gcd(a[-2]) > 1
      a << i
      b[i] = true
      i = 4
    end
    i += 1
  end
  a
end

p yellow(30)


\long\def\antefi#1#2\fi{#2\fi#1}
\def\fornum#1=#2to#3(#4){%
	\edef#1{\number\numexpr#2}\edef\fornumtemp{\noexpand\fornumi\expandafter\noexpand\csname fornum\string#1\endcsname
		{\number\numexpr#3}{\ifnum\numexpr#4<0 <\else>\fi}{\number\numexpr#4}\noexpand#1}\fornumtemp
}
\long\def\fornumi#1#2#3#4#5#6{\def#1{\unless\ifnum#5#3#2\relax\antefi{#6\edef#5{\number\numexpr#5+(#4)\relax}#1}\fi}#1}
\def\elem(#1,#2){\numexpr(#1+#2)*(#1+#2-1)/2-(\ifodd\numexpr#1+#2\relax#1\else#2\fi)\relax}
\def\zzmat#1{%
	\noindent% quit vertical mode
	\fornum\yy=1to#1(+1){%
		\fornum\xx=1to#1(+1){%
			\ifnum\numexpr\xx+\yy\relax<\numexpr#1+2\relax
				\hbox to 2em{\hfil\number\elem(\xx,\yy)}%
			\else
				\hbox to 2em{\hfil\number\numexpr#1*#1-1-\elem(#1+1-\xx,#1+1-\yy)\relax}%
			\fi
		}%
		\par\noindent% next line + quit vertical mode
	}\par
}
\zzmat{5}
\bye


%!PS
%%BoundingBox: 0 0 300 200
/size 9 def % defines row * column (9*9 -> 81 numbers,
            % from 0 to 80)
/itoa { 2 string cvs } bind def
% visual bounding box...
% 0 0 moveto 300 0 lineto 300 200 lineto 0 200 lineto
% closepath stroke
20 150 translate
% it can be easily enhanced to support more columns and
% rows. This limit is put here just to avoid more than 2
% digits, mainly because of formatting
size size mul 99 le {
   /Helvetica findfont 14 scalefont setfont
   /ulimit size size mul def
   /sizem1 size 1 sub def
   % prepare the number list
   0 ulimit 1 sub { dup 1 add } repeat
   ulimit array astore
   /di -1 def /dj 1 def
   /ri 1 def /rj 0 def /pus true def
   0 0 moveto
   /i 0 def /j 0 def
   {  % can be rewritten a lot better :)
      0.8 setgray i 30 mul j 15 mul neg lineto stroke
      0 setgray i 30 mul j 15 mul neg moveto itoa show
      i 30 mul j 15 mul neg moveto
      pus {
         i ri add size ge {
             /ri 0 def /rj 1 def
         } if
         j rj add size ge {
             /ri 1 def /rj 0 def
         } if
         /pus false def
         /i i ri add def
         /j j rj add def
         /ri rj /rj ri def def
      } {
          i di add dup    0 le
                  exch sizem1 ge or
          j dj add dup    0 le
                  exch sizem1 ge or
             or {
                /pus true def
                /i i di add def /j j dj add def
                /di di neg def /dj dj neg def
          } {
                /i i di add def /j j dj add def
          } ifelse
      } ifelse
   } forall
   stroke showpage
} if
%%EOF


function zhangSuenThin(img)
    local dirs={
        { 0,-1},
        { 1,-1},
        { 1, 0},
        { 1, 1},
        { 0, 1},
        {-1, 1},
        {-1, 0},
        {-1,-1},
        { 0,-1},
    }

    local black=1
    local white=0

    function A(x, y)
        local c=0
        local current=img[y+dirs[1][2]][x+dirs[1][1]]
        for i=2,#dirs do
            local to_compare=img[y+dirs[i][2]][x+dirs[i][1]]
            if current==white and to_compare==black then
                c=c+1
            end
            current=to_compare
        end
        return c
    end

    function B(x, y)
        local c=0
        for i=2,#dirs do
            local value=img[y+dirs[i][2]][x+dirs[i][1]]
            if value==black then
                c=c+1
            end
        end
        return c
    end

    function common_step(x, y)
        if img[y][x]~=black or x<=1 or x>=#img[y] or y<=1 or y>=#img then
            return false
        end

        local b_value=B(x, y)
        if b_value<2 or b_value>6 then
            return false
        end

        local a_value=A(x, y)
        if a_value~=1 then
            return false
        end
        return true
    end

    function step_one(x, y)
        if not common_step(x, y) then
            return false
        end
        local p2=img[y+dirs[1][2]][x+dirs[1][1]]
        local p4=img[y+dirs[3][2]][x+dirs[3][1]]
        local p6=img[y+dirs[5][2]][x+dirs[5][1]]
        local p8=img[y+dirs[7][2]][x+dirs[7][1]]

        if p4==white or p6==white or p2==white and p8==white then
            return true
        end
        return false
    end

    function step_two(x, y)
        if not common_step(x, y) then
            return false
        end
        local p2=img[y+dirs[1][2]][x+dirs[1][1]]
        local p4=img[y+dirs[3][2]][x+dirs[3][1]]
        local p6=img[y+dirs[5][2]][x+dirs[5][1]]
        local p8=img[y+dirs[7][2]][x+dirs[7][1]]

        if p2==white or p8==white or p4==white and p6==white then
            return true
        end
        return false
    end

    function convert(to_do)
        for k,v in pairs(to_do) do
            img[v[2]][v[1]]=white
        end
    end

    function do_step_on_all(step)
        local to_convert={}
        for y=1,#img do
            for x=1,#img[y] do
                if step(x, y) then
                    table.insert(to_convert, {x,y})
                end
            end
        end
        convert(to_convert)
        return #to_convert>0
    end

    local continue=true
    while continue do
        continue=false
        if do_step_on_all(step_one) then
            continue=true
        end

        if do_step_on_all(step_two) then
            continue=true
        end
    end

    for y=1,#img do
        for x=1,#img[y] do
            io.write(img[y][x]==black and '#' or ' ')
        end
        io.write('\n')
    end
end

local image = {
    {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0},
    {0,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0},
    {0,1,1,1,0,0,0,1,1,1,1,0,0,0,0,0,1,1,1,1,0,0,1,1,1,1,0,0,0,0,0,0},
    {0,1,1,1,0,0,0,0,1,1,1,0,0,0,0,0,1,1,1,0,0,0,0,1,1,1,0,0,0,0,0,0},
    {0,1,1,1,0,0,0,1,1,1,1,0,0,0,0,0,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0},
    {0,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0},
    {0,1,1,1,0,1,1,1,1,0,0,0,0,0,0,0,1,1,1,0,0,0,0,1,1,1,0,0,0,0,0,0},
    {0,1,1,1,0,0,1,1,1,1,0,0,1,1,1,0,1,1,1,1,0,0,1,1,1,1,0,1,1,1,0,0},
    {0,1,1,1,0,0,0,1,1,1,1,0,1,1,1,0,0,1,1,1,1,1,1,1,1,0,0,1,1,1,0,0},
    {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0},
}

zhangSuenThin(image)


// [dependencies]
// num = "0.3"
// plotters = "^0.2.15"

use num::integer::gcd;
use plotters::prelude::*;
use std::collections::HashSet;

fn yellowstone_sequence() -> impl std::iter::Iterator<Item = u32> {
    let mut sequence: HashSet<u32> = HashSet::new();
    let mut min = 1;
    let mut n = 0;
    let mut n1 = 0;
    let mut n2 = 0;
    std::iter::from_fn(move || {
        n2 = n1;
        n1 = n;
        if n < 3 {
            n += 1;
        } else {
            n = min;
            while !(!sequence.contains(&n) && gcd(n1, n) == 1 && gcd(n2, n) > 1) {
                n += 1;
            }
        }
        sequence.insert(n);
        while sequence.contains(&min) {
            sequence.remove(&min);
            min += 1;
        }
        Some(n)
    })
}

// Based on the example in the "Quick Start" section of the README file for
// the plotters library.
fn plot_yellowstone(filename: &str) -> Result<(), Box<dyn std::error::Error>> {
    let root = BitMapBackend::new(filename, (800, 600)).into_drawing_area();
    root.fill(&WHITE)?;
    let mut chart = ChartBuilder::on(&root)
        .caption("Yellowstone Sequence", ("sans-serif", 24).into_font())
        .margin(10)
        .x_label_area_size(20)
        .y_label_area_size(20)
        .build_ranged(0usize..100usize, 0u32..180u32)?;
    chart.configure_mesh().draw()?;
    chart.draw_series(LineSeries::new(
        yellowstone_sequence().take(100).enumerate(),
        &BLUE,
    ))?;
    Ok(())
}

fn main() {
    println!("First 30 Yellowstone numbers:");
    for y in yellowstone_sequence().take(30) {
        print!("{} ", y);
    }
    println!();
    match plot_yellowstone("yellowstone.png") {
        Ok(()) => {}
        Err(error) => eprintln!("Error: {}", error),
    }
}


proc gcd {a b} {
    while {$b} {
        lassign [list $b [expr {$a % $b}]] a b
    }
    return $a
}

proc gen_yellowstones {{maxN 30}} {
    set r {}
    for {set n 1} {$n <= $maxN} {incr n} {
        if {$n <= 3} {
            lappend r $n
        } else {
            ## NB: list indices start at 0, not 1.
            set pred    [lindex $r end  ]       ;# a(n-1): coprime
            set prepred [lindex $r end-1]       ;# a(n-2): not coprime
            for {set k 4} {1} {incr k} {
                if {[lsearch -exact $r $k] >= 0} { continue }
                if {1 != [gcd $k $pred   ]} { continue }
                if {1 == [gcd $k $prepred]} { continue }
                ## candidate k survived all tests...
                break
            }
            lappend r $k
        }
    }
    return $r
}
puts "The first 30 Yellowstone numbers are:"
puts [gen_yellowstones]


Dim @y(30)

@y(0) = 1
@y(1) = 2
@y(2) = 3

For i = 3 To 29
  k = 3
  Do
    k = k + 1
    If (FUNC(_gcd(k, @y(i-2))) = 1) + (FUNC(_gcd(k, @y(i-1))) > 1) Then
      Continue
    EndIf

    For j = 0 To i - 1
      If @y(j) = k Then Unloop : Continue
    Next

    @y(i) = k : Break
  Loop
Next

For i = 0 To 29
  Print @y(i); " ";
Next

Print : End

_gcd Param (2)
  If [email protected] = 0 Then Return ([email protected])
Return (FUNC(_gcd([email protected], [email protected] % [email protected])))


function zigzag( [int] $n ) {
    $zigzag=New-Object 'Object[,]' $n,$n
    $nodd = $n -band 1
    $nm1 = $n - 1
    $i=0;
    $j=0;
    foreach( $k in 0..( $n * $n - 1 ) ) {
        $zigzag[$i,$j] = $k
        $iodd = $i -band 1
        $jodd = $j -band 1
        if( ( $j -eq $nm1 ) -and ( $iodd -ne $nodd ) ) {
            $i++
        } elseif( ( $i -eq $nm1 ) -and ( $jodd -eq $nodd ) ) {
            $j++
        } elseif( ( $i -eq 0 ) -and ( -not $jodd ) ) {
            $j++
        } elseif( ( $j -eq 0 ) -and $iodd ) {
            $i++
        } elseif( $iodd -eq $jodd ) {
            $i--
            $j++
        } else {
            $i++
            $j--
        }
    }
    ,$zigzag
}

function displayZigZag( [int] $n ) {
    $a = zigzag $n
    0..$n | ForEach-Object {
        $b=$_
        $pad=($n*$n-1).ToString().Length
        "$(0..$n | ForEach-Object {
            "{0,$pad}" -f $a[$b,$_]
        } )"
    }
}


import math, sequtils, strutils

type
  Bit = 0..1
  BitMatrix = seq[seq[Bit]]     # Two-dimensional array of 0/1.
  Neighbors = array[2..9, Bit]  # Neighbor values.

const Symbols = [Bit(0): '.', Bit(1): '#']

func toBitMatrix(s: openArray[string]): BitMatrix =
  ## Convert an array of 01 strings into a BitMatrix.
  for row in s:
    assert row.allCharsInSet({'0', '1'})
    result.add row.mapIt(Bit(ord(it) - ord('0')))

proc `$`(m: BitMatrix): string =
  ## Return the string representation of a BitMatrix.
  for row in m:
    echo row.mapIt(Symbols[it]).join()

# Templates to allow using double indexing.
template `[]`(m: BitMatrix; i, j: Natural): Bit = m[i][j]
template `[]=`(m: var BitMatrix; i, j: Natural; val: Bit) = m[i][j] = val

func neighbors(m: BitMatrix; i, j: int): Neighbors =
  ## Return the array of neighbors.
  [m[i-1, j], m[i-1, j+1], m[i, j+1], m[i+1, j+1],
   m[i+1, j], m[i+1, j-1], m[i, j-1], m[i-1, j-1]]

func transitions(p: Neighbors): int =
  ## Return the numbers of transitions from P2 to P9.
  for (i, j) in [(2, 3), (3, 4), (4, 5), (5, 6),
                 (6, 7), (7, 8), (8, 9), (9, 2)]:
    result += ord(p[i] == 0 and p[j] == 1)

func thinned(m: BitMatrix): BitMatrix =
  ## Return a thinned version of "m".
  const Pair1 = [2, 8]
  const Pair2 = [4, 6]
  let rowMax = m.high
  let colMax = m[0].high
  result = m

  while true:
    var changed = false

    for step in 1..2:
      let (p1, p2) = if step == 1: (Pair1, Pair2) else: (Pair2, Pair1)
      var m = result
      for i in 1..<rowMax:
        for j in 1..<colMax:

          # Check criteria.
          if m[i, j] == 0:                            # criterion 0.
            continue
          let p = m.neighbors(i, j)
          if sum(p) notin 2..6:                       # criterion 1.
            continue
          if transitions(p) != 1:                     # criterion 2.
            continue
          if p[p1[0]] + p[p2[0]] + p[p2[1]] == 3 or   # criterion 3.
             p[p1[1]] + p[p2[0]] + p[p2[1]] == 3:     # criterion 4.
              continue

          # All criteria satisfied. Store a 0 in "result".
          result[i, j] = 0
          changed = true

    if not changed: break

when isMainModule:

  const Input = ["00000000000000000000000000000000",
                 "01111111110000000111111110000000",
                 "01110001111000001111001111000000",
                 "01110000111000001110000111000000",
                 "01110001111000001110000000000000",
                 "01111111110000001110000000000000",
                 "01110111100000001110000111000000",
                 "01110011110011101111001111011100",
                 "01110001111011100111111110011100",
                 "00000000000000000000000000000000"]

  let input = Input.toBitMatrix()
  let output = input.thinned()
  echo "Input image:"
  echo input
  echo()
  echo "Output image:"
  echo output


Function gcd(a As Long, b As Long) As Long
    If b = 0 Then
        gcd = a
        Exit Function
    End If
    gcd = gcd(b, a Mod b)
End Function

Sub Yellowstone()
Dim i As Long, j As Long, k As Long, Y(1 To 30) As Long

Y(1) = 1
Y(2) = 2
Y(3) = 3

For i = 4 To 30
  k = 3
  Do
      k = k + 1
      If gcd(k, Y(i - 2)) = 1 Or gcd(k, Y(i - 1)) > 1 Then GoTo EndLoop:
      For j = 1 To i - 1
          If Y(j) = k Then GoTo EndLoop:
      Next j
      Y(i) = k
      Exit Do
EndLoop:
  Loop
Next i

For i = 1 To 30
    Debug.Print Y(i) & " ";
Next i
End Sub


fn gcd(xx int, yy int) int {
    mut x := xx
    mut y := yy
    for y != 0 {
        x, y = y, x%y
    }
    return x
}

fn yellowstone(n int) []int {
    mut m := map[int]bool{}
    mut a := []int{len: n+1}
    for i in 1..4 {
        a[i] = i
        m[i] = true
    }
    mut min := 4
    for c := 4; c <= n; c++ {
        for i := min; ; i++ {
            if !m[i] && gcd(a[c-1], i) == 1 && gcd(a[c-2], i) > 1 {
                a[c] = i
                m[i] = true
                if i == min {
                    min++
                }
                break
            }
        }
    }
    return a[1..]
}

fn main() {
    mut x := []int{len: 100}
    for i in 0..100 {
        x[i] = i + 1
    }
    y := yellowstone(100)
    println("The first 30 Yellowstone numbers are:")
    println(y[..30])
}


import "/math" for Int

var yellowstone = Fn.new { |n|
    var m = {}
    var a = List.filled(n + 1, 0)
    for (i in 1..3) {
        a[i] = i
        m[i] = true
    }
    var min = 4
    for (c in 4..n) {
        var i = min
        while (true) {
            if (!m[i] && Int.gcd(a[c-1], i) == 1 && Int.gcd(a[c-2], i) > 1) {
                a[c] = i
                m[i] = true
                if (i == min) min = min + 1
                break
            }
            i = i + 1
        }
    }
    return a[1..-1]
}

var x = List.filled(30, 0)
for (i in 0...30) x[i] = i + 1
var y = yellowstone.call(30)
System.print("The first 30 Yellowstone numbers are:")
System.print(y)


zig_zag(N) :-
	zig_zag(N, N).

% compute zig_zag for a matrix of Lig lines of Col columns
zig_zag(Lig, Col) :-
	length(M, Lig),
	maplist(init(Col), M),
	fill(M, 0, 0, 0, Lig, Col, up),
	% display the matrix
	maplist(print_line, M).

fill(M, Cur, L, C, NL, NC, _) :-
	L is NL - 1,
	C is NC - 1,
	nth0(L, M, Line),
	nth0(C, Line, Cur).

fill(M, Cur, L, C, NL, NC, Sens) :-
	nth0(L, M, Line),
	nth0(C, Line, Cur),
	Cur1 is Cur + 1,
	compute_next(NL, NC, L, C, Sens, L1, C1, Sens1),
	fill(M, Cur1, L1, C1, NL, NC, Sens1).

init(N, L) :-
	length(L, N).

% compute_next
% arg1 : Number of lnes of the matrix
% arg2 : number of columns of the matrix
% arg3 : current line
% arg4 : current column
% arg5 : current direction of movement
% arg6 : nect line
% arg7 : next column
% arg8 : next direction of movement
compute_next(_NL, NC, 0, Col, up, 0, Col1, down) :-
	Col < NC - 1,
	Col1 is Col+1.

compute_next(_NL, NC, 0, Col, up, 1, Col, down) :-
	Col is NC - 1.

compute_next(NL, _NC, Lig, 0, down, Lig1, 0, up) :-
	Lig < NL - 1,
	Lig1 is Lig+1.

compute_next(NL, _NC, Lig, 0, down, Lig, 1, up) :-
	Lig is NL - 1.

compute_next(NL, _NC, Lig, Col, down, Lig1, Col1, down) :-
	Lig < NL - 1,
	Lig1 is Lig + 1,
	Col1 is Col-1.

compute_next(NL, _NC, Lig, Col, down, Lig, Col1, up) :-
	Lig is NL - 1,
	Col1 is Col+1.

compute_next(_NL, NC, Lig, Col, up, Lig1, Col1, up) :-
	Col < NC - 1,
	Lig1 is Lig - 1,
	Col1 is Col+1.

compute_next(_NL, NC, Lig, Col, up, Lig1, Col, down) :-
	Col is NC - 1,
	Lig1 is Lig + 1.

print_line(L) :-
	maplist(print_val, L),
	nl.

print_val(V) :-
	writef('%3r ', [V]).


with javascript_semantics
constant n = {{-1,0},{-1,1},{0,1},{1,1},{1,0},{1,-1},{0,-1},{-1,-1},{-1,0}};

function AB(sequence text, integer y, x, step)
integer wtb = 0, bn = 0
integer prev = '#', next
string p2468 = ""
    for i=1 to length(n) do
        next = text[y+n[i][1]][x+n[i][2]]
        wtb += (prev='.' and next<='#')
        bn += (i>1 and next<='#')
        if and_bits(i,1)=0 then p2468 = append(p2468,prev) end if
        prev = next
    end for
    if step=2 then -- make it p6842
        p2468 = p2468[3..4]&p2468[1..2]
    end if
    return {wtb,bn,p2468}
end function

procedure Zhang_Suen(sequence text)
integer wtb, bn, changed, changes
string p2468    -- (p6842 for step 2)
    text = split(text,'\n')
    while 1 do
        changed = 0
        for step=1 to 2 do
            changes = 0
            for y=2 to length(text)-1 do
                for x=2 to length(text[y])-1 do
                    if text[y][x]='#' then
                        {wtb,bn,p2468} = AB(text,y,x,step)
                        if wtb=1
                        and bn>=2 and bn<=6
                        and find('.',p2468[1..3])
                        and find('.',p2468[2..4])then
                            changes = 1
                            text[y][x] = '!'    -- (logically still black)
                        end if
                    end if
                end for
            end for
            if changes then
                for y=2 to length(text)-1 do
                    text[y] = substitute(text[y],"!",".")
                end for
                changed = 1
            end if
        end for
        if not changed then exit end if
    end while
    puts(1,join(text,"\n"))
end procedure

string small_rc = """
................................
.#########.......########.......
.###...####.....####..####......
.###....###.....###....###......
.###...####.....###.............
.#########......###.............
.###.####.......###....###......
.###..####..###.####..####.###..
.###...####.###..########..###..
................................"""
Zhang_Suen(small_rc)


func GCD(N, D);         \Return the greatest common divisor of N and D
int  N, D, R;           \numerator, denominator, remainder
[if D > N then
    [R:=D; D:=N; N:=R]; \swap D and N
while D > 0 do
    [R:= rem(N/D);
    N:= D;
    D:= R;
    ];
return N;
];

int I, A(30+1), N, T;
[for I:= 1 to 3 do A(I):= I;                    \givens
N:= 4;
repeat  T:= 4;
        loop    [if GCD(T, A(N-1)) = 1 and      \relatively prime
                    GCD(T, A(N-2)) # 1 then     \not relatively prime
                        [loop   [for I:= 1 to N-1 do \test if in sequence
                                    if T = A(I) then quit;
                                quit;
                                ];
                        if I = N then           \T is not in sequence so
                            [A(N):= T;          \ add it in
                            N:= N+1;
                            quit;
                            ];
                        ];
                T:= T+1;                        \next trial
                ];
until   N > 30;
for N:= 1 to 30 do
    [IntOut(0, A(N));  ChOut(0, ^ )];
\\for N:= 1 to 100 do Point(N, A(N));           \plot demonstration
]


fcn yellowstoneW{	// --> iterator
   Walker.zero().tweak(fcn(a,b){
      foreach i in ([1..]){
         if(not b.holds(i) and i.gcd(a[-1])==1 and i.gcd(a[-2]) >1){
	    a.del(0).append(i);	// only keep last two terms
	    b[i]=True;
	    return(i);
	 }
      }
   }.fp(List(2,3), Dictionary(1,True, 2,True, 3,True))).push(1,2,3);
}


Procedure zigZag(size)
  Protected i, v, x, y

  Dim a(size - 1, size - 1)

  x = 1
  y = 1
  For i = 1 To  size * size  ;loop once for each element
    a(x - 1, y - 1) = v      ;assign the next index

    If (x + y) & 1 = 0       ;even diagonal (zero based count)
      If x < size            ;while inside the square
        If y > 1             ;move right-up
          y - 1
        EndIf
        x + 1
      Else
        y + 1                ;on the edge increment y, but not x until diagonal is odd
      EndIf
    Else                     ;odd diagonal (zero based count)
      If y < size            ;while inside the square
        If x > 1             ;move left-down
          x - 1
        EndIf
        y + 1
      Else
        x + 1                ;on the edge increment x, but not y until diagonal is even
      EndIf
    EndIf
    v + 1
  Next

  ;generate and show printout
  PrintN("Zig-zag matrix of size " + Str(size) + #CRLF$)
  maxDigitCount = Len(Str(size * size)) + 1
  For y = 0 To size - 1
    For x = 0 To size - 1
      Print(RSet(Str(a(x, y)), maxDigitCount, " "))
    Next
    PrintN("")
  Next
  PrintN("")
EndProcedure

If OpenConsole()
  zigZag(5)
  zigZag(6)

  Print(#CRLF$ + #CRLF$ + "Press ENTER to exit")
  Input()
  CloseConsole()
EndIf


def zigzag(n):
    '''zigzag rows'''
    def compare(xy):
        x, y = xy
        return (x + y, -y if (x + y) % 2 else y)
    xs = range(n)
    return {index: n for n, index in enumerate(sorted(
        ((x, y) for x in xs for y in xs),
        key=compare
    ))}

def printzz(myarray):
    '''show zigzag rows as lines'''
    n = int(len(myarray) ** 0.5 + 0.5)
    xs = range(n)
    print('\n'.join(
        [''.join("%3i" % myarray[(x, y)] for x in xs) for y in xs]
    ))

printzz(zigzag(6))


#lang racket
(define (img-01string->vector str)
  (define lines (regexp-split "\n" str))
  (define h (length lines))
  (define w (if (zero? h) 0 (string-length (car lines))))
  (define v (for*/vector #:length (* w h)
              ((l (in-list lines)) (p (in-string l)))
              (match p (#\0 0) (#\1 1) (#\# 1) (#\. 0))))
  (values v h w))

; Task (2) asks for "or an ASCII-art image of space/non-space characters."
; Spaces don't really impress where the borders are, so we'll use a dot.
(define cell->display-char (match-lambda (0 ".") (1 "#") (else "?")))

(define (display-img v w)
  (for ((p (in-vector v)) (col (in-naturals)))
    (printf "~a" (cell->display-char p))
    (when (= (modulo col w) (sub1 w)) (newline))))

; returns vector of ([P1's idx] P1 P2 ... P9)
(define (Pns v w r c)
  (define i (+ c (* r w)))
  (define-syntax-rule (vi+ x) (vector-ref v (+ i x)))
  (define-syntax-rule (vi- x) (vector-ref v (- i x)))
  (vector i (vi+ 0) (vi- w) (vi+ (- 1 w))
          (vi+ 1) (vi+ (+ w 1)) (vi+ w)
          (vi+ (- w 1)) (vi- 1) (vi- (+ w 1))))

; Second argument to in-vector is the start offset;
; We skip offset 0 (idx) and 1 (P1)
(define (B Ps) (for/sum ((Pn (in-vector Ps 2))) Pn))

(define (A Ps)
  (define P2 (vector-ref Ps 2))
  (define-values (rv _)
    (for/fold ((acc 0) (Pn-1 P2))
      ((Pn (in-sequences (in-vector Ps 3) (in-value P2))))
      (values (+ acc (if (and (= 0 Pn-1) (= 1 Pn)) 1 0)) Pn)))
  rv)

(define-syntax-rule (not-all-black? Pa Pb Pc) (zero? (* Pa Pb Pc)))
(define (z-s-thin v h w)
  ; return idx when thin necessary, #f otherwise
  (define (thin? Ps n/bour-check-1 n/bour-check-2)
    (match-define (vector idx P1 P2 _ P4 _ P6 _ P8 _) Ps)
    (and (= P1 1) (<= 2 (B Ps) 6) (= (A Ps) 1)
         (n/bour-check-1 P2 P4 P6 P8)
         (n/bour-check-2 P2 P4 P6 P8)
         idx))

  (define (has-white?-246 P2 P4 P6 P8) (not-all-black? P2 P4 P6))
  (define (has-white?-468 P2 P4 P6 P8) (not-all-black? P4 P6 P8))
  (define (has-white?-248 P2 P4 P6 P8) (not-all-black? P2 P4 P8))
  (define (has-white?-268 P2 P4 P6 P8) (not-all-black? P2 P6 P8))
  (define (step-n even-Pn-check-1 even-Pn-check-2)
    (for*/list ((r (in-range 1 (- h 1)))
                (c (in-range 1 (- w 1)))
                (idx (in-value (thin? (Pns v w r c)
                                      even-Pn-check-1
                                      even-Pn-check-2)))
                #:when idx) idx))

  (define (step-1) (step-n has-white?-246 has-white?-468))
  (define (step-2) (step-n has-white?-248 has-white?-268))
  (define (inner-z-s-thin)
    (define changed-list-1 (step-1))
    (for ((idx (in-list changed-list-1))) (vector-set! v idx 0))
    (define changed-list-2 (step-2))
    (for ((idx (in-list changed-list-2))) (vector-set! v idx 0))
    (unless (and (null? changed-list-1) (null? changed-list-2)) (inner-z-s-thin)))
  (inner-z-s-thin))

(define (read-display-thin-display-image img-str)
  (define-values (v h w) (img-01string->vector img-str))
  (printf "Original image:~%") (display-img v w)
  (z-s-thin v h w)
  (printf "Thinned image:~%") (display-img v w))

(define e.g.-image #<<EOS
00000000000000000000000000000000
01111111110000000111111110000000
01110001111000001111001111000000
01110000111000001110000111000000
01110001111000001110000000000000
01111111110000001110000000000000
01110111100000001110000111000000
01110011110011101111001111011100
01110001111011100111111110011100
00000000000000000000000000000000
EOS
  )

(define e.g.-image/2 #<<EOS
##..###
##..###
##..###
##..###
##..##.
##..##.
##..##.
##..##.
##..##.
##..##.
##..##.
##..##.
######.
.......
EOS
  )

(module+ main
  ; (read-display-thin-display-image e.g.-image/2)
  ; (newline)
  (read-display-thin-display-image e.g.-image))


   [ ]'[ tuck do dip do ]        is with2  ( x x --> x x )

   [ dup temp put
     [] swap
     dup * times [ i^ join ]
     sortwith
       [ with2
           [ temp share /mod
             tuck + 1 &
             if negate ]
         > ]
     sortwith
       [ with2
           [ temp share /mod + ]
         > ]
     dup witheach
       [ i^ unrot poke ]
     [] swap
     temp share times
       [ temp share split
         dip [ nested join ] ]
    drop
    temp release ]               is zigzag (   n --> [   )

  10 zigzag
  witheach
    [ witheach
       [ dup 10 < if sp
         echo sp ]
      cr ]


(define odd? A -> (= 1 (MOD A 2)))
(define even? A -> (= 0 (MOD A 2)))

(define zigzag-val
  0 0 N -> 0

  X 0 N -> (1+ (zigzag-val (1- X) 0 N)) where (odd? X)
  X 0 N -> (1+ (zigzag-val (1- X) 1 N))

  0 Y N -> (1+ (zigzag-val 1 (1- Y) N)) where (odd? Y)
  0 Y N -> (1+ (zigzag-val 0 (1- Y) N))

  X Y N -> (1+ (zigzag-val (MAX 0 (1- X)) (MIN (1- N) (1+ Y)) N)) where (even? (+ X Y))
  X Y N -> (1+ (zigzag-val (MIN (1- N) (1+ X)) (MAX 0 (1- Y)) N)))

(define range
  E E -> []
  S E -> [S|(range (1+ S) E)])

(define zigzag
  N -> (map (/. Y
                (map (/. X
                         (zigzag-val X Y N))
                     (range 0 N)))
            (range 0 N)))


/*REXX program thins a  NxM  character grid  using  the  Zhang-Suen thinning  algorithm.*/
parse arg iFID .;  if iFID==''  then iFID='ZHANG_SUEN.DAT'
white=' ';         @.=white                      /* [↓]  read the input character grid. */
           do row=1  while lines(iFID)\==0;  _=linein(iFID)
           _=translate(_,,.0);               cols.row=length(_)
               do col=1  for cols.row;  @.row.col=substr(_,col,1)
               end   /*col*/                     /* [↑]  assign whole row of characters.*/
           end       /*row*/
rows=row-1                                       /*adjust ROWS because of the  DO loop. */
call [email protected] 'input file ' iFID  " contents:"      /*display show the input character grid*/

  do  until  changed==0;    changed=0            /*keep slimming until we're finished.  */
       do step=1  for 2                          /*keep track of  step one  or step two.*/
         do     r=1  for rows                    /*process all the  rows  and  columns. */
             do c=1  for cols.r;  !.r.[email protected].r.c    /*assign an alternate grid.            */
             if r==1|r==rows|c==1|c==cols.r  then iterate             /*is this an edge?*/
             if @.r.c==white  then iterate       /*Is the character white?  Then skip it*/
             call Ps; b=b()                      /*define   Ps   and also   "b".        */
             if b<2 | b>6     then iterate       /*is   B   within the range ?          */
             if a()\==1       then iterate       /*count the number of transitions.     */    /*  ╔══╦══╦══╗  */
             if step==1       then if (p2 & p4 & p6)  |  p4 & p6 & p8  then iterate           /*  ║p9║p2║p3║  */
             if step==2       then if (p2 & p4 & p8)  |  p2 & p6 & p8  then iterate           /*  ╠══╬══╬══╣  */
             !.r.c=white                         /*set a grid character to  white.      */    /*  ║p8║p1║p4║  */
             changed=1                           /*indicate a character was changed.    */    /*  ╠══╬══╬══╣  */
             end   /*c*/                                                                      /*  ║p7║p6║p5║  */
         end       /*r*/                                                                      /*  ╚══╩══╩══╝  */
       call copy!                                /*copy the alternate to working grid.  */
       end         /*step*/
  end              /*until changed==0*/

call [email protected]  'slimmed output:'                    /*display the slimmed character grid.  */
exit                                             /*stick a fork in it,  we're all done. */
/*─────────────────────────────────────────────────────────────────────────────────────────────────────────────*/
a: return (\p2==p3&p3)+(\p3==p4&p4)+(\p4==p5&p5)+(\p5==p6&p6)+(\p6==p7&p7)+(\p7==p8&p8)+(\p8==p9&p9)+(\p9==p2&p2)
b: return p2 + p3 + p4 + p5 + p6 + p7 + p8 + p9
copy!:                        do r=1  for rows;       do c=1  for cols.r;        @.r.c=!.r.c;  end;  end;  return
[email protected]: say; say arg(1); say;  do r=1  for rows; _=;   do c=1  for cols.r; _=_ || @.r.c; end;  say _; end;  return
/*──────────────────────────────────────────────────────────────────────────────────────*/
Ps:  rm=r-1;  rp=r+1;  cm=c-1;  cp=c+1                       /*calculate some shortcuts.*/
     [email protected].rm.c\==white; [email protected].rm.cp\==white; [email protected].r.cp\==white; [email protected].rp.cp\==white
     [email protected].rp.c\==white; [email protected].rp.cm\==white; [email protected].r.cm\==white; p[email protected].rm.cm\==white; return


zigzag1 <- function(n) {
  j <- seq(n)
  u <- rep(c(-1, 1), n)
  v <- j * (2 * j - 1) - 1
  v <- as.vector(rbind(v, v + 1))
  a <- matrix(0, n, n)
  for (i in seq(n)) {
    a[i, ] <- v[j + i - 1]
    v <- v + u
  }
  a
}

zigzag1(5)


#lang racket

(define/match (compare i j)
  [((list x y) (list a b)) (or (< x a) (and (= x a) (< y b)))])

(define/match (key i)
  [((list x y)) (list (+ x y) (if (even? (+ x y)) (- y) y))])

(define (zigzag-ht n)
  (define indexorder
    (sort (for*/list ([x n] [y n]) (list x y))
          compare #:key key))
  (for/hash ([(n i) (in-indexed indexorder)]) (values n i)))

(define (zigzag n)
  (define ht (zigzag-ht n))
  (for/list ([x n])
    (for/list ([y n])
      (hash-ref ht (list x y)))))

(zigzag 4)


class Turtle {
    my @dv =  [0,-1], [1,-1], [1,0], [1,1], [0,1], [-1,1], [-1,0], [-1,-1];
    my $points = 8; # 'compass' points of neighbors on grid: north=0, northeast=1, east=2, etc.

    has @.loc = 0,0;
    has $.dir = 0;
    has %.world;
    has $.maxegg;
    has $.range-x;
    has $.range-y;

    method turn-left ($angle = 90) { $!dir -= $angle / 45; $!dir %= $points; }
    method turn-right($angle = 90) { $!dir += $angle / 45; $!dir %= $points; }

    method lay-egg($egg) {
    %!world{~@!loc} = $egg;
    $!maxegg max= $egg;
    $!range-x minmax= @!loc[0];
    $!range-y minmax= @!loc[1];
    }

    method look($ahead = 1) {
    my $there = @!loc »+« @dv[$!dir] »*» $ahead;
    %!world{~$there};
    }

    method forward($ahead = 1) {
    my $there = @!loc »+« @dv[$!dir] »*» $ahead;
    @!loc = @($there);
    }

    method showmap() {
    my $form = "%{$!maxegg.chars}s";
    my $endx = $!range-x.max;
        for $!range-y.list X $!range-x.list -> ($y, $x) {
        print (%!world{"$x $y"} // '').fmt($form);
        print $x == $endx ?? "\n" !! ' ';
    }
    }
}

sub MAIN(Int $size = 5) {
    my $t = Turtle.new(dir => 1);
    my $counter = 0;
    for 1 ..^ $size -> $run {
	for ^$run {
	    $t.lay-egg($counter++);
	    $t.forward;
	}
	my $yaw = $run %% 2 ?? -1 !! 1;
	$t.turn-right($yaw * 135); $t.forward; $t.turn-right($yaw * 45);
    }
    for $size ... 1 -> $run {
	for ^$run -> $ {
	    $t.lay-egg($counter++);
	    $t.forward;
	}
	$t.turn-left(180); $t.forward;
	my $yaw = $run %% 2 ?? 1 !! -1;
	$t.turn-right($yaw * 45); $t.forward; $t.turn-left($yaw * 45);
    }
    $t.showmap;
}


/*REXX program  produces and displays a    zig─zag  matrix   (a square array).          */
parse arg n start inc .                          /*obtain optional arguments from the CL*/
if     n=='' |     n==","  then     n= 5         /*Not specified?  Then use the default.*/
if start=='' | start==","  then start= 0         /* "      "         "   "   "     "    */
if   inc=='' |   inc==","  then   inc= 1         /* "      "         "   "   "     "    */
row= 1;           col= 1;        size= n**2      /*start: 1st row & column;  array size.*/
        do j=start  by inc  for size;    @.row.col= j
        if (row+col)//2==0  then do;  if col<n    then col= col+1;     else row= row+2
                                      if row\==1  then row= row-1
                                 end
                            else do;  if row<n    then row= row+1;     else col= col+2
                                      if col\==1  then col= col-1
                                 end
        end   /*j*/                              /* [↑]     //    is REXX  ÷  remainder.*/
call show                                        /*display a (square) matrix──►terminal.*/
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
show: w= max(length(start), length(start+size*inc))  /*max width of any matrix elements,*/
        do   r=1  for n  ;  _=   right(@.r.1, w)     /*show the rows of the matrix.     */
          do c=2  for n-1;  _= _ right(@.r.c, w)     /*build a line for output of a row.*/
          end   /*c*/;  say _                        /* [↑]  align the matrix elements. */
        end     /*r*/;      return


# -*- coding: utf-8 -*-

set data {
00000000000000000000000000000000
01111111110000000111111110000000
01110001111000001111001111000000
01110000111000001110000111000000
01110001111000001110000000000000
01111111110000001110000000000000
01110111100000001110000111000000
01110011110011101111001111011100
01110001111011100111111110011100
00000000000000000000000000000000
}
proc zhang-suen data {
    set data [string trim $data]
    while 1 {
	set n 0
	incr n [step 1 data]
	incr n [step 2 data]
	if !$n break
    }
    return $data
}
proc step {number _data} {
    upvar 1 $_data data
    set xmax [string length [lindex $data 0]]
    set ymax [llength $data]
    switch -- $number {
	1 {set cond {(!$P2 || !$P4 || !$P6) && (!$P4 || !$P6 || !$P8)}}
	2 {set cond {(!$P2 || !$P4 || !$P8) && (!$P2 || !$P6 || !$P8)}}
    }
    set hits {}
    for {set x 1} {$x < $xmax-1} {incr x} {
	for {set y 1} {$y < $ymax-1} {incr y} {
	    if {[getpix $data $x $y] == 1} {
		set b [B $data $x $y]
		if {2 <= $b && $b <= 6} {
		    if {[A $data $x $y] == 1} {
			set P2 [getpix $data $x [expr $y-1]]
			set P4 [getpix $data [expr $x+1] $y]
			set P6 [getpix $data $x [expr $y+1]]
			set P8 [getpix $data [expr $x-1] $y]
			if $cond {lappend hits $x $y}
		    }
		}
	    }
	}
    }
    foreach {x y} $hits {set data [setpix $data $x $y 0]}
    return [llength $hits]
}
proc A {data x y} {
    set res 0
    set last [getpix $data $x [expr $y-1]]
    foreach {dx dy} {1 -1  1 0  1 1  0 1  -1 1  -1 0  -1 -1  0 -1} {
	set this [getpix $data [expr $x+$dx] [expr $y+$dy]]
	if {$this > $last} {incr res}
	set last $this
    }
    return $res
}
proc B {data x y} {
    set res 0
    foreach {dx dy} {1 -1  1 0  1 1  0 1  -1 1  -1 0  -1 -1  0 -1} {
	incr res [getpix $data [expr $x+$dx] [expr $y+$dy]]
    }
    return $res
}
proc getpix {data x y} {
    string index [lindex $data $y] $x
}
proc setpix {data x y val} {
    set row [lindex $data $y]
    lset data $y [string replace $row $x $x $val]
    return $data
}
puts [string map {1 @ 0 .} [join [zhang-suen $data] \n]]


# Project  Zig-zag matrix

load "guilib.ring"
load "stdlib.ring"
new qapp
        {
        win1 = new qwidget() {
                  setwindowtitle("Zig-zag matrix")
                  setgeometry(100,100,600,400)
                  n = 5
                  a = newlist(n,n)
                  zigzag = newlist(n,n)
                  for j = 1 to n
                       for i = 1 to n
                            a[j][i] = 0
                       next
                  next
                  i = 1
                  j = 1
                  k = 1
                  while k < n * n
                          a[j][i] = k
                          k = k + 1
                          if i = n
                             j = j + 1
                             a[j][i] = k
                             k = k + 1
                             di = -1
                             dj = 1
                          ok
                          if j = 1
                             i = i + 1
                             a[j][i] = k
                             k = k + 1
                             di = -1
                             dj = 1
                          ok
                          if j = n
                             i = i + 1
                             a[j][i] = k
                             k = k + 1
                             di = 1
                             dj = -1
                          ok
                          if i = 1
                             j = j + 1
                             a[j][i] = k
                             k = k + 1
                             di = 1
                             dj = -1
                          ok
                          i = i + di
                          j = j + dj
                  end
                  for p = 1 to n
                       for m = 1 to n
                            zigzag[p][m] = new qpushbutton(win1) {
                                                  x = 150+m*40
                                                  y = 30 + p*40
                                                  setgeometry(x,y,40,40)
                                                  settext(string(a[p][m]))
                                                  }
                       next
                  next
        show()
        }
        exec()
        }


def zigzag(n)
  (seq=*0...n).product(seq)
    .sort_by {|x,y| [x+y, (x+y).even? ? y : -y]}
    .each_with_index.sort.map(&:last).each_slice(n).to_a
end

def print_matrix(m)
  format = "%#{m.flatten.max.to_s.size}d " * m[0].size
  puts m.map {|row| format % row}
end

print_matrix zigzag(5)


Public n As Variant
Private Sub init()
    n = [{-1,0;-1,1;0,1;1,1;1,0;1,-1;0,-1;-1,-1;-1,0}]
End Sub

Private Function AB(text As Variant, y As Integer, x As Integer, step As Integer) As Variant
    Dim wtb As Integer
    Dim bn As Integer
    Dim prev As String: prev = "#"
    Dim next_ As String
    Dim p2468 As String
    For i = 1 To UBound(n)
        next_ = Mid(text(y + n(i, 1)), x + n(i, 2), 1)
        wtb = wtb - (prev = "." And next_ <= "#")
        bn = bn - (i > 1 And next_ <= "#")
        If (i And 1) = 0 Then p2468 = p2468 & prev
        prev = next_
    Next i
    If step = 2 Then '-- make it p6842
        p2468 = Mid(p2468, 3, 2) & Mid(p2468, 1, 2)
        'p2468 = p2468(3..4)&p2468(1..2)
    End If
    Dim ret(2) As Variant
    ret(0) = wtb
    ret(1) = bn
    ret(2) = p2468
    AB = ret
End Function

Private Sub Zhang_Suen(text As Variant)
    Dim wtb As Integer
    Dim bn As Integer
    Dim changed As Boolean, changes As Boolean
    Dim p2468 As String     '-- (p6842 for step 2)
    Dim x As Integer, y As Integer, step As Integer
    Do While True
        changed = False
        For step = 1 To 2
            changes = False
            For y = 1 To UBound(text) - 1
                For x = 2 To Len(text(y)) - 1
                    If Mid(text(y), x, 1) = "#" Then
                        ret = AB(text, y, x, step)
                        wtb = ret(0)
                        bn = ret(1)
                        p2468 = ret(2)
                        If wtb = 1 _
                            And bn >= 2 And bn <= 6 _
                            And InStr(1, Mid(p2468, 1, 3), ".") _
                            And InStr(1, Mid(p2468, 2, 3), ".") Then
                            changes = True
                            text(y) = Left(text(y), x - 1) & "!" & Right(text(y), Len(text(y)) - x)
                        End If
                    End If
                Next x
            Next y
            If changes Then
                For y = 1 To UBound(text) - 1
                    text(y) = Replace(text(y), "!", ".")
                Next y
                changed = True
            End If
        Next step
        If Not changed Then Exit Do
    Loop
    Debug.Print Join(text, vbCrLf)
End Sub

Public Sub main()
    init
    Dim Small_rc(9) As String
    Small_rc(0) = "................................"
    Small_rc(1) = ".#########.......########......."
    Small_rc(2) = ".###...####.....####..####......"
    Small_rc(3) = ".###....###.....###....###......"
    Small_rc(4) = ".###...####.....###............."
    Small_rc(5) = ".#########......###............."
    Small_rc(6) = ".###.####.......###....###......"
    Small_rc(7) = ".###..####..###.####..####.###.."
    Small_rc(8) = ".###...####.###..########..###.."
    Small_rc(9) = "................................"
    Zhang_Suen (Small_rc)
End Sub


use std::cmp::Ordering;
use std::cmp::Ordering::{Equal, Greater, Less};
use std::iter::repeat;

#[derive(Debug, PartialEq, Eq)]
struct SortIndex {
    x: usize,
    y: usize,
}

impl SortIndex {
    fn new(x: usize, y: usize) -> SortIndex {
        SortIndex { x, y }
    }
}

impl PartialOrd for SortIndex {
    fn partial_cmp(&self, other: &SortIndex) -> Option<Ordering> {
        Some(self.cmp(other))
    }
}

impl Ord for SortIndex {
    fn cmp(&self, other: &SortIndex) -> Ordering {
        let lower = if self.x + self.y == other.x + other.y {
            if (self.x + self.y) % 2 == 0 {
                self.x < other.x
            } else {
                self.y < other.y
            }
        } else {
            (self.x + self.y) < (other.x + other.y)
        };

        if lower {
            Less
        } else if self == other {
            Equal
        } else {
            Greater
        }
    }
}

fn zigzag(n: usize) -> Vec<Vec<usize>> {
    let mut l: Vec<SortIndex> = (0..n * n).map(|i| SortIndex::new(i % n, i / n)).collect();
    l.sort();

    let init_vec = vec![0; n];
    let mut result: Vec<Vec<usize>> = repeat(init_vec).take(n).collect();
    for (i, &SortIndex { x, y }) in l.iter().enumerate() {
        result[y][x] = i
    }
    result
}

fn main() {
    println!("{:?}", zigzag(5));
}


  def zigzag(n: Int): Array[Array[Int]] = {
    val l = for (i <- 0 until n*n) yield (i%n, i/n)
    val lSorted = l.sortWith {
      case ((x,y), (u,v)) =>
        if (x+y == u+v)
          if ((x+y) % 2 == 0) x<u else y<v
        else x+y < u+v
    }
    val res = Array.ofDim[Int](n, n)
    lSorted.zipWithIndex foreach {
      case ((x,y), i) => res(y)(x) = i
    }
    res
  }

  zigzag(5).foreach{
    ar => ar.foreach(x => print("%3d".format(x)))
    println
  }


$ include "seed7_05.s7i";

const type: matrix is array array integer;

const func matrix: zigzag (in integer: size) is func
  result
    var matrix: s is matrix.value;
  local
    var integer: i is 1;
    var integer: j is 1;
    var integer: d is -1;
    var integer: max is 0;
    var integer: n is 0;
  begin
    s := size times size times 0;
    max := size ** 2;
    for n range 1 to max div 2 + 1 do
      s[i][j] := n;
      s[size - i + 1][size - j + 1] := max - n + 1;
      i +:= d;
      j -:= d;
      if i < 1 then
        incr(i);
        d := -d;
      elsif j < 1 then
        incr(j);
        d := -d;
      end if;
    end for;
  end func;

const proc: main is func
  local
    var matrix: s is matrix.value;
    var integer: i is 0;
    var integer: num is 0;
  begin
    s := zigzag(7);
    for i range 1 to length(s) do
      for num range s[i] do
        write(num lpad 4);
      end for;
      writeln;
    end for;
  end func;


fun rowprint r = (List.app (fn i => print (StringCvt.padLeft #" " 3 (Int.toString i))) r;
                  print "\n");
fun zig lst M  =  List.app rowprint (lst M);

fun sign t = if t mod 2 = 0 then ~1 else 1;

fun zag n = List.tabulate (n,
            fn i=> rev ( List.tabulate (n,
                        fn j =>
			     let val t = n-j+i  and  u =  n+j-i  in
			         if i <= j
                                    then   t*t div 2 + sign t * ( t div 2 - i )
                                    else   n*n - 1 - ( u*u div 2 + sign u * ( u div 2 - n + 1 + i) )
	                      end
			 )));

zig zag 5 ;


proc zigzag {size} {
    set m [lrepeat $size [lrepeat $size .]]
    set x 0; set dx -1
    set y 0; set dy 1

    for {set i 0} {$i < $size ** 2} {incr i} {
        if {$x >= $size} {
            incr x -1
            incr y 2
            negate dx dy
        } elseif {$y >= $size} {
            incr x 2
            incr y -1
            negate dx dy
        } elseif {$x < 0 && $y >= 0} {
            incr x
            negate dx dy
        } elseif {$x >= 0 && $y < 0} {
            incr y
            negate dx dy
        }
        lset m $x $y $i
        incr x $dx
        incr y $dy
    }
    return $m
}

proc negate {args} {
    foreach varname $args {
        upvar 1 $varname var
        set var [expr {-1 * $var}]
    }
}

print_matrix [zigzag 5]


S = 5

i = 1
j = 1

For e = 0 To (S*S)-1
  @((i-1) * S + (j-1)) = e

  If (i + j) % 2 = 0 Then

    If j < S Then
      j = j + 1
    Else
      i = i + 2
    EndIf

    If i > 1 Then
      i = i - 1
    EndIf
  Else

    If i < S
      i = i + 1
    Else
      j = j + 2
    EndIf

    If j > 1
      j = j - 1
    EndIf
  EndIf
Next

For r = 0 To S-1
  For c = 0 To S-1
    Print Using "___#";@(r * S + c);
  Next
  Print
Next


#import std
#import nat

zigzag = ~&mlPK2xnSS+ num+ ==+sum~~|[email protected]+ iota


Public Sub zigzag(n)
Dim a() As Integer
'populate a (1,1) to a(n,n) in zigzag pattern

'check if n too small
If n < 1 Then
  Debug.Print "zigzag: enter a number greater than 1"
  Exit Sub
End If

'initialize
ReDim a(1 To n, 1 To n)
i = 1       'i is the row
j = 1       'j is the column
P = 0       'P is the next number
a(i, j) = P 'fill in initial value

'now zigzag through the matrix and fill it in
Do While (i <= n) And (j <= n)
  'move one position to the right or down the rightmost column, if possible
  If j < n Then
    j = j + 1
  ElseIf i < n Then
    i = i + 1
  Else
    Exit Do
  End If
  'fill in
  P = P + 1: a(i, j) = P
  'move down to the left
  While (j > 1) And (i < n)
    i = i + 1: j = j - 1
    P = P + 1: a(i, j) = P
  Wend
  'move one position down or to the right in the bottom row, if possible
  If i < n Then
    i = i + 1
  ElseIf j < n Then
    j = j + 1
  Else
    Exit Do
  End If
  P = P + 1: a(i, j) = P
  'move back up to the right
  While (i > 1) And (j < n)
    i = i - 1: j = j + 1
    P = P + 1: a(i, j) = P
  Wend
Loop

'print result
Debug.Print "Result for n="; n; ":"
For i = 1 To n
  For j = 1 To n
    Debug.Print a(i, j),
  Next
  Debug.Print
Next
End Sub


ZigZag(Cint(WScript.Arguments(0)))

Function ZigZag(n)
	Dim arrZ()
	ReDim arrZ(n-1,n-1)
	i = 1
	j = 1
	For e = 0 To (n^2) - 1
		arrZ(i-1,j-1) = e
		If ((i + j ) And 1) = 0 Then
			If j < n Then
				j = j + 1
			Else
				i = i + 2
			End If
			If i > 1 Then
				i = i - 1
			End If
		Else
			If i < n Then
				i = i + 1
			Else
				j = j + 2
			End If
			If j > 1 Then
				j = j - 1
			End If
		End If
	Next
	For k = 0 To n-1
		For l = 0 To n-1
			WScript.StdOut.Write Right("  " & arrZ(k,l),3)
		Next
		WScript.StdOut.WriteLine
	Next
End Function


import "/fmt" for Conv, Fmt

var zigzag = Fn.new { |n|
    var r = List.filled(n*n, 0)
    var i = 0
    var n2 = n * 2
    for (d in 1..n2) {
        var x = d - n
        if (x < 0) x = 0
        var y = d - 1
        if (y > n - 1) y = n - 1
        var j = n2 - d
        if (j > d) j = d
        for (k in 0...j) {
            if (d&1 == 0) {
                r[(x+k)*n+y-k] = i
            } else {
                r[(y-k)*n+x+k] = i
            }
            i = i + 1
        }
    }
    return r
}

var n = 5
var w = Conv.itoa(n*n - 1).count
var i = 0
for (e in zigzag.call(n)) {
    Fmt.write("$*d ", w, e)
    if (i%n == n - 1) System.print()
    i = i + 1
}


Size = 5
DIM array(Size-1, Size-1)

i = 1
j = 1
FOR e = 0 TO Size^2-1
  array(i-1, j-1) = e
  IF and((i + j), 1) = 0 THEN
    IF j < Size then j = j + 1 ELSE i = i + 2 end if
    IF i > 1 i = i - 1
  ELSE
    IF i < Size then i = i + 1 ELSE j = j + 2 end if
    IF j > 1 j = j - 1
  ENDIF
NEXT e

FOR row = 0 TO Size-1
  FOR col = 0 TO Size-1
    PRINT array(row,col) USING "##";
  NEXT col
  PRINT
NEXT row


fcn zz(n){
   grid := (0).pump(n,List, (0).pump(n,List).copy).copy();
   ri := Ref(0);
   foreach d in ([1..n*2]){
      x:=(0).max(d - n); y:=(n - 1).min(d - 1);
      (0).pump(d.min(n*2 - d),Void,'wrap(it){
         grid[if(d%2)y-it else x+it][if(d%2)x+it else y-it] = ri.inc();
      });
   }
   grid.pump(String,'wrap(r){("%3s"*n+"\n").fmt(r.xplode())});
}


/* ARM assembly AARCH64 Raspberry PI 3B */
/*  program xpathXml64.s   */

/*******************************************/
/* Constantes file                         */
/*******************************************/
/* for this file see task include a file in language AArch64 assembly*/
.include "../includeConstantesARM64.inc"

.equ NBMAXELEMENTS,    100

/*******************************************/
/* Structures                               */
/********************************************/
/* structure xmlNode*/
    .struct  0
xmlNode_private:                         // application data
    .struct  xmlNode_private + 8
xmlNode_type:                            // type number, must be second !
    .struct  xmlNode_type + 8
xmlNode_name:                            // the name of the node, or the entity
    .struct  xmlNode_name + 8
xmlNode_children:                        // parent->childs link
    .struct  xmlNode_children + 8
xmlNode_last:                            // last child link
    .struct  xmlNode_last + 8
xmlNode_parent:                          // child->parent link
    .struct  xmlNode_parent + 8
xmlNode_next:                            // next sibling link
    .struct  xmlNode_next + 8
xmlNode_prev:                            // previous sibling link
    .struct  xmlNode_prev + 8
xmlNode_doc:                             // the containing document
    .struct  xmlNode_doc + 8
xmlNode_ns:                              // pointer to the associated namespace
    .struct  xmlNode_ns + 8
xmlNode_content:                         // the content
    .struct  xmlNode_content + 8
xmlNode_properties:                      // properties list
    .struct  xmlNode_properties + 8
xmlNode_nsDef:                           // namespace definitions on this node
    .struct  xmlNode_nsDef + 8
xmlNode_psvi:                            // for type/PSVI informations
    .struct  xmlNode_psvi + 8
xmlNode_line:                            // line number
    .struct  xmlNode_line + 4
xmlNode_extra:                           // extra data for XPath/XSLT
    .struct  xmlNode_extra + 4
xmlNode_fin:
/********************************************/
/* structure xmlNodeSet*/
    .struct  0
xmlNodeSet_nodeNr:                       // number of nodes in the set
    .struct  xmlNodeSet_nodeNr + 4
xmlNodeSet_nodeMax:                      // size of the array as allocated
    .struct  xmlNodeSet_nodeMax + 4
xmlNodeSet_nodeTab:                      // array of nodes in no particular order
    .struct  xmlNodeSet_nodeTab + 8
xmlNodeSet_fin:
/********************************************/
/* structure xmlXPathObject*/
    .struct  0
xmlPathObj_type:                         //
    .struct  xmlPathObj_type + 8
xmlPathObj_nodesetval:                   //
    .struct  xmlPathObj_nodesetval + 8
xmlPathObj_boolval:                      //
    .struct  xmlPathObj_boolval + 8
xmlPathObj_floatval:                     //
    .struct  xmlPathObj_floatval + 8
xmlPathObj_stringval:                    //
    .struct  xmlPathObj_stringval + 8
xmlPathObj_user:                         //
    .struct  xmlPathObj_user + 8
xmlPathObj_index:                        //
    .struct  xmlPathObj_index + 8
xmlPathObj_usex2:                        //
    .struct  xmlPathObj_usex2 + 8
xmlPathObj_index2:                       //
    .struct  xmlPathObj_index2 + 8
/*********************************/
/* Initialized data              */
/*********************************/
.data
szMessEndpgm:      .asciz "\nNormal end of program.\n"
szMessDisVal:      .asciz "\nDisplay set values.\n"
szMessDisArea:     .asciz "\nDisplay area values.\n"
szFileName:        .asciz "testXml.xml"
szMessError:       .asciz "Error detected !!!!. \n"

szLibName:         .asciz "name"
szLibPrice:        .asciz "//price"
szLibExtName:      .asciz "//name"
szCarriageReturn:  .asciz "\n"

/*********************************/
/* UnInitialized data            */
/*********************************/
.bss
.align 4
tbExtract:          .skip 8 * NBMAXELEMENTS      // result extract area
/*********************************/
/*  code section                 */
/*********************************/
.text
.global main
main:                                     // entry of program
    ldr x0,qAdrszFileName
    bl xmlParseFile                       // create doc
    cbz x0,99f                            // error ?
    mov x19,x0                            // doc address
    mov x0,x19                            // doc
    bl xmlDocGetRootElement               // get root
    bl xmlFirstElementChild               // get first section
    bl xmlFirstElementChild               // get first item
    bl xmlFirstElementChild               // get first name
    bl xmlNodeGetContent                  // extract content
    bl affichageMess                      // for display
    ldr x0,qAdrszCarriageReturn
    bl affichageMess

    ldr x0,qAdrszMessDisVal
    bl affichageMess
    mov x0,x19
    ldr x1,qAdrszLibPrice                 // extract prices
    bl extractValue
    mov x0,x19
    ldr x1,qAdrszLibExtName               // extract names
    bl extractValue
    ldr x0,qAdrszMessDisArea
    bl affichageMess
    mov x4,#0                             // display string result area
    ldr x5,qAdrtbExtract
1:
    ldr x0,[x5,x4,lsl #3]
    cbz x0,2f
    bl affichageMess
    ldr x0,qAdrszCarriageReturn
    bl affichageMess
    add x4,x4,1
    b 1b
2:
    mov x0,x19
    bl xmlFreeDoc
    bl xmlCleanupParser
    ldr x0,qAdrszMessEndpgm
    bl affichageMess
    b 100f
99:                                       // error
    ldr x0,qAdrszMessError
    bl affichageMess
100:                                      // standard end of the program
    mov x0,0                              // return code
    mov x8,EXIT                           // request to exit program
    svc 0                                 // perform the system call

qAdrszMessError:          .quad szMessError
qAdrszMessEndpgm:         .quad szMessEndpgm
qAdrszLibName:            .quad szLibName
qAdrszLibPrice:           .quad szLibPrice
qAdrszCarriageReturn:     .quad szCarriageReturn
qAdrszFileName:           .quad szFileName
qAdrszLibExtName:         .quad szLibExtName
qAdrtbExtract:            .quad tbExtract
qAdrszMessDisVal:          .quad szMessDisVal
qAdrszMessDisArea:         .quad szMessDisArea
/******************************************************************/
/*     extract value of set                                       */
/******************************************************************/
/* x0 contains the doc address
/* x1 contains the address of the libel to extract */
extractValue:
    stp x19,lr,[sp,-16]!                 // save  registers
    stp x20,x21,[sp,-16]!                // save  registers
    stp x22,x23,[sp,-16]!                // save  registers
    mov x20,x1                           // save address libel
    mov x19,x0                           // save doc
    bl xmlXPathNewContext                // create context
    mov x23,x0                           // save context
    mov x1,x0
    mov x0,x20
    bl xmlXPathEvalExpression
    mov x21,x0
    mov x0,x23
    bl xmlXPathFreeContext               // free context
    cmp x21,#0
    beq 100f
    ldr x14,[x21,#xmlPathObj_nodesetval] // values set
    ldr w23,[x14,#xmlNodeSet_nodeNr]     // set size
    mov x22,#0                           // index
    ldr x20,[x14,#xmlNodeSet_nodeTab]    // area of nodes
    ldr x21,qAdrtbExtract
1:                                       // start loop
    ldr x3,[x20,x22,lsl #3]              // load node
    mov x0,x19
    ldr x1,[x3,#xmlNode_children]        // load string value
    mov x2,#1
    bl xmlNodeListGetString
    str x0,[x21,x22,lsl #3]              // store string pointer in area
    bl affichageMess                     // and display string result
    ldr x0,qAdrszCarriageReturn
    bl affichageMess
    add x22,x22,1
    cmp x22,x23
    blt 1b
100:
    ldp x22,x23,[sp],16                  // restaur  2 registers
    ldp x20,x21,[sp],16                  // restaur  2 registers
    ldp x19,lr,[sp],16                   // restaur  2 registers
    ret                                  // return to address lr x30
/********************************************************/
/*        File Include fonctions                        */
/********************************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeARM64.inc"


set theXMLdata to "<inventory title=\"OmniCorp Store #45x10^3\">

    <item upc=\"123456789\" stock=\"12\">
      <name>Invisibility Cream</name>
      <price>14.50</price>
      <description>Makes you invisible</description>
    </item>
    <item upc=\"445322344\" stock=\"18\">
      <name>Levitation Salve</name>
      <price>23.99</price>
      <description>Levitate yourself for up to 3 hours per application</description>
    </item>

    <item upc=\"485672034\" stock=\"653\">
      <name>Blork and Freen Instameal</name>
      <price>4.95</price>
      <description>A tasty meal in a tablet; just add water</description>
    </item>
    <item upc=\"132957764\" stock=\"44\">
      <name>Grob winglets</name>
      <price>3.56</price>
      <description>Tender winglets of Grob. Just add water</description>
    </item>

</inventory>"

on getElementValuesByName(theXML, theNameToFind)
	set R to {}
	tell application "System Events"
		repeat with i in theXML
			set {theName, theElements} to {i's name, i's XML elements}
			if (count of theElements) > 0 then set R to R & my getElementValuesByName(theElements, theNameToFind)
			if theName = theNameToFind then set R to R & i's value
		end repeat
	end tell
	return R
end getElementValuesByName

on getBlock(theXML, theItem, theInstance)
	set text item delimiters to ""
	repeat with i from 1 to theInstance
		set {R, blockStart, blockEnd} to {{}, "<" & theItem & space, "</" & theItem & ">"}
		set x to offset of blockStart in theXML
		if x = 0 then exit repeat
		set y to offset of blockEnd in (characters x thru -1 of theXML as string)
		if y = 0 then exit repeat
		set R to characters x thru (x + y + (length of blockEnd) - 2) of theXML as string
		set theXML to characters (y + (length of blockEnd)) thru -1 of theXML as string
	end repeat
	return R
end getBlock

tell application "System Events"
	set xmlData to make new XML data with properties {name:"xmldata", text:theXMLdata}

	return my getBlock(xmlData's text, "item", 1) -- Solution to part 1 of problem.
	return my getElementValuesByName(xmlData's contents, "name") -- Solution to part 2 of problem.
	return my getElementValuesByName(xmlData's contents, "price") -- Solution to part 3 of problem.

end tell