Random Differential Decomposition with Perl 6

by Arne Sommer

Random Differential Decomposition with Perl 6

Published 27. August 2019

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

Challenge #23.1

Create a script that prints nth order forward difference series. You should be able to pass the list of numbers and order number as command line parameters. Let me show you with an example.

Suppose we have list (X) of numbers: 5, 9, 2, 8, 1, 6 and we would like to create 1st order forward difference series (Y). So using the formula Y(i) = X(i+1) - X(i), we get the following numbers: (9-5), (2-9), (8-2), (1-8), (6-1). In short, the final series would be: 4, -7, 6, -7, 5. If you noticed, it has one less number than the original series. Similary you can carry on 2nd order forward difference series like: (-7-4), (6+7), (-7-6), (5+7) => -11, 13, -13, 12.

File: forward-difference
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 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 indeces of the array, from the second element to the end (skipping the first one).

[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 Perl 6 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:

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

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

Looking good. Let's try some other values:

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

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

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

$ perl6 forward-difference --order=5 5 9 2 8 1 6

$ perl6 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

Create a script that prints Prime Decomposition of a given number. The prime decomposition of a number is defined as a list of prime numbers which when all multiplied together, are equal to that number. For example, the Prime decomposition of 228 is 2,2,3,19 as 228 = 2 * 2 * 3 * 19.

File: prime-decomposition
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

Write a script to use Random Poems API. This is the easiset API, I have come across so far. You don’t need API key for this. They have only route to work with (GET). The API task is optional but we would love to see your solution.

File: random-poem-6
#! /usr/bin/env perl6

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.

Running it:

$ ./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

Doing the bouns API task was a first for me, so why not go the full nine yards (or rather the full five yards) and do the Perl 5 version as well?

Here it is:

File: random-poem-5
#! /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 5 and 6 code are very similar:

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

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

[3] Note the loop.

[4] Perl 5 uses «->» for object access, where Perl 6 (and most other object oriented languages) uses «.» (a dot). But hey! Where are the dot in the Perl 6 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:

$ ./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.