a) Weekends
b) Bank holidays

Input: $start_date = '2018-06-28', $offset = 3, $bank_holidays = ['2018-07-03']
Output: '2018-07-04'

Thursday bumped to Wednesday (3 day offset, with Monday a bank holiday)

Input: $start_date = '2018-06-28', $offset = 3
Output: '2018-07-03'

use Date::Names;

sub bankingDayOffset($start, $offset, @holidays) {
  my $date = Date.new($start); # convert string to Date
  my $off  = $offset;
  my $cnt  = 0;

  # convert holidays to Date objects
  @holidays = map { Date.new($_) }, @holidays;

  # instantiate a Date::Names object
  my $dn = Date::Names.new;

  my @explain;
  my $this_day = $dn.dow($date.day-of-week);
  while ($off) {
    $date++;
    my $next_day = $dn.dow($date.day-of-week);
    if (
      $date.day-of-week == 6 || # it's a Saturday
      $date.day-of-week == 7    # it's a Sunday
    ) { 
      @explain.push:
        "$next_day skipped because it's a weekend";
    }
    elsif ($date == @holidays.any) { # it's a Holiday
      @explain.push:
        "$next_day skipped because it's a holiday";
    }
    else {
      $off--; $cnt++;
      @explain.push:
        "$this_day bumped to $next_day (offset $cnt)";
      $this_day = $next_day;
    }
  }
  return $date.gist, @explain.join("\n");
}

$ raku/ch-1.raku
Example 1:
Input: $start_date = '2018-06-28', $offset = 3,
       $bank_holidays = ['2018-07-03']
Output: '2018-07-04'

Thursday bumped to Friday (offset 1)
Saturday skipped because it's a weekend
Sunday skipped because it's a weekend
Friday bumped to Monday (offset 2)
Tuesday skipped because it's a holiday
Monday bumped to Wednesday (offset 3)

Example 2:
Input: $start_date = '2018-06-28', $offset = 3
Output: '2018-07-03'

Thursday bumped to Friday (offset 1)
Saturday skipped because it's a weekend
Sunday skipped because it's a weekend
Friday bumped to Monday (offset 2)
Monday bumped to Tuesday (offset 3)

Example 3:
Input: $start_date = '2023-12-29', $offset = 5,
       $bank_holidays = ['2024-01-01']
Output: '2024-01-08'

Saturday skipped because it's a weekend
Sunday skipped because it's a weekend
Monday skipped because it's a holiday
Friday bumped to Tuesday (offset 1)
Tuesday bumped to Wednesday (offset 2)
Wednesday bumped to Thursday (offset 3)
Thursday bumped to Friday (offset 4)
Saturday skipped because it's a weekend
Sunday skipped because it's a weekend
Friday bumped to Monday (offset 5)

use List::Util qw( any );
use Time::Piece;
use Time::Seconds qw( ONE_DAY );

sub bankingDayOffset($start, $offset, @holidays) {
  # convert string to Date
  my $date = Time::Piece->strptime($start, "%Y-%m-%d")
                        ->truncate(to => 'day');
  my $cnt  = 0;

  # convert holidays to Date objects
  @holidays = map {
    Time::Piece->strptime($_, "%Y-%m-%d")
               ->truncate(to => 'day')
  } @holidays;

  my @explain;
  my $this_day = $date->fullday;
  while ($offset) {
    $date += ONE_DAY; # add 1 day
    my $next_day = $date->fullday;
    if (
      $date->wday == 7 || # it's a Saturday
      $date->wday == 1    # it's a Sunday
    ) { 
      push @explain,
        "$next_day skipped because it's a weekend";
    }
    elsif (any { $date == $_ } @holidays) { # it's a Holiday
      push @explain,
        "$next_day skipped because it's a holiday";
    }
    else {
      $offset--; $cnt++;
      push @explain,
        "$this_day bumped to $next_day (offset $cnt)";
      $this_day = $next_day;
    }
  }
  return $date->strftime('%F'), join("\n", @explain);
}

from datetime import date, timedelta

def bankingDayOffset(start, offset, holidays):
  d = date.fromisoformat(start) # convert string to Date
  cnt = 0

  # convert holidays to Date objects
  holidays = [ date.fromisoformat(h) for h in holidays ]

  explain = []
  this_day = d.strftime('%A')
  while offset:
    d += timedelta(days = 1) # add 1 day
    next_day = d.strftime('%A')
    if (
      d.isoweekday() == 6 or # it's a Saturday
      d.isoweekday() == 7    # it's a Sunday
    ): 
      explain.append(
        f"{next_day} skipped because it's a weekend"
      )
    elif any([d == h for h in holidays]): # it's a Holiday
      explain.append(
        f"{next_day} skipped because it's a holiday"
      )
    else:
      offset -= 1
      cnt += 1
      explain.append(
        f"{next_day} bumped to {next_day} (offset {cnt})"
      )
      this_day = next_day
  return d.strftime('%F'), "\n".join(explain)

{%  id   field1="value1"    field2="value2"  field3=42 %}

a) "id" can be \w+.
b) There can be 0  or more field-value pairs.
c) The name of the fields are \w+.
b) The values are either number in which case we don't need
   double quotes or string in which case we need double quotes
   around them.

{
       name => id,
       fields => {
           field1 => value1,
           field2 => value2,
           field3 => value3,
       }
}

{%  youtube title="Title \"quoted\" done" %}

{%  youtube title="Title with escaped backslash \\" %}

{% id  filed1="value1" ... %}
LINES
{% endid %}

{
       name => id,
       fields => {
           field1 => value1,
           field2 => value2,
           field3 => value3,
       }
       text => LINES
}

grammar Parser {
  rule TOP { [ <line> | <text> ] }

  rule line { '{%' <id> [ <field-value> ]* '%}' }

  # negative lookbehind and negative lookahead
  rule text { <!after ｢{%｣ > <-[ \n ]>+ <!before ｢%}｣ >}

  token id    { \w+ }
  token field { \w+ }

  token number { \d+ [ \. \d+ ]? }

  token quoted-string { '"' <string> '"' }
  token string {
    [
      <-[ " ]> # any character not a quote
      |
      ｢\\｣     # an escaped backslash
      |
      \\\"     # an escaped quote
    ]*
    }
  
  rule field-value { <field> '=' [<number> | <quoted-string>] }
}

sub MAIN($file) {
  my %data;
  my @ids;
  my $in_id = '';
  for $file.IO.lines -> $line {
    # parse this line of the file
    my $p = Parser.parse($line);

    # is there a line with {% ... %} ?
    if ($p<line>) {
      my $id = $p<line><id>.Str;
      # is the id the end of a block?
      if (my $c = ($id ~~ / end(\w+) /)) { # capture after end
        if (%data{$c[0]}:exists) { # it is!
          $id = $c[0]; 
          $in_id = ''; # clear the id we're processing
          if (%data{$id}{'text'}) {
            # if there's text, remove the final "newline"
            %data{$id}{'text'} ~~ s/\\n$//;
          }
          next; # skip to next line of file
        }
      }
      @ids.push($id); # keep list of ids in order
      $in_id = $id; # keep track of the current id for text
      # initialize base data for this id
      %data{$id} = { name => $id };
      # if we have fields...
      if ($p<line><field-value>) {
        # loop over them and store them in the data
        for $p<line><field-value> -> $fv {
          my $field = $fv<field>;
          my $value = $fv<number> ?? $fv<number> 
                   !! $fv<quoted-string><string>;
          %data{$id}{'fields'}{$field} = $value;
        }
      }
    }
    # if we have non-{% ... %} lines and we have an ID
    elsif ($p<text> && $in_id) {
      # append a "newline" to the end
      %data{$in_id}{'text'} ~= $p<text> ~ "\\n";
    }
  }

  # dump the data
  for @ids -> $id {
    my %group = %data{$id};
    say "\{";
    say "  name => %group{'name'},";
    say "  fields => \{";
    for %group{'fields'}.keys.sort -> $k {
      say "    $k => %group{'fields'}{$k},";
    }
    say "  }";
    say "  text => %group{'text'}" if %group{'text'};
    say "\}";
  }
}

$ raku/ch-2.raku data/parser-1.txt
{
  name => id,
  fields => {
    field1 => value1,
    field2 => value2,
    field3 => 42,
  }
}

$ raku/ch-2.raku data/parser-2.txt
{
  name => youtube,
  fields => {
    title => Title \"quoted\" done,
  }
}

$ raku/ch-2.raku data/parser-3.txt
{
  name => youtube,
  fields => {
    title => Title with escaped backslash \\,
  }
}

$ raku/ch-2.raku data/parser-4.txt
{
  name => id,
  fields => {
    filed1 => value1,
  }
  text => LINES
}

$ raku/ch-2.raku data/parser-5.txt
{
  name => id,
  fields => {
    filed1 => value1,
  }
  text => LINES\nLINES\nLINES
}
{
  name => foo,
  fields => {
    foonum => 3,
  }
  text => FOO\nBAR\nBAZ
}

use v5.38;

my $ID     = qr/ (?<ID> \w+) /x;
my $FIELD  = qr/ (?<FIELD> \w+) /x;
my $NUMBER = qr/ (?<NUMBER> \d+ [ \. \d+ ]? ) /x;
my $STRING = qr/ (?<STRING> ([^"] | \\ | \\\" )+ ) /x;

my $QUOTED_STRING = qr/ (?<QUOTED_STRING> " $STRING " ) /x;
my $FIELD_VALUE = qr/ $FIELD \s* = \s* ( $NUMBER | $QUOTED_STRING ) \s* /x;
my $FIELD_VALUES = qr/ (?<FIELD_VALUES> (?: $FIELD_VALUE \s* )* ) /x;

# negative lookbehind and negative lookahead
my $TEXT = qr/ (?<TEXT> (?<! {% ) .+ (?! %} ) ) /x;
my $LINE = qr/ (?<LINE> \{% \s* $ID \s* $FIELD_VALUES \s* %\} ) /x;

my $TOP  = qr/^ (?: $LINE | $TEXT ) $/x;

my $file = shift @ARGV;
open my $fh, '<', $file;

my %data;
my @ids;
my $in_id;

while (my $line = <$fh>) {
  $line =~ /$TOP/;

  # is there a line with {% ... %} ?
  if ($+{LINE}) {
    my $id = $+{ID};
    # is the id the end of a block?
    if ($id =~ /^ end(\w+) $/x) { # capture after end
      if (exists $data{$1}) { # it is!
        $id = $1; 
        undef $in_id; # clear the id we're processing
        if ($data{$id}{'text'}) {
          # if there's text, remove the final "newline"
          $data{$id}{'text'} =~ s/\\n$//;
        }
        next; # skip to next line of file
      }
    }
    push @ids, $id; # keep list of ids in order
    $in_id = $id; # keep track of the current id for text
    # initialize base data for this id
    $data{$id} = { name => $id };
    # if we have fields...
    my $field_values = $+{FIELD_VALUES};
    # loop over field values and store them in the data
    while ($field_values =~ /$FIELD_VALUE/g) {
      my $value = $+{STRING} ? $+{STRING} : $+{NUMBER};
      if ($+{NUMBER}) {
        $value =~ s/\s+$//; # we're picking up trailing spaces
      }
      $data{$id}->{'fields'}->{ $+{FIELD} } = $value;
    }

  }
  # if we have non-{% ... %} lines and we have an ID
  elsif ($+{TEXT} && $in_id) {
    # append a "newline" to the end
    $data{$in_id}{'text'} .= $+{TEXT} . "\\n";
  }
}

use Data::Dumper::Concise;
foreach my $id (@ids) {
  print Dumper($data{$id});
}

$ perl/ch-2.pl data/parser-1.txt
{
  fields => {
    field1 => "value1",
    field2 => "value2",
    field3 => 42,
  },
  name => "id",
}

$ perl/ch-2.pl data/parser-2.txt
{
  fields => {
    title => "Title \\",
  },
  name => "youtube",
}

$ perl/ch-2.pl data/parser-3.txt
{
  fields => {
    title => "Title with escaped backslash \\\\",
  },
  name => "youtube",
}

$ perl/ch-2.pl data/parser-4.txt
{
  fields => {
    filed1 => "value1",
  },
  name => "id",
  text => "LINES",
}

$ perl/ch-2.pl data/parser-5.txt
{
  fields => {
    filed1 => "value1",
  },
  name => "id",
  text => "LINES\\nLINES\\nLINES",
}
{
  fields => {
    foonum => 3,
  },
  name => "foo",
  text => "FOO\\nBAR\\nBAZ",
}

Input: @ints = (10, 1, 111, 24, 1000)
Output: 3

There are 3 integers having even digits i.e. 10, 24 and 1000.

Input: @ints = (111, 1, 11111)
Output: 0

Input: @ints = (2, 8, 1024, 256)
Output: 1

sub evenDigitCount(@ints) {
  my $count = 0; # in case there are no even digit ints
  for @ints -> $n {
    $count++ if floor(log10($n) + 1) % 2 == 0;
  }
  return $count;
}

use POSIX qw( log10 floor );

sub evenDigitCount(@ints) {
  my $count = 0; # in case there are no even digit ints
  foreach my $n ( @ints ) {
    $count++ if floor(log10($n) + 1) % 2 == 0;
  }
  return $count;
}

from math import floor, log10

def evenDigitCount(ints):
    count = 0; # in case there are no even digit ints
    for n in ints:
        if floor(log10(n) + 1) % 2 == 0: count += 1
    return count

Input: @ints = (2, 5, 9, 11, 3), $k = 1
Output: 17

Binary representation of index 0 = 0
Binary representation of index 1 = 1
Binary representation of index 2 = 10
Binary representation of index 3 = 11
Binary representation of index 4 = 100

So the indices 1, 2 and 4 have total one 1-bit sets.
Therefore the sum, $ints[1] + $ints[2] + $ints[4] = 17

Input: @ints = (2, 5, 9, 11, 3), $k = 2
Output: 11

Input: @ints = (2, 5, 9, 11, 3), $k = 0
Output: 2

use experimental :cached;

sub setBitCount($i) is cached {
  my $count = 0;
  my $bit   = 1;
  while ($bit <= $i) {
    $count++ if $i +& $bit; # count if we have this bit set
    $bit +<= 1; # shift bits left, ie 10 becomes 100
  }
  return $count;
}

sub valueSum($k, @ints) {
  my $sum = 0;
  for 0 .. @ints.end -> $i {
    $sum += @ints[$i] if setBitCount($i) == $k;
  }
  return $sum;
}

use Memoize;
memoize('setBitCount');

sub setBitCount($i) {
  my $count = 0;
  my $bit   = 1;
  while ($bit <= $i) {
    $count++ if $i & $bit; # count if we have this bit set
    $bit <<= 1; # shift bits left, ie 10 becomes 100
  }
  return $count;
}

sub valueSum($k, @ints) {
  my $sum = 0;
  foreach my $i ( 0 .. $#ints ) {
    $sum += $ints[$i] if setBitCount($i) == $k;
  }
  return $sum;
}

from functools import cache

@cache
def setBitCount(i):
  count = 0
  bit   = 1
  while (bit <= i):
    if i & bit: count += 1 # count if we have this bit set
    bit <<= 1 # shift bits left, ie 10 becomes 100
  return count

def valueSum(k, ints):
  sum = 0
  for i in range(len(ints)):
    if setBitCount(i) == k: sum += ints[i]
  return sum

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

For $ints[0] = 5, there are two integers (2,1) smaller than 5.
For $ints[1] = 2, there is one integer (1) smaller than 2.
For $ints[2] = 1, there is none integer smaller than 1.
For $ints[3] = 6, there are three integers (5,2,1) smaller than 6.

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

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

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

sub smallerThan(@ints) {
  my @counts;
  for 0 .. @ints.end -> $i {
    @counts[$i] = 0;
    for 0 .. @ints.end -> $j {
      next if $i == $j;
      @counts[$i]++ if @ints[$j] < @ints[$i];
    }
  }
  return @counts;
}

sub smallerThan(@ints) {
  my @counts;
  foreach my $i (0 .. $#ints) {
    @counts[$i] = 0;
    foreach my $j (0 .. $#ints) {
      next if $i == $j;
      $counts[$i]++ if $ints[$j] < $ints[$i];
    }
  }
  return @counts;
}

def smallerThan(ints):
  counts = []
  for i in range(len(ints)):
    counts.append(0)
    for j in range(len(ints)):
      if i != j and ints[j] < ints[i]: counts[i] += 1
  return counts

1. If a row does not consist entirely of zeros, then the first
   nonzero number in the row is a 1. We call this the leading 1.
2. If there are any rows that consist entirely of zeros, then
   they are grouped together at the bottom of the matrix.
3. In any two successive rows that do not consist entirely of
   zeros, the leading 1 in the lower row occurs farther to the
   right than the leading 1 in the higher row.
4. Each column that contains a leading 1 has zeros everywhere
   else in that column.

[
   [1,0,0,1],
   [0,1,0,2],
   [0,0,1,3]
]

    Input: $M = [
                  [1, 1, 0],
                  [0, 1, 0],
                  [0, 0, 0]
                ]
    Output: 0

    Input: $M = [
                  [0, 1,-2, 0, 1],
                  [0, 0, 0, 1, 3],
                  [0, 0, 0, 0, 0],
                  [0, 0, 0, 0, 0]
                ]
    Output: 1

    Input: $M = [
                  [1, 0, 0, 4],
                  [0, 1, 0, 7],
                  [0, 0, 1,-1]
                ]
    Output: 1

    Input: $M = [
                  [0, 1,-2, 0, 1],
                  [0, 0, 0, 0, 0],
                  [0, 0, 0, 1, 3],
                  [0, 0, 0, 0, 0]
                ]
    Output: 0

    Input: $M = [
                  [0, 1, 0],
                  [1, 0, 0],
                  [0, 0, 0]
                ]
    Output: 0

    Input: $M = [
                  [4, 0, 0, 0],
                  [0, 1, 0, 7],
                  [0, 0, 1,-1]
                ]
    Output: 0

sub rowIsEntirelyZeros(@row) {
  for @row -> $n {
    next if $n == 0;
    return 0;
  }
  return 1;
}

sub rowHasLeadingOne(@row) {
  for @row -> $n {
    next if $n == 0;
    return $n == 1;
  }
}

sub leadingOnePosition(@row) {
  for 0 .. @row.end -> $i {
    next if @row[$i] == 0;
    return $i;
  }
}

sub columnHasZerosBesidesLeadingOne(@matrix, $col) {
  my $count = 0;
  for @matrix -> @row {
    next if @row[$col] == 0; # skip zeroes
    return 0 if @row[$col] != 1; # fail if not one
    $count++; # count ones
  }
  return $count == 1;
}

sub isReducedRowEchelon(@matrix) {
  my $foundAllZeroRow = 0;
  my $lastLeadingOnePos = -1; # avoid comparison with undef
  for @matrix -> @row {
    if (! rowIsEntirelyZeros(@row)) {
      # 1. If a row does not consist entirely of zeros, then
      #    the first nonzero number in the row is a 1. We call
      #    this the leading 1.
      return 0 unless rowHasLeadingOne(@row);

      # 2. If there are any rows that consist entirely of zeros,
      #    then they are grouped together at the bottom of the
      #    matrix.
      return 0 if $foundAllZeroRow;

      # 3. In any two successive rows that do not consist
      #    entirely of zeros, the leading 1 in the lower row
      #    occurs farther to the right than the leading 1 in
      #    the higher row.
      my $thisLeadingOnePos = leadingOnePosition(@row);
      return 0 if $lastLeadingOnePos > $thisLeadingOnePos;
      $lastLeadingOnePos = $thisLeadingOnePos;

      # 4. Each column that contains a leading 1 has zeros
      #    everywhere else in that column.
      return 0 unless columnHasZerosBesidesLeadingOne(
        @matrix, $thisLeadingOnePos
      );
    }
    else {
      $foundAllZeroRow = 1;
    }
  }
  return 1;
}

sub rowIsEntirelyZeros(@row) {
  foreach my $n (@row) {
    next if $n == 0;
    return 0;
  }
  return 1;
}

sub rowHasLeadingOne(@row) {
  foreach my $n (@row) {
    next if $n == 0;
    return $n == 1;
  }
}

sub leadingOnePosition(@row) {
  foreach my $i (0 .. $#row) {
    next if $row[$i] == 0;
    return $i;
  }
}

sub columnHasZerosBesidesLeadingOne($matrix, $col) {
  my $count = 0;
  foreach my $row (@$matrix) {
    next if $row->[$col] == 0; # skip zeroes
    return 0 if $row->[$col] != 1; # fail if not one
    $count++; # count ones
  }
  return $count == 1;
}

sub isReducedRowEchelon(@matrix) {
  my $foundAllZeroRow = 0;
  my $lastLeadingOnePos = -1; # avoid comparison with undef
  foreach my $row (@matrix) {
    if (! rowIsEntirelyZeros(@$row)) {
      # 1. If a row does not consist entirely of zeros, then
      #    the first nonzero number in the row is a 1. We call
      #    this the leading 1.
      return 0 unless rowHasLeadingOne(@$row);

      # 2. If there are any rows that consist entirely of zeros,
      #    then they are grouped together at the bottom of the
      #    matrix.
      return 0 if $foundAllZeroRow;

      # 3. In any two successive rows that do not consist
      #    entirely of zeros, the leading 1 in the lower row
      #    occurs farther to the right than the leading 1 in
      #    the higher row.
      my $thisLeadingOnePos = leadingOnePosition(@$row);
      return 0 if $lastLeadingOnePos > $thisLeadingOnePos;
      $lastLeadingOnePos = $thisLeadingOnePos;

      # 4. Each column that contains a leading 1 has zeros
      #    everywhere else in that column.
      return 0 unless columnHasZerosBesidesLeadingOne(
        \@matrix, $thisLeadingOnePos
      );
    }
    else {
      $foundAllZeroRow = 1;
    }
  }
  return 1;
}

def rowIsEntirelyZeros(row):
    for n in row:
        if not n == 0: return 0
    return 1

def rowHasLeadingOne(row):
    for n in row:
        if not n == 0: return n == 1

def leadingOnePosition(row):
    for i in range(len(row)):
        if not row[i] == 0: return i

def columnHasZerosBesidesLeadingOne(matrix, col):
    count = 0
    for row in matrix:
        if not row[col] == 0: # skip zeroes
            if row[col] != 1: return 0 # fail if not one
            count += 1 # count ones
    return count == 1

def isReducedRowEchelon(matrix):
    foundAllZeroRow = 0
    lastLeadingOnePos = -1 # avoid comparison with undef
    for row in matrix:
        if not rowIsEntirelyZeros(row):
            # 1. If a row does not consist entirely of zeros,
            #    then the first nonzero number in the row is
            #    a 1. We call this the leading 1.
            if not rowHasLeadingOne(row): return 0 

            # 2. If there are any rows that consist entirely
            #    of zeros, then they are grouped together at
            #    the bottom of the matrix.
            if foundAllZeroRow: return 0

            # 3. In any two successive rows that do not consist
            #    entirely of zeros, the leading 1 in the lower
            #    row occurs farther to the right than the
            #    leading 1 in the higher row.
            thisLeadingOnePos = leadingOnePosition(row)
            if lastLeadingOnePos > thisLeadingOnePos: return 0
            lastLeadingOnePos = thisLeadingOnePos

            # 4. Each column that contains a leading 1 has
            #    zeros everywhere else in that column.
            if not columnHasZerosBesidesLeadingOne(
                matrix, thisLeadingOnePos
            ): return 0
        else:
            foundAllZeroRow = 1
    return 1

Input: @words = ("ab", "de", "ed", "bc")
Output: 1

There is one pair in the given array: "de" and "ed"

Input: @words = ("aa", "ba", "cd", "ed")
Output: 0

Input: @words = ("uv", "qp", "st", "vu", "mn", "pq")
Output: 2

sub maximumPairs(@words) {
  my $count = 0;
  while (@words) {
    # the the first word off the list
    my $first = @words.shift;
    # now compare to the rest of the words in the list
    for 0 .. @words.end -> $i {
      my $second = @words[$i];
      if ($first eq $second.flip) {
        # we found a pair
        $count++;
        # remove @words[$i] from the list
        @words.splice($i, 1);
        # we don't need to compare any more words to $first
        last;
      }
    }
  }
  return $count;
}

sub maximumPairs(@words) {
  my $count = 0;
  while (@words) {
    # the the first word off the list
    my $first = shift @words;
    # now compare to the rest of the words in the list
    for my $i (0 .. $#words) {
      my $second = $words[$i];
      if ($first eq reverse $second) {
        # we found a pair
        $count++;
        # remove @words[$i] from the list
        splice(@words, $i, 1);
        # we don't need to compare any more words to $first
        last;
      }
    }
  }
  return $count;
}

def maximumPairs(words):
    count = 0
    while words:
        # the the first word off the list
        first = words.pop(0)
        # now compare to the rest of the words in the list
        for i in range(len(words)):
            second = words[i]
            if first == second[::-1]:
                # we found a pair
                count += 1
                # remove words[i] from the list
                words.pop(i)
                # we don't need to compare
                # any more words to first
                break
    return count

Input: $str1 = "abcd", $str2 = "1234"
Output: "a1b2c3d4"

Input: $str1 = "abc", $str2 = "12345"
Output: "a1b2c345"

sub mergeStrings($str1, $str2) {
  my @chars1 = $str1.split('', :skip-empty);
  my @chars2 = $str2.split('', :skip-empty);
  my $result;
  while (@chars1 || @chars2) {
    $result ~= @chars1.shift if @chars1;
    $result ~= @chars2.shift if @chars2;
  }
  return $result;
}

sub mergeStrings($str1, $str2) {
  my @chars1 = split(//, $str1);
  my @chars2 = split(//, $str2);
  my $result;
  while (@chars1 || @chars2) {
    $result .= shift(@chars1) if @chars1;
    $result .= shift(@chars2) if @chars2;
  }
  return $result;
}

def mergeStrings(str1, str2):
    chars1 = list(str1)
    chars2 = list(str2)
    result = ''
    while chars1 or chars2:
        if chars1:
            result += chars1.pop(0)
        if chars2:
            result += chars2.pop(0)
    return result

Input: $s = "Perl" $t = "Preel"
Output: "e"

Input: $s = "Weekly" $t = "Weeakly"
Output: "a"

Input: $s = "Box" $t = "Boxy"
Output: "y"

sub oddChar($s, $t) {
  # count the characters in $s
  my %count;
  for $s.lc.split('', :skip-empty) -> $c {
    %count{$c}++;
  }
  # find the character in $t that's been added to $s
  for $t.lc.split('', :skip-empty) -> $c {
    if ( %count{$c}:!exists ) {
      # we found the added character!
      return $c
    }
    %count{$c}--;
    %count{$c}:delete if %count{$c} == 0;
  }
  die "No odd character found!";
}

sub oddChar($s, $t) {
  # count the characters in $s
  my %count;
  foreach my $c ( split(//, lc($s)) ) {
    $count{$c}++;
  }
  # find the character in $t that's been added to $s
  foreach my $c ( split(//, lc($t)) ) {
    if ( ! exists $count{$c} ) {
      # we found the added character!
      return $c
    }
    $count{$c}--;
    delete $count{$c} if $count{$c} == 0;
  }
  die "No odd character found!";
}

import sys
from collections import Counter

def oddChar(s, t):
    # count the characters in s
    count = Counter()
    for c in s.lower():
        count[c] += 1

    # find the character in t that's been added to s
    for c in t.lower():
        if c not in count:
            # we found the added character!
            return c
        count[c] -= 1
        if count[c] == 0:
            del count[c]

    sys.exit("No odd character found!")

Input: $p = "Joe hit a ball, the hit ball flew far after it was hit."
       $w = "hit"
Output: "ball"

The banned word "hit" occurs 3 times.
The other word "ball" occurs 2 times.

Input: $p = "Perl and Raku belong to the same family. Perl is the most popular language in the weekly challenge."
       $w = "the"
Output: "Perl"

The banned word "the" occurs 3 times.
The other word "Perl" occurs 2 times.

Example 1:
Input: $p = "Joe hit a ball, the hit ball flew far after it was hit."
       $w = "hit"
Output: "hit."

The banned word "hit" occurs 2 times.
The other word "hit." occurs 1 time.

sub frequentWord($p, $w) {
  # assign the value to a container so we can modify it
  my $paragraph = $p;

  # first, remove punctuation from the paragraph
  # (but we'll leave apostrophes for contractions)
  $paragraph ~~ s:i:g/<-[a..z'\s]>//;

  # count the words in $paragraph
  my %count;
  for $paragraph.lc.split(' ', :skip-empty) -> $pw {
    %count{$pw}++;
  }

  # generate the output about the banned word
  my $bannedCount = %count{$w} // 0;
  my $output = qq/The banned word "$w" occurs $bannedCount /;
  $output ~= ($bannedCount == 1) ?? 'time' !! 'times';
  $output ~= ".\n";

  # delete the banned word from the word count
  %count{$w}:delete;

  # now find the most frequent word left and report on that
  my @sorted = %count.keys.sort: {
    # sort by count
    %count{$^b} <=> %count{$^a}
  };
  my $freqWord  = @sorted[0];
  my $freqCount = %count{$freqWord};

  $output ~= qq/The other word "$freqWord" /;
  $output ~= qq/occurs $freqCount /;
  $output ~= ($freqCount == 1) ?? 'time.' !! 'times.';

  return $freqWord, $output;
}

Example 1:
Input: $p = "Joe hit a ball, the hit ball flew far after it was hit."
       $w = "hit"
Output: "ball"

The banned word "hit" occurs 3 times.
The other word "ball" occurs 2 times.

sub frequentWord($p, $w) {
  # first, remove punctuation from the paragraph
  # (but we'll leave apostrophes for contractions)
  $p =~ s/[^a-z'\s]//ig;

  # count the words in $paragraph
  my %count;
  foreach my $pw ( split(/\s+/, lc($p)) ) {
    $count{$pw}++;
  }

  # generate the output about the banned word
  my $bannedCount = $count{$w} // 0;
  my $output = qq/The banned word "$w" occurs $bannedCount /;
  $output .= ($bannedCount == 1) ? 'time' : 'times';
  $output .= ".\n";

  # delete the banned word from the word count
  delete $count{$w};

  # now find the most frequent word left and report on that
  my @sorted = sort {
    # sort by count
    $count{$b} <=> $count{$a}
  } keys %count;
  my $freqWord  = $sorted[0];
  my $freqCount = $count{$freqWord};

  $output .= qq/The other word "$freqWord" /;
  $output .= qq/occurs $freqCount /;
  $output .= ($freqCount == 1) ? 'time.' : 'times.';

  return $freqWord, $output;
}

import re
from collections import Counter

def frequentWord(p, w):
    # first, remove punctuation from the paragraph
    # (but we'll leave apostrophes for contractions)
    p = re.sub(r'[^a-z\'\s]', '', p.lower())

    # count the words in $paragraph
    count = Counter()
    for pw in p.split():
        count[pw] += 1

    # generate the output about the banned word
    bannedCount = count[w] if w in count else 0
    output = f'The banned word "{w}" occurs {bannedCount} ';
    output += 'time' if bannedCount == 1 else 'times'
    output += ".\n"

    # delete the banned word from the word count
    del count[w]

    # now find the most frequent word left and report on that
    decorated = [ ( count[w], w ) for w in count.keys() ]
    sorted_tuples = sorted(
        decorated,
        # the - before the first element sorts descending
        key=lambda k: -k[0]
    )
    freqWord = sorted_tuples[0][1]
    freqCount = count[freqWord]

    output +=  f'The other word "{freqWord}" '
    output += f'occurs {freqCount} '
    output += 'time.' if freqCount == 1 else 'times.'

    return (freqWord, output)

Input: @words = ("one.two.three","four.five","six")
       $separator = "."
Output: "one","two","three","four","five","six"

Input: @words = ("$perl$$", "$$raku$")
       $separator = "$"
Output: "perl","raku"

sub splitOnSeparator(@words, $separator) {
  my @output;
  for @words -> $str {
    @output.append( $str.split($separator, :skip-empty) );
  }
  return @output;
}

sub splitOnSeparator($separator, @words) {
  my @output;
  foreach my $str ( @words ) {
    push @output, grep { !/^$/ } split(/\Q$separator/, $str);
  }
  return @output;
}

def splitOnSeparator(words, separator):
    output = []
    for str in words:
        output.extend(
            list(filter(lambda w: w>"", str.split(separator)))
        )
    return output

a) The number of 1s in row i is less than the number of 1s in row j.
b) Both rows have the same number of 1 and i < j.

Input: $matrix = [
                   [1, 1, 0, 0, 0],
                   [1, 1, 1, 1, 0],
                   [1, 0, 0, 0, 0],
                   [1, 1, 0, 0, 0],
                   [1, 1, 1, 1, 1]
                 ]
Output: (2, 0, 3, 1, 4)

The number of 1s in each row is:
- Row 0: 2
- Row 1: 4
- Row 2: 1
- Row 3: 2
- Row 4: 5

Input: $matrix = [
                   [1, 0, 0, 0],
                   [1, 1, 1, 1],
                   [1, 0, 0, 0],
                   [1, 0, 0, 0]
                 ]
Output: (0, 2, 3, 1)

The number of 1s in each row is:
- Row 0: 1
- Row 1: 4
- Row 2: 1
- Row 3: 1

sub weakestRows(@matrix) {
  my @oneCount = @matrix.map({ $_.sum });
  my @weakest = (0 .. @oneCount.end).sort: {
    # sort by count first
    @oneCount[$^a] <=> @oneCount[$^b]
    ||
    # then by index order
    $^a <=> $^b
  };

  return @weakest;
}

use List::Util qw( sum );

sub weakestRows(@matrix) {
  my @oneCount = map { sum(@$_) } @matrix;
  my @weakest = sort {
    # sort by count first
    $oneCount[$a] <=> $oneCount[$b]
    ||
    # then by index order
    $a cmp $b
  } (0 .. $#oneCount);

  return @weakest;
}

def weakestRows(matrix):
    oneCount = [ sum(row) for row in matrix ]
    # sort the rows by their oneCount values
    # use the Decorate-Sort-Undecorate idiom
    # to convert the dict into a list
    # https://docs.python.org/3/howto/sorting.html#decorate-sort-undecorate
    decorated = [
        (oneCount[i], i) for i in range(len(oneCount))
    ]
    sorted_tuples = sorted(
        decorated,
        # the - before the first element sorts descending
        key=lambda k: (k[0], k[1])
    )
    weakest = [ t[1] for t in sorted_tuples ]
    return weakest

An element $int[i] of @ints is called special if i divides n, i.e. n % i == 0.
Where n is the length of the given array. Also the array is 1-indexed for the task.

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

There are exactly 3 special elements in the given array:
$ints[1] since 1 divides 4,
$ints[2] since 2 divides 4, and
$ints[4] since 4 divides 4.

Hence, the sum of the squares of all special elements of given array:
1 * 1 + 2 * 2 + 4 * 4 = 21.

Input: @ints = (2, 7, 1, 19, 18, 3)
Output: 63

There are exactly 4 special elements in the given array:
$ints[1] since 1 divides 6,
$ints[2] since 2 divides 6,
$ints[3] since 3 divides 6, and
$ints[6] since 6 divides 6.

Hence, the sum of the squares of all special elements of given array:
2 * 2 + 7 * 7 + 1 * 1 + 3 * 3 = 63

sub specialElementIndices($n) {
  return (1 .. $n).grep({ $n % $_ == 0 });
}

# code borrowed from my code for PWC 229
sub english_list ( *@list ) {
  # given a list, join it in a way that makes sense
  # to english speakers
  my $last = @list.pop(); # last element in array
  if (@list == 0) {
    # using an array in a scalar context returns
    # the number of elements in the array

    # there was only one element in the list
    return $last;
  }
  my $joined = @list.join(qq{,\n});
  if (@list > 1) {
    # if there's more than element, add an Oxford comma
    $joined ~= q{,};
  }
  return "$joined and\n$last";
}

sub specialNumberSquareSum(@ints) {
  my $n = @ints.elems;

  # find the list of indices for "special" numbers
  my @specialIndices = specialElementIndices($n);
  my $count = @specialIndices.elems;
  my @explain_list = @specialIndices.map({
    "\$ints[$_] since $_ divides $n"
  });
  my $explain = "There are exactly $count special elements "
    ~ "in the given array:\n" ~ english_list(@explain_list);

  # find the special numbers themselves
  my @special = @specialIndices.map({ @ints[$_ - 1] });

  # find the sum of the squares
  my $sum = @special.map({ $_ ** 2 }).sum;

  $explain ~= "\nHence, the sum of the squares of all special "
    ~ "elements of given array:\n"
    ~ @special.map({ "$_ * $_" }).join(' + ')
    ~ " = " ~ $sum;

  return (
    $sum,
    $explain
  );
}

use List::Util qw( sum );

sub specialElementIndices($n) {
  return grep { $n % $_ == 0 } 1 .. $n;
}

sub english_list ( @list ) {
  # given a list, join it in a way that makes sense
  # to english speakers
  my $last = pop @list; # last element in array
  if (@list == 0) {
    # using an array in a scalar context returns
    # the number of elements in the array

    # there was only one element in the list
    return $last;
  }
  my $joined = join qq{,\n}, @list;
  if (@list > 1) {
    # if there's more than element, add an Oxford comma
    $joined .= q{,};
  }
  return "$joined and\n$last";
}

sub specialNumberSquareSum(@ints) {
  # in scalar context, an array evaluates to the number
  # of elements in the array
  my $n = @ints;

  # find the list of indices for "special" numbers
  my @specialIndices = specialElementIndices($n);
  my $count = @specialIndices;
  my @explain_list = map {
    "\$ints[$_] since $_ divides $n"
  } @specialIndices;
  my $explain = "There are exactly $count special elements "
    . "in the given array:\n" . english_list(@explain_list);

  # find the special numbers themselves
  my @special = map { $ints[$_ - 1] } @specialIndices;

  # find the sum of the squares
  my $sum = sum( map { $_ ** 2 } @special);

  $explain .= "\nHence, the sum of the squares of all special "
    . "elements of given array:\n"
    . join(' + ', map { "$_ * $_" } @special)
    . " = " . $sum;

  return (
    $sum,
    $explain
  );
}

def specialElementIndices(n):
    return list( filter(lambda x: n % x == 0, range(1, n+1)) )

def english_list (strlist):
    # given a list, join it in a way that makes sense
    # to english speakers
    last = strlist.pop(-1) # last element in array
    if (len(strlist) == 0):
        # using an array in a scalar context returns
        # the number of elements in the array

        # there was only one element in the list
        return last

    joined = ',\n'.join(strlist)
    if (len(strlist) > 1):
        # if there's more than element, add an Oxford comma
        joined += ','

    return f'{joined} and\n{last}'

def specialNumberSquareSum(ints):
    n = len(ints)

    # find the list of indices for "special" numbers
    specialIndices = specialElementIndices(n)
    count = len(specialIndices)
    explain_list = [
        f"$ints[{x}] since {x} divides {n}"
        for x in specialIndices
    ] 
    explain = (
        "There are exactly $count special elements " +
        "in the given array:\n" + english_list(explain_list)
    )

    # find the special numbers themselves
    special = [ ints[x - 1] for x in specialIndices ]

    # find the sum of the squares
    sumval = sum([ x ** 2 for x in special ])

    explain += '\nHence, the sum of the squares of all special '
    explain += 'elements of given array:\n'
    explain += ' + '.join(map(lambda x: f'{x} * {x}', special))
    explain += f' = {sumval}'

    return (
        sumval,
        explain
    )

Input: $n = 5
Output: (-7, -1, 1, 3, 4)

Two other possible solutions could be as below:
(-5, -1, 1, 2, 3) and (-3, -1, 2, -2, 4).

Input: $n = 3
Output: (-1, 0, 1)

Input: $n = 1
Output: (0)

Example 1:
Input: $n = 5
Output: (-2, -1, 0, 1, 2)

Example 2:
Input: $n = 3
Output: (-1, 0, 1)

Example 3:
Input: $n = 1
Output: (0)

sub uniqueSumZero($input) {
  my $n = $input;
  my @list;
  my $x = 1;
  while ($n > 0) {
    if ($n % 2 == 1) { # $n is odd
      @list.push(0);
      $n -= 1;
    }
    else { # $n is even
      @list.append($x * -1, $x);
      $x += 1;
      $n -= 2;
    }
  }
  return @list.sort;
}

sub uniqueSumZero($n) {
  my @list;
  my $x = 1;
  while ($n > 0) {
    if ($n % 2 == 1) { # $n is odd
      push @list, 0;
      $n--;
    }
    else { # $n is even
      push @list, $x * -1, $x;
      $x++;
      $n -= 2;
    }
  }
  return sort { $a <=> $b } @list;
}

def uniqueSumZero(n):
    zero_sum_list = []
    x = 1
    while n > 0:
        if (n % 2 == 1): # n is odd
            zero_sum_list.append(0)
            n -= 1
        else: # n is even
            zero_sum_list.append(x * -1)
            zero_sum_list.append(x)
            x += 1
            n -= 2
    zero_sum_list.sort()
    return zero_sum_list

For example, the concatenation of 10, 21 is 1021.
The concatenation value of @ints is initially equal to 0.
Perform this operation until @ints becomes empty:

If there exists more than one number in @ints, pick the first element and last element in @ints respectively and add the value of their concatenation to the concatenation value of @ints, then delete the first and last element from @ints.

If one element exists, add its value to the concatenation value of @ints, then delete it.

Input: @ints = (6, 12, 25, 1)
Output: 1286

1st operation: concatenation of 6 and 1 is 61
2nd operation: concatenation of 12 and 25 is 1225

Concatenation Value => 61 + 1225 => 1286

Input: @ints = (10, 7, 31, 5, 2, 2)
Output: 489

1st operation: concatenation of 10 and 2 is 102
2nd operation: concatenation of 7 and 2 is 72
3rd operation: concatenation of 31 and 5 is 315

Concatenation Value => 102 + 72 + 315 => 489

Input: @ints = (1, 2, 10)
Output: 112

1st operation: concatenation of 1 and 10 is 110
2nd operation: only element left is 2

Concatenation Value => 110 + 2 => 112

sub concatenationValue(@ints) {
  return 0        if @ints.elems == 0; # no elements
  return @ints[0] if @ints.elems == 1; # one element

  my $first = @ints.shift; # first element
  my $last  = @ints.pop;   # last element
  my $concat = "$first$last".Int; # concatenate and convert

  return $concat + concatenationValue(@ints);
}

sub concatenationValue(@ints) {
  return 0        if @ints == 0; # no elements
  return $ints[0] if @ints == 1; # one element

  my $first = shift @ints; # first element
  my $last  = pop @ints;   # last element
  my $concat = "$first$last"+0; # concatenate and convert

  return $concat + concatenationValue(@ints);
}

def concatenationValue(ints):
    if len(ints) == 0: # no elements
        return 0
    if len(ints) == 1: # one element
        return ints[0]

    first = ints.pop(0);  # first element
    last  = ints.pop(-1); # last element
    concat = int(f"{first}{last}") # concatenate and convert

    return concat + concatenationValue(ints)

A lucky number is an element of the matrix such that it is
the minimum element in its row and maximum in its column.

Input: $matrix = [ [ 3,  7,  8],
                   [ 9, 11, 13],
                   [15, 16, 17] ];
Output: 15

15 is the only lucky number since it is the minimum in its row
and the maximum in its column.

Input: $matrix = [ [ 1, 10,  4,  2],
                   [ 9,  3,  8,  7],
                   [15, 16, 17, 12] ];
Output: 12

Input: $matrix = [ [7 ,8],
                   [1 ,2] ];
Output: 7

sub maxCols(@matrix) {
  my @rotated; # rotate cols to rows
  for @matrix -> @row {
    for @row.kv -> $k, $v {
      @rotated[$k].push($v);
    }
  }
  # return the max of the now rows!
  return @rotated.map({ $_.max() });
}

sub luckyNumber(@matrix) {
  my @minRows = @matrix.map({ $_.min() });
  my @maxCols = maxCols(@matrix);
  return ( @minRows (&) @maxCols ) // -1;
}

use Array::Utils qw( intersect );
use List::Util qw( min max );

sub maxCols(@matrix) {
  my @rotated; # rotate cols to rows
  foreach my $row ( @matrix ) {
    foreach my $k ( 0 .. $#{$row} ) {
      my $v = $row->[$k];
      push @{$rotated[$k]}, $v;
    }
  }
  # return the max of the now rows!
  return map { max( @$_ ) } @rotated;
}

sub luckyNumber(@matrix) {
  my @minRows = map { min( @$_ ) } @matrix;
  my @maxCols = maxCols(@matrix);
  # intersect() returns an array, so get the first element
  return (intersect( @minRows, @maxCols ))[0] // -1;

def maxCols(matrix):
    # initialize rotated with empty row for each column
    rotated = [ [] for col in matrix[0] ]
    for row in matrix:
        for k, v in enumerate(row):
            rotated[k].append(v)
    # return the max of the now rows!
    return [ max(row) for row in rotated ]

def luckyNumber(matrix):
    mRows = [ min(row) for row in matrix ]
    mCols = maxCols(matrix)
    intersection = list( set(mRows) & set(mCols) )
    if intersection:
        return intersection[0]
    else:
        return -1

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

i=0: 0 mod 10 = 0 == $ints[0].
i=1: 1 mod 10 = 1 == $ints[1].
i=2: 2 mod 10 = 2 == $ints[2].
All indices have i mod 10 == $ints[i], so we return the smallest index 0.

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

i=0: 0 mod 10 = 0 != $ints[0].
i=1: 1 mod 10 = 1 != $ints[1].
i=2: 2 mod 10 = 2 == $ints[2].
i=3: 3 mod 10 = 3 != $ints[3].
2 is the only index which has i mod 10 == $ints[i].

Input: @ints = (1, 2, 3, 4, 5, 6, 7, 8, 9, 0)
Output: -1
Explanation: No index satisfies i mod 10 == $ints[i].

ints[0] = 1
ints[1] = 2
ints[2] = 3
ints[3] = 4
ints[4] = 5
ints[5] = 6
ints[6] = 7
ints[7] = 8
ints[8] = 9
ints[9] = 0

ints[8]  = 9
ints[9]  = 8
ints[10] = 0

sub smallestIndex(@ints) {
  for 0 .. @ints.end -> $i {
    return $i if ($i mod 10) == @ints[$i];
  }
  return -1;
}

sub smallestIndex(@ints) {
  foreach my $i ( 0 .. $#ints ) {
    return $i if ($i % 10) == $ints[$i];
  }
  return -1;
}

def smallestIndex(ints):
    for i in range(len(ints)):
        if (i % 10) == ints[i]:
            return i
    return -1

a) The numeric representation of the string in base 10 if it is made up of digits only.
b) otherwise the length of the string

Input: @alphanumstr = ("perl", "2", "000", "python", "r4ku")
Output: 6

"perl" consists of letters only so the value is 4.
"2" is digits only so the value is 2.
"000" is digits only so the value is 0.
"python" consists of letters so the value is 6.
"r4ku" consists of letters and digits so the value is 4.

Input: @alphanumstr = ("001", "1", "000", "0001")
Output: 1

sub alphanumValue($str) {
  if ($str ~~ /^\d+$/) {
    return Int($str);
  }
  return $str.chars;
}

sub maxAlphanumValue(@alphanumstr) {
  my @values = @alphanumstr.map({ alphanumValue($_) });
  return @values.max;
}

use List::Util qw( max );

sub alphanumValue($str) {
  if ($str =~ /^\d+$/) {
    return $str + 0;
  }
  return length($str);
}

sub maxAlphanumValue(@alphanumstr) {
  my @values = map { alphanumValue($_) } @alphanumstr;
  return max(@values);
}

import re

is_numeric = re.compile('^\d+$')

def alphanumValue(strval):
    if (is_numeric.match(strval)):
        return int(strval)
    return len(strval)

def maxAlphanumValue(alphanumstr):
    values = [ alphanumValue(x) for x in alphanumstr ]
    return max(values)