Another week, time for another Perl Weekly Challenge!

Task 1: Unique Sum

You are given an array of integers.

Write a script to find out the sum of unique elements in the given array.

Example 1

Input: @int = (2, 1, 3, 2)
Output: 4

In the given array we have 2 unique elements (1, 3).

Example 2

Input: @int = (1, 1, 1, 1)
Output: 0

In the given array no unique element found.

Example 3

Input: @int = (2, 1, 3, 4)
Output: 10

In the given array every element is unique.

The examples make what this challenge is looking for pretty clear. We find the unique elements in the array, and sum those up. I immediately thought of using a hash to accomplish the task:

# find the unique elements
my %unique;
foreach my $int ( @ints ) {
  $unique{$int}++;
}

# make a list of ONLY the unique ints
my @unique_ints = grep { $unique{$_} == 1 } @ints;

It’s a common use-case in Perl to use a hash to count how many times something occurs, whether it’s to only do something once or to actually count up occurrences.

I guess I could have populated the %unique hash via a map, but I wanted to keep what the code was doing obvious, and sometimes I think using a map just to execute code in the code block and not to return an array/hash can be confusing.

map { $unique{$_}++ } @ints;

The other thing I knew I wanted to do was show off some List::Util functions

use List::Util qw( sum );

# sum the unique elements
my $sum = sum(@unique_ints) // 0;

Sure, it would be easy enough to say

my $sum = 0;
foreach my $int ( @unique_ints ) {
  $sum += $int;
}

But sum makes it is a lot shorter. So here’s the entire script…

#!/usr/bin/env perl

use v5.38;

use List::Util qw( sum );

# just accept the list of integers on the command line
my @ints = @ARGV;

# find the unique elements
my %unique;
foreach my $int ( @ints ) {
  $unique{$int}++;
}

# make a list of ONLY the unique ints
my @unique_ints = grep { $unique{$_} == 1 } @ints;

# sum the unique elements
my $sum = sum(@unique_ints) // 0;

# produce the output
say "Input: \@int = (" . join(', ', @ints) . ")";
say "Output: $sum";
say "";

print "In the given array ";
if ( scalar(@unique_ints) == scalar(@ints) ) {
  say "every element is unique.";
}
elsif ( scalar(@unique_ints) == 0 ) {
  say "no unique element found.";
}
else {
  say "we have " . scalar(@unique_ints) . " unique elements ("
    . join(', ', @unique_ints) . ").";
}

As always, I started with my Perl script and made changes to make it valid Raku:

#!/usr/bin/env raku

use v6;

# just accept the list of integers on the command line
my @ints = @*ARGS;

# find the unique elements
my %unique;
for @ints -> $int {
  %unique{$int}++;
}

# make a list of ONLY the unique ints
my @unique_ints = grep { %unique{$_} == 1 }, @ints;

# sum the unique elements
my $sum = [+] @unique_ints;

# produce the output
say "Input: \@int = (" ~ @ints.join(', ') ~ ")";
say "Output: $sum";
say "";

print "In the given array ";
if ( @unique_ints.elems == @ints.elems ) {
  say "every element is unique.";
}
elsif ( @unique_ints.elems == 0 ) {
  say "no unique element found.";
}
else {
  say "we have " ~ @unique_ints.elems ~ " unique elements ("
    ~ @unique_ints.join(', ') ~ ").";
}

Now, the big decision I had to make was how to do the sum. I picked showing off Raku’s Reduction Metaoperator: [ ]. When you put an operator between square brackets and put that in front of a Raku Positional (like an Array), it turns the Positional into a single value by applying the operator to the first two elements, and then applying the operator to the result and the next element, and so on until the Positional has run out of elements. You can multiply all the elements of a Positional using [*], you can concatenate all the elements of a Positional using [~], There’s even a max infix operator that given two operands will return the larger of the two, and this can be applied to a Positional to find the largest value using [max].

But I could have used the .sum routine provided by Raku’s List class (which Arrays are a subclass of):

my $sum = @unique_ints.sum;

Task 2: Empty Array

You are given an array of integers in which all elements are unique.

Write a script to perform the following operations until the array is empty and return the total count of operations.

If the first element is the smallest then remove it otherwise move it to the end.

Example 1

Input: @int = (3, 4, 2)
Output: 5

Operation 1: move 3 to the end: (4, 2, 3)
Operation 2: move 4 to the end: (2, 3, 4)
Operation 3: remove element 2: (3, 4)
Operation 4: remove element 3: (4)
Operation 5: remove element 4: ()

Example 2

Input: @int = (1, 2, 3)
Output: 3

Operation 1: remove element 1: (2, 3)
Operation 2: remove element 2: (3)
Operation 3: remove element 3: ()

This time, the List::Util function I wanted to use was min:

#!/usr/bin/env perl

use v5.38;

use List::Util qw( min );

# just accept the list of integers on the command line
my @ints = @ARGV;

my @operations;
my $count = 1;
while ( scalar(@ints) > 0 ) {
  my $min = min @ints;

  # in either case, we're removing the first element from the list
  my $first = shift @ints;

  if ($min == $first) {
    # the first element is the minimum, discard it
    push @operations, "Operation $count: "
                    . "remove element $min: ("
                    . join(',', @ints) . ")";
  }
  else {
    # the first element is NOT the minimum, add it to the end
    push @ints, $first;
    push @operations, "Operation $count: "
                    . "move $first to the end: ("
                    . join(',', @ints) . ")";
  }
  $count++;
}

# produce the output
# let's use @ARGV again, since we modify @ints as we go along
say "Input: \@int = (" . join(', ', @ARGV) . ")";
say "Output: " . scalar(@operations);
say "";
say join "\n", @operations;

This also does an excellent job of showing off array operations: shift to remove the first element of an array, and push to append an element to the end of an array (though, I will admit I really like the way PHP allows you to append to the end of an array: $ints[] = $first).

At first, I was using $ints[0] to examine the first element in the array and then using shift to remove it and discard the value if the first element was the minimum value, and if it wasn’t, using shift to remove the first value and save itm like this:

if ($min == $ints[0]) {
  shift @ints;
  push @operations, ...;
}
else {
  my $first = shift @ints;
  push @operations, ...;
}

But then I realized that I was shift-ing the value off @ints in either case, and it would just be cleaner to do it before the comparison so I could use $first instead of $ints[0].

The Raku version is nothing fancy this time:

#!/usr/bin/env raku

use v6;

# just accept the list of integers on the command line
my @ints = @*ARGS;

my @operations;
my $count = 1;
while ( @ints.elems > 0 ) {
  my $min = @ints.min;

  # in either case, we're removing the first element
  # from the list
  my $first = @ints.shift;

  if ($min == $first) {
    # the first element is the minimum, discard it
    push @operations, "Operation $count: "
                    ~ "remove element $min: ("
                    ~ @ints.join(', ') ~ ")";
  }
  else {
    # the first element is NOT the minimum, add it to the end
    push @ints, $first;
    push @operations, "Operation $count: "
                    ~ "move $first to the end: ("
                    ~ @ints.join(', ') ~ ")";
  }
  $count++;
}

# produce the output
# let's use @ARGV again, since we modofy @ints as we go along
say "Input: \@int = (" ~ @*ARGS.join(', ') ~ ")";
say "Output: " ~ @operations.elems;
say "";
say join "\n", @operations;

This week’s challenge brought two new tasks: Friday the 13^th & Roman Maths.

Task 1: Friday 13th

You are given a year number in the range 1753 to 9999.

Write a script to find out how many dates in the year are Friday 13th, assume that the current Gregorian calendar applies.

Example

Input: $year = 2023
Output: 2

Since there are only 2 Friday 13th in the given year 2023 i.e. 13th Jan and 13th Oct.

This was going to be easy, because I knew there were date manipulation modules in the core distribution: Time::Piece and Time::Seconds. I figured I wanted to start at the first of the year, add one day in a loop until I found the first Friday, and then skip from one Friday to the next by adding seven days, using the wday property of a Time::Piece object to check whether or not the date was the 13^th. Yes, instantiating the first day of the year would have been easier using the DateTime module, but I wanted to use only core modules if they did what I needed (and, really how much more complex is Time::Piece->strptime("$year-01-01", "%Y-%m-%d")->truncate(to => 'day'); versus DateTime->new(year => $year, month => 1, day => 1)->truncate(to => 'day');).

#!/usr/bin/env perl
use v5.38;

# let's use the core modules for date manipulation
use Time::Piece;
use Time::Seconds qw( ONE_DAY );

# get the year from the command line
my $year = shift @ARGV
  or die "usage: $0 year\n";

# do bounds checking as specified in the problem
if ($year < 1753 || $year > 9999) {
  die "Only years between 1753 to 9999 are allowed ($year is out of range)\n";
}

# create an object for Jan 01 of the given year
my $t = Time::Piece->strptime("$year-01-01", "%Y-%m-%d")
                   ->truncate(to => 'day');

# find the first friday
# in Time::Piece->wday, 1 = Sunday, 6 = Friday
while ( $t->wday != 6) {
  $t += ONE_DAY; # add 1 day
}

# now keep adding 7 days to the date until the year changes,
# noting how many times the day of the month is 13
my $thirteen_count = 0;
while ( $t->year == $year ) {
  $thirteen_count++ if $t->mday == 13;
  $t += ONE_DAY * 7;
}

say "Input: \$year = $year";
say "Output: $thirteen_count";

Doing this problem in Raku wound up being even easier, because in Raku, Date objects are a native part of the language, and incrementing a Date object increases the value by one day. Even instantiating a Date object was easier, because I didn’t need to parse a date format or specify an array with 0-indexed months or years with 1900 subtracted from them, I was able to specify a year, month, day in my new() call:

#!/usr/bin/env raku

sub MAIN($year) {
  # do bounds checking as specified in the problem
  if ($year < 1753 || $year > 9999) {
    say "Only years between 1753 to 9999 are allowed ($year is out of range)";
    exit 1;
  }

  # create an object for Jan 01 of the given year
  my $t = Date.new($year, 1, 1);

  # find the first friday
  # in Date.day-of-week, 0 = Sunday, 5 = Friday
  while ( $t.day-of-week != 5) {
    $t++; # add 1 day
  }

  # now keep adding 7 days to the date until the year changes,
  # noting how many times the day of the month is 13
  my $thirteen_count = 0;
  while ( $t.year == $year ) {
    $thirteen_count++ if $t.day == 13;
    $t += 7;
  }

  say "Input: \$year = $year";
  say "Output: $thirteen_count";
}

Task 2: Roman Maths

Write a script to handle a 2-term arithmetic operation expressed in Roman numeral.

Example

IV + V     => IX
M - I      => CMXCIX
X / II     => V
XI * VI    => LXVI
VII ** III => CCCXLIII
V - V      => nulla (they knew about zero but didn't have a symbol)
V / II     => non potest (they didn't do fractions)
MMM + M    => non potest (they only went up to 3999)
V - X      => non potest (they didn't do negative numbers)

Now, I’m not going to get into how Roman numerals did have ways of expressing fractions or numbers larger that 3,999, because that’s not part of the challenge. Remember, I want to showcase how easy it is to solve problems in Perl & Raku. And I knew just the module to use: Roman. Unfortunately, none of the modules for manipulating Roman numerals are in the core Perl distribution, so I had to use cpanm to install it: $ cpanm Roman (I could have used $ cpan install Roman instead, but I like the cpanm tool).

#!/usr/bin/env perl
use v5.38;

use Roman; # there's a module for handling Roman Numerals!

sub do_arithmetic {
  my $line = shift;
  # split the inout line into the three parts:
  # the two operands and the infix operator
  my($operand1r, $operator, $operand2r) = split /\s+/, $line;
  unless (defined $operand1r &&
          defined $operator  &&
          defined $operand2r) {
    say q{Lines must be of the form "operand1 operator operand2"};
    say q{where both operands are valid roman numerals and the};
    say q{operator is one of the following:  +  -  *  /  **};
    return;
  }

  my($operand1a, $operand2a);

  # check that the first operand is a roman numeral
  if (isroman($operand1r)) {
    # it is a roman numeral, convert it
    $operand1a = arabic($operand1r);
  }
  else {
    say "'$operand1r' is not a roman numberal!";
    return;
  }

  # check that the second operand is a roman numeral
  if (isroman($operand2r)) {
    # it is a roman numeral, convert it
    $operand2a = arabic($operand2r);
  }
  else {
    say "'$operand2r' is not a roman numberal!";
    return;
  }

  # calculate the results
  my $result;
  if ($operator eq '+') {
    $result = $operand1a + $operand2a;
  }
  elsif ($operator eq '-') {
    $result = $operand1a - $operand2a;
  }
  elsif ($operator eq '*') {
    $result = $operand1a * $operand2a;
  }
  elsif ($operator eq '/') {
    $result = $operand1a / $operand2a;
  }
  elsif ($operator eq '**') {
    $result = $operand1a ** $operand2a;
  }
  else {
    die "Unknown operator '$operator'; valid operators are + - * / **\n";
  }

  # handle all the special output cases
  if ($result == 0) {
    say "$operand1r $operator $operand2r => nulla "
      . "(they knew about zero but didn't have a symbol)";
  }
  elsif (int($result) != $result) {
    say "$operand1r $operator $operand2r => non potest "
      . "(they didn't do fractions)";
  }
  elsif ($result > 3999) {
    say "$operand1r $operator $operand2r => non potest "
      . "(they only went up to 3999)";
  }
  elsif ($result < 0) {
    say "$operand1r $operator $operand2r => non potest "
      . "(they didn't do negative numbers)";
  }
  else {
    say "$operand1r $operator $operand2r => " . uc roman($result);
  }
}

# while we have input on STDIN, process the calculations
while (my $line = <>) {
  chomp $line;
  do_arithmetic($line);
}

At first, I whipped it up as a command-line tool that accepted the two operands and the operator on the command line, but I realized it wouldn’t be easy to produce output as close to the sample as possible doing things this way, so I modified it to read the operations from STDIN. This also allowed me to add a file that could be used by both my Perl and Raku solutions to make the input standardized.

I also wanted to do some extra checking: not just the stuff between lines 53-72 to handle the special cases called out in the example; I wanted to check for invalid Roman numerals and for input that didn’t have two operands separated by an operator. Lines 22-40 do the check using the isroman() function provided by the Roman module, and lines 49-51 make sure that we generate an error if we’re not passed one of the five operators specified in the requirements.

The Raku version of this proved slightly more challenging, because the Math::Roman module available for Raku didn’t have a function corresponding to Perl’s Roman module’s isroman() function. So I had to make one:

#!/usr/bin/env raku
use Math::Roman; # it's v0.0.1, but usable

sub isroman ( $var ) {
  # Math::Roman doesn't have a test to see if a string is
  # a Roman numeral, but it does throw an exception if it
  # cannot convert it
  my $result;
  try {
    CATCH {
      default {
        return False;
      }
    }
    $result = Math::Roman.new: $var;
  }
  # Math::Roman also doesn't respect the maximum of 3999
  if ($result.as-arabic > 3999) {
    return False;
  }

  return True;
}

sub do_arithmetic (Str $line) {
  # split the inout line into the three parts:
  # the two operands and the infix operator
  my ($operand1, $operator, $operand2) = $line.split(/\s+/);

  unless (defined $operand1 &&
          defined $operator  &&
          defined $operand2) {
    say q{Lines must be of the form "operand1 operator operand2"};
    say q{where both operands are valid roman numerals and the};
    say q{operator is one of the following:  +  -  *  /  **};
    return;
  }

  # check that the first operand is a roman numeral
  if (isroman($operand1)) {
    # it is a roman numeral, convert it
    $operand1 = Math::Roman.new: $operand1;
  }
  else {
    say "'$operand1' is not a roman numberal!";
    return;
  }

  # check that the second operand is a roman numeral
  if (isroman($operand2)) {
    # it is a roman numeral, convert it
    $operand2 = Math::Roman.new: $operand2;
  }
  else {
    say "'$operand2' is not a roman numberal!";
    return;
  }

  # # calculate the results
  my $result;
  if ($operator eq '+')     {
    $result = $operand1.as-arabic + $operand2.as-arabic;
  }
  elsif ($operator eq '-')  {
    $result = $operand1.as-arabic - $operand2.as-arabic;
  }
  elsif ($operator eq '*')  {
    $result = $operand1.as-arabic * $operand2.as-arabic;
  }
  elsif ($operator eq '/')  {
    $result = $operand1.as-arabic / $operand2.as-arabic;
  }
  elsif ($operator eq '**') {
    $result = $operand1.as-arabic ** $operand2.as-arabic;
  }
  else {
    die "Unknown operator '$operator'; valid operators are + - * / **\n";
  }

  # handle all the special output cases
  if ($result == 0) {
    say "$operand1 $operator $operand2 => nulla "
      ~ "(they knew about zero but didn't have a symbol)";
  }
  elsif ($result.truncate != $result) {
    say "$operand1 $operator $operand2 => non potest "
      ~ "(they didn't do fractions)";
  }
  elsif ($result > 3999) {
    say "$operand1 $operator $operand2 => non potest "
      ~ "(they only went up to 3999)";
  }
  elsif ($result < 0) {
    say "$operand1 $operator $operand2 => non potest "
      ~ "(they didn't do negative numbers)";
  }
  else {
    $result = Math::Roman.new: value => $result.Int;
    say "$operand1 $operator $operand2 => $result";
  }
}

# while we have input on STDIN, process the calculations
for $*IN.lines -> $line {
  do_arithmetic($line);
}

I went to the Perl and Raku Conference in Toronto, ON, two weeks ago. I went because I really wanted to reconnect with the Perl community that I’d fallen out of touch with while I was working at a job where Perl was actively ridiculed.

While I was there, I was talking to one of the people giving talks, Bruce Gray. He suggested that one of the best ways to reconnect would be to do the weekly challenge.

I’d seen the challenge being talked about in emails I subscribed to, but I hadn’t given it much thought. But I wanted to reconnect, keep my Perl chops up to date, and generally start participating in the community again. So when I got the email for Challenge #226, I thought about it a bit. What I realized was that the challenge wasn’t just a way for people to showcase their Perl skills; it was a way for the community to showcase how easy Perl and Raku were to use. So I decided that was the approach I was going to take: not try to be clever, but try to show how easy this language I love is to solve problems.

Task 1: Shuffle String

Here’s the description provided in the challenge:

You are given a string and an array of indices of same length as string.
Write a script to return the string after re-arranging the indices in the correct order.

Example 1

Input: $string = 'lacelengh', @indices = (3,2,0,5,4,8,6,7,1)
Output: 'challenge'

Example 2

Input: $string = 'rulepark', @indices = (4,7,3,1,0,5,2,6)
Output: 'perlraku'

I won’t lie, it took me a little while to understand what it wanted me to do. Finally, I realized that the @indicies array was showing me where in the output string the character from the input string should be moved to: the first character in the input string should be moved to the 3rd position in the output, the second character to the 2nd position, the third to the 0th position and so on. Once I grokked that requirement, the Perl implementation came easily:

#!/usr/bin/env perl
use v5.36;

sub shuffle_string {
  my($string, $indices) = @_;
  my @chars = split //, $string; # split input string into characters
  my @result;
  foreach my $index ( @$indices ) {
    my $char  = shift @chars;     # get the next character
    $result[$index] = $char;      # put the character at that index in the result
  }
  say "Input: \$string = '$string', \@indices = (" . join(',', @$indices) . ")";
  say "Output: '" . join(q{}, @result) . "'";
}

say "Task 1: Shuffle String";
say "\nExample 1";
shuffle_string('lacelengh', [3,2,0,5,4,8,6,7,1]);
say "\nExample 2";
shuffle_string('rulepark', [4,7,3,1,0,5,2,6]);

Note how Perl makes handling the parts of the problem easy: splitting a string into its component characters is easy, recombining them back into a string is easy, passing the data around is easy.

Now, I don’t have a lot of experience with Raku; but I want to get better at it, so that’s why I’m doing the challenges in Raku as well. Unfortunately, for the moment my Raku solutions will look a lot like my Perl solutions:

#!/usr/bin/env raku

sub shuffle_string ($string, @indices) {
  my @chars = $string.split("", :skip-empty);
  my @result;
  for @indices -> $index {
    my $char = shift @chars;   # get the next character
    @result[$index] = $char;   # put the character at that index in the result
  }
  say "Input: \$string = '$string', \@indices = (" ~ @indices.join(',') ~ ")";
  say "Output: '" ~ @result.join('') ~ "'";
}

say "Task 1: Shuffle String";
say "\nExample 1";
shuffle_string('lacelengh', (3,2,0,5,4,8,6,7,1));
say "\nExample 2";
shuffle_string('rulepark', (4,7,3,1,0,5,2,6));

Task 2: Zero Array

You are given an array of non-negative integers, @ints.

Write a script to return the minimum number of operations to make every element equal zero.

In each operation, you are required to pick a positive number less than or equal to the smallest element in the array, then subtract that from each positive element in the array.

Example 1:

Input: @ints = (1, 5, 0, 3, 5)
Output: 3

operation 1: pick 1 => (0, 4, 0, 2, 4)
operation 2: pick 2 => (0, 2, 0, 0, 2)
operation 3: pick 2 => (0, 0, 0, 0, 0)

Example 2:

Input: @ints = (0)
Output: 0

Example 3:

Input: @ints = (2, 1, 4, 0, 3)
Output: 4

operation 1: pick 1 => (1, 0, 3, 0, 2)
operation 2: pick 1 => (0, 0, 2, 0, 1)
operation 3: pick 1 => (0, 0, 1, 0, 0)
operation 4: pick 1 => (0, 0, 0, 0, 0)

This one I found a lot easier to understand for some reason.

#!/usr/bin/env perl
use v5.36;

use List::Util qw( min );

sub min_positive {
  my @ints = grep { $_ > 0 } @_; # only consider positive numbers
  return min @ints; # find smallest, undef if empty list
}

sub zero_array {
  my @ints = @_;
  say "Input: \@ints = (" . join(', ', @ints) . ")";
  my @operations;
  while ( my $min = min_positive(@ints) ) {
    my $op_num = scalar(@operations) + 1;
    foreach my $int ( @ints ) {
      $int -= $min if $int > 0;
    }
    push @operations, "operation $op_num: pick $min => (" . join(', ', @ints) . ")";
  }
  say "Output: " . scalar(@operations);
  if (@operations) {
    say "";
    say join "\n", @operations;
  }
}

say "Task 2: Zero Array";
say "\nExample 1";
zero_array(1, 5, 0, 3, 5);

say "\nExample 2";
zero_array(0);

say "\nExample 3";
zero_array(2, 1, 4, 0, 3);

This one I’d like to pull apart a bit more. Picking “a positive number less than or equal to the smallest element in the array” sounded a lot like the min function found in the List::Util module, but that gives us the minimum value, not the minimum non-zero value, so I needed to filter the values equal to zero out of the array first. Initially, I did it like this:

min grep { $_ > 0 } @ints

but then I realized I needed to do that as part of the conditional to a loop, and I decided it would be a lot more readable if I pulled it out into it’s own function. Remember, I’m trying to express how easy things are in Perl, so I want to make my solutions completely readable and understandable to people who have never used Perl before.

I wanted the output to look exactly like the text in the examples, so I made the minimal extra effort to build an array of operations and put a bit of formatting into that so I could just dump the operations when I’d found out how many operations were necessary.

Again, my Raku solution looks like my Perl solution with a few syntax tweaks:

#!/usr/bin/env raku

sub min_positive (@ints) {
  my @positive = @ints.grep({ $_ > 0 }); # only consider positive numbers
  return unless @positive.elems;         # return early if no positive nums
  return @positive.reduce(&min);         # find smallest
}

sub zero_array (@ints) {
  say "Input: \@ints = (" ~ @ints.join(', ') ~ ")";
  my @operations;
  while ( my $min = min_positive(@ints) ) {
    my $op_num = @operations.elems + 1;
    for @ints <-> $int {
      $int -= $min if $int > 0;
    }
    @operations.push("operation $op_num: pick $min => (" ~ @ints.join(', ') ~ ")");
  }
  say "Output: " ~ @operations.elems;
  if (@operations) {
    say "";
    say @operations.join("\n");
  }
}

say "Task 2: Zero Array";
say "\nExample 1";
zero_array([1, 5, 0, 3, 5]);

say "\nExample 2";
zero_array([0]);

say "\nExample 3";
zero_array([2, 1, 4, 0, 3]);

If you really want a good example of how Raku can be used to solve this problem, take a look at Bruce Gray’s solution.

And that’s it. I’ve already coded my solutions for Challenge #227, and I’ll be blogging about them soon.