[User]
Some definitions to help in the explanation

:   Floor operation

    :   https://en.wikipedia.org/wiki/Floor\_and\_ceiling\_functions
    :   Greatest integer less than or equal to a real number.

:   Bitwise Logical shift operators (c-inspired)

    :   https://en.wikipedia.org/wiki/Bitwise\_operation#Bit\_shifts
    :   Binary bits of value shifted left or right, with zero bits shifted in where appropriate.
    :   Examples are shown for 8 bit binary numbers; most significant bit to the left.

:   :   **<<** Logical shift left by given number of bits.

        :   E.g Binary 00110101 **<<** 2 == Binary 11010100

:   :   **>>** Logical shift right by given number of bits.

        :   E.g Binary 00110101 **>>** 2 == Binary 00001101

:   **^** Bitwise exclusive-or operator

    :   https://en.wikipedia.org/wiki/Exclusive\_or
    :   Bitwise comparison for if bits differ

        :   E.g Binary 00110101 **^** Binary 00110011 == Binary 00000110

Xorshift\_star Generator (pseudo-code)

```
   /* Let u64 denote an unsigned 64 bit integer type. */
   /* Let u32 denote an unsigned 32 bit integer type. */

   class Xorshift_star
       u64 state       /* Must be seeded to non-zero initial value */
       u64 const = HEX '2545F4914F6CDD1D'

       method seed(u64 num):
           state =  num
       end method

       method next_int():
           u64 x = state
           x = x ^ (x >> 12)
           x = x ^ (x << 25)
           x = x ^ (x >> 27)
           state = x
           u32 answer = ((x * const) >> 32)

           return answer
       end method

       method next_float():
           return float next_int() / (1 << 32)
       end method

   end class

```

:   Xorshift use

```
   random_gen = instance Xorshift_star
   random_gen.seed(1234567)
   print(random_gen.next_int())   /* 3540625527 */
   print(random_gen.next_int())   /* 2750739987 */
   print(random_gen.next_int())   /* 4037983143 */
   print(random_gen.next_int())   /* 1993361440 */
   print(random_gen.next_int())   /* 3809424708 */

```

Task

* Generate a class/set of functions that generates pseudo-random

numbers as shown above.

* Show that the first five integers genrated with the seed 1234567

are as shown above

* Show that for an initial seed of 987654321, the counts of 100\_000 repetitions of

```
   floor(random_gen.next_float() * 5)

```

:   Is as follows:

```
   0: 20103, 1: 19922, 2: 19937, 3: 20031, 4: 20007

```

* Show your output here, on this page.

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

**Translation of**: Python

Raku does not have unsigned Integers at this time (Integers are arbitrary sized) so use explicit bit masks during bitwise operations. All constants are encapsulated inside the class.

```
class Xorshift-star {
    has $!state;

    submethod BUILD ( Int :$seed where * > 0 = 1 ) { $!state = $seed }

    method next-int {
        $!state +^= $!state +> 12;
        $!state +^= $!state +< 25 +& (2⁶⁴ - 1);
        $!state +^= $!state +> 27;
        ($!state * 0x2545F4914F6CDD1D) +> 32 +& (2³² - 1)
    }

    method next-rat { self.next-int / 2³² }
}

# Test next-int
say 'Seed: 1234567; first five Int values';
my $rng = Xorshift-star.new( :seed(1234567) );
.say for $rng.next-int xx 5;

# Test next-rat (since these are rational numbers by default)
say "\nSeed: 987654321; first 1e5 Rat values histogram";
$rng = Xorshift-star.new( :seed(987654321) );
say ( ($rng.next-rat * 5).floor xx 100_000 ).Bag;

# Test with default seed
say "\nSeed: default; first five Int values";
$rng = Xorshift-star.new;
.say for $rng.next-int xx 5;

```

Output:

```
Seed: 1234567; first five Int values
3540625527
2750739987
4037983143
1993361440
3809424708

Seed: 987654321; first 1e5 Rat values histogram
Bag(0(20103), 1(19922), 2(19937), 3(20031), 4(20007))

Seed: default; first five Int values
1206177355
2882512552
3117485455
1303648416
241277360
```


[User]
Task

Write a program that creates an image from a Pseudorandom Number Generator (PRNG) algorithm's output.
The image can have the following dimensions:

:   :   1. 250px by 250px : If the algorithm requires the use of prime numbers, use 8-15 bit primes.
        2. 500px by 500px : If the algorithm requires the use of prime numbers, use 8-15 bit primes.
        3. 1000px by 1000px : If the algorithm requires the use of prime numbers, use 8-32 bit primes.
        4. 1500px by 1500px : If the algorithm requires the use of prime numbers, use 16-64 bit primes.

Possible Output

https://www.random.org/analysis/randbitmap-rdo.png

https://ibb.co/ZJPS16j

See also

* Blum Blum Shub [1].
* Blum-Micali Algorithm: [2].
* Linear congruential generator [3].

[Assistant]
MoarVM uses Mersenne Twister as its PRNG but a prime seeder is not mandatory.

```
# 20200818 Raku programming solution

use Image::PNG::Portable;

srand 2⁶³ - 25; # greatest prime smaller than 2⁶³ and the max my system can take

my @data = < 250 500 1000 1500 >;

@data.map: {
   my $o = Image::PNG::Portable.new: :width($_), :height($_);
   for ^$_ X ^$_ -> @pixel { # about 40% slower if split to ($x,$y) or (\x,\y)
      $o.set: @pixel[0], @pixel[1], 256.rand.Int, 256.rand.Int, 256.rand.Int
   }
   $o.write: "image$_.png" or die;
}

```

Output:

```
file image*.png
image1000.png: PNG image data, 1000 x 1000, 8-bit/color RGBA, non-interlaced
image1500.png: PNG image data, 1500 x 1500, 8-bit/color RGBA, non-interlaced
image250.png:  PNG image data, 250 x 250, 8-bit/color RGBA, non-interlaced
image500.png:  PNG image data, 500 x 500, 8-bit/color RGBA, non-interlaced

```

image500.png (sample image, offsite)


[User]
The Pythagoras tree is a fractal tree constructed from squares. It is named after Pythagoras because each triple of touching squares encloses a right triangle, in a configuration traditionally used to represent the Pythagorean theorem.

Task

Construct a Pythagoras tree of order 7 using only vectors (no rotation or trigonometric functions).

Related tasks

* Fractal tree

[Assistant]
(formerly Perl 6)
We'll generate a SVG image.

```
class Square {
    has Complex ($.position, $.edge);
    method size { $!edge.abs }
    method svg-polygon {
	qq[<polygon points="{join ' ', map
	{ ($!position + $_ * $!edge).reals.join(',') },
	0, 1, 1+1i, 1i}" style="fill:lime;stroke=black" />]
    }
    method left-child {
	self.new:
	position => $!position + i*$!edge,
	edge => sqrt(2)/2*cis(pi/4)*$!edge;
    }
    method right-child {
	self.new:
	position => $!position + i*$!edge + self.left-child.edge,
	edge => sqrt(2)/2*cis(-pi/4)*$!edge;
    }
}

BEGIN say '<svg width="500" height="500">';
END   say '</svg>';

sub tree(Square $s, $level = 0) {
    return if $level > 8;
    say $s.svg-polygon;
    tree($s.left-child, $level+1);
    tree($s.right-child, $level+1);
}

tree Square.new: :position(250+0i), :edge(60+0i);

```


[User]
One form of   **Pythagorean quadruples**   is   (for positive integers   **a**,   **b**,   **c**,   and   **d**):

:   :   :   :   :   :   :   :   a2   +   b2   +   c2     =     d2

An example:

:   :   :   :   :   :   :   :   22   +   32   +   62     =     72

:   :   :   :   :   which is:

:   :   :   :   :   :   :   :   4    +   9    +   36     =     49

Task

For positive integers up   **2,200**   (inclusive),   for all values of   **a**,
**b**,   **c**,   and   **d**,

find   (and show here)   those values of   **d**   that   *can't*   be represented.

Show the values of   **d**   on one line of output   (optionally with a title).

Related tasks

* Euler's sum of powers conjecture.
* Pythagorean triples.

Reference
:   * the Wikipedia article:   Pythagorean quadruple.

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2018.09

```
my \N = 2200;
my @sq = (0 .. N)»²;
my @not = False xx N;
@not[0] = True;

(1 .. N).race.map: -> $d {
    my $last = 0;
    for $d ... ($d/3).ceiling -> $a {
        for 1 .. ($a/2).ceiling -> $b {
            last if (my $ab = @sq[$a] + @sq[$b]) > @sq[$d];
            if (@sq[$d] - $ab).sqrt.narrow ~~ Int {
                @not[$d] = True;
                $last = 1;
                last
            }
        }
        last if $last;
    }
}

say @not.grep( *.not, :k );

```

Output:

```
(1 2 4 5 8 10 16 20 32 40 64 80 128 160 256 320 512 640 1024 1280 2048)
```


[User]
A Pythagorean triple is defined as three positive integers

(
a
,
b
,
c
)
{\displaystyle {\displaystyle (a,b,c)}}
 where

a
<
b
<
c
{\displaystyle {\displaystyle a<b<c}}
, and

a

2
+

b

2
=

c

2
.
{\displaystyle {\displaystyle a^{2}+b^{2}=c^{2}.}}

They are called primitive triples if

a
,
b
,
c
{\displaystyle {\displaystyle a,b,c}}
 are co-prime, that is, if their pairwise greatest common divisors

g
c
d
(
a
,
b
)
=

g
c
d
(
a
,
c
)
=

g
c
d
(
b
,
c
)
=
1
{\displaystyle {\displaystyle {\rm {gcd}}(a,b)={\rm {gcd}}(a,c)={\rm {gcd}}(b,c)=1}}
.

Because of their relationship through the Pythagorean theorem, a, b, and c are co-prime if a and b are co-prime (

g
c
d
(
a
,
b
)
=
1
{\displaystyle {\displaystyle {\rm {gcd}}(a,b)=1}}
).

Each triple forms the length of the sides of a right triangle, whose perimeter is

P
=
a
+
b
+
c
{\displaystyle {\displaystyle P=a+b+c}}
.

Task

The task is to determine how many Pythagorean triples there are with a perimeter no larger than 100 and the number of these that are primitive.

Extra credit

Deal with large values.   Can your program handle a maximum perimeter of 1,000,000?   What about 10,000,000?   100,000,000?

Note: the extra credit is not for you to demonstrate how fast your language is compared to others;   you need a proper algorithm to solve them in a timely manner.

Related tasks

* Euler's sum of powers conjecture
* List comprehensions
* Pythagorean quadruples

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2018.09

Here is a straight-forward, naïve brute force implementation:

```
constant limit = 100;

for [X] [^limit] xx 3 -> (\a, \b, \c) {
    say [a, b, c] if a < b < c and a + b + c <= limit and a*b + b*b == c*c
}

```

Output:

```
[3 4 5]
[5 12 13]
[6 8 10]
[7 24 25]
[8 15 17]
[9 12 15]
[9 40 41]
[10 24 26]
[12 16 20]
[12 35 37]
[15 20 25]
[15 36 39]
[16 30 34]
[18 24 30]
[20 21 29]
[21 28 35]
[24 32 40]

```

Here is a slightly less naive brute force implementation, but still not practical for large perimeter limits.

```
my $limit = 10000;
my atomicint $i = 0;
my @triples[$limit/2];
(3 .. $limit/2).race.map: -> $c {
   for 1 .. $c -> $a {
       my $b = ($c * $c - $a * $a).sqrt;
       last if $c + $a + $b > $limit;
       last if $a > $b;
       @triples[$i⚛++] = ([gcd] $c, $a, $b) > 1 ?? 0 !! 1 if $b == $b.Int;
   }
}

say my $result = "There are {+@triples.grep:{$_ !eqv Any}} Pythagorean Triples with a perimeter <= $limit,"
 ~"\nof which {[+] @triples.grep: so *} are primitive.";

```

Output:

```
There are 4858 Pythagorean Triples with a perimeter <= 10000,
of which 703 are primitive.
```

Here's a much faster version. Hint, "oyako" is Japanese for "parent/child". :-)

```
sub triples($limit) {
    my $primitive = 0;
    my $civilized = 0;

    sub oyako($a, $b, $c) {
        my $perim = $a + $b + $c;
        return if $perim > $limit;
        ++$primitive; $civilized += $limit div $perim;
        oyako( $a - 2*$b + 2*$c,  2*$a - $b + 2*$c,  2*$a - 2*$b + 3*$c);
        oyako( $a + 2*$b + 2*$c,  2*$a + $b + 2*$c,  2*$a + 2*$b + 3*$c);
        oyako(-$a + 2*$b + 2*$c, -2*$a + $b + 2*$c, -2*$a + 2*$b + 3*$c);
    }

    oyako(3,4,5);
    "$limit => ($primitive $civilized)";
}

for 10,100,1000 ... * -> $limit {
    say triples $limit;
}

```

Output:

```
10 => (0 0)
100 => (7 17)
1000 => (70 325)
10000 => (703 4858)
100000 => (7026 64741)
1000000 => (70229 808950)
10000000 => (702309 9706567)
100000000 => (7023027 113236940)
1000000000 => (70230484 1294080089)
^C
```

The geometric sequence of limits will continue on forever, so eventually when you get tired of waiting (about a billion on my computer), you can just stop it. Another efficiency trick of note: we avoid passing the limit in as a parameter to the inner helper routine, but instead supply the limit via the lexical scope. Likewise, the accumulators are referenced lexically, so only the triples themselves need to be passed downward, and nothing needs to be returned.

Here is an alternate version that avoids naming any scalars that can be handled by vector processing instead. Using vectorized ops allows a bit more potential for parallelization in theory, but techniques like the use of complex numbers to add two numbers in parallel, and the use of gather/take generate so much overhead that this version runs 70-fold slower than the previous one.

```
constant @coeff = [[+1, -2, +2], [+2, -1, +2], [+2, -2, +3]],
                  [[+1, +2, +2], [+2, +1, +2], [+2, +2, +3]],
                  [[-1, +2, +2], [-2, +1, +2], [-2, +2, +3]];

sub triples($limit) {

    sub oyako(@trippy) {
        my $perim = [+] @trippy;
        return if $perim > $limit;
        take (1 + ($limit div $perim)i);
        for @coeff -> @nine {
            oyako (map -> @three { [+] @three »*« @trippy }, @nine);
        }
        return;
    }

    my $complex = 0i + [+] gather oyako([3,4,5]);
    "$limit => ({$complex.re, $complex.im})";
}

for 10, 100, 1000, 10000 -> $limit {
    say triples $limit;
}

```

Output:

```
10 => (0 0)
100 => (7 17)
1000 => (70 325)
10000 => (703 4858)
```


[User]
Any rectangular

m
×
n
{\displaystyle {\displaystyle m\times n}}
 matrix

A
{\displaystyle {\displaystyle {\mathit {A}}}}
 can be decomposed to a product of an orthogonal matrix

Q
{\displaystyle {\displaystyle {\mathit {Q}}}}
 and an upper (right) triangular matrix

R
{\displaystyle {\displaystyle {\mathit {R}}}}
, as described in QR decomposition.

**Task**

Demonstrate the QR decomposition on the example matrix from the Wikipedia article:

:   :   A
        =

        (

        12

        −
        51

        4

        6

        167

        −
        68

        −
        4

        24

        −
        41
        )
        {\displaystyle {\displaystyle A={\begin{pmatrix}12&-51&4\\6&167&-68\\-4&24&-41\end{pmatrix}}}}

and the usage for linear least squares problems on the example from Polynomial regression. The method of Householder reflections should be used:

**Method**

Multiplying a given vector

a
{\displaystyle {\displaystyle {\mathit {a}}}}
, for example the first column of matrix

A
{\displaystyle {\displaystyle {\mathit {A}}}}
, with the Householder matrix

H
{\displaystyle {\displaystyle {\mathit {H}}}}
, which is given as

:   :   H
        =
        I
        −

        2

        u

        T
        u
        u

        u

        T
        {\displaystyle {\displaystyle H=I-{\frac {2}{u^{T}u}}uu^{T}}}

reflects

a
{\displaystyle {\displaystyle {\mathit {a}}}}
 about a plane given by its normal vector

u
{\displaystyle {\displaystyle {\mathit {u}}}}
. When the normal vector of the plane

u
{\displaystyle {\displaystyle {\mathit {u}}}}
 is given as

:   :   u
        =
        a
        −
        ‖
        a

        ‖

        2

        e

        1
        {\displaystyle {\displaystyle u=a-\|a\|\_{2}\;e\_{1}}}

then the transformation reflects

a
{\displaystyle {\displaystyle {\mathit {a}}}}
 onto the first standard basis vector

:   :   e

        1
        =
        [
        1

        0

        0

        .
        .
        .

        ]

        T
        {\displaystyle {\displaystyle e\_{1}=[1\;0\;0\;...]^{T}}}

which means that all entries but the first become zero. To avoid numerical cancellation errors, we should take the opposite sign of

a

1
{\displaystyle {\displaystyle a\_{1}}}
:

:   :   u
        =
        a
        +

        sign
        (

        a

        1
        )
        ‖
        a

        ‖

        2

        e

        1
        {\displaystyle {\displaystyle u=a+{\textrm {sign}}(a\_{1})\|a\|\_{2}\;e\_{1}}}

and normalize with respect to the first element:

:   :   v
        =

        u

        u

        1
        {\displaystyle {\displaystyle v={\frac {u}{u\_{1}}}}}

The equation for

H
{\displaystyle {\displaystyle H}}
 thus becomes:

:   :   H
        =
        I
        −

        2

        v

        T
        v
        v

        v

        T
        {\displaystyle {\displaystyle H=I-{\frac {2}{v^{T}v}}vv^{T}}}

or, in another form

:   :   H
        =
        I
        −
        β
        v

        v

        T
        {\displaystyle {\displaystyle H=I-\beta vv^{T}}}

with

:   :   β
        =

        2

        v

        T
        v
        {\displaystyle {\displaystyle \beta ={\frac {2}{v^{T}v}}}}

Applying

H
{\displaystyle {\displaystyle {\mathit {H}}}}
 on

a
{\displaystyle {\displaystyle {\mathit {a}}}}
 then gives

:   :   H

        a
        =
        −

        sign
        (

        a

        1
        )

        ‖
        a

        ‖

        2

        e

        1
        {\displaystyle {\displaystyle H\;a=-{\textrm {sign}}(a\_{1})\;\|a\|\_{2}\;e\_{1}}}

and applying

H
{\displaystyle {\displaystyle {\mathit {H}}}}
 on the matrix

A
{\displaystyle {\displaystyle {\mathit {A}}}}
 zeroes all subdiagonal elements of the first column:

:   :   H

        1

        A
        =

        (

        r

        11

        r

        12

        r

        13

        0

        ∗

        ∗

        0

        ∗

        ∗
        )
        {\displaystyle {\displaystyle H\_{1}\;A={\begin{pmatrix}r\_{11}&r\_{12}&r\_{13}\\0&\*&\*\\0&\*&\*\end{pmatrix}}}}

In the second step, the second column of

A
{\displaystyle {\displaystyle {\mathit {A}}}}
, we want to zero all elements but the first two, which means that we have to calculate

H
{\displaystyle {\displaystyle {\mathit {H}}}}
 with the first column of the *submatrix* (denoted \*), not on the whole second column of

A
{\displaystyle {\displaystyle {\mathit {A}}}}
.

To get

H

2
{\displaystyle {\displaystyle H\_{2}}}
, we then embed the new

H
{\displaystyle {\displaystyle {\mathit {H}}}}
 into an

m
×
n
{\displaystyle {\displaystyle m\times n}}
 identity:

:   :   H

        2
        =

        (

        1

        0

        0

        0

        H

        0

        )
        {\displaystyle {\displaystyle H\_{2}={\begin{pmatrix}1&0&0\\0&H&\\0&&\end{pmatrix}}}}

This is how we can, column by column, remove all subdiagonal elements of

A
{\displaystyle {\displaystyle {\mathit {A}}}}
 and thus transform it into

R
{\displaystyle {\displaystyle {\mathit {R}}}}
.

:   :   H

        n

        .
        .
        .

        H

        3

        H

        2

        H

        1
        A
        =
        R
        {\displaystyle {\displaystyle H\_{n}\;...\;H\_{3}H\_{2}H\_{1}A=R}}

The product of all the Householder matrices

H
{\displaystyle {\displaystyle {\mathit {H}}}}
, for every column, in reverse order, will then yield the orthogonal matrix

Q
{\displaystyle {\displaystyle {\mathit {Q}}}}
.

:   :   H

        1

        H

        2

        H

        3

        .
        .
        .

        H

        n
        =
        Q
        {\displaystyle {\displaystyle H\_{1}H\_{2}H\_{3}\;...\;H\_{n}=Q}}

The QR decomposition should then be used to solve linear least squares (Multiple regression) problems

A
x
=
b
{\displaystyle {\displaystyle {\mathit {A}}x=b}}
 by solving

:   :   R

        x
        =

        Q

        T

        b
        {\displaystyle {\displaystyle R\;x=Q^{T}\;b}}

When

R
{\displaystyle {\displaystyle {\mathit {R}}}}
 is not square, i.e.

m
>
n
{\displaystyle {\displaystyle m>n}}
 we have to cut off the

m
−
n
{\displaystyle {\displaystyle {\mathit {m}}-n}}
 zero padded bottom rows.

:   :   R
        =

        (

        R

        1

        0
        )
        {\displaystyle {\displaystyle R={\begin{pmatrix}R\_{1}\\0\end{pmatrix}}}}

and the same for the RHS:

:   :   Q

        T

        b
        =

        (

        q

        1

        q

        2
        )
        {\displaystyle {\displaystyle Q^{T}\;b={\begin{pmatrix}q\_{1}\\q\_{2}\end{pmatrix}}}}

Finally, solve the square upper triangular system by back substitution:

:   :   R

        1

        x
        =

        q

        1
        {\displaystyle {\displaystyle R\_{1}\;x=q\_{1}}}

[Assistant]
(formerly Perl 6)

**Works with**: rakudo version 2018.06

```
# sub householder translated from https://codereview.stackexchange.com/questions/120978/householder-transformation

use v6;

sub identity(Int:D $m --> Array of Array) {
   my Array @M;

   for 0 ..^ $m -> $i {
      @M.push: [0 xx $m];
      @M[$i; $i] = 1;
   }

   @M;
}

multi multiply(Array:D @A, @b where Array:D --> Array) {
   my @c;

   for ^@A X ^@b -> ($i, $j) {
      @c[$i] += @A[$i; $j] * @b[$j];
   }

   @c;
}

multi multiply(Array:D @A, Array:D @B --> Array of Array) {
   my Array @C;

   for ^@A X ^@B[0] -> ($i, $j) {
      @C[$i; $j] += @A[$i; $_] * @B[$_; $j] for ^@B;
   }

   @C;
}

sub transpose(Array:D @M --> Array of Array) {
   my ($rows, $cols) = (@M.elems, @M[0].elems);

   my Array @T;

   for ^$cols X ^$rows -> ($j, $i) {
      @T[$j; $i] = @M[$i; $j];
   }

   @T;
}

####################################################
# NOTE: @A gets overwritten and becomes @R, only need
# to return @Q.
####################################################
sub householder(Array:D @A --> Array) {
   my Int ($m, $n) = (@A.elems, @A[0].elems);
   my @v = 0 xx $m;
   my Array @Q = identity($m);

   for 0 ..^ $n -> $k {
      my Real $sum = 0;
      my Real $A0 = @A[$k; $k];
      my Int $sign = $A0 < 0 ?? -1 !! 1;

      for $k ..^ $m -> $i {
         $sum += @A[$i; $k] * @A[$i; $k];
      }

      my Real $sqr_sum = $sign * sqrt($sum);
      my Real $tmp = sqrt(2 * ($sum + $A0 * $sqr_sum));
      @v[$k] = ($sqr_sum  + $A0) / $tmp;

      for ($k + 1) ..^ $m -> $i {
         @v[$i] = @A[$i; $k] / $tmp;
      }

      for 0 ..^ $n -> $j {
         $sum = 0;

         for $k ..^ $m -> $i {
            $sum += @v[$i] * @A[$i; $j];
         }

         for $k ..^ $m -> $i {
            @A[$i; $j] -= 2 * @v[$i] * $sum;
         }
      }

      for 0 ..^ $m -> $j {
         $sum = 0;

         for $k ..^ $m -> $i {
            $sum += @v[$i] * @Q[$i; $j];
         }

         for $k ..^ $m -> $i {
            @Q[$i; $j] -= 2 * @v[$i] * $sum;
         }
      }
   }

   @Q
}

sub dotp(@a where Array:D, @b where Array:D --> Real) {
   [+] @a >>*<< @b;
}

sub upper-solve(Array:D @U, @b where Array:D, Int:D $n --> Array) {
   my @y = 0 xx $n;

   @y[$n - 1] = @b[$n - 1] / @U[$n - 1; $n - 1];

   for reverse ^($n - 1) -> $i {
      @y[$i] = (@b[$i] - (dotp(@U[$i], @y))) / @U[$i; $i];
   }

   @y;
}

sub polyfit(@x where Array:D, @y where Array:D, Int:D $n) {
   my Int $m = @x.elems;
   my Array @V;

   # Vandermonde matrix
   for ^$m X (0 .. $n) -> ($i, $j) {
      @V[$i; $j] = @x[$i] ** $j
   }

   # least squares
   my $Q = householder(@V);
   my @b = multiply($Q, @y);

   return upper-solve(@V, @b, $n + 1);
}

sub print-mat(Array:D @M, Str:D $name) {
   my Int ($m, $n) = (@M.elems, @M[0].elems);
   print "\n$name:\n";

   for 0 ..^ $m -> $i {
      for 0 ..^ $n -> $j {
         print @M[$i; $j].fmt("%12.6f ");
      }

      print "\n";
   }
}

sub MAIN() {
   ############
   # 1st part #
   ############
   my Array @A = (
      [12, -51,   4],
      [ 6, 167, -68],
      [-4,  24, -41],
      [-1,   1,   0],
      [ 2,   0,   3]
   );

   print-mat(@A, 'A');
   my $Q = householder(@A);
   $Q = transpose($Q);
   print-mat($Q, 'Q');
   # after householder, @A is now @R
   print-mat(@A, 'R');
   print-mat(multiply($Q, @A), 'check Q x R = A');

   ############
   # 2nd part #
   ############
   my @x = [^11];
   my @y = [1, 6, 17, 34, 57, 86, 121, 162, 209, 262, 321];

   my @coef = polyfit(@x, @y, 2);

   say
      "\npolyfit:\n",
      <constant X X^2>.fmt("%12s"),
      "\n",
      @coef.fmt("%12.6f");
}

```

output:

```
A:
   12.000000   -51.000000     4.000000
    6.000000   167.000000   -68.000000
   -4.000000    24.000000   -41.000000
   -1.000000     1.000000     0.000000
    2.000000     0.000000     3.000000

Q:
   -0.846415     0.391291    -0.343124     0.066137    -0.091462
   -0.423207    -0.904087     0.029270     0.017379    -0.048610
    0.282138    -0.170421    -0.932856    -0.021942     0.143712
    0.070535    -0.014041     0.001099     0.997401     0.004295
   -0.141069     0.016656     0.105772     0.005856     0.984175

R:
  -14.177447   -20.666627    13.401567
   -0.000000  -175.042539    70.080307
    0.000000     0.000000    35.201543
   -0.000000     0.000000     0.000000
    0.000000    -0.000000     0.000000

check Q x R = A:
   12.000000   -51.000000     4.000000
    6.000000   167.000000   -68.000000
   -4.000000    24.000000   -41.000000
   -1.000000     1.000000    -0.000000
    2.000000    -0.000000     3.000000

polyfit:
    constant            X          X^2
    1.000000     2.000000     3.000000

```


[User]
Generate the sequence of quad-power prime seeds: positive integers **n** such that:

```
   n1 + n + 1, n2 + n + 1, n3 + n + 1 and n4 + n + 1 are all prime.

```

Task

* Find and display the first fifty quad-power prime seeds. (Or as many as are reasonably supported by your languages math capability if it is less.)

Stretch

* Find and display the position and value of first with a value greater than one million, two million, three million.

See also

* Task: Penta-power prime seeds * A219117 - Numbers n such that n^1+n+1, n^2+n+1, n^3+n+1 and n^4+n+1 are all prime

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

my @qpps = lazy (1..*).hyper(:5000batch).grep: -> \n { my \k = n + 1; (n+k).is-prime && (n²+k).is-prime && (n³+k).is-prime && (n⁴+k).is-prime }

say "First fifty quad-power prime seeds:\n" ~ @qpps[^50].batch(10)».&comma».fmt("%7s").join: "\n";

say "\nFirst quad-power prime seed greater than:";

for 1..10 {
    my $threshold = Int(1e6 × $_);
    my $key = @qpps.first: * > $threshold, :k;
    say "{$threshold.&cardinal.fmt: '%13s'} is the {ordinal-digit $key + 1}: {@qpps[$key].&comma}";
}

```

Output:

```
First fifty quad-power prime seeds:
      1       2       5       6      69     131     426   1,665   2,129   2,696
  5,250   7,929   9,689  13,545  14,154  14,286  16,434  19,760  25,739  27,809
 29,631  36,821  41,819  46,619  48,321  59,030  60,500  61,955  62,321  73,610
 77,685  79,646  80,535  82,655  85,251  86,996  91,014  96,566  97,739 105,939
108,240 108,681 119,754 122,436 123,164 126,489 140,636 150,480 153,179 163,070

First quad-power prime seed greater than:
  one million is the 141st: 1,009,286
  two million is the 234th: 2,015,496
three million is the 319th: 3,005,316
 four million is the 383rd: 4,004,726
 five million is the 452nd: 5,023,880
  six million is the 514th: 6,000,554
seven million is the 567th: 7,047,129
eight million is the 601st: 8,005,710
 nine million is the 645th: 9,055,151
  ten million is the 701st: 10,023,600
```


[User]
Task

Find the sequence of increasing primes, q, from 2 up to but excluding **16,000**,
where the successor of q is the least prime, p, such that p - q is a perfect square.

[Assistant]
```
my @sqp = 2, -> $previous {
    my $next;
    for (1..∞).map: *² {
        $next = $previous + $_;
        last if $next.is-prime;
    }
    $next
} … *;

say "{+$_} matching numbers:\n", $_».fmt('%5d').batch(7).join: "\n" given
    @sqp[^(@sqp.first: * > 16000, :k)];

```

Output:

```
49 matching numbers:
    2     3     7    11    47    83   227
  263   587   911   947   983  1019  1163
 1307  1451  1487  1523  1559  2459  3359
 4259  4583  5483  5519  5843  5879  6203
 6779  7103  7247  7283  7607  7643  8219
 8363 10667 11243 11279 11423 12323 12647
12791 13367 13691 14591 14627 14771 15671
```


[User]
Quaternions   are an extension of the idea of   complex numbers.

A complex number has a real and complex part,   sometimes written as     `a + bi,`

where     `a`     and     `b`     stand for real numbers, and     `i`     stands for the square root of minus 1.

An example of a complex number might be     `-3 + 2i,`

where the real part,     `a`     is     `-3.0`     and the complex part,     `b`     is     `+2.0.`

A quaternion has one real part and *three* imaginary parts,     `i,`       `j,`     and     `k.`

A quaternion might be written as     `a + bi + cj + dk.`

In the quaternion numbering system:

:   :   :   * `i∙i = j∙j = k∙k = i∙j∙k = -1,`         or more simply,
            * `ii  = jj  = kk  = ijk   = -1.`

The order of multiplication is important, as, in general, for two quaternions:

:   :   :   :   `q1`     and     `q2:`         `q1q2 ≠ q2q1.`

An example of a quaternion might be     `1 +2i +3j +4k`

There is a list form of notation where just the numbers are shown and the imaginary multipliers    `i,`       `j,`     and     `k`     are assumed by position.

So the example above would be written as     `(1, 2, 3, 4)`

Task

Given the three quaternions and their components:

```
   q  = (1, 2, 3, 4) = (a,  b,  c,  d)
   q1 = (2, 3, 4, 5) = (a1, b1, c1, d1)
   q2 = (3, 4, 5, 6) = (a2, b2, c2, d2)

```

And a wholly real number     `r = 7.`

Create functions   (or classes)   to perform simple maths with quaternions including computing:

1. The norm of a quaternion:
   `=

   a

   2
   +

   b

   2
   +

   c

   2
   +

   d

   2
   {\displaystyle {\displaystyle ={\sqrt {a^{2}+b^{2}+c^{2}+d^{2}}}}}`
2. The negative of a quaternion:
      `= (-a, -b, -c, -d)`
3. The conjugate of a quaternion:
      `= ( a, -b, -c, -d)`
4. Addition of a real number     `r`     and a quaternion     `q:`
      `r + q = q + r = (a+r, b, c, d)`
5. Addition of two quaternions:
      `q1 + q2 = (a1+a2, b1+b2, c1+c2, d1+d2)`
6. Multiplication of a real number and a quaternion:
      `qr = rq = (ar, br, cr, dr)`
7. Multiplication of two quaternions     `q1`     and   `q2`     is given by:
      `( a1a2 − b1b2 − c1c2 − d1d2,`
     `a1b2 + b1a2 + c1d2 − d1c2,`
     `a1c2 − b1d2 + c1a2 + d1b2,`
     `a1d2 + b1c2 − c1b2 + d1a2 )`
8. Show that, for the two quaternions     `q1`     and     `q2:
    q1q2 ≠ q2q1`

If a language has built-in support for quaternions, then use it.

C.f.

* Vector products
* On Quaternions;   or on a new System of Imaginaries in Algebra.   By Sir William Rowan Hamilton LL.D, P.R.I.A., F.R.A.S., Hon. M. R. Soc. Ed. and Dub., Hon. or Corr. M. of the Royal or Imperial Academies of St. Petersburgh, Berlin, Turin and Paris, Member of the American Academy of Arts and Sciences, and of other Scientific Societies at Home and Abroad, Andrews' Prof. of Astronomy in the University of Dublin, and Royal Astronomer of Ireland.

[Assistant]
(formerly Perl 6)

```
class Quaternion {
    has Real ( $.r, $.i, $.j, $.k );

    multi method new ( Real $r, Real $i, Real $j, Real $k ) {
        self.bless: :$r, :$i, :$j, :$k;
    }
    multi qu(*@r) is export { Quaternion.new: |@r }
    sub postfix:<j>(Real $x) is export { qu 0, 0, $x, 0 }
    sub postfix:<k>(Real $x) is export { qu 0, 0, 0, $x }

    method Str   () { "$.r + {$.i}i + {$.j}j + {$.k}k" }
    method reals () { $.r, $.i, $.j, $.k }
    method conj  () { qu $.r, -$.i, -$.j, -$.k }
    method norm  () { sqrt [+] self.reals X** 2 }

    multi infix:<eqv> ( Quaternion $a, Quaternion $b ) is export { $a.reals eqv $b.reals }

    multi infix:<+> ( Quaternion $a,       Real $b ) is export { qu $b+$a.r, $a.i, $a.j, $a.k }
    multi infix:<+> (       Real $a, Quaternion $b ) is export { qu $a+$b.r, $b.i, $b.j, $b.k }
    multi infix:<+> ( Quaternion $a,    Complex $b ) is export { qu $b.re + $a.r, $b.im + $a.i, $a.j, $a.k }
    multi infix:<+> (    Complex $a, Quaternion $b ) is export { qu $a.re + $b.r, $a.im + $b.i, $b.j, $b.k }
    multi infix:<+> ( Quaternion $a, Quaternion $b ) is export { qu $a.reals Z+ $b.reals }

    multi prefix:<-> ( Quaternion $a ) is export { qu $a.reals X* -1 }

    multi infix:<*> ( Quaternion $a,       Real $b ) is export { qu $a.reals X* $b }
    multi infix:<*> (       Real $a, Quaternion $b ) is export { qu $b.reals X* $a }
    multi infix:<*> ( Quaternion $a,    Complex $b ) is export { $a * qu $b.reals, 0, 0 }
    multi infix:<*> ( Complex $a,    Quaternion $b ) is export { $b R* qu $a.reals, 0, 0 }

    multi infix:<*> ( Quaternion $a, Quaternion $b ) is export {
	my @a_rijk            = $a.reals;
	my ( $r, $i, $j, $k ) = $b.reals;
	return qu [+]( @a_rijk Z* $r, -$i, -$j, -$k ), # real
		  [+]( @a_rijk Z* $i,  $r,  $k, -$j ), # i
		  [+]( @a_rijk Z* $j, -$k,  $r,  $i ), # j
		  [+]( @a_rijk Z* $k,  $j, -$i,  $r ); # k
    }
}
import Quaternion;

my $q  = 1 + 2i + 3j + 4k;
my $q1 = 2 + 3i + 4j + 5k;
my $q2 = 3 + 4i + 5j + 6k;
my $r  = 7;

say "1) q norm  = {$q.norm}";
say "2) -q      = {-$q}";
say "3) q conj  = {$q.conj}";
say "4) q  + r  = {$q + $r}";
say "5) q1 + q2 = {$q1 + $q2}";
say "6) q  * r  = {$q  * $r}";
say "7) q1 * q2 = {$q1 * $q2}";
say "8) q1q2 { $q1 * $q2 eqv $q2 * $q1 ?? '==' !! '!=' } q2q1";

```

Output:

```
1) q norm  = 5.47722557505166
2) -q      = -1 + -2i + -3j + -4k
3) q conj  = 1 + -2i + -3j + -4k
4) q  + r  = 8 + 2i + 3j + 4k
5) q1 + q2 = 5 + 7i + 9j + 11k
6) q  * r  = 7 + 14i + 21j + 28k
7) q1 * q2 = -56 + 16i + 24j + 26k
8) q1q2 != q2q1
```


[User]
Illustration of FIFO behavior

Task

Implement a FIFO queue.

Elements are added at one side and popped from the other in the order of insertion.

Operations:

:   * push   (aka *enqueue*)    - add element
    * pop     (aka *dequeue*)    - pop first element
    * empty                             - return truth value when empty

Errors:

* handle the error of trying to pop from an empty queue (behavior depends on the language and platform)

See

* Queue/Usage   for the built-in FIFO or queue of your language or standard library.

See also

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

[Assistant]
(formerly Perl 6)

**Works with**: rakudo version 2018.03

We could build a new container class to do FIFO pretty easily, but Arrays already do everything needed by a FIFO queue, so it is easier to just compose a Role on the existing Array class.

```
role FIFO {
    method enqueue ( *@values ) { # Add values to queue, returns the number of values added.
        self.push: @values;
        return @values.elems;
    }
    method dequeue ( ) {         # Remove and return the first value from the queue.
                                 # Return Nil if queue is empty.
        return self.elems ?? self.shift !! Nil;
    }
    method is-empty ( ) {        # Check to see if queue is empty. Returns Boolean value.
        return self.elems == 0;
    }
}

# Example usage:

my @queue does FIFO;

say @queue.is-empty;                         # -> Bool::True
for <A B C> -> $i { say @queue.enqueue: $i } # 1 \n 1 \n 1
say @queue.enqueue: Any;                     # -> 1
say @queue.enqueue: 7, 8;                    # -> 2
say @queue.is-empty;                         # -> Bool::False
say @queue.dequeue;                          # -> A
say @queue.elems;                            # -> 4
say @queue.dequeue;                          # -> B
say @queue.is-empty;                         # -> Bool::False
say @queue.enqueue('OHAI!');                 # -> 1
say @queue.dequeue until @queue.is-empty;    # -> C \n Any() \n [7 8] \n OHAI!
say @queue.is-empty;                         # -> Bool::True
say @queue.dequeue;                          # ->

```


[User]
Illustration of FIFO behavior

Task

Create a queue data structure and demonstrate its operations.

(For implementations of queues, see the FIFO task.)

Operations:

:   :   * push       (aka *enqueue*) - add element
        * pop         (aka *dequeue*) - pop first element
        * empty     - return truth value when empty

See also

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

[Assistant]
(formerly Perl 6)

Raku maintains the same list operators of Perl 5, for this task, the operations are:

```
push (aka enqueue) -- @list.push
pop (aka dequeue)  -- @list.shift
empty              -- !@list.elems

```

but there's also @list.pop which removes a item from the end,
and @list.unshift which add a item on the start of the list.
Example:

```
my @queue = < a >;

@queue.push('b', 'c'); # [ a, b, c ]

say @queue.shift; # a
say @queue.pop; # c

say @queue; # [ b ]
say @queue.elems; # 1

@queue.unshift('A'); # [ A, b ]
@queue.push('C'); # [ A, b, C ]

```


[User]
Use the quickselect algorithm on the vector

:   [9, 8, 7, 6, 5, 0, 1, 2, 3, 4]

To show the first, second, third, ... up to the tenth largest member of the vector, in order, here on this page.

* Note: Quick*sort* has a separate task.

[Assistant]
(formerly Perl 6)

**Translation of**: Python

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

```
my @v = <9 8 7 6 5 0 1 2 3 4>;
say map { select(@v, $_) }, 1 .. 10;

sub partition(@vector, $left, $right, $pivot-index) {
    my $pivot-value = @vector[$pivot-index];
    @vector[$pivot-index, $right] = @vector[$right, $pivot-index];
    my $store-index = $left;
    for $left ..^ $right -> $i {
        if @vector[$i] < $pivot-value {
            @vector[$store-index, $i] = @vector[$i, $store-index];
            $store-index++;
        }
    }
    @vector[$right, $store-index] = @vector[$store-index, $right];
    return $store-index;
}

sub select( @vector,
            \k where 1 .. @vector,
            \l where 0 .. @vector = 0,
            \r where l .. @vector = @vector.end ) {

    my ($k, $left, $right) = k, l, r;

    loop {
        my $pivot-index = ($left..$right).pick;
        my $pivot-new-index = partition(@vector, $left, $right, $pivot-index);
        my $pivot-dist = $pivot-new-index - $left + 1;
        given $pivot-dist <=> $k {
            when Same {
                return @vector[$pivot-new-index];
            }
            when More {
                $right = $pivot-new-index - 1;
            }
            when Less {
                $k -= $pivot-dist;
                $left = $pivot-new-index + 1;
            }
        }
    }
}

```

Output:

```
0 1 2 3 4 5 6 7 8 9
```


[User]
A quine is a self-referential program that can,
without any external access, output its own source.

A   **quine**   (named after Willard Van Orman Quine)   is also known as:

:   :   * *self-reproducing automata*   (1972)
        * *self-replicating program*         or   *self-replicating computer program*
        * *self-reproducing program*      or   *self-reproducing computer program*
        * *self-copying program*             or   *self-copying computer program*

It is named after the philosopher and logician
who studied self-reference and quoting in natural language,
as for example in the paradox "'Yields falsehood when preceded by its quotation' yields falsehood when preceded by its quotation."

"Source" has one of two meanings. It can refer to the text-based program source.
For languages in which program source is represented as a data structure, "source" may refer to the data structure: quines in these languages fall into two categories: programs which print a textual representation of themselves, or expressions which evaluate to a data structure which is equivalent to that expression.

The usual way to code a quine works similarly to this paradox: The program consists of two identical parts, once as plain code and once *quoted* in some way (for example, as a character string, or a literal data structure). The plain code then accesses the quoted code and prints it out twice, once unquoted and once with the proper quotation marks added. Often, the plain code and the quoted code have to be nested.

Task

Write a program that outputs its own source code in this way. If the language allows it, you may add a variant that accesses the code directly. You are not allowed to read any external files with the source code. The program should also contain some sort of self-reference, so constant expressions which return their own value which some top-level interpreter will print out. Empty programs producing no output are not allowed.

There are several difficulties that one runs into when writing a quine, mostly dealing with quoting:

* Part of the code usually needs to be stored as a string or structural literal in the language, which needs to be quoted somehow. However, including quotation marks in the string literal itself would be troublesome because it requires them to be escaped, which then necessitates the escaping character (e.g. a backslash) in the string, which itself usually needs to be escaped, and so on.
  + Some languages have a function for getting the "source code representation" of a string (i.e. adds quotation marks, etc.); in these languages, this can be used to circumvent the quoting problem.
  + Another solution is to construct the quote character from its character code, without having to write the quote character itself. Then the character is inserted into the string at the appropriate places. The ASCII code for double-quote is 34, and for single-quote is 39.
* Newlines in the program may have to be reproduced as newlines in the string, which usually requires some kind of escape sequence (e.g. "\n"). This causes the same problem as above, where the escaping character needs to itself be escaped, etc.
  + If the language has a way of getting the "source code representation", it usually handles the escaping of characters, so this is not a problem.
  + Some languages allow you to have a string literal that spans multiple lines, which embeds the newlines into the string without escaping.
  + Write the entire program on one line, for free-form languages (as you can see for some of the solutions here, they run off the edge of the screen), thus removing the need for newlines. However, this may be unacceptable as some languages require a newline at the end of the file; and otherwise it is still generally good style to have a newline at the end of a file. (The task is not clear on whether a newline is required at the end of the file.) Some languages have a print statement that appends a newline; which solves the newline-at-the-end issue; but others do not.

**Next to the Quines presented here, many other versions can be found on the Quine page.**

Related task
:   * print itself.

[Assistant]
(formerly Perl 6)

**Translation of**: Haskell

**Works with**: Rakudo version #32 "Pisa"

```
my &f = {say $^s, $^s.raku;}; f "my \&f = \{say \$^s, \$^s.raku;}; f "
```

Note the terminating newline.

**Works with**: Rakudo version 2014.04

A more compact, but still purely functional, approach:

```
{.fmt($_).say}(<{.fmt($_).say}(<%s>)>)
```

Note again the terminating newline.


[User]
Pretty much every programming language has some form of quoting construct to allow embedding of data in a program, be it literal strings, numeric data or some combination thereof.

Show examples of the quoting constructs in your language. Explain where they would likely be used, what their primary use is, what limitations they have and why one might be preferred over another. Is one style interpolating and another not? Are there restrictions on the size of the quoted data? The type? The format?

This is intended to be open-ended and free form. If you find yourself writing more than a few thousand words of explanation, summarize and provide links to relevant documentation; but do provide at least a fairly comprehensive summary here, on this page, **NOT** just a link to [See the language docs].

Note: This is primarily for quoting constructs for data to be "embedded" in some way into a program. If there is some special format for external data, it may be mentioned but that isn't the focus of this task.

[Assistant]
The Perl philosophy, which Raku thoroughly embraces, is that "There Is More Than One Way To Do It" (often abbreviated to TIMTOWTDI). Quoting constructs is an area where this is enthusiastically espoused.

Raku has a whole quoting specific sub-language built in called Q. Q changes the parsing rules inside the quoting structure and allows extremely fine control over how the enclosed data is parsed. Every quoting construct in Raku is some form of a Q syntactic structure, using adverbs to fine tune the desired behavior, though many of the most commonly used have some form of "shortcut" syntax for quick and easy use. Usually, when using an adverbial form, you may omit the Q: and just use the adverb.

In general, any and all quoting structures have theoretically unlimited length, in practice, are limited by memory size, practically, it is probably better to limit them to less than a gigabyte or so, though they can be read as a supply, not needing to hold the whole thing in memory at once. They can hold multiple lines of data. How the new-line characters are treated depends entirely on any white-space adverb applied. The Q forms use some bracketing character to delimit the quoted data. Usually some Unicode bracket ( [], {}, <>, ⟪⟫, whatever,) that has an "open" and "close" bracketing character, but they may use any non-indentifier character as both opener and closer. ||, //, ??, the list goes on. The universal escape character for constructs that allow escaping is backslash "\".

The following exposition barely scratches the surface. For much more detail see the **Raku documentation for quoting constructs** for a comprehensive list of adverbs and examples.

The most commonly used

:   * **Q[ ]**, common shortcut: **｢ ｣**

:   :   :   The most basic form of quoting. No interpolation, no escaping. What is inside is what you get. No exceptions.

:   :   :   ｢Ze backslash characters!\ \Zay do NUSSING!! \｣ -> Ze backslash characters!\ \Zay do NUSSING!! \

:   * "Single quote" quoting. - **Q:q[ ]**, adverbial: **q[ ]**, common shortcut: **' '**

:   :   :   No interpolation, but allow escaping quoting characters.

:   :   :   'Don\'t panic!' -> Don't panic!

:   * "Double quote" quoting. - **Q:qq[ ]**, adverbial: **qq[ ]**, common shortcut: **" "**

:   :   :   Interpolates: embedded variables, logical characters, character codes, continuations.

:   :   :   "Hello $name, today is {Date.today} \c[grinning face] \n🦋" -> Hello Dave, today is 2020-03-25 😀
        :   🦋

:   :   :   Where $name is a variable containing a name (one would imagine), {Date.today} is a continuation - a code block to be executed and the result inserted, \c[grinning face] is the literal emoji character 😀 as a character code, \n is a new-line character and 🦋 is an emoji butterfly. Allows escape sequences, and indeed, requires them when embedding data that *looks* like it may be an interpolation target but isn't.

*Every adverbial form has both a q and a qq variant to give the 'single quote' or "double quote" semantics. Only the most commonly used are listed here.*

:   * "Quote words" - **Q:qw[ ]**, adverbial: **qw[ ]**, common shortcut: **< >**

:   :   :   No interpolation, but allow escaping quote characters. (Inherited from the q[] escape semantics)

:   :   :   < a β 3 Б 🇩🇪 >

:   :   :   Parses whatever is inside as a white-space separated list of words. Returns a list with all white space removed. Any numeric values are returned as **allomorphs**.

:   :   :   That list may be operated on directly with any listy operator or it may be assigned to a variable.

:   :   :   say < a β 3 Б 🇩🇪 >[\*-1] # What is the last item in the list? (🇩🇪)

:   :   :   say +< a β 3 Б 🇩🇪 > # How many items are in the list? (5)

:   * "Quote words with white space protection" - **Q:qww[ ]**, adverbial: **qww[ ]**

:   :   :   May preserve white space by enclosing it in single or double quote characters, otherwise identical to qw[ ].

:   :   :   say qww< a β '3 Б' 🇩🇪 >[2] # Item 2 in the list? (3 Б)

:   * "Double quote words" quoting. - **Q:qqw[ ]**, adverbial: **qqw[ ]**, common shortcut: **<< >>** or **« »**

:   :   :   Interpolates similar to standard double quote, but then interprets the interpolated string as a white space separated list.

:   * "Double quoted words with white space protection" - **Q:qqww[ ]**, adverbial: **qqww[ ]**

:   :   :   Same as qqw[ ] but retains quoted white space.

:   * "System command" - **Q:qx[ ]**, adverbial: **qx[ ]**

:   :   :   Execute the string inside the construct as a system command and return the result.

:   * "Heredoc format" - **Q:q:to/END/; END**, adverbial: **q:to/END/; END**

:   :   :   Return structured text between two textual delimiters. Depending on the adverb, may or may not interpolate (same rules as other adverbial forms.) Will return the text with the same indent as the indent of the final delimiter. The text delimiter is user chosen (and is typically, though not necessarily, uppercase) as is the delimiter bracket character.

There are other adverbs to give precise control what interpolates or doesn't, that may be applied to any of the above constructs. See **the doc page for details**. There is another whole sub-genre dedicated to **quoting regexes**.


[User]
Definition

The **radical** of a positive integer is defined as the product of its distinct prime factors.

Although the integer 1 has no prime factors, its radical is regarded as 1 by convention.

Example

The radical of 504 = 2³ x 3² x 7 is: 2 x 3 x 7 = 42.

Task

1. Find and show on this page the radicals of the first **50** positive integers.

2. Find and show the radicals of the integers: **99999, 499999** and **999999**.

3. By considering their radicals, show the distribution of the first **one million** positive integers by numbers of distinct prime factors (hint: the maximum number of distinct factors is 7).

Bonus

By (preferably) using an independent method, calculate the number of primes and the number of powers of primes less than or equal to **one million** and hence check that your answer in 3. above for numbers with one distinct prime is correct.

Related tasks

* Square-free integers
* Almost prime

References

* Wikipedia article Radical of an integer
* OEIS sequence A007947: Largest square free number dividing n

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

sub radical ($_) { [×] unique .&prime-factors }

say "First fifty radicals:\n" ~
  (1..50).map({.&radical}).batch(10)».fmt("%2d").join: "\n";
say '';

printf "Radical for %7s => %7s\n", .&comma, comma .&radical
  for 99999, 499999, 999999;

my %rad = 1 => 1;
my $limit = 1e6.Int;

%rad.push: $_ for (2..$limit).race(:1000batch).map: {(unique .&prime-factors).elems => $_};

say "\nRadical factor count breakdown, 1 through {comma $limit}:";
say .key ~ " => {comma +.value}" for sort %rad;

my @primes = (2..$limit).grep: &is-prime;

my int $powers;
@primes.&upto($limit.sqrt.floor).map: -> $p {
   for (2..*) { ($p ** $_) < $limit ?? ++$powers !! last }
}

say qq:to/RADICAL/;

    Up to {comma $limit}:
    Primes: {comma +@primes}
    Powers:    $powers
    Plus 1:      1
    Total:  {comma 1 + $powers + @primes}
    RADICAL

```

Output:

```
First fifty radicals:
 1  2  3  2  5  6  7  2  3 10
11  6 13 14 15  2 17  6 19 10
21 22 23  6  5 26  3 14 29 30
31  2 33 34 35  6 37 38 39 10
41 42 43 22 15 46 47  6  7 10

Radical for  99,999 =>  33,333
Radical for 499,999 =>   3,937
Radical for 999,999 => 111,111

Radical factor count breakdown, 1 through 1,000,000:
1 => 78,735
2 => 288,726
3 => 379,720
4 => 208,034
5 => 42,492
6 => 2,285
7 => 8

Up to 1,000,000:
Primes: 78,498
Powers:    236
Plus 1:      1
Total:  78,735

```


[User]
Railway circuit

Given   **n**   sections of curve tracks,   each one being an arc of   **30°**   of radius   **R**.

The goal is to build and count all possible different railway circuits.

Constraints

* **n** = 12 + k\*4     (k = 0, 1,  ...)
* The circuit must be a closed, connected graph, and the last arc must join the first one
* Duplicates, either by symmetry, translation, reflexion, or rotation must be eliminated.
* Paths may overlap or cross each other.
* All tracks must be used.

Illustrations

http://www.echolalie.org/echolisp/duplo.html

Task

Write a function which counts and displays all possible circuits   **Cn**   for   **n** = 12, 16, 20.

Extra credit for   **n** = 24, 28, ... 48     (no display, only counts).

A circuit   **Cn**   will be displayed as a list, or sequence of   **n**   Right=1/Left=-1 turns.

Examples
:   :   :   :   C12 = (1,1,1,1,1,1,1,1,1,1,1,1)               and
            :   C12 = (-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1)

Straight tracks (extra-extra credit)

Suppose we have   **m** = k\*2   sections of straight tracks, each of length   L.

Such a circuit is denoted   **Cn,m**

A circuit is a sequence of   +1,   -1,   or   0 = straight move.

Count the number of circuits   **Cn,m**   with   **n**   same as above and   **m** = 2  to  8

[Assistant]
**Translation of**: Julia

```
#!/usr/bin/env raku

# 20200406 Raku programming solution

class 𝒫 { has ($.x, $.y) } # Point

multi infix:<⊞>(𝒫 \p, 𝒫 \q) { 𝒫.bless: x => p.x + q.x , y => p.y + q.y }
multi infix:<≈>(𝒫 \p, 𝒫 \q) { my $*TOLERANCE = .0001; p.x ≅ q.x and p.y ≅ q.y }

constant twelvesteps = (1..12).map: { 𝒫.new: x =>sin(π*$_/6), y=>cos(π*$_/6) };
constant foursteps   = (1..4).map:  { 𝒫.new: x =>sin(π*$_/2), y=>cos(π*$_/2) };

sub digits($n!, $base!, $pad=0) {
   my @output =  $n.base($base).comb.reverse;
   @output.append: 0 xx ($pad - +@output) if $pad > +@output;
   return @output
} # rough port of https://docs.julialang.org/en/v1/base/numbers/#Base.digits

sub addsymmetries(%infound, \turns) {
   my @allsym.push: | .&{ (0..^+@$_).map: -> $n {rotate @$_, $n} } for turns, -«turns;
   %infound{$_} = True for @allsym;
   return @allsym.max
}

sub isclosedpath(@turns, \straight, \start= 𝒫.bless: x => 0, y => 0) {
   return False unless ( @turns.sum % (straight ?? 4 !! 12) ) == 0;
   my ($angl, $point) = (0, start);
   for @turns -> $turn {
      $angl  += $turn;
      $point ⊞= straight ?? foursteps[$angl % 4] !! twelvesteps[$angl % 12];
   }
   return $point ≈ start;
}

sub allvalidcircuits(\N, \doPrint=False, \straight=False) {
   my ( @found, %infound );
   say "\nFor N of ",N," and ", straight ?? "straight" !! "curved", " track: ";
   for (straight ?? (0..^3**N) !! (0..^2**N)) -> \i {
      my @turns = straight ??
         digits(i,3,N).map: { $_ == 0 ??  0 !! ($_ == 1 ?? -1 !! 1) } !!
         digits(i,2,N).map: { $_ == 0 ?? -1 !! 1 } ;
      if isclosedpath(@turns, straight) && !(%infound{@turns.Str}:exists) {
         my \canon = addsymmetries(%infound, @turns);
         say canon if doPrint;
         @found.push: canon.Str;
      }
   }
   say "There are ", +@found, " unique valid circuits.";
   return @found
}

allvalidcircuits($_, $_ < 28) for 12, 16, 20;    # 12, 16 … 36
allvalidcircuits($_, $_ < 12, True) for 4, 6, 8; # 4, 6 … 16;

```

Output:

```
For N of 12 and curved track:
[1 1 1 1 1 1 1 1 1 1 1 1]
There are 1 unique valid circuits.

For N of 16 and curved track:
[1 1 1 1 1 1 1 -1 1 1 1 1 1 1 1 -1]
There are 1 unique valid circuits.

For N of 20 and curved track:
[1 1 1 1 1 1 1 1 -1 -1 1 1 1 1 1 1 1 1 -1 -1]
[1 1 1 1 1 1 1 -1 1 1 -1 1 1 1 1 1 1 1 -1 -1]
[1 1 1 1 1 1 1 -1 1 -1 1 1 1 1 1 1 1 -1 1 -1]
[1 1 1 1 1 1 -1 1 1 -1 1 1 1 1 1 1 -1 1 1 -1]
[1 1 1 1 1 -1 1 1 1 -1 1 1 1 1 1 -1 1 1 1 -1]
[1 1 1 1 -1 1 1 1 1 -1 1 1 1 1 -1 1 1 1 1 -1]
There are 6 unique valid circuits.

For N of 4 and straight track:
[1 1 1 1]
There are 1 unique valid circuits.

For N of 6 and straight track:
[1 1 0 1 1 0]
There are 1 unique valid circuits.

For N of 8 and straight track:
[1 1 0 0 1 1 0 0]
[1 0 1 0 1 0 1 0]
[1 1 0 1 0 1 1 -1]
[1 1 1 0 -1 -1 -1 0]
[1 1 1 1 1 1 1 1]
[1 1 1 1 -1 -1 -1 -1]
[1 1 1 -1 1 1 1 -1]
There are 7 unique valid circuits.
```


[User]
Task
:   Print out the word 'RAINBOW' to the screen with every character being a different color of the rainbow.

[Assistant]
```
use Color::Names:api<2>;
use Color::Names::X11 :colors;

for 'RAINBOW',
    'Another phrase that happens to contain the word "Rainbow".'
  -> $rainbow-text {
    for $rainbow-text.comb Z, flat(<red orange yellow green blue indigo violet> xx *) -> ($l, $c) {
        print "\e[38;2;{COLORS{"{$c}-X11"}<rgb>.join(';')}m$l\e[0"
    }
    say '';
}

```

Output:

Displayed here as HTML as ANSI colors don't show up on web interfaces.

RAINBOW
Another phrase that happens to contain the word "Rainbow".


[User]
As the integers get larger, the spacing between prime numbers slowly lengthens, but the spacing
between primes increases at a slower rate than the numbers themselves increase. A consequence of
this difference in rates of increase is the existence of special primes, called Ramanujan primes.

The `n`th Ramanujan prime is defined to be the least integer for which there are at least n primes between
x and x/2 for all x greater or equal to n.

Task

* :   Generate and show the first 100 Ramanujan prime numbers.

* :   Find and show the 1000th Ramanujan prime number.

Stretch task

* :   Find and show the 10,000th Ramanujan prime number.

See also

:   * The pi prime function, not to be confused with the transcendental number π
    * The OEIS entry:   OEIS entry
    * The Wikipedia entry: Ramanujan\_prime.

[Assistant]
All timings are purely informational. Will vary by system specs and load.

### Pure Raku

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

my $primes = Math::Primesieve.new;

my @mem;

sub ramanujan-prime (\n) {
   1 + (1..(4×n × (4×n).log / 2.log).floor).first: :end, -> \x {
       my \y = x div 2;
       ((@mem[x] //= $primes.count(x)) - (@mem[y] //= $primes.count(y))) < n
   }
}

say 'First 100:';
say (1..100).map( &ramanujan-prime ).batch(10)».&comma».fmt("%6s").join: "\n";
say "\n 1,000th: { comma 1000.&ramanujan-prime }";
say "10,000th: {  comma 10000.&ramanujan-prime }";
say (now - INIT now).fmt('%.3f') ~ ' seconds';

```

Output:

```
First 100:
     2     11     17     29     41     47     59     67     71     97
   101    107    127    149    151    167    179    181    227    229
   233    239    241    263    269    281    307    311    347    349
   367    373    401    409    419    431    433    439    461    487
   491    503    569    571    587    593    599    601    607    641
   643    647    653    659    677    719    727    739    751    769
   809    821    823    827    853    857    881    937    941    947
   967    983  1,009  1,019  1,021  1,031  1,049  1,051  1,061  1,063
 1,087  1,091  1,097  1,103  1,151  1,163  1,187  1,217  1,229  1,249
 1,277  1,289  1,297  1,301  1,367  1,373  1,423  1,427  1,429  1,439

 1,000th: 19,403
10,000th: 242,057
18.405 seconds
```

### ntheory library

**Library:** ntheory

```
use ntheory:from<Perl5> <ramanujan_primes nth_ramanujan_prime>;
use Lingua::EN::Numbers;

say 'First 100:';
say ramanujan_primes( nth_ramanujan_prime(100) ).batch(10)».&comma».fmt("%6s").join: "\n";

for (2..12).map: {exp $_, 10} -> $limit {
    say "\n{tc ordinal $limit}: { comma nth_ramanujan_prime($limit) }";
}

say (now - INIT now).fmt('%.3f') ~ ' seconds';

```

Output:

```
First 100:
     2     11     17     29     41     47     59     67     71     97
   101    107    127    149    151    167    179    181    227    229
   233    239    241    263    269    281    307    311    347    349
   367    373    401    409    419    431    433    439    461    487
   491    503    569    571    587    593    599    601    607    641
   643    647    653    659    677    719    727    739    751    769
   809    821    823    827    853    857    881    937    941    947
   967    983  1,009  1,019  1,021  1,031  1,049  1,051  1,061  1,063
 1,087  1,091  1,097  1,103  1,151  1,163  1,187  1,217  1,229  1,249
 1,277  1,289  1,297  1,301  1,367  1,373  1,423  1,427  1,429  1,439

One hundredth: 1,439

One thousandth: 19,403

Ten thousandth: 242,057

One hundred thousandth: 2,916,539

One millionth: 34,072,993

Ten millionth: 389,433,437

One hundred millionth: 4,378,259,731

One billionth: 48,597,112,639

Ten billionth: 533,902,884,973

One hundred billionth: 5,816,713,968,619

One trillionth: 62,929,891,461,461
15.572 seconds
```


[User]
In a manner similar to twin primes, twin Ramanujan primes may be explored. The task is to determine how many of the first million Ramanujan primes are twins.

Related Task
:   Twin primes

[Assistant]
Timing is informational only. Will vary by system specs and load.

**Library:** ntheory

```
use ntheory:from<Perl5> <ramanujan_primes nth_ramanujan_prime>;
use Lingua::EN::Numbers;

my @rp = ramanujan_primes nth_ramanujan_prime 1_000_000;

for (1e5, 1e6)».Int -> $limit {
    say "\nThe {comma $limit}th Ramanujan prime is { comma @rp[$limit-1]}";
    say "There are { comma +(^($limit-1)).race.grep: { @rp[$_+1] == @rp[$_]+2 } } twins in the first {comma $limit} Ramanujan primes.";
}

say (now - INIT now).fmt('%.3f') ~ ' seconds';

```

Output:

```
The 100,000th Ramanujan prime is 2,916,539
There are 8,732 twins in the first 100,000 Ramanujan primes.

The 1,000,000th Ramanujan prime is 34,072,993
There are 74,973 twins in the first 1,000,000 Ramanujan primes.
2.529 seconds
```


[User]
Calculate Ramanujan's constant (as described on the OEIS site) with at least
32 digits of precision, by the method of your choice. Optionally, if using the 𝑒\*\*(π\*√*x*) approach,
show that when evaluated with the last four Heegner numbers
the result is *almost* an integer.

[Assistant]
(formerly Perl 6)

### Iterative calculations

To generate a high-precision value for Ramanujan's constant, code is borrowed from three other Rosettacode tasks
(with some modifications) for performing calculations of
the value of π,
Euler's number, and
integer roots. Additional custom routines for exponentiation are used to ensure all computations are done with rationals, specifically FatRats (rational numbers stored with arbitrary size numerator and denominator). The module Rat::Precise makes it simple to display these to a configurable precision.

```
use Rat::Precise;

# set the degree of precision for calculations
constant D = 54;
constant d = 15;

# two versions of exponentiation where base and exponent are both FatRat
multi infix:<**> (FatRat $base, FatRat $exp where * >= 1 --> FatRat) {
    2 R** $base**($exp/2);
}

multi infix:<**> (FatRat $base, FatRat $exp where * <  1 --> FatRat) {
    constant ε = 10**-D;
    my $low  = 0.FatRat;
    my $high = 1.FatRat;
    my $mid  = $high / 2;
    my $acc  = my $sqr = sqrt($base);

    while (abs($mid - $exp) > ε) {
      $sqr = sqrt($sqr);
      if ($mid <= $exp) { $low  = $mid; $acc ×=   $sqr }
      else              { $high = $mid; $acc ××= 1/$sqr }
      $mid = ($low + $high) / 2;
    }
    $acc.substr(0, D).FatRat;
}

# calculation of π
sub π (--> FatRat) {
    my ($a, $n) = 1, 1;
    my $g = sqrt 1/2.FatRat;
    my $z = .25;
    my $pi;

    for ^d {
        given [ ($a + $g)/2, sqrt $a × $g ] {
            $z -= (.[0] - $a)**2 × $n;
            $n += $n;
            ($a, $g) = @$_;
            $pi = ($a ** 2 / $z).substr: 0, 2 + D;
        }
    }
    $pi.FatRat;
}

multi sqrt(FatRat $r --> FatRat) {
    FatRat.new: sqrt($r.nude[0] × 10**(D×2) div $r.nude[1]), 10**D;
}

# integer roots
multi sqrt(Int $n) {
    my $guess = 10**($n.chars div 2);
    my $iterator = { ( $^x + $n div ($^x) ) div 2 };
    my $endpoint = { $^x == $^y|$^z };
    min ($guess, $iterator … $endpoint)[*-1, *-2];
}

# 'cosmetic' cover to upgrade input to FatRat sqrt
sub prefix:<√> (Int $n) { sqrt($n.FatRat) }

# calculation of 𝑒
sub postfix:<!> (Int $n) { (constant f = 1, |[\×] 1..*)[$n] }
sub 𝑒 (--> FatRat) { sum map { FatRat.new(1,.!) }, ^D }

# inputs, and their difference, formatted decimal-aligned
sub format ($a,$b) {
    sub pad ($s) { ' ' x ((34 - d - 1) - ($s.split(/\./)[0]).chars) }
    my $c = $b.precise(d, :z);
    my $d = ($a-$b).precise(d, :z);
    join "\n",
        (sprintf "%11s {pad($a)}%s\n", 'Int', $a) ~
        (sprintf "%11s {pad($c)}%s\n", 'Heegner', $c) ~
        (sprintf "%11s {pad($d)}%s\n", 'Difference', $d)
}

# override built-in definitions
constant π = &π();
constant 𝑒 = &𝑒();

my $Ramanujan = 𝑒**(π × √163);
say "Ramanujan's constant to 32 decimal places:\nActual:     " ~
    "262537412640768743.99999999999925007259719818568888\n" ~
    "Calculated: ", $Ramanujan.precise(32, :z), "\n";

say "Heegner numbers yielding 'almost' integers";
for 19, 96, 43, 960, 67, 5280, 163, 640320 -> $heegner, $x {
    my $almost = 𝑒**(π × √$heegner);
    my $exact  = $x³ + 744;
    say format($exact, $almost);
}

```

Output:

```
Ramanujan's constant to 32 decimal places:
Actual:     262537412640768743.99999999999925007259719818568888
Calculated: 262537412640768743.99999999999925007259719818568888

Heegner numbers yielding 'almost' integers
        Int             885480
    Heegner             885479.777680154319498
 Difference                  0.222319845680502

        Int          884736744
    Heegner          884736743.999777466034907
 Difference                  0.000222533965093

        Int       147197952744
    Heegner       147197952743.999998662454225
 Difference                  0.000001337545775

        Int 262537412640768744
    Heegner 262537412640768743.999999999999250
 Difference                  0.000000000000750
```

### Continued fractions

Ramanujan's constant can also be generated to an arbitrary precision using standard continued fraction formulas for each component of the 𝑒\*\*(π\*√163) expression. Substantially slower than the first method.

```
use Rat::Precise;

sub continued-fraction($n, :@a, :@b) {
    my $x = @a[0].FatRat;
    $x = @a[$_ - 1] + @b[$_] / $x for reverse 1 ..^ $n;
    $x;
}

#`{ √163 } my $r163 =           continued-fraction( 50, :a(12,|((2*12) xx *)),      :b(19 xx *));
#`{ π    } my $pi   =         4*continued-fraction(140, :a( 0,|(1, 3 ... *)),       :b(4, 1, |((1, 2, 3 ... *) X** 2)));
#`{ e**x } my $R    = 1 + ($_ / continued-fraction(170, :a( 1,|(2+$_, 3+$_ ... *)), :b(Nil,  |(-1*$_, -2*$_ ... *)  ))) given $r163*$pi;

say "Ramanujan's constant to 32 decimal places:\n", $R.precise(32);

```

Output:

```
Ramanujan's constant to 32 decimal places:
262537412640768743.99999999999925007259719818568888
```


[User]
The   **Ramer–Douglas–Peucker**   algorithm is a line simplification algorithm for reducing the number of points used to define its shape.

Task

Using the   **Ramer–Douglas–Peucker**   algorithm, simplify the   2D   line defined by the points:

```
   (0,0)  (1,0.1)  (2,-0.1)  (3,5)  (4,6)  (5,7)  (6,8.1)  (7,9)  (8,9)  (9,9)

```

The error threshold to be used is:   **1.0**.

Display the remaining points here.

Reference
:   * the Wikipedia article:   Ramer-Douglas-Peucker algorithm.

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2017.05

**Translation of**: C++

```
sub norm (*@list) { @list»².sum.sqrt }

sub perpendicular-distance (@start, @end where @end !eqv @start, @point) {
    return 0 if @point eqv any(@start, @end);
    my ( $Δx, $Δy ) =   @end «-» @start;
    my ($Δpx, $Δpy) = @point «-» @start;
    ($Δx, $Δy) «/=» norm $Δx, $Δy;
    norm ($Δpx, $Δpy) «-» ($Δx, $Δy) «*» ($Δx*$Δpx + $Δy*$Δpy);
}

sub Ramer-Douglas-Peucker(@points where * > 1, \ε = 1) {
    return @points if @points == 2;
    my @d = (^@points).map: { perpendicular-distance |@points[0, *-1, $_] };
    my ($index, $dmax) = @d.first: @d.max, :kv;
    return flat
      Ramer-Douglas-Peucker( @points[0..$index], ε )[^(*-1)],
      Ramer-Douglas-Peucker( @points[$index..*], ε )
      if $dmax > ε;
    @points[0, *-1];
}

# TESTING
say Ramer-Douglas-Peucker(
   [(0,0),(1,0.1),(2,-0.1),(3,5),(4,6),(5,7),(6,8.1),(7,9),(8,9),(9,9)]
);

```

Output:

```
((0 0) (2 -0.1) (3 5) (7 9) (9 9))
```


[User]
Task

Find a graph with 17 Nodes such that any 4 Nodes are neither totally connected nor totally unconnected, so demonstrating Ramsey's theorem.

A specially-nominated solution may be used, but if so it **must** be checked to see if if there are any sub-graphs that are totally connected or totally unconnected.

[Assistant]
(formerly Perl 6)

**Works with**: rakudo version 2018.08

```
my $n = 17;
my @a = [ 0 xx $n ] xx $n;
@a[$_;$_] = '-' for ^$n;

for flat ^$n X 1,2,4,8 -> $i, $k {
    my $j = ($i + $k) % $n;
    @a[$i;$j] = @a[$j;$i] = 1;
}
.say for @a;

for combinations($n,4) -> $quartet {
    my $links = [+] $quartet.combinations(2).map: -> $i,$j { @a[$i;$j] }
    die "Bogus!" unless 0 < $links < 6;
}
say "OK";

```

Output:

```
- 1 1 0 1 0 0 0 1 1 0 0 0 1 0 1 1
1 - 1 1 0 1 0 0 0 1 1 0 0 0 1 0 1
1 1 - 1 1 0 1 0 0 0 1 1 0 0 0 1 0
0 1 1 - 1 1 0 1 0 0 0 1 1 0 0 0 1
1 0 1 1 - 1 1 0 1 0 0 0 1 1 0 0 0
0 1 0 1 1 - 1 1 0 1 0 0 0 1 1 0 0
0 0 1 0 1 1 - 1 1 0 1 0 0 0 1 1 0
0 0 0 1 0 1 1 - 1 1 0 1 0 0 0 1 1
1 0 0 0 1 0 1 1 - 1 1 0 1 0 0 0 1
1 1 0 0 0 1 0 1 1 - 1 1 0 1 0 0 0
0 1 1 0 0 0 1 0 1 1 - 1 1 0 1 0 0
0 0 1 1 0 0 0 1 0 1 1 - 1 1 0 1 0
0 0 0 1 1 0 0 0 1 0 1 1 - 1 1 0 1
1 0 0 0 1 1 0 0 0 1 0 1 1 - 1 1 0
0 1 0 0 0 1 1 0 0 0 1 0 1 1 - 1 1
1 0 1 0 0 0 1 1 0 0 0 1 0 1 1 - 1
1 1 0 1 0 0 0 1 1 0 0 0 1 0 1 1 -
OK
```


[User]
A Latin square of size `n` is an arrangement of `n` symbols in an `n-by-n` square in such a way that each row and column has each symbol appearing exactly once.
For the purposes of this task, a random Latin square of size `n` is a Latin square constructed or generated by a probabilistic procedure such that the probability of any particular Latin square of size `n` being produced is non-zero.

Example n=4 randomised Latin square

```
0 2 3 1
2 1 0 3
3 0 1 2
1 3 2 0
```

Task

1. Create a function/routine/procedure/method/... that given `n` generates a randomised Latin square of size `n`.
2. Use the function to generate *and show here*, two randomly generated squares of size 5.

Note

Strict *uniformity* in the random generation is a hard problem and **not** a requirement of the task.

Related tasks

* Latin Squares in reduced form/Randomizing using Jacobson and Matthews’ Technique
* Latin Squares in reduced form

Reference

* Wikipedia: Latin square
* OEIS: A002860

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2019.03

**Translation of**: Python

```
sub latin-square { [[0],] };

sub random ( @ls, :$size = 5 ) {

    # Build
    for 1 ..^ $size -> $i {
        @ls[$i] = @ls[0].clone;
        @ls[$_].splice($_, 0, $i) for 0 .. $i;
    }

    # Shuffle
    @ls = @ls[^$size .pick(*)];
    my @cols = ^$size .pick(*);
    @ls[$_] = @ls[$_][@cols] for ^@ls;

    # Some random Latin glyphs
    my @symbols = ('A' .. 'Z').pick($size);

    @ls.deepmap: { $_ = @symbols[$_] };

}

sub display ( @array ) { $_.fmt("%2s ").put for |@array, '' }

# The Task

# Default size 5
display random latin-square;

# Specified size
display random :size($_), latin-square for 5, 3, 9;

# Or, if you'd prefer:
display random latin-square, :size($_) for 12, 2, 1;

```

Sample output:

```
 V   Z   M   J   U
 Z   M   U   V   J
 U   J   V   M   Z
 J   V   Z   U   M
 M   U   J   Z   V

 B   H   K   U   D
 H   D   U   B   K
 K   U   H   D   B
 U   B   D   K   H
 D   K   B   H   U

 I   P   Y
 P   Y   I
 Y   I   P

 Y   J   K   E   Z   B   I   W   H
 E   Y   B   W   K   H   J   Z   I
 B   K   Y   H   J   E   Z   I   W
 I   H   W   J   E   Z   B   Y   K
 J   I   Z   Y   W   K   H   E   B
 W   E   H   Z   B   I   Y   K   J
 H   B   E   I   Y   W   K   J   Z
 K   Z   J   B   I   Y   W   H   E
 Z   W   I   K   H   J   E   B   Y

 L   Q   E   M   A   T   Z   C   N   Y   R   D
 Q   R   Y   L   N   D   C   E   M   T   A   Z
 E   Y   M   C   D   Q   A   N   Z   L   T   R
 M   L   C   N   R   Y   D   Z   A   E   Q   T
 N   M   Z   A   Q   E   T   D   R   C   L   Y
 T   D   Q   Y   C   A   M   L   E   R   Z   N
 R   A   T   Q   M   Z   E   Y   L   D   N   C
 D   Z   R   T   E   N   L   Q   Y   A   C   M
 Y   T   L   E   Z   R   N   M   C   Q   D   A
 A   N   D   R   L   C   Y   T   Q   Z   M   E
 Z   C   A   D   Y   M   Q   R   T   N   E   L
 C   E   N   Z   T   L   R   A   D   M   Y   Q

 Y   G
 G   Y

 I
```


[User]
Task

If your system has a means to generate random numbers involving not only a software algorithm   (like the /dev/urandom devices in Unix),   then:

show how to obtain a random 32-bit number from that mechanism.

Related task

* Random\_number\_generator\_(included)

[Assistant]
(formerly Perl 6)

**Works with**: rakudo version 2016-11

A lazy list of random numbers:

```
use experimental :pack;
my $UR = open("/dev/urandom", :bin) orelse .die;
my @random-spigot = $UR.read(1024).unpack("L*") ... *;

.say for @random-spigot[^10];

```

Output:

```
1431009271
1702240522
670020272
588612037
1864913839
2155430433
1690056587
385405103
2366495746
692037942
```


[User]
The task is to:

:   State the type of random number generator algorithm used in a language's built-in random number generator. If the language or its immediate libraries don't provide a random number generator, skip this task.
:   If possible, give a link to a wider explanation of the algorithm used.

Note: the task is *not* to create an RNG, but to report on the languages in-built RNG that would be the most likely RNG used.

The main types of pseudo-random number generator (PRNG) that are in use are the Linear Congruential Generator (LCG), and the Generalized Feedback Shift Register (GFSR), (of which the Mersenne twister generator is a subclass). The last main type is where the output of one of the previous ones (typically a Mersenne twister) is fed through a cryptographic hash function to maximize unpredictability of individual bits.

Note that neither LCGs nor GFSRs should be used for the most demanding applications (cryptography) without additional steps.

[Assistant]
(formerly Perl 6)
The implementation underlying the rand function is platform and VM dependent. The JVM backend uses that platform's SecureRandom class.


[User]
Task

Generate a collection filled with   **1000**   normally distributed random (or pseudo-random) numbers
with a mean of   **1.0**   and a   standard deviation   of   **0.5**

Many libraries only generate uniformly distributed random numbers. If so, you may use one of these algorithms.

Related task

* Standard deviation

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version #22 "Thousand Oaks"

```
sub randnorm ($mean, $stddev) {
    $mean + $stddev * sqrt(-2 * log rand) * cos(2 * pi * rand)
}

my @nums = randnorm(1, 0.5) xx 1000;

# Checking
say my $mean = @nums R/ [+] @nums;
say my $stddev = sqrt $mean**2 R- @nums R/ [+] @nums X** 2;

```


[User]
* Read in the book "The War of the Worlds", by H. G. Wells.
* Skip to the start of the book, proper.
* Remove extraneous punctuation, but keep at least sentence-ending punctuation characters . ! and ?
* Keep account of what words follow words and how many times it is seen, (treat sentence terminators as words too).
* Keep account of what words follow *two* words and how many times it is seen, (again treating sentence terminators as words too).
* Assume that a sentence starts with a not to be shown full-stop character then *use a weighted random choice* of the possible words that may follow a full-stop to add to the sentence.
* Then repeatedly add words to the sentence based on weighted random choices of what words my follow the last two words to extend the sentence.
* Stop after adding a sentence ending punctuation character.
* Tidy and then print the sentence.

Show examples of random sentences generated.

Related task

* Markov\_chain\_text\_generator

[Assistant]
Started out as translation of Perl, but diverged.

```
my $text = '36-0.txt'.IO.slurp.subst(/.+ '*** START OF THIS' .+? \n (.*?) 'End of the Project Gutenberg EBook' .*/, {$0} );

$text.=subst(/ <+punct-[.!?\’,]> /, ' ', :g);
$text.=subst(/ (\s) '’' (\s)  /, '', :g);
$text.=subst(/ (\w) '’' (\s)  /, {$0~$1}, :g);
$text.=subst(/ (\s) '’' (\w)  /, {$0~$1}, :g);

my (%one, %two);

for $text.comb(/[\w+(\’\w+)?]','?|<punct>/).rotor(3 => -2) {
    %two{.[0]}{.[1]}{.[2]}++;
    %one{.[0]}{.[1]}++;
}

sub weightedpick (%hash) { %hash.keys.map( { $_ xx %hash{$_} } ).pick }

sub sentence {
    my @sentence = <. ! ?>.roll;
    @sentence.push: weightedpick( %one{ @sentence[0] } );
    @sentence.push: weightedpick( %two{ @sentence[*-2] }{ @sentence[*-1] } // %('.' => 1) )[0]
      until @sentence[*-1] ∈ <. ! ?>;
    @sentence.=squish;
    shift @sentence;
    redo if @sentence < 7;
    @sentence.join(' ').tc.subst(/\s(<:punct>)/, {$0}, :g);
}

say sentence() ~ "\n" for ^10;

```

Sample output:

```
To the inhabitants calling itself the Committee of Public Supply seized the opportunity of slightly shifting my position, which had caused a silent mass of smoke rose slanting and barred the face.

Why was I after the Martian within the case, but that these monsters.

As if hell was built for rabbits!

Thenks and all that the Secret of Flying, was discovered.

Or did a Martian standing sentinel I suppose the time we drew near the railway officials connected the breakdown with the butt.

Flutter, flutter, went the bats, heeding it not been for the big table like end of it a great light was seen by the humblest things that God, in his jaws coming headlong towards me, and rapidly growing hotter.

Survivors there were no longer venturing into the side roads of the planet in view.

Just as they began playing at touch in and out into the west, but nothing to me the landscape, weird and vague and strange and incomprehensible that for the wet.

Just as they seem to remember talking, wanderingly, to myself for an accident, but the captain lay off the platforms, and my wife to their former stare, and his lower limbs lay limp and dead horses.

Entrails they had fought across to the post office a little one roomed squatter’s hut of wood, surrounded by a gradual development of brain and hands, the latter giving rise to the corner.
```


[User]
Define a range of numbers   **R**,   with bounds   **b0**   and   **b1**   covering all numbers *between and including both bounds*.

That range can be shown as:

:   :   :   :   :   :   :   :   :   **[b0, b1]**
                            :   or equally as:

                                :   **[b1, b0]**

Given two ranges, the act of consolidation between them compares the two ranges:

* If one range covers all of the other then the result is that encompassing range.
* If the ranges touch or intersect then the result is   *one*   new single range covering the overlapping ranges.
* Otherwise the act of consolidation is to return the two non-touching ranges.

Given   **N**   ranges where   **N > 2**   then the result is the same as repeatedly replacing all combinations of two ranges by their consolidation until no further consolidation between range pairs is possible.

If   **N < 2**   then range consolidation has no strict meaning and the input can be returned.

Example 1
:   Given the two ranges   **[1, 2.5]**   and   **[3, 4.2]**   then
:   there is no common region between the ranges and the result is the same as the input.

Example 2
:   Given the two ranges   **[1, 2.5]**   and   **[1.8, 4.7]**   then
:   there is :   an overlap   **[2.5, 1.8]**   between the ranges and
:   the result is the single range   **[1, 4.7]**.
:   Note that order of bounds in a range is not (yet) stated.

Example 3
:   Given the two ranges   **[6.1, 7.2]**   and   **[7.2, 8.3]**   then
:   they touch at   **7.2**   and
:   the result is the single range   **[6.1, 8.3]**.

Example 4
:   Given the three ranges   **[1, 2]**   and   **[4, 8]**   and   **[2, 5]**
:   then there is no intersection of the ranges   **[1, 2]**   and   **[4, 8]**
:   but the ranges   **[1, 2]**   and   **[2, 5]**   overlap and
:   consolidate to produce the range   **[1, 5]**.
:   This range, in turn, overlaps the other range   **[4, 8]**,   and
:   so consolidates to the final output of the single range   **[1, 8]**.

Task

Let a normalized range display show the smaller bound to the left;   and show the
range with the smaller lower bound to the left of other ranges when showing multiple ranges.

Output the *normalized* result of applying consolidation to these five sets of ranges:

```
           [1.1, 2.2]
           [6.1, 7.2], [7.2, 8.3]
           [4, 3], [2, 1]
           [4, 3], [2, 1], [-1, -2], [3.9, 10]
           [1, 3], [-6, -1], [-4, -5], [8, 2], [-6, -6]

```

Show all output here.

See also

* Set consolidation
* Set of real numbers

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2020.08.1

In Raku, a Range is a first class object with its own specialized notation. Raku Ranges allow for exclusion of the boundary numbers. This example doesn't since it isn't a requirement in this task. Much of the logic is lifted from the Set\_of\_real\_numbers task with simplified logic for the much simpler requirements.

Note: the output is in standard Raku notation for Ranges.

```
# Union
sub infix:<∪> (Range $a, Range $b) { Range.new($a.min,max($a.max,$b.max)) }

# Intersection
sub infix:<∩> (Range $a, Range $b) { so $a.max >= $b.min }

multi consolidate() { () }

multi consolidate($this is copy, **@those) {
    gather {
        for consolidate |@those -> $that {
            if $this ∩ $that { $this ∪= $that }
            else             { take $that }
        }
        take $this;
    }
}

for [[1.1, 2.2],],
    [[6.1, 7.2], [7.2, 8.3]],
    [[4, 3], [2, 1]],
    [[4, 3], [2, 1], [-1, -2], [3.9, 10]],
    [[1, 3], [-6, -1], [-4, -5], [8, 2], [-6, -6]]
-> @intervals {
    printf "%46s => ", @intervals.raku;
    say reverse consolidate |@intervals.grep(*.elems)».sort.sort({ [.[0], .[*-1]] }).map: { Range.new(.[0], .[*-1]) }
}

```

Output:

```
                                 [[1.1, 2.2],] => (1.1..2.2)
                      [[6.1, 7.2], [7.2, 8.3]] => (6.1..8.3)
                              [[4, 3], [2, 1]] => (1..2 3..4)
         [[4, 3], [2, 1], [-1, -2], [3.9, 10]] => (-2..-1 1..2 3..10)
[[1, 3], [-6, -1], [-4, -5], [8, 2], [-6, -6]] => (-6..-1 1..8)

```


[User]
A format for expressing an ordered list of integers is to use a comma separated list of either

* individual integers
* Or a range of integers denoted by the starting integer separated from the end integer in the range by a dash, '-'. (The range includes all integers in the interval including both endpoints)

:   * **The range syntax is to be used only for, and for every range that expands to more than two values.**

**Example**
The list of integers:

:   -6, -3, -2, -1, 0, 1, 3, 4, 5, 7, 8, 9, 10, 11, 14, 15, 17, 18, 19, 20

Is accurately expressed by the range expression:

:   -6,-3-1,3-5,7-11,14,15,17-20

(And vice-versa).

Task

Expand the range description:

```
  -6,-3--1,3-5,7-11,14,15,17-20

```

Note that the second element above,
is the **range from minus 3 to *minus* 1**.

Related task

* Range extraction

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2016.07

```
sub range-expand (Str $range-description) {
    my token number { '-'? \d+ }
    my token range  { (<&number>) '-' (<&number>) }

    $range-description
        .split(',')
        .map({ .match(&range) ?? $0..$1 !! +$_ })
        .flat
}

say range-expand('-6,-3--1,3-5,7-11,14,15,17-20').join(', ');

```

Output:

```
-6, -3, -2, -1, 3, 4, 5, 7, 8, 9, 10, 11, 14, 15, 17, 18, 19, 20
```

Alternatively, using a grammar:

```
grammar RangeList {
    token TOP    { <term>* % ','    { make $<term>.map(*.made)       } }
    token term   { [<range>|<num>]  { make ($<num> // $<range>).made } }
    token range  { <num> '-' <num>  { make +$<num>[0] .. +$<num>[1]  } }
    token num    { '-'? \d+         { make +$/                       } }
}

say RangeList.parse('-6,-3--1,3-5,7-11,14,15,17-20').made.flat.join(', ');

```

Output:

```
-6, -3, -2, -1, 3, 4, 5, 7, 8, 9, 10, 11, 14, 15, 17, 18, 19, 20
```


[User]
A format for expressing an ordered list of integers is to use a comma separated list of either

* individual integers
* Or a range of integers denoted by the starting integer separated from the end integer in the range by a dash, '-'. (The range includes all integers in the interval including both endpoints)

:   * **The range syntax is to be used only for, and for every range that expands to more than two values.**

**Example**
The list of integers:

:   -6, -3, -2, -1, 0, 1, 3, 4, 5, 7, 8, 9, 10, 11, 14, 15, 17, 18, 19, 20

Is accurately expressed by the range expression:

:   -6,-3-1,3-5,7-11,14,15,17-20

(And vice-versa).

Task

* Create a function that takes a list of integers in increasing order and returns a correctly formatted string in the range format.
* Use the function to compute and print the range formatted version of the following ordered list of integers. (The correct answer is: `0-2,4,6-8,11,12,14-25,27-33,35-39`).

```
    0,  1,  2,  4,  6,  7,  8, 11, 12, 14,
   15, 16, 17, 18, 19, 20, 21, 22, 23, 24,
   25, 27, 28, 29, 30, 31, 32, 33, 35, 36,
   37, 38, 39

```

* Show the output of your program.

Related task

* Range expansion

[Assistant]
(formerly Perl 6)

```
sub range-extraction (*@ints) {
    my $prev = NaN;
    my @ranges;

    for @ints -> $int {
        if $int == $prev + 1 {
            @ranges[*-1].push: $int;
        }
        else {
            @ranges.push: [$int];
        }
        $prev = $int;
    }
    join ',', @ranges.map: -> @r { @r > 2 ?? "@r[0]-@r[*-1]" !! @r }
}

say range-extraction
    -6, -3, -2, -1, 0, 1, 3, 4, 5, 7, 8, 9, 10, 11, 14, 15, 17, 18, 19, 20;

say range-extraction
    0,  1,  2,  4,  6,  7,  8, 11, 12, 14,
    15, 16, 17, 18, 19, 20, 21, 22, 23, 24,
    25, 27, 28, 29, 30, 31, 32, 33, 35, 36,
    37, 38, 39;

```

Output:

```
-6,-3-1,3-5,7-11,14,15,17-20
0-2,4,6-8,11,12,14-25,27-33,35-39
```


[User]
The increasing range of all integers from a lower to an upper bound, including
each boundary, is shown by the lower-boundary separated from the
higher-boundary by a single dash. So `64-1234` is the range of all integers
from 64 to 1234, (including both 64 and 1234). `10-10` is the range covering
the single integer 10.

A sequence of ranges is shown by successive integer ranges that do not overlap,
and which have *increasing* lower bounds. Each range is separated by a single
comma. So `13-14,22-22,100999999-101000001` is a sequence of ranges that
contain the integers 13 14 22 100999999 101000000 and 101000001.
Empty ranges are removed. An empty sequence has an empty string representation.

Note: There are NO internal spaces in the sequence format.

Task

Given an initial sequence of ranges write programs to add or remove an integer
from the sequence and display the resultant sequence.
Note:

* The initial sequence may be empty.
* Adding an int that is already covered should not change the sequence.
* removing an int that is not in the sequence should not change the sequence.
* The add and remove operations should print their result in the standard form mentioned.
* Solutions **must** work by modifying range boundaries, splitting and joining, as well as creating and deleting ranges.
   **Do not** use algorithms that create and modify arrays of all the integer values within ranges.

Show the results, (including intermediate results), of performing the following
steps

Ex0

```
   Start with ""
       add 77
       add 79
       add 78
       remove 77
       remove 78
       remove 79

```

Ex1

```
   Start with "1-3,5-5"
       add 1
       remove 4
       add 7
       add 8
       add 6
       remove 7

```

Ex2

```
   Start with "1-5,10-25,27-30"
       add 26
       add 9
       add 7
       remove 26
       remove 9
       remove 7

```

Requires Gdip Library

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

Quite a bit of this is just transforming syntax back and forth. Raku already has Ranges and Sequences as first class objects, though the syntax is different.

Demonstrate the task required examples: adding and removing integers, as well as an example adding and removing ranges to / from the sequence, in both native Raku syntax and the "Stringy" syntax required by the task.

Demo with some extremely large values / ranges. Capable of working with infinite ranges by default.

Won't handle negative numbers as written, mostly due the need to work around the syntax requirements for output.

```
my @seq;

-> $op, $string { printf "%20s -> %s\n", $op, $string } for
  'Start',     to-string( @seq  = canonicalize "" ),
  'add 77',    to-string( @seq .= &add(77) ),
  'add 79',    to-string( @seq .= &add(79) ),
  'add 78',    to-string( @seq .= &add(78) ),
  'remove 77', to-string( @seq .= &remove(77) ),
  'remove 78', to-string( @seq .= &remove(78) ),
  'remove 79', to-string( @seq .= &remove(79) );

say '';
-> $op, $string { printf "%20s -> %s\n", $op, $string } for
  'Start',    to-string( @seq  = canonicalize "1-3,5-5" ),
  'add 1',    to-string( @seq .= &add(1) ),
  'remove 4', to-string( @seq .= &remove(4) ),
  'add 7',    to-string( @seq .= &add(7) ),
  'add 8',    to-string( @seq .= &add(8) ),
  'add 6',    to-string( @seq .= &add(6) ),
  'remove 7', to-string( @seq .= &remove(7) );

say '';
-> $op, $string { printf "%20s -> %s\n", $op, $string } for
  'Start',     to-string( @seq  = canonicalize "1-5,10-25,27-30" ),
  'add 26',    to-string( @seq .= &add(26) ),
  'add 9',     to-string( @seq .= &add(9) ),
  'add 7',     to-string( @seq .= &add(7) ),
  'remove 26', to-string( @seq .= &remove(26) ),
  'remove 9',  to-string( @seq .= &remove(9) ),
  'remove 7',  to-string( @seq .= &remove(7) );

say '';
-> $op, $string { printf "%30s -> %s\n", $op, $string } for
  'Start',                  to-string( @seq  = canonicalize "6-57,160-251,2700-7000000" ),
  'add "2502-2698"',        to-string( @seq .= &add("2502-2698") ),
  'add 41..69',             to-string( @seq .= &add(41..69) ),
  'remove 17..30',          to-string( @seq .= &remove(17..30) ),
  'remove 4391..6527',      to-string( @seq .= &remove("4391-6527") ),
  'add 2699',               to-string( @seq .= &add(2699) ),
  'add 76',                 to-string( @seq .= &add(76) ),
  'add 78',                 to-string( @seq .= &add(78) ),
  'remove "70-165"',        to-string( @seq .= &remove("70-165") ),
  'remove 16..31',          to-string( @seq .= &remove(16..31) ),
  'add 1.417e16 .. 3.2e21', to-string( @seq .= &add(1.417e16.Int .. 3.2e21.Int) ),
  'remove "4001-Inf"',      to-string( @seq .= &remove("4001-Inf") );

sub canonicalize (Str $ranges) { sort consolidate |sort parse-range $ranges }

sub parse-range (Str $_) { .comb(/\d+|'Inf'/).map: { +$^α .. +$^ω } }

sub to-string (@ranges) { qq|"{ @ranges».minmax».join('-').join(',') }"| }

multi add (@ranges, Int   $i) { samewith @ranges, $i .. $i }
multi add (@ranges, Str   $s) { samewith @ranges, |parse-range($s) }
multi add (@ranges, Range $r) { @ranges > 0 ?? (sort consolidate |sort |@ranges, $r) !! $r }

multi remove (@ranges, Int   $i) { samewith @ranges, $i .. $i }
multi remove (@ranges, Str   $s) { samewith @ranges, |parse-range($s) }
multi remove (@ranges, Range $r) {
    gather for |@ranges -> $this {
        if $r.min <= $this.min {
            if $r.max >= $this.min and $r.max < $this.max {
                take $r.max + 1 .. $this.max
            }
            elsif $r.max < $this.min {
                take $this
            }
        }
        else {
            if $r.max >= $this.max and $r.min <= $this.max {
                take $this.min .. $r.min - 1
            }
            elsif $r.max < $this.max and $r.min > $this.min {
                take $this.min .. $r.min - 1;
                take $r.max + 1 .. $this.max
            }
            else {
                take $this
            }
        }
    }
}

multi consolidate() { () }

multi consolidate($this is copy, **@those) {
    sub infix:<∪> (Range $a, Range $b) { Range.new($a.min,max($a.max,$b.max)) }

    sub infix:<∩> (Range $a, Range $b) { so $a.max >= $b.min }

    my @ranges = sort gather {
        for consolidate |@those -> $that {
            next unless $that;
            if $this ∩ $that { $this ∪= $that }
            else             { take $that }
        }
        take $this;
    }
    for reverse ^(@ranges - 1) {
        if @ranges[$_].max == @ranges[$_ + 1].min - 1 {
            @ranges[$_] = @ranges[$_].min .. @ranges[$_ + 1].max;
            @ranges[$_ + 1]:delete
        }
    }
    @ranges
}

```

Output:

```
               Start -> ""
              add 77 -> "77-77"
              add 79 -> "77-77,79-79"
              add 78 -> "77-79"
           remove 77 -> "78-79"
           remove 78 -> "79-79"
           remove 79 -> ""

               Start -> "1-3,5-5"
               add 1 -> "1-3,5-5"
            remove 4 -> "1-3,5-5"
               add 7 -> "1-3,5-5,7-7"
               add 8 -> "1-3,5-5,7-8"
               add 6 -> "1-3,5-8"
            remove 7 -> "1-3,5-6,8-8"

               Start -> "1-5,10-25,27-30"
              add 26 -> "1-5,10-30"
               add 9 -> "1-5,9-30"
               add 7 -> "1-5,7-7,9-30"
           remove 26 -> "1-5,7-7,9-25,27-30"
            remove 9 -> "1-5,7-7,10-25,27-30"
            remove 7 -> "1-5,10-25,27-30"

                         Start -> "6-57,160-251,2700-7000000"
               add "2502-2698" -> "6-57,160-251,2502-2698,2700-7000000"
                    add 41..69 -> "6-69,160-251,2502-2698,2700-7000000"
                 remove 17..30 -> "6-16,31-69,160-251,2502-2698,2700-7000000"
             remove 4391..6527 -> "6-16,31-69,160-251,2502-2698,2700-4390,6528-7000000"
                      add 2699 -> "6-16,31-69,160-251,2502-4390,6528-7000000"
                        add 76 -> "6-16,31-69,76-76,160-251,2502-4390,6528-7000000"
                        add 78 -> "6-16,31-69,76-76,78-78,160-251,2502-4390,6528-7000000"
               remove "70-165" -> "6-16,31-69,166-251,2502-4390,6528-7000000"
                 remove 16..31 -> "6-15,32-69,166-251,2502-4390,6528-7000000"
        add 1.417e16 .. 3.2e21 -> "6-15,32-69,166-251,2502-4390,6528-7000000,14170000000000000-3200000000000000000000"
             remove "4001-Inf" -> "6-15,32-69,166-251,2502-4000"

```


[User]
The numerical rank of competitors in a competition shows if one is better than, equal to, or worse than another based on their results in a competition.

The numerical rank of a competitor can be assigned in several different ways.

Task

The following scores are accrued for all competitors of a competition (in best-first order):

```
44 Solomon
42 Jason
42 Errol
41 Garry
41 Bernard
41 Barry
39 Stephen
```

For each of the following ranking methods, create a function/method/procedure/subroutine... that applies the ranking method to an ordered list of scores with scorers:

1. Standard. (Ties share what would have been their first ordinal number).
2. Modified. (Ties share what would have been their last ordinal number).
3. Dense. (Ties share the next available integer).
4. Ordinal. ((Competitors take the next available integer. Ties are not treated otherwise).
5. Fractional. (Ties share the mean of what would have been their ordinal numbers).

See the wikipedia article for a fuller description.

Show here, on this page, the ranking of the test scores under each of the numbered ranking methods.

[Assistant]
(formerly Perl 6)

```
my @scores =
    Solomon => 44,
    Jason   => 42,
    Errol   => 42,
    Garry   => 41,
    Bernard => 41,
    Barry   => 41,
    Stephen => 39;

sub tiers (@s) { @s.classify(*.value).pairs.sort.reverse.map: { .value».key } }

sub standard (@s) {
    my $rank = 1;
    gather for tiers @s -> @players {
	take $rank => @players;
	$rank += @players;
    }
}

sub modified (@s) {
    my $rank = 0;
    gather for tiers @s -> @players {
	$rank += @players;
	take $rank => @players;
    }
}

sub dense (@s) { tiers(@s).map: { ++$_ => @^players } }

sub ordinal (@s) { @s.map: ++$_ => *.key }

sub fractional (@s) {
    my $rank = 1;
    gather for tiers @s -> @players {
	my $beg = $rank;
	my $end = $rank += @players;
	take [+]($beg ..^ $end) / @players => @players;
    }
}

say   "Standard:";   .perl.say for   standard @scores;
say "\nModified:";   .perl.say for   modified @scores;
say "\nDense:";      .perl.say for      dense @scores;
say "\nOrdinal:";    .perl.say for    ordinal @scores;
say "\nFractional:"; .perl.say for fractional @scores;

```

Output:

```
Standard:
1 => ["Solomon"]
2 => ["Jason", "Errol"]
4 => ["Garry", "Bernard", "Barry"]
7 => ["Stephen"]

Modified:
1 => ["Solomon"]
3 => ["Jason", "Errol"]
6 => ["Garry", "Bernard", "Barry"]
7 => ["Stephen"]

Dense:
1 => ["Solomon"]
2 => ["Jason", "Errol"]
3 => ["Garry", "Bernard", "Barry"]
4 => ["Stephen"]

Ordinal:
1 => "Solomon"
2 => "Jason"
3 => "Errol"
4 => "Garry"
5 => "Bernard"
6 => "Barry"
7 => "Stephen"

Fractional:
1.0 => ["Solomon"]
2.5 => ["Jason", "Errol"]
5.0 => ["Garry", "Bernard", "Barry"]
7.0 => ["Stephen"]
```