[User]
The discrete Fourier transform is a linear, invertible transformation which transforms an arbitrary sequence of complex numbers to another sequence of complex numbers of the same length. The Fast Fourier transform (FFT) is an efficient implementation of this mechanism, but one which only works for sequences which have a length which is a power of 2.

The discrete Fourier transform is a useful testing mechanism to verify the correctness of code bases which use or implement the FFT.

For this task:

1. Implement the discrete fourier transform
2. Implement the inverse fourier transform
3. (optional) implement a cleaning mechanism to remove small errors introduced by floating point representation.
4. Verify the correctness of your implementation using a small sequence of integers, such as 2 3 5 7 11

The fourier transform of a sequence

x

n
{\displaystyle {\displaystyle x\_{n}}}
 of length

N
{\displaystyle {\displaystyle N}}
 is given by:

X

n
=

∑

k
=
0

N
−
1

x

k
⋅

e

−
i

2
π
N
k
n
{\displaystyle {\displaystyle X\_{n}=\sum \_{k=0}^{N-1}x\_{k}\cdot e^{-i{\frac {2\pi }{N}}kn}}}

The inverse transform is given by:

x

n
=

1
N

∑

k
=
0

N
−
1

X

k
⋅

e

i

2
π
N
k
n
{\displaystyle {\displaystyle x\_{n}={\frac {1}{N}}\sum \_{k=0}^{N-1}X\_{k}\cdot e^{i{\frac {2\pi }{N}}kn}}}

[Assistant]
* This task could be done with a loop of maps like
  @X[k] = sum @x.kv.map: -> \n, \v { v \* exp( -i \* tau / N \* k \* n ) }
  , but it is a better fit for Raku's concurrent Hyper-operators.
* In the DFT formula, *N* becomes *+@x*, the element count. We would usually omit the plus sign and get the same result from numeric context, but that gets confusing to read when mixed with hyper-ops like »\*« .
* The exponents of DFT and IDFT only differ from each other in the sign of *i*, and the calculation of any given elements only differ by the *k* index of the element being output, so the inner loop is cleanly shareable between DFT and IDFT.
* Euler's constant, imaginary unit, pi, and 2pi are built-in, with ASCII and Unicode spellings: e 𝑒 i pi π tau τ .
* $one\_thing «op« @many\_things vectorizes the *op* operation: 5 «+« (1,2,3) is (6,7,8) .
* @many\_things »op« @many\_more\_things distributes the *op* operation pairwise: (5,6,7) »+« (1,2,3) is (6,8,10) .
* (list)».method applies the method to each element of the list.
* @array.keys, when @array has e.g. 4 elements, is 0,1,2,3 .
* $n.round($r) returns *$n* rounded to the nearest *$r*. (13/16).round(1/4) is 3/4 .
* .narrow changes a Numeric's type to a "narrower" type, when no precision would be lost.
  8/2 is 4, but is type Rat (rational). (8/2).narrow is also 4, but type Int.

```
sub ft_inner ( @x, $k, $pos_neg_i where * == i|-i ) {
    my @exp := ( $pos_neg_i * tau / +@x * $k ) «*« @x.keys;
    return sum @x »*« 𝑒 «**« @exp;
}
sub dft   ( @x ) { return @x.keys.map: { ft_inner( @x, $_, -i )       } }
sub idft  ( @x ) { return @x.keys.map: { ft_inner( @x, $_,  i ) / +@x } }
sub clean ( @x ) { @x».round(1e-12)».narrow }

my @tests = ( 1, 2-i, -i, -1+2i     ),
            ( 2,   3,  5,     7, 11 ),
;
for @tests -> @x {
    my @x_dft  =  dft(@x);
    my @x_idft = idft(@x_dft);

    say .key.fmt('%6s:'), .value.&clean.fmt('%5s', ', ') for :@x, :@x_dft, :@x_idft;
    say '';
    warn "Round-trip failed" unless ( clean(@x) Z== clean(@x_idft) ).all;
}

```

Output:

```
     x:    1,  2-1i,  0-1i, -1+2i
 x_dft:    2, -2-2i,  0-2i,  4+4i
x_idft:    1,  2-1i,  0-1i, -1+2i

     x:    2,     3,     5,     7,    11
 x_dft:   28, -3.38196601125+8.784022634946i, -5.61803398875+2.800168985749i, -5.61803398875-2.800168985749i, -3.38196601125-8.784022634946i
x_idft:    2,     3,     5,     7,    11
```


[User]
Task

Display a finite linear combination in an infinite vector basis

(

e

1
,

e

2
,
…
)
{\displaystyle {\displaystyle (e\_{1},e\_{2},\ldots )}}
.

Write a function that, when given a finite list of scalars

(

α

1
,

α

2
,
…
)
{\displaystyle {\displaystyle (\alpha ^{1},\alpha ^{2},\ldots )}}
,
creates a string representing the linear combination

∑

i

α

i

e

i
{\displaystyle {\displaystyle \sum \_{i}\alpha ^{i}e\_{i}}}
 in an explicit format often used in mathematics, that is:

:   α

    i

    1

    e

    i

    1
    ±

    |

    α

    i

    2

    |

    e

    i

    2
    ±

    |

    α

    i

    3

    |

    e

    i

    3
    ±
    …
    {\displaystyle {\displaystyle \alpha ^{i\_{1}}e\_{i\_{1}}\pm |\alpha ^{i\_{2}}|e\_{i\_{2}}\pm |\alpha ^{i\_{3}}|e\_{i\_{3}}\pm \ldots }}

where

α

i

k
≠
0
{\displaystyle {\displaystyle \alpha ^{i\_{k}}\neq 0}}

The output must comply to the following rules:

* don't show null terms, unless the whole combination is null.

:   :   :   :   :   :   :   **e(1)**     is fine,     **e(1) + 0\*e(3)**     or     **e(1) + 0**     is wrong.

* don't show scalars when they are equal to one or minus one.

:   :   :   :   :   :   :   **e(3)**     is fine,     **1\*e(3)**     is wrong.

* don't prefix by a minus sign if it follows a preceding term.   Instead you use subtraction.

:   :   :   :   :   :   :   **e(4) - e(5)**     is fine,     **e(4) + -e(5)**     is wrong.

Show here output for the following lists of scalars:

```
 1)    1,  2,  3
 2)    0,  1,  2,  3
 3)    1,  0,  3,  4
 4)    1,  2,  0
 5)    0,  0,  0
 6)    0
 7)    1,  1,  1
 8)   -1, -1, -1
 9)   -1, -2,  0, -3
10)   -1

```

[Assistant]
(formerly Perl 6)

```
sub linear-combination(@coeff) {
    (@coeff Z=> map { "e($_)" }, 1 .. *)
    .grep(+*.key)
    .map({ .key ~ '*' ~ .value })
    .join(' + ')
    .subst('+ -', '- ', :g)
    .subst(/<|w>1\*/, '', :g)
        || '0'
}

say linear-combination($_) for
[1, 2, 3],
[0, 1, 2, 3],
[1, 0, 3, 4],
[1, 2, 0],
[0, 0, 0],
[0],
[1, 1, 1],
[-1, -1, -1],
[-1, -2, 0, -3],
[-1 ]
;

```

Output:

```
e(1) + 2*e(2) + 3*e(3)
e(2) + 2*e(3) + 3*e(4)
e(1) + 3*e(3) + 4*e(4)
e(1) + 2*e(2)
0
0
e(1) + e(2) + e(3)
-e(1) - e(2) - e(3)
-e(1) - 2*e(2) - 3*e(4)
-e(1)
```


[User]
|  |  |  |  |  |  |  |
| --- | --- | --- | --- | --- | --- | --- |
| Display an outline as a nested table. | | | | | | |
| Parse the outline to a tree, | | | count the leaves descending from each node, | | and write out a table with 'colspan' values | |
| measuring the indent of each line, | translating the indentation to a nested structure, | and padding the tree to even depth. | defining the width of a leaf as 1, | and the width of a parent node as a sum. | either as a wiki table, | or as HTML. |
|  |  |  |  | (The sum of the widths of its children) |  |  |

The graphic representation of outlines is a staple of mind-mapping and the planning of papers, reports, and speeches.

Task

Given a outline with at least 3 levels of indentation, for example:

```
Display an outline as a nested table.
    Parse the outline to a tree,
        measuring the indent of each line,
        translating the indentation to a nested structure,
        and padding the tree to even depth.
    count the leaves descending from each node,
        defining the width of a leaf as 1,
        and the width of a parent node as a sum.
            (The sum of the widths of its children)
    and write out a table with 'colspan' values
        either as a wiki table,
        or as HTML.
```

write a program in your language which translates your outline into a nested table, with WikiTable or HTML colspan values attached (where needed) to parent nodes in the nested table.

The WikiTable at the top of this page was generated from the indented outline shown above, producing the following markup string:

```
{| class="wikitable" style="text-align: center;"
|-
| style="background: #ffffe6; " colspan=7 | Display an outline as a nested table.
|-
| style="background: #ffebd2; " colspan=3 | Parse the outline to a tree,
| style="background: #f0fff0; " colspan=2 | count the leaves descending from each node,
| style="background: #e6ffff; " colspan=2 | and write out a table with 'colspan' values
|-
| style="background: #ffebd2; " | measuring the indent of each line,
| style="background: #ffebd2; " | translating the indentation to a nested structure,
| style="background: #ffebd2; " | and padding the tree to even depth.
| style="background: #f0fff0; " | defining the width of a leaf as 1,
| style="background: #f0fff0; " | and the width of a parent node as a sum.
| style="background: #e6ffff; " | either as a wiki table,
| style="background: #e6ffff; " | or as HTML.
|-
|  |
|  |
|  |
|  |
| style="background: #f0fff0; " | (The sum of the widths of its children)
|  |
|  |
|}
```

Extra credit

Use background color to distinguish the main stages of your outline, so that the subtree of each node at level two is consistently colored, and the edges between adjacent subtrees are immediately revealed.

Output

Display your nested table on this page.

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2019.07.1

Use a slightly more complicated outline than the task example to test some edge conditions. Limited to 10 direct subnodes on any one node as is. Easily adapted for larger if necessary.

Strictly speaking, this is not a nested table. It is just a single level table that has some column spans > 1. For an example of using actual nested tables, see the task entry: List\_authors\_of\_task\_descriptions#Raku, (and full output).

```
my $outline = q:to/END/;
    Display an outline as a nested table.
        Parse the outline to a tree,
            measuring the indent of each line,
            translating the indentation to a nested structure,
            and padding the tree to even depth.
        count the leaves descending from each node,
            defining the width of a leaf as 1,
            and the width of a parent node as a sum.
                (The sum of the widths of its children)
                Propagating the sums upward as necessary.
        and write out a table with 'colspan' values
            either as a wiki table,
            or as HTML.
        Optionally add color to the nodes.
    END

# Import outline paragraph into native data structure
sub import (Str $trees, $level = '  ') {
    my $forest;
    my $last = -Inf;

    for $trees.lines -> $branch {
        $branch ~~ / ($($level))* /;
        my $this = +$0;
        $forest ~= do {
            given $this cmp $last {
                when More { "\['{esc $branch.trim}', " }
                when Same { "'{esc $branch.trim}', " }
                when Less { "{']' x $last - $this}, '{esc $branch.trim}', " }
            }
        }
        $last = $this;
    }

    sub esc { $^s.subst( /(<['\\]>)/, -> $/ { "\\$0" }, :g) }

    $forest ~= ']' x 1 + $last;
    use MONKEY-SEE-NO-EVAL;
    $forest.EVAL;
}

my @AoA = import $outline, '    ';
my @layout;

# Collect information about node depth, position and children
{
    my @width = 0;
    my $depth = -1;
    @AoA.&insert;

    multi insert ($item) {
        @width[*-1]++;
        @layout.push: { :depth($depth.clone), :id(@width[*-1].clone), :text($item) };
    }

    multi insert (@array) {
        @width.push: @width[*-1] * 10;
        ++$depth;
        @array.map: &insert;
        --$depth;
        @width.pop;
    }
}

my $max-depth = @layout.max( *.<depth> )<depth>;

# Pad ragged nodes
for (^$max-depth) -> $d {
    my @nodes = @layout.grep( *.<depth> == $d );
    for @nodes.sort( +*.<id> ) -> $n {
        unless @layout.first( *.<id> == $n<id> ~ 1 ) {
            @layout.push: { :depth($n<depth> + 1), :id($n<id> *10 + 1), :text('') };
        }
    }
}

# Calculate spans (child nodes)
for (0..$max-depth).reverse -> $d {
    my @nodes = @layout.grep( *.<depth> == $d );
    for @nodes.sort( +*.<id> ) -> $n {
        my @span = @layout.grep: {.<depth> == $d + 1 && .<id>.starts-with: $n<id> };
        $n<span> = ( sum @span.map( { .<span> // 0} )) || +@span || 1;
    }
}

# Programatically assign colors
for (0..$max-depth) -> $d {
    my @nodes = @layout.grep( *.<depth> == $d );
    my $incr = 1 / (1 + @nodes);
    for @nodes.sort( +*.<id> ) -> $n {
        my $color = $d > 1 ??
        @layout.first( *.<id> eq $n<id>.chop )<color> !!
        "style=\"background: #" ~ hsv2rgb( ++$ * $incr, .1, 1) ~ '" ';
        $n<color> = $n<text> ?? $color !! '';
    }
}

# Generate wikitable
say '{| class="wikitable" style="text-align: center;"' ~ "\n" ~
(join "\n|-\n", (0..$max-depth).map: -> $d {
    my @nodes = @layout.grep( *.<depth> == $d );
    (join "\n", @nodes.sort( +*.<id> ).map( -> $node {
        '| ' ~
        ($node<color> // '' ) ~
        ($node<span> > 1 ?? "colspan=$node<span>" !! '' ) ~
        ' | ' ~ $node<text> }
    ))
}) ~ "\n|}";

say "\n\nSometimes it makes more sense to display an outline as...
well... as an outline, rather than as a table." ~ Q|¯\_(ツ)_/¯| ~ "\n";

{ ## Outline - Ordered List #######
    my @type = <upper-roman upper-latin decimal lower-latin lower-roman>;
    my $depth = 0;

    multi ol ($item) { "\<li>$item\n" }

    multi ol (@array) {
        my $li = $depth ?? "</li>" !! '';
        $depth++;
        my $list = "<ol style=\"list-style: {@type[$depth - 1]};\">\n" ~
        ( @array.map( &ol ).join ) ~ "</ol>$li\n";
        $depth--;
        $list
    }

    say "<div style=\"background: #fee;\">\n" ~ @AoA.&ol ~ "</div>";
}

sub hsv2rgb ( $h, $s, $v ){
    my $c = $v * $s;
    my $x = $c * (1 - abs( (($h*6) % 2) - 1 ) );
    my $m = $v - $c;
    my ($r, $g, $b) = do given $h {
        when   0..^(1/6) { $c, $x, 0 }
        when 1/6..^(1/3) { $x, $c, 0 }
        when 1/3..^(1/2) { 0, $c, $x }
        when 1/2..^(2/3) { 0, $x, $c }
        when 2/3..^(5/6) { $x, 0, $c }
        when 5/6..1      { $c, 0, $x }
    }
    ( $r, $g, $b ).map( ((*+$m) * 255).Int)».base(16).join
}

```

Output:

|  |  |  |  |  |  |  |  |  |
| --- | --- | --- | --- | --- | --- | --- | --- | --- |
| Display an outline as a nested table. | | | | | | | | |
| Parse the outline to a tree, | | | count the leaves descending from each node, | | | and write out a table with 'colspan' values | | Optionally add color to the nodes. |
| measuring the indent of each line, | translating the indentation to a nested structure, | and padding the tree to even depth. | defining the width of a leaf as 1, | and the width of a parent node as a sum. | | either as a wiki table, | or as HTML. |  |
|  |  |  |  | (The sum of the widths of its children) | Propagating the sums upward as necessary. |  |  |  |

Sometimes it makes more sense to display an outline as...
well... as an outline, rather than as a table.¯\\_(ツ)\_/¯

1. Display an outline as a nested table.
   1. Parse the outline to a tree,
      1. measuring the indent of each line,
      2. translating the indentation to a nested structure,
      3. and padding the tree to even depth.
   2. count the leaves descending from each node,
      1. defining the width of a leaf as 1,
      2. and the width of a parent node as a sum.
         1. (The sum of the widths of its children)
         2. Propagating the sums upward as necessary.
   3. and write out a table with 'colspan' values
      1. either as a wiki table,
      2. or as HTML.
   4. Optionally add color to the nodes.


[User]
It is very important in aviation to have knowledge of the nearby airports at any time in flight.

Task

Determine the distance and bearing from an Airplane to the 20 nearest Airports whenever requested.
Use the non-commercial data from openflights.org airports.dat as reference.

A request comes from an airplane at position ( latitude, longitude ): ( **51.514669, 2.198581** ).

Your report should contain the following information from table airports.dat (column shown in brackets):

Name(2), Country(4), ICAO(6), Distance and Bearing calculated from Latitude(7) and Longitude(8).

Distance is measured in nautical miles (NM). Resolution is 0.1 NM.

Bearing is measured in degrees (°). 0° = 360° = north then clockwise 90° = east, 180° = south, 270° = west. Resolution is 1°.

See
:   * openflights.org/data:  Airport, airline and route data
    * Movable Type Scripts:  Calculate distance, bearing and more between Latitude/Longitude points

[Assistant]
```
use Text::CSV;

constant $EARTH_RADIUS_IN_NAUTICAL_MILES = 6372.8 / 1.852;

sub degrees   ( Real $rad ) { $rad / tau * 360 }
sub radians   ( Real $deg ) { $deg * tau / 360 }
sub haversine ( Real $x   ) { ($x / 2).sin.²   }
sub arc_haver ( Real $x   ) { $x.sqrt.asin * 2 }

sub great_circle_distance ( \φ1, \λ1, \φ2, \λ2 ) {
    # https://en.wikipedia.org/wiki/Haversine_formula
    #   latitude (represented by φ) and longitude (represented by λ)
    #   hav(θ) = hav(φ₂ − φ₁) + cos(φ₁) cos(φ₂) hav(λ₂ − λ₁)
    arc_haver(
        haversine(φ2 - φ1)
      + haversine(λ2 - λ1) * cos(φ1) * cos(φ2)
    );
}

sub great_circle_bearing ( \φ1, \λ1, \φ2, \λ2 ) {
    atan2(                          φ2.cos * (λ2 - λ1).sin,
        φ1.cos * φ2.sin - φ1.sin * φ2.cos * (λ2 - λ1).cos,
    );
}

sub distance_and_bearing ( $lat1, $lon1, $lat2, $lon2 ) {
    my @ll = map &radians, $lat1, $lon1, $lat2, $lon2;

    my $dist  = great_circle_distance(|@ll);
    my $theta = great_circle_bearing( |@ll);

    return  $dist * $EARTH_RADIUS_IN_NAUTICAL_MILES,
            degrees( $theta + (tau if $theta < 0) )
}

sub find_nearest_airports ( $latitude, $longitude, $csv_path ) {
    my &d_and_b_from_here = &distance_and_bearing.assuming($latitude, $longitude);

    my @airports = csv(
        in => $csv_path,
        headers => [<ID Name City Country IATA ICAO Latitude Longitude>],
    );

    for @airports -> %row {
        %row<Distance Bearing> = d_and_b_from_here( +%row<Latitude>, +%row<Longitude> );
    }

    return @airports.sort(*.<Distance>);
}

sub MAIN ( $lat = 51.514669, $long = 2.198581, $wanted = 20, $csv = 'airports.dat' ) {
    printf "%7s\t%7s\t%-7s\t%-15s\t%s\n", <Dist Bear ICAO Country Name>;

    for find_nearest_airports($lat, $long, $csv).head($wanted) {
        printf "%7.1f\t    %03d\t%-7s\t%-15s\t%s\n",
            .<Distance Bearing ICAO Country Name>;
    }
}

```

Output:

```
   Dist	   Bear	ICAO   	Country        	Name
   30.7	    146	EBFN   	Belgium        	Koksijde Air Base
   31.3	    127	EBOS   	Belgium        	Ostend-Bruges International Airport
   33.6	    252	EGMH   	United Kingdom 	Kent International Airport
   34.4	    195	LFAC   	France         	Calais-Dunkerque Airport
   42.6	    105	EBKW   	Belgium        	Westkapelle heliport
   51.6	    240	EGMK   	United Kingdom 	Lympne Airport
   52.8	    114	EBUL   	Belgium        	Ursel Air Base
   56.2	    274	EGMC   	United Kingdom 	Southend Airport
   56.4	    162	LFQT   	France         	Merville-Calonne Airport
   56.5	    137	EBKT   	Belgium        	Wevelgem Airport
   57.3	    089	EHMZ   	Netherlands    	Midden-Zeeland Airport
   58.0	    235	EGMD   	United Kingdom 	Lydd Airport
   59.0	    309	EGUW   	United Kingdom 	RAF Wattisham
   59.3	    339	EGSM   	United Kingdom 	Beccles Airport
   59.7	    146	LFQO   	France         	Lille/Marcq-en-Baroeul Airport
   62.2	    250	EGKH   	United Kingdom 	Lashenden (Headcorn) Airfield
   63.7	    200	LFAT   	France         	Le Touquet-Côte d'Opale Airport
   64.2	    261	EGTO   	United Kingdom 	Rochester Airport
   66.3	    149	LFQQ   	France         	Lille-Lesquin Airport
   68.4	    271	EGMT   	United Kingdom 	Thurrock Airfield
```


[User]
Find all distinct palindromes contained as substrings in decimal representation of n. Note that for the
purpose of the initial function, a single digit will be considered a palindrome.

Task

1. Find all the palindromes including single digits in the integers from 100 to 125, inclusive.
2. Determine which if any of the following decimal integers contain palindromes of 2 digits or more:

```
 9, 169, 12769, 1238769, 123498769, 12346098769, 1234572098769,
 123456832098769, 12345679432098769, 1234567905432098769, 123456790165432098769,
 83071934127905179083, 1320267947849490361205695

```

Also see
:   * OEIS entry:   A262188 (Task 1).
    * OEIS entry:   A151997 (Task 2).

Related tasks

Palindrome\_detection
Longest\_palindromic\_substrings
N\_1's\_followed\_by\_a\_3

[Assistant]
A minor modification of the Longest palindromic substrings task. As such, works for any string, not just integers.

```
use Sort::Naturally;

sub getpal ($str) {
    my @chars = $str.comb;
    my @pal = flat @chars,
    (1 ..^ @chars).map: -> \idx {
        my @s;
        for 1, 2 {
           my int ($rev, $fwd) = $_, 1;
           loop {
                quietly last if ($rev > idx) || (@chars[idx - $rev] ne @chars[idx + $fwd]);
                $rev = $rev + 1;
                $fwd = $fwd + 1;
            }
            @s.push: @chars[idx - $rev ^..^ idx + $fwd].join if $rev + $fwd > 2;
            last if @chars[idx - 1] ne @chars[idx];
        }
        next unless +@s;
        @s
    }
    @pal.unique.sort({.chars, .&naturally});
}

say 'All palindromic substrings including (bizarrely enough) single characters:';
put "$_ => ", getpal $_ for 100..125;
put "\nDo these strings contain a minimum two character palindrome?";
printf "%25s => %s\n", $_, getpal($_).tail.chars > 1 for flat
    9, 169, 12769, 1238769, 123498769, 12346098769, 1234572098769,
    123456832098769, 12345679432098769, 1234567905432098769,
    123456790165432098769, 83071934127905179083, 1320267947849490361205695,
    <Do these strings contain a minimum two character palindrome?>

```

Output:

```
All palindromic substrings including (bizarrely enough) single characters:
100 => 0 1 00
101 => 0 1 101
102 => 0 1 2
103 => 0 1 3
104 => 0 1 4
105 => 0 1 5
106 => 0 1 6
107 => 0 1 7
108 => 0 1 8
109 => 0 1 9
110 => 0 1 11
111 => 1 11 111
112 => 1 2 11
113 => 1 3 11
114 => 1 4 11
115 => 1 5 11
116 => 1 6 11
117 => 1 7 11
118 => 1 8 11
119 => 1 9 11
120 => 0 1 2
121 => 1 2 121
122 => 1 2 22
123 => 1 2 3
124 => 1 2 4
125 => 1 2 5

Do these strings contain a minimum two character palindrome?
                        9 => False
                      169 => False
                    12769 => False
                  1238769 => False
                123498769 => False
              12346098769 => False
            1234572098769 => False
          123456832098769 => False
        12345679432098769 => False
      1234567905432098769 => False
    123456790165432098769 => False
     83071934127905179083 => False
1320267947849490361205695 => True
                       Do => False
                    these => True
                  strings => False
                  contain => False
                        a => False
                  minimum => True
                      two => False
                character => True
              palindrome? => False
```


[User]
Task

Compute all combinations of

a

b
{\displaystyle {\displaystyle a^{b}}}
 where a and b are integers between 2 and 5 inclusive.

Place them in numerical order, with any repeats removed.

You should get the following sequence of 15 distinct terms:

4, 8, 9, 16, 25, 27, 32, 64, 81, 125, 243, 256, 625, 1024, 3125

[Assistant]
```
put squish sort [X**] (2..5) xx 2;

```

Output:

```
4 8 9 16 25 27 32 64 81 125 243 256 625 1024 3125
```


[User]
Write two programs (or one program with two modes) which run on networked computers, and send some messages between them.

The protocol used may be language-specific or not, and should be **suitable for general distributed programming**; that is, the *protocol* should be generic (not designed just for the particular example application), readily capable of handling the independent communications of many different components of a single application, and the transferring of arbitrary data structures natural for the language.

This task is intended to demonstrate high-level communication facilities beyond just creating sockets.

[Assistant]
(formerly Perl 6)

Server listens for JSON encoded messages. It processes requests for set|get|dump. 'set' stores a message, 'get' returns message, 'dump' returns all stored messages. Optional parameters for ip address and port.

Server.raku:

```
./server.raku --usage
Usage:
  server.p6 [--server=<Any>] [--port=<Any>]
```

```
#!/usr/bin/env raku
use JSON::Fast ;
sub MAIN( :$server='0.0.0.0' , :$port=3333 ) {
  my %db ;
  react {
    whenever IO::Socket::Async.listen( $server , $port ) -> $conn {
        whenever $conn.Supply.lines -> $line {
            my %response = 'status' => '' ;
            my $msg = from-json $line ;
            say $msg.raku;
            given $msg{"function"} {
                when 'set' {
                    %db{ $msg<topic> } = $msg<message> ;
                    %response<status> = 'ok' ;
                }
                when 'get' {
                    %response<topic> = $msg<topic> ;
                    %response<message> = %db{ $msg<topic> } ;
                    %response<status> = 'ok' ;
                }
                when 'dump' {
                    %response = %db ;
                }
                when 'delete' {
                    %db{ $msg<topic> }:delete;
                    %response<status> = 'ok' ;
                }
            }
            $conn.print( to-json(%response, :!pretty) ~ "\n" ) ;
            LAST { $conn.close ; }
            QUIT { default { $conn.close ; say "oh no, $_";}}
            CATCH { default { say .^name, ': ', .Str ,  " handled in $?LINE";}}
        }
    }
  }
}

```

client.raku:

```
Usage:
  client.raku [--server=<Any>] [--port=<Any>] [--json=<Any>] set <topic> [<message>]
  client.raku [--server=<Any>] [--port=<Any>] get <topic>
  client.raku [--server=<Any>] [--port=<Any>] dump
```

```
#!/usr/bin/env raku
use JSON::Fast ;
multi MAIN('set', $topic,  $message='', :$server='localhost', :$port='3333', :$json='') {
    my %msg = function => 'set' , topic=> $topic , message=> $message ;
    %msg{"message"} = from-json( $json ) if $json ;
    sendmsg( %msg , $server, $port) ;
}
multi MAIN('get', $topic, :$server='localhost', :$port='3333') {
    my %msg = function => 'get' , topic=> $topic ;
    sendmsg( %msg , $server, $port) ;
}
multi MAIN('delete', $topic, :$server='localhost', :$port='3333') {
    my %msg = function => 'delete' , topic=> $topic ;
    sendmsg( %msg , $server, $port) ;
}
multi MAIN('dump', :$server='localhost', :$port='3333') {
    my %msg = function => 'dump'  ;
    sendmsg( %msg , $server, $port) ;
}
sub sendmsg( %msg , $server, $port){
    my $conn = await IO::Socket::Async.connect( $server , $port );
    $conn.print: to-json( %msg,:!pretty)~"\n";
    react {
        whenever $conn.Supply -> $data {
            print $data;
            $conn.close;
        }
    }
}

```

examples:

```
echo '{"function":"set","topic":"push","message":["perl5","raku","rakudo"]}' | nc localhost 3333

./client.raku set version raku
{"status": "ok"}
./client.raku get version
{"status": "ok","topic": "version","message": "raku"}
./client.raku --json='["one","two","three"]' set mylist
{"status": "ok"}
./client.raku dump
{"push": ["perl5","raku","rakudo"],"version": "raku","mylist": ["one","two","three"]}
./client.raku delete version
{"status": "ok"}

server output:
${:function("set"), :message($["perl5", "raku", "rakudo"]), :topic("push")}
${:function("set"), :message("raku"), :topic("version")}
${:function("get"), :topic("version")}
${:function("set"), :message($["one", "two", "three"]), :topic("mylist")}
${:function("dump")}
${:function("delete"), :topic("version")}
```


[User]
Large Factorials and the Distribution of '0' in base 10 digits.

About the task

We can see that some features of factorial numbers (the series of numbers 1!, 2!, 3!, ...)
come about because such numbers are the product of a series of counting numbers, and so those
products have predictable factors. For example, all factorials above 1! are even numbers,
since they have 2 as a factor. Similarly, all factorials from 5! up end in a 0, because they
have 5 and 2 as factors, and thus have 10 as a factor. In fact, the factorial integers add
another 0 at the end of the factorial for every step of 5 upward: 5! = 120, 10! = 3628800,
15! = 1307674368000, 16! = 20922789888000 and so on.

Because factorial numbers, which quickly become quite large, continue to have another terminal 0
on the right hand side of the number for every factor of 5 added to the factorial product, one might
think that the proportion of zeros in a base 10 factorial number might be close to 1/5. However,
though the factorial products add another terminating 0 every factor of 5 multiplied into the product,
as the numbers become quite large, the number of digits in the factorial product expands exponentially,
and so the number above the terminating zeros tends toward 10% of each digit from 0 to 1 as the factorial
becomes larger. Thus, as the factorials become larger, the proportion of 0 digits in the factorial products
shifts slowly from around 1/5 toward 1/10, since the number of terminating zeros in n! increases only in
proportion to n, whereas the number of digits of n! in base 10 increases exponentially.

The task

Create a function to calculate the mean of the proportions of 0 digits out of the total digits found in each factorial
product from 1! to N!. This proportion of 0 digits in base 10 should be calculated using the number as printed as a base 10 integer.

Example: for 1 to 6 we have 1!, 2!, 3!, 4!, 5!, 6!, or (1, 2, 6, 24, 120, 720), so we need the mean of
(0/1, 0/1, 0/1, 0/2, 1/3, 1/3) = (2/3) (totals of each proportion) / 6 (= N), or 0.1111111...

Example: for 1 to 25 the mean of the proportions of 0 digits in the factorial products series of N! with N from 1 to 25 is 0.26787.

Do this task for 1 to N where N is in (100, 1000, and 10000), so, compute the mean of the proportion of 0 digits for each product
in the series of each of the factorials from 1 to 100, 1 to 1000, and 1 to 10000.

Stretch task

Find the N in 10000 < N < 50000 where the mean of the proportions of 0 digits in the factorial products from 1 to N
permanently falls below 0.16. This task took many hours in the Python example, though I wonder if there is a faster
algorithm out there.

[Assistant]
Works, but depressingly slow for 10000.

```
sub postfix:<!> (Int $n) { ( constant factorial = 1, 1, |[\*] 2..* )[$n] }
sink 10000!; # prime the iterator to allow multithreading

sub zs ($n) { ( constant zero-share = (^Inf).race(:32batch).map: { (.!.comb.Bag){'0'} / .!.chars } )[$n+1] }

.say for (
     100
    ,1000
    ,10000
).map:  -> \n { "{n}: {([+] (^n).map: *.&zs) / n}" }

```

Output:

```
100: 0.24675318616743216
1000: 0.20354455110316458
10000: 0.17300384824186605

```


[User]
The   *wisdom of the crowd*   is the collective opinion of a group of individuals rather than that of a single expert.

Wisdom-of-the-crowds research routinely attributes the superiority of crowd averages over individual judgments to the elimination of individual noise,   an explanation that assumes independence of the individual judgments from each other.

Thus the crowd tends to make its best decisions if it is made up of diverse opinions and ideologies.

Scott E. Page introduced the diversity prediction theorem:

:   *The squared error of the collective prediction equals the average squared error minus the predictive diversity*.

Therefore,   when the diversity in a group is large,   the error of the crowd is small.

Definitions
:   :   * Average Individual Error:   Average of the individual squared errors
        * Collective Error:   Squared error of the collective prediction
        * Prediction Diversity:   Average squared distance from the individual predictions to the collective prediction
        * Diversity Prediction Theorem:   *Given a crowd of predictive models*,     then

        :   :   :   :   Collective Error   =   Average Individual Error   ─   Prediction Diversity

Task

For a given   true   value and a number of number of estimates (from a crowd),   show   (here on this page):

:   :   :   * the true value   and   the crowd estimates
            * the average error
            * the crowd error
            * the prediction diversity

Use   (at least)   these two examples:

:   :   :   * a true value of   **49**   with crowd estimates of:    **48   47   51**
            * a true value of   **49**   with crowd estimates of:    **48   47   51   42**

Also see
:   * Wikipedia entry:   Wisdom of the crowd
    * University of Michigan: PDF paper         (exists on a web archive,   the *Wayback Machine*).

[Assistant]
(formerly Perl 6)

```
sub diversity-calc($truth, @pred) {
    my $ae = avg-error($truth, @pred); # average individual error
    my $cp = ([+] @pred)/+@pred;       # collective prediction
    my $ce = ($cp - $truth)**2;        # collective error
    my $pd = avg-error($cp, @pred);    # prediction diversity
    return $ae, $ce, $pd;
}

sub avg-error ($m, @v) { ([+] (@v X- $m) X**2) / +@v }

sub diversity-format (@stats) {
    gather {
        for <average-error crowd-error diversity> Z @stats -> ($label,$value) {
            take $label.fmt("%13s") ~ ':' ~ $value.fmt("%7.3f");
        }
    }
}

.say for diversity-format diversity-calc(49, <48 47 51>);
.say for diversity-format diversity-calc(49, <48 47 51 42>);

```

Output:

```
average-error:  3.000
  crowd-error:  0.111
    diversity:  2.889
average-error: 14.500
  crowd-error:  4.000
    diversity: 10.500

```


[User]
Given the coordinates of a rectangle and a number, cut the rectangle into that
number of random, non-similar triangles that exactly cover the rectangle without
gaps or overlaps.

The number of triangles may have reasonable limits such as being above a small
limit, and/or odd or even, and/or prime for example.
The number should not have an upper bound however, so that many triangles can be generated.

* Explain, or refer to the algorithm employed.
* Give a sample of sets of triangles produced from running the algorithm, on this page.

[Assistant]
The first triangle bisects the rectangle via the diagonal. The rest of them all got one vertex at the origin and a side defined by ratios of numbers from a descending positive integer sequence.

```
# 20220123 Raku programming solution

# Proof :
#
#    H-----------A---------B-------C-----D---E
#    |                                       |
#    |                                       |
#    |                                       |
#    O---------------------------------------L
#
#    ▲OEL is unique as its area is the sum of the rest.
#
#    and also in terms of area ▲OHA > ▲OAB > ... > ▲ODE

sub UnequalDivider (\L,\H,\N where N > 2) {

   my \sum = $ = 0 ; my \part = $ = 0 ; my @sequence = (N^...1) ;

   loop {                                               #   if  ▲OHA ~ ▲OEL
      sum  = @sequence.sum;                             #   increase 1st term
      @sequence[0]*L*L/sum == H*H ?? (@sequence[0] +=1) !! last
   }

   (  [ (0,0), (L,H), (L,0) ],  ).Array.append: @sequence.map: -> \chunk {
      [ (0,0), (L*part/sum,H), (L*(part+=chunk)/sum,H) ] ;
   }
}

.say for UnequalDivider(1000,500,5);

```

Output:

```
[(0 0) (1000 500) (1000 0)]
[(0 0) (0 500) (400 500)]
[(0 0) (400 500) (700 500)]
[(0 0) (700 500) (900 500)]
[(0 0) (900 500) (1000 500)]

```


[User]
DNS is an internet service that maps domain names, like `rosettacode.org`, to IP addresses, like `66.220.0.231`.

Use DNS to resolve `www.kame.net` to both IPv4 and IPv6 addresses. Print these addresses.

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2017.01

```
use Net::DNS;

my $resolver = Net::DNS.new('8.8.8.8');

my $ip4 = $resolver.lookup('A',    'orange.kame.net');
my $ip6 = $resolver.lookup('AAAA', 'orange.kame.net');

say $ip4[0].octets.join: '.';
say $ip6[0].octets.».fmt("%.2X").join.comb(4).join: ':';

```

Output:

```
203.178.141.194
2001:0200:0dff:fff1:0216:3eff:feb1:44d7
```


[User]
Show how to insert documentation for classes, functions, and/or variables in your language. If this documentation is built-in to the language, note it. If this documentation requires external tools, note them.

See also

* Related task: Comments
* Related task: Here\_document

[Assistant]
(formerly Perl 6)
Similarly to Perl 5, Raku is documented using Pod (a redesigned version of POD). However, it's not simply ignored by the parser as in Perl 5, it's an internal part of the language spec and can be used to attach documentation objects to almost any part of the code.

```
#= it's yellow
sub marine { ... }
say &marine.WHY; # "it's yellow"

#= a shaggy little thing
class Sheep {
    #= not too scary
    method roar { 'roar!' }
}
say Sheep.WHY; # "a shaggy little thing"
say Sheep.^find_method('roar').WHY; # "not too scary"

```

A compiler has a built-in `--doc` switch that will generate documentation from a given source file. An output format can be specified in the switch. For example, `--doc=Markdown` will generate Markdown from Pod provided that the `Pod::To::Markdown` is installed.


[User]
Warning: If you are looking for pizza delivery you have come to the wrong page. Bloody Google (other search engines are available).

Take a box of dominoes give them a good shuffle and then arrange them in diverse orientations such that they form a rectangle with 7 rows of 8 columns. Make a tableau of the face values e.g.

```
       05132231
       05505246
       43036620
       06235126
       11300245
       21433466
       64515414

```

Now torment your computer by making it identify where each domino is.

Do this for the above tableau and one of your own construction.

Extra credit:

How many ways are there to arrange dominoes in an 8x7 rectangle, first ignoring their values, then considering their values, and finally considering values but ignoring value symmetry, i.e. transposing 5 and 4.

[Assistant]
```
sub domino (Str $s) { $s.comb.sort.join }

sub solve ( UInt $rows, UInt $cols, @tab ) {
    die unless @tab.elems == $rows*$cols;
    die unless @tab.elems %% 2;

    my @orientations = 'A' xx @tab.elems; # [A]vailable,[R]ight,[D]own,[L]eft,[U]p

    my SetHash $hand .= new: map &domino, [X~] @tab.unique xx 2;

    return gather {
        my sub place_domino_at_first_available_after ( UInt $pos_last = 0 ) {
            my $p1 = $pos_last + @orientations.skip($pos_last).first(:k, 'A');

            for (False, $p1+1    , <L R>),
                (True , $p1+$cols, <D U>) -> ($is_down, $p2, @two_letters) {

                next if $p2 > @tab.end or (!$is_down && $p2 %% $cols); # Board boundaries.

                my @two_cells := @orientations[$p1, $p2]; # Bind to candidate location

                next if @two_cells !eqv <A A>; # Both cells must be available for placement.

                my $dom = domino( @tab[$p1, $p2].join );

                $hand{$dom}-- or next;          # Take domino from hand, iff present
                @two_cells = @two_letters;      # Assign placement

                # Either the solution is complete, or we must recurse.
                if !$hand { take @orientations.clone }
                else      { place_domino_at_first_available_after($p1) }

                @two_cells = <A A>;             # Unassign placement
                $hand{$dom}++;                  # Restore domino into hand
            }
        }
        place_domino_at_first_available_after();
    }
}
sub bonus ( UInt $rows, UInt $cols ) {
    die "Both are odd, so no tiling possible" if $rows !%% 2 and $cols !%% 2;

    my $half = $rows * $cols div 2;

    my sub T ($N) { map { ( pi * $_/($N+1) ).cos² * 4 }, 1..($N/2).ceiling }

    my $arrangements = [*] T($rows) X+ T($cols);
    my $flips        =     2 ** $half;
    my $permutations = [*] 1 .. $half;
    my $product      = [*] ($arrangements, $flips, $permutations);
    return :$arrangements, :$flips, :$permutations, :$product;
}
my @tests =
    (7, 8, '05132231055052464303662006235126113002452143346664515414'),
    (7, 8, '64220650162341432102355113505610426040114420536366525334'),
    (3, 4, '001102221201'),
;
sub solution_works ( UInt $rows, UInt $cols, @tab, @sol --> Bool ) {
    die unless @sol.all eq <L R U D>.any;
    my BagHash $b .= new;
    for @sol.keys -> $p1 {
        given @sol[$p1] {
            when 'L' { my $p2 = $p1+1;     die unless @sol[$p2] eq 'R'; $b{ domino( @tab[$p1,$p2].join ) }++; }
            when 'D' { my $p2 = $p1+$cols; die unless @sol[$p2] eq 'U'; $b{ domino( @tab[$p1,$p2].join ) }++; }
        }
    }
    die unless $b.values.max == 1 and $b.elems == $rows * $cols / 2;
    return True;
}
for @tests -> ( $rows, $cols, $flat_table ) {
    my @solutions = solve($rows, $cols, $flat_table.comb);
    say 'Solutions found: ', +@solutions;

    # Confirm that every solution is valid.
    solution_works($rows, $cols, $flat_table.comb, $_) or die for @solutions;

    # Print first solution
    say .join.trans( [<L R D U>] => [<╼ ╾ ╽ ╿>]) for @solutions[0].batch($cols);

    if ++$ == 1 {
        say 'Bonus:';
        say .value.fmt("%45d "), .key.tclc for bonus($rows, $cols);
        say '';
    }
}

```

Output:

```
Solutions found: 1
╼╾╼╾╽╼╾╽
╽╼╾╽╿╼╾╿
╿╽╽╿╼╾╽╽
╽╿╿╼╾╽╿╿
╿╽╽╼╾╿╽╽
╽╿╿╼╾╽╿╿
╿╼╾╼╾╿╼╾
Bonus:
                                      1292697 Arrangements
                                    268435456 Flips
               304888344611713860501504000000 Permutations
105797996085635619122449324709940305294524416 Product

Solutions found: 2025
╼╾╼╾╼╾╽╽
╼╾╼╾╼╾╿╿
╼╾╼╾╼╾╼╾
╼╾╼╾╼╾╼╾
╼╾╽╽╼╾╼╾
╼╾╿╿╽╼╾╽
╼╾╼╾╿╼╾╿
Solutions found: 4
╼╾╼╾
╼╾╼╾
╼╾╼╾

```


[User]
About the task

John Conway (1937-2020), was a mathematician who also invented several mathematically
oriented computer pastimes, such as the famous Game of Life cellular automaton program.
Dr. Conway invented a simple algorithm for finding the day of the week, given any date.
The algorithm was based on calculating the distance of a given date from certain
"anchor days" which follow a pattern for the day of the week upon which they fall.

Algorithm

The formula is calculated assuming that Sunday is 0, Monday 1, and so forth with Saturday 7, and

```
   doomsday = (Tuesday(or 2) + 5(y mod 4) + 4(y mod 100) + 6(y mod 400)) % 7

```

which, for 2021, is 0 (Sunday).

To calculate the day of the week, we then count days from a close doomsday,
with these as charted here by month, then add the doomsday for the year,
then get the remainder after dividing by 7. This should give us the number
corresponding to the day of the week for that date.

```
   Month	        Doomsday Dates for Month
   --------------------------------------------
   January (common years)   3, 10, 17, 24, 31
   January (leap years)     4, 11, 18, 25
   February (common years)  7, 14, 21, 28
   February (leap years)    1, 8, 15, 22, 29
   March                    7, 14, 21, 28
   April                    4, 11, 18, 25
   May                      2, 9, 16, 23, 30
   June                     6, 13, 20, 27
   July                     4, 11, 18, 25
   August                   1, 8, 15, 22, 29
   September                5, 12, 19, 26
   October                  3, 10, 17, 24, 31
   November                 7, 14, 21, 28
   December                 5, 12, 19, 26

```

Task

Given the following dates:

* 1800-01-06 (January 6, 1800)
* 1875-03-29 (March 29, 1875)
* 1915-12-07 (December 7, 1915)
* 1970-12-23 (December 23, 1970)
* 2043-05-14 (May 14, 2043)
* 2077-02-12 (February 12, 2077)
* 2101-04-02 (April 2, 2101)

Use Conway's Doomsday rule to calculate the day of the week for each date.

see also

* Doomsday rule
* Tomorrow is the Day After Doomsday (p.28)

[Assistant]
```
my @dow = < Sunday Monday Tuesday Wednesday Thursday Friday Saturday >;

my %doomsday = False => [3,7,7,4,2,6,4,1,5,3,7,5], True => [4,1,7,4,2,6,4,1,5,3,7,5];

sub conway ($date) {
    my ($year, $month, $day) = $date.comb(/\d+/)».Int;
    my $is-leap = ($year %% 4) && (($year % 100) || ($year %% 400));

    my $c = $year div 100;
    my $s = ($year % 100) div 12;
    my $t = ($year % 100)   % 12;
    my $a = ( 5 * ($c % 4) + 2 ) % 7;
    my $b = ( $s + $t + ($t div 4) + $a ) % 7;

    ($b + $day - %doomsday{$is-leap}[$month - 1] + 7) % 7
}

for < 1800-01-06 1875-03-29 1915-12-07 1970-12-23 2043-05-14 2077-02-12 2101-04-02 >
{
    say "Conway  - $_ is a: ", @dow[.&conway];
    # Or, we could use the method built into the compiler...
    say "Builtin - $_ is a: ", @dow[Date.new($_).day-of-week];
    say '';
}

```

Output:

```
Conway  - 1800-01-06 is a: Monday
Builtin - 1800-01-06 is a: Monday

Conway  - 1875-03-29 is a: Monday
Builtin - 1875-03-29 is a: Monday

Conway  - 1915-12-07 is a: Tuesday
Builtin - 1915-12-07 is a: Tuesday

Conway  - 1970-12-23 is a: Wednesday
Builtin - 1970-12-23 is a: Wednesday

Conway  - 2043-05-14 is a: Thursday
Builtin - 2043-05-14 is a: Thursday

Conway  - 2077-02-12 is a: Friday
Builtin - 2077-02-12 is a: Friday

Conway  - 2101-04-02 is a: Saturday
Builtin - 2101-04-02 is a: Saturday

```


[User]
Task

Create a function/use an in-built function, to compute the   **dot product**,   also known as the   **scalar product**   of two vectors.

If possible, make the vectors of arbitrary length.

As an example, compute the dot product of the vectors:

:   :   :   :   `[1,  3, -5]`       and
            :   `[4, -2, -1]`

If implementing the dot product of two vectors directly:

:   :   :   * each vector must be the same length
            * multiply corresponding terms from each vector
            * sum the products   (to produce the answer)

Related task

* Vector products

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2010.07

We use the square-bracket meta-operator to turn the infix operator `+` into a reducing list operator, and the guillemet meta-operator to vectorize the infix operator `*`. Length validation is automatic in this form.

```
sub infix:<·> { [+] @^a »*« @^b }

say (1, 3, 5)·(4, -2, 1);
```


[User]
**Definition**

Let (p1,p2) and (p3,p4) be twin primes where p3 - p2 = 4.

Such primes called **Double Twin Primes**

**Example**

[5,7,11,13]

**Task**

Find and show here all Double Twin Primes under 1000.

See also
:   * OEIS:A007530
    * Wikipedia:Prime\_k-tuple

[Assistant]
Cousin twin primes:

```
sub dt { $^p, $p+2, $p+6, $p+8 }
.&dt.say for (^1000).grep: { all .&dt».is-prime };

```

Output:

```
(5 7 11 13)
(11 13 17 19)
(101 103 107 109)
(191 193 197 199)
(821 823 827 829)
```


[User]
Define the data structure for a complete Doubly Linked List.

* The structure should support adding elements to the head, tail and middle of the list.
* The structure should not allow circular loops

See also

* Array
* Associative array: Creation, Iteration
* Collections
* Compound data type
* Doubly-linked list: Definition, Element definition, Element insertion, List Traversal, Element Removal
* Linked list
* Queue: Definition, Usage
* Set
* Singly-linked list: Element definition, Element insertion, List Traversal, Element Removal
* Stack

[Assistant]
(formerly Perl 6)
This shows a complete example. (Other entries in the section focus on aspects of this solution.)

```
role DLElem[::T] {
    has DLElem[T] $.prev is rw;
    has DLElem[T] $.next is rw;
    has T $.payload = T;

    method pre-insert(T $payload) {
	die "Can't insert before beginning" unless $!prev;
	my $elem = ::?CLASS.new(:$payload);
	$!prev.next = $elem;
	$elem.prev = $!prev;
	$elem.next = self;
	$!prev = $elem;
	$elem;
    }

    method post-insert(T $payload) {
	die "Can't insert after end" unless $!next;
	my $elem = ::?CLASS.new(:$payload);
	$!next.prev = $elem;
	$elem.next = $!next;
	$elem.prev = self;
	$!next = $elem;
	$elem;
    }

    method delete {
	die "Can't delete a sentinel" unless $!prev and $!next;
	$!next.prev = $!prev;
	$!prev.next = $!next;	# conveniently returns next element
    }
}

role DLList[::DLE] {
    has DLE $.first;
    has DLE $.last;

    submethod BUILD {
	$!first = DLE.new;
	$!last = DLE.new;
	$!first.next = $!last;
	$!last.prev = $!first;
    }

    method list { ($!first.next, *.next ...^ !*.next).map: *.payload }
    method reverse { ($!last.prev, *.prev ...^ !*.prev).map: *.payload }
}

class DLElem_Int does DLElem[Int] {}
class DLList_Int does DLList[DLElem_Int] {}

my $dll = DLList_Int.new;

$dll.first.post-insert(1).post-insert(2).post-insert(3);
$dll.first.post-insert(0);

$dll.last.pre-insert(41).pre-insert(40).prev.delete;  # (deletes 3)
$dll.last.pre-insert(42);

say $dll.list;     # 0 1 2 40 41 42
say $dll.reverse;  # 42 41 40 2 1 0

```

Output:

```
0 1 2 40 41 42
42 41 40 2 1 0
```


[User]
Task

Define the data structure for a doubly-linked list element.

The element should include a data member to hold its value and pointers to both the next element in the list and the previous element in the list.

The pointers should be mutable.

See also

* Array
* Associative array: Creation, Iteration
* Collections
* Compound data type
* Doubly-linked list: Definition, Element definition, Element insertion, List Traversal, Element Removal
* Linked list
* Queue: Definition, Usage
* Set
* Singly-linked list: Element definition, Element insertion, List Traversal, Element Removal
* Stack

[Assistant]
(formerly Perl 6)

```
role DLElem[::T] {
    has DLElem[T] $.prev is rw;
    has DLElem[T] $.next is rw;
    has T $.payload = T;

    method pre-insert(T $payload) {
        die "Can't insert before beginning" unless $!prev;
        my $elem = ::?CLASS.new(:$payload);
        $!prev.next = $elem;
        $elem.prev = $!prev;
        $elem.next = self;
        $!prev = $elem;
        $elem;
    }

    method post-insert(T $payload) {
        die "Can't insert after end" unless $!next;
        my $elem = ::?CLASS.new(:$payload);
        $!next.prev = $elem;
        $elem.next = $!next;
        $elem.prev = self;
        $!next = $elem;
        $elem;
    }

    method delete {
        die "Can't delete a sentinel" unless $!prev and $!next;
        $!next.prev = $!prev;
        $!prev.next = $!next;   # conveniently returns next element
    }
}

```


[User]
Use the link structure defined in Doubly-Linked List (element) to define a procedure for inserting a link into a doubly-linked list. Call this procedure to insert element C into a list {A,B}, between elements A and B.

This is much like inserting into a Singly-Linked List, but with added assignments so that the backwards-pointing links remain correct.

See also

* Array
* Associative array: Creation, Iteration
* Collections
* Compound data type
* Doubly-linked list: Definition, Element definition, Element insertion, List Traversal, Element Removal
* Linked list
* Queue: Definition, Usage
* Set
* Singly-linked list: Element definition, Element insertion, List Traversal, Element Removal
* Stack

[Assistant]
(formerly Perl 6)

Using the generic definitions from Doubly-linked\_list/Definition#Raku:

```
role DLElem[::T] {
    has DLElem[T] $.prev is rw;
    has DLElem[T] $.next is rw;
    has T $.payload = T;

    method pre-insert(T $payload) {
        die "Can't insert before beginning" unless $!prev;
        my $elem = ::?CLASS.new(:$payload);
        $!prev.next = $elem;
        $elem.prev = $!prev;
        $elem.next = self;
        $!prev = $elem;
        $elem;
    }

    method post-insert(T $payload) {
        die "Can't insert after end" unless $!next;
        my $elem = ::?CLASS.new(:$payload);
        $!next.prev = $elem;
        $elem.next = $!next;
        $elem.prev = self;
        $!next = $elem;
        $elem;
    }

    method delete {
        die "Can't delete a sentinel" unless $!prev and $!next;
        $!next.prev = $!prev;
        $!prev.next = $!next;   # conveniently returns next element
    }
}

role DLList[::DLE] {
    has DLE $.first;
    has DLE $.last;

    submethod BUILD {
	$!first = DLE.new;
	$!last = DLE.new;
	$!first.next = $!last;
	$!last.prev = $!first;
    }

    method list { ($!first.next, *.next ...^ !*.next).map: *.payload }
    method reverse { ($!last.prev, *.prev ...^ !*.prev).map: *.payload }
}

class DLElem_Str does DLElem[Str] {}
class DLList_Str does DLList[DLElem_Str] {}

my $sdll = DLList_Str.new;
my $b = $sdll.first.post-insert('A').post-insert('B');
$b.pre-insert('C');
say $sdll.list;  # A C B

```

Output:

```
A C B
```


[User]
Task

Define a method to remove an element from a doubly-linked list and demonstrate its use.

You may wish to use the list element defined in Doubly-Linked List (element) for the purposes of this task.

[Assistant] Already implemented and demonstrated as part of Doubly-linked\_list/Definition#Raku. Not going to duplicate the entire entry from there to here.


[User]
Traverse from the beginning of a doubly-linked list to the end, and from the end to the beginning.

See also

* Array
* Associative array: Creation, Iteration
* Collections
* Compound data type
* Doubly-linked list: Definition, Element definition, Element insertion, List Traversal, Element Removal
* Linked list
* Queue: Definition, Usage
* Set
* Singly-linked list: Element definition, Element insertion, List Traversal, Element Removal
* Stack

[Assistant]
(formerly Perl 6)

Since the list routines are supplied by the generic roles defined in Doubly-linked\_list/Definition#Raku, it suffices to say:

```
say $dll.list;
say $dll.reverse;

```

These automatically return just the payloads, hiding the elements containing the forward and backward pointers.


[User]
Create and display a dragon curve fractal.

(You may either display the curve directly or write it to an image file.)

Algorithms

Here are some brief notes the algorithms used and how they might suit various languages.

* Recursively a right curling dragon is a right dragon followed by a left dragon, at 90-degree angle. And a left dragon is a left followed by a right.

```
*---R----*     expands to     *       *
                               \     /
                                R   L
                                 \ /
                                  *

                                  *
                                 / \
                                L   R
                               /     \
*---L---*      expands to     *       *
```

:   The co-routines `dcl` and `dcr` in various examples do this recursively to a desired expansion level.

* The curl direction right or left can be a parameter instead of two separate routines.

* Recursively, a curl direction can be eliminated by noting the dragon consists of two copies of itself drawn towards a central point at 45-degrees.

```
*------->*   becomes    *       *     Recursive copies drawn
                         \     /      from the ends towards
                          \   /       the centre.
                           v v
                            *
```

:   This can be seen in the SVG example. This is best suited to off-line drawing since the reversal in the second half means the drawing jumps backward and forward (in binary reflected Gray code order) which is not very good for a plotter or for drawing progressively on screen.

* Successive approximation repeatedly re-writes each straight line as two new segments at a right angle,

```
                       *
*-----*   becomes     / \      bend to left
                     /   \     if N odd
                    *     *

                    *     *
*-----*   becomes    \   /     bend to right
                      \ /      if N even
                       *
```

:   Numbering from the start of the curve built so far, if the segment is at an odd position then the bend introduced is on the right side. If the segment is an even position then on the left. The process is then repeated on the new doubled list of segments. This constructs a full set of line segments before any drawing.

:   The effect of the splitting is a kind of bottom-up version of the recursions. See the Asymptote example for code doing this.

* Iteratively the curve always turns 90-degrees left or right at each point. The direction of the turn is given by the bit above the lowest 1-bit of n. Some bit-twiddling can extract that efficiently.

```
n = 1010110000
        ^
        bit above lowest 1-bit, turn left or right as 0 or 1

LowMask = n BITXOR (n-1)   # eg. giving 0000011111
AboveMask = LowMask + 1    # eg. giving 0000100000
BitAboveLowestOne = n BITAND AboveMask
```

:   The first turn is at n=1, so reckon the curve starting at the origin as n=0 then a straight line segment to position n=1 and turn there.

:   If you prefer to reckon the first turn as n=0 then take the bit above the lowest 0-bit instead. This works because "...10000" minus 1 is "...01111" so the lowest 0 in n-1 is where the lowest 1 in n is.

:   Going by turns suits turtle graphics such as Logo or a plotter drawing with a pen and current direction.

* If a language doesn't maintain a "current direction" for drawing then you can always keep that separately and apply turns by bit-above-lowest-1.

* Absolute direction to move at point n can be calculated by the number of bit-transitions in n.

```
n = 11 00 1111 0 1
      ^  ^    ^ ^     4 places where change bit value
                      so direction=4*90degrees=East
```

:   This can be calculated by counting the number of 1 bits in "n XOR (n RIGHTSHIFT 1)" since such a shift and xor leaves a single 1 bit at each position where two adjacent bits differ.

* Absolute X,Y coordinates of a point n can be calculated in complex numbers by some powers (i+1)^k and add/subtract/rotate. This is done in the gnuplot code. This might suit things similar to Gnuplot which want to calculate each point independently.

* Predicate test for whether a given X,Y point or segment is on the curve can be done. This might suit line-by-line output rather than building an entire image before printing. See M4 for an example of this.

:   A predicate works by dividing out complex number i+1 until reaching the origin, so it takes roughly a bit at a time from X and Y is thus quite efficient. Why it works is slightly subtle but the calculation is not difficult. (Check segment by applying an offset to move X,Y to an "even" position before dividing i+1. Check vertex by whether the segment either East or West is on the curve.)

:   The number of steps in the predicate corresponds to doublings of the curve, so stopping the check at say 8 steps can limit the curve drawn to 2^8=256 points. The offsets arising in the predicate are bits of n the segment number, so can note those bits to calculate n and limit to an arbitrary desired length or sub-section.

* As a Lindenmayer system of expansions. The simplest is two symbols F and S both straight lines, as used by the PGF code.

```
Axiom F, angle 90 degrees
F -> F+S
S -> F-S
```

This always has F at even positions and S at odd. Eg. after 3 levels `F_S_F_S_F_S_F_S`. The +/- turns in between bend to the left or right the same as the "successive approximation" method above. Read more at for instance Joel Castellanos' L-system page.

Variations are possible if you have only a single symbol for line draw, for example the Icon and Unicon and Xfractint code. The angles can also be broken into 45-degree parts to keep the expansion in a single direction rather than the endpoint rotating around.

The string rewrites can be done recursively without building the whole string, just follow its instructions at the target level. See for example C by IFS Drawing code. The effect is the same as "recursive with parameter" above but can draw other curves defined by L-systems.

[Assistant]
(formerly Perl 6)
We'll use a L-System role, and draw the dragon in SVG.

```
use SVG;

role Lindenmayer {
    has %.rules;
    method succ {
	    self.comb.map( { %!rules{$^c} // $c } ).join but Lindenmayer(%!rules)
    }
}

my $dragon = "FX" but Lindenmayer( { X => 'X+YF+', Y => '-FX-Y' } );

$dragon++ xx ^15;

my @points = 215, 350;

for $dragon.comb {
    state ($x, $y) = @points[0,1];
    state $d = 2 + 0i;
    if /'F'/ { @points.append: ($x += $d.re).round(.1), ($y += $d.im).round(.1) }
    elsif /< + - >/ { $d *= "{$_}1i" }
}

say SVG.serialize(
    svg => [
        :600width, :450height, :style<stroke:rgb(0,0,255)>,
        :rect[:width<100%>, :height<100%>, :fill<white>],
        :polyline[ :points(@points.join: ','), :fill<white> ],
    ],
);

```


[User]
Task

Draw a clock.

More specific:

1. Draw a time keeping device. It can be a stopwatch, hourglass, sundial, a mouth counting "one thousand and one", anything. Only showing the seconds is required, e.g.: a watch with just a second hand will suffice. However, it must clearly change every second, and the change must cycle every so often (one minute, 30 seconds, etc.) It must be *drawn*; printing a string of numbers to your terminal doesn't qualify. Both text-based and graphical drawing are OK.
2. The clock is unlikely to be used to control space flights, so it needs not be hyper-accurate, but it should be usable, meaning if one can read the seconds off the clock, it must agree with the system clock.
3. A clock is rarely (never?) a major application: don't be a CPU hog and poll the system timer every microsecond, use a proper timer/signal/event from your system or language instead. For a bad example, many OpenGL programs update the frame-buffer in a busy loop even if no redraw is needed, which is very undesirable for this task.
4. A clock is rarely (never?) a major application: try to keep your code simple and to the point. Don't write something too elaborate or convoluted, instead do whatever is natural, concise and clear in your language.

Key points

* animate simple object
* timed event
* polling system resources
* code clarity

[Assistant]
(formerly Perl 6)

```
my ($rows,$cols) = qx/stty size/.words;
my $v = floor $rows / 2;
my $h = floor $cols / 2 - 16;

my @t = < ⡎⢉⢵ ⠀⢺⠀ ⠊⠉⡱ ⠊⣉⡱ ⢀⠔⡇ ⣏⣉⡉ ⣎⣉⡁ ⠊⢉⠝ ⢎⣉⡱ ⡎⠉⢱ ⠀⠶⠀>;
my @b = < ⢗⣁⡸ ⢀⣸⣀ ⣔⣉⣀ ⢄⣀⡸ ⠉⠉⡏ ⢄⣀⡸ ⢇⣀⡸ ⢰⠁⠀ ⢇⣀⡸ ⢈⣉⡹ ⠀⠶⠀>;

loop {
    my @x = DateTime.now.Str.substr(11,8).ords X- ord('0');
    print "\e[H\e[J";
    print "\e[$v;{$h}H";
    print ~@t[@x];
    print "\e[{$v+1};{$h}H";
    print ~@b[@x];
    print "\e[H";
    sleep 1;
}

```

Output:

```
⠀⢺⠀ ⢀⠔⡇ ⠀⠶⠀ ⠊⠉⡱ ⠊⣉⡱ ⠀⠶⠀ ⣏⣉⡉ ⡎⢉⢵
⢀⣸⣀ ⠉⠉⡏ ⠀⠶⠀ ⣔⣉⣀ ⢄⣀⡸ ⠀⠶⠀ ⢄⣀⡸ ⢗⣁⡸
```

A simpler version that does not clear the screen:

```
constant @t = < ⡎⢉⢵ ⠀⢺⠀ ⠊⠉⡱ ⠊⣉⡱ ⢀⠔⡇ ⣏⣉⡉ ⣎⣉⡁ ⠊⢉⠝ ⢎⣉⡱ ⡎⠉⢱ ⠀⠶⠀>;
constant @b = < ⢗⣁⡸ ⢀⣸⣀ ⣔⣉⣀ ⢄⣀⡸ ⠉⠉⡏ ⢄⣀⡸ ⢇⣀⡸ ⢰⠁⠀ ⢇⣀⡸ ⢈⣉⡹ ⠀⠶⠀>;

signal(SIGINT).tap: { print "\e[?25h\n"; exit }
print "\e7\e[?25l"; # saves cursor position, make it invisible
loop {
    my @x = DateTime.now.Str.substr(11,8).ords X- ord('0');
    put ~.[@x] for @t, @b;
    sleep 1;
    print "\e8"; # restores cursor position
}

```

Finally a more minimalist version that shows three progress bars (hours, minutes, seconds):

```
print "\e7";
loop {
    my $time = DateTime.now;
    put '#' x $_ ~ '.' x (24 - $_) given $time.hour.round;
    put '#' x $_ ~ '.' x (60 - $_) given $time.minute.round;
    put '#' x $_ ~ '.' x (60 - $_) given $time.second.round;
    sleep 1;
    print "\e8";
}
END put "\n";

```


[User]
Task

Draw a   cuboid   with relative dimensions of    2 × 3 × 4.

The cuboid can be represented graphically, or in   ASCII art,   depending on the language capabilities.

To fulfill the criteria of being a cuboid, three faces must be visible.

Either static or rotational projection is acceptable for this task.

Related tasks

* draw a sphere
* draw a rotating cube
* write language name in 3D ASCII
* draw a Deathstar

[Assistant]
(formerly Perl 6)

**Works with**: moar version 2015-11-27

```
sub braille-graphics (%a) {
    my ($ylo, $yhi, $xlo, $xhi);
    for %a.keys -> $y {
	$ylo min= +$y; $yhi max= +$y;
	for %a{$y}.keys -> $x {
	    $xlo min= +$x; $xhi max= +$x;
	}
    }

    for $ylo, $ylo + 4 ...^ * > $yhi -> \y {
	for $xlo, $xlo + 2 ...^ * > $xhi -> \x {
	    my $cell = 0x2800;
	    $cell += 1   if %a{y + 0}{x + 0};
	    $cell += 2   if %a{y + 1}{x + 0};
	    $cell += 4   if %a{y + 2}{x + 0};
	    $cell += 8   if %a{y + 0}{x + 1};
	    $cell += 16  if %a{y + 1}{x + 1};
	    $cell += 32  if %a{y + 2}{x + 1};
	    $cell += 64  if %a{y + 3}{x + 0};
	    $cell += 128 if %a{y + 3}{x + 1};
	    print chr($cell);
	}
	print "\n";
    }
}

sub cuboid ( [$x, $y, $z] ) {
    my \x = $x * 4;
    my \y = $y * 4;
    my \z = $z * 2;
    my %t;
    sub horz ($X, $Y) { %t{$Y     }{$X + $_} = True for 0 .. x }
    sub vert ($X, $Y) { %t{$Y + $_}{$X     } = True for 0 .. y }
    sub diag ($X, $Y) { %t{$Y - $_}{$X + $_} = True for 0 .. z }

    horz(0, z); horz(z, 0); horz(  0, z+y);
    vert(0, z); vert(x, z); vert(z+x,   0);
    diag(0, z); diag(x, z); diag(  x, z+y);

    say "[$x, $y, $z]";
    braille-graphics %t;
}

cuboid $_ for [2,3,4], [3,4,2], [4,2,3], [1,1,1], [8,1,1], [1,8,1], [1,1,8];

```

Output:


[User]
Task

Create a window and draw a pixel in it, subject to the following:

:   :   1. the window is 320 x 240
        2. the color of the pixel must be red (255,0,0)
        3. the position of the pixel is x = 100, y = 100

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2018.05

Really? Draw a single pixel? Sigh.

```
use GTK::Simple;
use GTK::Simple::DrawingArea;
use Cairo;

my $app = GTK::Simple::App.new(:title('Draw a Pixel'));
my $da  = GTK::Simple::DrawingArea.new;
gtk_simple_use_cairo;

$app.set-content( $da );
$app.border-width = 5;
$da.size-request(320,240);

sub rect-do( $d, $ctx ) {
    given $ctx {
        .rgb(1, 0, 0);
        .rectangle(100, 100, 1, 1);
        .fill;
    }
}

my $ctx = $da.add-draw-handler( &rect-do );
$app.run;

```


[User]
Task

Draw a rotating cube.

It should be oriented with one vertex pointing straight up, and its opposite vertex on the main diagonal (the one farthest away) straight down. It can be solid or wire-frame, and you can use ASCII art if your language doesn't have graphical capabilities. Perspective is optional.

Related tasks

* Draw a cuboid
* write language name in 3D ASCII

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2018.12

Raku has no native graphics libraries built in, but makes it fairly easy to bind to third party libraries. Here we'll use bindings to Libcaca, the **C**olor **A**S**C**II **A**rt library to generate a rotating cube in an ASCII terminal.

```
use Terminal::Caca;
given my $canvas = Terminal::Caca.new {
    .title('Rosetta Code - Rotating cube - Press any key to exit');

    sub scale-and-translate($x, $y, $z) {
        $x * 5 / ( 5 + $z ) * 15 + 40,
        $y * 5 / ( 5 + $z ) *  7 + 15,
        $z;
    }

    sub rotate3d-x( $x, $y, $z, $angle ) {
        my ($cosθ, $sinθ) = cis( $angle * π / 180.0 ).reals;
        $x,
        $y * $cosθ - $z * $sinθ,
        $y * $sinθ + $z * $cosθ;
    }

    sub rotate3d-y( $x, $y, $z, $angle ) {
        my ($cosθ, $sinθ) = cis( $angle * π / 180.0 ).reals;
        $x * $cosθ - $z * $sinθ,
        $y,
        $x * $sinθ + $z * $cosθ;
    }

    sub rotate3d-z( $x, $y, $z, $angle ) {
        my ($cosθ, $sinθ) = cis( $angle * π / 180.0 ).reals;
        $x * $cosθ - $y * $sinθ,
        $x * $cosθ + $y * $sinθ,
        $z;
    }

    # Unit cube from polygon mesh, aligned to axes
    my @mesh =
      [ [1, 1, -1], [-1, -1, -1], [-1,  1, -1] ], # far face
      [ [1, 1, -1], [-1, -1, -1], [ 1, -1, -1] ],
      [ [1, 1,  1], [-1, -1,  1], [-1,  1,  1] ], # near face
      [ [1, 1,  1], [-1, -1,  1], [ 1, -1,  1] ];
      @mesh.push: [$_».rotate( 1)».Array] for @mesh[^4]; # positive and
      @mesh.push: [$_».rotate(-1)».Array] for @mesh[^4]; # negative rotations

    # Rotate to correct orientation for task
    for ^@mesh X ^@mesh[0] -> ($i, $j) {
        @(@mesh[$i;$j]) = rotate3d-x |@mesh[$i;$j], 45;
        @(@mesh[$i;$j]) = rotate3d-z |@mesh[$i;$j], 40;
    }

    my @colors = red, blue, green, cyan, magenta, yellow;

    loop {
        for ^359 -> $angle {
            .color( white, white );
            .clear;

            # Flatten 3D into 2D and rotate for all faces
            my @faces-z;
            my $c-index = 0;
            for @mesh -> @triangle {
                my @points;
                my $sum-z = 0;
                for @triangle -> @node {
                    my ($px, $py, $z) = scale-and-translate |rotate3d-y |@node, $angle;
                    @points.append: $px.Int, $py.Int;
                    $sum-z += $z;
                }

                @faces-z.push: %(
                    color  => @colors[$c-index++ div 2],
                    points => @points,
                    avg-z  => $sum-z / +@points;
                );
            }

            # Draw all faces
            # Sort by z to draw farthest first
            for @faces-z.sort( -*.<avg-z> ) -> %face {
                # Draw filled triangle
                .color( %face<color>, %face<color> );
                .fill-triangle( |%face<points> );
                # And frame
                .color( black, black );
                .thin-triangle( |%face<points> );
            }

            .refresh;
            exit if .wait-for-event(key-press);
        }
    }

    # Cleanup on scope exit
    LEAVE {
        .cleanup;
    }
}

```


[User]
Task

Draw a sphere.

The sphere can be represented graphically, or in ASCII art, depending on the language capabilities.

Either static or rotational projection is acceptable for this task.

Related tasks

* draw a cuboid
* draw a rotating cube
* write language name in 3D ASCII
* draw a Deathstar

[Assistant]
(formerly Perl 6)

### Pure Raku

**Translation of**: C

The C code is modified to output a .pgm file.

**Works with**: Rakudo version 2018.10

```
my $width = my $height = 255; # must be odd

my @light = normalize([ 3, 2, -5 ]);

my $depth = 255;

sub MAIN ($outfile = 'sphere-perl6.pgm') {
    spurt $outfile, "P5\n$width $height\n$depth\n"; # .pgm header
    my $out = open( $outfile, :a, :bin ) orelse .die;
    $out.write( Blob.new(draw_sphere( ($width-1)/2, .9, .2) ) );
    $out.close;
}

sub normalize (@vec) { @vec »/» ([+] @vec »*« @vec).sqrt }

sub dot (@x, @y) { -([+] @x »*« @y) max 0 }

sub draw_sphere ( $rad, $k, $ambient ) {
    my @pixels[$height];
    my $r2 = $rad * $rad;
    my @range = -$rad .. $rad;
    @range.hyper.map: -> $x {
        my @row[$width];
        @range.map: -> $y {
            if (my $x2 = $x * $x) + (my $y2 = $y * $y) < $r2 {
                my @vector = normalize([$x, $y, ($r2 - $x2 - $y2).sqrt]);
                my $intensity = dot(@light, @vector) ** $k + $ambient;
                my $pixel = (0 max ($intensity * $depth).Int) min $depth;
                @row[$y+$rad] = $pixel;
            }
            else {
                @row[$y+$rad] = 0;
            }
        }
        @pixels[$x+$rad] = @row;
    }
    flat |@pixels.map: *.list;
}

```

### Cairo graphics library

```
use Cairo;

given Cairo::Image.create(Cairo::FORMAT_ARGB32, 256, 256) {
    given Cairo::Context.new($_) {

        my Cairo::Pattern::Solid $bg .= create(.5,.5,.5);
        .rectangle(0, 0, 256, 256);
        .pattern($bg);
        .fill;
        $bg.destroy;

        my Cairo::Pattern::Gradient::Radial $shadow .=
           create(105.2, 102.4, 15.6, 102.4,  102.4, 128.0);
        $shadow.add_color_stop_rgba(0, .3, .3, .3, .3);
        $shadow.add_color_stop_rgba(1, .1, .1, .1, .02);
        .pattern($shadow);
        .arc(136.0, 134.0, 110, 0, 2 * pi);
        .fill;
        $shadow.destroy;

        my Cairo::Pattern::Gradient::Radial $sphere .=
           create(115.2, 102.4, 25.6, 102.4,  102.4, 128.0);
        $sphere.add_color_stop_rgba(0, 1, 1, .698, 1);
        $sphere.add_color_stop_rgba(1, .923, .669, .144, 1);
        .pattern($sphere);
        .arc(128.0, 128.0, 110, 0, 2 * pi);
        .fill;
        $sphere.destroy;
    };
    .write_png('sphere2-perl6.png');
}

```

See sphere2-perl6.png (offsite .png image)


[User]
Task

Create a window and draw a pixel in it, subject to the following:

:   :   1. the window is 640 x 480
        2. the color of the pixel must be yellow (255,255,0)
        3. the position of the pixel is random

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2018.05

Coordinates of random pixel displayed in window title. To make the single pixel show up better I filled in the drawing area background with black to get better contrast.

```
use GTK::Simple;
use GTK::Simple::DrawingArea;
use Cairo;
my ($w, $h) = 640, 480;
my ($x, $y) = (^$w).pick, (^$h).pick;

my $app = GTK::Simple::App.new(:title("Draw Pixel 2 @ $x,$y"));
my $da  = GTK::Simple::DrawingArea.new;
gtk_simple_use_cairo;

$app.set-content( $da );
$app.border-width = 5;
$da.size-request($w, $h);

sub rect-do( $d, $ctx ) {
    given $ctx {
        .rgb(0, 0, 0);
        .rectangle(0, 0, $w, $h);
        .fill;
        .rgb(1, 1, 0);
        .rectangle($x, $y, 1, 1);
        .fill;
    }
}

my $ctx = $da.add-draw-handler( &rect-do );
$app.run;

```


[User]
A **Duffinian number** is a composite number **k** that is relatively prime to its sigma sum **σ**.

*The sigma sum of **k** is the sum of the divisors of **k**.*

E.G.

**161** is a **Duffinian number**.

* It is composite. (7 × 23)
* The sigma sum **192** (1 + 7 + 23 + 161) is relatively prime to **161**.

Duffinian numbers are very common.

It is not uncommon for two consecutive integers to be Duffinian (a Duffinian twin) (8, 9), (35, 36), (49, 50), etc.

Less common are Duffinian triplets; three consecutive Duffinian numbers. (63, 64, 65), (323, 324, 325), etc.

Much, much less common are Duffinian quadruplets and quintuplets. The first Duffinian quintuplet is (202605639573839041, 202605639573839042, 202605639573839043, 202605639573839044, 202605639573839045).

It is not possible to have six consecutive Duffinian numbers

Task

* Find and show the first 50 Duffinian numbers.
* Find and show at least the first 15 Duffinian triplets.

See also

* Numbers Aplenty - Duffinian numbers * OEIS:A003624 - Duffinian numbers: composite numbers k relatively prime to sigma(k)

[Assistant]
```
use Prime::Factor;

my @duffinians = lazy (3..*).hyper.grep: { !.is-prime && $_ gcd .&divisors.sum == 1 };

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

put "\nFirst 40 Duffinian triplets:\n" ~
    ((^∞).grep: -> $n { (@duffinians[$n] + 1 == @duffinians[$n + 1]) && (@duffinians[$n] + 2 == @duffinians[$n + 2]) })[^40]\
    .map( { "({@duffinians[$_ .. $_+2].join: ', '})" } ).batch(4)».fmt("%-24s").join: "\n";

```

Output:

```
First 50 Duffinian numbers:
  4   8   9  16  21  25  27  32  35  36
 39  49  50  55  57  63  64  65  75  77
 81  85  93  98 100 111 115 119 121 125
128 129 133 143 144 155 161 169 171 175
183 185 187 189 201 203 205 209 215 217

First 40 Duffinian triplets:
(63, 64, 65)             (323, 324, 325)          (511, 512, 513)          (721, 722, 723)
(899, 900, 901)          (1443, 1444, 1445)       (2303, 2304, 2305)       (2449, 2450, 2451)
(3599, 3600, 3601)       (3871, 3872, 3873)       (5183, 5184, 5185)       (5617, 5618, 5619)
(6049, 6050, 6051)       (6399, 6400, 6401)       (8449, 8450, 8451)       (10081, 10082, 10083)
(10403, 10404, 10405)    (11663, 11664, 11665)    (12481, 12482, 12483)    (13447, 13448, 13449)
(13777, 13778, 13779)    (15841, 15842, 15843)    (17423, 17424, 17425)    (19043, 19044, 19045)
(26911, 26912, 26913)    (30275, 30276, 30277)    (36863, 36864, 36865)    (42631, 42632, 42633)
(46655, 46656, 46657)    (47523, 47524, 47525)    (53137, 53138, 53139)    (58563, 58564, 58565)
(72961, 72962, 72963)    (76175, 76176, 76177)    (79523, 79524, 79525)    (84099, 84100, 84101)
(86527, 86528, 86529)    (94177, 94178, 94179)    (108899, 108900, 108901) (121103, 121104, 121105)
```


[User]
File:Dutch flag 3.jpg

The Dutch national flag is composed of three coloured bands in the order:

:   :   * red     (top)
        * then white,   and
        * lastly blue   (at the bottom).

The problem posed by Edsger Dijkstra is:

:   Given a number of red, blue and white balls in random order, arrange them in the order of the colours in the Dutch national flag.

When the problem was first posed, Dijkstra then went on to successively refine a solution, minimising the number of swaps and the number of times the colour of a ball needed to determined and restricting the balls to end in an array, ...

Task

1. Generate a randomized order of balls *ensuring that they are not in the order of the Dutch national flag*.
2. Sort the balls in a way idiomatic to your language.
3. Check the sorted balls *are* in the order of the Dutch national flag.

C.f.

* Dutch national flag problem
* Probabilistic analysis of algorithms for the Dutch national flag problem by Wei-Mei Chen. (pdf)

[Assistant]
(formerly Perl 6)
Here are five ways to do it, all one liners (apart from the test apparatus).

```
enum NL <red white blue>;
my @colors;

sub how'bout (&this-way) {
    sub show {
        say @colors;
        say "Ordered: ", [<=] @colors;
    }

    @colors = NL.roll(20);
    show;
    this-way;
    show;
    say '';
}

say "Using functional sort";
how'bout { @colors = sort *.value, @colors }

say "Using in-place sort";
how'bout { @colors .= sort: *.value }

say "Using a Bag";
how'bout { @colors = flat red, white, blue Zxx bag(@colors».key)<red white blue> }

say "Using the classify method";
how'bout { @colors = flat (.list for %(@colors.classify: *.value){0,1,2}) }

say "Using multiple greps";
how'bout { @colors = flat (.grep(red), .grep(white), .grep(blue) given @colors) }

```

Output:

```
Using functional sort
red red white white red red red red red red red white red white red red red white white white
Ordered: False
red red red red red red red red red red red red red white white white white white white white
Ordered: True

Using in-place sort
red blue white red white blue white blue red white blue blue blue red white white red blue red blue
Ordered: False
red red red red red red white white white white white white blue blue blue blue blue blue blue blue
Ordered: True

Using a Bag
red blue blue blue white red white red white blue blue red red red red blue blue red white blue
Ordered: False
red red red red red red red red white white white white blue blue blue blue blue blue blue blue
Ordered: True

Using the classify method
blue red white blue blue white white red blue red red white red blue white white red blue red white
Ordered: False
red red red red red red red white white white white white white white blue blue blue blue blue blue
Ordered: True

Using multiple greps
red white blue white white red blue white red white red white white white white white red red blue red
Ordered: False
red red red red red red red white white white white white white white white white white blue blue blue
Ordered: True
```


[User]
Task

Create a variable with a user-defined name.

The variable name should *not* be written in the program text, but should be taken from the user dynamically.

See also

* Eval in environment is a similar task.

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2018.03

You can interpolate strings as variable names:

```
our $our-var = 'The our var';
my  $my-var  = 'The my var';

my $name  = prompt 'Variable name: ';
my $value = $::('name'); # use the right sigil, etc

put qq/Var ($name) starts with value ｢$value｣/;

$::('name') = 137;

put qq/Var ($name) ends with value ｢{$::('name')}｣/;

```


[User]
When calculating prime numbers > 2, the difference between adjacent primes is always an even number. This difference, also referred to as the gap, varies in an random pattern; at least, no pattern has ever been discovered, and it is strongly conjectured that no pattern exists. However, it is also conjectured that between some two adjacent primes will be a gap corresponding to every positive even integer.

| gap | minimal starting prime | ending prime |
| --- | --- | --- |
| 2 | 3 | 5 |
| 4 | 7 | 11 |
| 6 | 23 | 29 |
| 8 | 89 | 97 |
| 10 | 139 | 149 |
| 12 | 199 | 211 |
| 14 | 113 | 127 |
| 16 | 1831 | 1847 |
| 18 | 523 | 541 |
| 20 | 887 | 907 |
| 22 | 1129 | 1151 |
| 24 | 1669 | 1693 |
| 26 | 2477 | 2503 |
| 28 | 2971 | 2999 |
| 30 | 4297 | 4327 |

This task involves locating the minimal primes corresponding to those gaps.

Though every gap value exists, they don't seem to come in any particular order. For example, this table shows the gaps and minimum starting value primes for 2 through 30:

For the purposes of this task, considering only primes greater than 2, consider prime gaps that differ by exactly two to be adjacent.

Task

For each order of magnitude **m** from **10¹** through **10⁶**:

* Find the first two sets of minimum adjacent prime gaps where the absolute value of the difference between the prime gap start values is greater than **m**.

E.G.

For an **m** of **10¹**;

The start value of gap 2 is 3, the start value of gap 4 is 7, the difference is 7 - 3 or 4. 4 < **10¹** so keep going.

The start value of gap 4 is 7, the start value of gap 6 is 23, the difference is 23 - 7, or 16. 16 > **10¹** so this the earliest adjacent gap difference > **10¹**.

Stretch goal

* Do the same for **10⁷** and **10⁸** (and higher?) orders of magnitude

Note: the earliest value found for each order of magnitude may not be unique, in fact, *is* not unique; also, with the gaps in ascending order, the minimal starting values are not strictly ascending.

[Assistant]
1e1 through 1e7 are pretty speedy (less than 5 seconds total). 1e8 and 1e9 take several minutes.

```
use Math::Primesieve;
use Lingua::EN::Numbers;

my $iterator = Math::Primesieve::iterator.new;
my @gaps;
my $last = 2;

for 1..9 {
    my $m = exp $_, 10;
    my $this;
    loop {
        $this = (my $p = $iterator.next) - $last;
        if !@gaps[$this].defined {
             @gaps[$this]= $last;
             check-gap($m, $this, @gaps) && last
               if $this > 2 and @gaps[$this - 2].defined and (abs($last - @gaps[$this - 2]) > $m);
        }
        $last = $p;
    }
}

sub check-gap ($n, $this, @p) {
    my %upto = @p[^$this].pairs.grep: *.value;
    my @upto = (1..$this).map: { last unless %upto{$_ * 2}; %upto{$_ * 2} }
    my $key = @upto.rotor(2=>-1).first( {.sink; abs(.[0] - .[1]) > $n}, :k );
    return False unless $key;
    say "Earliest difference > {comma $n} between adjacent prime gap starting primes:";
    printf "Gap %s starts at %s, gap %s starts at %s, difference is %s\n\n",
    |(2 * $key + 2, @upto[$key], 2 * $key + 4, @upto[$key+1], abs(@upto[$key] - @upto[$key+1]))».,
    True
}

```

Output:

```
Earliest difference > 10 between adjacent prime gap starting primes:
Gap 4 starts at 7, gap 6 starts at 23, difference is 16

Earliest difference > 100 between adjacent prime gap starting primes:
Gap 14 starts at 113, gap 16 starts at 1,831, difference is 1,718

Earliest difference > 1,000 between adjacent prime gap starting primes:
Gap 14 starts at 113, gap 16 starts at 1,831, difference is 1,718

Earliest difference > 10,000 between adjacent prime gap starting primes:
Gap 36 starts at 9,551, gap 38 starts at 30,593, difference is 21,042

Earliest difference > 100,000 between adjacent prime gap starting primes:
Gap 70 starts at 173,359, gap 72 starts at 31,397, difference is 141,962

Earliest difference > 1,000,000 between adjacent prime gap starting primes:
Gap 100 starts at 396,733, gap 102 starts at 1,444,309, difference is 1,047,576

Earliest difference > 10,000,000 between adjacent prime gap starting primes:
Gap 148 starts at 2,010,733, gap 150 starts at 13,626,257, difference is 11,615,524

Earliest difference > 100,000,000 between adjacent prime gap starting primes:
Gap 198 starts at 46,006,769, gap 200 starts at 378,043,979, difference is 332,037,210

Earliest difference > 1,000,000,000 between adjacent prime gap starting primes:
Gap 276 starts at 649,580,171, gap 278 starts at 4,260,928,601, difference is 3,611,348,430
```


[User]
Definition

An   **eban**   number is a number that has no letter    **e**    in it when the number is spelled in English.

Or more literally,   spelled numbers that contain the letter   **e**   are banned.

The American version of spelling numbers will be used here   (as opposed to the British).

**2,000,000,000**   is two billion,   *not*   two milliard.

Only numbers less than   **one sextillion**   (**1021**)   will be considered in/for this task.

This will allow optimizations to be used.

Task
:   :   :   * show all eban numbers   ≤   **1,000**   (in a horizontal format),   and a count
            * show all eban numbers between   **1,000**   and   **4,000**   (inclusive),   and a count
            * show a count of all eban numbers up and including           **10,000**
            * show a count of all eban numbers up and including         **100,000**
            * show a count of all eban numbers up and including      **1,000,000**
            * show a count of all eban numbers up and including    **10,000,000**
            * show all output here.

See also
:   * The MathWorld entry:   eban numbers.
    * The OEIS entry:   A6933, eban numbers.
    * Number names.

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2018.12

Modular approach, very little is hard coded. Change the $upto order-of-magnitude limit to adjust the search/display ranges. Change the letter(s) given to the enumerate / count subs to modify which letter(s) to disallow.

Will handle multi-character 'bans'. Demonstrate for e-ban, t-ban and subur-ban.

Directly find :

:   * OEIS:A006933 Numbers without e: Eban
    * OEIS:A008521 Numbers without o: Oban
    * OEIS:A008523 Numbers without t: Tban
    * OEIS:A072954 Numbers without a, i, l, t: TALIban
    * OEIS:A072955 Numbers without b, r, s, u: SUBURban
    * OEIS:A072956 Numbers without r, t, u: TURban
    * OEIS:A072957 Numbers without r, u: URban
    * OEIS:A072958 Numbers without a, c, i, l: CALIban
    * OEIS:A089589 Numbers without i: Iban
    * OEIS:A089590 Numbers without u: Uban
    * *and so on...*

Considering numbers up to **1021**, as the task directions suggest.

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

sub nban ($seq, $n = 'e') { ($seq).map: { next if .&cardinal.contains(any($n.lc.comb)); $_ } }

sub enumerate ($n, $upto) {
    my @ban = [nban(1 .. 99, $n)],;
    my @orders;
    (2 .. $upto).map: -> $o {
        given $o % 3 { # Compensate for irregulars: 11 - 19
            when 1  { @orders.push: [flat (10**($o - 1) X* 10 .. 19).map(*.&nban($n)), |(10**$o X* 2 .. 9).map: *.&nban($n)] }
            default { @orders.push: [flat (10**$o X* 1 .. 9).map: *.&nban($n)] }
        }
    }
    ^@orders .map: -> $o {
        @ban.push: [] and next unless +@orders[$o];
        my @these;
        @orders[$o].map: -> $m {
            @these.push: $m;
            for ^@ban -> $b {
                next unless +@ban[$b];
                @these.push: $_ for (flat @ban[$b]) »+» $m ;
            }
        }
        @ban.push: @these;
    }
    @ban.unshift(0) if nban(0, $n);
    flat @ban.map: *.flat;
}

sub count ($n, $upto) {
    my @orders;
    (2 .. $upto).map: -> $o {
        given $o % 3 { # Compensate for irregulars: 11 - 19
            when 1  { @orders.push: [flat (10**($o - 1) X* 10 .. 19).map(*.&nban($n)), |(10**$o X* 2 .. 9).map: *.&nban($n)] }
            default { @orders.push: [flat (10**$o X* 1 .. 9).map: *.&nban($n)] }
        }
    }
    my @count  = +nban(1 .. 99, $n);
    ^@orders .map: -> $o {
        @count.push: 0 and next unless +@orders[$o];
        my $prev = so (@orders[$o].first( { $_ ~~ /^ '1' '0'+ $/ } ) // 0 );
        my $sum = @count.sum;
        my $these = +@orders[$o] * $sum + @orders[$o];
        $these-- if $prev;
        @count[1 + $o] += $these;
        ++@count[$o]  if $prev;
    }
    ++@count[0] if nban(0, $n);
    [\+] @count;
}

#for < e o t tali subur tur ur cali i u > -> $n { # All of them
for < e t subur > -> $n { # An assortment for demonstration
    my $upto   = 21; # 1e21
    my @bans   = enumerate($n, 4);
    my @counts = count($n, $upto);

    # DISPLAY
    my @k = @bans.grep: * < 1000;
    my @j = @bans.grep: 1000 <= * <= 4000;
    put "\n============= {$n}-ban: =============\n" ~
        "{$n}-ban numbers up to 1000: {+@k}\n[{@k».&comma}]\n\n" ~
        "{$n}-ban numbers between 1,000 & 4,000: {+@j}\n[{@j».&comma}]\n" ~
        "\nCounts of {$n}-ban numbers up to {cardinal 10**$upto}"
        ;

    my $s = max (1..$upto).map: { (10**$_).&cardinal.chars };
    @counts.unshift: @bans.first: * > 10, :k;
    for ^$upto -> $c {
        printf "Up to and including %{$s}s: %s\n", cardinal(10**($c+1)), comma(@counts[$c]);
    }
}

```

Output:

```
============= e-ban: =============
e-ban numbers up to 1000: 19
[2 4 6 30 32 34 36 40 42 44 46 50 52 54 56 60 62 64 66]

e-ban numbers between 1,000 & 4,000: 21
[2,000 2,002 2,004 2,006 2,030 2,032 2,034 2,036 2,040 2,042 2,044 2,046 2,050 2,052 2,054 2,056 2,060 2,062 2,064 2,066 4,000]

Counts of e-ban numbers up to one sextillion
Up to and including                     ten: 3
Up to and including             one hundred: 19
Up to and including            one thousand: 19
Up to and including            ten thousand: 79
Up to and including    one hundred thousand: 399
Up to and including             one million: 399
Up to and including             ten million: 1,599
Up to and including     one hundred million: 7,999
Up to and including             one billion: 7,999
Up to and including             ten billion: 31,999
Up to and including     one hundred billion: 159,999
Up to and including            one trillion: 159,999
Up to and including            ten trillion: 639,999
Up to and including    one hundred trillion: 3,199,999
Up to and including         one quadrillion: 3,199,999
Up to and including         ten quadrillion: 12,799,999
Up to and including one hundred quadrillion: 63,999,999
Up to and including         one quintillion: 63,999,999
Up to and including         ten quintillion: 255,999,999
Up to and including one hundred quintillion: 1,279,999,999
Up to and including          one sextillion: 1,279,999,999

============= t-ban: =============
t-ban numbers up to 1000: 56
[0 1 4 5 6 7 9 11 100 101 104 105 106 107 109 111 400 401 404 405 406 407 409 411 500 501 504 505 506 507 509 511 600 601 604 605 606 607 609 611 700 701 704 705 706 707 709 711 900 901 904 905 906 907 909 911]

t-ban numbers between 1,000 & 4,000: 0
[]

Counts of t-ban numbers up to one sextillion
Up to and including                     ten: 7
Up to and including             one hundred: 9
Up to and including            one thousand: 56
Up to and including            ten thousand: 56
Up to and including    one hundred thousand: 56
Up to and including             one million: 57
Up to and including             ten million: 392
Up to and including     one hundred million: 785
Up to and including             one billion: 5,489
Up to and including             ten billion: 38,416
Up to and including     one hundred billion: 76,833
Up to and including            one trillion: 537,824
Up to and including            ten trillion: 537,824
Up to and including    one hundred trillion: 537,824
Up to and including         one quadrillion: 537,825
Up to and including         ten quadrillion: 3,764,768
Up to and including one hundred quadrillion: 7,529,537
Up to and including         one quintillion: 52,706,752
Up to and including         ten quintillion: 52,706,752
Up to and including one hundred quintillion: 52,706,752
Up to and including          one sextillion: 52,706,752

============= subur-ban: =============
subur-ban numbers up to 1000: 35
[1 2 5 8 9 10 11 12 15 18 19 20 21 22 25 28 29 50 51 52 55 58 59 80 81 82 85 88 89 90 91 92 95 98 99]

subur-ban numbers between 1,000 & 4,000: 0
[]

Counts of subur-ban numbers up to one sextillion
Up to and including                     ten: 6
Up to and including             one hundred: 35
Up to and including            one thousand: 35
Up to and including            ten thousand: 35
Up to and including    one hundred thousand: 35
Up to and including             one million: 36
Up to and including             ten million: 216
Up to and including     one hundred million: 2,375
Up to and including             one billion: 2,375
Up to and including             ten billion: 2,375
Up to and including     one hundred billion: 2,375
Up to and including            one trillion: 2,375
Up to and including            ten trillion: 2,375
Up to and including    one hundred trillion: 2,375
Up to and including         one quadrillion: 2,375
Up to and including         ten quadrillion: 2,375
Up to and including one hundred quadrillion: 2,375
Up to and including         one quintillion: 2,375
Up to and including         ten quintillion: 2,375
Up to and including one hundred quintillion: 2,375
Up to and including          one sextillion: 2,375
```

Note that the limit to one sextillion is somewhat arbitrary and is just to match the task parameters.

This will quite happily count \*-bans up to one hundred centillion. (10305) It takes longer, but still on the order of seconds, not minutes.

```
Counts of e-ban numbers up to one hundred centillion
 ...
Up to and including one hundred centillion: 35,184,372,088,831,999,999,999,999,999,999,999,999,999,999,999,999,999,999,999
```


[User]
Create a network service that sits on TCP port 12321, which accepts connections on that port, and which echoes complete lines (using a carriage-return/line-feed sequence as line separator) back to clients. No error handling is required. For the purposes of testing, it is only necessary to support connections from localhost (127.0.0.1 or perhaps ::1). Logging of connection information to standard output is recommended.

The implementation must be able to handle simultaneous connections from multiple clients. A multi-threaded or multi-process solution may be used. Each connection must be able to echo more than a single line.

The implementation must not stop responding to other clients if one client sends a partial line or stops reading responses.

[Assistant]
(formerly Perl 6)

**Works with**: rakudo version 2018.03

```
my $socket = IO::Socket::INET.new:
    :localhost<localhost>,
    :localport<12321>,
    :listen;

while $socket.accept -> $conn {
    say "Accepted connection";
    start {
        while $conn.recv -> $stuff {
            say "Echoing $stuff";
            $conn.print($stuff);
        }
        $conn.close;
    }
}

```

Async version:

```
react {
    whenever IO::Socket::Async.listen('0.0.0.0', 12321) -> $conn {
        whenever $conn.Supply.lines -> $line {
            $conn.print( "$line\n" ) ;
        }
    }
}

```


[User]
An **eertree** is a data structure designed for efficient processing of certain palindrome tasks, for instance counting the number of sub-palindromes in an input string.

The data structure has commonalities to both *tries* and *suffix trees*.
  See links below.

Task

Construct an eertree for the string "eertree", then output all sub-palindromes by traversing the tree.

See also

* Wikipedia entry:   trie.
* Wikipedia entry:   suffix tree
* Cornell University Library, Computer Science, Data Structures and Algorithms ───► EERTREE: An Efficient Data Structure for Processing Palindromes in Strings.
* EERTREE: An efficient data structure for processing palindromes in strings[1]

[Assistant]
(formerly Perl 6)

**Translation of**: Ring

```
my $str = "eertree";
my @pal = ();
my ($strrev,$strpal);

for (1 .. $str.chars) -> $n {
   for (1 .. $str.chars) -> $m {
      $strrev = "";
      $strpal = $str.substr($n-1, $m);
      if ($strpal ne "") {
         for ($strpal.chars ... 1) -> $p {
            $strrev ~= $strpal.substr($p-1,1);
         }
         ($strpal eq $strrev) and @pal.push($strpal);
      }
   }
}

say @pal.unique;

```

Output:

```
(e ee eertree ertre r rtr t)

```