[User]
The **Yellowstone sequence**, also called the **Yellowstone permutation**, is defined as:

For n <= 3,

```
   a(n) = n

```

For n >= 4,

```
   a(n) = the smallest number not already in sequence such that a(n) is relatively prime to a(n-1) and
          is not relatively prime to a(n-2).

```

The sequence is a permutation of the natural numbers, and gets its name from what its authors felt was a spiking, geyser like appearance of a plot of the sequence.

Example

a(4) is 4 because 4 is the smallest number following 1, 2, 3 in the sequence that is relatively prime to the entry before it (3), and is not relatively prime to the number two entries before it (2).

Task
:   Find and show as output the first  **30**  Yellowstone numbers.

Extra
:   Demonstrate how to plot, with x = n and y coordinate a(n), the first 100 Yellowstone numbers.

Related tasks
:   * Greatest common divisor.
    * Plot coordinate pairs.
    * EKG sequence convergence

See also
:   * The OEIS entry:   A098550 The Yellowstone permutation.
    * Applegate et al, 2015: The Yellowstone Permutation [1].

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2020.01

Not really clear whether a line graph or bar graph was desired, so generate both. Also, 100 points don't really give a good feel for the overall shape so do 500.

```
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 {+@x} 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;

```

Output:

```
The first 30 terms in the Yellowstone sequence:
1 2 3 4 9 8 15 14 5 6 25 12 35 16 7 10 21 20 27 22 39 11 13 33 26 45 28 51 32 17
```

See (offsite SVG images) Line graph or Bar graph


[User]
One well-known symbol of the philosophy of duality known as yin and yang is the taijitu.

Task
:   * Create a function that, given a parameter representing size, generates such a symbol scaled to the requested size.
    * Generate and display the symbol for two different (small) sizes.

[Assistant]
(formerly Perl 6)

Translation / Modification of C and Perl examples.

```
sub circle ($rad, $cx, $cy, $fill = 'white', $stroke = 'black' ){
    say "<circle cx='$cx' cy='$cy' r='$rad' fill='$fill' stroke='$stroke' stroke-width='1'/>";
}

sub yin_yang ($rad, $cx, $cy, :$fill = 'white', :$stroke = 'black', :$angle = 90) {
    my ($c, $w) = (1, 0);
    say "<g transform='rotate($angle, $cx, $cy)'>" if $angle;
    circle($rad, $cx, $cy, $fill, $stroke);
    say "<path d='M $cx {$cy + $rad}A {$rad/2} {$rad/2} 0 0 $c $cx $cy ",
        "{$rad/2} {$rad/2} 0 0 $w $cx {$cy - $rad} $rad $rad 0 0 $c $cx ",
        "{$cy + $rad} z' fill='$stroke' stroke='none' />";
    circle($rad/5, $cx, $cy + $rad/2, $fill, $stroke);
    circle($rad/5, $cx, $cy - $rad/2, $stroke, $fill);
    say "</g>" if $angle;
}

say '<?xml version="1.0" encoding="UTF-8" standalone="no"?>
<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN" "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">
<svg height="400" width="400" xmlns="http://www.w3.org/2000/svg" version="1.1"
 xmlns:xlink="http://www.w3.org/1999/xlink">';

yin_yang(100, 130, 130);
yin_yang(50, 300, 300);

say '</svg>';

```

Seems like something of a cheat since it relies on a web browser /
svg image interpreter to actually view the output image.
If that's the case, we may as well cheat harder. ;-)

```
sub cheat_harder ($scale) { "<span style=\"font-size:$scale%;\">☯</span>"; }

say '<div>', cheat_harder(700), cheat_harder(350), '</div>';

```

☯☯


[User]
The Zebra puzzle, a.k.a. Einstein's Riddle,
is a logic puzzle which is to be solved programmatically.

It has several variants, one of them this:

:   1. There are five houses.
    2. The English man lives in the red house.
    3. The Swede has a dog.
    4. The Dane drinks tea.
    5. The green house is immediately to the left of the white house.
    6. They drink coffee in the green house.
    7. The man who smokes Pall Mall has a bird.
    8. In the yellow house they smoke Dunhill.
    9. In the middle house they drink milk.
    10. The Norwegian lives in the first house.
    11. The Blend-smoker lives in the house next to the house with a cat.
    12. In a house next to the house with a horse, they smoke Dunhill.
    13. The man who smokes Blue Master drinks beer.
    14. The German smokes Prince.
    15. The Norwegian lives next to the blue house.
    16. They drink water in a house next to the house where they smoke Blend.

The question is, who owns the zebra? For clarity, each of the five houses is painted a different color, and their inhabitants are of different nationalities, own different pets, drink different beverages and smoke different brands of cigarettes.

Additionally, list the solution for all the houses.

Optionally, show the solution is unique.

Related tasks

* Dinesman's multiple-dwelling problem
* Twelve statements

[Assistant]
(formerly Perl 6)
A rule driven approach:

```
my Hash @houses = (1 .. 5).map: { %(:num($_)) }; # 1 there are five houses

my @facts = (
    { :nat<English>, :color<red> },      # 2 The English man lives in the red house.
    { :nat<Swede>, :pet<dog> },          # 3 The Swede has a dog.
    { :nat<Dane>, :drink<tea> },         # 4 The Dane drinks tea.
    { :color<green>, :Left-Of(:color<white>) }, # 5 the green house is immediately to the left of the white house
    { :drink<coffee>, :color<green> },   # 6 They drink coffee in the green house.
    { :smoke<Pall-Mall>, :pet<birds> },  # 7 The man who smokes Pall Mall has birds.
    { :color<yellow>, :smoke<Dunhill> }, # 8 In the yellow house they smoke Dunhill.
    { :num(3), :drink<milk> },           # 9 In the middle house they drink milk.
    { :num(1), :nat<Norwegian> },        # 10 The Norwegian lives in the first house.
    { :smoke<Blend>, :Next-To(:pet<cats>) }, # 11 The man who smokes Blend lives in the house next to the house with cats.
    { :pet<horse>, :Next-To(:smoke<Dunhill>) }, # 12 In a house next to the house where they have a horse, they smoke Dunhill.
    { :smoke<Blue-Master>, :drink<beer> }, # 13 The man who smokes Blue Master drinks beer.
    { :nat<German>, :smoke<Prince> },      # 14 The German smokes Prince.
    { :nat<Norwegian>, :Next-To(:color<blue>) }, # 15 The Norwegian lives next to the blue house.
    { :drink<water>, :Next-To(:smoke<Blend>) },  # 16 They drink water in a house next to the house where they smoke Blend.
    { :pet<zebra> }, # who owns this?
);

sub MAIN {
    for gather solve(@houses, @facts) {
        #-- output
        say .head.sort.map(*.key.uc.fmt("%-9s")).join(' | ');
        say .sort.map(*.value.fmt("%-9s")).join(' | ')
            for .list;
        last; # stop after first solution
    }
}

#| a solution has been found that fits all the facts
multi sub solve(@solution, @facts [ ]) {
    take @solution;
}

#| extend this scenario to fit the next fact
multi sub solve(@scenario, [ $fact, *@facts ]) {
    for gather match(@scenario, |$fact) -> @houses {
        solve(@houses, @facts)
    }
}

#| find all possible solutions for pairs of houses with
#| properties %b, left of a house  with properties %a
multi sub match(@houses, :Left-Of(%a)!, *%b) {
    for 1 ..^ @houses {
        my %left-house  := @houses[$_-1];
        my %right-house := @houses[$_];

        if plausible(%left-house, %a) && plausible(%right-house, %b) {
            temp %left-house  ,= %a;
            temp %right-house ,= %b;
            take @houses;
        }
    }
}

#| match these houses are next to each other (left or right)
multi sub match(@houses, :Next-To(%b)!, *%a ) {
    match(@houses, |%a, :Left-Of(%b) );
    match(@houses, |%b, :Left-Of(%a) );
}

#| find all possible houses that match the given properties
multi sub match(@houses, *%props) {
    for @houses.grep({plausible($_, %props)}) -> %house {
        temp %house ,= %props;
        take @houses;
    }
}

#| plausible if doesn't conflict with anything
sub plausible(%house, %props) {
   ! %props.first: {%house{.key} && %house{.key} ne .value };
}

```

Output:

```
COLOR     | DRINK     | NAT       | NUM       | PET       | SMOKE
yellow    | water     | Norwegian | 1         | cats      | Dunhill
blue      | tea       | Dane      | 2         | horse     | Blend
red       | milk      | English   | 3         | birds     | Pall-Mall
green     | coffee    | German    | 4         | zebra     | Prince
white     | beer      | Swede     | 5         | dog       | Blue-Master

```

Note: Facts can be shuffled by changing line 3 to `my @facts = pick *, (`. It seems to reliably find solutions, although execution times will vary (from under 1 sec up to about 10sec).


[User]
This task is a *total immersion* zeckendorf task; using decimal numbers will attract serious disapprobation.

The task is to implement addition, subtraction, multiplication, and division using Zeckendorf number representation. Optionally provide decrement, increment and comparitive operation functions.

Addition

Like binary 1 + 1 = 10, note carry 1 left. There the similarity ends. 10 + 10 = 101, note carry 1 left and 1 right. 100 + 100 = 1001, note carry 1 left and 2 right, this is the general case.

Occurrences of 11 must be changed to 100. Occurrences of 111 may be changed from the right by replacing 11 with 100, or from the left converting 111 to 100 + 100;

Subtraction

10 - 1 = 1. The general rule is borrow 1 right carry 1 left. eg:

```
  abcde
  10100 -
   1000
  _____
    100  borrow 1 from a leaves 100
  + 100  add the carry
  _____
   1001

```

A larger example:

```
  abcdef
  100100 -
    1000
  ______
  1*0100 borrow 1 from b
   + 100 add the carry
  ______
  1*1001

Sadly we borrowed 1 from b which didn't have it to lend. So now b borrows from a:

    1001
  + 1000 add the carry
    ____
   10100

```

Multiplication

Here you teach your computer its zeckendorf tables. eg. 101 \* 1001:

```
  a = 1 * 101 = 101
  b = 10 * 101 = a + a = 10000
  c = 100 * 101 = b + a = 10101
  d = 1000 * 101 = c + b = 101010

  1001 = d + a therefore 101 * 1001 =

  101010
   + 101
  ______
 1000100

```

Division

Lets try 1000101 divided by 101, so we can use the same table used for multiplication.

```
  1000101 -
   101010 subtract d (1000 * 101)
  _______
     1000 -
      101 b and c are too large to subtract, so subtract a
     ____
        1 so 1000101 divided by 101 is d + a (1001) remainder 1

```

Efficient algorithms for Zeckendorf arithmetic is interesting. The sections on addition and subtraction are particularly relevant for this task.

[Assistant]
(formerly Perl 6)

This is a somewhat limited implementation of Zeckendorf arithmetic operators. They only handle positive integer values. There are no actual calculations, everything is done with string manipulations, so it doesn't matter what glyphs you use for 1 and 0.

Implemented arithmetic operators:

```
  +z addition
  -z subtraction
  ×z multiplication
  /z division (more of a divmod really)
 ++z post increment
 --z post decrement

```

Comparison operators:

```
 eqz equal
 nez not equal
 gtz greater than
 ltz less than

```

```
my $z1 = '1'; # glyph to use for a '1'
my $z0 = '0'; # glyph to use for a '0'

sub zorder($a) { ($z0 lt $z1) ?? $a !! $a.trans([$z0, $z1] => [$z1, $z0]) }

######## Zeckendorf comparison operators #########

# less than
sub infix:<ltz>($a, $b) { $a.&zorder lt $b.&zorder }

# greater than
sub infix:<gtz>($a, $b) { $a.&zorder gt $b.&zorder }

# equal
sub infix:<eqz>($a, $b) { $a eq $b }

# not equal
sub infix:<nez>($a, $b) { $a ne $b }

######## Operators for Zeckendorf arithmetic ########

# post increment
sub postfix:<++z>($a is rw) {
    $a = ("$z0$z0"~$a).subst(/("$z0$z0")($z1+ %% $z0)?$/,
      -> $/ { "$z0$z1" ~ ($1 ?? $z0 x $1.chars !! '') });
    $a ~~ s/^$z0+//;
    $a
}

# post decrement
sub postfix:<--z>($a is rw) {
    $a.=subst(/$z1($z0*)$/,
      -> $/ {$z0 ~ "$z1$z0" x $0.chars div 2 ~ $z1 x $0.chars mod 2});
    $a ~~ s/^$z0+(.+)$/$0/;
    $a
}

# addition
sub infix:<+z>($a is copy, $b is copy) { $a++z; $a++z while $b--z nez $z0; $a }

# subtraction
sub infix:<-z>($a is copy, $b is copy) { $a--z; $a--z while $b--z nez $z0; $a }

# multiplication
sub infix:<×z>($a, $b) {
    return $z0 if $a eqz $z0 or $b eqz $z0;
    return $a if $b eqz $z1;
    return $b if $a eqz $z1;
    my $c = $a;
    my $d = $z1;
    repeat {
         my $e = $z0;
         repeat { $c++z; $e++z } until $e eqz $a;
         $d++z;
    } until $d eqz $b;
    $c
}

# division  (really more of a div mod)
sub infix:</z>($a is copy, $b is copy) {
    fail "Divide by zero" if $b eqz $z0;
    return $a if $a eqz $z0 or $b eqz $z1;
    my $c = $z0;
    repeat {
        my $d = $b +z ($z1 ~ $z0);
        $c++z;
        $a++z;
        $a--z while $d--z nez $z0
    } until $a ltz $b;
    $c ~= " remainder $a" if $a nez $z0;
    $c
}

###################### Testing ######################

# helper sub to translate constants into the particular glyphs you used
sub z($a) { $a.trans([<1 0>] => [$z1, $z0]) }

say "Using the glyph '$z1' for 1 and '$z0' for 0\n";

my $fmt = "%-22s = %15s  %s\n";

my $zeck = $z1;

printf( $fmt, "$zeck++z", $zeck++z, '# increment' ) for 1 .. 10;

printf $fmt, "$zeck +z {z('1010')}", $zeck +z= z('1010'), '# addition';

printf $fmt, "$zeck -z {z('100')}", $zeck -z= z('100'), '# subtraction';

printf $fmt, "$zeck ×z {z('100101')}", $zeck ×z= z('100101'), '# multiplication';

printf $fmt, "$zeck /z {z('100')}", $zeck /z= z('100'), '# division';

printf( $fmt, "$zeck--z", $zeck--z, '# decrement' ) for 1 .. 5;

printf $fmt, "$zeck ×z {z('101001')}", $zeck ×z= z('101001'), '# multiplication';

printf $fmt, "$zeck /z {z('100')}", $zeck /z= z('100'), '# division';

```

**Testing Output**

```
Using the glyph '1' for 1 and '0' for 0

1++z                   =              10  # increment
10++z                  =             100  # increment
100++z                 =             101  # increment
101++z                 =            1000  # increment
1000++z                =            1001  # increment
1001++z                =            1010  # increment
1010++z                =           10000  # increment
10000++z               =           10001  # increment
10001++z               =           10010  # increment
10010++z               =           10100  # increment
10100 +z 1010          =          101000  # addition
101000 -z 100          =          100010  # subtraction
100010 ×z 100101       =    100001000001  # multiplication
100001000001 /z 100    =       101010001  # division
101010001--z           =       101010000  # decrement
101010000--z           =       101001010  # decrement
101001010--z           =       101001001  # decrement
101001001--z           =       101001000  # decrement
101001000--z           =       101000101  # decrement
101000101 ×z 101001    = 101010000010101  # multiplication
101010000010101 /z 100 = 1001010001001 remainder 10  # division
```

Using alternate glyphs:

```
Using the glyph 'X' for 1 and 'O' for 0

X++z                   =              XO  # increment
XO++z                  =             XOO  # increment
XOO++z                 =             XOX  # increment
XOX++z                 =            XOOO  # increment
XOOO++z                =            XOOX  # increment
XOOX++z                =            XOXO  # increment
XOXO++z                =           XOOOO  # increment
XOOOO++z               =           XOOOX  # increment
XOOOX++z               =           XOOXO  # increment
XOOXO++z               =           XOXOO  # increment
XOXOO +z XOXO          =          XOXOOO  # addition
XOXOOO -z XOO          =          XOOOXO  # subtraction
XOOOXO ×z XOOXOX       =    XOOOOXOOOOOX  # multiplication
XOOOOXOOOOOX /z XOO    =       XOXOXOOOX  # division
XOXOXOOOX--z           =       XOXOXOOOO  # decrement
XOXOXOOOO--z           =       XOXOOXOXO  # decrement
XOXOOXOXO--z           =       XOXOOXOOX  # decrement
XOXOOXOOX--z           =       XOXOOXOOO  # decrement
XOXOOXOOO--z           =       XOXOOOXOX  # decrement
XOXOOOXOX ×z XOXOOX    = XOXOXOOOOOXOXOX  # multiplication
XOXOXOOOOOXOXOX /z XOO = XOOXOXOOOXOOX remainder XO  # division
```


[User]
Just as numbers can be represented in a positional notation as sums of multiples of the powers of ten (decimal) or two (binary); all the positive integers can be represented as the sum of one or zero times the distinct members of the Fibonacci series.

Recall that the first six distinct Fibonacci numbers are: 1, 2, 3, 5, 8, 13.

The decimal number eleven can be written as 0\*13 + 1\*8 + 0\*5 + 1\*3 + 0\*2 + 0\*1 or 010100 in positional notation where the columns represent multiplication by a particular member of the sequence. Leading zeroes are dropped so that 11 decimal becomes 10100.

10100 is not the only way to make 11 from the Fibonacci numbers however; 0\*13 + 1\*8 + 0\*5 + 0\*3 + 1\*2 + 1\*1 or 010011 would also represent decimal 11. For a true Zeckendorf number there is the added restriction that *no two consecutive Fibonacci numbers can be used* which leads to the former unique solution.

Task

Generate and show here a table of the Zeckendorf number representations of the decimal numbers zero to twenty, in order.

The intention in this task to find the Zeckendorf form of an arbitrary integer. The Zeckendorf form can be iterated by some bit twiddling rather than calculating each value separately but leave that to another separate task.

Also see

* OEIS A014417   for the the sequence of required results.
* Brown's Criterion - Numberphile

Related task

* Fibonacci sequence

[Assistant]
(formerly Perl 6)

**Works with**: rakudo version 2015.12

```
printf "%2d: %8s\n", $_, zeckendorf($_) for 0 .. 20;

multi zeckendorf(0) { '0' }
multi zeckendorf($n is copy) {
    constant FIBS = (1,2, *+* ... *).cache;
    [~] map {
        $n -= $_ if my $digit = $n >= $_;
        +$digit;
    }, reverse FIBS ...^ * > $n;
}

```

Output:

```
 0:        0
 1:        1
 2:       10
 3:      100
 4:      101
 5:     1000
 6:     1001
 7:     1010
 8:    10000
 9:    10001
10:    10010
11:    10100
12:    10101
13:   100000
14:   100001
15:   100010
16:   100100
17:   100101
18:   101000
19:   101001
20:   101010
```


[User]
Some computer programming languages are not exactly consistent   (with other computer programming languages)

when   *raising zero to the zeroth power*:     **00**

Task

Show the results of raising   zero   to the   zeroth   power.

If your computer language objects to      **0\*\*0**      or      **0^0**      at compile time,   you may also try something like:

```
           x = 0
           y = 0
           z = x**y
           say  'z='  z

```

**Show the result here.**
And of course use any symbols or notation that is supported in your computer programming language for exponentiation.

See also

* The Wiki entry: Zero to the power of zero.
* The Wiki entry: Zero to the power of zero: History.
* The MathWorld™ entry: exponent laws.
  + Also, in the above MathWorld™ entry, see formula (**9**):

    x

    0
    =
    1
    {\displaystyle {\displaystyle x^{0}=1}}
    .
* The OEIS entry: The special case of zero to the zeroth power

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2018.03

```
say '    type         n      n**n  exp(n,n)';
say '--------  --------  --------  --------';

for 0, 0.0, FatRat.new(0), 0e0, 0+0i {
    printf "%8s  %8s  %8s  %8s\n", .^name, $_, $_**$_, exp($_,$_);
}

```

Output:

```
    type         n      n**n  exp(n,n)
--------  --------  --------  --------
     Int         0         1         1
     Rat         0         1         1
  FatRat         0         1         1
     Num         0         1         1
 Complex      0+0i      1+0i      1+0i

```


[User]
This is an algorithm used to thin a black and white i.e. one bit per pixel images.

For example, with an input image of:

```

 #################                   #############
 ##################               ################
 ###################            ##################
 ########     #######          ###################
   ######     #######         #######       ######
   ######     #######        #######
   #################         #######
   ################          #######
   #################         #######
   ######     #######        #######
   ######     #######        #######
   ######     #######         #######       ######
 ########     #######          ###################
 ########     ####### ######    ################## ######
 ########     ####### ######      ################ ######
 ########     ####### ######         ############# ######

```

It produces the thinned output:

```

    # ##########                       #######
     ##        #                   ####       #
     #          #                 ##
     #          #                #
     #          #                #
     #          #                #
     ############               #
     #          #               #
     #          #                #
     #          #                #
     #          #                #
     #                            ##
     #                             ############
                       ###                          ###

```

Algorithm

Assume black pixels are one and white pixels zero, and that the input image is a rectangular N by M array of ones and zeroes.

The algorithm operates on all black pixels P1 that can have eight neighbours.

The neighbours are, in order, arranged as:

|  |  |  |
| --- | --- | --- |
| P9 | P2 | P3 |
| P8 | **P1** | P4 |
| P7 | P6 | P5 |

Obviously the boundary pixels of the image cannot have the full eight neighbours.

* Define

  A
  (
  P
  1
  )
  {\displaystyle {\displaystyle A(P1)}}
   = the number of transitions from white to black, (0 -> 1) in the sequence P2,P3,P4,P5,P6,P7,P8,P9,P2. (Note the extra P2 at the end - it is circular).
* Define

  B
  (
  P
  1
  )
  {\displaystyle {\displaystyle B(P1)}}
   = The number of black pixel neighbours of P1. ( = sum(P2 .. P9) )

Step 1

All pixels are tested and pixels satisfying all the following conditions (simultaneously) are just noted at this stage.

* (0) The pixel is black and has eight neighbours
* (1)

  2
  <=
  B
  (
  P
  1
  )
  <=
  6
  {\displaystyle {\displaystyle 2<=B(P1)<=6}}
* (2) A(P1) = 1
* (3) At least one of P2 and P4 and P6 is white
* (4) At least one of P4 and P6 and P8 is white

After iterating over the image and collecting all the pixels satisfying all step 1 conditions, all these condition satisfying pixels are set to white.

Step 2

All pixels are again tested and pixels satisfying all the following conditions are just noted at this stage.

* (0) The pixel is black and has eight neighbours
* (1)

  2
  <=
  B
  (
  P
  1
  )
  <=
  6
  {\displaystyle {\displaystyle 2<=B(P1)<=6}}
* (2) A(P1) = 1
* (3) At least one of P2 and P4 and **P8** is white
* (4) At least one of **P2** and P6 and P8 is white

After iterating over the image and collecting all the pixels satisfying all step 2 conditions, all these condition satisfying pixels are again set to white.

Iteration

If any pixels were set in this round of either step 1 or step 2 then all steps are repeated until no image pixels are so changed.

Task

1. Write a routine to perform Zhang-Suen thinning on an image matrix of ones and zeroes.
2. Use the routine to thin the following image and show the output here on this page as either a matrix of ones and zeroes, an image, or an ASCII-art image of space/non-space characters.

```
          00000000000000000000000000000000
          01111111110000000111111110000000
          01110001111000001111001111000000
          01110000111000001110000111000000
          01110001111000001110000000000000
          01111111110000001110000000000000
          01110111100000001110000111000000
          01110011110011101111001111011100
          01110001111011100111111110011100
          00000000000000000000000000000000

```

Reference

* Zhang-Suen Thinning Algorithm, Java Implementation by Nayef Reza.
* "Character Recognition Systems: A Guide for Students and Practitioners" By Mohamed Cheriet, Nawwaf Kharma, Cheng-Lin Liu, Ching Suen

[Assistant]
(formerly Perl 6)
Source image may be based on any characters whose low bits are 0 or 1 (which conveniently includes . and #).

```
my $source = qq:to/EOD/;
................................
.#########.......########.......
.###...####.....####..####......
.###....###.....###....###......
.###...####.....###.............
.#########......###.............
.###.####.......###....###......
.###..####..###.####..####.###..
.###...####.###..########..###..
................................
EOD

my @lines = ([.ords X+& 1] for $source.split("\n")); # The low bits Just Work.
my \v = +@lines;
my \h = +@lines[0];
my @black = flat @lines.map: *.values;   # Flatten to 1-dimensional.

my \p8 = [-h-1, -h+0, -h+1,         # Flatland distances to 8 neighbors.
           0-1,        0+1,
           h-1,  h+0,  h+1].[1,2,4,7,6,5,3,0];   # (in cycle order)

# Candidates have 8 neighbors and are known black
my @cand = grep { @black[$_] }, do
    for 1..v-2 X 1..h-2 -> (\y,\x) { y*h + x }

repeat while my @goners1 or my @goners2 {
    sub seewhite (\w1,\w2) {
        sub cycles (@neighbors) { [+] @neighbors Z< @neighbors[].rotate }
        sub blacks (@neighbors) { [+] @neighbors }

        my @prior = @cand; @cand = ();

        gather for @prior -> \p {
            my \n = @black[p8 X+ p];
            if cycles(n) == 1 and 2 <= blacks(n) <= 6 and n[w1].any == 0 and n[w2].any == 0
                 { take p }
            else { @cand.push: p }
        }
    }

    @goners1 = seewhite (0,2,4), (2,4,6);
    @black[@goners1] = 0 xx *;
    say "Ping: {[+] @black} remaining after removing ", @goners1;

    @goners2 = seewhite (0,2,6), (0,4,6);
    @black[@goners2] = 0 xx *;
    say "Pong: {[+] @black} remaining after removing ", @goners2;
}

say @black.splice(0,h).join.trans('01' => '.#') while @black;

```

Output:

```
Ping: 66 remaining after removing 33 41 49 56 67 71 74 80 83 86 89 99 106 114 119 120 121 131 135 138 146 169 178 195 197 210 215 217 227 230 233 236 238 240 243 246 249 251 253 257 258 259 263 264 266 268 269 270 273 274 279 280 283 284 285
Pong: 47 remaining after removing 65 73 88 97 104 112 129 137 144 161 167 176 193 198 208 216 225 226 231
Ping: 45 remaining after removing 87 194
Pong: 45 remaining after removing
Ping: 45 remaining after removing
Pong: 45 remaining after removing
................................
..#######.........######........
..#.....#........##.............
..#......#.......#..............
..#.....#........#..............
..#####.#........#..............
.......##........#..............
........#....#...##....##...#...
.........#.........####.........
................................
```


[User]
Task

Produce a zig-zag array.

A   *zig-zag*   array is a square arrangement of the first   N2   natural numbers,   where the

numbers increase sequentially as you zig-zag along the array's   anti-diagonals.

For a graphical representation, see   JPG zigzag   (JPG uses such arrays to encode images).

For example, given   **5**,   produce this array:

```
 0  1  5  6 14
 2  4  7 13 15
 3  8 12 16 21
 9 11 17 20 22
10 18 19 23 24

```

Related tasks

* Spiral matrix
* Identity matrix
* Ulam spiral (for primes)

See also

* Wiktionary entry:   anti-diagonals

[Assistant]
(formerly Perl 6)

Using the same Turtle class as in the Spiral matrix task:

```
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;
}
```


[User]
**Zsigmondy numbers** **n** to **a**, **b**, are the greatest divisor of **an - bn** that is coprime to **am - bm** for all positive integers **m < n**.

E.G.

Suppose we set **a** = **2** and **b** = **1**. *(**Zs(n,2,1)**)*

For each **n**, find the divisors of **an - bn** and return the largest that is coprime to all of **am - bm**, where **m** is each of the positive integers **1** to **n - 1**.

When **n** = **4**, **24 - 14 = 15**. The divisors of **15** are **1, 3, 5,** and **15**.

For **m = 1, 2, 3** we get **2-1, 22-12, 23-13**, or **1, 3, 7**.

The divisors of **15** that are coprime to each are **5** and **1**, (***1** is always included*).

The largest coprime divisor is **5**, so **Zs(4,2,1) = 5**.

When **n** = **6**, **26 - 16 = 63**; its divisors are **1, 3, 7, 9, 21, 63**. The largest divisor coprime to all of **1, 3, 7, 15, 31** is **1**, (***1** is always included*), so **Zs(6,2,1) = 1**.

If a particular **an - bn** is prime, then **Zs(n,a,b)** will be equal to that prime. **25 - 15 = 31** so **Zs(5,2,1) = 31**.

Task

* Write a general routine (function, procedure, whatever) to find the Zsigmondy number sequence given a set of radices.
* Use that routine to generate the first several elements, (at least 10), for the following radix sets.

:   * (2,1)
    * (3,1)
    * (4,1)
    * (5,1)
    * (6,1)
    * (7,1)
    * (3,2)
    * (5,3)
    * (7,3)
    * (7,5)

See also

* OEIS:A064078 - Zsigmondy numbers for a = 2, b = 1 * OEIS:A064077 - Zsigmondy numbers for a = 3, b = 1 * OEIS:A064080 - Zsigmondy numbers for a = 4, b = 1 * OEIS:A064081 - Zsigmondy numbers for a = 5, b = 1 * OEIS:A064082 - Zsigmondy numbers for a = 6, b = 1 * OEIS:A064083 - Zsigmondy numbers for a = 7, b = 1 * OEIS:A109325 - Zsigmondy numbers for a = 3, b = 2 * OEIS:A109347 - Zsigmondy numbers for a = 5, b = 3 * OEIS:A109348 - Zsigmondy numbers for a = 7, b = 3 * OEIS:A109349 - Zsigmondy numbers for a = 7, b = 5

[Assistant]
First twenty elements of each.

```
use Prime::Factor;

sub Zsigmondy ($a, $b) {
    my @aexp = 1, * × $a … *;
    my @bexp = 1, * × $b … *;
    (1..∞).map: -> $n {
        (@aexp[$n] - @bexp[$n]).&divisors.sort(-*).first: -> $d {
            all (1..^$n).map: { (@aexp[$_] - @bexp[$_]) gcd $d == 1 }
        }
    }
}

for '064078', (2,1), '064079', (3,1), '064080', (4,1), '064081', (5,1), '064082', (6,1),
    '064083', (7,1), '109325', (3,2), '109347', (5,3), '109348', (7,3), '109349', (7,5)
  -> $oeis, $seq {
    say "\nA$oeis: Zsigmondy(n,$seq[0],$seq[1]):\n" ~ Zsigmondy(|$seq)[^20]
}

```

Output:

```
A064078: Zsigmondy(n,2,1):
1 3 7 5 31 1 127 17 73 11 2047 13 8191 43 151 257 131071 19 524287 41

A064079: Zsigmondy(n,3,1):
2 1 13 5 121 7 1093 41 757 61 88573 73 797161 547 4561 3281 64570081 703 581130733 1181

A064080: Zsigmondy(n,4,1):
3 5 7 17 341 13 5461 257 1387 41 1398101 241 22369621 3277 49981 65537 5726623061 4033 91625968981 61681

A064081: Zsigmondy(n,5,1):
4 3 31 13 781 7 19531 313 15751 521 12207031 601 305175781 13021 315121 195313 190734863281 5167 4768371582031 375601

A064082: Zsigmondy(n,6,1):
5 7 43 37 311 31 55987 1297 46873 1111 72559411 1261 2612138803 5713 1406371 1679617 3385331888947 46441 121871948002099 1634221

A064083: Zsigmondy(n,7,1):
6 1 19 25 2801 43 137257 1201 39331 2101 329554457 2353 16148168401 102943 4956001 2882401 38771752331201 117307 1899815864228857 1129901

A109325: Zsigmondy(n,3,2):
1 5 19 13 211 7 2059 97 1009 11 175099 61 1586131 463 3571 6817 129009091 577 1161737179 4621

A109347: Zsigmondy(n,5,3):
2 1 49 17 1441 19 37969 353 19729 421 24325489 481 609554401 10039 216001 198593 381405156481 12979 9536162033329 288961

A109348: Zsigmondy(n,7,3):
4 5 79 29 4141 37 205339 1241 127639 341 494287399 2041 24221854021 82573 3628081 2885681 58157596211761 109117 2849723505777919 4871281

A109349: Zsigmondy(n,7,5):
2 3 109 37 6841 13 372709 1513 176149 1661 964249309 1801 47834153641 75139 3162961 3077713 115933787267041 30133 5689910849522509 3949201
```


[User]
Zumkeller numbers are the set of numbers whose divisors can be partitioned into two disjoint sets that sum to the same value. Each sum must contain divisor values that are not in the other sum, and all of the divisors must be in one or the other. There are no restrictions on *how* the divisors are partitioned, only that the two partition sums are equal.

E.G.

:   **6** is a Zumkeller number; The divisors **{1 2 3 6}** can be partitioned into two groups **{1 2 3}** and **{6}** that both sum to 6.

:   **10** is not a Zumkeller number; The divisors **{1 2 5 10}** can not be partitioned into two groups in any way that will both sum to the same value.

:   **12** is a Zumkeller number; The divisors **{1 2 3 4 6 12}** can be partitioned into two groups **{1 3 4 6}** and **{2 12}** that both sum to 14.

Even Zumkeller numbers are common; odd Zumkeller numbers are much less so. For values below 10^6, there is *at least* one Zumkeller number in every 12 consecutive integers, and the vast majority of them are even. The odd Zumkeller numbers are very similar to the list from the task Abundant odd numbers; they are nearly the same except for the further restriction that the abundance (**A(n) = sigma(n) - 2n**), must be even: **A(n) mod 2 == 0**

Task
:   * Write a routine (function, procedure, whatever) to find Zumkeller numbers.
    * Use the routine to find and display here, on this page, the first **220 Zumkeller numbers**.
    * Use the routine to find and display here, on this page, the first **40 odd Zumkeller numbers**.
    * Optional, stretch goal: Use the routine to find and display here, on this page, the first **40 odd Zumkeller numbers that don't end with 5**.

See Also

:   * **OEIS:A083207 - Zumkeller numbers** to get an impression of different partitions **OEIS:A083206 Zumkeller partitions**
    * **OEIS:A174865 - Odd Zumkeller numbers**

Related Tasks

:   * **Abundant odd numbers**
    * **Abundant, deficient and perfect number classifications**
    * **Proper divisors** , **Factors of an integer**

[Assistant]
(formerly Perl 6)

**Library:** ntheory

```
use ntheory:from<Perl5> <factor is_prime>;

sub zumkeller ($range)  {
    $range.grep: -> $maybe {
        next if $maybe < 3 or $maybe.&is_prime;
        my @divisors = $maybe.&factor.combinations».reduce( &[×] ).unique.reverse;
        next unless [and] @divisors > 2, @divisors %% 2, (my $sum = @divisors.sum) %% 2, ($sum /= 2) ≥ $maybe;
        my $zumkeller = False;
        if $maybe % 2 {
            $zumkeller = True
        } else {
            TEST: for 1 ..^ @divisors/2 -> $c {
                @divisors.combinations($c).map: -> $d {
                    next if $d.sum != $sum;
                    $zumkeller = True and last TEST
                }
            }
        }
        $zumkeller
    }
}

say "First 220 Zumkeller numbers:\n" ~
    zumkeller(^Inf)[^220].rotor(20)».fmt('%3d').join: "\n";

put "\nFirst 40 odd Zumkeller numbers:\n" ~
    zumkeller((^Inf).map: * × 2 + 1)[^40].rotor(10)».fmt('%7d').join: "\n";

# Stretch. Slow to calculate. (minutes)
put "\nFirst 40 odd Zumkeller numbers not divisible by 5:\n" ~
    zumkeller(flat (^Inf).map: {my \p = 10 * $_; p+1, p+3, p+7, p+9} )[^40].rotor(10)».fmt('%7d').join: "\n";

```

Output:

```
First 220 Zumkeller numbers:
  6  12  20  24  28  30  40  42  48  54  56  60  66  70  78  80  84  88  90  96
102 104 108 112 114 120 126 132 138 140 150 156 160 168 174 176 180 186 192 198
204 208 210 216 220 222 224 228 234 240 246 252 258 260 264 270 272 276 280 282
294 300 304 306 308 312 318 320 330 336 340 342 348 350 352 354 360 364 366 368
372 378 380 384 390 396 402 408 414 416 420 426 432 438 440 444 448 456 460 462
464 468 474 476 480 486 490 492 496 498 500 504 510 516 520 522 528 532 534 540
544 546 550 552 558 560 564 570 572 580 582 588 594 600 606 608 612 616 618 620
624 630 636 640 642 644 650 654 660 666 672 678 680 684 690 696 700 702 704 708
714 720 726 728 732 736 740 744 750 756 760 762 768 770 780 786 792 798 804 810
812 816 820 822 828 832 834 836 840 852 858 860 864 868 870 876 880 888 894 896
906 910 912 918 920 924 928 930 936 940 942 945 948 952 960 966 972 978 980 984

First 40 odd Zumkeller numbers:
    945    1575    2205    2835    3465    4095    4725    5355    5775    5985
   6435    6615    6825    7245    7425    7875    8085    8415    8505    8925
   9135    9555    9765   10395   11655   12285   12705   12915   13545   14175
  14805   15015   15435   16065   16695   17325   17955   18585   19215   19305

First 40 odd Zumkeller numbers not divisible by 5:
  81081  153153  171171  189189  207207  223839  243243  261261  279279  297297
 351351  459459  513513  567567  621621  671517  729729  742203  783783  793611
 812889  837837  891891  908523  960687  999999 1024947 1054053 1072071 1073709
1095633 1108107 1145529 1162161 1198197 1224531 1270269 1307691 1324323 1378377
```