[User]
Background of the   **juggler sequence**:

Juggler sequences were publicized by an American mathematician and author   Clifford A. Pickover.   The name of the sequence gets it's name from the similarity of the rising and falling nature of the numbers in the sequences,   much like balls in the hands of a juggler.

Description

A juggler sequence is an integer sequence that starts with a positive integer a[0], with each subsequent term in the sequence being defined by the recurrence relation:

```
            a[k + 1]  =  floor(a[k] ^ 0.5)    if a[k] is even    or
            a[k + 1]  =  floor(a[k] ^ 1.5)    if a[k] is odd

```

If a juggler sequence reaches 1, then all subsequent terms are equal to 1. This is known to be the case for initial terms up to 1,000,000 but it is not known whether all juggler sequences after that will eventually reach 1.

Task

Compute and show here the following statistics for juggler sequences with an initial term of a[n] where n is between **20** and **39** inclusive:

* l[n] - the number of terms needed to reach 1.
* h[n] - the maximum value reached in that sequence.
* i[n] - the index of the term (starting from 0) at which the maximum is (first) reached.

If your language supports *big integers* with an integer square root function, also compute and show here the same statistics for as many as you reasonably can of the following values for n:

113, 173, 193, 2183, 11229, 15065, 15845, 30817, 48443, 275485, 1267909, 2264915, 5812827

Those with fast languages and fast machines may also like to try their luck at n = 7110201.

However, as h[n] for most of these numbers is thousands or millions of digits long, show instead of h[n]:

* d[n] - the number of digits in h[n]

The results can be (partially) verified against the table here.

Related tasks

* Hailstone sequence
* Yellowstone sequence
* Isqrt\_(integer\_square\_root)\_of\_X

See also

* oeis:A007320 Number of steps needed for Juggler sequence started at n to reach 1
* oeis:A094716 Largest value in the Juggler sequence started at n

[Assistant]
Reaches 30817 fairly quickly but later values suck up enough memory that it starts thrashing the disk cache and performance drops off a cliff (on my system). Killed it after 10 minutes and capped list at 30817. Could rewrite to not try to hold entire sequence in memory at once, but probably not worth it. If you want sheer numeric calculation performance, Raku is probably not where it's at.

```
use Lingua::EN::Numbers;
sub juggler (Int $n where * > 0) { $n, { $_ +& 1 ?? .³.&isqrt !! .&isqrt } … 1 }

sub isqrt ( \x ) { my ( $X, $q, $r, $t ) =  x, 1, 0 ;
    $q +<= 2 while $q ≤ $X ;
    while $q > 1 {
        $q +>= 2; $t = $X - $r - $q; $r +>= 1;
        if $t ≥ 0 { $X = $t; $r += $q }
    }
    $r
}

say " n  l[n]  i[n]   h[n]";
for 20..39 {
    my @j = .&juggler;
    my $max = @j.max;
    printf "%2s %4d  %4d    %s\n", .&comma, +@j-1, @j.first(* == $max, :k), comma $max;
}

say "\n      n     l[n]   i[n]    d[n]";
( 113, 173, 193, 2183, 11229, 15065, 15845, 30817 ).hyper(:1batch).map: {
    my $start = now;
    my @j = .&juggler;
    my $max = @j.max;
    printf "%10s %4d   %4d %10s   %6.2f seconds\n", .&comma, +@j-1, @j.first(* == $max, :k),
      $max.chars.&comma, (now - $start);
}

```

Output:

```
 n  l[n]  i[n]   h[n]
20    3     0    20
21    9     4    140
22    3     0    22
23    9     1    110
24    3     0    24
25   11     3    52,214
26    6     3    36
27    6     1    140
28    6     3    36
29    9     1    156
30    6     3    36
31    6     1    172
32    6     3    36
33    8     2    2,598
34    6     3    36
35    8     2    2,978
36    3     0    36
37   17     8    24,906,114,455,136
38    3     0    38
39   14     3    233,046

      n     l[n]   i[n]    d[n]
       113   16      9         27     0.01 seconds
       173   32     17         82     0.01 seconds
       193   73     47        271     0.09 seconds
     2,183   72     32      5,929     1.05 seconds
    11,229  101     54      8,201     1.98 seconds
    15,065   66     25     11,723     2.05 seconds
    15,845  139     43     23,889    10.75 seconds
    30,817   93     39     45,391    19.60 seconds
```


[User]
Task

Generate and draw a Julia set.

Related tasks

* Mandelbrot Set

[Assistant]
(formerly Perl 6)

**Translation of**: Perl

with the pallette swapped, just because.

**Works with**: Rakudo version 2016.03

```
use Image::PNG::Portable;

my ($w, $h) = 800, 600;
my $out = Image::PNG::Portable.new: :width($w), :height($h);

my $maxIter = 255;
my $c = -0.7 + 0.27015i;

julia($out);

$out.write: 'Julia-set-perl6.png';

sub julia ( $png ) {
    ^$w .race.map: -> $x {
        for ^$h -> $y {
            my $z = Complex.new(($x - $w / 2) / $w * 3, ($y - $h / 2) / $h * 2);
            my $i = $maxIter;
            while (abs($z) < 2 and --$i) {
                $z = $z*$z + $c;
            }
            $png.set: $x, $y, |hsv2rgb($i / $maxIter, 1, ?$i).reverse;
        }
    }
}

sub hsv2rgb ( $h, $s, $v ){
    my $c = $v * $s;
    my $x = $c * (1 - abs( (($h*6) % 2) - 1 ) );
    my $m = $v - $c;
    [(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 }
    } ).map: ((*+$m) * 255).Int]
}

```


[User]
Imperative programs like to jump around, but some languages restrict these jumps. Many structured languages restrict their conditional structures and loops to *local jumps* within a function. Some assembly languages limit certain jumps or branches to a small range.

This task is to demonstrate a local jump and a global jump and the various other types of jumps that the language supports.
For the purpose of this task, the jumps need not be used for a single purpose and you have the freedom to use these jumps for different purposes.
You may also defer to more specific tasks, like Exceptions or Generator.
This task provides a "grab bag" for several types of jumps. There are *non-local jumps* across function calls, or *long jumps* to anywhere within a program. Anywhere means not only to the tops of functions!

* Some languages can *go to* any global label in a program.
* Some languages can break multiple function calls, also known as *unwinding the call stack*.
* Some languages can save a *continuation*. The program can later continue from the same place. So you can jump anywhere, but only if you have a previous visit there (to save the continuation).

These jumps are not all alike.
A simple *goto* never touches the call stack.
A continuation saves the call stack, so you can continue a function call after it ends.

Task

Use your language to demonstrate the various types of jumps that it supports.

Because the possibilities vary by language, this task is not specific.
You have the freedom to use these jumps for different purposes.
You may also defer to more specific tasks, like Exceptions or Generator.

[Assistant]
(formerly Perl 6)

### Label-based jumps

```
    outer-loop: loop {
        inner-loop: loop {
            # NYI # goto inner-loop if rand > 0.5; # Hard goto
            next inner-loop if rand > 0.5; # Next loop iteration
            redo inner-loop if rand > 0.5; # Re-execute block
            last outer-loop if rand > 0.5; # Exit the loop
            ENTER { say "Entered inner loop block" }
            LEAVE { say "Leaving inner loop block" }
        }
        ENTER { say "Entered outer loop block" }
        LEAVE { say "Leaving outer loop block" }
        LAST  { say "Ending outer loop" }
    }

```

Produces random output, but here's a representative run:

```
 Entered outer loop block
 Entered inner loop block
 Leaving inner loop block
 Entered inner loop block
 Leaving inner loop block
 Entered inner loop block
 Leaving inner loop block
 Leaving outer loop block
 Ending outer loop

```

### Continuation-based execution

Continuations in Raku are currently limited to use in generators via the gather/take model:

```
    my @list = lazy gather for ^100 -> $i {
        if $i.is-prime {
            say "Taking prime $i";
            take $i;
        }
    }

    say @list[5];

```

This outputs:

```
 Taking prime 2
 Taking prime 3
 Taking prime 5
 Taking prime 7
 Taking prime 11
 Taking prime 13
 13

```

Notice that no further execution of the loop occurs. If we then asked for the element at index 20, we would expect to see 15 more lines of "Taking prime..." followed by the result: 73.

### Failures and exceptions

Exceptions are fairly typical in Raku:

```
    die "This is a generic, untyped exception";

```

Will walk up the stack until either some `CATCH` block intercepts the specific exception type or we exit the program.

But if a failure should be recoverable (e.g. execution might reasonably continue along another path) a failure is often the right choice. The fail operator is like "return", but the returned value will only be valid in boolean context or for testing definedness. Any other operation will produce the original exception with the original exception's execution context (e.g. traceback) along with the current context.

```
    sub foo() { fail "oops" }
    my $failure = foo;
    say "Called foo";
    say "foo not true" unless $failure;
    say "foo not defined" unless $failure.defined;
    say "incremented foo" if $failure++; # exception

```

Produces:

```
 Called foo
 foo not true
 foo not defined
 oops
   in sub foo at fail.p6 line 1
   in block <unit> at fail.p6 line 2
 Actually thrown at:
   in any  at gen/moar/m-Metamodel.nqp line 3090
   in block <unit> at fail.p6 line 6

```

However, an exception can `.resume` in order to jump back to the failure point (this is why the stack is not unwound until after exception handling).

```
  sub foo($i) {
      if $i == 0 {
          die "Are you sure you want /0?";
      }
      say "Dividing by $i";
      1/$i.Num + 0; # Fighting hard to make this fail
  }

  for ^10 -> $n {
      say "1/$n  = " ~ foo($n);
  }

  CATCH {
      when ~$_ ~~ m:s/Are you sure/ { .resume; #`(yes, I'm sure) }
  }

```

This code raises an exception on a zero input, but then resumes execution, divides be zero and then raises a divide by zero exception which is not caught:

```
 Dividing by 0
 Attempt to divide 1 by zero using /
   in sub foo at fail.p6 line 6
   in block <unit> at fail.p6 line 10

 Actually thrown at:
   in sub foo at fail.p6 line 6
   in block <unit> at fail.p6 line 10

```


[User]
Given a stream of characters containing the separator characters "formfeed", "linefeed", "tab" and "space", print out the ith character of the ith tab-field of the ith line of the ith page to reveal a secret password.

Stop processing immediately upon encountering a "!" found uniquely in this *i,i,i,i* position (lest the system self-destruct). The "!" may be found elsewhere however, in which case it should be ignored.

Ideally this can be generalised as follows:

* The separator characters are defined by a user-supplied array that can include additional or alternative separators, e.g. (formfeed, linefeed, ".", "," ," ",...).
* The selection criterion is generalised ith,ith,ith,ith to a boolean function of *f(page,line,field,word,...) **or** f(ith,jth,kth,lth,mth,etc...)*

Provide a reasonably interesting message to be decoded, e.g. "Silence-Dogood". Your choice.

This task was inspired by the movie "National Treasure", which refers to a "book cipher".

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2019.03

This is a something of a toy encoder / decoder and probably shouldn't be used for anything serious.

Default encode/decode key is 'Raku' Feed it a pass phrase at the command line to use that instead.

Will handle any visible character in the ASCII range as well as space and new-line.

```
#`[
Set srand to set the encode / decode "key".
Need to use the same "key" and same implementation
of Raku to encode / decode. Gain "security" by
exchanging "keys" by a second channel. Default
"key" is "Raku"
]

unit sub MAIN ($key = 'Raku');

srand $key.comb(/<.alnum>/).join.parse-base(36) % 2**63;

my @stream = (flat "\n", ' ' .. '~').roll(*);

sub jit-encode (Str $str) {
    my $i = 0;
    my $last = 0;
    my $enc = '';
    for $str.comb -> $c {
        my $h;
        my $l = '';
        ++$i until $i > 1 && $c eq @stream[$i];
        my $o = $i - $last;
        $l    = $o % 26;
        $h    = $o - $l if $o >= 26;
        $l   += 10;
        $enc ~= ($h ?? $h.base(36).uc !! '') ~ ($l.base(36).lc);
        $last = $i;
    }
    my $block = 60;
    $enc.comb($block).join: "\n"
}

sub jit-decode (Str $str is copy) {
    $str.=subst("\n", '', :g);
    $str ~~ m:g/((.*?) (<:Ll>))/;
    my $dec = '';
    my $i = 0;
    for $/.List -> $l {
        my $o = ($l[0][1].Str.parse-base(36) - 10 // 0) +
                ($l[0][0].Str.parse-base(36) // 0);
        $i += $o;
        $dec ~= @stream[$i];
    }
    $dec
}

my $secret = q:to/END/;
In my opinion, this task is pretty silly.

'Twas brillig, and the slithy toves
    Did gyre and gimble in the wabe.

!@#$%^&*()_+}{[].,><\|/?'";:1234567890
END

say "== Secret: ==\n$secret";

say "\n== Encoded: ==";
say my $enc = jit-encode($secret);

say "\n== Decoded: ==";
say jit-decode($enc);

```

```
== Secret: ==
In my opinion, this task is pretty silly.

'Twas brillig, and the slithy toves
    Did gyre and gimble in the wabe.

!@#$%^&*()_+}{[].,><\|/?'";:1234567890

== Encoded: ==
Qv26e26q1Gi2Ww5SiQr26h3Mk1GbQy52e1Gg6Ib52kQfQk26n26l26cQm26q
2Wk26vwme52qy6Ia1GuQfa3MbQxtd26aa3MvQu2Wuat26p2Wbe2Wc1Ga26g2
6h26pQha26h4Cf26jrz7Yz3MaA4h2WxFWf52zyg2WrQn2Wj26pQyQy78x1Gd
dk4Cu26k26qaaap26j26xqQf7Yr8Op3Me3Me5Sv1Ge1Gt2WxlQz5Si1GeQg4
CjQc5Sb2WbQo1GycQr1Gm1Gy1GsQei3MrQsai1Gq2WnQdt2Wj1Gff1Gg26le
2Wd1Go9Ek1Gm9Eh2Wb1Gd52h2WdQae4Chu3MeQd1Gg1Gw4CqbEGh52u2Wr1G
t52xhvQmx

== Decoded: ==
In my opinion, this task is pretty silly.

'Twas brillig, and the slithy toves
    Did gyre and gimble in the wabe.

!@#$%^&*()_+}{[].,><\|/?'";:1234567890
```


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

A k-d tree (short for *k*-dimensional tree) is a space-partitioning data structure for organizing points in a k-dimensional space. k-d trees are a useful data structure for several applications, such as searches involving a multidimensional search key (e.g. range searches and nearest neighbor searches).
k-d trees are a special case of binary space partitioning trees.

k-d trees are not suitable, however, for efficiently finding the nearest neighbor in high dimensional spaces. As a general rule, if the dimensionality is *k*, the number of points in the data, *N*, should be *N* ≫ 2*k*.
Otherwise, when k-d trees are used with high-dimensional data, most of the points in the tree will be evaluated and the efficiency is no better than exhaustive search, and other methods such as approximate nearest-neighbor are used instead.

**Task:** Construct a k-d tree and perform a nearest neighbor search for two example data sets:

1. The Wikipedia example data of [(2,3), (5,4), (9,6), (4,7), (8,1), (7,2)].
2. 1000 3-d points uniformly distributed in a 3-d cube.

For the Wikipedia example, find the nearest neighbor to point (9, 2)
For the random data, pick a random location and find the nearest neighbor.

In addition, instrument your code to count the number of nodes visited in the nearest neighbor search. Count a node as visited if any field of it is accessed.

Output should show the point searched for, the point found,
the distance to the point, and the number of nodes visited.

There are variant algorithms for constructing the tree.
You can use a simple median strategy or implement something more efficient.
Variants of the nearest neighbor search include nearest N neighbors, approximate nearest neighbor, and range searches.
You do not have to implement these.
The requirement for this task is specifically the nearest single neighbor.
Also there are algorithms for inserting, deleting, and balancing k-d trees.
These are also not required for the task.

[Assistant]
(formerly Perl 6)

**Translation of**: Python

```
class Kd_node {
    has $.d;
    has $.split;
    has $.left;
    has $.right;
}

class Orthotope {
    has $.min;
    has $.max;
}

class Kd_tree {
    has $.n;
    has $.bounds;
    method new($pts, $bounds) { self.bless(n => nk2(0,$pts), bounds => $bounds) }

    sub nk2($split, @e) {
        return () unless @e;
        my @exset = @e.sort(*.[$split]);
        my $m = +@exset div 2;
        my @d = @exset[$m][];
        while $m+1 < @exset and @exset[$m+1][$split] eqv @d[$split] {
            ++$m;
        }

        my $s2 = ($split + 1) % @d; # cycle coordinates
        Kd_node.new: :@d, :$split,
                left  => nk2($s2, @exset[0 ..^ $m]),
                right => nk2($s2, @exset[$m ^.. *]);
    }
}

class T3 {
    has $.nearest;
    has $.dist_sqd = Inf;
    has $.nodes_visited = 0;
}

sub find_nearest($k, $t, @p) {
    return nn($t.n, @p, $t.bounds, Inf);

    sub nn($kd, @target, $hr, $max_dist_sqd is copy) {
        return T3.new(:nearest([0.0 xx $k])) unless $kd;

        my $nodes_visited = 1;
        my $s = $kd.split;
        my $pivot = $kd.d;
        my $left_hr = $hr.clone;
        my $right_hr = $hr.clone;
        $left_hr.max[$s] = $pivot[$s];
        $right_hr.min[$s] = $pivot[$s];

        my $nearer_kd;
        my $further_kd;
        my $nearer_hr;
        my $further_hr;
        if @target[$s] <= $pivot[$s] {
            ($nearer_kd, $nearer_hr) = $kd.left, $left_hr;
            ($further_kd, $further_hr) = $kd.right, $right_hr;
        }
        else {
            ($nearer_kd, $nearer_hr) = $kd.right, $right_hr;
            ($further_kd, $further_hr) = $kd.left, $left_hr;
        }

        my $n1 = nn($nearer_kd, @target, $nearer_hr, $max_dist_sqd);
        my $nearest = $n1.nearest;
        my $dist_sqd = $n1.dist_sqd;
        $nodes_visited += $n1.nodes_visited;

        if $dist_sqd < $max_dist_sqd {
            $max_dist_sqd = $dist_sqd;
        }
        my $d = ($pivot[$s] - @target[$s]) ** 2;
        if $d > $max_dist_sqd {
            return T3.new(:$nearest, :$dist_sqd, :$nodes_visited);
        }
        $d = [+] (@$pivot Z- @target) X** 2;
        if $d < $dist_sqd {
            $nearest = $pivot;
            $dist_sqd = $d;
            $max_dist_sqd = $dist_sqd;
        }

        my $n2 = nn($further_kd, @target, $further_hr, $max_dist_sqd);
        $nodes_visited += $n2.nodes_visited;
        if $n2.dist_sqd < $dist_sqd {
            $nearest = $n2.nearest;
            $dist_sqd = $n2.dist_sqd;
        }

        T3.new(:$nearest, :$dist_sqd, :$nodes_visited);
    }
}

sub show_nearest($k, $heading, $kd, @p) {
    print qq:to/END/;
        $heading:
        Point:            [@p.join(',')]
        END
    my $n = find_nearest($k, $kd, @p);
    print qq:to/END/;
        Nearest neighbor: [$n.nearest.join(',')]
        Distance:         &sqrt($n.dist_sqd)
        Nodes visited:    $n.nodes_visited()

        END
}

sub random_point($k) { [rand xx $k] }
sub random_points($k, $n) { [random_point($k) xx $n] }

sub MAIN {
    my $kd1 = Kd_tree.new([[2, 3],[5, 4],[9, 6],[4, 7],[8, 1],[7, 2]],
                  Orthotope.new(:min([0, 0]), :max([10, 10])));
    show_nearest(2, "Wikipedia example data", $kd1, [9, 2]);

    my $N = 1000;
    my $t0 = now;
    my $kd2 = Kd_tree.new(random_points(3, $N), Orthotope.new(:min([0,0,0]), :max([1,1,1])));
    my $t1 = now;
    show_nearest(2,
        "k-d tree with $N random 3D points (generation time: {$t1 - $t0}s)",
         $kd2, random_point(3));
}

```

Output:

```
Wikipedia example data:
Point:            [9,2]
Nearest neighbor: [8,1]
Distance:         1.4142135623731
Nodes visited:    3

k-d tree with 1000 random 3D points (generation time: 67.0934954s):
Point:            [0.765565651400664,0.223251226280109,0.00536717765240979]
Nearest neighbor: [0.758919336088656,0.228895111242011,0.0383284709862686]
Distance:         0.0340950700678338
Nodes visited:    23
```


[User]
K-means++ clustering a classification of data, so that points assigned to the same cluster are similar (in some sense). It is identical to the K-means algorithm, except for the selection of initial conditions.

This data was partitioned into 7 clusters using the K-means algorithm.

The task is to ***implement the K-means++ algorithm***. Produce a function which takes two arguments: the number of clusters K, and the dataset to classify. K is a positive integer and the dataset is a list of points in the Cartesian plane. The output is a list of clusters (related sets of points, according to the algorithm).

For ***extra credit*** (in order):

1. Provide a function to exercise your code, which generates a list of random points.
2. Provide a visualization of your results, including centroids (see example image).
3. Generalize the function to polar coordinates (in radians).
4. Generalize the function to points in an arbitrary N space (i.e. instead of x,y pairs, points are an N-tuples representing coordinates in ℝN).
   *If this is different or more difficult than the [naive] solution for ℝ2, discuss what had to change to support N dimensions.*

Extra credit is only awarded if the examples given demonstrate the feature in question. To earn credit for 1. and 2., visualize 6 clusters of 30,000 points in ℝ2. It is not necessary to provide visualization for spaces higher than ℝ2 but the examples should demonstrate features 3. and 4. if the solution has them.

[Assistant]
(formerly Perl 6)

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

We use Complex numbers to represent points in the plane. We feed the algorithm with three artificially made clouds of points so we can easily see if the output makes sense.

```
sub postfix:«-means++»(Int $K) {
    return sub (@data) {
        my @means = @data.pick;
        until @means == $K {
            my @cumulD2 = [\+] @data.map: -> $x {
                min @means.map: { abs($x - $_)**2 }
            }
            my $rand = rand * @cumulD2[*-1];
            @means.push: @data[
                (^@data).first: { @cumulD2[$_] > $rand }
            ];
        }
        sub cluster { @data.classify: -> $x { @means.min: { abs($_ - $x) } } }
        loop (
            my %cluster;
            $*TOLERANCE < [+] (@means Z- keys (%cluster = cluster))».abs X** 2;
            @means = %cluster.values.map( { .elems R/ [+] @$_ } )
        ) { ; }
        return @means;
    }
}

my @centers = 0, 5, 3 + 2i;
my @data = flat @centers.map: { ($_ + .5 - rand + (.5 - rand) * i) xx 100 }
@data.=pick(*);
.say for 3-means++(@data);

```

Output:

```
5.04622376429502+0.0145269848483031i
0.0185674577571743+0.0298199687431731i
2.954898072093+2.14922298688815i
```


[User]
:   Note to language implementers
:   This task touches on the details of number representation that is often hidden for convenience in many programming languages. You may need to understand the difference between precision in calculations and precision in presenting answers for example; or understand decimal arithmetic as distinct from the usual binary based floating point schemes used in many languages.

The Kahan summation algorithm is a method of summing a series of numbers represented in a limited precision in a way that minimises the loss of precision in the result.

(The   **Kahan summation algorithm**   is also known as the   **summation with carry algorithm**.)

**The task** is to follow the previously linked Wikipedia articles algorithm and its worked example by:

1. Do all arithmetic in decimal to a precision of six digits.
2. Write a function/method/procedure/subroutine/... to perform Kahan summation on an ordered collection of numbers, (such as a list of numbers).
3. Create the three numbers `a, b, c` equal to `10000.0, 3.14159, 2.71828` respectively.
4. Show that the simple left-to-right summation, equivalent to `(a + b) + c` gives an answer of 10005.8
5. Show that the Kahan function applied to the sequence of values `a, b, c` results in the more precise answer of 10005.9

**If your language does not have six digit decimal point**, but does have some fixed precision floating point number system then **state this** and try this alternative task using floating point numbers:

* Follow the same steps as for the main task description above but for the numbers `a, b, c` use the floating-point values `1.0, epsilon, -epsilon` respectively where epsilon is determined by its final value after the following:

```
epsilon = 1.0
while 1.0 + epsilon != 1.0:
    epsilon = epsilon / 2.0

```

The above should ensure that `(a + b) + c != 1.0` whilst their Kahan sum does equal 1.0 . *Only* if this is not the case are you then free to find three values with this property of your own.

**If your language has decimals, but not six digits of precision** then you may follow the outline given in Kahan\_summation#Python:\_Arbitrary\_precision\_Decimal which uses ideas from the floating point case above.

In general

* Show all output on this page.
* If the floating point calculations are used then answers may depend on the hardware platform or compiler/interpreter tool-chain used for a language.
* *Slight* deviations from the task description should be explained and the the subsequent difference in output explained.
* All examples should have constants chosen to clearly show the benefit of Kahan summing!

[Assistant]
(formerly Perl 6)

**Translation of**: Python

Raku does not offer a fixed precision decimal. It *does* have IEEE 754 floating point numbers so let's try implementing the floating point option as shown in Python. Need to explicitly specify scientific notation numbers to force floating point Nums.

```
constant ε = (1e0, */2e0 … *+1e0==1e0)[*-1];

sub kahan (*@nums) {
    my $summ = my $c = 0e0;
    for @nums -> $num {
        my $y = $num - $c;
        my $t = $summ + $y;
        $c = ($t - $summ) - $y;
        $summ = $t;
    }
    $summ
}

say 'Epsilon:    ', ε;

say 'Simple sum: ', ((1e0 + ε) - ε).fmt: "%.16f";

say 'Kahan sum:  ', kahan(1e0, ε, -ε).fmt: "%.16f";

```

Output:

```
Epsilon:    1.1102230246251565e-16
Simple sum: 0.9999999999999999
Kahan sum:  1.0000000000000000

```


[User]
A positive integer is a Kaprekar number if:

* It is   **1**     (unity)
* The decimal representation of its square may be split once into two parts consisting of positive integers which sum to the original number.

Note that a split resulting in a part consisting purely of 0s is not valid,
as 0 is not considered positive.

Example Kaprekar numbers

* 2223
  {\displaystyle {\displaystyle 2223}}
   is a Kaprekar number, as

  2223
  ∗
  2223
  =
  4941729
  {\displaystyle {\displaystyle 2223\*2223=4941729}}
  ,

  4941729
  {\displaystyle {\displaystyle 4941729}}
   may be split to

  494
  {\displaystyle {\displaystyle 494}}
   and

  1729
  {\displaystyle {\displaystyle 1729}}
  , and

  494
  +
  1729
  =
  2223
  {\displaystyle {\displaystyle 494+1729=2223}}
  .
* The series of Kaprekar numbers is known as A006886, and begins as

  1
  ,
  9
  ,
  45
  ,
  55
  ,
  .
  .
  .
  {\displaystyle {\displaystyle 1,9,45,55,...}}
  .

Example process

10000 (1002) splitting from left to right:

* The first split is [1, 0000], and is invalid; the 0000 element consists entirely of 0s, and 0 is not considered positive.
* Slight optimization opportunity: When splitting from left to right, once the right part consists entirely of 0s, no further testing is needed; all further splits would also be invalid.

Task

Generate and show all Kaprekar numbers less than 10,000.

Extra credit

Optionally, count (and report the count of) how many Kaprekar numbers are less than 1,000,000.

Extra extra credit

The concept of Kaprekar numbers is not limited to base 10 (i.e. decimal numbers);
if you can, show that Kaprekar numbers exist in other bases too.

For this purpose, do the following:

* Find all Kaprekar numbers for base 17 between 1 and 1,000,000 (one million);
* Display each of them in base 10 representation;
* Optionally, using base 17 representation (use letters 'a' to 'g' for digits 10(10) to 16(10)), display each of the numbers, its square, and where to split the square.

For example, 225(10) is "d4" in base 17, its square "a52g", and a5(17) + 2g(17) = d4(17), so the display would be something like:

```
225   d4  a52g  a5 + 2g
```

Reference

* The Kaprekar Numbers by Douglas E. Iannucci (2000). PDF version

Related task

* Casting out nines

[Assistant]
(formerly Perl 6)

### String version (slow)

```
sub kaprekar( Int $n ) {
    my $sq = $n ** 2;
    for 0 ^..^ $sq.chars -> $i {
        my $x = +$sq.substr(0, $i);
        my $y = +$sq.substr($i) || return;
        return True if $x + $y == $n;
    }
    False;
}

print 1;
print " $_" if .&kaprekar for ^10000;
print "\n";

```

Output:

```
1 9 45 55 99 297 703 999 2223 2728 4879 4950 5050 5292 7272 7777 9999
```

### Numeric version (medium)

The addition of **race**, in two places, allows for concurrent computation, and brings a significant speed-up in running time.

```
sub kaprekar( Int $n, Int :$base = 10 ) {
    my $hi = $n ** 2;
    my $lo = 0;
    loop (my $s = 1; $hi; $s *= $base) {
        $lo += ($hi % $base) * $s;
        $hi div= $base;
        return $hi,$lo if $lo + $hi == $n and $lo;
    }
    ();
}

print " $_" if .&kaprekar for ^10_000;

my atomicint $n;
(^1_000_000).race.map: { $n++ if kaprekar $_ }
say "\n\nBase 10 Kaprekar numbers < :10<1_000_000> = $n";

say "\nBase 17 Kaprekar numbers < :17<1_000_000>";

my &k17 = &kaprekar.assuming(:base(17));

my @results;
(^:17<1_000_000>).race.map: -> $n {
    my ($h,$l) = k17 $n;
    next unless $l;
    my $n17 = $n.base(17);
    my $s17 = ($n * $n).base(17);
    my $h17 = $h.base(17);
    @results.push: "$n $n17 $s17 ($h17 + $s17.substr(* - max(1,($s17.chars - $h17.chars))))";
}

.say for @results.sort: *.chars;

```

Output:

```
1 9 45 55 99 297 703 999 2223 2728 4879 4950 5050 5292 7272 7777 9999

Base 10 Kaprekar numbers < :10<1_000_000> = 54

Base 17 Kaprekar numbers < :17<1_000_000>
1 1 1 (0 + 1)
16 G F1 (F + 1)
64 3D E2G (E + 2G)
225 D4 A52G (A5 + 2G)
288 GG GF01 (GF + 01)
1536 556 1B43B2 (1B4 + 3B2)
3377 BBB 8093B2 (809 + 3B2)
4912 GGG GGF001 (GGF + 001)
7425 18BD 24E166G (24E + 166G)
9280 1F1F 39B1B94 (39B + 1B94)
16705 36DB B992C42 (B99 + 2C42)
20736 43CD 10DE32FG (10DE + 32FG)
30016 61EB 23593F92 (2359 + 3F92)
36801 785D 351E433G (351E + 433G)
37440 7A96 37144382 (3714 + 4382)
46081 967B 52G94382 (52G9 + 4382)
46720 98B4 5575433G (5575 + 433G)
53505 AF26 6GA43F92 (6GA4 + 3F92)
62785 CD44 9A5532FG (9A55 + 32FG)
66816 DA36 AEG42C42 (AEG4 + 2C42)
74241 F1F2 D75F1B94 (D75F + 1B94)
76096 F854 E1F5166G (E1F5 + 166G)
83520 GGGG GGGF0001 (GGGF + 0001)
266224 33334 A2C52A07G (A2C5 + 2A07G)
1153633 DDDDD B3D5E2A07G (B3D5E + 2A07G)
1334529 FGACC F0540F1A78 (F054 + 0F1A78)
1419856 GGGGG GGGGF00001 (GGGGF + 00001)
1787968 146FCA 19G4C12DG7F (19G4C + 12DG7F)
3122497 236985 4E3BE1F95D8 (4E3BE + 1F95D8)
3773952 2B32B3 711CB2420F9 (711CB + 2420F9)
4243968 2GDE03 8FEGB27EG09 (8FEGB + 27EG09)
5108481 3A2D6F CG10B2E3C64 (CG10B + 2E3C64)
5561920 3FA16D F5EAE3043CG (F5EAE + 3043CG)
6031936 443CCD 110DDE332FFG (110DDE + 332FFG)
6896449 4E9C28 16A10C37GB1D (16A10C + 37GB1D)
7435233 54067B 1A72G93AA382 (1A72G9 + 3AA382)
8017920 5AGGB6 1EF1D43D1EF2 (1EF1D4 + 3D1EF2)
9223201 687534 2835C5403G7G (2835C5 + 403G7G)
9805888 6F6F6G 2DBE3F41C131 (2DBE3F + 41C131)
11140416 7E692A 3A997C43DGBF (3A997C + 43DGBF)
11209185 7F391E 3B58D543F059 (3B58D5 + 43F059)
12928384 91D7F3 4EF79B43F059 (4EF79B + 43F059)
12997153 92A7E7 4FD82943DGBF (4FD829 + 43DGBF)
14331681 A1A1A1 5GF07041C131 (5GF070 + 41C131)
14914368 A89BDD 685C5E403G7G (685C5E + 403G7G)
16119649 B6005B 79F2793D1EF2 (79F279 + 3D1EF2)
16702336 BCGA96 8267143AA382 (826714 + 3AA382)
17241120 C274E9 8B7ACD37GB1D (8B7ACD + 37GB1D)
18105633 CCD444 99A555332FFG (99A555 + 332FFG)
18575649 D16FA4 A12BE53043CG (A12BE5 + 3043CG)
19029088 D6E3A2 A9A83F2E3C64 (A9A83F + 2E3C64)
19893601 E032GE B953G527EG09 (B953G5 + 27EG09)
20363617 E5DE5E C1BD752420F9 (C1BD75 + 2420F9)
21015072 EDA78C CF11C41F95D8 (CF11C4 + 1F95D8)
22349601 FCA147 E9D1D912DG7F (E9D1D9 + 12DG7F)
22803040 G10645 F2FCDE0F1A78 (F2FCDE + 0F1A78)
24137568 GGGGGG GGGGGF000001 (GGGGGF + 000001)
```

Note that this algorithm allows the null string on the left, taken as zero, which automatically includes 1 as the first element of the sequence.

### Casting out nines (fast)

```
sub kaprekar-generator( :$base = 10 ) {
    my $base-m1 = $base - 1;
    gather loop (my $place = 1; ; ++$place) {
        my $nend = $base ** $place;
        loop (my $n = $base ** ($place - 1); $n < $nend; ++$n) {
            if $n * ($n - 1) %% $base-m1 {
                my $pend = $place * 2;
                loop (my $p = $place; $p < $pend; ++$p) {
                    my $B = $base ** $p;
                    my $lo = $n * ($B - $n) div ($B - 1);
                    my $hi = floor $n - $lo;
                    if $n * $n == $hi * $B + $lo and $lo {
                        take [$n, $hi, $lo];
                        last;
                    }
                }
            }
        }
    }
}

print " $_[0]" for kaprekar-generator() ...^ *.[0] >= 10_000;
say "\n";

say "Base 10 Kaprekar numbers < :10<1_000_000> = ", +(kaprekar-generator() ...^ *.[0] >= 1000000);
say '';

say "Base 17 Kaprekar numbers < :17<1_000_000>";

my &k17-gen = &kaprekar-generator.assuming(:base(17));

for k17-gen() ...^ *.[0] >= :17<1000000> -> @r {
    my ($n,$h,$l) = @r;
    my $n17 = $n.base(17);
    my $s = $n * $n;
    my $s17 = $s.base(17);
    my $h17 = $h.base(17);
    my $l17 = $l.base(17);
    $l17 = '0' x ($s17.chars - $h17.chars - $l17.chars) ~ $l17;
    say "$n $n17 $s17 ($h17 + $l17)";
}

```

(Same output.)


[User]
Brian Kernighan, in a lecture at the University of Nottingham, described a problem on which this task is based.

Problem

You are given a a data file of thousands of lines; each of three `whitespace` separated fields: a date, a one word name and the magnitude of the event.

Example lines from the file would be lines like:

```
8/27/1883    Krakatoa            8.8
5/18/1980    MountStHelens       7.6
3/13/2009    CostaRica           5.1
```

Task

* Create a program or script invocation to find all the events with magnitude greater than 6
* Assuming an appropriate name e.g. "data.txt" for the file:

:   1. Either: Show how your program is invoked to process a data file of that name.
    2. Or: Incorporate the file name into the program, (as it is assumed that the program is single use).

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2018.03

Pass in a file name, or use default for demonstration purposes.

```
$_ = @*ARGS[0] ?? @*ARGS[0].IO !! q:to/END/;
    8/27/1883    Krakatoa            8.8
    5/18/1980    MountStHelens       7.6
    3/13/2009    CostaRica           5.1
    END

map { .say if .words[2] > 6 }, .lines;

```


[User]
Flush the   keyboard   buffer.

This reads characters from the keyboard input and
discards them until there are no more currently buffered,
and then allows the program to continue.

*The program must not wait for users to type anything.*

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2018.12

Using termios to set some input attributes, flush the buffer & do unbuffered reads. Longer than strictly necessary to demonstrate concepts and make it easy to verify that it actually works as advertised.

```
use Term::termios;

constant $saved   = Term::termios.new( :fd($*IN.native-descriptor) ).getattr;
constant $termios = Term::termios.new( :fd($*IN.native-descriptor) ).getattr;

# set some modified input flags
$termios.unset_iflags(<BRKINT ICRNL ISTRIP IXON>);
$termios.unset_lflags(< ECHO ICANON IEXTEN>);
$termios.setattr(:DRAIN);

# reset terminal to original settings on exit
END { $saved.setattr(:NOW) }

# Sleep for a few seconds to give you time to fill the input buffer,
# type a bunch of random characters.
sleep 2;

# ------- The actual task --------
# Flush the input buffer

$termios.setattr(:FLUSH);

# --------------------------------

# Ctrl-C to exit
loop {
    # Read up to 5 bytes from STDIN
    # F5 through F12 are 5 bytes each
    my $keypress = $*IN.read: 5;
    # print the ordinals of the keypress character
    print $keypress.decode.ords;
    print "|";
}

```


[User]
Determine if a key has been pressed and store this in a variable.

If no key has been pressed, the program should continue without waiting.

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2018.10

```
use Term::ReadKey;

react {
    whenever key-pressed(:!echo) {
        given .fc {
            when 'q' { done }
            default { .uniname.say }
        }
    }
}

```


[User]
Task

Obtain a valid   **Y**   or   **N**   response from the keyboard.

The keyboard should be flushed, so that any outstanding key-presses are removed, preventing any existing   **Y**   or   **N**   key-press from being evaluated.

The response should be obtained as soon as   **Y**   or   **N**   are pressed, and there should be no need to press an   enter   key.

[Assistant]
(formerly Perl 6)

```
my $TTY = open("/dev/tty");

sub prompt-char($prompt) {
    ENTER shell "stty raw -echo min 1 time 1";
    LEAVE shell "stty sane";

    print $prompt;
    $TTY.read(1).decode('latin1');
}

say so prompt-char("Y or N? ") ~~ /:i y/;

```


[User]
Show how to link user defined methods to user defined keys.

An example of this is the facility provided by emacs for key bindings.

These key bindings may be application-specific or system-wide; state which you have done.

[Assistant]
(formerly Perl 6)

```
my $TTY = open("/dev/tty");
my @INPUT;

sub log($mess) { print "$mess\r\n" }

INIT { shell "stty raw -echo min 1 time 1"; log "(raw mode)"; }
END { shell "stty sane"; log "(sane mode)"; }

loop {
    push @INPUT, $TTY.getc unless @INPUT;
    given @INPUT.shift {
        when "q" | "\c4" { log "QUIT"; last; }

        when "\r" { log "CR" }

        when "j" { log "down" }
        when "k" { log "up" }
        when "h" { log "left" }
        when "l" { log "right" }

        when "J" { log "DOWN" }
        when "K" { log "UP" }
        when "H" { log "LEFT" }
        when "L" { log "RIGHT" }

        when "\e" {
            my $esc = '';
            repeat until my $x ~~ /^<alpha>$/ {
                push @INPUT, $TTY.getc unless @INPUT;
                $x = @INPUT.shift;
                $esc ~= $x;
            }
            given $esc {
                when "[A" { log "up" }
                when "[B" { log "down" }
                when "[C" { log "right" }
                when "[D" { log "left" }
                when "[1;2A" { log "UP" }
                when "[1;2B" { log "DOWN" }
                when "[1;2C" { log "RIGHT" }
                when "[1;2D" { log "LEFT" }
                default { log "Unrecognized escape: $esc"; }
            }
        }
        default { log "Unrecognized key: $_"; }
    }
}

```


[User]
Klarner-Rado sequences are a class of similar sequences that were studied by the mathematicians David Klarner and Richard Rado.

The most well known is defined as the thinnest strictly ascending sequence ***K*** which starts **1**, then, for each element ***n***, it will also contain somewhere in the sequence, ***2 × n + 1*** and ***3 × n + 1***.

So, the sequence ***K*** starts with **1**.

Set ***n*** equal to the first element **1**; the sequence will also contain ***2 × n + 1*** and ***3 × n + 1***, or **3** and **4**.

Set ***n*** equal to the next element: **3**, somewhere in the sequence it will contain ***2 × n + 1*** and ***3 × n + 1***, or **7** and **10**.

Continue setting ***n*** equal to each element in turn to add to the sequence.

Task

* Find and display the first one hundred elements of the sequence.
* Find and display the one thousandth and ten thousandth elements of the sequence.

*Preferably without needing to find an over abundance and sorting.*

Stretch

* Find and display the one hundred thousandth and one millionth elements of the sequence.

See also

* OEIS:A002977 - Klarner-Rado sequence: a(1) = 1; subsequent terms are defined by the rule that if m is present so are 2m+1 and 3m+1

[Assistant]
```
sub Klarner-Rado ($n) {
    my @klarner-rado = 1;
    my @next = x2, x3;

    loop {
        @klarner-rado.push: my $min = @next.min;
        @next[0] = x2 if @next[0] == $min;
        @next[1] = x3 if @next[1] == $min;
        last if +@klarner-rado > $n.max;
    }

    sub x2 { state $i = 0; @klarner-rado[$i++] × 2 + 1 }
    sub x3 { state $i = 0; @klarner-rado[$i++] × 3 + 1 }

    @klarner-rado[|$n]
}

use Lingua::EN::Numbers;

put "First 100 elements of Klarner-Rado sequence:";
put Klarner-Rado(^100).batch(10)».fmt("%3g").join: "\n";
put '';
put (($_».Int».&ordinal».tc »~» ' element: ').List Z~ |(List.new: (Klarner-Rado ($_ »-» 1))».&comma)
    given $(1e0, 1e1, 1e2, 1e3, 1e4, 1e5, 1e6)).join: "\n";

```

Output:

```
First 100 elements of Klarner-Rado sequence:
  1   3   4   7   9  10  13  15  19  21
 22  27  28  31  39  40  43  45  46  55
 57  58  63  64  67  79  81  82  85  87
 91  93  94 111 115 117 118 121 127 129
130 135 136 139 159 163 165 166 171 172
175 183 187 189 190 193 202 223 231 235
237 238 243 244 247 255 256 259 261 262
271 273 274 279 280 283 319 327 331 333
334 343 345 346 351 352 355 364 367 375
379 381 382 387 388 391 405 406 409 418

First element: 1
Tenth element: 21
One hundredth element: 418
One thousandth element: 8,487
Ten thousandth element: 157,653
One hundred thousandth element: 2,911,581
One millionth element: 54,381,285
```


[User]
A tourist wants to make a good trip at the weekend with his friends.

They will go to the mountains to see the wonders of nature, so he needs to pack well for the trip.

He has a good knapsack for carrying things, but knows that he can carry a maximum of only 4kg in it,   and it will have to last the whole day.

He creates a list of what he wants to bring for the trip but the total weight of all items is too much.

He then decides to add columns to his initial list detailing their weights and a numerical value representing how important the item is for the trip.

Here is the list:

:   :   :   :   :   :   :   Table of potential knapsack items

                            | item | weight (dag) | value |
                            | --- | --- | --- |
                            | map | 9 | 150 |
                            | compass | 13 | 35 |
                            | water | 153 | 200 |
                            | sandwich | 50 | 160 |
                            | glucose | 15 | 60 |
                            | tin | 68 | 45 |
                            | banana | 27 | 60 |
                            | apple | 39 | 40 |
                            | cheese | 23 | 30 |
                            | beer | 52 | 10 |
                            | suntan cream | 11 | 70 |
                            | camera | 32 | 30 |
                            | T-shirt | 24 | 15 |
                            | trousers | 48 | 10 |
                            | umbrella | 73 | 40 |
                            | waterproof trousers | 42 | 70 |
                            | waterproof overclothes | 43 | 75 |
                            | note-case | 22 | 80 |
                            | sunglasses | 7 | 20 |
                            | towel | 18 | 12 |
                            | socks | 4 | 50 |
                            | book | 30 | 10 |
                            | knapsack | ≤400 dag | ? |

The tourist can choose to take any combination of items from the list,
but only one of each item is available.

He may not cut or diminish the items, so he can only take whole units of any item.

Task

Show which items the tourist can carry in his knapsack so that their total weight does not
exceed 400 dag [4 kg],   and their total value is maximized.

[dag = decagram = 10 grams]

Related tasks

* Knapsack problem/Bounded
* Knapsack problem/Unbounded
* Knapsack problem/Continuous
* A\* search algorithm

[Assistant]
(formerly Perl 6)

#### Brute force

**Works with**: Rakudo version 2017.01

```
my class KnapsackItem { has $.name; has $.weight; has $.unit; }

multi sub pokem ([],           $,  $v = 0) { $v }
multi sub pokem ([$,  *@],     0,  $v = 0) { $v }
multi sub pokem ([$i, *@rest], $w, $v = 0) {
  my $key = "{+@rest} $w $v";
  (state %cache){$key} or do {
    my @skip = pokem @rest, $w, $v;
    if $w >= $i.weight { # next one fits
      my @put = pokem @rest, $w - $i.weight, $v + $i.unit;
      return (%cache{$key} = |@put, $i.name).list if @put[0] > @skip[0];
    }
    return (%cache{$key} = |@skip).list;
  }
}

my $MAX_WEIGHT = 400;
my @table = flat map -> $name,  $weight,  $unit {
     KnapsackItem.new: :$name, :$weight, :$unit;
},
    'map',                      9, 150,
    'compass',                 13,  35,
    'water',                  153, 200,
    'sandwich',                50, 160,
    'glucose',                 15,  60,
    'tin',                     68,  45,
    'banana',                  27,  60,
    'apple',                   39,  40,
    'cheese',                  23,  30,
    'beer',                    52,  10,
    'suntan cream',            11,  70,
    'camera',                  32,  30,
    'T-shirt',                 24,  15,
    'trousers',                48,  10,
    'umbrella',                73,  40,
    'waterproof trousers',     42,  70,
    'waterproof overclothes',  43,  75,
    'note-case',               22,  80,
    'sunglasses',               7,  20,
    'towel',                   18,  12,
    'socks',                    4,  50,
    'book',                    30,  10;

my ($value, @result) = pokem @table, $MAX_WEIGHT;
say "Value = $value\nTourist put in the bag:\n  " ~ @result;

```

Output:

```
Value = 1030
Tourist put in the bag:
  socks sunglasses note-case waterproof overclothes waterproof trousers suntan cream banana glucose sandwich water compass map
```

#### Dynamic programming

Much faster than the previous example.

**Translation of**: Perl

```
my $raw = q:to/TABLE/;
    map                      9  150
    compass                 13   35
    water                  153  200
    sandwich                50  160
    glucose                 15   60
    tin                     68   45
    banana                  27   60
    apple                   39   40
    cheese                  23   30
    beer                    52   10
    suntancream             11   70
    camera                  32   30
    T-shirt                 24   15
    trousers                48   10
    umbrella                73   40
    waterproof trousers     42   70
    waterproof overclothes  43   75
    note-case               22   80
    sunglasses               7   20
    towel                   18   12
    socks                    4   50
    book                    30   10
TABLE

my (@name, @weight, @value);

for $raw.lines.sort({-($_ ~~ m/\d+/)}).comb(/\S+[\s\S+]*/) -> $n, $w, $v {
    @name.push:   $n;
    @weight.push: $w;
    @value.push:  $v;
}

my $sum = 400;

my @subset;

sub optimal ($item, $sub-sum) {
    return 0, [] if $item < 0;
    return |@subset[$item][$sub-sum] if @subset[$item][$sub-sum];

    my @next = optimal($item-1, $sub-sum);

    if @weight[$item] > $sub-sum {
        @subset[$item][$sub-sum] = @next
    } else {
        my @skip = optimal($item-1, $sub-sum - @weight[$item]);

        if (@next[0] > @skip[0] + @value[$item] ) {
            @subset[$item][$sub-sum] = @next;
        } else {
            @subset[$item][$sub-sum] = @skip[0] + @value[$item], [|@skip[1], @name[$item]];
        }
    }

    |@subset[$item][$sub-sum]
}

my @solution = optimal(@name.end, $sum);
put "@solution[0]: ", @solution[1].sort.join(', ');

```

Output:

```
1030: banana, compass, glucose, map, note-case, sandwich, socks, sunglasses, suntancream, water, waterproof overclothes, waterproof trousers

```


[User]
A tourist wants to make a good trip at the weekend with his friends.

They will go to the mountains to see the wonders of nature.   So he needs some items during the trip.   Food, clothing, etc.   He has a good knapsack for carrying the things, but he knows that he can carry only 4 kg weight in his knapsack, because they will make the trip from morning to evening.

He creates a list of what he wants to bring for the trip, but the total weight of all items is too much.   He adds a value to each item.   The value represents how important the thing for the tourist.

The list contains which items are the wanted things for the trip, what is the weight and value of an item, and how many units does he have from each items.

This is the list:

:   :   :   :   :   Table of potential knapsack items

                    | item | weight (dag) (each) | value (each) | piece(s) |
                    | --- | --- | --- | --- |
                    | map | 9 | 150 | 1 |
                    | compass | 13 | 35 | 1 |
                    | water | 153 | 200 | 2 |
                    | sandwich | 50 | 60 | 2 |
                    | glucose | 15 | 60 | 2 |
                    | tin | 68 | 45 | 3 |
                    | banana | 27 | 60 | 3 |
                    | apple | 39 | 40 | 3 |
                    | cheese | 23 | 30 | 1 |
                    | beer | 52 | 10 | 3 |
                    | suntan cream | 11 | 70 | 1 |
                    | camera | 32 | 30 | 1 |
                    | T-shirt | 24 | 15 | 2 |
                    | trousers | 48 | 10 | 2 |
                    | umbrella | 73 | 40 | 1 |
                    | waterproof trousers | 42 | 70 | 1 |
                    | waterproof overclothes | 43 | 75 | 1 |
                    | note-case | 22 | 80 | 1 |
                    | sunglasses | 7 | 20 | 1 |
                    | towel | 18 | 12 | 2 |
                    | socks | 4 | 50 | 1 |
                    | book | 30 | 10 | 2 |
                    | knapsack | ≤400 dag | ? | ? |

The tourist can choose to take any combination of items from the list, and some number of each item is available   (see the column   **piece(s)**   in the list above).

He may not cut the items, so he can only take whole units of any item.

Task

Show which items does the tourist carry in his knapsack so that their total weight does not exceed 4 kg, and their total value is maximized.

Related tasks

* Knapsack problem/Unbounded
* Knapsack problem/Continuous
* Knapsack problem/0-1

[Assistant]
(formerly Perl 6)

#### Original

Recursive algorithm, with cache. Idiomatic code style, using multi-subs and a class.

**Works with**: Rakudo version 2017.01

```
my class KnapsackItem { has $.name; has $.weight; has $.unit; }

multi sub pokem ([],           $,  $v = 0) { $v }
multi sub pokem ([$,  *@],     0,  $v = 0) { $v }
multi sub pokem ([$i, *@rest], $w, $v = 0) {
  my $key = "{+@rest} $w $v";
  (state %cache){$key} or do {
    my @skip = pokem @rest, $w, $v;
    if $w >= $i.weight { # next one fits
      my @put = pokem @rest, $w - $i.weight, $v + $i.unit;
      return (%cache{$key} = |@put, $i.name).list if @put[0] > @skip[0];
    }
    return (%cache{$key} = |@skip).list;
  }
}

my $MAX_WEIGHT = 400;
my @table = flat map -> $name,  $weight,  $unit,     $count {
     KnapsackItem.new( :$name, :$weight, :$unit ) xx $count;
},
        'map',                         9,      150,    1,
        'compass',                     13,     35,     1,
        'water',                       153,    200,    2,
        'sandwich',                    50,     60,     2,
        'glucose',                     15,     60,     2,
        'tin',                         68,     45,     3,
        'banana',                      27,     60,     3,
        'apple',                       39,     40,     3,
        'cheese',                      23,     30,     1,
        'beer',                        52,     10,     3,
        'suntan cream',                11,     70,     1,
        'camera',                      32,     30,     1,
        'T-shirt',                     24,     15,     2,
        'trousers',                    48,     10,     2,
        'umbrella',                    73,     40,     1,
        'waterproof trousers',         42,     70,     1,
        'waterproof overclothes',      43,     75,     1,
        'note-case',                   22,     80,     1,
        'sunglasses',                  7,      20,     1,
        'towel',                       18,     12,     2,
        'socks',                       4,      50,     1,
        'book',                        30,     10,     2
        ;

my ($value, @result) = pokem @table, $MAX_WEIGHT;

(my %hash){$_}++ for @result;

say "Value = $value";
say "Tourist put in the bag:";
say "  # ITEM";
for %hash.sort -> $item {
  say "  {$item.value} {$item.key}";
}

```

Output:

```
Value = 1010
Tourist put in the bag:
  # ITEM
  3 banana
  1 cheese
  1 compass
  2 glucose
  1 map
  1 note-case
  1 socks
  1 sunglasses
  1 suntan cream
  1 water
  1 waterproof overclothes
```

#### Faster alternative

Also recursive, with cache, but substantially faster. Code more generic (ported from Perl solution).

```
my $raw = qq:to/TABLE/;
map             9       150     1
compass         13      35      1
water           153     200     2
sandwich        50      60      2
glucose         15      60      2
tin             68      45      3
banana          27      60      3
apple           39      40      3
cheese          23      30      1
beer            52      10      1
suntancream     11      70      1
camera          32      30      1
T-shirt         24      15      2
trousers        48      10      2
umbrella        73      40      1
w_trousers      42      70      1
w_overcoat      43      75      1
note-case       22      80      1
sunglasses       7      20      1
towel           18      12      2
socks            4      50      1
book            30      10      2
TABLE

my @items;
for split(["\n", /\s+/], $raw, :skip-empty) -> $n,$w,$v,$q {
    @items.push: %{ name => $n, weight => $w, value => $v, quant => $q}
}

my $max_weight = 400;

sub pick ($weight, $pos) {
    state %cache;
    return 0, 0 if $pos < 0 or $weight <= 0;

    my $key = $weight ~ $pos;
    %cache{$key} or do {
        my %item = @items[$pos];
        my ($bv, $bi, $bw, @bp) = (0, 0, 0);

        for 0 .. %item{'quant'} -> $i {
            last if $i * %item{'weight'} > $weight;
            my ($v, $w, @p) = pick($weight - $i * %item{'weight'}, $pos - 1);
            next if ($v += $i * %item{'value'}) <= $bv;

            ($bv, $bi, $bw, @bp) = ($v, $i, $w, |@p);
        }
        %cache{$key} = $bv, $bw + $bi * %item{'weight'}, |@bp, $bi;
    }
}

my ($v, $w, @p) = pick($max_weight, @items.end);
{ say "{@p[$_]} of @items[$_]{'name'}" if @p[$_] } for 0 .. @p.end;
say "Value: $v Weight: $w";

```

Output:

```
1 of map
1 of compass
1 of water
2 of glucose
3 of banana
1 of cheese
1 of suntancream
1 of w_overcoat
1 of note-case
1 of sunglasses
1 of socks
Value: 1010 Weight: 396
```


[User]
A thief burgles a butcher's shop, where he can select from some items.

The thief knows the weights and prices of each items.   Because he has a knapsack with 15 kg maximal capacity, he wants to select the items such that he would have his profit maximized.   He may cut the items;   the item has a reduced price after cutting that is proportional to the original price by the ratio of masses.   That means:   half of an item has half the price of the original.

This is the item list in the butcher's shop:

:   :   :   :   :   :   Table of potential knapsack items

                        | Item | Weight (kg) | Price (Value) |
                        | --- | --- | --- |
                        | beef | 3.8 | 36 |
                        | pork | 5.4 | 43 |
                        | ham | 3.6 | 90 |
                        | greaves | 2.4 | 45 |
                        | flitch | 4.0 | 30 |
                        | brawn | 2.5 | 56 |
                        | welt | 3.7 | 67 |
                        | salami | 3.0 | 95 |
                        | sausage | 5.9 | 98 |
                        | Knapsack | <=15 kg | ? |

Task

Show which items the thief carries in his knapsack so that their total weight does not exceed 15 kg, and their total value is maximized.

Related tasks

* Knapsack problem/Bounded
* Knapsack problem/Unbounded
* Knapsack problem/0-1

See also

* Wikipedia article:   continuous knapsack.

[Assistant]
(formerly Perl 6)

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

This Solutions sorts the item by WEIGHT/VALUE

```
class KnapsackItem {
  has $.name;
  has $.weight is rw;
  has $.price is rw;
  has $.ppw;

  method new (Str $n, Rat $w, Int $p) {
    self.bless(:name($n), :weight($w), :price($p), :ppw($w/$p))
  }

  method cut-maybe ($max-weight) {
    return False if $max-weight > $.weight;
    $.price = $max-weight / $.ppw;
    $.weight = $.ppw * $.price;
    return True;
  }

  method gist () { sprintf "%8s %1.2f   %3.2f",
                            $.name,
                                $.weight,
                                        $.price }
}

my $max-w = 15;
say    "Item    Portion Value";

.say for gather
    for < beef    3.8 36
          pork    5.4 43
          ham     3.6 90
          greaves 2.4 45
          flitch  4.0 30
          brawn   2.5 56
          welt    3.7 67
          salami  3.0 95
          sausage 5.9 98 >
        ==> map({ KnapsackItem.new($^a, $^b, $^c) })
        ==> sort *.ppw
    {
        my $last-one = .cut-maybe($max-w);
        take $_;
        $max-w -= .weight;
        last if $last-one;
    }

```

**Output:**

```
Item    Portion Value
  salami 3.00   95.00
     ham 3.60   90.00
   brawn 2.50   56.00
 greaves 2.40   45.00
    welt 3.50   63.38
```


[User]
A traveler gets diverted and has to make an unscheduled stop in what turns out to be Shangri La.   Opting to leave, he is allowed to take as much as he likes of the following items, so long as it will fit in his knapsack, and he can carry it.

He knows that he can carry no more than   25   'weights' in total;   and that the capacity of his knapsack is   0.25   'cubic lengths'.

Looking just above the bar codes on the items he finds their weights and volumes.   He digs out his recent copy of a financial paper and gets the value of each item.

|  |  |  |  |  |
| --- | --- | --- | --- | --- |
| Item | Explanation | Value (each) | weight | Volume (each) |
| panacea (vials of) | Incredible healing properties | 3000 | 0.3 | 0.025 |
| ichor (ampules of) | Vampires blood | 1800 | 0.2 | 0.015 |
| gold (bars) | Shiney shiney | 2500 | 2.0 | 0.002 |
| Knapsack | For the carrying of | - | <=25 | <=0.25 |

He can only take whole units of any item, but there is much more of any item than he could ever carry

Task

Show how many of each item does he take to maximize the value of items he is carrying away with him.

Note

* There are four solutions that maximize the value taken.   Only one *need* be given.

Related tasks

* Knapsack problem/Bounded
* Knapsack problem/Continuous
* Knapsack problem/0-1

[Assistant]
(formerly Perl 6)

**Works with**: rakudo version 2019.03.1

Brute force, looked a lot at the Ruby solution.

```
class KnapsackItem {
  has $.volume;
  has $.weight;
  has $.value;
  has $.name;

  method new($volume,$weight,$value,$name) {
    self.bless(:$volume, :$weight, :$value, :$name)
  }
};

my KnapsackItem $panacea .= new: 0.025, 0.3, 3000, "panacea";
my KnapsackItem $ichor   .= new: 0.015, 0.2, 1800, "ichor";
my KnapsackItem $gold    .= new: 0.002, 2.0, 2500, "gold";
my KnapsackItem $maximum .= new: 0.25,  25,  0   , "max";

my $max_val = 0;
my @solutions;
my %max_items;

for $panacea, $ichor, $gold -> $item {
    %max_items{$item.name} = floor min
                            $maximum.volume / $item.volume,
			    $maximum.weight / $item.weight;
}

for 0..%max_items<panacea>
       X 0..%max_items<ichor>
           X 0..%max_items<gold>
 -> ($p, $i, $g)
{
  next if $panacea.volume * $p + $ichor.volume * $i + $gold.volume * $g > $maximum.volume;
  next if $panacea.weight * $p + $ichor.weight * $i + $gold.weight * $g > $maximum.weight;
  given $panacea.value * $p + $ichor.value * $i + $gold.value * $g {
    if $_ > $max_val { $max_val = $_; @solutions = (); }
    when $max_val    { @solutions.push: $[$p,$i,$g] }
  }
}

say "maximum value is $max_val\npossible solutions:";
say "panacea\tichor\tgold";
.join("\t").say for @solutions;

```

**Output:**

```
maximum value is 54500
possible solutions:
panacea	ichor	gold
0	15	11
3	10	11
6	5	11
9	0	11
```


[User]
Task

Problem: you have a standard 8x8 chessboard, empty but for a single knight on some square. Your task is to emit a series of legal knight moves that result in the knight visiting every square on the chessboard exactly once. Note that it is *not* a requirement that the tour be "closed"; that is, the knight need not end within a single move of its start position.

Input and output may be textual or graphical, according to the conventions of the programming environment. If textual, squares should be indicated in algebraic notation. The output should indicate the order in which the knight visits the squares, starting with the initial position. The form of the output may be a diagram of the board with the squares numbered according to visitation sequence, or a textual list of algebraic coordinates in order, or even an actual animation of the knight moving around the chessboard.

Input: starting square

Output: move sequence

Related tasks

* A\* search algorithm
* N-queens problem
* Solve a Hidato puzzle
* Solve a Holy Knight's tour
* Solve a Hopido puzzle
* Solve a Numbrix puzzle
* Solve the no connection puzzle

[Assistant]
(formerly Perl 6)

**Translation of**: Perl

```
my @board;

my $I = 8;
my $J = 8;
my $F = $I*$J > 99 ?? "%3d" !! "%2d";

# Choose starting position - may be passed in on command line; if
# not, choose random square.
my ($i, $j);

if my $sq = shift @*ARGS {
  die "$*PROGRAM_NAME: illegal start square '$sq'\n" unless ($i, $j) = from_algebraic($sq);
}
else {
  ($i, $j) = (^$I).pick, (^$J).pick;
}

# Move sequence
my @moves = ();

for 1 .. $I * $J -> $move {
  # Record current move
  push @moves, to_algebraic($i,$j);
  @board[$i][$j] = $move;

  # Find move with the smallest degree
  my @min = (9);
  for possible_moves($i,$j) -> @target {
      my ($ni, $nj) = @target;
      my $next = possible_moves($ni,$nj);
      @min = $next, $ni, $nj if $next < @min[0];
  }

  # And make it
  ($i, $j) = @min[1,2];
}

# Print the move list
for @moves.kv -> $i, $m {
    print ',', $i %% 16 ?? "\n" !! " " if $i;
    print $m;
}
say "\n";

# And the board, with move numbers
for ^$I -> $i {
  for ^$J -> $j {
    # Assumes (1) ANSI sequences work, and (2) output
    # is light text on a dark background.
    print "\e[7m" if $i % 2 == $j % 2;
    printf $F, @board[$i][$j];
    print "\e[0m";
  }
  print "\n";
}

# Find the list of positions the knight can move to from the given square
sub possible_moves($i,$j) {
  grep -> [$ni, $nj] { $ni ~~ ^$I and $nj ~~ ^$J and !@board[$ni][$nj] },
    [$i-2,$j-1], [$i-2,$j+1], [$i-1,$j-2], [$i-1,$j+2],
    [$i+1,$j-2], [$i+1,$j+2], [$i+2,$j-1], [$i+2,$j+1];
}

# Return the algebraic name of the square identified by the coordinates
# i=rank, 0=black's home row; j=file, 0=white's queen's rook
sub to_algebraic($i,$j) {
    chr(ord('a') + $j) ~ ($I - $i);
}

# Return the coordinates matching the given algebraic name
sub from_algebraic($square where /^ (<[a..z]>) (\d+) $/) {
   $I - $1, ord(~$0) - ord('a');
}

```

(Output identical to Perl's above.)


[User]
The   Knuth shuffle   (a.k.a. the Fisher-Yates shuffle)   is an algorithm for randomly shuffling the elements of an array.

Task

Implement the Knuth shuffle for an integer array (or, if possible, an array of any type).

Specification

Given an array ***items*** with indices ranging from *0* to ***last***, the algorithm can be defined as follows (pseudo-code):

```
       for i from last downto 1 do:
           let j = random integer in range 0

            ≤

    {\displaystyle {\displaystyle \leq }}

 j

            ≤

    {\displaystyle {\displaystyle \leq }}

 i
           swap items[i] with items[j]

```

Notes

* It modifies the input array in-place.
* If that is unreasonable in your programming language, you may amend the algorithm to return the shuffled items as a new array instead.
* The algorithm can also be amended to iterate from left to right, if that is more convenient.

Test cases

:   :   :   :   :   :   | Input array | Possible output arrays |
                        | --- | --- |
                        | [] | [] |
                        | [10] | [10] |
                        | [10, 20] | [10, 20] [20, 10] |
                        | [10, 20, 30] | [10, 20, 30] [10, 30, 20] [20, 10, 30] [20, 30, 10] [30, 10, 20] [30, 20, 10] |

(These are listed here just for your convenience; no need to demonstrate them on the page.)

Related task

* Sattolo cycle

Other tasks related to string operations:

Metrics

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

Counting

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

Remove/replace

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

Anagrams/Derangements/shuffling

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

Find/Search/Determine

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

Formatting

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

Song lyrics/poems/Mad Libs/phrases

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

Tokenize

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

Sequences

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

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version #21 "Seattle"

```
sub shuffle (@a is copy) {
    for 1 ..^ @a -> $n {
        my $k = (0 .. $n).pick;
        $k == $n or @a[$k, $n] = @a[$n, $k];
    }
    return @a;
}
```

The shuffle is also built into the pick method on lists when you pass it a "whatever" for the number to pick:

```
my @deck = @cards.pick(*);
```


[User]
This is a method of randomly sampling n items from a set of M items, with equal probability; where M >= n and M, the number of items is unknown until the end.
This means that the equal probability sampling should be maintained for all successive items > n as they become available (although the content of successive samples can change).

The algorithm
:   * Select the first n items as the sample as they become available;
    * For the i-th item where i > n, have a random chance of n/i of keeping it. If failing this chance, the sample remains the same. If not, have it randomly (1/n) replace one of the previously selected n items of the sample.
    * Repeat   2nd step   for any subsequent items.

The Task
:   * Create a function `s_of_n_creator` that given

      n
      {\displaystyle {\displaystyle n}}
       the maximum sample size, returns a function `s_of_n` that takes one parameter, `item`.
    * Function `s_of_n` when called with successive items returns an equi-weighted random sample of up to n of its items so far, each time it is called, calculated using Knuths Algorithm S.
    * Test your functions by printing and showing the frequency of occurrences of the selected digits from 100,000 repetitions of:

    :   :   1. Use the s\_of\_n\_creator with n == 3 to generate an s\_of\_n.
            2. call s\_of\_n with each of the digits 0 to 9 in order, keeping the returned three digits of its random sampling from its last call with argument item=9.

Note: A class taking n and generating a callable instance/function might also be used.

Reference

* The Art of Computer Programming, Vol 2, 3.4.2 p.142

Related tasks

* One of n lines in a file
* Accumulator factory

[Assistant]
(formerly Perl 6)

```
sub s_of_n_creator($n) {
    my (@sample, $i);
    -> $item {
        if    ++$i    <= $n { @sample.push:      $item }
        elsif $i.rand <  $n { @sample[$n.rand] = $item }
        @sample
    }
}

my @bin;
for ^100000 {
    my &s_of_n = s_of_n_creator 3;
    sink .&s_of_n for ^9;
    @bin[$_]++ for s_of_n 9;
}

say @bin;

```

Output:

```
29975 30028 30246 30056 30004 29983 29836 29967 29924 29981
```


[User]
(Knuth's power tree is used for computing   xn   efficiently.)

Task

Compute and show the list of Knuth's power tree integers necessary for the computation of:

:   :   * xn   for any real   x   and any non-negative integer   n.

Then, using those integers, calculate and show the exact values of (at least) the integer powers below:

:   :   * 2n     where   n   ranges from   0 ──► 17   (inclusive)
        * 3191
        * 1.181

A  *zero*  power is often handled separately as a special case.

Optionally, support negative integer powers.

Example

An example of a small power tree for some low integers:

```
                                                                    1
                                                                     \
                                                                      2
                          ___________________________________________/ \
                         /                                              \
                        3                                                4
                       / \____________________________________            \
                      /                                       \            \
                     5                                         6            8
                    / \____________                           / \            \
                   /               \                         /   \            \
                  7                 10                      9     12           16
                 /                 //\\                     │      │           /\
                /            _____//  \\________            │      │          /  \
              14            /     /    \        \           │      │         /    \
             /│ \         11    13      15       20        18     24        17    32
            / │  \         │    /\      /\        │        /\      │        /\     │
           /  │   \        │   /  \    /  \       │       /  \     │       /  \    │
         19  21    28     22 23   26  25   30    40     27   36    48     33 34   64
         │   /\    /│\     │  │   /\   │   /\    /│\     │   /\    /│\     │  │   /\
         │  /  \  / │ \    │  │  /  \  │  /  \  / │ \    │  /  \  / │ \    │  │  /  \
        38 35 42 29 31 56 44 46 39 52 50 45 60 41 43 80 54 37 72 49 51 96 66 68 65 128

```

Where, for the power   43,   following the tree "downwards" from   1:

:   :   * (for   2)   compute square of   X,   store X2
        * (for   3)   compute   X \* X2,   store X3
        * (for   5)   compute   X3 \* X2,   store X5
        * (for 10)   compute square of   X5,   store X10
        * (for 20)   compute square of   X10,   store X20
        * (for 40)   compute square of   X20,   store X40
        * (for 43)   compute   X40 \* X3   (result).

Note that for every even integer (in the power tree),   one just squares the previous value.

For an odd integer, multiply the previous value with an appropriate odd power of   X   (which was previously calculated).
  For the last multiplication in the above example, it would be   (43-40),   or   3.

According to Dr. Knuth (see below),   computer tests have shown that this power tree gives optimum results for all of the   *n*
  listed above in the graph.

For   *n*   ≤ 100,000,   the power tree method:

:   :   * bests the factor method   88,803   times,
        * ties   11,191   times,
        * loses   6   times.

References
:   :   * Donald E. Knuth's book:   *The Art of Computer Programming, Vol. 2*, Second Edition, Seminumerical Algorithms, section 4.6.3: Evaluation of Powers.
        * link   codegolf.stackexchange.com/questions/3177/knuths-power-tree     It shows a   **Haskell**,   **Python**,   and a   **Ruby**   computer program example   (but they are mostly   *code golf*).
        * link   comeoncodeon.wordpress.com/tag/knuth/     (See the section on Knuth's Power Tree.)     It shows a   **C++**   computer program example.
        * link to Rosetta Code   addition-chain exponentiation.

[Assistant]
(formerly Perl 6)
Paths are random. It is possible replace `.pick(*)` with `.reverse` if you want paths as in Perl, or remove it for Python paths.

```
use v6;

sub power-path ($n ) {
    state @unused_nodes = (2,);
    state @power-tree = (False,0,1);

    until @power-tree[$n].defined {
        my $node = @unused_nodes.shift;

        for  $node X+ power-path($node).pick(*) {
            next if @power-tree[$_].defined;
            @unused_nodes.push($_);
            @power-tree[$_]= $node;
        }
    }

    ( $n, { @power-tree[$_] } ...^ 0 ).reverse;
}

multi power ( $, 0 ) { 1 };
multi power ( $n, $exponent ) {
    state  %p;
    my     %r =  %p{$n}  // ( 0 => 1, 1 => $n ) ;

    for power-path( $exponent ).rotor( 2 => -1 ) -> ( $p, $c ) {
        %r{ $c } = %r{ $p } * %r{ $c - $p }
    }

    %p{$n} := %r ;
    %r{ $exponent }
}

say 'Power paths: ',      pairs map *.&power-path,    ^18;
say '2 ** key = value: ', pairs map { 2.&power($_) }, ^18;

say 'Path for 191: ', power-path 191;
say '3 ** 191 = ',    power   3, 191;
say 'Path for 81: ',  power-path  81;
say '1.1 ** 81 = ',   power 1.1,  81;

```

Output:

```
Power paths: (0 => () 1 => (1) 2 => (1 2) 3 => (1 2 3) 4 => (1 2 4) 5 => (1 2 3 5) 6 => (1 2 3 6) 7 => (1 2 3 6 7) 8 => (1 2 4 8) 9 => (1 2 3 6 9) 10 => (1 2 3 5 10) 11 => (1 2 3 6 9 11) 12 => (1 2 3 6 12) 13 => (1 2 3 6 12 13) 14 => (1 2 3 6 12 14) 15 => (1 2 3 6 9 15) 16 => (1 2 4 8 16) 17 => (1 2 4 8 16 17))
2 ** key = value: (0 => 1 1 => 2 2 => 4 3 => 8 4 => 16 5 => 32 6 => 64 7 => 128 8 => 256 9 => 512 10 => 1024 11 => 2048 12 => 4096 13 => 8192 14 => 16384 15 => 32768 16 => 65536 17 => 131072)
Path for 191: (1 2 3 6 9 18 27 54 108 162 189 191)
3 ** 191 = 13494588674281093803728157396523884917402502294030101914066705367021922008906273586058258347
Path for 81: (1 2 3 6 9 18 27 54 81)
1.1 ** 81 = 2253.24023604401

```


[User] < About Knuth-Morris-Pratt String Search Algorithm >

[Assistant]
Based on pseudocode found in WP (kmp\_search & kmp\_table). Data and output format mostly follows the Wren entry.

```
# 20220810 Raku programming solution

sub kmp_search (@S where *.Bool, @W where *.Bool) {

   sub kmp_table (@W where *.Bool) {
      loop (my ($pos,$cnd,@T) = 1,0,-1 ; $pos < @W.elems ; ($pos, $cnd)>>++) {
         if @W[$pos] eq @W[$cnd] {
            @T[$pos]  = @T[$cnd]
         } else {
            @T[$pos]  = $cnd;
            while $cnd ≥ 0 and @W[$pos] ne @W[$cnd] { $cnd = @T[$cnd] }
         }
      }
      @T[$pos] = $cnd;
      return @T
   }

   return gather loop (my ($j,$k,@T) = 0,0, |kmp_table @W; $j < @S.elems; ) {
      if @W[$k] eq @S[$j] {
         ($j, $k)>>++;
         if $k == @W.elems {
	    take $j - $k;
            $k = @T[$k]
         }
      } else {
         ($j, $k)>>++ if ($k = @T[$k]) < 0
      }
   }
}

my @texts = [
   "GCTAGCTCTACGAGTCTA",
   "GGCTATAATGCGTA",
   "there would have been a time for such a word",
   "needle need noodle needle",
   "BharôtভাৰতBharôtভারতIndiaBhāratભારતBhāratभारतBhārataಭಾರತBhāratभारतBhāratamഭാരതംBhāratभारतBhāratभारतBharôtôଭାରତBhāratਭਾਰਤBhāratamभारतम्Bārataபாரதம்BhāratamഭാരതംBhāratadēsamభారతదేశం",
   "InhisbookseriesTheArtofComputerProgrammingpublishedbyAddisonWesleyDKnuthusesanimaginarycomputertheMIXanditsassociatedmachinecodeandassemblylanguagestoillustratetheconceptsandalgorithmsastheyarepresented",
   "Nearby farms grew a half acre of alfalfa on the dairy's behalf, with bales of all that alfalfa exchanged for milk.",
];

my @pats = ["TCTA", "TAATAAA", "word", "needle", "ഭാരതം", "put", "and", "alfalfa"];

say "text$_ = @texts[$_]" for @texts.keys ;
say();

for @pats.keys {
   my \j = $_ < 6 ?? $_ !! $_-1 ; # for searching text5 twice
   say "Found '@pats[$_]' in 'text{j}' at indices ", kmp_search @texts[j].comb, @pats[$_].comb
}

```

Output:

```
text0 = GCTAGCTCTACGAGTCTA
text1 = GGCTATAATGCGTA
text2 = there would have been a time for such a word
text3 = needle need noodle needle
text4 = BharôtভাৰতBharôtভারতIndiaBhāratભારતBhāratभारतBhārataಭಾರತBhāratभारतBhāratamഭാരതംBhāratभारतBhāratभारतBharôtôଭାରତBhāratਭਾਰਤBhāratamभारतम्Bārataபாரதம்BhāratamഭാരതംBhāratadēsamభారతదేశం
text5 = InhisbookseriesTheArtofComputerProgrammingpublishedbyAddisonWesleyDKnuthusesanimaginarycomputertheMIXanditsassociatedmachinecodeandassemblylanguagestoillustratetheconceptsandalgorithmsastheyarepresented
text6 = Nearby farms grew a half acre of alfalfa on the dairy's behalf, with bales of all that alfalfa exchanged for milk.

Found 'TCTA' in 'text0' at indices (6 14)
Found 'TAATAAA' in 'text1' at indices ()
Found 'word' in 'text2' at indices (40)
Found 'needle' in 'text3' at indices (0 19)
Found 'ഭാരതം' in 'text4' at indices (68 138)
Found 'put' in 'text5' at indices (26 90)
Found 'and' in 'text5' at indices (101 128 171)
Found 'alfalfa' in 'text6' at indices (33 87)
```


[User] Draw a Koch curve. See details: Koch curve

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2018.03

Koch curve, actually a full Koch snowflake.

```
use SVG;

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

my $flake = 'F--F--F' but Lindenmayer( { F => 'F+F--F+F' } );

$flake++ xx 5;
my @points = (50, 440);

for $flake.comb -> $v {
    state ($x, $y) = @points[0,1];
    state $d = 2 + 0i;
    with $v {
        when 'F' { @points.append: ($x += $d.re).round(.01), ($y += $d.im).round(.01) }
        when '+' { $d *= .5 + .8660254i }
        when '-' { $d *= .5 - .8660254i }
    }
}

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

```

See: Koch snowflake

Variation using 90° angles:

```
use SVG;

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

my $koch = 'F' but Lindenmayer( { F => 'F+F-F-F+F', } );

$koch++ xx 4;
my @points = (450, 250);

for $koch.comb -> $v {
    state ($x, $y) = @points[0,1];
    state $d = -5 - 0i;
    with $v {
        when 'F' { @points.append: ($x += $d.re).round(.01), ($y += $d.im).round(.01) }
        when /< + - >/ { $d *= "{$v}1i" }
    }
}

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

```

See: Koch curve variant with 90° angles


[User]
The Kolakoski sequence is an infinite sequence of natural numbers, (excluding zero); with the property that:

:   *if you form a new sequence from the counts of runs of the same number in the first sequence, this new sequence is the same as the first sequence*.

Example

This is *not* a Kolakoski sequence:

```
1,1,2,2,2,1,2,2,1,2,...
```

Its sequence of run counts, (sometimes called a run length encoding, (RLE); but a true RLE also gives the character that each run encodes), is calculated like this:

:   Starting from the leftmost number of the sequence we have `2` ones, followed by `3` twos, then `1` ones, `2` twos, `1` one, ...

The above gives the RLE of:

```
2, 3, 1, 2, 1, ...
```

The original sequence is different from its RLE in this case. **It would be the same for a true Kolakoski sequence**.

Creating a Kolakoski sequence

Lets start with the two numbers `(1, 2)` that we will cycle through; i.e. they will be used in this order:
 `1,2,1,2,1,2,....`

1. We start the sequence `s` with the first item from the cycle `c`:
    `1`
2. An index, `k`, into the, (expanding), sequence will step, or index through each item of the sequence `s` from the first, at its own rate.

We will arrange that the `k`'th item of `s` states how many *times* the *last* item of `s`should appear at the end of `s`.

We started `s` with `1` and therefore `s[k]` states that it should appear only the `1` time.

3. Increment `k`
4. Get the next item from `c` and append it to the end of sequence `s`. `s` will then become:
    `1, 2`
5. `k` was moved to the second item in the list and `s[k]` states that it should appear two times, so append another of the last item to the sequence `s`:
    `1, 2,2`
6. Increment `k`
7. Append the next item from the cycle to the list:
    `1, 2,2, 1`
8. `k` is now at the third item in the list that states that the last item should appear twice so add another copy of the last item to the sequence `s`:
    `1, 2,2, 1,1`
9. increment k

...

**Note** that the RLE of `1, 2, 2, 1, 1, ...` begins `1, 2, 2` which is the beginning of the original sequence. The generation algorithm ensures that this will always be the case.

Task

1. Create a routine/proceedure/function/... that given an initial ordered list/array/tuple etc of the natural numbers `(1, 2)`, returns the next number from the list when accessed in a cycle.
2. Create another routine that when given the initial ordered list `(1, 2)` and the minimum length of the sequence to generate; uses the first routine and the algorithm above, to generate at least the requested first members of the kolakoski sequence.
3. Create a routine that when given a sequence, creates the run length encoding of that sequence (as defined above) and returns the result of checking if sequence starts with the exact members of its RLE. (But *note*, due to sampling, do not compare the last member of the RLE).
4. Show, on this page, (compactly), the first 20 members of the sequence generated from `(1, 2)`
5. Check the sequence againt its RLE.
6. Show, on this page, the first 20 members of the sequence generated from `(2, 1)`
7. Check the sequence againt its RLE.
8. Show, on this page, the first 30 members of the Kolakoski sequence generated from `(1, 3, 1, 2)`
9. Check the sequence againt its RLE.
10. Show, on this page, the first 30 members of the Kolakoski sequence generated from `(1, 3, 2, 1)`
11. Check the sequence againt its RLE.

(There are rules on generating Kolakoski sequences from this method that are broken by the last example)

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2018.04.01

```
sub kolakoski (*@seed) {
    my $k = @seed[0] == 1 ?? 1 !! 0;
    my @k = flat @seed[0] == 1 ?? (1, @seed[1] xx @seed[1]) !! @seed[0] xx @seed[0],
      { $k++; @seed[$k % @seed] xx @k[$k] } … *
}

sub rle (*@series) { @series.join.subst(/((.)$0*)/, -> { $0.chars }, :g).comb».Int }

# Testing
for [1, 2], 20,
    [2, 1], 20,
    [1, 3, 1, 2], 30,
    [1, 3, 2, 1], 30
  -> @seed, $terms {
    say "\n## $terms members of the series generated from { @seed.perl } is:\n   ",
    my @kolakoski = kolakoski(@seed)[^$terms];
    my @rle = rle @kolakoski;
    say "   Looks like a Kolakoski sequence?: ", @rle[*] eqv @kolakoski[^@rle];
}

```

Output:

```
## 20 members of the series generated from [1, 2] is:
   [1 2 2 1 1 2 1 2 2 1 2 2 1 1 2 1 1 2 2 1]
   Looks like a Kolakoski sequence?: True

## 20 members of the series generated from [2, 1] is:
   [2 2 1 1 2 1 2 2 1 2 2 1 1 2 1 1 2 2 1 2]
   Looks like a Kolakoski sequence?: True

## 30 members of the series generated from [1, 3, 1, 2] is:
   [1 3 3 3 1 1 1 2 2 2 1 3 1 2 2 1 1 3 3 1 2 2 2 1 3 3 1 1 2 1]
   Looks like a Kolakoski sequence?: True

## 30 members of the series generated from [1, 3, 2, 1] is:
   [1 3 3 3 2 2 2 1 1 1 1 1 3 3 2 2 1 1 3 2 1 1 1 1 3 3 3 2 2 1]
   Looks like a Kolakoski sequence?: False
```


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

Kosaraju's algorithm (also known as the Kosaraju–Sharir algorithm) is a linear time algorithm to find the strongly connected components of a directed graph. Aho, Hopcroft and Ullman credit it to an unpublished paper from 1978 by S. Rao Kosaraju. The same algorithm was independently discovered by Micha Sharir and published by him in 1981. It makes use of the fact that the transpose graph (the same graph with the direction of every edge reversed) has exactly the same strongly connected components as the original graph.

For this task consider the directed graph with these connections:

```
 0 -> 1
 1 -> 2
 2 -> 0
 3 -> 1,  3 -> 2,  3 -> 4
 4 -> 3,  4 -> 5
 5 -> 2,  5 -> 6
 6 -> 5
 7 -> 4, 7  -> 6, 7 -> 7

```

And report the kosaraju strongly connected component for each node.

References

* The article on Wikipedia.

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2018.09

Inspired by Python & Kotlin entries.

Accepts a hash of lists/arrays holding the vertex (name => (neighbors)) pairs. No longer limited to continuous, positive, integer vertex names.

```
sub kosaraju (%k) {
    my %g = %k.keys.sort Z=> flat ^%k;
    my %h = %g.invert;
    my %visited;
    my @stack;
    my @transpose;
    my @connected;

    sub visit ($u) {
        unless %visited{$u} {
            %visited{$u} = True;
            for |%k{$u} -> $v {
                visit($v);
                @transpose[%g{$v}].push: $u;
            }
            @stack.push: $u;
        }
    }

    sub assign ($u, $root) {
        if %visited{$u} {
            %visited{$u}   = False;
            @connected[%g{$u}] = $root;
            assign($_, $root) for |@transpose[%g{$u}];
        }
    }

    .&visit for %g.keys;
    assign($_, $_) for @stack.reverse;

    (|%g{@connected}).pairs.categorize( *.value, :as(*.key) ).values.map: { %h{|$_} };
}

# TESTING

-> $test { say "\nStrongly connected components: ", |kosaraju($test).sort } for

# Same test data as all other entries, converted to a hash of lists
(((1),(2),(0),(1,2,4),(3,5),(2,6),(5),(4,6,7)).pairs.hash),

# Same layout test data with named vertices instead of numbered.
(
 %(:Andy<Bart>,
   :Bart<Carl>,
   :Carl<Andy>,
   :Dave<Bart Carl Earl>,
   :Earl<Dave Fred>,
   :Fred<Carl Gary>,
   :Gary<Fred>,
   :Hank<Earl Gary Hank>)
)

```

Output:

```
Strongly connected components: (0 1 2)(3 4)(5 6)(7)

Strongly connected components: (Andy Bart Carl)(Dave Earl)(Fred Gary)(Hank)
```


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

Task

Implement the   Kronecker product   of two matrices (arbitrary sized) resulting in a block matrix.

Test cases

Show results for each of the following two samples:

Sample 1 (from Wikipedia):

```

          ┌   ┐     ┌   ┐     ┌           ┐
          │1 2│     │0 5│     │ 0  5  0 10│
          │3 4│  x  │6 7│  =  │ 6  7 12 14│
	  └   ┘     └   ┘     │ 0 15  0 20│
	                      │18 21 24 28│
                              └           ┘

```

Sample 2:

```
          ┌     ┐     ┌       ┐     ┌                       ┐
          │0 1 0│     │1 1 1 1│     │0 0 0 0 1 1 1 1 0 0 0 0│
          │1 1 1│  x  │1 0 0 1│  =  │0 0 0 0 1 0 0 1 0 0 0 0│
          │0 1 0│     │1 1 1 1│     │0 0 0 0 1 1 1 1 0 0 0 0│
	  └     ┘     └       ┘     │1 1 1 1 1 1 1 1 1 1 1 1│
                                    │1 0 0 1 1 0 0 1 1 0 0 1│
                                    │1 1 1 1 1 1 1 1 1 1 1 1│
                                    │0 0 0 0 1 1 1 1 0 0 0 0│
                                    │0 0 0 0 1 0 0 1 0 0 0 0│
                                    │0 0 0 0 1 1 1 1 0 0 0 0│
                                    └                       ┘

```

See implementations and results below in JavaScript and PARI/GP languages.

Related task

* Kronecker product based fractals.

[Assistant]
(formerly Perl 6)

**Works with**: rakudo version 2017.01-34-g700a077

```
sub kronecker_product ( @a, @b ) {
    return (@a X @b).map: { .[0].list X* .[1].list };
}

.say for kronecker_product([ <1 2>, <3 4> ],
                           [ <0 5>, <6 7> ]);
say '';
.say for kronecker_product([ <0 1 0>,   <1 1 1>,   <0 1 0>  ],
                           [ <1 1 1 1>, <1 0 0 1>, <1 1 1 1>]);

```

Output:

```
(0 5 0 10)
(6 7 12 14)
(0 15 0 20)
(18 21 24 28)

(0 0 0 0 1 1 1 1 0 0 0 0)
(0 0 0 0 1 0 0 1 0 0 0 0)
(0 0 0 0 1 1 1 1 0 0 0 0)
(1 1 1 1 1 1 1 1 1 1 1 1)
(1 0 0 1 1 0 0 1 1 0 0 1)
(1 1 1 1 1 1 1 1 1 1 1 1)
(0 0 0 0 1 1 1 1 0 0 0 0)
(0 0 0 0 1 0 0 1 0 0 0 0)
(0 0 0 0 1 1 1 1 0 0 0 0)
```


[User]
This task is based on   Kronecker product   of two matrices.

If your language has no a built-in function for such product then you need to implement it first.

The essence of fractals is self-replication (at least, self-similar replications).

So, using   **n**   times self-product of the matrix   (filled with **0**/**1**)   we will have a fractal of the   **n**th   order.

Actually, "self-product" is a Kronecker power of the matrix.

In other words: for a matrix   **M**   and a power   **n**   create a function like   **matkronpow(M, n)**,

which returns   MxMxMx...   (**n**   times product).

A formal recurrent *algorithm* of creating Kronecker power of a matrix is the following:

Algorithm

* Let M is an initial matrix, and Rn is a resultant block matrix of the Kronecker power, where n is the power (a.k.a. order).
* Self-product of M, i.e., M x M producing R2 (resultant matrix with order/power 2).
* To receive the next order/power matrix use this recurrent formula: Rn = R(n-1) x M.
* Plot this Rn matrix to produce the ***n**th* order fractal.

Even just looking at the resultant matrix you can see what will be plotted.
There are virtually infinitely many fractals of this type. You are limited only by your creativity and
the power of your computer.

Task

Using Kronecker product implement and show two popular and well-known fractals, i.e.:

* Vicsek fractal;
* Sierpinski carpet fractal.

The last one ( Sierpinski carpet) is already here on RC, but built using different approaches.

Test cases

These 2 fractals (each order/power 4 at least) should be built using the following 2 simple matrices:

```
          │ 0 1 0 │    and    │ 1 1 1 │
          │ 1 1 1 │           │ 1 0 1 │
          │ 0 1 0 │           │ 1 1 1 │

```

Note

* Output could be a graphical or ASCII-art representation, but if an order is set > 4 then printing is not suitable.
* The orientation and distortion of the fractal could be your language/tool specific.
* It would be nice to see one additional fractal of your choice, e.g., based on using a single (double) letter(s) of an alphabet, any sign(s) or already made a resultant matrix of the Kronecker product.

See implementations and results below in JavaScript, PARI/GP and R languages. They have additional samples of "H", "+" and checkerboard fractals.

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2018.09

```
sub kronecker-product ( @a, @b ) { (@a X @b).map: { (.[0].list X* .[1].list).Array } }

sub kronecker-fractal ( @pattern, $order = 4 ) {
    my @kronecker = @pattern;
    @kronecker = kronecker-product(@kronecker, @pattern) for ^$order;
    @kronecker
}

use Image::PNG::Portable;

#Task requirements
my @vicsek = ( [0, 1, 0], [1, 1, 1], [0, 1, 0] );
my @carpet = ( [1, 1, 1], [1, 0, 1], [1, 1, 1] );
my @six    = ( [0,1,1,1,0], [1,0,0,0,1], [1,0,0,0,0], [1,1,1,1,0], [1,0,0,0,1], [1,0,0,0,1], [0,1,1,1,0] );

for  'vicsek', @vicsek, 4,
     'carpet', @carpet, 4,
     'six',    @six,    3
  -> $name,    @shape,  $order {
    my @img = kronecker-fractal( @shape, $order );
    my $png = Image::PNG::Portable.new: :width(@img[0].elems), :height(@img.elems);
    (^@img[0]).race(:12batch).map: -> $x {
        for ^@img -> $y {
            $png.set: $x, $y, |( @img[$y;$x] ?? <255 255 32> !! <16 16 16> );
        }
    }
    $png.write: "kronecker-{$name}-perl6.png";
}

```

See Kronecker-Vicsek, Kronecker-Carpet and Kronecker-Six images.


[User]
Introduction

An **L-system**, or Lindenmayer system, is a Turing-complete form of computaion, based in the parallel rewriting of symbols, usually provided and managed as strings. The name comes after Aristid Lindenmayer, a biologist who created it in order to simulate the growth of plants.

An L-system consists of:

:   * An alphabet of symbols
    * An initial string, known as the *axiom*
    * A set of rewriting rules, in he form A → B, where A is a single symbol and B is a string. The B string can contain zero, one or multiple symbols, including A.

Computation

At start, the *current* string is the axiom.

On each step of computation, every symbol Aₙ in the current string, having a rewriting rule Aₙ → Bₙ, is replaced by Bₙ. if the string Bₙ of the rule Aₙ → Bₙ contains the symbol Aₙ, the rule is not applied recursively. This is why this form of computation is called "parallel". Once the rewriting of symbols have been performed, the string was converted to another string, usually longer.

After a defined number of steps, the string is the result of the computation.

Example (rabbit population)

Alphabet: { `I`, `M` } for immature and mature rabbit. Only a mature rabbit can procreate a bunny

Rules:

:   * `I` → `M` (An immature rabbit will be a mature one in the next step)
    * `M` → `MI` (A mature rabbit will procreate a bunny in the next step)

Axiom: `I` (Let us start with a immature rabbit)

Computation (5 steps):

| Step | String | Notes |
| --- | --- | --- |
| 0 | `I` | the axiom |
| 1 | `M` |  |
| 2 | `MI` |  |
| 3 | `MIM` |  |
| 4 | `MIMMI` |  |
| 5 | `MIMMIMIM` | the result |

As you can see, the number of rabbits (the string length) in each step corresponds to the Fibonacci numbers.

Interpretation

It is common to make a further use of the resulting string. For example, symbols can represents musical notes, graphic operations, etc. In this sense, the string is like a program, and each symbol is a instruction of that program.

When using graphic operations, sometimes specific symbols represent turtle graphics operations such as moving forward, moving forward and drawing, turning a certain angle, etc. Other symbols could represent push/pop operations in a stack data structure, in order to save the position/angle of the pen, to be retieved later.

Task

Create a function, method, procedure, class, script, etc. (the solution) to compute the steps of a given L-system, and then, to perform the interpretation of the resulting string.

The inputs of the solution must be:

:   * The axiom
    * The rewritig rules, in a data structure natural to your language, it could be, for example, an array of pairs of strings (S, R) where S is the symbol and R is the :rewriting of the symbol
    * The number of steps to perform
    * The set of operations associated to each symbol of the resulting string, in a natural structure of your language, it could be, for example, an array of pairs (S, O) where S is a symbol and O is a structure that denotes delayed functionallity, such as anonymous functions, callbacks, pointers to functions, names of functions that can be invoked at run time with EVAL, lambda expressions, etc. (list is not exhaustive)

It is highly recommended for the solution to be absracted enought to let the inputs to be given separated from the solution, this is, the solution should be coded as its final place is inside a library which is invoked with specific values or parameters. It is not required for the solution to contain the necessary code be an actual library, it is enough that the code of the solution is separarted from the code of the invocation.

**Accesing environment objects**. When interpretation produces graphical output, it is common to have objects that operations should access, such as graphic handlers, a stack, etc. A solution is to define the operations requestng such objects as parameters. Another (maybe better) option is to use closures.

If there already exists a library, package, etc. for your language to perform execution of L-systems, indicate the name of the library, how to get it, if it is open source, and examples of how to use it (see below).

Test cases

Provide one or more test cases of L-systems executed and interpreted by your solution.

References

:   * Wikipedia: L-system

[Assistant]
L-system functionality as a Role that may be mixed in to a scalar.

```
# L-system functionality
role Lindenmayer {
    has %.rules;
    method succ {
        self.comb.map( { %!rules{$^c} // $c } ).join but Lindenmayer(%!rules)
    }
}

# Testing
my $rabbits = 'I' but Lindenmayer({I => 'M', M => 'MI'});

.say for $rabbits++ xx 6;

```

Output:

```
I
M
MI
MIM
MIMMI
MIMMIMIM
```

Also see:
Dragon\_curve#Raku
Hilbert\_curve#Raku
Koch\_curve#Raku
Peano\_curve#Raku
Penrose\_tiling#Raku
Sierpinski\_curve#Raku
Sierpinski\_arrowhead\_curve#Raku
Sierpinski\_square\_curve#Raku
among others...