Monthly Archives: July 2023

Perl Weekly Challenge #227

Posted on by

This week’s challenge brought two new tasks: Friday the 13th & 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 13th. 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);
}

Perl Weekly Challenge #226

Posted on by

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.