[User]
A   Narcissistic decimal number   is a non-negative integer,

n
{\displaystyle {\displaystyle n}}
,   that is equal to the sum of the

m
{\displaystyle {\displaystyle m}}
-th   powers of each of the digits in the decimal representation of

n
{\displaystyle {\displaystyle n}}
,   where

m
{\displaystyle {\displaystyle m}}
   is the number of digits in the decimal representation of

n
{\displaystyle {\displaystyle n}}
.

Narcissistic (decimal) numbers are sometimes called   **Armstrong**   numbers, named after Michael F. Armstrong.

They are also known as   **Plus Perfect**   numbers.

An example
:   :   :   :   * if

                  n
                  {\displaystyle {\displaystyle n}}
                     is   **153**
                * then

                  m
                  {\displaystyle {\displaystyle m}}
                  ,   (the number of decimal digits)   is   **3**
                * we have    13 + 53 + 33   =   1 + 125 + 27   =   **153**
                * and so   **153**   is a narcissistic decimal number

Task

Generate and show here the first   **25**   narcissistic decimal numbers.

Note:

0

1
=
0
{\displaystyle {\displaystyle 0^{1}=0}}
,   the first in the series.

See also

* the  OEIS entry:     Armstrong (or Plus Perfect, or narcissistic) numbers.
* MathWorld entry:   Narcissistic Number.
* Wikipedia entry:     Narcissistic number.

[Assistant]
(formerly Perl 6)

### Simple, with concurrency

Simple implementation is not exactly speedy, but concurrency helps move things along.

```
sub is-narcissistic(Int $n) { $n == [+] $n.comb »**» $n.chars }
my @N = lazy (0..∞).hyper.grep: *.&is-narcissistic;
@N[^25].join(' ').say;

```

Output:

```
0 1 2 3 4 5 6 7 8 9 153 370 371 407 1634 8208 9474 54748 92727 93084 548834 1741725 4210818 9800817 9926315
```

### Single-threaded, with precalculations

This version that precalculates the values for base 1000 digits, but despite the extra work ends up taking more wall-clock time than the simpler version.

```
sub kigits($n) {
    my int $i = $n;
    my int $b = 1000;
    gather while $i {
        take $i % $b;
        $i = $i div $b;
    }
}

for (1..*) -> $d {
    my @t = 0..9 X** $d;
    my @table = @t X+ @t X+ @t;
    sub is-narcissistic(\n) { n == [+] @table[kigits(n)] };
    state $l = 2;
    FIRST say "1\t0";
    say $l++, "\t", $_ if .&is-narcissistic for 10**($d-1) ..^ 10**$d;
    last if $l > 25
};

```

Output:

```
1	0
2	1
3	2
4	3
5	4
6	5
7	6
8	7
9	8
10	9
11	153
12	370
13	371
14	407
15	1634
16	8208
17	9474
18	54748
19	92727
20	93084
21	548834
22	1741725
23	4210818
24	9800817
25	9926315
```


[User]
**In short:** Use the specimen language (native) for "scripting".

Example
:   If your language is "foo", then the test case of "echo.foo" runs in a terminal as "./echo.foo Hello, world!".

**In long**: Create a program (in the specimen language) that will automatically compile a *test case* (of the same specimen language) to a native binary executable and then transparently load and run this *test case* executable.

Make it so that all that is required is a custom shebangs
at the start of the *test case*. e.g. "#!/usr/local/bin/script\_foo"

**Importantly:** This task must be coded **strictly** in the specimen language, **neither** using a shell script **nor** any other 3rd language.

Optimise this progress so that the *test program* **binary executable** is only created if the original *test program* **source code** as been touched/edited.

Note: If the lauguage (or a specific implementation) handles this automatically,
then simple provide an example of "echo.foo"

**Background:**

Simple shebangs can help with scripting, e.g. "#!/usr/bin/env python" at the top of a Python script will allow it to be run in a terminal as "./script.py".

The task Multiline shebang largely demonstrates how to use "shell" code in the shebang to compile and/or run source-code from a 3rd language, typically "#!/bin/bash" or "#!/bin/sh".

**This task:**

However in this task **Native shebang** task we are go *native*.
In the shebang, instead of running a shell, we call a binary-executable
generated from the original native language,
e.g. when using C with gcc "#!/usr/local/bin/script\_gcc"
to extract, compile and run the native "script" source code.

Other small innovations required of this *Native shebang* task:

* Cache the executable in some appropriate place in a path, dependant on available write permissions.
* Generate a new cached executable only when the source has been touched.
* If a cached is available, then run this instead of regenerating a new executable.

**Difficulties:**

* Naturally, some languages are not compiled. These languages are forced to use shebang executables from another language, eg "#!/usr/bin/env python" uses the C binaries /usr/bin/env and /usr/bin/python. If this is the case, then simply document the details of the case.
* In a perfect world, the test file (e.g. *echo.c*) would still be a valid program, and would compile without error using the native compiler (e.g. *gcc* for *text.c*). The problem is that "#!" is syntactically incorrect on many languages, but in others it can be parsed as a comment.
* The "test binary" should be exec-ed and hence retain the original Process identifier.

**Test case:**

* Create a simple "script file" (in the same native language) called "echo" then use the "script" to output "Hello, world!"

[Assistant]
(formerly Perl 6)

Raku is not installed by default on most systems and does not have a default install directory, so the path will vary by system.

**Works with**: Rakudo version 2020.02

**File: echo.p6**

```
#!/path/to/raku
put @*ARGS;

```

**Usage:**

```
./echo.p6 Hello, world!

```

Output:

```
Hello, world!

```


[User]
Natural sorting is the sorting of text that does more than rely on the
order of individual characters codes to make the finding of
individual strings easier for a *human* reader.

There is no "one true way" to do this, but for the purpose of this task 'natural' orderings might include:

:   1. Ignore leading, trailing and multiple adjacent spaces
:   2. Make all whitespace characters equivalent.
:   3. Sorting without regard to case.
:   4. Sorting numeric portions of strings in numeric order.

    :   That is split the string into fields on numeric boundaries, then sort on each field, with the rightmost fields being the most significant, and numeric fields of integers treated as numbers.
    :   foo9.txt before foo10.txt
    :   As well as ... x9y99 before x9y100, before x10y0
    :   ... (for any number of groups of integers in a string).
:   5. Title sorts: without regard to a leading, very common, word such

    :   as 'The' in "The thirty-nine steps".
:   6. Sort letters without regard to accents.
:   7. Sort ligatures as separate letters.
:   8. Replacements:

    :   Sort German eszett or scharfes S (ß)       as   ss
    :   Sort ſ, LATIN SMALL LETTER LONG S     as   s
    :   Sort ʒ, LATIN SMALL LETTER EZH           as   s
    :   ∙∙∙

Task Description

* **Implement the first four** of the eight given features in a natural sorting routine/function/method...
* Test each feature implemented separately with an ordered list of test strings from the   **Sample inputs**   section below,   and make sure your naturally sorted output is in the same order as other language outputs such as    `Python`.
* Print and display your output.
* **For extra credit** implement more than the first four.

Note:   it is not necessary to have individual control of which features are active in the natural sorting routine at any time.

Sample input

```
• Ignoring leading spaces.                       Text strings:   ['ignore leading spaces:  2-2',
                                                                  'ignore leading spaces:  2-1',
                                                                  'ignore leading spaces:  2+0',
                                                                  'ignore leading spaces:  2+1']

• Ignoring multiple adjacent spaces (MAS).       Text strings:   ['ignore MAS spaces:  2-2',
                                                                  'ignore MAS spaces:  2-1',
                                                                  'ignore MAS spaces:  2+0',
                                                                  'ignore MAS spaces:  2+1']

• Equivalent whitespace characters.              Text strings:   ['Equiv.  spaces:     3-3',
                                                                  'Equiv. \rspaces:    3-2',
                                                                  'Equiv. \x0cspaces:  3-1',
                                                                  'Equiv. \x0bspaces:  3+0',
                                                                  'Equiv. \nspaces:    3+1',
                                                                  'Equiv. \tspaces:    3+2']

• Case Independent sort.                         Text strings:   ['cASE INDEPENDENT:  3-2',
                                                                  'caSE INDEPENDENT:  3-1',
                                                                  'casE INDEPENDENT:  3+0',
                                                                  'case INDEPENDENT:  3+1']

• Numeric fields as numerics.                    Text strings:   ['foo100bar99baz0.txt',
                                                                  'foo100bar10baz0.txt',
                                       sv                           'foo1000bar99baz10.txt',
                                                                  'foo1000bar99baz9.txt']

• Title sorts.                                   Text strings:   ['The Wind in the Willows',
                                                                  'The 40th step more',
                                                                  'The 39 steps',
                                                                  'Wanda']

• Equivalent accented characters (and case).     Text strings:   [u'Equiv. \xfd accents:  2-2',
                                                                  u'Equiv. \xdd accents:  2-1',
                                                                  u'Equiv.  y accents:    2+0',
                                                                  u'Equiv.  Y accents:    2+1']

• Separated ligatures.                           Text strings:   [u'\u0132 ligatured ij',
                                                                   'no ligature']

• Character replacements.                        Text strings:   [u'Start with an \u0292:  2-2',
                                                                  u'Start with an \u017f:  2-1',
                                                                  u'Start with an \xdf:    2+0',
                                                                  u'Start with an  s:      2+1']

```

[Assistant]
(formerly Perl 6)

**Works with**: rakudo version 2015-11-02

In Raku it is very easy to modify the default sorting order by passing in a
transform routine to the sort function. If the transform routines are arity one,
the sort function will apply a Schwartzian Transform so it only needs to calculate
the transform once. Note that the transforms are non-destructive; The sort function
returns the original strings.

The following are a series of subroutines to perform the various natural
sorting transforms. They may be applied individually or mixed and matched
to get the particular result desired. When more than one is strung
together, they apply left to right. Some combinations may yield
different results depending on the order they are applied.

```
# Sort groups of digits in number order. Sort by order of magnitude then lexically.
sub naturally ($a) { $a.lc.subst(/(\d+)/, ->$/ {0~$0.chars.chr~$0},:g) ~"\x0"~$a }

# Collapse multiple ws characters to a single.
sub collapse ($a) { $a.subst( / ( \s ) $0+ /, -> $/ { $0 }, :g ) }

# Convert all ws characters to a space.
sub normalize ($a) { $a.subst( / ( \s ) /, ' ', :g ) }

# Ignore common leading articles for title sorts
sub title ($a) { $a.subst( / :i ^ ( a | an | the ) >> \s* /, '' ) }

# Decompose ISO-Latin1 glyphs to their base character.
sub latin1_decompose ($a) {
    $a.trans: <
       Æ AE æ ae Þ TH þ th Ð TH ð th ß ss À A Á A Â A Ã A Ä A Å A à a á a
        â a ã a ä a å a Ç C ç c È E É E Ê E Ë E è e é e ê e ë e Ì I Í I Î
        I Ï I ì i í i î i ï i Ò O Ó O Ô O Õ O Ö O Ø O ò o ó o ô o õ o ö o
        ø o Ñ N ñ n Ù U Ú U Û U Ü U ù u ú u û u ü u Ý Y ÿ y ý y
    >.hash;
}

# Used as:

my @tests = (
    [
        "Task 1a\nSort while ignoring leading spaces.",
        [
          'ignore leading spaces: 1', '   ignore leading spaces: 4',
          '  ignore leading spaces: 3', ' ignore leading spaces: 2'
        ],
        {.trim} # builtin method.
    ],
    [
        "Task 1b\nSort while ignoring multiple adjacent spaces.",
        [
          'ignore m.a.s   spaces: 3', 'ignore m.a.s spaces: 1',
          'ignore m.a.s    spaces: 4', 'ignore m.a.s  spaces: 2'
        ],
        {.&collapse}
    ],
    [
        "Task 2\nSort with all white space normalized to regular spaces.",
        [
          "Normalized\tspaces: 4", "Normalized\xa0spaces: 1",
          "Normalized\x20spaces: 2", "Normalized\nspaces: 3"
        ],
        {.&normalize}
    ],
    [
        "Task 3\nSort case independently.",
        [
          'caSE INDEPENDENT: 3', 'casE INDEPENDENT: 2',
          'cASE INDEPENDENT: 4', 'case INDEPENDENT: 1'
        ],
        {.lc} # builtin method
    ],
    [
        "Task 4\nSort groups of digits in natural number order.",
        [
          <Foo100bar99baz0.txt foo100bar10baz0.txt foo1000bar99baz10.txt
           foo1000bar99baz9.txt 201st 32nd 3rd 144th 17th 2 95>
        ],
        {.&naturally}
    ],
    [
        "Task 5 ( mixed with 1, 2, 3 & 4 )\n"
        ~ "Sort titles, normalize white space, collapse multiple spaces to\n"
        ~ "single, trim leading white space, ignore common leading articles\n"
        ~ 'and sort digit groups in natural order.',
        [
          'The Wind	in the Willows  8', '  The 39 Steps               3',
          'The    7th Seal              1', 'Wanda                        6',
          'A Fish Called Wanda          5', ' The Wind and the Lion       7',
          'Any Which Way But Loose      4', '12 Monkeys                   2'
        ],
        {.&normalize.&collapse.trim.&title.&naturally}
    ],
    [
        "Task 6, 7, 8\nMap letters in Latin1 that have accents or decompose to two\n"
        ~ 'characters to their base characters for sorting.',
        [
          <apple Ball bald car Card above Æon æon aether
            niño nina e-mail Évian evoke außen autumn>
        ],
        {.&latin1_decompose.&naturally}
    ]
);

for @tests -> $case {
    my $code_ref = $case.pop;
    my @array = $case.pop.list;
    say $case.pop, "\n";

    say "Standard Sort:\n";
    .say for @array.sort;

    say "\nNatural Sort:\n";
    .say for @array.sort: {.$code_ref};

    say "\n" ~ '*' x 40 ~ "\n";
}

```

Sample output:

```
Task 1a
Sort while ignoring leading spaces.

Standard Sort:

   ignore leading spaces: 4
  ignore leading spaces: 3
 ignore leading spaces: 2
ignore leading spaces: 1

Natural Sort:

ignore leading spaces: 1
 ignore leading spaces: 2
  ignore leading spaces: 3
   ignore leading spaces: 4

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

Task 1b
Sort while ignoring multiple adjacent spaces.

Standard Sort:

ignore m.a.s    spaces: 4
ignore m.a.s   spaces: 3
ignore m.a.s  spaces: 2
ignore m.a.s spaces: 1

Natural Sort:

ignore m.a.s spaces: 1
ignore m.a.s  spaces: 2
ignore m.a.s   spaces: 3
ignore m.a.s    spaces: 4

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

Task 2
Sort with all white space normalized to regular spaces.

Standard Sort:

Normalized	spaces: 4
Normalized
spaces: 3
Normalized spaces: 2
Normalized spaces: 1

Natural Sort:

Normalized spaces: 1
Normalized spaces: 2
Normalized
spaces: 3
Normalized	spaces: 4

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

Task 3
Sort case independently.

Standard Sort:

cASE INDEPENDENT: 4
caSE INDEPENDENT: 3
casE INDEPENDENT: 2
case INDEPENDENT: 1

Natural Sort:

case INDEPENDENT: 1
casE INDEPENDENT: 2
caSE INDEPENDENT: 3
cASE INDEPENDENT: 4

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

Task 4
Sort groups of digits in natural number order.

Standard Sort:

144th
17th
2
201st
32nd
3rd
95
Foo100bar99baz0.txt
foo1000bar99baz10.txt
foo1000bar99baz9.txt
foo100bar10baz0.txt

Natural Sort:

2
3rd
17th
32nd
95
144th
201st
foo100bar10baz0.txt
Foo100bar99baz0.txt
foo1000bar99baz9.txt
foo1000bar99baz10.txt

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

Task 5 ( mixed with 1, 2, 3 & 4 )
Sort titles, normalize white space, collapse multiple spaces to
single, trim leading white space, ignore common leading articles
and sort digit groups in natural order.

Standard Sort:

  The 39 Steps               3
 The Wind and the Lion       7
12 Monkeys                   2
A Fish Called Wanda          5
Any Which Way But Loose      4
The    7th Seal              1
The Wind	in the Willows  8
Wanda                        6

Natural Sort:

The    7th Seal              1
12 Monkeys                   2
  The 39 Steps               3
Any Which Way But Loose      4
A Fish Called Wanda          5
Wanda                        6
 The Wind and the Lion       7
The Wind	in the Willows  8

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

Task 6, 7, 8
Map letters in Latin1 that have accents or decompose to two
characters to their base characters for sorting.

Standard Sort:

Ball
Card
above
aether
apple
autumn
außen
bald
car
e-mail
evoke
nina
niño
Æon
Évian
æon

Natural Sort:

above
Æon
æon
aether
apple
außen
autumn
bald
Ball
car
Card
e-mail
Évian
evoke
nina
niño

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

```


[User]
File:Ship'sBell.jpg

Task

Write a small program that emulates a nautical bell producing a ringing bell pattern at certain times throughout the day.

The bell timing should be in accordance with Greenwich Mean Time, unless locale dictates otherwise.

It is permissible for the program to daemonize, or to slave off a scheduler, and it is permissible to use alternative notification methods (such as producing a written notice "Two Bells Gone"), if these are more usual for the system type.

Related task

* Sleep

[Assistant]
(formerly Perl 6)

Raku uses UTC (GMT) time internally and by default. This will display the current UTC time and on the half hour, display a graphical representation of the bell. If run in a terminal with the system bell enabled, will also chime the system alarm bell.

```
my @watch = <Middle Morning Forenoon Afternoon Dog First>;
my @ordinal = <One Two Three Four Five Six Seven Eight>;

my $thishour;
my $thisminute = '';

loop {
    my $utc = DateTime.new(time);
    if $utc.minute ~~ any(0,30) and $utc.minute != $thisminute {
        $thishour   = $utc.hour;
        $thisminute = $utc.minute;
        bell($thishour, $thisminute);
    }
    printf "%s%02d:%02d:%02d", "\r", $utc.hour, $utc.minute, $utc.second;
    sleep(1);
}

sub bell ($hour, $minute) {

    my $bells = (($hour % 4) * 2 + $minute div 30) || 8;

    printf "%s%02d:%02d %9s watch, %6s Bell%s Gone: \t", "\b" x 9, $hour, $minute,
      @watch[($hour div 4 - !?($minute + $hour % 4) + 6) % 6],
      @ordinal[$bells - 1], $bells == 1 ?? '' !! 's';

    chime($bells);

    sub chime ($count) {
	for 1..$count div 2 {
		print "\a♫ ";
		sleep .25;
		print "\a";
		sleep .75;
	}
	if $count % 2 {
	     print "\a♪";
	     sleep 1;
        }
        print "\n";
    }
}

```

Output:

```
00:00     First watch,  Eight Bells Gone: 	♫ ♫ ♫ ♫
00:30    Middle watch,    One Bell Gone: 	♪
01:00    Middle watch,    Two Bells Gone: 	♫
01:30    Middle watch,  Three Bells Gone: 	♫ ♪
02:00    Middle watch,   Four Bells Gone: 	♫ ♫
02:30    Middle watch,   Five Bells Gone: 	♫ ♫ ♪
03:00    Middle watch,    Six Bells Gone: 	♫ ♫ ♫
03:30    Middle watch,  Seven Bells Gone: 	♫ ♫ ♫ ♪
04:00    Middle watch,  Eight Bells Gone: 	♫ ♫ ♫ ♫
04:30   Morning watch,    One Bell Gone: 	♪
05:00   Morning watch,    Two Bells Gone: 	♫
05:30   Morning watch,  Three Bells Gone: 	♫ ♪
06:00   Morning watch,   Four Bells Gone: 	♫ ♫
06:30   Morning watch,   Five Bells Gone: 	♫ ♫ ♪
07:00   Morning watch,    Six Bells Gone: 	♫ ♫ ♫
07:30   Morning watch,  Seven Bells Gone: 	♫ ♫ ♫ ♪
08:00   Morning watch,  Eight Bells Gone: 	♫ ♫ ♫ ♫
08:30  Forenoon watch,    One Bell Gone: 	♪
09:00  Forenoon watch,    Two Bells Gone: 	♫
09:30  Forenoon watch,  Three Bells Gone: 	♫ ♪
10:00  Forenoon watch,   Four Bells Gone: 	♫ ♫
10:30  Forenoon watch,   Five Bells Gone: 	♫ ♫ ♪
11:00  Forenoon watch,    Six Bells Gone: 	♫ ♫ ♫
11:30  Forenoon watch,  Seven Bells Gone: 	♫ ♫ ♫ ♪
12:00  Forenoon watch,  Eight Bells Gone: 	♫ ♫ ♫ ♫
12:30 Afternoon watch,    One Bell Gone: 	♪
13:00 Afternoon watch,    Two Bells Gone: 	♫
13:30 Afternoon watch,  Three Bells Gone: 	♫ ♪
14:00 Afternoon watch,   Four Bells Gone: 	♫ ♫
14:30 Afternoon watch,   Five Bells Gone: 	♫ ♫ ♪
15:00 Afternoon watch,    Six Bells Gone: 	♫ ♫ ♫
15:30 Afternoon watch,  Seven Bells Gone: 	♫ ♫ ♫ ♪
16:00 Afternoon watch,  Eight Bells Gone: 	♫ ♫ ♫ ♫
16:30       Dog watch,    One Bell Gone: 	♪
17:00       Dog watch,    Two Bells Gone: 	♫
17:30       Dog watch,  Three Bells Gone: 	♫ ♪
18:00       Dog watch,   Four Bells Gone: 	♫ ♫
18:30       Dog watch,   Five Bells Gone: 	♫ ♫ ♪
19:00       Dog watch,    Six Bells Gone: 	♫ ♫ ♫
19:30       Dog watch,  Seven Bells Gone: 	♫ ♫ ♫ ♪
20:00       Dog watch,  Eight Bells Gone: 	♫ ♫ ♫ ♫
20:30     First watch,    One Bell Gone: 	♪
21:00     First watch,    Two Bells Gone: 	♫
21:30     First watch,  Three Bells Gone: 	♫ ♪
22:00     First watch,   Four Bells Gone: 	♫ ♫
22:30     First watch,   Five Bells Gone: 	♫ ♫ ♪
23:00     First watch,    Six Bells Gone: 	♫ ♫ ♫
23:30     First watch,  Seven Bells Gone: 	♫ ♫ ♫ ♪
```


[User]
Negative base numbers are an alternate way to encode numbers without the need for a minus sign. Various negative bases may be used including negadecimal (base -10), negabinary (-2) and negaternary (-3).[1][2]

Task

* Encode the decimal number 10 as negabinary (expect 11110)
* Encode the decimal number 146 as negaternary (expect 21102)
* Encode the decimal number 15 as negadecimal (expect 195)
* In each of the above cases, convert the encoded number back to decimal.

extra credit

* supply an integer, that when encoded to base   -62   (or something "higher"),   expresses the
  name of the language being used   (with correct capitalization).   If the computer language has
  non-alphanumeric characters,   try to encode them into the negatory numerals,   or use other
  characters instead.

[Assistant]
(formerly Perl 6)

### Explicit

**Works with**: Rakudo version 2016.11

Raku provides built-in methods / routines base and parse-base to convert to and from bases 2 through 36. We'll just shadow the core routines with versions that accept negative bases.

As a stretch goal, rather than implement something that can "Spell the name of the language with correct capitalization" (which is silly, trivial, and has absolutely ***nothing*** to do with negative base numbers,) we'll implement routines that correctly work with any Real number, not just integers.

The Real candidate has a 'precision' parameter, default -15, (15 places after the decimal point,) to limit the length of the fractional portion of the converted value. Change it if you need or want different precision. The Integer only routine is kept here as a multi-dispatch candidate since it is potentially much faster than the Real capable routine. The dispatcher will automatically use the most appropriate (fastest) routine.

Note that the parse-base routine will handle 'illegal' negative negative-base values without blowing up.

```
multi sub base ( Int $value is copy, Int $radix where -37 < * < -1) {
    my $result;
    while $value {
        my $r = $value mod $radix;
        $value div= $radix;
        if $r < 0 {
            $value++;
            $r -= $radix
        }
        $result ~= $r.base(-$radix);
    }
    flip $result || ~0;
}

multi sub base ( Real $num, Int $radix where -37 < * < -1, :$precision = -15 ) {
    return '0' unless $num;
    my $value  = $num;
    my $result = '';
    my $place  = 0;
    my $upper-bound = 1 / (-$radix + 1);
    my $lower-bound = $radix * $upper-bound;

    $value = $num / $radix ** ++$place until $lower-bound <= $value < $upper-bound;

    while ($value or $place > 0) and $place > $precision {
        my $digit = ($radix * $value - $lower-bound).Int;
        $value    =  $radix * $value - $digit;
        $result ~= '.' unless $place or $result.contains: '.';
        $result ~= $digit == -$radix ?? ($digit-1).base(-$radix)~'0' !! $digit.base(-$radix);
        $place--
    }
    $result
}

multi sub parse-base (Str $str, Int $radix where -37 < * < -1) {
    return -1 * $str.substr(1).&parse-base($radix) if $str.substr(0,1) eq '-';
    my ($whole, $frac) = $str.split: '.';
    my $fraction = 0;
    $fraction = [+] $frac.comb.kv.map: { $^v.parse-base(-$radix) * $radix ** -($^k+1) } if $frac;
    $fraction + [+] $whole.flip.comb.kv.map: { $^v.parse-base(-$radix) * $radix ** $^k }
}

# TESTING
for <4 -4 0 -7  10 -2  146 -3  15 -10  -19 -10  107 -16
    227.65625 -16  2.375 -4 -1.3e2 -8 41371457.268272761 -36> -> $v, $r {
    my $nbase = $v.&base($r, :precision(-5));
    printf "%20s.&base\(%3d\) = %-11s : %13s.&parse-base\(%3d\) = %s\n",
      $v, $r, $nbase, "'$nbase'", $r, $nbase.&parse-base($r);
}

# 'Illegal' negative-base value
say q|  '-21'.&parse-base(-10) = |, '-21'.&parse-base(-10);

```

Output:

```
                   4.&base( -4) = 130         :         '130'.&parse-base( -4) = 4
                   0.&base( -7) = 0           :           '0'.&parse-base( -7) = 0
                  10.&base( -2) = 11110       :       '11110'.&parse-base( -2) = 10
                 146.&base( -3) = 21102       :       '21102'.&parse-base( -3) = 146
                  15.&base(-10) = 195         :         '195'.&parse-base(-10) = 15
                 -19.&base(-10) = 21          :          '21'.&parse-base(-10) = -19
                 107.&base(-16) = 1AB         :         '1AB'.&parse-base(-16) = 107
           227.65625.&base(-16) = 124.68      :      '124.68'.&parse-base(-16) = 227.65625
               2.375.&base( -4) = 3.32        :        '3.32'.&parse-base( -4) = 2.375
              -1.3e2.&base( -8) = 1616        :        '1616'.&parse-base( -8) = -130
  41371457.268272761.&base(-36) = PERL6.ROCKS : 'PERL6.ROCKS'.&parse-base(-36) = 41371457.268272761
  '-21'.&parse-base(-10) = 19
```

### Module

**Works with**: Rakudo version 2020.02

Using the module Base::Any from the Raku ecosystem.

Does everything the explicit version does but also handles a **much** larger range of negative bases.

Doing pretty much the same tests as the explicit version.

```
use Base::Any;

for < 4 -4 0 -7  10 -2  146 -3  15 -10  -19 -10  107 -16
    227.65625 -16  2.375 -4 -1.3e2 -8 41371457.268272761 -36
    -145115966751439403/3241792 -1184 > -> $v, $r {
    my $nbase = $v.&to-base($r, :precision(-5));
    printf "%21s.&to-base\(%5d\) = %-11s : %13s.&from-base\(%5d\) = %s\n",
      +$v, $r, $nbase, "'$nbase'", $r, $nbase.&from-base($r);
}

```

Output:

```
                    4.&to-base(   -4) = 130         :         '130'.&from-base(   -4) = 4
                    0.&to-base(   -7) = 0           :           '0'.&from-base(   -7) = 0
                   10.&to-base(   -2) = 11110       :       '11110'.&from-base(   -2) = 10
                  146.&to-base(   -3) = 21102       :       '21102'.&from-base(   -3) = 146
                   15.&to-base(  -10) = 195         :         '195'.&from-base(  -10) = 15
                  -19.&to-base(  -10) = 21          :          '21'.&from-base(  -10) = -19
                  107.&to-base(  -16) = 1AB         :         '1AB'.&from-base(  -16) = 107
            227.65625.&to-base(  -16) = 124.68      :      '124.68'.&from-base(  -16) = 227.65625
                2.375.&to-base(   -4) = 3.32        :        '3.32'.&from-base(   -4) = 2.375
                 -130.&to-base(   -8) = 1616        :        '1616'.&from-base(   -8) = -130
   41371457.268272761.&to-base(  -36) = PERL6.ROCKS : 'PERL6.ROCKS'.&from-base(  -36) = 41371457.268272761
-44764120200.01264825.&to-base(-1184) = Raku.FTW    :    'Raku.FTW'.&from-base(-1184) = -44764120200.01264825
```


[User]
Task

Find and show primes p such that p\*q+2 is prime, where q is next prime after p and **p < 500**

See also:

* Special neighbor primes

[Assistant]
```
my @primes = grep &is-prime, ^Inf;
my $last_p = @primes.first: :k, * >= 500;
my $last_q = $last_p + 1;

my @cousins = @primes.head( $last_q )
                     .rotor( 2 => -1 )
                     .map(-> (\p, \q) { p, q, p*q+2 } )
                     .grep( *.[2].is-prime );

say .fmt('%6d') for @cousins;

```

Output:

```
     3      5     17
     5      7     37
     7     11     79
    13     17    223
    19     23    439
    67     71   4759
   149    151  22501
   179    181  32401
   229    233  53359
   239    241  57601
   241    251  60493
   269    271  72901
   277    281  77839
   307    311  95479
   313    317  99223
   397    401 159199
   401    409 164011
   419    421 176401
   439    443 194479
   487    491 239119

```


[User]
In many languages, functions can be nested, resulting in outer functions and inner functions. The inner function can access variables from the outer function. In most languages, the inner function can also modify variables in the outer function.

Task

Write a program consisting of two nested functions that prints the following text.

```
1. first
2. second
3. third

```

The outer function (called MakeList or equivalent) is responsible for creating the list as a whole and is given the separator ". " as argument. It also defines a counter variable to keep track of the item number. This demonstrates how the inner function can influence the variables in the outer function.

The inner function (called MakeItem or equivalent) is responsible for creating a list item. It accesses the separator from the outer function and modifies the counter.

References
:   * Nested function

[Assistant]
(formerly Perl 6)

```
sub make-List ($separator = ') '){
    my $count = 1;

    sub make-Item ($item) { "{$count++}$separator$item" }

    join "\n", <first second third>».&make-Item;
}

put make-List('. ');

```

Output:

```
1. first
2. second
3. third
```


[User]
A template for data is an arbitrarily nested tree of integer indices.

Data payloads are given as a separate mapping, array or other simpler, flat,
association of indices to individual items of data, and are strings.
The idea is to create a data structure with the templates' nesting, and the
payload corresponding to each index appearing at the position of each index.

Answers using simple string replacement or regexp are to be avoided. The idea is
to use the native, or usual implementation of lists/tuples etc of the language
and to hierarchically traverse the template to generate the output.

Task Detail

Given the following input template `t` and list of payloads `p`:

```
# Square brackets are used here to denote nesting but may be changed for other,
# clear, visual representations of nested data appropriate to ones programming
# language.
t = [
    [[1, 2],
     [3, 4, 1],
     5]]

p = 'Payload#0' ... 'Payload#6'

```

The correct output should have the following structure, (although spacing and
linefeeds may differ, the nesting and order should follow):

```
[[['Payload#1', 'Payload#2'],
  ['Payload#3', 'Payload#4', 'Payload#1'],
  'Payload#5']]

```

1. Generate the output for the above template, `t`.

Optional Extended tasks

2. Show which payloads remain unused.
3. Give some indication/handling of indices without a payload.

*Show output on this page.*

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2020.08.1

Explicitly not using strings, using one data structure to fill in another. Since it *isn't* a string, the output format removes the newlines from the template; line feed (white space in general) isn't particularly significant in Raku data structures. It does preserve the nesting though. In the second example, payload "buckets" that don't exist result in an undefined value being inserted; by default: Any.

```
say join "\n  ", '##PAYLOADS:', |my @payloads = 'Payload#' X~ ^7;

for [
     (((1, 2),
       (3, 4, 1),
       5),),

     (((1, 2),
       (10, 4, 1),
       5),)
    ] {
    say "\n      Template: ", $_.raku;
    say "Data structure: { @payloads[|$_].raku }";
}

```

Output:

```
##PAYLOADS:
  Payload#0
  Payload#1
  Payload#2
  Payload#3
  Payload#4
  Payload#5
  Payload#6

      Template: $(((1, 2), (3, 4, 1), 5),)
Data structure: ((("Payload#1", "Payload#2"), ("Payload#3", "Payload#4", "Payload#1"), "Payload#5"),)

      Template: $(((1, 2), (10, 4, 1), 5),)
Data structure: ((("Payload#1", "Payload#2"), (Any, "Payload#4", "Payload#1"), "Payload#5"),)
```


[User]
Given a zero or positive integer, the task is to generate the next largest integer with the same digits\*1.

* Numbers will not be padded to the left with zeroes.
* Use all given digits, with their given multiplicity. (If a digit appears twice in the input number, it should appear twice in the result).
* If there is no next highest integer return zero.

:   \*1   Alternatively phrased as:   "Find the smallest integer larger than the (positive or zero) integer   **N**

    :   which can be obtained by reordering the (base ten) digits of   **N**".

Algorithm 1

1. Generate all the permutations of the digits and sort into numeric order.
2. Find the number in the list.
3. Return the next highest number from the list.

The above could prove slow and memory hungry for numbers with large numbers of
digits, but should be easy to reason about its correctness.

Algorithm 2

1. Scan right-to-left through the digits of the number until you find a digit with a larger digit somewhere to the right of it.
2. Exchange that digit with the smallest digit on the right that is greater than it.
3. Order the digits to the right of this position, after the swap; lowest-to-highest, left-to-right. (that is, so they form the lowest numerical representation)

**E.g.:**

```
    n = 12453
<scan>
    12_4_53
<swap>
    12_5_43
<order-right>
    12_5_34

    return: 12534

```

This second algorithm is faster and more memory efficient, but implementations
may be harder to test.

One method of testing, (as used in developing the task),   is to compare results from both
algorithms for random numbers generated from a range that the first algorithm can handle.

Task requirements

Calculate the next highest integer from the digits of the following numbers:

:   * 0
    * 9
    * 12
    * 21
    * 12453
    * 738440
    * 45072010
    * 95322020

Optional stretch goal
:   * 9589776899767587796600

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2020.01

Minimal error trapping. Assumes that the passed number is an integer. Handles positive or negative integers, always returns next largest regardless (if possible).

```
use Lingua::EN::Numbers;

sub next-greatest-index ($str, &op = &infix:«<» ) {
    my @i = $str.comb;
    (1..^@i).first: { &op(@i[$_ - 1], @i[$_]) }, :end, :k;
}

multi next-greatest-integer (Int $num where * >= 0) {
    return 0 if $num.chars < 2;
    return $num.flip > $num ?? $num.flip !! 0 if $num.chars == 2;
    return 0 unless my $i = next-greatest-index( $num ) // 0;
    my $digit = $num.substr($i, 1);
    my @rest  = (flat $num.substr($i).comb).sort(+*);
    my $next  = @rest.first: * > $digit, :k;
    $digit    = @rest.splice($next,1);
    join '', flat $num.substr(0,$i), $digit, @rest;
}

multi next-greatest-integer (Int $num where * < 0) {
    return 0 if $num.chars < 3;
    return $num.abs.flip < -$num ?? -$num.abs.flip !! 0 if $num.chars == 3;
    return 0 unless my $i = next-greatest-index( $num, &CORE::infix:«>» ) // 0;
    my $digit = $num.substr($i, 1);
    my @rest  = (flat $num.substr($i).comb).sort(-*);
    my $next  = @rest.first: * < $digit, :k;
    $digit    = @rest.splice($next,1);
    join '', flat $num.substr(0,$i), $digit, @rest;
}

say "Next largest integer able to be made from these digits, or zero if no larger exists:";
printf "%30s  -> %s%s\n", .&comma, .&next-greatest-integer < 0 ?? '' !! ' ', .&next-greatest-integer.&comma for
    flat 0, (9, 12, 21, 12453, 738440, 45072010, 95322020, 9589776899767587796600, 3345333,
    95897768997675877966000000000000000000000000000000000000000000000000000000000000000000).map: { $_, -$_ };

```

Output:

```
Next largest integer able to be made from these digits, or zero if no larger exists:
                             0  ->  0
                             9  ->  0
                            -9  ->  0
                            12  ->  21
                           -12  ->  0
                            21  ->  0
                           -21  -> -12
                        12,453  ->  12,534
                       -12,453  -> -12,435
                       738,440  ->  740,348
                      -738,440  -> -738,404
                    45,072,010  ->  45,072,100
                   -45,072,010  -> -45,072,001
                    95,322,020  ->  95,322,200
                   -95,322,020  -> -95,322,002
 9,589,776,899,767,587,796,600  ->  9,589,776,899,767,587,900,667
-9,589,776,899,767,587,796,600  -> -9,589,776,899,767,587,796,060
                     3,345,333  ->  3,353,334
                    -3,345,333  -> -3,343,533
95,897,768,997,675,877,966,000,000,000,000,000,000,000,000,000,000,000,000,000,000,000,000,000,000,000,000,000,000  ->  95,897,768,997,675,879,000,000,000,000,000,000,000,000,000,000,000,000,000,000,000,000,000,000,000,000,000,000,667
-95,897,768,997,675,877,966,000,000,000,000,000,000,000,000,000,000,000,000,000,000,000,000,000,000,000,000,000,000  -> -95,897,768,997,675,877,960,600,000,000,000,000,000,000,000,000,000,000,000,000,000,000,000,000,000,000,000,000,000
```


[User]
Task

**n**   is smallest prime such that the difference of successive terms is strictly increasing,
where     **n**   <   **1050**.

[Assistant]
```
sub is-special ( ($previous, $gap) ) {
    state @primes = grep *.is-prime, 2..*;
    shift @primes while @primes[0] <= $previous + $gap;
    return ( @primes[0], @primes[0] - $previous );
}

my @specials = (2, 0), &is-special … *;

my $limit = @specials.first: :k, *.[0] > 1050;

say .fmt('%4d') for @specials.head($limit);

```

Output:

```
   2    0
   3    1
   5    2
  11    6
  19    8
  29   10
  41   12
  59   18
  79   20
 101   22
 127   26
 157   30
 191   34
 227   36
 269   42
 313   44
 359   46
 409   50
 461   52
 521   60
 587   66
 659   72
 733   74
 809   76
 887   78
 967   80
1049   82
```


[User]
Task
:   :   1. Take an positive integer   **n**
        2. **sumn**   is the sum of the decimal digits of   **n**
        3. If  **sumn'**s  length is greater than   **1**   (unity),   repeat step 2 for   **n = sumn**
        4. Stop when  **sumn'**s  length is equal to   **1**   (unity)

If   **n**   and   **sumn**   are prime,   then   **n**   is a   **Nice prime**

Let     **500   <   n   <   1000**

Example

```
       853 (prime)
       8 + 5 + 3 = 16
       1 + 6 = 7 (prime)

```

Also see
:   :   * The OEIS article:   A78403 Primes such that digital root is prime.

[Assistant]
```
sub digroot ($r) { .tail given $r, { [+] .comb } ... { .chars == 1 } }
my @is-nice = lazy (0..*).map: { .&is-prime && .&digroot.&is-prime ?? $_ !! False };
say @is-nice[500 ^..^ 1000].grep(*.so).batch(11)».fmt("%4d").join: "\n";

```

Output:

```
 509  547  563  569  587  599  601  617  619  641  653
 659  673  677  691  709  727  743  761  797  821  839
 853  857  887  907  911  929  941  947  977  983  997
```

Alternately, with somewhat better separation of concerns.

```
sub digroot ($r) { ($r, { .comb.sum } … { .chars == 1 }).tail }
sub is-nice ($_) { .is-prime && .&digroot.is-prime }
say (500 ^..^ 1000).grep( *.&is-nice ).batch(11)».fmt("%4d").join: "\n";

```

Same output.


[User]
Nim is a simple game where the second player─if they know the trick─will always win.

The game has only 3 rules:

:   :   * start with   **12**   tokens
        * each player takes   **1,  2,  or  3**   tokens in turn
        * the player who takes the last token wins.

To win every time,   the second player simply takes 4 minus the number the first player took.   So if the first player takes 1,   the second takes 3; if the first player takes 2,   the second should take 2; and if the first player takes 3,   the second player will take 1.

Task

Design a simple Nim game where the human player goes first, and the computer always wins. The game should enforce the rules.

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2019.03

```
say my $tokens = 12, " tokens remaining.\n";

loop {
    my $player = trim prompt "How many tokens do you want to remove; 1, 2 or 3? : ";
    say "Nice try. $tokens tokens remaining.\n" and
    next unless $player eq any <1 2 3>;
    $tokens -= 4;
    say "Computer takes {4 - $player}.\n$tokens tokens remaining.\n";
    say "Computer wins." and last if $tokens <= 0;
}

```

Sample output:

```
12 tokens remaining.

How many tokens do you want to remove; 1, 2 or 3? : 3
Computer takes 1.
8 tokens remaining.

How many tokens do you want to remove; 1, 2 or 3? : 6
Nice try. 8 tokens remaining.

How many tokens do you want to remove; 1, 2 or 3? : G
Nice try. 8 tokens remaining.

How many tokens do you want to remove; 1, 2 or 3? : 2
Computer takes 2.
4 tokens remaining.

How many tokens do you want to remove; 1, 2 or 3? : 1
Computer takes 3.
0 tokens remaining.

Computer wins.
```


[User]
The **nimbers**, also known as **Grundy** numbers, are the values of the heaps in the game of Nim. They have **addition** and **multiplication** operations, unrelated to the addition and multiplication of the integers. Both operations are defined recursively:

The **nim-sum** of two integers m and n, denoted m⊕n is given by

m⊕n=mex(m'⊕n, m⊕ n' : m'<m, n'<n),

where the mex function returns the smallest integer *not* in the set. More simply: collect all the nim-sums of *m* and numbers smaller than *n*, and all nim-sums of *n* with all numbers less than *m* and find the smallest number not in that set. Fortunately, this also turns out to be equal to the bitwise xor of the two.

The **nim-product** is also defined recursively:

m⊗n=mex([m'⊗n]⊕[m⊗n']⊕[m'⊗n'] : m'<m, n'<n)

The product is more complicated and time-consuming to evaluate, but there are a few facts which may help:

* The operators ⊕ and ⊗ are commutative and distributive
* the nim-product of a Fermat power (22k) and a smaller number is their ordinary product
* the nim-square of a Fermat power x is the ordinary product 3x/2

Tasks

1. Create nimber addition and multiplication tables up to at least 15
2. Find the nim-sum and nim-product of two five digit integers of your choice

[Assistant]
**Works with**: Rakudo version 2020.05

**Translation of**: FreeBasic

(or at least, heavily inspired by FreeBasic)

Not limited by integer size. Doesn't rely on twos complement bitwise and.

```
sub infix:<⊕> (Int $x, Int $y) { $x +^ $y }

sub infix:<⊗> (Int $x, Int $y) {
    return $x × $y if so $x|$y < 2;
    my $h = exp $x.lsb, 2;
    return ($h ⊗ $y) ⊕ (($x ⊕ $h) ⊗ $y) if $x > $h;
    return ($y ⊗ $x) if $y.lsb < $y.msb;
    return $x × $y unless my $comp = $x.lsb +& $y.lsb;
    $h = exp $comp.lsb, 2;
    (($x +> $h) ⊗ ($y +> $h)) ⊗ (3 +< ($h - 1))
}

# TESTING

my $upto = 26;

for <⊕>, &infix:<⊕>,
    <⊗>, &infix:<⊗>
  -> $op, &f {

    put " $op │", ^$upto .fmt('%3s'), "\n───┼", '────' x $upto;
    -> $r { put $r.fmt('%2s'), ' │', ^$upto .map: { &f($r, $_).fmt('%3s')} } for ^$upto;
    put "\n";
}

put "21508 ⊕ 42689 = ", 21508 ⊕ 42689;
put "21508 ⊗ 42689 = ", 21508 ⊗ 42689;

put "2150821508215082150821508 ⊕ 4268942689426894268942689 = ", 2150821508215082150821508 ⊕ 4268942689426894268942689;
put "2150821508215082150821508 ⊗ 4268942689426894268942689 = ", 2150821508215082150821508 ⊗ 4268942689426894268942689;

```

Output:

```
 ⊕ │  0   1   2   3   4   5   6   7   8   9  10  11  12  13  14  15  16  17  18  19  20  21  22  23  24  25
───┼────────────────────────────────────────────────────────────────────────────────────────────────────────
 0 │  0   1   2   3   4   5   6   7   8   9  10  11  12  13  14  15  16  17  18  19  20  21  22  23  24  25
 1 │  1   0   3   2   5   4   7   6   9   8  11  10  13  12  15  14  17  16  19  18  21  20  23  22  25  24
 2 │  2   3   0   1   6   7   4   5  10  11   8   9  14  15  12  13  18  19  16  17  22  23  20  21  26  27
 3 │  3   2   1   0   7   6   5   4  11  10   9   8  15  14  13  12  19  18  17  16  23  22  21  20  27  26
 4 │  4   5   6   7   0   1   2   3  12  13  14  15   8   9  10  11  20  21  22  23  16  17  18  19  28  29
 5 │  5   4   7   6   1   0   3   2  13  12  15  14   9   8  11  10  21  20  23  22  17  16  19  18  29  28
 6 │  6   7   4   5   2   3   0   1  14  15  12  13  10  11   8   9  22  23  20  21  18  19  16  17  30  31
 7 │  7   6   5   4   3   2   1   0  15  14  13  12  11  10   9   8  23  22  21  20  19  18  17  16  31  30
 8 │  8   9  10  11  12  13  14  15   0   1   2   3   4   5   6   7  24  25  26  27  28  29  30  31  16  17
 9 │  9   8  11  10  13  12  15  14   1   0   3   2   5   4   7   6  25  24  27  26  29  28  31  30  17  16
10 │ 10  11   8   9  14  15  12  13   2   3   0   1   6   7   4   5  26  27  24  25  30  31  28  29  18  19
11 │ 11  10   9   8  15  14  13  12   3   2   1   0   7   6   5   4  27  26  25  24  31  30  29  28  19  18
12 │ 12  13  14  15   8   9  10  11   4   5   6   7   0   1   2   3  28  29  30  31  24  25  26  27  20  21
13 │ 13  12  15  14   9   8  11  10   5   4   7   6   1   0   3   2  29  28  31  30  25  24  27  26  21  20
14 │ 14  15  12  13  10  11   8   9   6   7   4   5   2   3   0   1  30  31  28  29  26  27  24  25  22  23
15 │ 15  14  13  12  11  10   9   8   7   6   5   4   3   2   1   0  31  30  29  28  27  26  25  24  23  22
16 │ 16  17  18  19  20  21  22  23  24  25  26  27  28  29  30  31   0   1   2   3   4   5   6   7   8   9
17 │ 17  16  19  18  21  20  23  22  25  24  27  26  29  28  31  30   1   0   3   2   5   4   7   6   9   8
18 │ 18  19  16  17  22  23  20  21  26  27  24  25  30  31  28  29   2   3   0   1   6   7   4   5  10  11
19 │ 19  18  17  16  23  22  21  20  27  26  25  24  31  30  29  28   3   2   1   0   7   6   5   4  11  10
20 │ 20  21  22  23  16  17  18  19  28  29  30  31  24  25  26  27   4   5   6   7   0   1   2   3  12  13
21 │ 21  20  23  22  17  16  19  18  29  28  31  30  25  24  27  26   5   4   7   6   1   0   3   2  13  12
22 │ 22  23  20  21  18  19  16  17  30  31  28  29  26  27  24  25   6   7   4   5   2   3   0   1  14  15
23 │ 23  22  21  20  19  18  17  16  31  30  29  28  27  26  25  24   7   6   5   4   3   2   1   0  15  14
24 │ 24  25  26  27  28  29  30  31  16  17  18  19  20  21  22  23   8   9  10  11  12  13  14  15   0   1
25 │ 25  24  27  26  29  28  31  30  17  16  19  18  21  20  23  22   9   8  11  10  13  12  15  14   1   0

 ⊗ │  0   1   2   3   4   5   6   7   8   9  10  11  12  13  14  15  16  17  18  19  20  21  22  23  24  25
───┼────────────────────────────────────────────────────────────────────────────────────────────────────────
 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 │  0   1   2   3   4   5   6   7   8   9  10  11  12  13  14  15  16  17  18  19  20  21  22  23  24  25
 2 │  0   2   3   1   8  10  11   9  12  14  15  13   4   6   7   5  32  34  35  33  40  42  43  41  44  46
 3 │  0   3   1   2  12  15  13  14   4   7   5   6   8  11   9  10  48  51  49  50  60  63  61  62  52  55
 4 │  0   4   8  12   6   2  14  10  11  15   3   7  13   9   5   1  64  68  72  76  70  66  78  74  75  79
 5 │  0   5  10  15   2   7   8  13   3   6   9  12   1   4  11  14  80  85  90  95  82  87  88  93  83  86
 6 │  0   6  11  13  14   8   5   3   7   1  12  10   9  15   2   4  96 102 107 109 110 104 101  99 103  97
 7 │  0   7   9  14  10  13   3   4  15   8   6   1   5   2  12  11 112 119 121 126 122 125 115 116 127 120
 8 │  0   8  12   4  11   3   7  15  13   5   1   9   6  14  10   2 128 136 140 132 139 131 135 143 141 133
 9 │  0   9  14   7  15   6   1   8   5  12  11   2  10   3   4  13 144 153 158 151 159 150 145 152 149 156
10 │  0  10  15   5   3   9  12   6   1  11  14   4   2   8  13   7 160 170 175 165 163 169 172 166 161 171
11 │  0  11  13   6   7  12  10   1   9   2   4  15  14   5   3   8 176 187 189 182 183 188 186 177 185 178
12 │  0  12   4   8  13   1   9   5   6  10   2  14  11   7  15   3 192 204 196 200 205 193 201 197 198 202
13 │  0  13   6  11   9   4  15   2  14   3   8   5   7  10   1  12 208 221 214 219 217 212 223 210 222 211
14 │  0  14   7   9   5  11   2  12  10   4  13   3  15   1   8   6 224 238 231 233 229 235 226 236 234 228
15 │  0  15   5  10   1  14   4  11   2  13   7   8   3  12   6   9 240 255 245 250 241 254 244 251 242 253
16 │  0  16  32  48  64  80  96 112 128 144 160 176 192 208 224 240  24   8  56  40  88  72 120 104 152 136
17 │  0  17  34  51  68  85 102 119 136 153 170 187 204 221 238 255   8  25  42  59  76  93 110 127 128 145
18 │  0  18  35  49  72  90 107 121 140 158 175 189 196 214 231 245  56  42  27   9 112  98  83  65 180 166
19 │  0  19  33  50  76  95 109 126 132 151 165 182 200 219 233 250  40  59   9  26 100 119  69  86 172 191
20 │  0  20  40  60  70  82 110 122 139 159 163 183 205 217 229 241  88  76 112 100  30  10  54  34 211 199
21 │  0  21  42  63  66  87 104 125 131 150 169 188 193 212 235 254  72  93  98 119  10  31  32  53 203 222
22 │  0  22  43  61  78  88 101 115 135 145 172 186 201 223 226 244 120 110  83  69  54  32  29  11 255 233
23 │  0  23  41  62  74  93  99 116 143 152 166 177 197 210 236 251 104 127  65  86  34  53  11  28 231 240
24 │  0  24  44  52  75  83 103 127 141 149 161 185 198 222 234 242 152 128 180 172 211 203 255 231  21  13
25 │  0  25  46  55  79  86  97 120 133 156 171 178 202 211 228 253 136 145 166 191 199 222 233 240  13  20

21508 ⊕ 42689 = 62149
21508 ⊗ 42689 = 35202
2150821508215082150821508 ⊕ 4268942689426894268942689 = 2722732241575131661744101
2150821508215082150821508 ⊗ 4268942689426894268942689 = 221974472829844568827862736061997038065
```


[User]
Suppose you have a sequence of integers, starting with 1. Each integer that gets added to the sequence must be lexicographically later, and must have the property that when added, there is no subsequence that will sum to a prime number.

Note

for the purposes of this task, "lexicographically later" means "greater than" - see the Mathematical discussion of ordering link below.

E.G.

```
   Sequence starts with: (1)
   testing integers...
   1  - is not lexicographically later
   2  - 2 + 1 is 3, a prime
   3  - is prime ( a sum can be of a single element )
   4  - 4 + 1 is 5, a prime
   5  - is prime
   6  - 6 + 1 is 7, a prime
   7  - is prime
   8  - 8 is later than 1, is not prime and 8 + 1 is not prime, so 8 is added to the sequence
   and so on...

```

There are variations of this sequence that have some further constraints.

* Same premise except that each added integer must also be odd.
* Same premise except that each added integer must also be even.

Task

Find the first **eight** elements of each variation, starting with **1**, where each added element is:

* Lexicographically later, and yields no non-prime subsequence sum.
* Lexicographically later, yields no non-prime subsequence sum, and is odd.
* Lexicographically later, yields no non-prime subsequence sum, and is even.

Stretch

The numbers grow quite large very quickly. Find the first **ten** elements of each sequence, with an approximate elapsed time.

See also

* OEIS A052349 - Lexicographically earliest sequence of distinct positive integers such that no subsequence sums to a prime * OEIS A128687 - Smallest odd nonprime such that every subset sums to a nonprime * OEIS A128688 - a(1)=1. For n>1, a(n) is the smallest even number such that every subset sums to a nonprime * Mathematical discussion of Ordering

[Assistant]
This version is multi-threaded to take advantage of multicore processors. When run on a Ryzen 5950 16 core processor, it takes a little under 1 second total to produce the first 8 elements of all three sequences. Stepping up to 10 elements of each takes just over 31 minutes total. :-( The timing will scale inversely with the number of cores available.

Attempt This Online! (8 elements only)

```
say "Sequence, starting with 1, then:";

for '', (*), 'odd ', (* % 2), 'even ', (* %% 2) -> $label, $filter {
    my @check = 0, 1;
    my @seq = 1, |lazy gather loop {
        state $last = 1;
        take $last = ($last^..Inf).grep($filter).hyper.grep({ none (@check.grep({.defined}) »+» $_)».is-prime })[0];
        @check.append: @check »+» $last;
    }

    say "\nlexicographically  earliest {$label}integer such that no subsequence sums to a prime:\n",
    @seq[^10];
}

```

Output:

```
Sequence, starting with 1, then:

lexicographically earliest integer such that no subsequence sums to a prime:
(1 8 24 25 86 1260 1890 14136 197400 10467660)

lexicographically earliest odd integer such that no subsequence sums to a prime:
(1 9 15 39 105 731 2805 59535 2658795 78060135)

lexicographically earliest even integer such that no subsequence sums to a prime:
(1 8 24 86 90 780 5940 52350 278460 40768260)
```


[User]
Consider some sequence of elements. (It differs from a mere set of elements by having an ordering among members.)

A *subsequence* contains some subset of the elements of this sequence, in the same order.

A *continuous* subsequence is one in which no elements are missing between the first and last elements of the subsequence.

Note: Subsequences are defined *structurally*, not by their contents.
So a sequence *a,b,c,d* will always have the same subsequences and continuous subsequences, no matter which values are substituted; it may even be the same value.

**Task**: Find all non-continuous subsequences for a given sequence.

Example

For the sequence   *1,2,3,4*,   there are five non-continuous subsequences, namely:

:   :   :   :   * *1,3*
                * *1,4*
                * *2,4*
                * *1,3,4*
                * *1,2,4*

Goal

There are different ways to calculate those subsequences.

Demonstrate algorithm(s) that are natural for the language.

Other tasks related to string operations:

Metrics

* Array length
* String length
* Copy a string
* Empty string  (assignment)

Counting

* Word frequency
* Letter frequency
* Jewels and stones
* I before E except after C
* Bioinformatics/base count
* Count occurrences of a substring
* Count how many vowels and consonants occur in a string

Remove/replace

* XXXX redacted
* Conjugate a Latin verb
* Remove vowels from a string
* String interpolation (included)
* Strip block comments
* Strip comments from a string
* Strip a set of characters from a string
* Strip whitespace from a string -- top and tail
* Strip control codes and extended characters from a string

Anagrams/Derangements/shuffling

* Word wheel
* ABC problem
* Sattolo cycle
* Knuth shuffle
* Ordered words
* Superpermutation minimisation
* Textonyms (using a phone text pad)
* Anagrams
* Anagrams/Deranged anagrams
* Permutations/Derangements

Find/Search/Determine

* ABC words
* Odd words
* Word ladder
* Semordnilap
* Word search
* Wordiff  (game)
* String matching
* Tea cup rim text
* Alternade words
* Changeable words
* State name puzzle
* String comparison
* Unique characters
* Unique characters in each string
* Extract file extension
* Levenshtein distance
* Palindrome detection
* Common list elements
* Longest common suffix
* Longest common prefix
* Compare a list of strings
* Longest common substring
* Find common directory path
* Words from neighbour ones
* Change e letters to i in words
* Non-continuous subsequences
* Longest common subsequence
* Longest palindromic substrings
* Longest increasing subsequence
* Words containing "the" substring
* Sum of the digits of n is substring of n
* Determine if a string is numeric
* Determine if a string is collapsible
* Determine if a string is squeezable
* Determine if a string has all unique characters
* Determine if a string has all the same characters
* Longest substrings without repeating characters
* Find words which contains all the vowels
* Find words which contain the most consonants
* Find words which contains more than 3 vowels
* Find words whose first and last three letters are equal
* Find words with alternating vowels and consonants

Formatting

* Substring
* Rep-string
* Word wrap
* String case
* Align columns
* Literals/String
* Repeat a string
* Brace expansion
* Brace expansion using ranges
* Reverse a string
* Phrase reversals
* Comma quibbling
* Special characters
* String concatenation
* Substring/Top and tail
* Commatizing numbers
* Reverse words in a string
* Suffixation of decimal numbers
* Long literals, with continuations
* Numerical and alphabetical suffixes
* Abbreviations, easy
* Abbreviations, simple
* Abbreviations, automatic

Song lyrics/poems/Mad Libs/phrases

* Mad Libs
* Magic 8-ball
* 99 bottles of beer
* The Name Game (a song)
* The Old lady swallowed a fly
* The Twelve Days of Christmas

Tokenize

* Text between
* Tokenize a string
* Word break problem
* Tokenize a string with escaping
* Split a character string based on change of character

Sequences

* Show ASCII table
* De Bruijn sequences
* Summarize and say sequence
* Generate lower case ASCII alphabet

[Assistant]
(formerly Perl 6)

**Works with**: rakudo version 2015-09-24

```
sub non_continuous_subsequences ( *@list ) {
    @list.combinations.grep: { 1 != all( .[ 0 ^.. .end] Z- .[0 ..^ .end] ) }
}

say non_continuous_subsequences( 1..3 )».gist;
say non_continuous_subsequences( 1..4 )».gist;
say non_continuous_subsequences(   ^4 ).map: {[<a b c d>[.list]].gist};

```

Output:

```
((1 3))
((1 3) (1 4) (2 4) (1 2 4) (1 3 4))
([a c] [a d] [b d] [a b d] [a c d])
```


[User]
Number base conversion is when you express a stored integer in an integer base, such as in octal (base 8) or binary (base 2). It also is involved when you take a string representing a number in a given base and convert it to the stored integer form. Normally, a stored integer is in binary, but that's typically invisible to the user, who normally enters or sees stored integers as decimal.

Task

Write a function (or identify the built-in function) which is passed a non-negative integer to convert, and another integer representing the base.

It should return a string containing the digits of the resulting number, without leading zeros except for the number   **0**   itself.

For the digits beyond 9, one should use the lowercase English alphabet, where the digit   **a** = 9+1,   **b** = a+1,   etc.

For example:   the decimal number   **26**   expressed in base   **16**   would be   **1a**.

Write a second function which is passed a string and an integer base, and it returns an integer representing that string interpreted in that base.

The programs may be limited by the word size or other such constraint of a given language. There is no need to do error checking for negatives, bases less than 2, or inappropriate digits.

[Assistant]
(formerly Perl 6)

```
sub from-base(Str $str, Int $base) {
    +":$base\<$str>";
}

sub to-base(Real $num, Int $base) {
    $num.base($base);
}

```

These work on any real type including integer types. There is also a build in method/function for Strings: parse-base.


[User]
It is common to have a string containing a number written in some format, with the most common ones being decimal, hexadecimal, octal and binary. Such strings are found in many places (user interfaces, configuration files, XML data, network protocols, etc.)

This task requires parsing of such a string (which may be assumed to contain nothing else) using the language's built-in facilities if possible. Parsing of decimal strings is required, parsing of other formats is optional but should be shown (i.e., if the language can parse in base-19 then that should be illustrated).

The solutions may assume that the base of the number in the string is known. In particular, if your language has a facility to guess the base of a number by looking at a prefix (e.g. "0x" for hexadecimal) or other distinguishing syntax as it parses it, please show that.

The reverse operation is in task Non-decimal radices/Output

For general number base conversion, see Non-decimal radices/Convert.

[Assistant]
(formerly Perl 6)
By default, all strings of digits are parsed as base 10 numbers, including those with a leading zero. Numbers with a prefix 0b, 0o, 0d or 0x are parsed as binary, octal, decimal or hexadecimal respectively.

```
say 0b11011;  # -> 27
say 0o11011;  # -> 4617
say 0d11011;  # -> 11011
say 0x11011;  # -> 69649

```

Additionally, there are built-in adverbial prefix operators to parse strings of "digits" of radix 2 through radix 36 into decimal. They will fail with a runtime error if they are fed a digit that is not valid in that radix.

```
my $n = '11011';

say  :2($n); # -> 27
say  :3($n); # -> 112
say  :4($n); # -> 325
say  :5($n); # -> 756
say  :6($n); # -> 1519
say  :7($n); # -> 2752
say  :8($n); # -> 4617
say  :9($n); # -> 7300
say :10($n); # -> 11011
say :11($n); # -> 15984
say :12($n); # -> 22477
say :13($n); # -> 30772
say :14($n); # -> 41175
say :15($n); # -> 54016
say :16($n); # -> 69649
say :17($n); # -> 88452
say :18($n); # -> 110827
say :19($n); # -> 137200
say :20($n); # -> 168021
say :21($n); # -> 203764
say :22($n); # -> 244927
say :23($n); # -> 292032
say :24($n); # -> 345625
say :25($n); # -> 406276
say :26($n); # -> 474579
say :27($n); # -> 551152
say :28($n); # -> 636637
say :29($n); # -> 731700
say :30($n); # -> 837031
say :31($n); # -> 953344
say :32($n); # -> 1081377
say :33($n); # -> 1221892
say :34($n); # -> 1375675
say :35($n); # -> 1543536
say :36($n); # -> 1726309

```


[User]
Programming languages often have built-in routines to convert a non-negative integer for printing in different number bases. Such common number bases might include binary, Octal and Hexadecimal.

Task

Print a small range of integers in some different bases, as supported by standard routines of your programming language.

Note

This is distinct from Number base conversion as a user-defined conversion function is **not** asked for.)

The reverse operation is Common number base parsing.

[Assistant]
(formerly Perl 6)

Calling the `.base` method on a number returns a string. It can handle all bases between 2 and 36:

```
say 30.base(2);   # "11110"
say 30.base(8);   # "36"
say 30.base(10);  # "30"
say 30.base(16);  # "1E"
say 30.base(30);  # "10"

```

Alternatively, `printf` can be used for some common number bases:

```
for 0..33 -> $n {
  printf " %6b %3o %2d %2X\n", $n xx 4;
}

```


[User]
Let our dice select numbers on their faces with equal probability, i.e. fair dice.
Dice may have more or less than six faces. (The possibility of there being a
3D physical shape that has that many "faces" that allow them to be fair dice,
is ignored for this task - a die with 3 or 33 defined sides is defined by the
number of faces and the numbers on each face).

Throwing dice will randomly select a face on each die with equal probability.
To show which die of dice thrown multiple times is more likely to win over the
others:

1. calculate all possible combinations of different faces from each die
2. Count how many times each die wins a combination
3. Each *combination* is equally likely so the die with more winning face combinations is statistically more likely to win against the other dice.

**If two dice X and Y are thrown against each other then X likely to: win, lose, or break-even against Y can be shown as: `X > Y, X < Y, or X = Y` respectively.**

Example 1

If X is the three sided die with 1, 3, 6 on its faces and Y has 2, 3, 4 on its
faces then the equal possibility outcomes from throwing both, and the winners
is:

```
   X   Y   Winner
   =   =   ======
   1   2   Y
   1   3   Y
   1   4   Y
   3   2   X
   3   3   -
   3   4   Y
   6   2   X
   6   3   X
   6   4   X

   TOTAL WINS: X=4, Y=4

```

Both die will have the same statistical probability of winning, i.e.their comparison can be written as `X = Y`

Transitivity

In mathematics transitivity are rules like:

```
   if a op b and b op c then a op c

```

If, for example, the op, (for operator), is the familiar less than, <, and it's applied to integers
we get the familiar `if a < b and b < c then a < c`

Non-transitive dice

These are an ordered list of dice where the '>' operation between successive
dice pairs applies but a comparison between the first and last of the list
yields the opposite result, '<'.
*(Similarly '<' successive list comparisons with a final '>' between first and last is also non-transitive).*

Three dice S, T, U with appropriate face values could satisfy

```
   S < T, T < U and yet S > U

```

To be non-transitive.

Notes

* The order of numbers on the faces of a die is not relevant. For example, three faced die described with face numbers of 1, 2, 3 or 2, 1, 3 or any other permutation are equivalent. For the purposes of the task **show only the permutation in lowest-first sorted order i.e. 1, 2, 3** (and remove any of its perms).
* A die can have more than one instance of the same number on its faces, e.g. `2, 3, 3, 4`
* **Rotations**: Any rotation of non-transitive dice from an answer is also an answer. You may *optionally* compute and show only one of each such rotation sets, ideally the first when sorted in a natural way. If this option is used then prominently state in the output that rotations of results are also solutions.

Task

====

Find all the ordered lists of *three* non-transitive dice S, T, U of the form
S < T, T < U and yet S > U; where the dice are selected from all *four-faced die*
, (unique w.r.t the notes), possible by having selections from the integers
*one to four* on any dies face.

Solution can be found by generating all possble individual die then testing all
possible permutations, (permutations are ordered), of three dice for
non-transitivity.

Optional stretch goal

Find lists of **four** non-transitive dice selected from the same possible dice from the non-stretch goal.

Show the results here, on this page.

References

* The Most Powerful Dice - Numberphile Video.
* Nontransitive dice - Wikipedia.

[Assistant]
Thanks to Thundergnat for the nice "less-is-more" tweaks now the 4 dice portion takes around 10 (down from 17 ) minutes to run ..

**Translation of**: Go

```
# 20201225 Raku programming solution

my @dicepool = ^4 xx 4 ;

sub FaceCombs(\N, @dp) { # for brevity, changed to use 0-based dice on input
   my @res = my @found = [];
   for [X] @dp {
      unless @found[ my \key = [+] ( N «**« (N-1…0) ) Z* .sort ] {
         @found[key] = True;
         @res.push: $_ »+» 1
      }
   }
   @res
}

sub infix:<⚖>(@x, @y) { +($_{Less} <=> $_{More}) given (@x X<=> @y).Bag }

sub findIntransitive(\N, \cs) {
   my @res = [];
   race for [X] ^+cs xx N -> @lot {
      my $skip = False;
      for @lot.rotor(2 => -1) {
         { $skip = True and last } unless cs[ @_[0] ] ⚖ cs[ @_[1] ] == -1
      }
      next if $skip;
      if cs[ @lot[0] ] ⚖ cs[ @lot[*-1] ] == 1 { @res.push: [ cs[ @lot ] ] }
   }
   @res
}

say "Number of eligible 4-faced dice : ", +(my \combs = FaceCombs(4,@dicepool));
for 3, 4 {
   my @output = findIntransitive($_, combs);
   say +@output, " ordered lists of $_ non-transitive dice found, namely:";
   .say for @output;
}

```

Output:

```
Number of eligible 4-faced dice : 35
3 ordered lists of 3 non-transitive dice found, namely:
[(1 1 4 4) (2 2 2 4) (1 3 3 3)]
[(1 3 3 3) (1 1 4 4) (2 2 2 4)]
[(2 2 2 4) (1 3 3 3) (1 1 4 4)]
4 ordered lists of 4 non-transitive dice found, namely:
[(1 1 4 4) (2 2 2 4) (2 2 3 3) (1 3 3 3)]
[(1 3 3 3) (1 1 4 4) (2 2 2 4) (2 2 3 3)]
[(2 2 2 4) (2 2 3 3) (1 3 3 3) (1 1 4 4)]
[(2 2 3 3) (1 3 3 3) (1 1 4 4) (2 2 2 4)]
```


[User]
Nonoblock is a chip off the old Nonogram puzzle.

Given

* The number of cells in a row.
* The size of each, (space separated), connected block of cells to fit in the row, in left-to right order.

Task

* show all possible positions.
* show the number of positions of the blocks for the following cases within the row.
* show all output on this page.
* use a "neat" diagram of the block positions.

Enumerate the following configurations

1. **5**   cells   and   **[2, 1]**   blocks
2. **5**   cells   and   **[]**   blocks   (no blocks)
3. **10**   cells   and   **[8]**   blocks
4. **15**   cells   and   **[2, 3, 2, 3]**   blocks
5. **5**   cells   and   **[2, 3]**   blocks   (should give some indication of this not being possible)

Example

Given a row of five cells and a block of two cells followed by a block of one cell - in that order, the example could be shown as:

```
   |_|_|_|_|_| # 5 cells and [2, 1] blocks

```

And would expand to the following 3 possible rows of block positions:

```
   |A|A|_|B|_|
   |A|A|_|_|B|
   |_|A|A|_|B|

```

Note how the sets of blocks are always separated by a space.

Note also that it is not necessary for each block to have a separate letter.
Output approximating

This:

```
                       |#|#|_|#|_|
                       |#|#|_|_|#|
                       |_|#|#|_|#|

```

This would also work:

```
                       ##.#.
                       ##..#
                      .##.#

```

An algorithm

* Find the minimum space to the right that is needed to legally hold all but the leftmost block of cells (with a space between blocks remember).
* The leftmost cell can legitimately be placed in all positions from the LHS up to a RH position that allows enough room for the rest of the blocks.
* for each position of the LH block recursively compute the position of the rest of the blocks in the *remaining* space to the right of the current placement of the LH block.

(This is the algorithm used in the Nonoblock#Python solution).

Reference

* The blog post Nonogram puzzle solver (part 1) Inspired this task and donated its Nonoblock#Python solution.

[Assistant]
(formerly Perl 6)

**Translation of**: Perl

```
for (5, [2,1]), (5, []), (10, [8]), (5, [2,3]), (15, [2,3,2,3]) -> ($cells, @blocks) {
    say $cells, ' cells with blocks: ', @blocks ?? join ', ', @blocks !! '∅';
    my $letter = 'A';
    my $row = join '.', map { $letter++ x $_ }, @blocks;
    say "no solution\n" and next if $cells < $row.chars;
    say $row ~= '.' x $cells - $row.chars;
    say $row while $row ~~ s/^^ (\.*) <|w> (.*?) <|w> (\w+) \.<!|w> /$1$0.$2/;
    say '';
}

```

Output:

```
5 cells with blocks: 2, 1
AA.B.
AA..B
.AA.B

5 cells with blocks: ∅
.....

10 cells with blocks: 8
AAAAAAAA..
.AAAAAAAA.
..AAAAAAAA

5 cells with blocks: 2, 3
no solution

15 cells with blocks: 2, 3, 2, 3
AA.BBB.CC.DDD..
AA.BBB.CC..DDD.
AA.BBB..CC.DDD.
AA..BBB.CC.DDD.
.AA.BBB.CC.DDD.
AA.BBB.CC...DDD
AA.BBB..CC..DDD
AA..BBB.CC..DDD
.AA.BBB.CC..DDD
AA.BBB...CC.DDD
AA..BBB..CC.DDD
.AA.BBB..CC.DDD
AA...BBB.CC.DDD
.AA..BBB.CC.DDD
..AA.BBB.CC.DDD
```


[User]
A nonogram is a puzzle that provides
numeric clues used to fill in a grid of cells,
establishing for each cell whether it is filled or not.
The puzzle solution is typically a picture of some kind.

Each row and column of a rectangular grid is annotated with the lengths
of its distinct runs of occupied cells.
Using only these lengths you should find one valid configuration
of empty and occupied cells, or show a failure message.

Example

```
Problem:                 Solution:

. . . . . . . .  3       . # # # . . . .  3
. . . . . . . .  2 1     # # . # . . . .  2 1
. . . . . . . .  3 2     . # # # . . # #  3 2
. . . . . . . .  2 2     . . # # . . # #  2 2
. . . . . . . .  6       . . # # # # # #  6
. . . . . . . .  1 5     # . # # # # # .  1 5
. . . . . . . .  6       # # # # # # . .  6
. . . . . . . .  1       . . . . # . . .  1
. . . . . . . .  2       . . . # # . . .  2
1 3 1 7 5 3 4 3          1 3 1 7 5 3 4 3
2 1 5 1                  2 1 5 1
```

The problem above could be represented by two lists of lists:

```
x = [[3], [2,1], [3,2], [2,2], [6], [1,5], [6], [1], [2]]
y = [[1,2], [3,1], [1,5], [7,1], [5], [3], [4], [3]]
```

A more compact representation of the same problem uses strings,
where the letters represent the numbers, A=1, B=2, etc:

```
x = "C BA CB BB F AE F A B"
y = "AB CA AE GA E C D C"
```

Task

For this task, try to solve the 4 problems below, read from a “nonogram\_problems.txt” file that has this content
(the blank lines are separators):

```
C BA CB BB F AE F A B
AB CA AE GA E C D C

F CAC ACAC CN AAA AABB EBB EAA ECCC HCCC
D D AE CD AE A DA BBB CC AAB BAA AAB DA AAB AAA BAB AAA CD BBA DA

CA BDA ACC BD CCAC CBBAC BBBBB BAABAA ABAD AABB BBH BBBD ABBAAA CCEA AACAAB BCACC ACBH DCH ADBE ADBB DBE ECE DAA DB CC
BC CAC CBAB BDD CDBDE BEBDF ADCDFA DCCFB DBCFC ABDBA BBF AAF BADB DBF AAAAD BDG CEF CBDB BBB FC

E BCB BEA BH BEK AABAF ABAC BAA BFB OD JH BADCF Q Q R AN AAN EI H G
E CB BAB AAA AAA AC BB ACC ACCA AGB AIA AJ AJ ACE AH BAF CAG DAG FAH FJ GJ ADK ABK BL CM
```

**Extra credit**: generate nonograms with unique solutions, of desired height and width.

This task is the problem n.98 of the "99 Prolog Problems" (archived) by Werner Hett (also thanks to Paul Singleton for the idea and the examples).

Related tasks

* Nonoblock.

See also

* Arc Consistency Algorithm
* http://www.haskell.org/haskellwiki/99\_questions/Solutions/98 (Haskell)
* http://twanvl.nl/blog/haskell/Nonograms (Haskell)
* http://picolisp.com/5000/!wiki?99p98 (PicoLisp)

[Assistant]
### Translation of Go

**Translation of**: Go

```
# 20220401 Raku programming solution

sub reduce(\a, \b) {
   my \countRemoved = $ = 0;
   for ^+a -> \i {
      my \commonOn  = @ =  True xx b.elems;
      my \commonOff = @ = False xx b.elems;

      a[i].map: -> \candidate { commonOn  <<?&=>> candidate ;
                                commonOff <<?|=>> candidate }
      # remove from b[j] all candidates that don't share the forced values
      for ^+b -> \j {
         my (\fi,\fj) = i, j;
         for ((+b[j])^...0) -> \k {
            my \cnd = b[j][k];
            if (commonOn[fj] ?& !cnd[fi]) ?| (!commonOff[fj] ?& cnd[fi]) {
	       b[j][k..*-2] = b[j][k+1..*-1];
               b[j].pop;
               countRemoved++
            }
         }
         return -1 if b[j].elems == 0
      }
   }
   return countRemoved
}

sub genSequence(\ones, \numZeros) {
   if ( my \le = ones.elems ) == 0 { return [~] '0' xx numZeros }

   my @result;
   loop ( my $x = 1; $x < ( numZeros -le+2); $x++ ) {
      my @skipOne = ones[1..*];
      for genSequence(@skipOne, numZeros -$x) -> \tail {
         @result.push:  ( '0' x $x )~ones[0]~tail
      }
   }
   return @result
}

# If all the candidates for a row have a value in common for a certain cell,
#   then it's the only possible outcome, and all the candidates from the
#   corresponding column need to have that value for that cell too. The ones
#   that don't, are removed. The same for all columns. It goes back and forth,
#   until no more candidates can be removed or a list is empty (failure).

sub reduceMutual(\cols, \rows) {
   return -1 if ( my \countRemoved1 = reduce(cols, rows) ) == -1 ;
   return -1 if ( my \countRemoved2 = reduce(rows, cols) ) == -1 ;

   return countRemoved1 + countRemoved2
}

# collect all possible solutions for the given clues
sub getCandidates(@data, \len) {
   return gather for @data -> \s {
      my \sumBytes = [+] (my @a = s.ords)>>.&{ $_ - 'A'.ord + 1 }
      my @prep = @a.values.map: { [~] '1' xx ($_ - 'A'.ord + 1) }
      take ( gather for genSequence(@prep, len -sumBytes+1) -> \r {
         my \bits = r.substr(1..*).ords;
	 take ( bits.values.map: *.chr == '1' ).Array
      } ).Array
   }
}

sub  newPuzzle (@data) {

   my (@rowData,@colData) := @data.map: *.split: ' ' ;

   my \rows = getCandidates(@rowData, @colData.elems);
   my \cols = getCandidates(@colData, @rowData.elems);

   loop {
      my \numChanged = reduceMutual(cols, rows);
      given (numChanged) { when -1 { say "No solution" andthen return }
                           when  0 { last }                             }
   }

   for rows -> \row {
      for ^+cols -> \k { print row[0][k] ?? '# ' !! '. ' }
      print "\n"
   }
   print "\n"
}

newPuzzle $_ for (
   ( "C BA CB BB F AE F A B", "AB CA AE GA E C D C" ),

   ( "F CAC ACAC CN AAA AABB EBB EAA ECCC HCCC",
     "D D AE CD AE A DA BBB CC AAB BAA AAB DA AAB AAA BAB AAA CD BBA DA" ),

   ( "CA BDA ACC BD CCAC CBBAC BBBBB BAABAA ABAD AABB BBH "
       ~"BBBD ABBAAA CCEA AACAAB BCACC ACBH DCH ADBE ADBB DBE ECE DAA DB CC",
     "BC CAC CBAB BDD CDBDE BEBDF ADCDFA DCCFB DBCFC ABDBA BBF AAF BADB DBF "
        ~"AAAAD BDG CEF CBDB BBB FC" ),

   ( "E BCB BEA BH BEK AABAF ABAC BAA BFB OD JH BADCF Q Q R AN AAN EI H G",
     "E CB BAB AAA AAA AC BB ACC ACCA AGB AIA AJ AJ "
        ~"ACE AH BAF CAG DAG FAH FJ GJ ADK ABK BL CM" ),
);

```

### Translation of Perl

**Translation of**: Perl

```
for './nonogram_problems.txt'.IO.lines.rotor(3, :partial) {

   my (@rpats,@cpats) := @_[0,1]>>.&makepatterns;
   my @rows            = ( '.' x +@cpats ) xx +@rpats ;

   loop (my $prev = ''; $prev ne ~@rows; ) {
      $prev = ~@rows;
      try(@rows, @rpats);
      my @cols = (^+@cpats).map: { [~] @rows.map: { ~ s/.// } }
      try(@cols, @cpats);
      @rows    = (^+@rpats).map: { [~] @cols.map: { ~ s/.// } }
   }
   say();
   @rows ~~ /\./ ?? say "Failed" !! say TR/01/.@/ for @rows
}

sub try(@lines, @patterns) {
   for ^+@lines -> $i {
      my $pos = 0;
      while ( @lines[$i] ~~ m:g/\./ and $pos < @lines[$i].chars ) {
         for 0, 1 -> $try {
	    with @lines[$i] { S:pos($pos)/\./$try/ ~~ /<{@patterns[$i]}>/ or
                              s:pos($pos)/./{ 1 - $try }/                   }
         }
	 $pos++;
      }
   }
}

sub makepatterns($input) {
   $input ==> split( ' ' )
          ==>   map( *.comb )
	  ==>   map( *>>.&{ .ord - 64 } )
	  ==>   map( '<[1.]>**' <<~<< * )
	  ==>   map( *.join:  '<[0.]>+' )
	  ==>   map( '^<[0.]>*' ~ * ~ '<[0.]>*$' )
}

```


[User]
Task

Implement the algorithm to compute the principal   nth   root

A

n
{\displaystyle {\displaystyle {\sqrt[{n}]{A}}}}
   of a positive real number   *A*,   as explained at the   Wikipedia page.

[Assistant]
(formerly Perl 6)

```
sub infix:<√>($n, $A) {
    .tail given $A / $n, { (($n-1) * $_+ $A / ($_** ($n-1))) / $n } ... * ≅ *;
}

use Test;
plan 9;
is-approx ($_√pi)**$_, pi for 2 .. 10;

```


[User]
**Null** (or **nil**) is the computer science concept of an undefined or unbound object.
Some languages have an explicit way to access the null object, and some don't.
Some languages distinguish the null object from undefined values, and some don't.

Task

Show how to access null in your language by checking to see if an object is equivalent to the null object.

*This task is not about whether a variable is defined. The task is about "null"-like values in various languages, which may or may not be related to the defined-ness of variables in your language.*

[Assistant]
(formerly Perl 6)

**Translation of**: Haskell

(as it were...)

In Raku you can name the concept of Nil, but it not considered an object, but rather the *absence* of an object, more of a "bottom" type. The closest analog in real objects is an empty list, but an empty list is considered defined, while Nil.defined always returns false. Nil is what you get if you try to read off the end of a list, and () is just very easy to read off the end of... :-)

If you try to put Nil into a container, you don't end up with a container that has Nil in it. Instead the container reverts to an uninitialized state that is consistent with the declared type. Hence, Raku has the notion of typed undefined values, that are real objects in the sense of "being there", but are generic in the sense of representing type information without being instantiated as a real object. We call these *type objects* since they can stand in for real objects when one reasons about the types of objects. So type objects fit into the type hierarchy just as normal objects do. In physics terms, think of them as "type charge carriers" that are there for bookkeeping between the "real" particles.

All type objects derive from Mu, the most-undefined type
object, and the object most like "null" in many languages. All other object types derive from Mu,
so it is like Object in other languages as well, except Mu also encompasses various objects that are not discrete, such as junctions. So Raku distinguishes Mu from Any, which is the type that functions the most like a discrete, mundane object.

Mostly the user doesn't have to think about it. All object containers behave like "Maybe" types in Haskell terms; they may either hold a valid value or a "nothing" of an appropriate type.
Most containers default to an object of type Any so you don't accidentally send quantum superpositions (junctions) around in your program.

```
my $var;
say $var.WHAT;      # Any()
$var = 42;
say $var.WHAT;      # Int()
say $var.defined;   # True
$var = Nil;
say $var.WHAT;      # Any()
say $var.defined    # False

```

You can declare a variable of type Mu if you wish to propagate superpositional types:

```
my Mu $junction;
say $junction.WHAT;      # Mu()
$junction = 1 | 2 | 3;
say $junction.WHAT;      # Junction()

```

Or you can declare a more restricted type than Any

```
my Str $str;
say $str.WHAT;      # Str()
$str = "I am a string.";
say $str.WHAT;      # Str()
$str = 42;          # (fails)

```

But in the Raku view of reality, it's completely bogus to ask
for a way "to see if an object is equivalent to the null object."
The whole point of such a non-object object is that it doesn't exist,
and can't participate in computations. If you think you mean the
null object in Raku, you really mean some kind of generic object
that is uninstantiated, and hence undefined. One of those is your "null object",
except there are many of them, so you can't just check for equivalence. Use the defined predicate (or match on a subclass of your type that forces recognition of abstraction or definedness).

Raku also has Failure objects that, in addition to being
undefined carriers of type, are also carriers of the *reason*
for the value's undefinedness. We tend view them as lazily thrown
exceptions, at least until you try to use them as defined values,
in which case they're thrown for real.


[User]
Task

Show how to spell out a number in English.

You can use a preexisting implementation or roll your own, but you should support inputs up to at least one million (or the maximum value of your language's default bounded integer type, if that's less).

Support for inputs other than positive integers (like zero, negative integers, and floating-point numbers) is optional.

Related task

* Spelling of ordinal numbers.

[Assistant]
(formerly Perl 6)

Apart from the $m++ this can be viewed as a purely functional program; we use nested gather/take constructs to avoid accumulators.

```
constant @I = <zero one    two    three    four     five    six     seven     eight    nine
               ten  eleven twelve thirteen fourteen fifteen sixteen seventeen eighteen nineteen>;
constant @X = <0    X      twenty thirty   forty    fifty   sixty   seventy   eighty   ninety>;
constant @C = @I X~ ' hundred';
constant @M = (<0 thousand>,
    ((<m b tr quadr quint sext sept oct non>,
    (map { ('', <un duo tre quattuor quin sex septen octo novem>).flat X~ $_ },
    <dec vigint trigint quadragint quinquagint sexagint septuagint octogint nonagint>),
    'cent').flat X~ 'illion')).flat;

sub int-name ($num) {
    if $num.substr(0,1) eq '-' { return "negative {int-name($num.substr(1))}" }
    if $num eq '0' { return @I[0] }
    my $m = 0;
    return join ', ', reverse gather for $num.flip.comb(/\d ** 1..3/) {
        my ($i,$x,$c) = .comb».Int;
        if $i or $x or $c {
            take join ' ', gather {
                if $c { take @C[$c] }
                if $x and $x == 1 { take @I[$i+10] }
                else {
                    if $x { take @X[$x] }
                    if $i { take @I[$i] }
                }
                take @M[$m] // die "WOW! ZILLIONS!\n" if $m;
            }
        }
        $m++;
    }
}

while '' ne (my $n = prompt("Number: ")) {
    say int-name($n);
}

```

Output:

```
Number: 0
zero
Number: 17
seventeen
Number: -1,234,567,890
negative one billion, two hundred thirty four million, five hundred sixty seven thousand, eight hundred ninety
Number: 42 000
forty two thousand
Number: 1001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001
one novemseptuagintillion, one octoseptuagintillion, one septenseptuagintillion, one sexseptuagintillion, one quinseptuagintillion, one quattuorseptuagintillion, one treseptuagintillion, one duoseptuagintillion, one unseptuagintillion, one septuagintillion, one novemsexagintillion, one octosexagintillion, one septensexagintillion, one sexsexagintillion, one quinsexagintillion, one quattuorsexagintillion, one tresexagintillion, one duosexagintillion, one unsexagintillion, one sexagintillion, one novemquinquagintillion, one octoquinquagintillion, one septenquinquagintillion, one sexquinquagintillion, one quinquinquagintillion, one quattuorquinquagintillion, one trequinquagintillion, one duoquinquagintillion, one unquinquagintillion, one quinquagintillion, one novemquadragintillion, one octoquadragintillion, one septenquadragintillion, one sexquadragintillion, one quinquadragintillion, one quattuorquadragintillion, one trequadragintillion, one duoquadragintillion, one unquadragintillion, one quadragintillion, one novemtrigintillion, one octotrigintillion, one septentrigintillion, one sextrigintillion, one quintrigintillion, one quattuortrigintillion, one tretrigintillion, one duotrigintillion, one untrigintillion, one trigintillion, one novemvigintillion, one octovigintillion, one septenvigintillion, one sexvigintillion, one quinvigintillion, one quattuorvigintillion, one trevigintillion, one duovigintillion, one unvigintillion, one vigintillion, one novemdecillion, one octodecillion, one septendecillion, one sexdecillion, one quindecillion, one quattuordecillion, one tredecillion, one duodecillion, one undecillion, one decillion, one nonillion, one octillion, one septillion, one sextillion, one quintillion, one quadrillion, one trillion, one billion, one million, one thousand, one
Number: 198723483017417
one hundred ninety eight trillion, seven hundred twenty three billion, four hundred eighty three million, seventeen thousand, four hundred seventeen
```

Alternately, we could use the Lingua::EN::Numbers module from the Raku ecosystem. It will return similar output for similar inputs as above, but also handles fractions with configurable reduction and denominator, exponential notation, and ordinal notation.

```
use Lingua::EN::Numbers; # Version 2.4.0 or higher

put join "\n", .&cardinal, .&cardinal(:improper) with -7/4;

printf "%-7s : %19s : %s\n", $_, cardinal($_), cardinal($_, :denominator(16)) for 1/16, 2/16 ... 1;

put join "\n", .&cardinal, .&cardinal-year, .&ordinal, .&ordinal-digit with 1999;

.&cardinal.put for 6.022e23, 42000, π;

```

```
negative one and three quarters
negative seven quarters
0.0625  :       one sixteenth : one sixteenth
0.125   :          one eighth : two sixteenths
0.1875  :    three sixteenths : three sixteenths
0.25    :         one quarter : four sixteenths
0.3125  :     five sixteenths : five sixteenths
0.375   :       three eighths : six sixteenths
0.4375  :    seven sixteenths : seven sixteenths
0.5     :            one half : eight sixteenths
0.5625  :     nine sixteenths : nine sixteenths
0.625   :        five eighths : ten sixteenths
0.6875  :   eleven sixteenths : eleven sixteenths
0.75    :      three quarters : twelve sixteenths
0.8125  : thirteen sixteenths : thirteen sixteenths
0.875   :       seven eighths : fourteen sixteenths
0.9375  :  fifteen sixteenths : fifteen sixteenths
1       :                 one : one
one thousand, nine hundred ninety-nine
nineteen ninety-nine
one thousand, nine hundred ninety-ninth
1999th
six point zero two two times ten to the twenty-third
forty-two thousand
three point one four one five nine two six five three five eight nine seven nine
```


[User]
Task

Given a jumbled list of the numbers   **1**   to   **9**   that are definitely   *not*   in
ascending order.

Show the list,   and then ask the player how many digits from the
left to reverse.

Reverse those digits,   then ask again,   until all the digits end up in ascending order.

The score is the count of the reversals needed to attain the ascending order.

Note: Assume the player's input does not need extra validation.

Related tasks

* Sorting algorithms/Pancake sort
* Pancake sorting.
* Topswops

[Assistant]
(formerly Perl 6)

Do-at-least-once loops are fairly rare, but this program wants to have two of them. We use the built-in .pick(\*) method to shuffle the numbers. We use .= to dispatch a mutating method in two spots; the first is just a different way to write ++, while the second of these reverses an array slice in place. The [<] is a reduction operator on less than, so it returns true if the elements of the list are strictly ordered. We also see in the first repeat loop that, although the while condition is not tested till after the loop, the while condition can in fact declare the variable that will be initialized the first time through the loop, which is a neat trick, and not half unreadable once you get used to it.

```
repeat while [<] my @jumbled-list {
    @jumbled-list = (1..9).pick(*)
}

my $turn = 0;
repeat until [<] @jumbled-list {
    my $d = prompt $turn.=succ.fmt('%2d: ') ~
                   @jumbled-list ~
                   " - Flip how many digits? "
        or exit;
    @jumbled-list[^$d] .= reverse;
}

say "    @jumbled-list[]";
say "You won in $turn turns.";

```

Output:

```
 1: 3 5 8 2 7 9 6 1 4 - Flip how many digits ? 6
 2: 9 7 2 8 5 3 6 1 4 - Flip how many digits ? 9
 3: 4 1 6 3 5 8 2 7 9 - Flip how many digits ? 6
 4: 8 5 3 6 1 4 2 7 9 - Flip how many digits ? 8
 5: 7 2 4 1 6 3 5 8 9 - Flip how many digits ? 7
 6: 5 3 6 1 4 2 7 8 9 - Flip how many digits ? 3
 7: 6 3 5 1 4 2 7 8 9 - Flip how many digits ? 6
 8: 2 4 1 5 3 6 7 8 9 - Flip how many digits ? 4
 9: 5 1 4 2 3 6 7 8 9 - Flip how many digits ? 5
10: 3 2 4 1 5 6 7 8 9 - Flip how many digits ? 3
11: 4 2 3 1 5 6 7 8 9 - Flip how many digits ? 4
12: 1 3 2 4 5 6 7 8 9 - Flip how many digits ? 2
13: 3 1 2 4 5 6 7 8 9 - Flip how many digits ? 3
14: 2 1 3 4 5 6 7 8 9 - Flip how many digits ? 2
    1 2 3 4 5 6 7 8 9
You won in 14 turns.
```


[User]
Task

Find and show positive decimal integers divisible by their individual digits,   but not divisible by the product of their digits,

where   **n   <   1,000**

[Assistant]
```
say "{+$_} matching numbers:\n{.batch(10)».fmt('%3d').join: "\n"}" given
   (^1000).grep: -> $n { $n.contains(0) ?? False !! all |($n.comb).map($n %% *), $n % [*] $n.comb };

```

Output:

```
45 matching numbers:
 22  33  44  48  55  66  77  88  99 122
124 126 155 162 168 184 222 244 248 264
288 324 333 336 366 396 412 424 444 448
488 515 555 636 648 666 728 777 784 824
848 864 888 936 999
```


[User]
Task
:   Find numbers in base 10 that are palindromic in bases 2, 4, and 16, where **n < 25,000**

[Assistant]
```
put "{+$_} such numbers:\n", .batch(10)».fmt('%5d').join("\n") given
(^25000).grep: -> $n { all (2,4,16).map: { $n.base($_) eq $n.base($_).flip } }

```

Output:

```
23 such numbers:
    0     1     3     5    15    17    51    85   255   257
  273   771   819  1285  1365  3855  4095  4097  4369 12291
13107 20485 21845
```


[User]
Task

Find positive integers for which the base 16 (hexadecimal) representation does not contain any decimal digits '0'..'9',   where   **n   <   50010**

[Assistant]
> Find numbers in base-16 representation that cannot be written with decimal digits, where n < 500

This is **literally** the exact same task as (the horribly named) Base-16 representation task.

Leaving aside the requirement that it be base 16 (well, base negative 16 according to the task title); assume it really means *hexadecimal*, otherwise all bets are off.

I challenge anyone to demonstrate how, say 46510, can be written in hexadecimal using only decimal digits.

The task as written:

```
put "{+$_} such numbers:\n", .batch(20)».fmt('%3d').join("\n")
    given (1..500).grep( { so any |.map: { .polymod(16 xx *) »>» 9 } } );

```

Output:

```
301 such numbers:
 10  11  12  13  14  15  26  27  28  29  30  31  42  43  44  45  46  47  58  59
 60  61  62  63  74  75  76  77  78  79  90  91  92  93  94  95 106 107 108 109
110 111 122 123 124 125 126 127 138 139 140 141 142 143 154 155 156 157 158 159
160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179
180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199
200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219
220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239
240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 266 267 268 269
270 271 282 283 284 285 286 287 298 299 300 301 302 303 314 315 316 317 318 319
330 331 332 333 334 335 346 347 348 349 350 351 362 363 364 365 366 367 378 379
380 381 382 383 394 395 396 397 398 399 410 411 412 413 414 415 416 417 418 419
420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439
440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459
460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479
480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499
500
```

What the task author *probably* meant.

Find numbers in decimal that when written in hexadecimal are expressed using **only** alphabetic glyphs.

Which is a **tiny** (2 character) change from Base-16 representation. Add some other (possibly useful) functionality.

```
#Filter out such numbers from a range:
put "Filter: {+$_} such numbers:\n", .batch(20)».fmt('%3d').join("\n")
    given (1..500).grep( { so all |.map: { .polymod(16 xx *) »>» 9 } } );

#Generate such numbers directly, up to a threshold:
put "\nGenerate: first {+$_}:\n", .batch(10)».map({ "{$_}({:16($_)})" })».fmt('%9s').join("\n") given
    ((1..^Inf).grep(* % 7).map( { .base(7).trans: [1..6] => ['A'..'F'] } )).grep(!*.contains: 0)[^42];

#Count such numbers directly, up to a threshold
my $upto = 500;
put "\nCount: " ~ [+] flat (map {exp($_, 6)}, 1..($upto.log(16).floor)),
+(exp($upto.log(16).floor, 16) .. $upto).grep( { so all |.map: { .polymod(16 xx *) »>» 9 } });

```

Output:

```
Filter: 42 such numbers:
 10  11  12  13  14  15 170 171 172 173 174 175 186 187 188 189 190 191 202 203
204 205 206 207 218 219 220 221 222 223 234 235 236 237 238 239 250 251 252 253
254 255

Generate: first 42:
    A(10)     B(11)     C(12)     D(13)     E(14)     F(15)   AA(170)   AB(171)   AC(172)   AD(173)
  AE(174)   AF(175)   BA(186)   BB(187)   BC(188)   BD(189)   BE(190)   BF(191)   CA(202)   CB(203)
  CC(204)   CD(205)   CE(206)   CF(207)   DA(218)   DB(219)   DC(220)   DD(221)   DE(222)   DF(223)
  EA(234)   EB(235)   EC(236)   ED(237)   EE(238)   EF(239)   FA(250)   FB(251)   FC(252)   FD(253)
  FE(254)   FF(255)

Count: 42
```


[User]
Definition

For the purposes of this task, a **qualifying number** is a non-negative integer, k, whose last letter is the same as the first letter of k+1 when written in English.

For example, 18 (i.e 'eighteen' in English) is a qualifying number because its last letter 'n' is the same as the first letter of 'nineteen'.

Take the English equivalent of 0 to be 'zero' and not 'nought' or similar words.

For numbers such as 100 or 1000, the equivalent English should be taken as 'one hundred' or 'one thousand' and not 'a hundred' or 'a thousand'.

Task

1. Find and show here the first 50 qualifying numbers.

2. What are the 1,000th and 10,000th qualifying numbers?

3. For the first 1,000 and 10,000 qualifying numbers, show their breakdown by final digit. This can be shown numerically, graphically or both.

If it is difficult for your language to meet all of these requirements, then just do what you reasonably can.

Stretch

4. What are the 100,000th and millionth qualifying numbers?

5. For the first 100,000 and million qualifying numbers, show their breakdown by final digit.

References

* OEIS sequence A363659:Numbers k such that the last letter of k is the same as the first letter of k+1 when written in English.

* GCHQ, The GCHQ Puzzle Book, Penguin, 2016. See Puzzle 31, page 37 (referred to in OEIS link).

* Number names

[Assistant]
**Translation of**: Wren

```
# 20230713 Raku programming solution

###### https://rosettacode.org/wiki/Number_names#Raku

constant @I = <zero one    two    three    four     five    six     seven     eight    nine
               ten  eleven twelve thirteen fourteen fifteen sixteen seventeen eighteen nineteen>;
constant @X = <0    X      twenty thirty   forty    fifty   sixty   seventy   eighty   ninety>;
constant @C = @I X~ ' hundred';
constant @M = (<0 thousand>,
    ((<m b tr quadr quint sext sept oct non>,
    (map { ('', <un duo tre quattuor quin sex septen octo novem>).flat X~ $_ },
    <dec vigint trigint quadragint quinquagint sexagint septuagint octogint nonagint>),
    'cent').flat X~ 'illion')).flat;

sub int-name ($num) {
    if $num.substr(0,1) eq '-' { return "negative {int-name($num.substr(1))}" }
    if $num eq '0' { return @I[0] }
    my $m = 0;
    return join ', ', reverse gather for $num.flip.comb(/\d ** 1..3/) {
        my ($i,$x,$c) = .comb».Int;
        if $i or $x or $c {
            take join ' ', gather {
                if $c { take @C[$c] }
                if $x and $x == 1 { take @I[$i+10] }
                else {
                    if $x { take @X[$x] }
                    if $i { take @I[$i] }
                }
                take @M[$m] // die "WOW! ZILLIONS!\n" if $m;
            }
        }
        $m++;
    }
}
######

my ($i, $c, $limit, $prev, @nums, @lastDigs) = 0, 0, 1000, int-name(0);

while $limit <= 1e4 {
   my $next = int-name $i+1;
   if $prev.substr(*-1) eq $next.substr(0,1) {
      if ($c < 50) { @nums.append: $i };
      @lastDigs[$i % 10] += 1;
      $c++;
      if $c == 50 {
         say "First 50 numbers:";
         say [~] $_>>.fmt('%4s') for @nums.rotor(10);
         say();
      } elsif $c == $limit {
         print "The {$c}th number is $i.\n";
         say "Breakdown by last digit of first {$c}th numbers";
         say 'N Freq';
         for 0..9 -> $d {
            say "$d {@lastDigs[$d].fmt('%4s')} ",
                '█' x (@lastDigs[$d]/@lastDigs.max*72).Int;
         }
         say();
         $limit *= 10
      }
   }
   $prev = $next;
   $i++;
}

```

You may Attempt This Online!