[User]
Task

Find the limit of recursion.

[Assistant]
(formerly Perl 6)
Maximum recursion depth is memory dependent. Values in excess of 1 million are easily achieved.

**Works with**: Rakudo version 2015.12

```
my $x = 0;
recurse;

sub recurse () {
   ++$x;
   say $x if $x %% 1_000_000;
   recurse;
}
```

Output:

When manually terminated memory use was on the order of 4Gb:

```
1000000
2000000
3000000
4000000
5000000
6000000
7000000
8000000
9000000
10000000
^C

```


[User]
Task

Find and show here on this page the minimum number of coins that can make a value of   **988.**

Available coins are:   **1,   2,   5,   10,   20,   50,   100,**   and   **200.**

The coins that would be dispensed are:

```
     four coins of 200
      one coin  of 100
      one coin  of  50
      one coin  of  20
      one coin  of  10
      one coin  of   5
      one coin  of   2
      one coin  of   1

```

[Assistant]
Since unit denominations are possible, don't bother to check to see if an exact pay-out isn't possible.

```
my @denominations = 200, 100, 50, 20, 10, 5, 2, 1;

sub change (Int $n is copy where * >= 0) { gather for @denominations { take $n div $_; $n %= $_ } }

for 988, 1307, 37511, 0 -> $amount {
    say "\n$amount:";
    printf "%d × %d\n", |$_ for $amount.&change Z @denominations;
}

```

Output:

```
988:
4 × 200
1 × 100
1 × 50
1 × 20
1 × 10
1 × 5
1 × 2
1 × 1

1307:
6 × 200
1 × 100
0 × 50
0 × 20
0 × 10
1 × 5
1 × 2
0 × 1

37511:
187 × 200
1 × 100
0 × 50
0 × 20
1 × 10
0 × 5
0 × 2
1 × 1

0:
0 × 200
0 × 100
0 × 50
0 × 20
0 × 10
0 × 5
0 × 2
0 × 1
```


[User]
Task

* Find and show (in decimal) the first six numbers (non-negative integers) that are   palindromes   in   *both*:

:   :   :   * base 2
            * base 3

* Display   **0**   (zero) as the first number found, even though some other definitions ignore it.
* Optionally, show the decimal number found in its binary and ternary form.
* Show all output here.

It's permissible to assume the first two numbers and simply list them.

See also

* Sequence A60792,   numbers that are palindromic in bases 2 and 3 on *The On-Line Encyclopedia of Integer Sequences*.

[Assistant]
(formerly Perl 6)
Instead of searching for numbers that are palindromes in one base then checking the other, generate palindromic trinary numbers directly, then check to see if they are also binary palindromes (with additional simplifying constraints as noted in other entries). Outputs the list in decimal, binary and trinary.

```
constant palindromes = 0, 1, |gather for 1 .. * -> $p {
    my $pal = $p.base(3);
    my $n = :3($pal ~ '1' ~ $pal.flip);
    next if $n %% 2;
    my $b2 = $n.base(2);
    next if $b2.chars %% 2;
    next unless $b2 eq $b2.flip;
    take $n;
}

printf "%d, %s, %s\n", $_, .base(2), .base(3) for palindromes[^6];

```

Output:

```
0, 0, 0
1, 1, 1
6643, 1100111110011, 100010001
1422773, 101011011010110110101, 2200021200022
5415589, 10100101010001010100101, 101012010210101
90396755477, 1010100001100000100010000011000010101, 22122022220102222022122
```


[User]
Task

Find prime   **n**     for   **0 < n < 500**     which are also primes when the (decimal) digits are reversed.

Nearly Emirp Primes, which don't count palindromatic primes like 101.

[Assistant]
```
unit sub MAIN ($limit = 500);
say "{+$_} reversible primes < $limit:\n{$_».fmt("%" ~ $limit.chars ~ "d").batch(10).join("\n")}",
    with ^$limit .grep: { .is-prime and .flip.is-prime }

```

Output:

```
34 reversible primes < 500:
  2   3   5   7  11  13  17  31  37  71
 73  79  97 101 107 113 131 149 151 157
167 179 181 191 199 311 313 337 347 353
359 373 383 389
```


[User]
Task
:   Find prime numbers of the form    n*3*+2,   where 0 < n < 200

[Assistant]
```
# 20210315 Raku programming solution

say ((1…199)»³ »+»2).grep: *.is-prime

```

Output:

```
(3 29 127 24391 91127 250049 274627 328511 357913 571789 1157627 1442899 1860869 2146691 2924209 3581579 5000213 5177719 6751271)

```


[User]
Task

Find and show on this page the least positive integer number **n**, where difference of **n\*n** and **(n-1)\*(n-1)** greater than **1000**.

The result is **501** because **501\*501 - 500\*500 = 251001 - 250000 = 1001 > 1000**.

[Assistant]
```
say first { $_² - ($_-1)² > 1000 }, ^Inf;

```

Output:

```
501
```


[User]
Task

Find squares **n** where **n+1** is prime and **n<1.000**

[Assistant]
Use up to to one thousand (1,000) rather than up to one (1.000) as otherwise it would be a pretty short list...

```
say ({$++²}…^*>Ⅿ).grep: (*+1).is-prime

```

Output:

```
(1 4 16 36 100 196 256 400 576 676)
```

Although, technically, there is absolutely nothing in the task directions specifying that **n** needs to be the square of an *integer*. So, more accurately...

```
put (^Ⅿ).grep(*.is-prime).map(*-1).batch(20)».fmt("%3d").join: "\n"

```

Output:

```
  1   2   4   6  10  12  16  18  22  28  30  36  40  42  46  52  58  60  66  70
 72  78  82  88  96 100 102 106 108 112 126 130 136 138 148 150 156 162 166 172
178 180 190 192 196 198 210 222 226 228 232 238 240 250 256 262 268 270 276 280
282 292 306 310 312 316 330 336 346 348 352 358 366 372 378 382 388 396 400 408
418 420 430 432 438 442 448 456 460 462 466 478 486 490 498 502 508 520 522 540
546 556 562 568 570 576 586 592 598 600 606 612 616 618 630 640 642 646 652 658
660 672 676 682 690 700 708 718 726 732 738 742 750 756 760 768 772 786 796 808
810 820 822 826 828 838 852 856 858 862 876 880 882 886 906 910 918 928 936 940
946 952 966 970 976 982 990 996
```


[User]
Finding the intersection of an infinite ray with a plane in 3D is an important topic in collision detection.

Task

Find the point of intersection for the infinite ray with direction   (0, -1, -1)   passing through position   (0, 0, 10)   with the infinite plane with a normal vector of   (0, 0, 1)   and which passes through [0, 0, 5].

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2016.11

**Translation of**: Python

```
class Line {
    has $.P0; # point
    has $.u⃗;  # ray
}
class Plane {
    has $.V0; # point
    has $.n⃗;  # normal
}

sub infix:<∙> ( @a, @b where +@a == +@b ) { [+] @a «*» @b } # dot product

sub line-plane-intersection ($𝑳, $𝑷) {
    my $cos = $𝑷.n⃗ ∙ $𝑳.u⃗; # cosine between normal & ray
    return 'Vectors are orthogonal; no intersection or line within plane'
      if $cos == 0;
    my $𝑊 = $𝑳.P0 «-» $𝑷.V0;      # difference between P0 and V0
    my $S𝐼 = -($𝑷.n⃗ ∙ $𝑊) / $cos;  # line segment where it intersects the plane
    $𝑊 «+» $S𝐼 «*» $𝑳.u⃗ «+» $𝑷.V0; # point where line intersects the plane
 }

say 'Intersection at point: ', line-plane-intersection(
     Line.new( :P0(0,0,10), :u⃗(0,-1,-1) ),
    Plane.new( :V0(0,0, 5), :n⃗(0, 0, 1) )
  );

```

Output:

```
Intersection at point: (0 -5 5)
```

### With a geometric algebra library

See task geometric algebra

```
use Clifford:ver<6.2.1>;

# We pick a (non-degenerate) projective basis and
# we define the dual and meet operators.
my $I = [∧] my ($i, $j, $k, $l) = @e;
sub prefix:<∗>($M) { $M/$I }
sub infix:<∨>($A, $B) { ∗((∗$B)∧(∗$A)) }

my $direction = -$j - $k;

# Homogeneous coordinates of (X, Y, Z) are (X, Y, Z, 1)
my $point = 10*$k + $l;

# A projective line is a bivector
my $line = $direction ∧ $point;

# A projective plane is a trivector
my $plane = (5*$k + $l) ∧ ($k*-$i∧$j∧$k);

# The intersection is the meet
my $m = $line ∨ $plane;

# Affine coordinates of (X, Y, Z, W) are (X/W, Y/W, Z/W)
say $m/($m·$l) X· ($i, $j, $k);

```

Output:

```
(0 -5 5)
```


[User]
Finding the intersection of two lines that are in the same plane is an important topic in collision detection.[1]

Task

Find the point of intersection of two lines in 2D.

The 1st line passes though    (4,0)    and    (6,10) .

The 2nd line passes though    (0,3)    and    (10,7) .

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2016.11

**Translation of**: zkl

```
sub intersection (Real $ax, Real $ay, Real $bx, Real $by,
                  Real $cx, Real $cy, Real $dx, Real $dy ) {

    sub term:<|AB|> { determinate($ax, $ay, $bx, $by) }
    sub term:<|CD|> { determinate($cx, $cy, $dx, $dy) }

    my $ΔxAB = $ax - $bx;
    my $ΔyAB = $ay - $by;
    my $ΔxCD = $cx - $dx;
    my $ΔyCD = $cy - $dy;

    my $x-numerator = determinate( |AB|, $ΔxAB, |CD|, $ΔxCD );
    my $y-numerator = determinate( |AB|, $ΔyAB, |CD|, $ΔyCD );
    my $denominator = determinate( $ΔxAB, $ΔyAB, $ΔxCD, $ΔyCD );

    return 'Lines are parallel' if $denominator == 0;

    ($x-numerator/$denominator, $y-numerator/$denominator);
}

sub determinate ( Real $a, Real $b, Real $c, Real $d ) { $a * $d - $b * $c }

# TESTING
say 'Intersection point: ', intersection( 4,0, 6,10, 0,3, 10,7 );
say 'Intersection point: ', intersection( 4,0, 6,10, 0,3, 10,7.1 );
say 'Intersection point: ', intersection( 0,0, 1,1, 1,2, 4,5 );

```

Output:

```
Intersection point: (5 5)
Intersection point: (5.010893 5.054466)
Intersection point: Lines are parallel

```

### Using a geometric algebra library

See task geometric algebra.

```
use Clifford;

# We pick a projective basis,
# and we compute its pseudo-scalar and its square.
my ($i, $j, $k) = @e;
my $I = $i∧$j∧$k;
my $I2 = ($I**2).narrow;

# Homogeneous coordinates of point (X,Y) are (X,Y,1)
my $A =  4*$i +  0*$j + $k;
my $B =  6*$i + 10*$j + $k;
my $C =  0*$i +  3*$j + $k;
my $D = 10*$i +  7*$j + $k;

# We form lines by joining points
my $AB = $A∧$B;
my $CD = $C∧$D;

# The intersection is their meet, which we
# compute by using the De Morgan law
my $ab = $AB*$I/$I2;
my $cd = $CD*$I/$I2;
my $M = ($ab ∧ $cd)*$I/$I2;

# Affine coordinates are (X/Z, Y/Z)
say $M/($M·$k) X· $i, $j;

```

Output:

```
(5 5)
```


[User]
Write a program or a script that returns the last Sundays of each month of a given year. The year may be given through any simple input method in your language (command line, std in, etc).

Example of an expected output:

```
./last_sundays 2013
2013-01-27
2013-02-24
2013-03-31
2013-04-28
2013-05-26
2013-06-30
2013-07-28
2013-08-25
2013-09-29
2013-10-27
2013-11-24
2013-12-29
```

Related tasks

* Day of the week
* Five weekends
* Last Friday of each month

[Assistant]
(formerly Perl 6)

**Works with**: rakudo version 2018.03

```
sub MAIN ($year = Date.today.year) {
    for 1..12 -> $month {
        my $month-end = Date.new($year, $month, Date.new($year,$month,1).days-in-month);
        say $month-end - $month-end.day-of-week % 7;
    }
}

```

Output  —  for input `2018`:

```
2018-01-28
2018-02-25
2018-03-25
2018-04-29
2018-05-27
2018-06-24
2018-07-29
2018-08-26
2018-09-30
2018-10-28
2018-11-25
2018-12-30
```


[User]
```
                    ABCD
                    CABD
                    ACDB
                    DACB
                    BCDA
                    ACBD
                    ADCB
                    CDAB
                    DABC
                    BCAD
                    CADB
                    CDBA
                    CBAD
                    ABDC
                    ADBC
                    BDCA
                    DCBA
                    BACD
                    BADC
                    BDAC
                    CBDA
                    DBCA
                    DCAB

```

Listed above are   all-but-one   of the permutations of the symbols   **A**,   **B**,   **C**,   and   **D**,   *except*   for one permutation that's   *not*   listed.

Task

Find that missing permutation.

Methods

* Obvious method:

```
        enumerate all permutations of   A,  B,  C,  and  D,
        and then look for the missing permutation.

```

* alternate method:

```
        Hint:  if all permutations were shown above,  how many
        times would  A  appear in each position?
        What is the  parity  of this number?

```

* another alternate method:

```
        Hint:  if you add up the letter values of each column,
        does a missing letter   A,  B,  C,  and  D   from each
        column cause the total value for each column to be unique?

```

Related task

* Permutations)

[Assistant]
(formerly Perl 6)

```
my @givens = <ABCD CABD ACDB DACB BCDA ACBD ADCB CDAB DABC BCAD CADB CDBA
                CBAD ABDC ADBC BDCA DCBA BACD BADC BDAC CBDA DBCA DCAB>;

my @perms = <A B C D>.permutations.map: *.join;

.say when none(@givens) for @perms;

```

Output:

```
DBAC
```

Of course, all of these solutions are working way too hard,
when you can just xor all the bits,
and the missing one will just pop right out:

```
say [~^] <ABCD CABD ACDB DACB BCDA ACBD ADCB CDAB DABC BCAD CADB CDBA
          CBAD ABDC ADBC BDCA DCBA BACD BADC BDAC CBDA DBCA DCAB>;

```

Output:

```
DBAC
```


[User]
Task

Write a function to search plain text for URIs or IRIs.

The function should return a list of URIs or IRIs found in the text.

The definition of a URI is given in RFC 3986.
IRI is defined in RFC 3987.

For searching URIs in particular "Appendix C. Delimiting a URI in Context" is noteworthy.

The abbreviation IRI isn't as well known as URI and the short description is that an IRI is just an alternate form of a URI that supports Internationalization and hence Unicode. While many specifications support both forms this isn't universal.

Consider the following issues:

:   * `. , ; ' ? ( )`    are legal characters in a URI, but they are often used in plain text as a delimiter.
    * IRIs allow most (but not all) unicode characters.
    * URIs can be something else besides http:// or https://

Sample text

```
     this URI contains an illegal character, parentheses and a misplaced full stop:
     http://en.wikipedia.org/wiki/Erich_Kästner_(camera_designer). (which is handled by http://mediawiki.org/).
     and another one just to confuse the parser: http://en.wikipedia.org/wiki/-)
     ")" is handled the wrong way by the mediawiki parser.
     ftp://domain.name/path(balanced_brackets)/foo.html
     ftp://domain.name/path(balanced_brackets)/ending.in.dot.
     ftp://domain.name/path(unbalanced_brackets/ending.in.dot.
     leading junk ftp://domain.name/path/embedded?punct/uation.
     leading junk ftp://domain.name/dangling_close_paren)
     if you have other interesting URIs for testing, please add them here:

```

Regular expressions to solve the task are fine, but alternative approaches are welcome too. (otherwise, this task would degrade into 'finding and applying the best regular expression')

**Extra Credit:**   implement the parser to match the IRI specification in RFC 3987.

[Assistant]
(formerly Perl 6)

This needs an installed URI distribution.

**Works with**: Rakudo version 2018.03

```
use v6;
use IETF::RFC_Grammar::URI;

say q:to/EOF/.match(/ <IETF::RFC_Grammar::URI::absolute-URI> /, :g).list.join("\n");
    this URI contains an illegal character, parentheses and a misplaced full stop:
    http://en.wikipedia.org/wiki/Erich_Kästner_(camera_designer). (which is handled by http://mediawiki.org/).
    and another one just to confuse the parser: http://en.wikipedia.org/wiki/-)
    ")" is handled the wrong way by the mediawiki parser.
    ftp://domain.name/path(balanced_brackets)/foo.html
    ftp://domain.name/path(balanced_brackets)/ending.in.dot.
    ftp://domain.name/path(unbalanced_brackets/ending.in.dot.
    leading junk ftp://domain.name/path/embedded?punct/uation.
    leading junk ftp://domain.name/dangling_close_paren)
    EOF

say $/[*-1];
say "We matched $/[*-1], which is a $/[*-1].^name() at position $/[*-1].from() to $/[*-1].to()"

```

Like most of the solutions here it does not comply to IRI but only to URI:

```
stop:
http://en.wikipedia.org/wiki/Erich_K
http://mediawiki.org/).
parser:
http://en.wikipedia.org/wiki/-)
ftp://domain.name/path(balanced_brackets)/foo.html
ftp://domain.name/path(balanced_brackets)/ending.in.dot.
ftp://domain.name/path(unbalanced_brackets/ending.in.dot.
ftp://domain.name/path/embedded
ftp://domain.name/dangling_close_paren)
｢ftp://domain.name/dangling_close_paren)｣
 IETF::RFC_Grammar::URI::absolute_URI => ｢ftp://domain.name/dangling_close_paren)｣
  scheme => ｢ftp｣
We matched ftp://domain.name/dangling_close_paren), which is a Match, at position 554 to 593
```

The last lines show that we get Match objects back that we can query to get all kinds of information.
We even get the information what subrules matched, and since these are also Match objects we can obtain
their match position in the text.


[User]
Task

Use the dictionary  unixdict.txt

Find the words which contains all the vowels,   but each vowel should appear only once in a word.

The length of any word shown should have a length   **>  10****.**

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]
Yet another "Filter a word list" task.

```
put +.words, " words found:\n", $_ with 'unixdict.txt'.IO.words\
  .grep({ .chars > 10 and all(.comb.Bag<a e i o u>) == 1 })\
  .batch(5)».fmt('%-13s').join: "\n";

```

Output:

```
25 words found:
ambidextrous  bimolecular   cauliflower   communicable  communicate
consanguine   consultative  countervail   exclusionary  grandiloquent
importunate   incommutable  incomputable  insupportable loudspeaking
malnourished  mensuration   oneupmanship  pandemonium   permutation
perturbation  portraiture   praseodymium  stupefaction  sulfonamide
```


[User]
Task

Use the dictionary  unixdict.txt

Find the words which contains most consonants,   but each consonant should appear only once in a word.

The length of any word shown should have a length   **>  10****.**

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]
Hmm. Depends on how you define "most".

```
unit sub MAIN ($min = 11);
my @vowel = <a e i o u>;
my $vowel = rx/ @vowel /;
my @consonant = ('a'..'z').grep: { $_ ∉ @vowel };
my $consonant = rx/ @consonant /;

say "Minimum characters in a word: $min";

say "Number found, consonant count and list of words with the largest absolute number of unique, unrepeated consonants:";
say +.value, ' @ ', $_ for 'unixdict.txt'.IO.words.grep( {.chars >= $min and so all(.comb.Bag{@consonant}) <= 1} )
    .classify( { +.comb(/$consonant/) } ).sort(-*.key).head(2);

say "\nNumber found, ratio and list of words with the highest ratio of unique, unrepeated consonants to vowels:";
say +.value, ' @ ', $_  for 'unixdict.txt'.IO.slurp.words.grep( {.chars >= $min and so all(.comb.Bag{@consonant}) <= 1} )
    .classify( { +.comb(/$vowel/) ?? (+.comb(/$consonant/) / +.comb(/$vowel/) ) !! Inf } ).sort(-*.key).head(3);

```

Output:

```
Minimum characters in a word: 11
Number found, consonant count and list of words with the largest absolute number of unique, unrepeated consonants:
1 @ 9 => [comprehensible]
39 @ 8 => [administrable anthropology blameworthy bluestocking boustrophedon bricklaying chemisorption christendom claustrophobia compensatory comprehensive counterexample demonstrable disciplinary discriminable geochemistry hypertensive indecipherable indecomposable indiscoverable lexicography manslaughter misanthropic mockingbird monkeyflower neuropathology paralinguistic pharmacology pitchblende playwriting shipbuilding shortcoming springfield stenography stockholder switchblade switchboard switzerland thunderclap]

Number found, ratio and list of words with the highest ratio of unique, unrepeated consonants to vowels:
14 @ 2.666667 => [blameworthy bricklaying christendom mockingbird pitchblende playwriting shortcoming springfield stenography stockholder switchblade switchboard switzerland thunderclap]
13 @ 2 => [anthropology bluestocking compensatory demonstrable disciplinary geochemistry hypertensive lexicography manslaughter misanthropic monkeyflower pharmacology shipbuilding]
1 @ 1.8 => [comprehensible]
```

Character count of 11 minimum is rather arbitrary. If we feed it a character count minimum of 5, the first one returns a pretty similar answer, 8 additional words at 8 consonants (all with 10 characters.)

The second would actually come up with some infinite ratios (since we somewhat bogusly don't count 'y' as a vowel.):

```
Minimum characters in a word: 5
Number found, consonant count and list of words with the largest absolute number of unique, unrepeated consonants:
1 @ 9 => [comprehensible]
47 @ 8 => [administrable anthropology bankruptcy blacksmith blameworthy bluestocking boustrophedon bricklaying chemisorption christendom claustrophobia compensatory comprehensive counterexample crankshaft demonstrable disciplinary discriminable geochemistry hypertensive indecipherable indecomposable indiscoverable lexicography lynchburg manslaughter misanthropic mockingbird monkeyflower neuropathology paralinguistic pharmacology pitchblende playwright playwriting shipbuilding shortcoming sprightly springfield stenography stockholder strickland stronghold switchblade switchboard switzerland thunderclap]

Number found, ratio and list of words with the highest ratio of unique, unrepeated consonants to vowels:
6 @ Inf => [crypt glyph lymph lynch nymph psych]
2 @ 8 => [lynchburg sprightly]
5 @ 7 => [klystron mcknight schwartz skylight splotchy]
```


[User]
Task

Use the dictionary   unixdict.txt

Find words which contains more than three   **e**   vowels   *and*   contains only   **e**   vowels.

Show the output here on this page.

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]
Hardly even worth saving as a script file; an easily entered one-liner.

```
.say for "unixdict.txt".IO.lines.grep: { !/<[aiou]>/ and /e.*e.*e.*e/ };

```

Output:

```
belvedere
dereference
elsewhere
erlenmeyer
evergreen
everywhere
exegete
freewheel
nevertheless
persevere
preference
referee
seventeen
seventeenth
telemeter
tennessee

```

In an attempt to be a little less useless, here's an alternate script that allows you to specify a vowel, the minimum count to search for, and the file to search. Counts base vowels case, and combining accent insensitive; works with *any* text file, not just word lists. Defaults to finding words with at least 4 'e's in unixdict.txt. Default output is same as above.

```
unit sub MAIN ($vowel = 'e', $min = 4, $file = 'unixdict.txt');
.say for squish sort
  ( $file.IO.slurp.words.grep: { ((my $b = .lc.samemark(' ').comb.Bag){$vowel} >= $min) && $b<a e i o u>.sum == $b{$vowel} } )\
  ».subst(/<[":;,.?!_\[\]]>/, '', :g);

```

How about: find words with at least 4 'a's in the Les Misérables file used for the Word frequency task?

Command line `> raku monovowel a 4 lemiz.txt`

Output:

```
Caracalla
Caracara
Salamanca
Vâsaphantâ
```


[User]
Task

Using the dictionary  unixdict.txt

find the words whose first and last three letters are equal.

The length of any word shown should have a length   **>  5****.**

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]
```
# 20210210 Raku programming solution

my ( \L, \N, \IN ) = 5, 3, 'unixdict.txt';

for IN.IO.lines { .say if .chars > L and .substr(0,N) eq .substr(*-N,*) }

```

Output:

```
antiperspirant
calendrical
einstein
hotshot
murmur
oshkosh
tartar
testes

```


[User]
Task

Using the dictionary   unixdict.txt,   find words which odd letters are consonants and even letters are vowels or vice versa.

Display the words here (on this page).

The length of any word shown should have a length   **> 9****.**

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]
Sigh. Yet another "Filter a word list" task. In a effort to make it a *little* more interesting, rather than just doing a one-liner, build a grammar and use that to filter.

```
grammar VOWCON {
    token       TOP { <|w> <vowel>? ( <consonant> <vowel> )* <consonant>? <|w> }
    token     vowel { <[aeiou]> }
    token consonant { <[a..z] - [aeiou]> }
}

say ( grep { VOWCON.parse: .lc }, grep { .chars > 9 }, 'unixdict.txt'.IO.words ).batch(6)».fmt('%-15s').join: "\n";

```

Output:

```
aboriginal      apologetic      bimolecular     borosilicate    calorimeter     capacitate
capacitive      capitoline      capitulate      caricature      colatitude      coloratura
colorimeter     debilitate      decelerate      decolonize      definitive      degenerate
deliberate      demodulate      denominate      denotative      deregulate      desiderata
desideratum     dilapidate      diminutive      epigenetic      facilitate      hemosiderin
heretofore      hexadecimal     homogenate      inoperative     judicature      latitudinal
legitimate      lepidolite      literature      locomotive      manipulate      metabolite
nicotinamide    oratorical      paragonite      pejorative      peridotite      peripatetic
polarimeter     recitative      recuperate      rehabilitate    rejuvenate      remunerate
repetitive      reticulate      savonarola      similitude      solicitude      tananarive
telekinesis     teratogenic     topologize      unilateral      unimodular      uninominal
verisimilitude
```


[User]
A Finite state machine (FSM) is computational abstraction which maps a finite number of states to other states within the same set, via transitions. An FSM can only be in one state at any given moment. Transitions can either be explicit or implicit; explicit transitions are triggered by an input signal and implicit transitions by the internal state of the system (that is, the current state). Implicit transitions thus represent "automatic" or sequenced states that are generally processed between explicit transitions (although they can also be used to provide an optional path when no valid transition exists for a given input signal).

Example

Consider the model of a simple vending machine. The machine is initially in the "ready" state, which maps to exactly two states in the following way:

:   ready -> **deposit** -> waiting

:   ready -> **quit** -> exit

The variables in bold-face represent transitions. Any input signal not corresponding to one of those transitions can either trigger an error or be ignored. Otherwise, the current state is updated and the process is repeated. If, for example, a **deposit** input signal is encountered, the FSM will move to the "waiting" state, which defines these transitions:

:   waiting -> **select** -> dispense

:   waiting -> **refund** -> refunding

The "dispense" state defines only one transition:

:   dispense -> **remove** -> ready

Note, however, that in this example the "refunding" state doesn't actually require input in order to move to the "ready" state, so an implicit transition is defined as such:

:   refunding -> ready

Task

Implement a finite state machine which handles both explicit and implicit transitions. Then demonstrate an example which models some real-world process.

See also

* Computers Without Memory (Finite State Automata), A Computerphile Video.

[Assistant]
(formerly Perl 6)

```
#===== The state machine =====#

class StateMachine {
    class State {...}
    class Transition {...}

    has State %!state;
    has &.choose-transition is rw;

    method add-state(Str $id, &action)
    {
        %!state{$id} = State.new(:$id, :&action);
    }

    multi method add-transition(Str $from, Str $to)
    {
        %!state{$from}.implicit-next = %!state{$to};
    }

    multi method add-transition(Str $from, $id, Str $to)
    {
        %!state{$from}.explicit-next.push: Transition.new(:$id, to => %!state{$to});
    }

    method run(Str $initial-state)
    {
        my $state = %!state{$initial-state};

        loop {
            $state.action.();
            if $state.implicit-next -> $_ { $state = $_; }
            elsif $state.explicit-next -> $_ { $state = &.choose-transition.(|$_).to; }
            else { last; }
        }
    }

    class Transition {
        has $.id;
        has State $.to;
    }
    class State {
        has $.id;
        has &.action;
        has State $.implicit-next is rw;
        has Transition @.explicit-next;
    }
}

#===== Usage example: Console-based vending machine =====#

my StateMachine $machine .= new;

$machine.choose-transition = sub (*@transitions) {
    say "[{.key + 1}] {.value.id}" for @transitions.pairs;
    loop {
        my $n = val get;
        return @transitions[$n - 1] if $n ~~ Int && $n ~~ 1..@transitions;
        say "Invalid input; try again.";
    }
}

$machine.add-state("ready",     { say "Please deposit coins.";                     });
$machine.add-state("waiting",   { say "Please select a product.";                  });
$machine.add-state("dispense",  { sleep 2; say "Please remove product from tray."; });
$machine.add-state("refunding", { sleep 1; say "Refunding money...";               });
$machine.add-state("exit",      { say "Shutting down...";                          });

$machine.add-transition("ready",     "quit",    "exit");
$machine.add-transition("ready",     "deposit", "waiting");
$machine.add-transition("waiting",   "select",  "dispense");
$machine.add-transition("waiting",   "refund",  "refunding");
$machine.add-transition("dispense",  "remove",  "ready");
$machine.add-transition("refunding",            "ready");

$machine.run("ready");

```


[User]
Task

Show on this page the first 9 prime Fibonacci numbers.

[Assistant]
```
put ++$ .fmt("%2d: ") ~ $_ for (0, 1, * + * … *).grep( &is-prime )[^20];

```

Output:

```
 1: 2
 2: 3
 3: 5
 4: 13
 5: 89
 6: 233
 7: 1597
 8: 28657
 9: 514229
10: 433494437
11: 2971215073
12: 99194853094755497
13: 1066340417491710595814572169
14: 19134702400093278081449423917
15: 475420437734698220747368027166749382927701417016557193662268716376935476241
16: 529892711006095621792039556787784670197112759029534506620905162834769955134424689676262369
17: 1387277127804783827114186103186246392258450358171783690079918032136025225954602593712568353
18: 3061719992484545030554313848083717208111285432353738497131674799321571238149015933442805665949
19: 10597999265301490732599643671505003412515860435409421932560009680142974347195483140293254396195769876129909
20: 36684474316080978061473613646275630451100586901195229815270242868417768061193560857904335017879540515228143777781065869
```


[User]
According to Wikipedia, "In computing, a first-class object ... is an entity that can be constructed at run-time, passed as a parameter, returned from a subroutine, or assigned into a variable".

Often this term is used in the context of "first class functions". In an analogous way, a programming language may support "first class environments".

The environment is minimally, the set of variables accessible to a statement being executed. Change the environments and the same statement could produce different results when executed.

Often an environment is captured in a closure, which encapsulates a function together with an environment. That environment, however, is **not** first-class, as it cannot be created, passed etc. independently from the function's code.

Therefore, a first class environment is a set of variable bindings which can be constructed at run-time, passed as a parameter, returned from a subroutine, or assigned into a variable. It is like a closure without code. A statement must be able to be executed within a stored first class environment and act according to the environment variable values stored within.

Task

Build a dozen environments, and a single piece of code to be run repeatedly in each of these environments.

Each environment contains the bindings for two variables:

:   * a value in the Hailstone sequence, and
    * a count which is incremented until the value drops to 1.

The initial hailstone values are 1 through 12, and the count in each environment is zero.

When the code runs, it calculates the next hailstone step in the current environment (unless the value is already 1) and counts the steps. Then it prints the current value in a tabular form.

When all hailstone values dropped to 1, processing stops, and the total number of hailstone steps for each environment is printed.

[Assistant]
(formerly Perl 6)

Set up an array of hashes containing the current values and iteration counts then pass each hash in turn with a code reference to a routine to calculate the next iteration.

```
my $calculator = sub ($n is rw) {
    $n == 1 ?? 1 !! $n %% 2 ?? $n div 2 !! $n * 3 + 1
}

sub next (%this, &get_next) {
    return %this if %this.<value> == 1;
    %this.<value> .= &get_next;
    %this.<count>++;
    %this;
}

my @hailstones = map { %(value => $_, count => 0) }, 1 .. 12;

while not all( map { $_.<value> }, @hailstones ) == 1 {
    say [~] map { $_.<value>.fmt: '%4s' }, @hailstones;
    @hailstones[$_] .= &next($calculator) for ^@hailstones;
}

say "\nCounts\n" ~ [~] map { $_.<count>.fmt: '%4s' }, @hailstones;

```

Output:

```
   1   2   3   4   5   6   7   8   9  10  11  12
   1   1  10   2  16   3  22   4  28   5  34   6
   1   1   5   1   8  10  11   2  14  16  17   3
   1   1  16   1   4   5  34   1   7   8  52  10
   1   1   8   1   2  16  17   1  22   4  26   5
   1   1   4   1   1   8  52   1  11   2  13  16
   1   1   2   1   1   4  26   1  34   1  40   8
   1   1   1   1   1   2  13   1  17   1  20   4
   1   1   1   1   1   1  40   1  52   1  10   2
   1   1   1   1   1   1  20   1  26   1   5   1
   1   1   1   1   1   1  10   1  13   1  16   1
   1   1   1   1   1   1   5   1  40   1   8   1
   1   1   1   1   1   1  16   1  20   1   4   1
   1   1   1   1   1   1   8   1  10   1   2   1
   1   1   1   1   1   1   4   1   5   1   1   1
   1   1   1   1   1   1   2   1  16   1   1   1
   1   1   1   1   1   1   1   1   8   1   1   1
   1   1   1   1   1   1   1   1   4   1   1   1
   1   1   1   1   1   1   1   1   2   1   1   1
Counts
   0   1   7   2   5   8  16   3  19   6  14   9
```


[User]
Find the first perfect square in a given base **N** that has at least **N** digits and
exactly **N** *significant unique* digits when expressed in base **N**.

E.G. In base **10**, the first perfect square with at least **10** unique digits is **1026753849** (**32043²**).

You may use analytical methods to reduce the search space, but the code must do a search. Do not use magic numbers or just feed the code the answer to verify it is correct.

Task

* Find and display here, on this page, the first perfect square in base **N**, with **N** significant unique digits when expressed in base **N**, for each of base **2** through **12**. Display each number in the base **N** for which it was calculated.

* (optional) Do the same for bases **13** through **16**.

* (stretch goal) Continue on for bases **17** - **??** (Big Integer math)

See also

* OEIS A260182: smallest square that is pandigital in base n.

Related task

* Casting out nines

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2019.03

As long as you have the patience, this will work for bases 2 through 36.

Bases 2 through 19 finish quickly, (about 10 seconds on my system), 20 takes a while, 21 is pretty fast, 22 is glacial. 23 through 26 takes several hours.

Use analytical start value filtering based on observations by Hout++
and Nigel Galloway++ on the
discussion page.

Try it online!

```
#`[

Only search square numbers that have at least N digits;
smaller could not possibly match.

Only bother to use analytics for large N. Finesse takes longer than brute force for small N.

]

unit sub MAIN ($timer = False);

sub first-square (Int $n) {
    my @start = flat '1', '0', (2 ..^ $n)».base: $n;

    if $n > 10 { # analytics
        my $root  = digital-root( @start.join, :base($n) );
        my @roots = (2..$n).map(*²).map: { digital-root($_.base($n), :base($n) ) };
        if $root ∉ @roots {
            my $offset = min(@roots.grep: * > $root ) - $root;
            @start[1+$offset] = $offset ~ @start[1+$offset];
        }
    }

    my $start = @start.join.parse-base($n).sqrt.ceiling;
    my @digits = reverse (^$n)».base: $n;
    my $sq;
    my $now  = now;
    my $time = 0;
    my $sr;
    for $start .. * {
        $sq = .²;
        my $s = $sq.base($n);
        my $f;
        $f = 1 and last unless $s.contains: $_ for @digits;
        if $timer && $n > 19 && $_ %% 1_000_000 {
            $time += now - $now;
            say "N $n:  {$_}² = $sq <$s> : {(now - $now).round(.001)}s" ~
                " : {$time.round(.001)} elapsed";
            $now = now;
        }
        next if $f;
        $sr = $_;
        last
    }
    sprintf( "Base %2d: %13s² == %-30s", $n, $sr.base($n), $sq.base($n) ) ~
        ($timer ?? ($time + now - $now).round(.001) !! '');
}

sub digital-root ($root is copy, :$base = 10) {
    $root = $root.comb.map({:36($_)}).sum.base($base) while $root.chars > 1;
    $root.parse-base($base);
}

say  "First perfect square with N unique digits in base N: ";
say .&first-square for flat
   2 .. 12, # required
  13 .. 16, # optional
  17 .. 19, # stretch
  20, # slow
  21, # pretty fast
  22, # very slow
  23, # don't hold your breath
  24, # slow but not too terrible
  25, # very slow
  26, #   "
;

```

Output:

```
First perfect square with N unique digits in base N:
Base  2:            10² == 100
Base  3:            22² == 2101
Base  4:            33² == 3201
Base  5:           243² == 132304
Base  6:           523² == 452013
Base  7:          1431² == 2450361
Base  8:          3344² == 13675420
Base  9:         11642² == 136802574
Base 10:         32043² == 1026753849
Base 11:        111453² == 1240A536789
Base 12:        3966B9² == 124A7B538609
Base 13:       3828943² == 10254773CA86B9
Base 14:       3A9DB7C² == 10269B8C57D3A4
Base 15:      1012B857² == 102597BACE836D4
Base 16:      404A9D9B² == 1025648CFEA37BD9
Base 17:     423F82GA9² == 101246A89CGFB357ED
Base 18:     44B482CAD² == 10236B5F8EG4AD9CH7
Base 19:    1011B55E9A² == 10234DHBG7CI8F6A9E5
Base 20:    49DGIH5D3G² == 1024E7CDI3HB695FJA8G
Base 21:   4C9HE5FE27F² == 1023457DG9HI8J6B6KCEAF
Base 22:   4F94788GJ0F² == 102369FBGDEJ48CHI7LKA5
Base 23:  1011D3EL56MC² == 10234ACEDKG9HM8FBJIL756
Base 24:  4LJ0HDGF0HD3² == 102345B87HFECKJNIGMDLA69
Base 25: 1011E145FHGHM² == 102345DOECKJ6GFB8LIAM7NH9
Base 26: 52K8N53BDM99K² == 1023458LO6IEMKG79FPCHNJDBA
```


[User]
(This task is taken from a   *Project Euler*   problem.)

(All numbers herein are expressed in base ten.)

**27   =   128**   and   **7**   is
the first power of   **2**   whose leading decimal digits are   **12**.

The next power of   **2**   whose leading decimal digits
are   **12**   is   **80**,

**280   =   1208925819614629174706176**.

Define      ***p*(*L,n*)**      to be the  ***n*th**-smallest
value of    ***j***    such that the base ten representation
of    **2*j***    begins with the digits of    ***L*** .

```
    So   p(12, 1) =  7    and
         p(12, 2) = 80

```

You are also given that:

```
         p(123, 45)   =   12710

```

Task
:   :   * find:

        :   :   :   * ***p*(12, 1)**
                    * ***p*(12, 2)**
                    * ***p*(123, 45)**
                    * ***p*(123, 12345)**
                    * ***p*(123, 678910)**

        * display the results here, on this page.

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2019.11

Uses logs similar to Go and Pascal entries. Takes advantage of patterns in the powers to cut out a bunch of calculations.

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

constant $ln2ln10 = log(2) / log(10);

my @startswith12  = ^∞ .grep: { ( 10 ** ($_ * $ln2ln10 % 1) ).substr(0,3) eq '1.2' };

my @startswith123 = lazy gather loop {
    state $pre   = '1.23';
    state $count = 0;
    state $this  = 0;
    given $this {
        when 196 {
            $this = 289;
            my \n = $count + $this;
            $this = 485 unless ( 10 ** (n * $ln2ln10 % 1) ).substr(0,4) eq $pre;
        }
        when 485 {
            $this = 196;
            my \n = $count + $this;
            $this = 485 unless ( 10 ** (n * $ln2ln10 % 1) ).substr(0,4) eq $pre;
        }
        when 289 { $this = 196 }
        when 90  { $this = 289 }
        when 0   { $this = 90  }
    }
    take $count += $this;
}

multi p ($prefix where *.chars == 2, $nth) {  @startswith12[$nth-1] }
multi p ($prefix where *.chars == 3, $nth) { @startswith123[$nth-1] }

# The Task
for < 12 1  12 2  123 45  123 12345  123 678910 > -> $prefix, $nth {
    printf "%-15s %9s power of two (2^n) that starts with %5s is at n = %s\n", "p($prefix, $nth):",
        comma($nth) ~ ordinal-digit($nth).substr(*-2), "'$prefix'", comma p($prefix, $nth);
}

```

Output:

```
p(12, 1):             1st power of two (2^n) that starts with  '12' is at n = 7
p(12, 2):             2nd power of two (2^n) that starts with  '12' is at n = 80
p(123, 45):          45th power of two (2^n) that starts with '123' is at n = 12,710
p(123, 12345):   12,345th power of two (2^n) that starts with '123' is at n = 3,510,491
p(123, 678910): 678,910th power of two (2^n) that starts with '123' is at n = 193,060,223
```


[User]
A language has first-class functions if it can do each of the following without recursively invoking a compiler or interpreter or otherwise metaprogramming:

* Create new functions from preexisting functions at run-time
* Store functions in collections
* Use functions as arguments to other functions
* Use functions as return values of other functions

Task

Write a program to create an ordered collection *A* of functions of a real number. At least one function should be built-in and at least one should be user-defined; try using the sine, cosine, and cubing functions. Fill another collection *B* with the inverse of each function in *A*. Implement function composition as in Functional Composition. Finally, demonstrate that the result of applying the composition of each function in *A* and its inverse in *B* to a value, is the original value. (Within the limits of computational accuracy).

(A solution need not actually call the collections "A" and "B". These names are only used in the preceding paragraph for clarity.)

Related task

First-class Numbers

[Assistant]
(formerly Perl 6)
Here we use the Z ("zipwith") metaoperator to zip the 𝐴 and 𝐵 lists with builtin composition operator, ∘ (or just o). The .() construct invokes the function contained in the $\_ (current topic) variable.

```
my \𝐴 = &sin,  &cos,  { $_ ** <3/1> }
my \𝐵 = &asin, &acos, { $_ ** <1/3> }

say .(.5) for 𝐴 Z∘ 𝐵

```

Output:

```
0.5
0.4999999999999999
0.5000000000000001

```

It is not clear why we don't get exactly 0.5, here.

Operators, both builtin and user-defined, are first class too.

```
my @a = 1,2,3;
my @op = &infix:<+>, &infix:<->, &infix:<*>;
for flat @a Z @op -> $v, &op { say 42.&op($v) }

```

Output:

```
43
40
126
```


[User]
In First-class functions, a language is showing how its manipulation of functions is similar to its manipulation of other types.

This tasks aim is to compare and contrast a language's implementation of first class functions, with its normal handling of numbers.

Write a program to create an ordered collection of a mixture of literally typed and expressions producing a real number, together with another ordered collection of their multiplicative inverses. Try and use the following pseudo-code to generate the numbers for the ordered collections:

```
  x  = 2.0
  xi = 0.5
  y  = 4.0
  yi = 0.25
  z  = x + y
  zi = 1.0 / ( x + y )

```

Create a function *multiplier*, that given two numbers as arguments returns a function that when called with one argument, returns the result of multiplying the two arguments to the call to multiplier that created it and the argument in the call:

```
 new_function = multiplier(n1,n2)
 # where new_function(m) returns the result of n1 * n2 * m

```

Applying the multiplier of a number and its inverse from the two ordered collections of numbers in pairs, show that the result in each case is one.
**Compare and contrast the resultant program with the corresponding entry in First-class functions.** They should be close.

To paraphrase the task description: Do what was done before, but with numbers rather than functions

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2015-09-10

```
sub multiplied ($g, $f) { return { $g * $f * $^x } }

my $x  = 2.0;
my $xi = 0.5;
my $y  = 4.0;
my $yi = 0.25;
my $z  = $x + $y;
my $zi = 1.0 / ( $x + $y );

my @numbers = $x, $y, $z;
my @inverses = $xi, $yi, $zi;

for flat @numbers Z @inverses { say multiplied($^g, $^f)(.5) }

```

Output:

```
0.5
0.5
0.5
```

The structure of this is identical to first-class function task.


[User]
The month of October in 2010 has five Fridays, five Saturdays, and five Sundays.

Task

1. Write a program to show all months that have this same characteristic of five full weekends from the year 1900 through 2100 (Gregorian calendar).
2. Show the *number* of months with this property (there should be 201).
3. Show at least the first and last five dates, in order.

**Algorithm suggestions**

* Count the number of Fridays, Saturdays, and Sundays in every month.
* Find all of the 31-day months that begin on Friday.

**Extra credit**

Count and/or show all of the years which do not have at least one five-weekend month (there should be 29).

Related tasks

* Day of the week
* Last Friday of each month
* Find last sunday of each month

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2015-09-10

```
# A month has 5 weekends iff it has 31 days and starts on Friday.

my @years = 1900 .. 2100;
my @has31 = 1, 3, 5, 7, 8, 10, 12;
my @happy = ($_ when *.day-of-week == 5 for (@years X @has31).map(-> ($y, $m) { Date.new: $y, $m, 1 }));

say 'Happy month count:  ', +@happy;
say 'First happy months: ' ~ @happy[^5];
say 'Last  happy months: ' ~ @happy[*-5 .. *];
say 'Dreary years count: ',  @years - @happy».year.squish;

```

Output:

```
Happy month count:  201
First happy months: 1901-03-01 1902-08-01 1903-05-01 1904-01-01 1904-07-01
Last  happy months: 2097-03-01 2098-08-01 2099-05-01 2100-01-01 2100-10-01
Dreary years count: 29
```


[User]
Many big data or scientific programs use boxplots to show distributions of data.   In addition, sometimes saving large arrays for boxplots can be impractical and use extreme amounts of RAM.   It can be useful to save large arrays as arrays with five numbers to save memory.

For example, the   **R**   programming language implements Tukey's five-number summary as the **fivenum** function.

Task

Given an array of numbers, compute the five-number summary.

Note

While these five numbers can be used to draw a boxplot,   statistical packages will typically need extra data.

Moreover, while there is a consensus about the "box" of the boxplot,   there are variations among statistical packages for the whiskers.

[Assistant]
(formerly Perl 6)

**Translation of**: Perl

```
sub fourths ( Int $end ) {
    my $end_22 = $end div 2 / 2;

    return 0, $end_22, $end/2, $end - $end_22, $end;
}
sub fivenum ( @nums ) {
    my @x = @nums.sort(+*)
        or die 'Input must have at least one element';

    my @d = fourths(@x.end);

    return ( @x[@d».floor] Z+ @x[@d».ceiling] ) »/» 2;
}

say .&fivenum for [15, 6, 42, 41, 7, 36, 49, 40, 39, 47, 43],
                  [36, 40, 7, 39, 41, 15], [
    0.14082834,  0.09748790,  1.73131507,  0.87636009, -1.95059594,
    0.73438555, -0.03035726,  1.46675970, -0.74621349, -0.72588772,
    0.63905160,  0.61501527, -0.98983780, -1.00447874, -0.62759469,
    0.66206163,  1.04312009, -0.10305385,  0.75775634,  0.32566578,
];

```

Output:

```
(6 25.5 40 42.5 49)
(7 15 37.5 40 41)
(-1.95059594 -0.676741205 0.23324706 0.746070945 1.73131507)
```


[User]
Fixed length read/write

Before terminals, computers commonly used punch card readers or paper tape input.

A common format before these devices were superseded by terminal technology was based on the Hollerith code, Hollerith code.

These input devices handled 80 columns per card and had a limited character set, encoded by punching holes in one or more rows of the card for each column.

These devices assumed/demanded a fixed line width of 80 characters, newlines were not required (and could not even be encoded in some systems).

Task

Write a program to read 80 column fixed length records (no newline terminators (but newline characters allowed in the data)) and then write out the reverse of each line as fixed length 80 column records.

Samples here use printable characters, but that is not a given with fixed length data. Filenames used are sample.txt, infile.dat, outfile.dat.

**Note:** There are no newlines, inputs and outputs are fixed at 80 columns, no more, no less, space padded. Fixed length data is 8 bit complete. NUL bytes of zero are allowed.

These fixed length formats are still in wide use on mainframes, with JCL and with COBOL (which commonly use EBCDIC encoding and not ASCII). Most of the large players in day to day financial transactions know all about fixed length records and the expression *logical record length*.

Sample data

To create the sample input file, use an editor that supports fixed length records or use a conversion utility. For instance, most GNU/Linux versions of **dd** support blocking and unblocking records with a conversion byte size.

```
Line 1...1.........2.........3.........4.........5.........6.........7.........8
Line 2
Line 3
Line 4

Line 6
Line 7
     Indented line 8............................................................
Line 9                                                                 RT MARGIN
```

```
prompt$ dd if=sample.txt of=infile.dat cbs=80 conv=block
```

will create a fixed length record file of 80 bytes given newline delimited text input.

```
prompt$ dd if=infile.dat cbs=80 conv=unblock
```

will display a file with 80 byte logical record lengths to standard out as standard text with newlines.

Bonus round

Forth systems often include BLOCK words. A block is 1024 bytes. Source code is stored as 16 lines of 64 characters each (again, no newline character or sequence to mark the end of a line).

Write a program to convert a block file to text (using newlines). Trailing spaces should be excluded from the output.

Also demonstrate how to convert from a normal text file to block form. All lines either truncated or padded to 64 characters with no newline terminators. The last block filled to be exactly 1024 characters by adding blanks if needed. Assume a full range of 8 bit byte values for each character.

The COBOL example uses forth.txt and forth.blk filenames.

[Assistant]
(formerly Perl 6)
Link to a copy of the input file used: flr-infile.dat

Essentially the same as task Selective\_File\_Copy except more boring.

```
$*OUT = './flr-outfile.dat'.IO.open(:w, :bin) orelse .die; # open a file in binary mode for writing
while my $record = $*IN.read(80) {                       # read in fixed sized binary chunks
     $*OUT.write: $record.=reverse;                      # write reversed records out to $outfile
     $*ERR.say: $record.decode('ASCII');                 # display decoded records on STDERR
}
close $*OUT;

```

Output:

```
8.........7.........6.........5.........4.........3.........2.........1...1 eniL
                                                                          2 eniL
                                                                          3 eniL
                                                                          4 eniL

                                                                          6 eniL
                                                                          7 eniL
............................................................8 enil detnednI
NIGRAM TR                                                                 9 eniL
```


[User]
Task

Write a program that prints the integers from   **1**   to   **100**   (inclusive).

But:

:   * for multiples of three,   print   **Fizz**     instead of the number;
    * for multiples of five,   print   **Buzz**     instead of the number;
    * for multiples of both three and five,   print   **FizzBuzz**     instead of the number.

The   *FizzBuzz*   problem was presented as the lowest level of comprehension required to illustrate adequacy.

Also see

* (a blog)   dont-overthink-fizzbuzz
* (a blog)   fizzbuzz-the-programmers-stairway-to-heaven

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo Star version 2015-09-10

Most straightforwardly:

```
for 1 .. 100 {
    when $_ %% (3 & 5) { say 'FizzBuzz'; }
    when $_ %% 3       { say 'Fizz'; }
    when $_ %% 5       { say 'Buzz'; }
    default            { .say; }
}
```

Or abusing multi subs:

```
multi sub fizzbuzz(Int $ where * %% 15) { 'FizzBuzz' }
multi sub fizzbuzz(Int $ where * %%  5) { 'Buzz' }
multi sub fizzbuzz(Int $ where * %%  3) { 'Fizz' }
multi sub fizzbuzz(Int $number        ) { $number }
(1 .. 100)».&fizzbuzz.say;
```

Or abusing list metaoperators:

```
[1..100].map({[~] ($_%%3, $_%%5) »||» "" Z&& <fizz buzz> or $_ })».say
```

Concisely (readable):

```
say 'Fizz' x $_ %% 3 ~ 'Buzz' x $_ %% 5 || $_ for 1 .. 100;
```

Shortest FizzBuzz to date:

```
say "Fizz"x$_%%3~"Buzz"x$_%%5||$_ for 1..100
```

And here's an implementation that never checks for divisibility:

```
.say for
    (
      (flat ('' xx 2, 'Fizz') xx *)
      Z~
      (flat ('' xx 4, 'Buzz') xx *)
    )
    Z||
    1 .. 100;
```


[User]
Task

Write a function to flatten the nesting in an arbitrary list of values.

Your program should work on the equivalent of this list:

```
  [[1], 2, [[3, 4], 5], [[[]]], [[[6]]], 7, 8, []]

```

Where the correct result would be the list:

```
   [1, 2, 3, 4, 5, 6, 7, 8]

```

Related task

* Tree traversal

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo Star version 2018.03

```
my @l = [[1], 2, [[3,4], 5], [[[]]], [[[6]]], 7, 8, []];

say .perl given gather @l.deepmap(*.take); # lazy recursive version

# Another way to do it is with a recursive function (here actually a Block calling itself with the &?BLOCK dynamic variable):

say { |(@$_ > 1 ?? map(&?BLOCK, @$_) !! $_) }(@l)
```


[User]
The game

Given an   **N×N**   square array of zeroes or ones in an initial configuration,   and a target configuration of zeroes and ones.

The game is to transform one to the other in as few moves as possible by inverting whole numbered rows or whole lettered
columns at once   (as one move).

In an inversion.   any  **1**  becomes  **0**,   and any  **0**  becomes  **1**  for that whole row or column.

Task

Create a program to score for the Flipping bits game.

1. The game should create an original random target configuration and a starting configuration.
2. Ensure that the starting position is *never* the target position.
3. The target position must be guaranteed as reachable from the starting position.   (One possible way to do this is to generate the start position by legal flips from a random target position.   The flips will always be reversible back to the target from the given start position).
4. The number of moves taken so far should be shown.

Show an example of a short game here, on this page, for a   **3×3**   array of bits.

[Assistant]
(formerly Perl 6)

**Works with**: rakudo version 2016.11

Pass in a parameter to set the square size for the puzzle. (Defaults to 4.) Arbitrarily limited to between 1 and 26. Yes, you can choose to solve a 1 element square puzzle, but it won't be very challenging. Accepts upper or lower case letters for columns. Disregards any out-of-range indices. Enter a blank or 0 (zero) to exit.

```
sub MAIN ($square = 4) {
    say "{$square}? Seriously?" and exit if $square < 1 or $square > 26;
    my %bits = map { $_ => %( map { $_ => 0 }, ('A' .. *)[^ $square] ) },
        (1 .. *)[^ $square];
    scramble %bits;
    my $target = build %bits;
    scramble %bits until build(%bits) ne $target;
    display($target, %bits);
    my $turns = 0;
    while my $flip = prompt "Turn {++$turns}: Flip which row / column? " {
        flip $flip.match(/\w/).uc, %bits;
        if display($target, %bits) {
            say "Hurray! You solved it in $turns turns.";
            last;
        }
    }
}

sub display($goal, %hash) {
    shell('clear');
    say "Goal\n$goal\nYou";
    my $this = build %hash;
    say $this;
    return ($goal eq $this);
}

sub flip ($a, %hash) {
    given $a {
        when any(keys %hash) {
            %hash{$a}{$_} = %hash{$a}{$_} +^ 1 for %hash{$a}.keys
        };
        when any(keys %hash{'1'}) {
            %hash{$_}{$a} = %hash{$_}{$a} +^ 1 for %hash.keys
        };
    }
}

sub build (%hash) {
    my $string = '   ';
    $string ~= sprintf "%2s ", $_ for sort keys %hash{'1'};
    $string ~= "\n";
    for %hash.keys.sort: +* -> $key {
        $string ~= sprintf "%2s ", $key;
        $string ~= sprintf "%2s ", %hash{$key}{$_} for sort keys %hash{$key};
        $string ~=  "\n";
    };
    $string
}

sub scramble(%hash) {
    my @keys = keys %hash;
    @keys.push: | keys %hash{'1'};
    flip $_,  %hash for @keys.pick( @keys/2 );
}

```

A sample 3 x 3 game might look like this:

```
Goal
    A  B  C
 1  1  1  0
 2  0  0  1
 3  1  1  0

You
    A  B  C
 1  0  0  0
 2  1  1  1
 3  1  1  1

Turn 1: Flip which row / column? 2

Goal
    A  B  C
 1  1  1  0
 2  0  0  1
 3  1  1  0

You
    A  B  C
 1  0  0  0
 2  0  0  0
 3  1  1  1

Turn 2: Flip which row / column? 1

Goal
    A  B  C
 1  1  1  0
 2  0  0  1
 3  1  1  0

You
    A  B  C
 1  1  1  1
 2  0  0  0
 3  1  1  1

Turn 3: Flip which row / column? c

Goal
    A  B  C
 1  1  1  0
 2  0  0  1
 3  1  1  0

You
    A  B  C
 1  1  1  0
 2  0  0  1
 3  1  1  0

Hurray! You solved it in 3 turns.
```


[User]
Task

Document common flow-control structures.

One common example of a flow-control structure is the    `goto`    construct.

Note that   Conditional Structures   and   Loop Structures   have their own articles/categories.

Related tasks

* Conditional Structures
* Loop Structures

[Assistant]
(formerly Perl 6)

### Control exceptions

Control flow is extensible in Raku; most abnormal control flow (including the standard loop and switch exits) is managed by throwing control exceptions that are caught by the code implementing the construct in question. Warnings are also handled via control exceptions, and turn into control flow if the dynamic context chooses not to resume after the warning. See [S04/Control exceptions] for more information.

### Phasers

Phasers are blocks that are transparent to the normal control flow but that are automatically called at an appropriate phase of compilation or execution. The current list of phasers may be found in [S04/Phasers].

### goto

```
TOWN: goto TOWN;

```

Labels that have not been defined yet must be enclosed in quotes.


[User]
Floyd's triangle   lists the natural numbers in a right triangle aligned to the left where

* the first row is   **1**     (unity)
* successive rows start towards the left with the next number followed by successive naturals listing one more number than the line above.

The first few lines of a Floyd triangle looks like this:

```
 1
 2  3
 4  5  6
 7  8  9 10
11 12 13 14 15

```

Task
:   1. Write a program to generate and display here the first   n   lines of a Floyd triangle.
       (Use   n=5   and   n=14   rows).
    2. Ensure that when displayed in a mono-space font, the numbers line up in vertical columns as shown and that only one space separates numbers of the last row.

[Assistant]
(formerly Perl 6)
Here's two ways of doing it.

```
constant @floyd1 = (1..*).rotor(1..*);
constant @floyd2 = gather for 1..* -> $s { take [++$ xx $s] }

sub format-rows(@f) {
    my @table;
    my @formats = @f[@f-1].map: {"%{.chars}s"}
    for @f -> @row {
        @table.push: (@row Z @formats).map: -> ($i, $f) { $i.fmt($f) }
    }
    join "\n", @table;
}

say format-rows(@floyd1[^5]);
say '';
say format-rows(@floyd2[^14]);

```

Output:

```
 1
 2  3
 4  5  6
 7  8  9 10
11 12 13 14 15

 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 26 27 28
29 30 31 32 33 34 35 36
37 38 39 40 41 42 43 44  45
46 47 48 49 50 51 52 53  54  55
56 57 58 59 60 61 62 63  64  65  66
67 68 69 70 71 72 73 74  75  76  77  78
79 80 81 82 83 84 85 86  87  88  89  90  91
92 93 94 95 96 97 98 99 100 101 102 103 104 105
```


[User]
The Floyd–Warshall algorithm is an algorithm for finding shortest paths in a weighted graph with positive or negative edge weights.

Task

Find the lengths of the shortest paths between all pairs of vertices of the given directed graph. Your code may assume that the input has already been checked for loops, parallel edges and negative cycles.

Print the pair, the distance and (optionally) the path.

Example

```
pair     dist    path
1 -> 2    -1     1 -> 3 -> 4 -> 2
1 -> 3    -2     1 -> 3
1 -> 4     0     1 -> 3 -> 4
2 -> 1     4     2 -> 1
2 -> 3     2     2 -> 1 -> 3
2 -> 4     4     2 -> 1 -> 3 -> 4
3 -> 1     5     3 -> 4 -> 2 -> 1
3 -> 2     1     3 -> 4 -> 2
3 -> 4     2     3 -> 4
4 -> 1     3     4 -> 2 -> 1
4 -> 2    -1     4 -> 2
4 -> 3     1     4 -> 2 -> 1 -> 3
```

See also

* Floyd-Warshall Algorithm - step by step guide (youtube)

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2016.12

**Translation of**: Ruby

```
sub Floyd-Warshall (Int $n, @edge) {
    my @dist = [0, |(Inf xx $n-1)], *.Array.rotate(-1) … !*[*-1];
    my @next = [0 xx $n] xx $n;

    for @edge -> ($u, $v, $w) {
        @dist[$u-1;$v-1] = $w;
        @next[$u-1;$v-1] = $v-1;
    }

    for [X] ^$n xx 3 -> ($k, $i, $j) {
        if @dist[$i;$j] > my $sum = @dist[$i;$k] + @dist[$k;$j] {
            @dist[$i;$j] = $sum;
            @next[$i;$j] = @next[$i;$k];
        }
    }

    say ' Pair  Distance     Path';
    for [X] ^$n xx 2 -> ($i, $j){
        next if $i == $j;
        my @path = $i;
        @path.push: @next[@path[*-1];$j] until @path[*-1] == $j;
        printf("%d → %d  %4d       %s\n", $i+1, $j+1, @dist[$i;$j],
          @path.map( *+1 ).join(' → '));
    }
}

Floyd-Warshall(4, [[1, 3, -2], [2, 1, 4], [2, 3, 3], [3, 4, 2], [4, 2, -1]]);

```

Output:

```
 Pair  Distance     Path
1 → 2    -1       1 → 3 → 4 → 2
1 → 3    -2       1 → 3
1 → 4     0       1 → 3 → 4
2 → 1     4       2 → 1
2 → 3     2       2 → 1 → 3
2 → 4     4       2 → 1 → 3 → 4
3 → 1     5       3 → 4 → 2 → 1
3 → 2     1       3 → 4 → 2
3 → 4     2       3 → 4
4 → 1     3       4 → 2 → 1
4 → 2    -1       4 → 2
4 → 3     1       4 → 2 → 1 → 3

```


[User]
Lagrange's theorem tells us that every positive integer can be written as a sum of at most four squares.

Many, (square numbers) can be written as a "sum" of a single square. **E.G.:** `4 == 22`.

Some numbers require at least two squares to be summed. `5 == 22 + 12`

Others require at least three squares. `6 == 22 + 12 + 12`

Finally, some, (the focus of this task) require the sum at least four squares. `7 == 22 + 12 + 12 + 12`. There is no way to reach 7 summing fewer than four squares.

These numbers show up in crystallography; x-ray diffraction patterns of cubic crystals depend on a length squared plus a width squared plus a height squared. Some configurations that require at least four squares are impossible to index and are colloquially known as **forbidden numbers**.

Note that some numbers *can* be made from the sum of four squares: `16 == 22 + 22 + 22 + 22`, but since it can also be formed from fewer than four, `16 == 42`, it does not count as a forbidden number.

Task

* Find and show the first fifty forbidden numbers.

* Find and show the **count** of forbidden numbers up to 500, 5,000.

Stretch

* Find and show the **count** of forbidden numbers up to 50,000, 500,000.

See also

* Wikipedia: Lagrange's theorem * OEIS A004215 - Numbers that are the sum of 4 but no fewer nonzero squares

[Assistant]
```
use Lingua::EN::Numbers;
use List::Divvy;

my @f = (1..*).map: *×8-1;

my @forbidden = lazy flat @f[0], gather for ^∞ {
    state ($p0, $p1) = 1, 0;
    take (@f[$p0] < @forbidden[$p1]×4) ?? @f[$p0++] !! @forbidden[$p1++]×4;
}

put "First fifty forbidden numbers: \n" ~
  @forbidden[^50].batch(10)».fmt("%3d").join: "\n";

put "\nForbidden number count up to {.Int.&cardinal}: " ~
  comma +@forbidden.&upto: $_ for 5e2, 5e3, 5e4, 5e5, 5e6;

```

Output:

```
First fifty forbidden numbers:
  7  15  23  28  31  39  47  55  60  63
 71  79  87  92  95 103 111 112 119 124
127 135 143 151 156 159 167 175 183 188
191 199 207 215 220 223 231 239 240 247
252 255 263 271 279 284 287 295 303 311

Forbidden number count up to five hundred: 82

Forbidden number count up to five thousand: 831

Forbidden number count up to fifty thousand: 8,330

Forbidden number count up to five hundred thousand: 83,331

Forbidden number count up to five million: 833,329
```


[User]
|  |
| --- |
| This page uses content from **Wikipedia**. The original article was at Forest-fire model. The list of authors can be seen in the page history. As with Rosetta Code, the text of Wikipedia is available under the GNU FDL. (See links for details on variance) |

Task

Implement the Drossel and Schwabl definition of the forest-fire model.

It is basically a 2D   cellular automaton   where each cell can be in three distinct states (*empty*, *tree* and *burning*) and evolves according to the following rules (as given by Wikipedia)

1. A burning cell turns into an empty cell
2. A tree will burn if at least one neighbor is burning
3. A tree ignites with probability   *f*    even if no neighbor is burning
4. An empty space fills with a tree with probability    *p*

Neighborhood is the   Moore neighborhood;   boundary conditions are so that on the boundary the cells are always empty ("fixed" boundary condition).

At the beginning, populate the lattice with empty and tree cells according to a specific probability (e.g. a cell has the probability 0.5 to be a tree). Then, let the system evolve.

Task's requirements do not include graphical display or the ability to change parameters (probabilities    *p*    and    *f* )   through a graphical or command line interface.

Related tasks

* See   Conway's Game of Life
* See   Wireworld.

[Assistant]
(formerly Perl 6)

### ANSI graphics

**Works with**: rakudo version 2015-10-04

This version saves a lot of looking around by using four states instead of three; the Heating state does a lookahead to track trees that are being heated up by burning trees, so we only ever have to traverse the neighbors of burning trees, not all trees. Also, by only checking the list of burning trees, we can avoid copying the entire forest each iteration, since real forests are mutable.

```
constant $RED = "\e[1;31m";
constant $YELLOW = "\e[1;33m";
constant $GREEN = "\e[1;32m";
constant $CLEAR = "\e[0m";
# make sure we clear colors at the end
END print $CLEAR;

enum Cell-State <Empty Tree Heating Burning>;
my @pix = '  ', $GREEN ~ '木', $YELLOW ~ '木', $RED ~ '木';

class Forest {
    has Rat $.p = 0.01;
    has Rat $.f = 0.001;
    has Int $!height;
    has Int $!width;
    has @!coords;
    has @!spot;
    has @!neighbors;

    method BUILD (Int :$!height, Int :$!width) {
	@!coords = ^$!height X ^$!width;
	@!spot = [ (Bool.pick ?? Tree !! Empty) xx $!width ] xx $!height;
        self!init-neighbors;
    }

    method !init-neighbors {
        for @!coords -> ($i, $j) {
            @!neighbors[$i][$j] = eager gather for
                    [-1,-1],[+0,-1],[+1,-1],
                    [-1,+0],        [+1,+0],
                    [-1,+1],[+0,+1],[+1,+1]
	    {
		take-rw @!spot[$i + .[0]][$j + .[1]] // next;
	    }
	}
    }

    method step {
	my @heat;
        for @!coords -> ($i, $j) {
            given @!spot[$i][$j] {
                when Empty   { $_ = Tree if rand < $!p }
                when Tree    { $_ = Heating if rand < $!f }
                when Heating { $_ = Burning; push @heat, ($i, $j); }
                when Burning { $_ = Empty }
            }
        }
	for @heat -> ($i,$j) {
	    $_ = Heating for @!neighbors[$i][$j].grep(Tree);
	}
    }

    method show {
        for ^$!height -> $i {
            say @pix[@!spot[$i].list].join;
        }
    }
}

my ($ROWS, $COLS) = qx/stty size/.words;

signal(SIGINT).act: { print "\e[H\e[2J"; exit }

sub MAIN (Int $height = $ROWS - 2, Int $width = +$COLS div 2 - 1) {
    my Forest $forest .= new(:$height, :$width);
    print "\e[2J";      # ANSI clear screen
    loop {
	print "\e[H";   # ANSI home
	say $++;
	$forest.show;
	$forest.step;
    }
}

```

### SDL2 Animation

An alternate version implemented in SDL2.

```
use NativeCall;
use SDL2::Raw;

my ($width, $height) = 900, 900;

SDL_Init(VIDEO);
my SDL_Window $window = SDL_CreateWindow(
    "Forest Fire - Raku",
    SDL_WINDOWPOS_CENTERED_MASK, SDL_WINDOWPOS_CENTERED_MASK,
    $width, $height,
    RESIZABLE
);
my SDL_Renderer $renderer = SDL_CreateRenderer( $window, -1, ACCELERATED +| PRESENTVSYNC );

SDL_ClearError();

my int ($w, $h) = 200, 200;

my $forest_texture = SDL_CreateTexture($renderer, %PIXELFORMAT<RGB332>, STREAMING, $w, $h);

my $pixdatabuf  = CArray[int64].new(0, $w, $h, $w);
my $work-buffer = CArray[int64].new(0, $w, $h, $w);

my int $bare    = 0;    # Black
my int $tree    = 8;    # Green
my int $heating = -120; # Orange ( 132 but it's being passed into an int8 )
my int $burning = 128;  # Red
my int $buf = $w * $h;
my $humidity    = .7;  # Chance that a tree next to a burning tree will resist catching fire
my $tree-spawn  = .75; # Initial probability that a space will contain a tree. Probability
                       # will be adjusted (way down) once rendering starts.

sub render {

    # work-around to pass the pointer-pointer.
    my $pixdata = nativecast(Pointer[int64], $pixdatabuf);
    SDL_LockTexture($forest_texture, SDL_Rect, $pixdata, my int $pitch);

    $pixdata = nativecast(CArray[int8], Pointer.new($pixdatabuf[0]));

    loop (my int $row; $row < $h; $row = $row + 1) {
        my int $rs = $row * $w; # row start
        my int $re = $rs  + $w; # row end
        loop (my int $idx = $rs; $idx < $re; $idx = $idx + 1) {
            # Skip it if it is a tree
            next if $pixdata[$idx] == $tree;
            if $pixdata[$idx] == $bare {
                # Maybe spawn a tree on bare ground
                $work-buffer[$idx] = rand < $tree-spawn ?? $tree !! $bare;
            } elsif $pixdata[$idx] == $heating {
                # Check if there are trees around a hot spot and light them if humidity is low enough
                $work-buffer[$idx - $w - 1] = $heating if rand > $humidity && $pixdata[$idx - $w - 1] && $row > 0;
                $work-buffer[$idx - $w    ] = $heating if rand > $humidity && $pixdata[$idx - $w    ] && $row > 0;
                $work-buffer[$idx - $w + 1] = $heating if rand > $humidity && $pixdata[$idx - $w + 1] && $row > 0;
                $work-buffer[$idx - 1     ] = $heating if rand > $humidity && $pixdata[$idx -  1    ];
                $work-buffer[$idx + $w - 1] = $heating if rand > $humidity && $pixdata[$idx + $w - 1];
                $work-buffer[$idx + $w    ] = $heating if rand > $humidity && $pixdata[$idx + $w    ];
                $work-buffer[$idx + $w + 1] = $heating if rand > $humidity && $pixdata[$idx + $w + 1];
                $work-buffer[$idx + 1     ] = $heating if rand > $humidity && $pixdata[$idx +  1    ];

                # Hotspot becomes a flame
                $work-buffer[$idx] = $burning
            } else {
                # Extinguish a flame after fuel is gone
                $work-buffer[$idx] = $bare;
            }
        }
    }
    # copy working buffer to main texture buffer
    loop (my int $i; $i < $buf; $i = $i + 1) { $pixdata[$i] = $work-buffer[$i] }

    # start a fire maybe
    $pixdata[$buf.rand] = $heating if rand < .1;

    SDL_UnlockTexture($forest_texture);

    SDL_RenderCopy($renderer, $forest_texture, SDL_Rect, SDL_Rect.new(:x(0), :y(0), :w($width), :h($height)));
    SDL_RenderPresent($renderer);
    once $tree-spawn = .005;
}

my $event = SDL_Event.new;

enum KEY_CODES ( K_Q => 20 );

main: loop {

    while SDL_PollEvent($event) {
        my $casted_event = SDL_CastEvent($event);

        given $casted_event {
            when *.type == QUIT {
                last main;
            }
            when *.type == KEYDOWN {
                if KEY_CODES(.scancode) -> $comm {
                    given $comm {
                        when 'K_Q'      { last main }
                    }
                }
            }
            when *.type == WINDOWEVENT {
                if .event == RESIZED {
                    $width  = .data1;
                    $height = .data2;
                }
            }
        }
    }
    render();
    print fps;
}
say '';

sub fps {
    state $fps-frames = 0;
    state $fps-now    = now;
    state $fps        = '';
    $fps-frames++;
    if now - $fps-now >= 1 {
        $fps = [~] "\b" x 40, ' ' x 20, "\b" x 20 ,
            sprintf "FPS: %5.2f  ", ($fps-frames / (now - $fps-now)).round(.01);
        $fps-frames = 0;
        $fps-now = now;
    }
    $fps
}

```


[User]
Task

Spawn a new process which can run simultaneously with, and independently of, the original parent process.

[Assistant]
(formerly Perl 6)

**Works with**: rakudo version 2016.06

```
use NativeCall;
sub fork() returns int32 is native { ... }

if fork() -> $pid {
    print "I am the proud parent of $pid.\n";
}
else {
    print "I am a child.  Have you seen my mommy?\n";
}

```

Output:

```
I am the proud parent of 17691.
I am a child.  Have you seen my mommy?
```


[User]
A *power series* is an infinite sum of the form

a

0
+

a

1
⋅
x
+

a

2
⋅

x

2
+

a

3
⋅

x

3
+
⋯
{\displaystyle {\displaystyle a\_{0}+a\_{1}\cdot x+a\_{2}\cdot x^{2}+a\_{3}\cdot x^{3}+\cdots }}

The *ai* are called the *coefficients* of the series. Such sums can be added, multiplied etc., where the new coefficients of the powers of *x* are calculated according to the usual rules.

If one is not interested in evaluating such a series for particular values of *x*, or in other words, if convergence doesn't play a role, then such a collection of coefficients is called *formal power series*. It can be treated like a new kind of number.

**Task**: Implement formal power series as a numeric type. Operations should at least include *addition*, *multiplication*, *division* and additionally non-numeric operations like *differentiation* and *integration* (with an integration constant of zero). Take care that your implementation deals with the potentially infinite number of coefficients.

As an example, define the power series of sine and cosine in terms of each other using integration, as in

sin

x
=

∫

0

x
cos

t

d
t
{\displaystyle {\displaystyle \sin x=\int \_{0}^{x}\cos t\,dt}}

cos

x
=
1
−

∫

0

x
sin

t

d
t
{\displaystyle {\displaystyle \cos x=1-\int \_{0}^{x}\sin t\,dt}}

**Goals**: Demonstrate how the language handles new numeric types and delayed (or *lazy*) evaluation.

[Assistant]
(formerly Perl 6)

```
class DerFPS { ... }
class IntFPS { ... }

role FPS {
    method coeffs        { ... }
    method differentiate { DerFPS.new(:x(self)) }
    method integrate     { IntFPS.new(:x(self)) }

    method pretty($n) {
        sub super($i) { $i.trans('0123456789' => '⁰¹²³⁴⁵⁶⁷⁸⁹') }
        my $str = $.coeffs[0];
        for flat 1..$n Z $.coeffs[1..$n] -> $p, $c {
            when $c > 0 { $str ~= " + { $c .nude.join: '/'}∙x{super($p)}" }
            when $c < 0 { $str ~= " - {-$c .nude.join: '/'}∙x{super($p)}" }
        }
        $str;
    }
}

class ExplicitFPS does FPS { has @.coeffs }

class SumFPS does FPS {
    has FPS ($.x, $.y);
    method coeffs { $.x.coeffs Z+ $.y.coeffs }
}

class DifFPS does FPS {
    has FPS ($.x, $.y);
    method coeffs { $.x.coeffs Z- $.y.coeffs }
}

class ProFPS does FPS {
    has FPS ($.x, $.y);
    method coeffs { (0..*).map: { [+] ($.x.coeffs[0..$_] Z* $.y.coeffs[$_...0]) } }
}

class InvFPS does FPS {
    has FPS $.x;
    method coeffs {
        # see http://en.wikipedia.org/wiki/Formal_power_series#Inverting_series
        flat gather {
            my @a = $.x.coeffs;
            @a[0] != 0 or fail "Cannot invert power series with zero constant term.";
            take my @b = (1 / @a[0]);
            take @b[$_] = -@b[0] * [+] (@a[1..$_] Z* @b[$_-1...0]) for 1..*;
        }
    }
}

class DerFPS does FPS {
    has FPS $.x;
    method coeffs { (1..*).map: { $_ * $.x.coeffs[$_] } }
}

class IntFPS does FPS {
    has FPS $.x;
    method coeffs { 0, |(0..*).map: { $.x.coeffs[$_] / ($_+1) } }
}

class DeferredFPS does FPS {
    has FPS $.realized is rw;
    method coeffs { $.realized.coeffs }
}

# some arithmetic operations for formal power series
multi infix:<+>(FPS $x, FPS $y) { SumFPS.new(:$x, :$y) }
multi infix:<->(FPS $x, FPS $y) { DifFPS.new(:$x, :$y) }
multi infix:<*>(FPS $x, FPS $y) { ProFPS.new(:$x, :$y) }
multi infix:</>(FPS $x, FPS $y) { $x * InvFPS.new(:x($y)) }

# an example of a mixed-type operator:
multi infix:<->(Numeric $x, FPS $y) { ExplicitFPS.new(:coeffs(lazy flat $x, 0 xx *)) - $y }

# define sine and cosine in terms of each other
my $sin       = DeferredFPS.new;
my $cos       = 1 - $sin.integrate;
$sin.realized = $cos.integrate;

# define tangent in terms of sine and cosine
my $tan       = $sin / $cos;

say 'sin(x) ≈ ' ~ $sin.pretty(10);
say 'cos(x) ≈ ' ~ $cos.pretty(10);
say 'tan(x) ≈ ' ~ $tan.pretty(10);

```

Output:

```
sin(x) ≈ 0 + 1/1∙x¹ - 1/6∙x³ + 1/120∙x⁵ - 1/5040∙x⁷ + 1/362880∙x⁹
cos(x) ≈ 1 - 1/2∙x² + 1/24∙x⁴ - 1/720∙x⁶ + 1/40320∙x⁸ - 1/3628800∙x¹⁰
tan(x) ≈ 0 + 1/1∙x¹ + 1/3∙x³ + 2/15∙x⁵ + 17/315∙x⁷ + 62/2835∙x⁹
```


[User]
Task

Express a number in decimal as a fixed-length string with leading zeros.

For example, the number   **7.125**   could be expressed as   **00007.125**.

[Assistant]
(formerly Perl 6)

```
say 7.125.fmt('%09.3f');

```


[User]
Definition

A Fortunate number is the smallest integer **m > 1** such that for a given positive integer **n**, **primorial(n) + m** is a prime number, where **primorial(n)** is the product of the first **n** prime numbers.

For example the first fortunate number is 3 because primorial(1) is 2 and 2 + 3 = 5 which is prime whereas 2 + 2 = 4 is composite.

Task

After sorting and removal of any duplicates, compute and show on this page the first **8** Fortunate numbers or, if your language supports *big integers*, the first **50** Fortunate numbers.

Related task

* Primorial numbers

See also

* oeis:A005235 Fortunate numbers
* oeis:A046066 Fortunate numbers, sorted with duplicates removed

[Assistant]
Limit of 75 primorials to get first 50 unique fortunates is arbitrary, found through trial and error.

```
my @primorials = [\*] grep *.is-prime, ^∞;

say display :title("First 50 distinct fortunate numbers:\n"),
   (squish sort @primorials[^75].hyper.map: -> $primorial {
       (2..∞).first: (* + $primorial).is-prime
   })[^50];

sub display ($list, :$cols = 10, :$fmt = '%6d', :$title = "{+$list} matching:\n") {
    cache $list;
    $title ~ $list.batch($cols)».fmt($fmt).join: "\n"
}

```

Output:

```
First 50 distinct fortunate numbers:
     3      5      7     13     17     19     23     37     47     59
    61     67     71     79     89    101    103    107    109    127
   151    157    163    167    191    197    199    223    229    233
   239    271    277    283    293    307    311    313    331    353
   373    379    383    397    401    409    419    421    439    443
```


[User]
Task

Provide code that produces a list of numbers which is the   nth  order forward difference, given a non-negative integer (specifying the order) and a list of numbers.

The first-order forward difference of a list of numbers   **A**   is a new list   **B**,   where   **B**n = **A**n+1 - **A**n.

List   **B**   should have one fewer element as a result.

The second-order forward difference of   **A**   will be:

```
tdefmodule Diff do
	def forward(arr,i\\1) do
		forward(arr,[],i)
	end

	def forward([_|[]],diffs,i) do
		if i == 1 do
			IO.inspect diffs
		else
			forward(diffs,[],i-1)
		end
	end

	def forward([val1|[val2|vals]],diffs,i) do
		forward([val2|vals],diffs++[val2-val1],i)
	end
end

```

The same as the first-order forward difference of   **B**.

That new list will have two fewer elements than   **A**   and one less than   **B**.

The goal of this task is to repeat this process up to the desired order.

For a more formal description, see the related   Mathworld article.

Algorithmic options

* Iterate through all previous forward differences and re-calculate a new array each time.
* Use this formula (from Wikipedia):

:   :   :   Δ

            n
            [
            f
            ]
            (
            x
            )
            =

            ∑

            k
            =
            0

            n

            (

            n
            k

            )
            (
            −
            1

            )

            n
            −
            k
            f
            (
            x
            +
            k
            )
            {\displaystyle {\displaystyle \Delta ^{n}[f](x)=\sum \_{k=0}^{n}{n \choose k}(-1)^{n-k}f(x+k)}}

:   :   :   (Pascal's Triangle   may be useful for this option.)

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo Star version 2010-07

Here we use signature matching to bind both an entire array and a version missing the head.
The Z- operator is a zip metaoperator with a minus to subtract the two lists pairwise.
It's almost a shame to define difn, since the series and subscript are hardly longer than the call itself would be, and arguably more self-documenting than the name of the function would be.

```
sub dif(@array [$, *@tail]) { @tail Z- @array }
sub difn($array, $n) { ($array, &dif ... *)[$n] }

```


[User]
Task

"*Simulate*" a four-bit adder.

This design can be realized using four 1-bit full adders.
Each of these 1-bit full adders can be built with two half adders and an   *or*   gate. ;

Finally a half adder can be made using an   *xor*   gate and an   *and*   gate.

The   *xor*   gate can be made using two   *not*s,   two   *and*s   and one   *or*.

**Not**,   **or**   and   **and**,   the only allowed "gates" for the task, can be "imitated" by using the bitwise operators of your language.

If there is not a *bit type* in your language, to be sure that the   *not*   does not "invert" all the other bits of the basic type   (e.g. a byte)   we are not interested in,   you can use an extra   *nand*   (*and*   then   *not*)   with the constant   **1**   on one input.

Instead of optimizing and reducing the number of gates used for the final 4-bit adder,   build it in the most straightforward way,   *connecting* the other "constructive blocks",   in turn made of "simpler" and "smaller" ones.

Schematics of the "constructive blocks"

| (Xor gate with ANDs, ORs and NOTs) | (A half adder) | (A full adder) | (A 4-bit adder) |
| --- | --- | --- | --- |
|  |  |  |  |

Solutions should try to be as descriptive as possible, making it as easy as possible to identify "connections" between higher-order "blocks".

It is not mandatory to replicate the syntax of higher-order blocks in the atomic "gate" blocks, i.e. basic "gate" operations can be performed as usual bitwise operations, or they can be "wrapped" in a *block* in order to expose the same syntax of higher-order blocks, at implementers' choice.

To test the implementation, show the sum of two four-bit numbers (in binary).

[Assistant]
(formerly Perl 6)

```
sub xor ($a, $b) { (($a and not $b) or (not $a and $b)) ?? 1 !! 0 }

sub half-adder ($a, $b) {
    return xor($a, $b), ($a and $b);
}

sub full-adder ($a, $b, $c0) {
    my ($ha0_s, $ha0_c) = half-adder($c0, $a);
    my ($ha1_s, $ha1_c) = half-adder($ha0_s, $b);
    return $ha1_s, ($ha0_c or $ha1_c);
}

sub four-bit-adder ($a0, $a1, $a2, $a3, $b0, $b1, $b2, $b3) {
    my ($fa0_s, $fa0_c) = full-adder($a0, $b0, 0);
    my ($fa1_s, $fa1_c) = full-adder($a1, $b1, $fa0_c);
    my ($fa2_s, $fa2_c) = full-adder($a2, $b2, $fa1_c);
    my ($fa3_s, $fa3_c) = full-adder($a3, $b3, $fa2_c);

    return $fa0_s, $fa1_s, $fa2_s, $fa3_s, $fa3_c;
}

{
    use Test;

    is four-bit-adder(1, 0, 0, 0, 1, 0, 0, 0), (0, 1, 0, 0, 0), '1 + 1 == 2';
    is four-bit-adder(1, 0, 1, 0, 1, 0, 1, 0), (0, 1, 0, 1, 0), '5 + 5 == 10';
    is four-bit-adder(1, 0, 0, 1, 1, 1, 1, 0)[4], 1, '7 + 9 == overflow';
}

```

Output:

```
ok 1 - 1 + 1 == 2
ok 2 - 5 + 5 == 10
ok 3 - 7 + 9 == overflow
```