Centenary Sequences with Raku - Part 7: Every Tom, Dick, and Harry
[100.7] Published 4. November 2020.See also: The Introduction | Part 1: Raku Part 2: Arithmetic and Geometric Sequences | Part 3: Not True, or Not | Part 4: Primes and Fibonacci | Part 5: Divisors and Factors | Part 6: Binary and Palindrome
Sequences Named after Persons
Sequences named after the person(s) that either discovered them, or made them famous.081. Fermat Numbers
The Fermat Numbers start at
index 1, and we get the numbers with this formula: (2 ** 2 ** index) + 1.
(my $i = 1, { 2 ** 2 ** ($i++ -1) +1 } ... Inf) # 081
> say (my $i = 1, { 2 ** 2 ** ($i++ -1) +1 } ... Inf)[^9]
(1 3 5 17 257 65537 4294967297 18446744073709551617
340282366920938463463374607431768211457)
082. The Hailstone Sequences
The The Hailstone Sequences start with a user specified value (see the examples below), and every value after that is defined as:
previous/2if the previous value is odd(previous * 3) + 1if the previous value is even
This is the sequence starting with 1:
(1, { $^a %% 2 ?? ( $^a / 2 ) !! ( 3 * $^a +1 ) } ... Inf) # 082a
> say (1, { $^a %% 2 ?? ( $^a / 2 ) !! ( 3 * $^a +1 ) } ... Inf)[^25];
(1 4 2 1 4 2 1 4 2 1 4 2 1 4 2 1 4 2 1 4 2 1 4 2 1)
We can start at other numbers than 1, but the numbers will gravitate to the repeating trailing sequence (4, 2, 1) sooner or later.
> say (7, { $^a %% 2 ?? ( $^a / 2 ) !! ( 3 * $^a +1 ) } ... Inf )[^25];
(7 22 11 34 17 52 26 13 40 20 10 5 16 8 4 2 1 4 2 1 4 2 1 4 2)
This program takes the starting number as argument:
File: hailstone
unit sub MAIN (Int $start, Int $count = 10);
my $hailstone := gather
{
my $current = $start;
take $current;
loop
{
$current = $current %% 2
?? $current / 2 # Even
!! 3 * $current + 1; # Odd
take $current;
}
}
say $hailstone[^$count];
$ ./hailstone 1 25
(1 4 2 1 4 2 1 4 2 1 4 2 1 4 2 1 4 2 1 4 2 1 4 2 1)
$ ./hailstone 2 25
(2 1 4 2 1 4 2 1 4 2 1 4 2 1 4 2 1 4 2 1 4 2 1 4 2)
$ ./hailstone 3 25
(3 10 5 16 8 4 2 1 4 2 1 4 2 1 4 2 1 4 2 1 4 2 1 4 2)
$ ./hailstone 9 25
(9 28 14 7 22 11 34 17 52 26 13 40 20 10 5 16 8 4 2 1 4 2 1 4 2)
082. Mersenne Numbers
The Mersenne Numbers
start at index 1, and the values are given by (2 ** index) -1:
This is ok-ish, if we skip the first value (at index 0):
> say (my $i=1, {2 ** $i++ -1 } ... Inf)[^10];
(1 1 3 7 15 31 63 127 255 511)
We can try removing the start value (my $i=1), and place the variable
inside the rule (as a state variable):
> say ( {2 ** state $i++ -1 } ... Inf)[^10];
(0 1 3 7 15 31 63 127 255 511)
That does not work. The start value is simply assumed to be 0.
But prefix ++ does the trick:
(my $i=1, {2 ** ++$i -1 } ... Inf) # 082
> say > (my $i=1, {2 ** ++$i -1 } ... Inf)[^17]
(1 3 7 15 31 63 127 255 511 1023 2047 4095 8191 16383 32767 65535 131071)
083. Mersenne Primes
A Mersenne Prime is a
prime number that is one less than a power of two, e.g. (2 ** i) -1:
(my $i=1, { 2 ** ++$i -1 } ... Inf).grep( *.is-prime) # 083
say (my $i=1, { 2 ** ++$i -1 } ... Inf).grep( *.is-prime)[^9];
(3 7 31 127 8191 131071 524287 2147483647 2305843009213693951)
084. Mersenne Prime Exponents
The Mersenne Prime Exponents (the value of i):
(1 .. Inf).grep({ (2 ** $_ -1).is-prime }) # 084
> say (1 .. Inf).grep({ (2 ** $_ -1).is-prime })[^20];
(2 3 5 7 13 17 19 31 61 89 107 127 521 607 1279 2203 2281 3217 4253 4423)
085. Sylvester's sequence
Sylvester's Sequence is a sequence where each value in the sequence is the product of the previous value, plus one. The first value is 2.
(my $sum = 2, { my $c = $sum +1; $sum *= $c; $c } ... Inf) # 085
> say (my $sum = 2, { my $c = $sum +1; $sum *= $c; $c } ... Inf)[^8];
(2 3 7 43 1807 3263443 10650056950807 113423713055421844361000443)
Hofstadter Sequences
The Hofstadter Sequences are a family of sequences defined by non-linear recurrence relations. I'll show 2 of them.
086. Hofstadter Female and Male Sequences
Both sequences start at index 0. The values are as follows:
F(0) = 1M(0) = 0F(n) = n - M(F(n-1))), n > 0M(n) = n - F(M(n-1))), n > 0
A gather/take construct is the best way to do this. The mutual
dependency makes it impossible to define one of them before the other, but we can remedy
that by declaring one of them first, without the definition):
#! /usr/bin/env raku # 086
unit sub MAIN ($limit = 10);
my $M;
my $F := gather
{
take 1;
loop { state $index++; take $index - $M[$F[$index -1]]; }
}
$M := gather
{
take 0;
loop { state $index++; take $index - $F[$M[$index -1]]; }
}
say " ", ( $_.fmt("%2d") for ^$limit ).join(" ");
say "F:", ( $F[$_].fmt("%2d") for ^$limit ).join(" ");
say "M:", ( $M[$_].fmt("%2d") for ^$limit ).join(" ");
$ ./hofstadter-FM 20
0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19
F: 1 1 2 2 3 3 4 5 5 6 6 7 8 8 9 9 10 11 11 12
M: 0 0 1 2 2 3 4 4 5 6 6 7 7 8 9 9 10 11 11 12
087. Hofstadter Q Sequence
This sequence start at index 1. The values are as follows:
Q(1) = 1Q(2) = 1Q(2) = Q(n - Q(n - 1)) + Q(n - Q(n - 2)), n > 2
#! /usr/bin/env raku # 087
unit sub MAIN ($limit = 10);
my $Q := gather
{
take 1;
take 1;
my $index = 1;
loop
{
$index++;
take $Q[$index - $Q[$index - 1]] + $Q[$index - $Q[$index - 2]];
}
}
say $Q[^$limit];
Note that the indices start at 0 in
$Q.
$ ./hofstadter-Q 25
(1 1 2 3 3 4 5 5 6 6 6 8 8 8 10 9 10 11 11 12 12 12 12 16 14)
Other Sequences
That did not fit in elsewhere...
088. Number of Derangements
The Derangement sequence start at index 0. The values are as follows:
d(0) = 1d(1) = 0d(n) = d(n - 1) * ( d(n - 1) + d(n - 2)), n > 1
As a recursive procedure using multiple dispatch:
multi sub derangement (0) { return 1; }
multi sub derangement (1) { return 0; }
multi sub derangement ($n)
{
return ($n - 1) * ( derangement($n - 1) + derangement($n - 2) );
}
The recursive calls (e.g.
derangement($n - 1)) are bad as they will compute an already
calculated value again. We can fix it by setting up a Sequence, which has
built-in caching, and access the values from it instead:
#! /usr/bin/env raku # 088a
unit sub MAIN (Int $count = 10);
my $d := (^Inf).map({ derangement($_) });
multi sub derangement (0) { return 1; }
multi sub derangement (1) { return 0; }
multi sub derangement ($n)
{
return ($n - 1) * ( $d[$n - 1] + $d[$n - 2] );
}
say $d[^$count];
$ ./derangement 14
(1 0 1 2 9 44 265 1854 14833 133496 1334961 14684570 176214841 2290792932)
As a Sequence:
( my $i = 1, 0, { $i++ * ($^b + $^a) }) # 088b
> say ( my $i = 1, 0, { $i++ * ($^b + $^a) } ... Inf)[^12];
(1 0 1 2 9 44 265 1854 14833 133496 1334961 14684570 176214841 2290792932)
089. Catalan Numbers
The Catalan Numbers (hich are named after a person, but shown here as they are similar to the «Number of Derangements») can be defined like this, with a recursive procedure using multiple dispatch.
File: catalan
#! /usr/bin/env raku # 089
unit sub MAIN (Int $count = 10);
my $c := (^Inf).map({ catalan($_) });
multi sub catalan (0) { return 1; }
multi sub catalan (1) { return 1; }
multi sub catalan ($n)
{
my $res;
$res += $c[$_] * $c[$n - $_ - 1] for ^$n;
return $res;
}
say $c[^$count];
$ ./catalan 14
(1 1 2 5 14 42 132 429 1430 4862 16796 58786 208012 742900)
The loop (for ^$n) makes it
impossible to set this up as a Sequence.
090. Triangular Numbers
The Triangular Numbers can be illustrated like this, where the value is the number of circles:
The numbers are: 1, 3, 6, 10, 15, 21, 28, 36, 45, ....
The formula for the ith value is: i * (i + 1) / 2. We can code
it like this with gather/take:
#! /usr/bin/env raku # 090a
unit sub MAIN (Int $count = 10);
my $t := gather
{
my $value = 1;
loop { take $value * ($value + 1) / 2; $value++ }
}
say $t[^$count];
./triangular 20
(1 3 6 10 15 21 28 36 45 55 66 78 91 105 120 136 153 171 190 210)
A closer look at the illustration shows us that the value for e.g. 3 is
the value for 2 added with the index - as we have added a new row at
the bottom with that number of circles.
We can set it up as a Sequence like this:
(my $i=1, * + 1 + $i++ ... Inf) # 090b
> say (my $i=1, * + 1 + $i++ ... Inf)[^20];
(1 3 6 10 15 21 28 36 45 55 66 78 91 105 120 136 153 171 190 210)
091. Tetrahedral Numbers
The Tetrahedral Numbers are similar to Triangular Numbers, but we stack them in three dimensions. We get a three sided pyramid of balls, where all the faces look the same. (See the link for details.)
The values are: 1, 4, 10, 20, 35, 56.
The pattern, which is hard to detect, is in fact rather easy. The number of balls in a layer n is the Triangular Number of the layer. The Tetrahedral Number is the previous Tetrahedral Number added with that Triangular Number.
my @triangular = (my $a=1, * + 1 + $a++ ... Inf); # 091
my @tetrahedral = (my $a=1, * + @triangular[$a++] ... Inf);
say @tetrahedral[^18];
(1 4 10 20 35 56 84 120 165 220 286 364 455 560 680 816 969 1140)
092. Square Numbers
The Square Numbers
(also called «Perfect Squares») are the result of squaring the indices
(index ** 2):
gather { my $index = 0; loop { take $index++ ** 2 }} # 092a
> say gather { my $index = 0; loop { take $index++ ** 2 }}[^20];
(0 1 4 9 16 25 36 49 64 81 100 121 144 169 196 225 256 289 324 361)
Or with map:
(^Inf).map( * ** 2 ) # 092b
> say (^Inf).map( * ** 2 )[^20];
(0 1 4 9 16 25 36 49 64 81 100 121 144 169 196 225 256 289 324 361)
093. Cube Numbers
The Cube Numbers
are the result of cubing the indices (index ** 3):
gather { my $value = 1; loop { take $value++ ** 3 }} # 093a
> say gather { my $value = 1; loop { take $value++ ** 3 }}[^17]
(1 8 27 64 125 216 343 512 729 1000 1331 1728 2197 2744 3375 4096 4913)
Or with map:
(1..Inf).map( * ** 3 ) # 093b
> say (1..Inf).map( * ** 3 )[^17]
(1 8 27 64 125 216 343 512 729 1000 1331 1728 2197 2744 3375 4096 4913)
094. To the Power of Itself
We can raise the numbers (the indices) to the power of themselves:
(1..Inf).map({ $_ ** $_ }) # 094
The numbers are growing at an alarming rate:
> say (1..Inf).map({ $_ ** $_ })[^10];
(1 4 27 256 3125 46656 823543 16777216 387420489 10000000000)
> say (1..Inf).map({ $_ ** $_ })[100].chars;
203
> say (1..Inf).map({ $_ ** $_ })[200].chars;
463
> say (1..Inf).map({ $_ ** $_ })[1000].chars;
3004
Challenge
Which sequence will this give us, and why?
(1..Inf).map( * ** * )
095. Every Other Number
We can have a sequence where there are different rules for the even and odd values. This is a very simple one, where all the values at even indices are zero:
gather { my $var = 1; loop { take $var++; take 0 }} # 095
> say gather { my $var = 1; loop { take $var++; take 0 }}[^25];
(1 0 2 0 3 0 4 0 5 0 6 0 7 0 8 0 9 0 10 0 11 0 12 0 13)