Random Differential Decomposition with Raku

This is my response to the Perl Weekly Challenge #023.

Challenge #23.1

subset Positive of Int where * >= 1;                               # [1]

sub MAIN (Positive :$order = 1, *@list is copy)                    # [2]
{
  die "Integers only in the list!" unless @list.all ~~ Int;        # [3]
    
  @list = forward-difference(@list) for ^$order;                   # [4]

  say @list;                                                       # [5]
}

sub forward-difference (@list)                                     # [6]
{
  return gather take @list[$_] - @list[$_ -1] for 1 .. @list.end;  # [7]
  # 7d # # 7c # # 7b ######################## # 7a #############
}

[1] The order is 1, 2, 3 and up. I have declared a custom type (with subset for that value.

[2] The program computes the 1st order by default, and any higher order if we specify a different value with the «--order» command line option. The values are given as a list on the command line (and the program uses a slurpy «*@list» to get them all).

[3] Exit if any of the values is something other than an integer.

[4] Use «forward-difference» to get the 1st order. The second order is done by doing the call again, with the output from the first one as input. And so on.

[5] Display the list (values).

[6] The procedure doing the job.

[7] Read this line of code from the end;

[7a] • The loop iterates over the indices of the array, from the second element to the end (skipping the first one). «end» gives the index of the last item in the array, which is 1 less than what «elems» gives.

[7b] • We send off the new values (with «take»), one at a time. Each new value is the current value (in the input list) minus the value to the left (and that is why we started with the second element in the loop).

[7c] • Use «gather» to collect the values from «take» in a list,

[7d] • and return that list.

See my Raku Gather, I Take article for more information about gather/take. They are usually used in a lazy context, but that isn't an issue here as we need all the values at once (for the return statement).

Running it:

$ raku forward-difference 5 9 2 8 1 6
[4 -7 6 -7 5]

$ raku forward-difference 4 -7 6 -7 5
[-11 13 -13 12]

Looking good. Let's try some other values:

$ raku forward-difference --order=2 5 9 2 8 1 6
[-11 13 -13 12]

$ raku forward-difference --order=3 5 9 2 8 1 6
[24 -26 25]

$ raku forward-difference --order=4 5 9 2 8 1 6
[-50 51]

$ raku forward-difference --order=5 5 9 2 8 1 6
[101]

$ raku forward-difference --order=6 5 9 2 8 1 6
[]

The last one shows that we get an empty list if the order is higher or equal to the number of elements in the input list.

Challenge #23.2

sub MAIN (Int $number where $number > 1)           # [1]
{
  say prime-decomposition($number).join(" * ");    # [2]
}

my $primes := (2 .. Inf).grep(*.is-prime);         # [3]

sub prime-decomposition (Int $number is copy)      # [4]
{
  my @decomposition;                               # [5]

  for $primes -> $prime                            # [6]
  {
    if $number.is-prime                            # [7]
    {
      @decomposition.push($number);                # [7a]
      last;                                        # [7b]
    }
    
    while $number %% $prime && $number != $prime   # [8]
    ##### # 8a ############    # 8b #############
    {
      $number div= $prime;                         # [9]
      @decomposition.push($prime);                 # [10]
      last if $number.is-prime;                    # [11]
    }
  }
  return @decomposition;                           # [7c]
}

[1] A «MAIN» wrapper around the «prime-decomposition» procedure doing the job. This makes it easier to reuse the procedure elsewhere (in case somebody has a need for it). The input value must be a positive integer, and 2 is the lowest legal value (as 0 and 1 are not primes).

[2] Get the values, and print them with a «*» (the multiplication symbol) between them as a nice touch.

[3] We need a list (or sequence) of primes. This should be familiar by now. (If not, look up one of my earlier articles with «Prime» in the name.).

[4] «is copy» gives us a writeable copy of the input value, as we shall modify it. The default is a read only variable.

[5] The decomposed primes go here.

[6] An outer loop through the primes, in increasing order.

[7] If the number (the original input number the first time, and a fraction of it after decomposition) itself is a prime, we add the number to the list [7a] and exit the loop [7b]. Finally the return statement returns the list [7c].

[8] A loop, as long as the number is divisible by the current prime (in [6]) and it (the number) isn't the same as the current prime (as e.g. «3 / 3» should be stopped). If the condition isn't met, we continue with the next iteration of the outer loop which tries the next prime.

[9] • divide the number by the prime, and assign the new number back. We have already ensured that the new value is an integer, so integer division (with «div») is the thing here.

[10] • add the prime to the list of decomposed primes.

[11] • exit this inner loop if the new number is a prime, as primes cannot be decomposed further. The next iteration of the outer loop sees that the number is a prime (in [7]), adds it to the list and finishes.

Challenge #23.3

#! /usr/bin/env raku

unit sub MAIN (Int $count where $count > 0 = 1);  # [1]

use LWP::Simple;                 # [2]
use JSON::Fast;                  # [2]
                
my $json = LWP::Simple.get('https://www.poemist.com/api/v1/randompoems'); # [3]

my $data = from-json $json;      # [4]

for ^$count                      # [5]
{
  last unless $data[$_];         # [5a]

  my $first = '"' ~ $data[$_]<title> ~ '" by ' ~ $data[$_]<poet><name>;   # [6]
  say $first;                    # [6a]
  say '-' x $first.chars;        # [7]
  say $data[$_]<content>;        # [8]
  say "";                        # [9]
}

[1] The API returns 5 (random) poems at a time. I have chosen to display only one, unless the user specifies a higher integer value on the command line.

[2] Install the modules «LWP::Simple», «JSON::Fast» and «IO::Socket::SSL» (with «zef»), if they are missing.

[3] Get the poems, as a json data structure.

[4] Convert the json data to Perl data structure.

[5] A loop running the number of times specified on the command line. The values are 0 to one less than the specified value, and that is excellent index material. Exit if the poem with the specified index isn't found. This ensures that a user specified value of e.g «100» doesn't cause an error. And it allows for future changes in the number of poems returned.

[6] The first line is the title in quotes, followed by «by» and the author. Print it [6b],

[7] • and get the length so that we can print a nice line of dashes under it.

[8] Print the poem itself. The data has embedded newlines, as they are essential in poems.

[9] Add a trailing blank line, so that the poems (in case we have more than one) are separated by a blank line.

See docs.raku.org/routine/x for more information about the String repetition operator x.

Running it:

$ raku random-poem-6
"(fragment 2) I Know 'Tis But A Dream, Yet Feel More Anguish" by Samuel Taylor Coleridge
----------------------------------------------------------------------------------------
I know 'tis but a Dream, yet feel more anguish 
Than if 'twere Truth. It has been often so:
Must I die under it? Is no one near?
Will no one hear these stifled groans and wake me?

One random poem is enough for me...

Bonus: Perl 5

Here it is:

#! /usr/bin/env perl

use feature 'say';        # [1]
use utf8;                 # [2]
binmode STDOUT, ":utf8";  # [2]

use LWP::Simple; 
use JSON;

my $count = 1;

$count = $ARGV[0] if @ARGV && $ARGV[0] >= 1; 

my $json = get('https://www.poemist.com/api/v1/randompoems');

my $data = from_json($json);

for (0 .. $count -1)       # [3]
{
  last unless $data->[$_]; # [4]

  my $first = '"' . $data->[$_]->{title} . '" by ' . $data->[$_]->{poet}->{name};
  say $first;  
  say '-' x length($first);    
  say $data->[$_]->{content};
  say "";
}

Note that the Perl and Raku code are very similar:

[1] «say» has been borrowed from Raku, but must be enabled manually.

[2] Unicode support in Perl is good, but must (also) be enabled manually.

[3] Note the loop.

[4] Perl uses «->» for object access, where Raku (and most other object oriented languages) uses «.» (a dot). But hey! Where are the dot in the Raku code you may ask. It isn't necessary, but can be used: $data[$_]<title> is the same as $data[$_].<title>.

The program works, in case you wonder:

$ perl random-poem-5
"When Life Is Young" by Alexander Anderson
------------------------------------------
When life is young, and dreams are sweet,
 And golden light is in the sky,
And Hope, with flowers about her feet,
 Smiles and is ever standing nigh,
Then all the earth is very fair,
And joy is dancing everywhere.
When life is cold, and all the skies
 Have lost their glory, and the light
Dims as a taper's ere it dies,
 And ghostly shadows whisper night,
Then Death may have within his call,
Something far sweeter than them all.

And that's it.