Input: @arr1 = ("ab", "c")
       @arr2 = ("a", "bc")
Output: true

Using @arr1, word1 => "ab" . "c" => "abc"
Using @arr2, word2 => "a" . "bc" => "abc"

Input: @arr1 = ("ab", "c")
       @arr2 = ("ac", "b")
Output: false

Using @arr1, word1 => "ab" . "c" => "abc"
Using @arr2, word2 => "ac" . "b" => "acb"

Input: @arr1 = ("ab", "cd", "e")
       @arr2 = ("abcde")
Output: true

Using @arr1, word1 => "ab" . "cd" . "e" => "abcde"
Using @arr2, word2 => "abcde"

sub sameString(@arr1, @arr2) {
  my $words = "";
  my $word1 = [~] @arr1;
  $words ~= "\n" ~ 'Using @arr1, word1 => "'
         ~ @arr1.join('" . "')
         ~ '" => "' ~ $word1 ~ '"';
  my $word2 = [~] @arr2;
  $words ~= "\n" ~ 'Using @arr2, word2 => "'
         ~ @arr2.join("' . '")
         ~  '" => "' ~ $word2 ~ '"';
  my $same = $word1 eq $word2;
  return($same, $words);
}

sub concatString($num, @arr) {
  my $word = [~] @arr;
  my $words = "\nUsing \@arr$num, word$num => \""
            ~ @arr.join('" . "')
            ~ '" => "' ~ $word ~ '"';
  return ($word, $words);
}

sub sameString(@arr1, @arr2) {
  my ($word1, $words1) = concatString(1, @arr1);
  my ($word2, $words2) = concatString(2, @arr2);
  return($word1 eq $word2, $words1 ~ $words2);
}

use List::Util qw( reduce );

sub concatString {
  my($num, $arr) = @_;
  my $word = reduce { $a . $b } @$arr;
  my $words = "\nUsing \@arr$num, word$num => \""
            . join('" . "', @$arr)
            . '" => "' . $word . '"';
  return ($word, $words);
}

sub sameString {
  my ($arr1, $arr2) = @_;
  my ($word1, $words1) = concatString(1, $arr1);
  my ($word2, $words2) = concatString(2, $arr2);
  return($word1 eq $word2, $words1 . $words2);
}

from functools import reduce

def concatString(num, arr):
    word = reduce(lambda a, b: a + b, arr)
    words = (
      f'\nUsing @arr{num}, word{num} => "' +
      "' . '".join(arr) +
      f'" => "{word}"'
    )
    return word, words

def sameString(arr1, arr2):
    word1, words1 = concatString(1, arr1)
    word2, words2 = concatString(2, arr2)
    return(word1 == word2, words1 + words2)

Input: @str = ("ad", "bd", "aaab", "baa", "badab")
       $allowed = "ab"
Output: 2

Strings "aaab" and "baa" are consistent since they only contain characters 'a' and 'b'.

Input: @str = ("a", "b", "c", "ab", "ac", "bc", "abc")
       $allowed = "abc"
Output: 7

Input: @str = ("cc", "acd", "b", "ba", "bac", "bad", "ac", "d")
       $allowed = "cad"
Output: 4

Strings "cc", "acd", "ac", and "d" are consistent.

sub consistentCount($allowed, @str) {
  my $regex = '^ <[' ~ $allowed ~ ']>+ $';
  my $count = 0;
  for @str -> $s {
    $count++ if $s.match: / <$regex> /;
  }
  return $count;
}

sub consistentCount {
  my($allowed, $str) = @_;
  my $regex = '^[' . $allowed . ']+$';
  my $count = 0;
  foreach my $s ( @$str ) {
    $count++ if $s =~ /$regex/;
  }
  return $count;
}

import re

def consistentCount(allowed, str):
    regex = re.compile('^[' + allowed + ']+$')
    count = 0
    for s in str:
        if regex.match(s):
            count += 1
    return count

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

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

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

for (my $i = 0; $i <= $#int; $i++) {
  # sum the 0th through $i-th numbers in @int
  my $sum = $int[0];
  for (my $j = 1; $j <= $i; $j++) {
    $sum += $int[$j];
  }
  $sums[$i] = $sum;
}

use List::Util qw(sum);
for (my $i = 0; $i <= $#int; $i++) {
  # sum the 0th through $i-th numbers in @int
  $sums[$i] = sum @int[0 .. $i];
}

sub runningSum {
  my @int = @_;
  my @sums;
  my $running_sum = 0;
  foreach my $num ( @int ) {
    # add the next number to the sum of numbers before it
    $running_sum += $num;
    # add the current running sum to the output array
    push @sums, $running_sum;
  }
  return @sums;
}

sub runningSum(*@int) {
  my @sums;
  my $running_sum = 0;
  for @int -> $num {
    # add the next number to the sum of numbers before it
    $running_sum += $num;
    # add the current running sum to the output array
    @sums.push( $running_sum );
  }
  return @sums;
}

def runningSum(int):
    sums = []
    running_sum = 0
    for num in int:
        # add the next number to the sum of numbers before it
        running_sum += num
        # add the current running sum to the output array
        sums.append( running_sum )
    return sums

Input: @int = (15, 99, 1, 34)
Output: (1, 15, 34, 99)

15 => 1 x 5 => 5 (1 step)
99 => 9 x 9 => 81 => 8 x 1 => 8 (2 steps)
1  => 0 step
34 => 3 x 4 => 12 => 1 x 2 => 2 (2 steps)

Input: @int = (50, 25, 33, 22)
Output: (22, 33, 50, 25)

50 => 5 x 0 => 0 (1 step)
25 => 2 x 5 => 10 => 1 x 0 => 0 (2 steps)
33 => 3 x 3 => 9 (1 step)
22 => 2 x 2 => 4 (1 step)

my $step_count = 0;
while ( length($num) > 1 ) {
  # split $num into its individual digits
  my @digits = split //, $num;
  # generate a new number by multiplying all the digits
  $num = product @digits;
  # add to our count of steps
  $step_count++;
}

my %step_count;
foreach my $num ( @int ) {
  $step_count{$num} = 0;
  my $num_copy = $num; # copy the num so we can modify it
  while ( length($num_copy) > 1 ) {
    # split $num_copy into its individual digits
    my @digits = split //, $num_copy;

    # generate a new number by multiplying all the digits
    $num_copy = product @digits;

    # add to our count of steps
    $step_count{$num}++;
  }
}

my @sorted = sort {
  # sort by step count
  $step_count{$a} <=> $step_count{$b}
  ||
  # then sort numerically
  $a <=> $b
} @int;

use List::Util qw( product );

sub persistenceSort {
  my @int = @_;
  my %step_count;
  my $steps;
  # first, calculates the steps for each number
  foreach my $num ( @int ) {
    $step_count{$num} = 0;

    $steps .= "\n$num"; # our starting number

    my $num_copy = $num; # copy the num so we can modify it

    while ( length($num_copy) > 1 ) {
      # split $num_copy into its individual digits
      my @digits = split //, $num_copy;

      # generate a new number by multiplying all the digits
      $num_copy = product @digits;

      # show the multiplication in the steps for this num
      $steps .= ' => ' . join(' x ', @digits);
      $steps .= " => $num_copy";

      # add to our count of steps
      $step_count{$num}++;
    }

    # put the step count in the steps for this num
    $steps .=
      sprintf " (%d step%s)", $step_count{$num},
              $step_count{$num} == 1 ? '' : 's';
  }

  # now, sort by steps/numeric value
  my @sorted = sort {
    # sort by step count
    $step_count{$a} <=> $step_count{$b}
    ||
    # then sort numerically
    $a <=> $b
  } @int;

  return \@sorted, $steps;
}

sub persistenceSort(*@int) {
  my %step_count;
  my $steps;
  # first, calculates the steps for each number
  for @int -> $num {
    %step_count{$num} = 0;

    $steps ~= "\n$num"; # our starting number

    my $num_copy = $num; # copy the num so we can modify it

    while ( $num_copy.Str.chars > 1 ) {
      # split $num_copy into its individual digits
      my @digits = $num_copy.split('', :skip-empty);

      # generate a new number by multiplying all the digits
      $num_copy = [*] @digits;

      # show the multiplication in the steps for this num
      $steps ~= ' => ' ~ @digits.join(' x ');
      $steps ~= " => $num_copy";

      # add to our count of steps
      %step_count{$num}++;
    }

    # put the step count in the steps for this num
    $steps ~=
      sprintf " (%d step%s)", %step_count{$num},
              %step_count{$num} == 1 ?? '' !! 's';
  }

  # now, sort by steps/numeric value
  my @sorted = @int.sort({
    # sort by step count
    %step_count{$^a} <=> %step_count{$^b}
    ||
    # then sort numerically
    $^a <=> $^b
  });

  return @sorted, $steps;
}

sub solution {
  my @int = @_;
  say 'Input: @int = (' ~ @int.join(', ') ~ ')';
  # if we attempt to capture the returned array in
  # @sorted, the array becomes the first ELEMENT in
  # @sorted (and the $steps Str becomes the second
  # element) so we capture it in $sorted
  my ($sorted, $steps) = persistenceSort(@int);
  say 'Output: (' ~ $sorted.join(', ') ~ ')';
  say $steps;
}

from functools import cmp_to_key, reduce

def persistenceSort(int_list):
    step_count = {}
    steps = ""

    # first, calculates the steps for each number
    for num in int_list:
        step_count[num] = 0

        steps += f"\n{num}" # our starting number

        num_copy = str(num) # copy the num so we can modify it

        while len(num_copy) > 1:
            # split num_copy into its individual digits
            digits = list(num_copy)

            # generate a new number by multiplying
            # all the digits
            num_copy = str(
                reduce(
                    lambda a, b: int(a) * int(b),
                    digits
                )
            )

            # show the multiplication in the steps for this num
            steps += ' => ' + ' x '.join(digits)
            steps += ' => ' + num_copy

            # add to our count of steps
            step_count[num] += 1

        # put the step count in the steps for this num
        step_word = 'step' if step_count[num] == 1 else 'steps'
        steps += f" ({step_count[num]} {step_word})"

    # now, sort by steps/numeric value
    sorted_list = sorted(int_list,
                         key=lambda x: (step_count[x], x))

    return sorted_list, steps

Input: Year = 2024, Month = 4, Weekday of month = 3, day of week = 2
Output: 16

The 3rd Tue of Apr 2024 is the 16th

Input: Year = 2025, Month = 10, Weekday of month = 2, day of week = 4
Output: 9

The 2nd Thu of Oct 2025 is the 9th

Input: Year = 2026, Month = 8, Weekday of month = 5, day of week = 3
Output: 0

There isn't a 5th Wed in Aug 2026

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

sub seizeTheDay {
  my %params = @_;
  # build the first day of the specified month
  my $start = $params{year} . '-' . $params{month} . '-01';
  # create an object for Jan 01 of the given year
  my $t = Time::Piece->strptime($start, "%Y-%m-%d")
                     ->truncate(to => 'day');
  # in Time::Piece->wday, 1 = Sun, 2 = Mon, 3 = Tue, but our
  # input is 0 = Sun, 1 = Mon, 2 = Tue, so adjust our input
  $params{day_of_week}++;

  # find the FIRST instance of the desired day of the week
  while ( $t->wday != $params{day_of_week} ) {
    $t += ONE_DAY; # add 1 day
  }

  # take note of some values that won't change
  # for our description
  my $year  = $t->year;
  my $month = $t->month;
  my $dow   = $t->wdayname;
  my $count = 1;

  my $ord_weekday_of_month = 
    noun($params{weekday_of_month})->ordinal(0);

  # now roll forward through the month until the desired
  # weekday of the month
  while (
    # we're still in the desired month
    $t->mon == $params{month}
    &&
    # we haven't reached the desired weekday of the month
    $count != $params{weekday_of_month}
  ) {
    # add a week to the date
    $t += ONE_DAY * 7;
    # add to the weekday of the month count
    $count++;
  }

  # if we rolled out of the month, return an error condition
  if ($t->mon != $params{month}) {
    return 0, "There isn't a $ord_weekday_of_month $dow "
            . "in $month $year";
  }
  else {
    # take note of what the day of the month is
    my $day = $t->day_of_month;
    my $ord_day_of_month = noun($day)->ordinal(0);
    return $day, "The $ord_weekday_of_month $dow "
               . "of $month $year is the $ord_day_of_month";
  }
}

use Date::Names;
use Lingua::EN::Numbers; # for ordinal-digit()

sub seizeTheDay(
  Int :$year,
  Int :$month,
  Int :$weekday_of_month,
  Int :$day_of_week
) {
  # object for the first day of the specified month
  my $t = Date.new($year, $month, 1);

  # in Date.day-of-week, 0 = Sun, 1 = Mon, 2 = Tue,
  # which matches our input, so no adjustment is needed

  # find the FIRST instance of the desired day of the week
  while ( $t.day-of-week != $day_of_week ) {
    $t++; # add 1 day
  }

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

  # take note of some values that won't change
  # for our description
  my $month_name = $dn.mon($t.month);
  my $dow        = $dn.dow($t.day-of-week);
  my $count      = 1;

  my $ord_weekday_of_month = ordinal-digit($weekday_of_month);

  # now roll forward through the month until the desired
  # weekday of the month
  while (
    # we're still in the desired month
    $t.month == $month
    &&
    # we haven't reached the desired weekday of the month
    $count < $weekday_of_month
  ) {
    # add a week to the date
    $t += 7;
    # add to the weekday of the month count
    $count++;
  }

  # if we rolled out of the month, return an error condition
  if ($t.month != $month) {
    return 0, "There isn't a $ord_weekday_of_month $dow "
            ~ "in $month $year";
  }
  else {
    # take note of what the day of the month is
    my $day = $t.day;
    my $ord_day_of_month = ordinal-digit($day);
    return $day, "The $ord_weekday_of_month $dow "
               ~ "of $month $year is the $ord_day_of_month";
  }
}

from datetime  import date, timedelta
from num2words import num2words

def seizeTheDay(year, month, weekday_of_month, day_of_week):
    """
    Function to determine, given a year, month, weekday of
    month and day of week, whether such a date exists and,
    if so, what day of the month it is.
    """
    # object for the first day of the specified month
    t = date(year, month, 1)

    # datetime.date.isoweekday returns 1 = Mon, 2 = Tue, etc.,
    # which matches our input, so no adjustment is needed

    # find the FIRST instance of the desired day of the week
    while ( t.isoweekday() != day_of_week ):
        t += timedelta(days = 1) # add 1 day

    # take note of some values that won't change
    # for our description
    month_name = t.strftime('%b')
    dow        = t.strftime('%a')
    count      = 1
  
    ord_weekday_of_month = num2words(
        weekday_of_month, to="ordinal_num"
    )

    # now roll forward through the month until the desired
    # weekday of the month
    while (
      # we're still in the desired month
      t.month == month
      and
      # we haven't reached the desired weekday of the month
      count < weekday_of_month
    ):
        # add a week to the date
        t += timedelta(days = 7)
        # add to the weekday of the month count
        count += 1

    # if we rolled out of the month, return an error condition
    if (t.month != month):
        return(
          0,
          f"There isn't a {ord_weekday_of_month} {dow} " +
          f"in {month_name} {year}"
        )
    else:
        # take note of what the day of the month is
        day = t.day
        ord_day_of_month = num2words(day, to="ordinal_num")
        return(
            day,
            f"The {ord_weekday_of_month} {dow} " +
            f"of {month_name} {year} is the {ord_day_of_month}"
        )

import java.util.Calendar;  
import java.text.SimpleDateFormat;

class seizeTheDay {
  public int    day;
  public String description;

  public seizeTheDay(
    int year,
    int month,
    int weekday_of_month,
    int day_of_week
  ) {
    // object for the first day of the specified month
    Calendar t = Calendar.getInstance();
    t.set(year, month - 1, 1);

    // find the FIRST instance of the desired day of the week
    while (t.get(Calendar.DAY_OF_WEEK) != day_of_week+1) {
      t.add(Calendar.DATE, 1);
    }

    String month_str =
      new SimpleDateFormat("MMM").format(t.getTime());
    String dow_str =
      new SimpleDateFormat("EEE").format(t.getTime());
    int count = 1;

    // now roll forward through the month until the desired
    // weekday of the month
    while (
      // we're still in the desired month
      t.get(Calendar.MONTH) == month - 1
      && 
      // we haven't reached the desired weekday of the month
      count < weekday_of_month
    ) {
      t.add(Calendar.DATE, 7);
      count++;
    }
    if (t.get(Calendar.MONTH) != month - 1) {
      this.day = 0;
      this.description = String.format(
        "There isn't a %s %s in %s %d",
        this.ord_suffix(weekday_of_month),
        dow_str,
        month_str,
        year
      );
    }
    else {
      this.day = t.get(Calendar.DATE);
      this.description = String.format(
        "The %s %s of %s %d is the %s",
        this.ord_suffix(weekday_of_month),
        dow_str,
        month_str,
        year,
        this.ord_suffix(this.day)
      );
    }
  }

  private String ord_suffix(int num) {
    // quick function to add an ordinal suffix
    // to a number
    if (num == 11 || num == 12 | num == 13) {
      return num + "th";
    }
    else {
      switch (num % 10) {
        case 1:  return num + "st";
        case 2:  return num + "nd";
        case 3:  return num + "rd";
        default: return num + "th";
      }
    }
  }
}

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

One possible permutation: (2, 5, 1, 3, 3, 1, 1) which returns 4 greatness as below:
nums[0] < perm[0]
nums[1] < perm[1]
nums[3] < perm[3]
nums[4] < perm[4]

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

One possible permutation: (2, 3, 4, 1) which returns 3 greatness as below:
nums[0] < perm[0]
nums[1] < perm[1]
nums[2] < perm[2]

sub greatness {
  # determine the "greatness" of a permutation
  # relative to the original array; accepts two
  # array references to do the comparison
  my ($nums, $perm) = @_;
  my $greatness = 0;
  foreach my $i ( 0 .. $#$nums ) {
    $greatness++ if $nums->[$i] < $perm->[$i];
  }
  return $greatness;
}

sub removeNumFromCount {
  # since we do this in two locations below,
  # make this a subroutine we can call;
  # accept a reference to the count hash and
  # the number being removed
  my ($num_count, $num) = @_;

  # decrement the count of that number available
  $num_count->{$num}--;

  # if there are no more of that number, remove it
  # from the %num_count hash
  delete $num_count->{$num}
    if $num_count->{$num} == 0;
}

sub greatestPermutation {
  my @nums = @_;
  # first, count up how many of each num we have
  my %num_count;
  foreach my $num ( @nums ) {
    $num_count{$num}++;
  }

  # now, build a permutation that maximizes "greatness"
  my @perm;
  NUM: foreach my $num ( @nums ) {
    my @available = sort keys %num_count;
    my $smallest_available = $available[0];
    foreach my $avail ( @available ) {
      if ( $avail > $num ) {
        # push the available number onto the permutation
        push @perm, $avail;

        removeNumFromCount(\%num_count, $avail);

        # go to the next input number
        next NUM;
      }
    }
    # we didn't find an available number larger than $num,
    # so let's put the smallest available number on @perm
    push @perm, $smallest_available;

    removeNumFromCount(\%num_count, $smallest_available);
  }

  return @perm;
}

sub removeNumFromCount {
  # since we do this in two locations below,
  # make this a subroutine we can call;
  # accept references to the count hash and
  # the list of available numbers, and the
  # number being removed
  my ($num_count, $available, $num) = @_;

  # decrement the count of that number available
  $num_count->{$num}--;

  # if there are no more of that number, remove it
  # from the %num_count hash and the @available array
  if ( $num_count->{$num} == 0 ) {
    # remove key from the hash
    delete $num_count->{$num};
    # filter array to not include $num
    @$available = grep { $_ != $num } @$available;
  }
}

sub greatestPermutation {
  my @nums = @_;
  # first, count up how many of each num we have
  my %num_count;
  foreach my $num ( @nums ) {
    $num_count{$num}++;
  }

  # now, build a permutation that maximizes "greatness"
  my @perm;
  my @available = sort keys %num_count; # do the sort once
  NUM: foreach my $num ( @nums ) {
    my $smallest_available = $available[0];
    foreach my $avail ( @available ) {
      if ( $avail > $num ) {
        # push the available number onto the permutation
        push @perm, $avail;

        removeNumFromCount(
          \%num_count, \@available, $avail
        );

        # go to the next input number
        next NUM;
      }
    }
    # we didn't find an available number larger than $num,
    # so let's put the smallest available number on @perm
    push @perm, $smallest_available;

    removeNumFromCount(
      \%num_count, \@available, $smallest_available
    );
  }

  return @perm;
}

sub greatness(@nums, @perm) {
  # determine the "greatness" of a permutation
  # relative to the original array; accepts two
  # arrays to do the comparison
  my $greatness = 0;
  for 0 .. @nums.elems - 1 -> $i {
    $greatness++ if @nums[$i] < @perm[$i];
  }
  return $greatness;
}

sub removeNumFromCount(%num_count, @available, $num) {
  # since we do this in two locations below,
  # make this a subroutine we can call; accept
  # the count hash and the list of available
  # numbers, and the number being removed

  # decrement the count of that number available
  %num_count{$num}--;

  # if there are no more of that number, remove it
  # from the %num_count hash and the @available array
  if ( %num_count{$num} == 0 ) {
    # remove key from the hash
    %num_count{$num}:delete;
    # filter array to not include $num
    @available = @available.grep( { $_ != $num } );
  }
}

sub greatestPermutation(@nums) {
  # first, count up how many of each num we have
  my %num_count;
  for @nums -> $num {
    %num_count{$num}++;
  }

  # now, build a permutation that maximizes "greatness"
  my @perm;
  my @available = %num_count.keys().sort(); # do the sort once
  NUM: for @nums -> $num {
    my $smallest_available = @available[0];
    for @available -> $avail {
      if ( $avail > $num ) {
        # push the available number onto the permutation
        @perm.push($avail);

        removeNumFromCount(
          %num_count, @available, $avail
        );

        # go to the next input number
        next NUM;
      }
    }
    # we didn't find an available number larger than $num,
    # so let's put the smallest available number on @perm
    push @perm, $smallest_available;

    removeNumFromCount(
      %num_count, @available, $smallest_available
    );
  }

  return @perm;
}

def greatness(nums, perm):
    """
    Function to enumerate the greatness of
    the list perm relative to the list nums
    """
    greatness_num = 0
    for i in range(0, len(nums) - 1):
        if nums[i] < perm[i]:
            greatness_num += 1
    return greatness_num

def greatestPermutation(nums):
    """
    Function to generate a permutation of the list nums
    which has the largest relative "greatness" to nums
    """

    # first, count up how many of each num we have
    num_count = {}
    for num in nums:
        num_count[num] = num_count.get(num, 0) + 1

    # now, build a permutation that maximizes "greatness"
    perm = []
    available = sorted(num_count.keys()) # only sort once
    for num in nums:
        # default to the smallest available number
        num_to_add = available[0]

        # but now look for the smallest available number
        # that's GREATER than the current number
        for avail in available:
            if avail > num:
                num_to_add = avail
                break

        # add num_to_add to the permutation
        perm.append(num_to_add)

        # decrement its count in num_count
        num_count[num_to_add] -= 1

        # if there are no more, remove it from available
        if num_count[num_to_add] == 0:
            available = [
                x for x in available if x != num_to_add
            ]

    return perm

  public static int greatness(int[] nums, int[] perm) {
    // determine the "greatness" of a permutation
    // relative to the original array; accepts two
    // arrays to do the comparison
    int greatness_num = 0;
    for (int i = 0; i < nums.length; i++) {
      if (nums[i] < perm[i]) {
        greatness_num++;
      }
    }
    return greatness_num;
  }

  public static int[] greatestPermutation(int[] nums) {
    // first, count up how many of each num we have
    HashMap<Integer, Integer> num_count =
      new HashMap<Integer, Integer>();
    for (int i = 0; i < nums.length; i++) {
      num_count.put(
        nums[i],
        num_count.getOrDefault(nums[i], 0) + 1
      );
    }

    // make a list of the available numbers
    // to put in a permutation
    List<Integer> available =
      new ArrayList<>(num_count.keySet());
    Collections.sort(available);

    // now, build a permutation that maximizes "greatness"
    List<Integer> perm = new ArrayList<>();
    for (Integer num : nums) {
      // default to the smallest available number
      int num_to_add = available.get(0);
      for (int i = 0; i < available.size(); i++) {
        int this_num = available.get(i);
        if (num < this_num) {
          num_to_add = this_num;
          break;
        }
      }
      perm.add(num_to_add);

      // decrement the count of that number available
      num_count.put(
        num_to_add,
        num_count.get(num_to_add) - 1
      );
  
      // if there are no more of that number, remove it
      // from available list
      if ( num_count.get(num_to_add) == 0 ) {
        // filter array to not include $num
        int size = available.size();
        for (int i = 1; i < size; i++) {
          int this_num = available.get(i);
          if (num_to_add == this_num) {
            available.remove(i);
            break;
          }
        }
      }
    }

    // because we built the permutations in a List,
    // convert the list to an int array for return
    int[] perm_return = new int[perm.size()];
    for (int i = 0; i < perm.size(); i++) {
      perm_return[i] = perm.get(i);
    }
    return perm_return;
  }

Input: @bills = (5, 5, 5, 10, 20)
Output: true

From the first 3 customers, we collect three $5 bills in order.
From the fourth customer, we collect a $10 bill and give back a $5.
From the fifth customer, we give a $10 bill and a $5 bill.
Since all customers got correct change, we output true.

Input: @bills = (5, 5, 10, 10, 20)
Output: false

From the first two customers in order, we collect two $5 bills.
For the next two customers in order, we collect a $10 bill and give back a $5 bill.
For the last customer, we can not give the change of $15 back because we only have two $10 bills.
Since not every customer received the correct change, the answer is false.

Input: @bills = (5, 5, 5, 20)
Output: true

sub isExactChangePossible {
  my @bills = @_;
  my %till; # we keep the bills in a "till"
  BILLS: foreach my $collected ( @bills ) {
    # put the bill we collected in the "till"
    $till{$collected}++;

    # calculate the required change
    my $change_required = $collected - 5;

    # if we don't need to make change,
    # skip to the next bill collected!
    next BILLS unless $change_required;

    # loop through the bills we have on hand
    # in descending size (try to make change
    # with the largest bills possible)
    foreach my $bill ( reverse sort { $a <=> $b } keys %till ) {

      # as long as we have more of this bill and
      # using it would not yield TOO MUCH change
      while ($till{$bill} > 0 && $change_required - $bill >= 0) {
        # deduct the amount from the required change
        $change_required -= $bill;

        # remove the bill from the till
        $till{$bill}--;
      }

      # move on if we managed to make exact change!
      next BILLS unless $change_required;
    }

    # if we weren't able to make change, fail
    return 0 if $change_required;
  }

  # we successfully made change for all transactions!
  return 1;
}

sub isExactChangePossible(*@bills where ($_.all ~~ Int)) {
  my %till; # we keep the bills in a "till"
  BILLS: for @bills -> $collected {
    # put the bill we collected in the "till"
    %till{$collected}++;

    # calculate the required change
    my $change_required = $collected - 5;

    # if we don't need to make change,
    # skip to the next bill collected!
    next BILLS unless $change_required;

    # loop through the bills we have on hand
    for %till.keys().sort({ .Int }).reverse() -> $bill {
      # as long as we have more of this bill and
      # using it would not yield TOO MUCH change
      while (%till{$bill} > 0 && $change_required - $bill >= 0) {
        # deduct the amount from the required change
        $change_required -= $bill;

        # remove the bill from the till
        %till{$bill}--;
      }

      # move on if we managed to make exact change!
      next BILLS unless $change_required;
    }

    # if we weren't able to make change, fail
    return 0 if $change_required;
  }
  
  # we successfully made change for all transactions!
  return 1;
}

def isExactChangePossible(bills):
    till = {}; # we keep the bills in a "till"
    for collected in bills:
        # put the bill we collected in the "till"
        #
        # using .get(collected, 0) yields the value in the
        # dict for the key 'collected' if it exists, or the
        # specified default (in this case, 0) if it doesn't
        till[collected] = till.get(collected, 0) + 1

        # calculate the required change
        change_required = collected - 5

        # loop through the bills we have on hand
        for bill in sorted(till, reverse=True):
            # as long as we have more of this bill and
            # using it would not yield TOO MUCH change
            while till[bill] > 0 and change_required - bill >= 0:
                # deduct the amount from the required change
                change_required -= bill

                # remove the bill from the till
                till[bill] -= 1

        # if we weren't able to make change, fail
        if change_required:
            return 0
  
    # we successfully made change for all transactions!
    return 1

  public static boolean isExactChangePossible(int[] bills) {
    // we keep the bills in a "till"
    HashMap<Integer, Integer> till =
      new HashMap<Integer, Integer>();

    for (int collected : bills) {
      // put the bill we collected in the "till"
      //
      // using .getOrDefault(collected, 0) yields the value
      // in the map for the key 'collected' if it exists, or
      // the specified default (in this case, 0) if it doesn't
      till.put(
        collected,
        till.getOrDefault(collected, 0) + 1
      );

      // calculate the required change
      int change_required = collected - 5;

      // loop through the bills we have on hand, making sure
      // we go from largest to smallest bill
      List<Integer> keys = new ArrayList<>(till.keySet());
      Collections.sort(keys, Collections.reverseOrder());
      for (Integer bill : keys) {
        // as long as we have more of this bill and
        // using it would not yield TOO MUCH change
        while (till.get(bill) > 0 &&
               change_required - bill >= 0) {
          // deduct the amount from the required change
          change_required -= bill;

          // remove the bill from the till
          till.put(bill, till.get(bill) - 1);
        }
      }
      // if we weren't able to make change, fail
      if (change_required > 0) {
          return false;
      }
    }
    return true;
  }

Input: @ints = (4,6,3,8,15,0,13,18,7,16,14,19,17,5,11,1,12,2,9,10)
Output: 3

To determine the 1st loop, start at index 0, the number at that index is 4, proceed to index 4, the number at that index is 15, proceed to index 15 and so on until you're back at index 0.

Loops are as below:
[4 15 1 6 13 5 0]
[3 8 7 18 9 16 12 17 2]
[14 11 19 10]

Input: @ints = (0,1,13,7,6,8,10,11,2,14,16,4,12,9,17,5,3,18,15,19)
Output: 6

Loops are as below:
[0]
[1]
[13 9 14 17 18 15 5 8 2]
[7 11 4 6 10 16 3]
[12]
[19]

Input: @ints = (9,8,3,11,5,7,13,19,12,4,14,10,18,2,16,1,0,15,6,17)
Output: 1

Loop is as below:
[9 4 5 7 19 17 15 1 8 12 18 6 13 2 3 11 10 14 16 0]

sub loopExistsAt {
  my %params = @_;
  my $ints  = $params{ints};
  my $start = $params{start};
  my $seen  = $params{seen};

  # bail early if we're in a loop we've seen before
  return if exists $seen->{$start};

  my @loop;
  my $i = $start;
  for (;;) {
    # keep track of the values in the order we visit them
    push @loop, $ints->[$i];

    # track where we've already been
    # to avoid double-counting loops
    $seen->{$i} = 1;

    # get the next index
    $i = $ints->[$i];

    # make sure the index is in bounds
    last unless $i >= 0 && $i <= $#{$ints};

    # make sure we haven't seen the index before
    last if exists $seen->{$i};
  }

  # if the last element points back to
  # the start, it's a loop!
  if ($loop[-1] == $start) {
    return @loop;
  }
  # otherwise, return an empty list
  return;
}

sub identifyLoops {
  my @ints = @_;
  my @loops;
  my %seen; # keep track of indices we've seen
            # to avoid duplicating loops
  foreach my $start ( 0 .. $#ints ) {
    my @loop = loopExistsAt(
      start => $start,
      ints  => \@ints,
      seen  => \%seen
    );
    if (@loop) {
      push @loops, \@loop;
    }
  }
  return @loops;
}

sub loopExistsAt(:@ints, :$start, :%seen) {
  # bail early if we're in a loop we've seen before
  return [] if %seen{$start}:exists;

  my @loop;
  my $i = $start;
  loop (;;) {
    # keep track of the values in the order we visit them
    push @loop, @ints[$i];

    # track where we've already been
    # to avoid double-counting loops
    %seen{$i} = 1;

    # get the next index
    $i = @ints[$i];

    # make sure the index is in bounds
    last unless $i >= 0 && $i < @ints.elems;

    # make sure we haven't seen the index before
    last if %seen{$i}:exists;
  }

  # if the last element points back to
  # the start, it's a loop!
  if (@loop[*-1] == $start) {
    return @loop;
  }
  # otherwise, return an empty list
  return [];
}

sub identifyLoops {
  my @ints = @_;
  my @loops;
  my %seen; # keep track of indices we've seen
            # to avoid duplicating loops
  for 0 .. $@ints.elems - 1 -> $start {
    my @loop = loopExistsAt(
      start => $start,
      ints  => @ints,
      seen  => %seen
    );
    if (@loop) { 
      push @loops, @loop;
    }
  }
  return @loops;
}

def loopExistsAt(ints=[], seen={}, start=0):
    # bail early if we're in a loop we've seen before
    if start in seen:
        return []

    loop = [] # initialize an empty list to start
    i = start # initialize i to starting point
    while True:
        # keep track of the values in the order we visit them
        loop.append(ints[i])

        # track where we've already been
        # to avoid double-counting loops
        seen[i] = 1

        # get the next index
        i = ints[i]

        # make sure the index is in bounds
        if i < 0 or i >= len(ints):
            break

        # make sure we haven't seen the index before
        if i in seen:
            break

    # if the last element points back to
    # the start, it's a loop!
    if loop[-1] == start:
        return loop

    # otherwise, return an empty list
    return []

def identifyLoops(ints):
    loops = []
    seen = {}; # keep track of indices we've seen
               # to avoid duplicating loops
    for start in range(0, len(ints)):
        loop = loopExistsAt(
          start = start,
          ints  = ints,
          seen  = seen
        )
        if loop:
            loops.append(loop)
    return loops

import java.util.ArrayList;
import java.util.Arrays;
import java.util.HashMap;
import java.util.stream.Collectors;

public class Ch2 {
  public static ArrayList<Integer> loopExistsAt(
    int start, int[] ints, HashMap<Integer, Integer> seen
  ) {
    // bail early if we're in a loop we've seen before
    if (seen.get(start) != null) {
      // return an empty ArrayList
      return new ArrayList<Integer>();
    }

    // initialize an empty list to start
    ArrayList<Integer> loop = new ArrayList<Integer>();
    // initialize i to starting point
    int i = start;
    while (true) {
      // keep track of the values in the order we visit them
      loop.add(ints[i]);

      // track where we've already been
      // to avoid double-counting loops
      seen.put(i, 1);

      // get the next index
      i = ints[i];

      // make sure the index is in bounds
      if (i < 0 || i >= ints.length) {
        break;
      }

      // make sure we haven't seen the index before
      if (seen.get(i) != null) {
        break;
      }
    }

    // if the last element points back to
    // the start, it's a loop!
    if (loop.get(loop.size() - 1) == start) {
        return loop;
    }

    // otherwise, return an empty ArrayList
    return new ArrayList<Integer>();
  }

  public static ArrayList<ArrayList<Integer>> identifyLoops(int[] ints) {
    ArrayList<ArrayList<Integer>> loops =
      new ArrayList<ArrayList<Integer>>();
    HashMap<Integer, Integer> seen = 
      new HashMap<Integer, Integer>();

    for (int i = 0; i < ints.length; i++) {
      ArrayList<Integer> loop = loopExistsAt(i, ints, seen);
      if (loop.size() > 0) {
        loops.add(loop);
      }
    }
    return loops;
  }

  public static String comma_joined(int[] ints) {
    // we're using it more than once, make it a method
    return Arrays.stream(ints)
                 .mapToObj(String::valueOf)
                 .collect(Collectors.joining(","));
  }

  public static void solution(int[] ints) {
    System.out.println("Input: @ints = (" + comma_joined(ints) +
                       ")");
    ArrayList<ArrayList<Integer>> loops = identifyLoops(ints);
    int count = loops.size();
    System.out.println(String.format("Output: %1$d", count));
    if (count > 0) {
      String loop_noun = (count == 1) ? "Loop" : "Loops";
      String are_verb  = (count == 1) ? "is"   : "are";
      System.out.println("\n" + loop_noun + " " + are_verb +
                         " as below:");

      for (ArrayList<Integer> loop : loops) {
        String as_list = loop.stream()
                             .map(String::valueOf)
                             .collect(Collectors.joining(" "));
        System.out.println("[" + as_list + "]");
      }
    }
  }

  public static void main(String[] args) {
    System.out.println("Example 1:");
    solution(new int[] {4,6,3,8,15,0,13,18,7,16,14,
                        19,17,5,11,1,12,2,9,10});

    System.out.println("\nExample 2:");
    solution(new int[] {0,1,13,7,6,8,10,11,2,14,16,
                        4,12,9,17,5,3,18,15,19});

    System.out.println("\nExample 3:");
    solution(new int[] {9,8,3,11,5,7,13,19,12,4,14,
                        10,18,2,16,1,0,15,6,17});
  }
}

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

Removing ONLY 9 in the given array makes it strictly increasing order.

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

Input: @ints = (2, 2, 3)
Output: true

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

sub isStrictlyIncreasing {
  my @ints = @_;
  # get the first integer from the list
  my $last_int = shift @ints;
  # test to make sure each subsequent int is greater
  foreach my $this_int ( @ints ) {
    return 0 if $this_int <= $last_int;
    $last_int = $this_int;
  }
  return 1;
}

sub isStrictlyIncreasingExceptOne {
  my @ints = @_;

  # the list cannot be strictly increasing unless
  # there are at least two items in it
  return 0 if @ints <= 1;

  # if it's strictly increasing without removing
  # an item, it fails the test
  return 0 if isStrictlyIncreasing(@ints);

  # loop over the list by index
  for (my $i = 1; $i <= $#ints; $i++) {
    if ($ints[$i] <= $ints[$i - 1]) {
      # remove the bigger item from the list
      splice(@ints, $i-1, 1);
      # after removing the element, is 
      # the list strictly increasing?
      return isStrictlyIncreasing(@ints);
    }
  }
}

sub solution {
  my @ints = @_;
  say 'Input: @ints = (' . join(', ', @ints) . ')';
  my $output = isStrictlyIncreasingExceptOne(@ints);
  say 'Output: ' . ($output ? 'true' : 'false');
}
 
say "Example 1:";
solution(0, 2, 9, 4, 6);
 
say "\nExample 2:";
solution(5, 1, 3, 2);
 
say "\nExample 3:";
solution(2, 2, 3);

say "\nExample 4 from James Curtis-Smith:";
solution(1,2,3,4,1,2,3);

sub isStrictlyIncreasingExceptOne {
  my @ints = @_;
  my $count = 0;

  # the index of the first int we're comparing against
  my $last_int = 0;
  LOOP: for (my $this_int = 1;
             $this_int <= $#ints;
             $this_int++) {
    unless ( $ints[$last_int] < $ints[$this_int] ) {
      return 0 if ++$count > 1;

      # if we're comparing something after the first integer,
      # move the comparison back to the previous good integer
      # and then retry the comparison
      if ($last_int > 0) {
        $last_int--;
        redo LOOP;
      }
      # if we were comparing the first two integers, $last_int
      # will become 1 and we'll compare that against $this_int
      # as 2 the next time through the loop
    }
    $last_int = $this_int;
  }
  return $count == 1;
}

#!/usr/bin/env raku
 
use v6;

sub isStrictlyIncreasing(*@ints where ($_.all ~~ Int)) {
  # get the first integer from the list
  my $last_int = shift @ints;
  for @ints -> $this_int {
    return 0 if $this_int <= $last_int;
    $last_int = $this_int;
  }
  return 1;
}

sub isStrictlyIncreasingExceptOne(*@ints where ($_.all ~~ Int)) {
  # the list cannot be strictly increasing unless
  # there are at least two items in it
  return 0 if @ints <= 1;

  # if it's strictly increasing without removing
  # an item, it fails the test
  return 0 if isStrictlyIncreasing(@ints);

  # loop over the list by index
  loop (my $i = 1; $i < @ints.elems; $i++) {
    if (@ints[$i] <= @ints[$i - 1]) {
      # remove the bigger item from the list
      @ints.splice($i-1, 1);
      # after removing the element, is 
      # the list strictly increasing?
      return isStrictlyIncreasing(@ints);
    }
  }
}

sub solution(*@ints where ($_.all ~~ Int)) {
  say 'Input: @ints = (' ~ @ints.join(', ') ~ ')';
  my $output = isStrictlyIncreasingExceptOne(@ints);
  say 'Output: ' ~ ($output ?? 'true' !! 'false');
}
 
say "Example 1:";
solution(0, 2, 9, 4, 6);
 
say "\nExample 2:";
solution(5, 1, 3, 2);
 
say "\nExample 3:";
solution(2, 2, 3);

say "\nExample 4 from James Curtis-Smith:";
solution(1,2,3,4,1,2,3);

#!/usr/bin/env python

def isStrictlyIncreasing(ints):
    intlist = ", ".join([ str(i) for i in ints ])
    # get the first integer from the list
    last_int = ints[0]

    for this_int in ints[1:]:
        if this_int <= last_int:
            return False
        last_int = this_int
    return True

def isStrictlyIncreasingExceptOne(ints):
    # the list cannot be strictly increasing unless
    # there are at least two items in it
    if len(ints) <= 1:
        return False

    # if it's strictly increasing without removing
    # an item, it fails the test
    if isStrictlyIncreasing(ints):
        return False

    length = len(ints)
    for i in range(1, length-1):
        if ints[i] <= ints[i - 1]:
            print(f'removed {ints[i - 1]} at {i-1}')
            ints.pop(i - 1)
            return isStrictlyIncreasing(ints)

def solution(ints):
    intlist = ", ".join([ str(i) for i in ints ])
    print(f'Input: @ints = ({ intlist })')
    output = isStrictlyIncreasingExceptOne(ints)
    print(f'Output: {output}')
 
print("Example 1:")
solution([0, 2, 9, 4, 6])
 
print("\nExample 2:")
solution([5, 1, 3, 2])

print("\nExample 3:")
solution([2, 2, 3])

print("\nExample 4 from James Curtis-Smith:")
solution([1,2,3,4,1,2,3])

import java.util.Arrays;
import java.util.stream.Collectors;

public class Ch1 {
  public static String joined(int[] ints) {
    // we're using it more than once, make it a method
    return Arrays.stream(ints)
                 .mapToObj(String::valueOf)
                 .collect(Collectors.joining(", "));
  }

  public static boolean isStrictlyIncreasing(int[] ints) {
    // get the first integer from the list
    int last_int = ints[0];

    // note that we start with element 1, because
    // we've already put the value of the 0th
    // element into last_int
    for (int i = 1; i < ints.length; i++) {
      if (ints[i] <= last_int) {
        return false;
      }
      last_int = ints[i];
    }
    return true;
  }

  public static boolean isStrictlyIncreasingExceptOne(int[] ints) {
    // the list cannot be strictly increasing unless
    // there are at least two items in it
    if (ints.length <= 1) {
      return false;
    }

    // if it's strictly increasing without removing
    // an item, it fails the test
    if (isStrictlyIncreasing(ints)) {
      return false;
    }

    for (int i = 1; i < ints.length; i++) {
      if (ints[i] <= ints[i-1]) {
        // make a new list to hold the list
        // with one value removed
        int[] newlist = new int[ints.length - 1];
        // copy over all but the (i-1)th element
        for (int j = 0; j < ints.length; j++) {
          if (j == i - 1) {
            continue;
          }
          if (j < i - 1) {
            newlist[j] = ints[j];
          }
          else {
            newlist[j-1] = ints[j];
          }
        }
        // now test this new list to see
        // if it's strictly increasing
        return isStrictlyIncreasing(newlist);
      }
    }
    return false;
  }


  public static void solution(int[] ints) {
    System.out.println("Input: @ints = (" + joined(ints) + ")");
    boolean output = isStrictlyIncreasingExceptOne(ints);
    System.out.println("Output: " + output);
  }

  public static void main(String[] args) {
    System.out.println("Example 1:");
    solution(new int[] {0, 2, 9, 4, 6});

    System.out.println("\nExample 2:");
    solution(new int[] {5, 1, 3, 2});

    System.out.println("\nExample 3:");
    solution(new int[] {2, 2, 3});

    System.out.println("\nExample 4 from James Curtis-Smith:");
    solution(new int[] {1,2,3,4,1,2,3});
  }
}

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

Input: @ints = (1, 2, 3)
Ouput: (1, 2, 3)

Input: @ints = (0, 3, 0, 4, 5)
Ouput: (0, 0, 3, 0, 0)

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

sub duplicateZeros {
  my @ints = @_;
  for (my $i = 0; $i < scalar(@ints); $i++) {
    if ($ints[$i] == 0) {
      splice(@ints, $i+1, 0, 0); # insert a 0 at $i+1
      splice(@ints, -1);         # pop the last element off @ints
      $i++; # skip over the 0 we added!
    }
  }
  return @ints;
}

sub solution {
  my @ints = @_;
  say 'Input: @ints = (' . join(', ', @ints) . ')';
  @ints = duplicateZeros(@ints);
  say 'Output: (' . join(', ', @ints) . ')';
}
 
say "Example 1:";
solution(1, 0, 2, 3, 0, 4, 5, 0);
 
say "\nExample 2:";
solution(1, 2, 3);
 
say "\nExample 3:";
solution(0, 3, 0, 4, 5);

#!/usr/bin/env raku
 
use v6;
 
sub duplicateZeros(*@ints where ($_.all ~~ Int)) {
  loop (my $i = 0; $i < @ints.elems; $i++) {
    if (@ints[$i] == 0) {
      @ints.splice($i+1, 0, 0); # insert a 0 at $i+1
      @ints.splice(*-1);        # pop the last element off @ints
      $i++; # skip over the 0 we added!
    }
  }
  return @ints;
}

sub solution(*@ints where ($_.all ~~ Int)) {
  say 'Input: @ints = (' ~ @ints.join(', ') ~ ')';
  @ints = duplicateZeros(@ints);
  say 'Output: (' ~ @ints.join(', ') ~ ')';
}
 
say "Example 1:";
solution(1, 0, 2, 3, 0, 4, 5, 0);
 
say "\nExample 2:";
solution(1, 2, 3);
 
say "\nExample 3:";
solution(0, 3, 0, 4, 5);

#!/usr/bin/env python

def duplicateZeros(ints):
    length = len(ints)
    skip_me = -1
    for i in range(0, length):
        if skip_me == i:
            continue
        if ints[i] == 0:
            ints.insert(i+1, 0) # insert a 0 at i+1
            ints.pop(-1)        # pop the last element off ints
            skip_me = i+1       # skip over the 0 we added!
    return ints

def solution(ints):
    intlist = ", ".join([ str(i) for i in ints ])
    print(f'Input: @ints = ({ intlist })')
    ints = duplicateZeros(ints)
    intlist = ", ".join([ str(i) for i in ints ])
    print(f'Output: ({ intlist })');
 
print("Example 1:")
solution([1, 0, 2, 3, 0, 4, 5, 0])
 
print("\nExample 2:")
solution([1, 2, 3])
 
print("\nExample 3:")
solution([0, 3, 0, 4, 5])

import java.util.Arrays;
import java.util.stream.Collectors;

public class Ch2 {
  public static String joined(int[] ints) {
    // we're using it more than once, make it a method
    return Arrays.stream(ints)
                 .mapToObj(String::valueOf)
                 .collect(Collectors.joining(", "));
  }

  public static int[] duplicateZeros(int[] ints) {
    for (int i = 0; i < ints.length; i++) {
      if (ints[i] == 0) {
        // shift all the values in the array to the right by one 
        for (int j = ints.length - 1; j > i; j--) {
          ints[j] = ints[j - 1];
        }
        ints[i + 1] = 0; // insert a new 0
        i++; // skip over the 0 we added!
      }
    }
    return ints;
  }

  public static void solution(int[] ints) {
    System.out.println("Input: @ints = (" + joined(ints) + ")");
    ints = duplicateZeros(ints);
    System.out.println("Output: (" + joined(ints) + ")");
  }

  public static void main(String[] args) {
    System.out.println("Example 1:");
    solution(new int[] {1, 0, 2, 3, 0, 4, 5, 0});

    System.out.println("\nExample 2:");
    solution(new int[] {1, 2, 3});

    System.out.println("\nExample 3:");
    solution(new int[] {0, 3, 0, 4, 5});
  }
}

Input: @words = ("java", "javascript", "julia")
Output: ("j", "a")

Input: @words = ("bella", "label", "roller")
Output: ("e", "l", "l")

Input: @words = ("cool", "lock", "cook")
Output: ("c", "o")

sub charFrequency {
  my $word = shift;
  my %freq;
  foreach my $c ( split //, $word ) {
    $freq{$c}++;
  }
  return \%freq; # return a hash REFERENCE
}

sub commonCharacters {
  my @words = @_;
  my @freq = map { charFrequency($_) } @words;
  # grab the character frequency map for the first word
  my $first = shift @freq;
  # now check the characters in the first word against
  # the characters in all the subsequent words
  foreach my $subsequent ( @freq ) {
    foreach my $c ( keys %$first ) {
      if (! exists $subsequent->{$c}) {
        # this character isn't in subsequent words,
        # so let's remove it from the frequency map
        # of the first word
        delete $first->{$c};
      }
      else {
        # the character IS in subsequent words,
        # so let's set the frequency count to be
        # the minimum count found in those words
        $first->{$c} = min($first->{$c}, $subsequent->{$c});
      }
    }
  }
}

sub commonCharacters {
  ...
  # now we generate a list of characters in the order they
  # appear in the first word
  my @output;
  # once again, loop over the characters in the first word
  foreach my $c ( split //, $words[0] ) {
    next unless exists $first->{$c};
    if ($first->{$c} > 1) {
      # there's more than one occurence, so let's decrement
      # the count for the next time through the loop
      $first->{$c}--;
    }
    else {
      # there is only one occurence left, so remove the
      # character
      delete $first->{$c};
    }
    push @output, $c;
  }
  return @output;
}

#!/usr/bin/env perl

use v5.38;

use List::Util qw( min );

sub charFrequency {
  my $word = shift;
  my %freq;
  foreach my $c ( split //, $word ) {
    $freq{$c}++;
  }
  return \%freq; # return a hash REFERENCE
}

sub commonCharacters {
  my @words = @_;
  my @freq = map { charFrequency($_) } @words;
  # grab the character frequency map for the first word
  my $first = shift @freq;
  # now check the characters in the first word against
  # the characters in all the subsequent words
  foreach my $subsequent ( @freq ) {
    foreach my $c ( keys %$first ) {
      if (! exists $subsequent->{$c}) {
        # this character isn't in subsequent words,
        # so let's remove it from the frequency map
        # of the first word
        delete $first->{$c};
      }
      else {
        # the character IS in subsequent words,
        # so let's set the frequency count to be
        # the minimum count found in those words
        $first->{$c} = min($first->{$c}, $subsequent->{$c});
      }
    }
  }

  # now we generate a list of characters in the order they
  # appear in the first word
  my @output;
  # once again, loop over the characters in the first word
  foreach my $c ( split //, $words[0] ) {
    next unless exists $first->{$c};
    if ($first->{$c} > 1) {
      # there's more than one occurence, so let's decrement
      # the count for the next time through the loop
      $first->{$c}--;
    }
    else {
      # there is only one occurence left, so remove the
      # character
      delete $first->{$c};
    }
    push @output, $c;
  }
  return @output;
}

sub solution {
  my @words = @_;
  say 'Input: @words = ("' . join('", "', @words) . '")';
  my @output = commonCharacters(@words);
  say 'Output: ("' . join('", "', @output) . '")';
}

say "Example 1:";
solution("java", "javascript", "julia");

say "\nExample 2:";
solution("bella", "label", "roller");

say "\nExample 3:";
solution("cool", "lock", "cook");

#!/usr/bin/env raku

use v6;

sub charFrequency(Str $word) {
  my %freq;
  for $word.split('', :skip-empty) -> $c {
    %freq{$c}++;
  }
  return %freq;
}

sub commonCharacters(*@words where ($_.all ~~ Str)) {
  my @freq = @words.map({ charFrequency($_) });
  # grab the character frequency map for the first word
  my $first = shift @freq;
  # now check the characters in the first word against
  # the characters in all the subsequent words
  for @freq -> $subsequent {
    for $first.keys() -> $c {
      if ($subsequent{$c}:!exists) {
        # this character isn't in subsequent words,
        # so let's remove it from the frequency map
        # of the first word
        $first{$c}:delete;
      }
      else {
        # the character IS in subsequent words,
        # so let's set the frequency count to be
        # the minimum count found in those words
        $first{$c} = min($first{$c}, $subsequent{$c});
      }
    }
  }

  # now we generate a list of characters in the order they
  # appear in the first word
  my @output;
  # once again, loop over the characters in the first word
  for @words[0].split('', :skip-empty) -> $c  {
    next unless $first{$c}:exists;
    if ($first{$c} > 1) {
      # there's more than one occurence, so let's decrement
      # the count for the next time through the loop
      $first{$c}--;
    }
    else {
      # there is only one occurence left, so remove the
      # character
      $first{$c}:delete;
    }
    push @output, $c;
  }
  return @output;
}

sub solution {
  my @words = @_;
  say 'Input: @words = ("' ~ @words.join('", "') ~ '")';
  my @output = commonCharacters(@words);
  say 'Output: ("' ~ @output.join('", "') ~ '")';
}

say "Example 1:";
solution("java", "javascript", "julia");

say "\nExample 2:";
solution("bella", "label", "roller");

say "\nExample 3:";
solution("cool", "lock", "cook");

#!/usr/bin/env python

from collections import Counter

def charFrequency(word):
    # https://docs.python.org/3/library/collections.html#counter-objects
    freq = Counter()
    for c in word:
        freq[c] += 1
    return freq

def commonCharacters(words):
    # get the character freqencies for each word
    freq = list(map(charFrequency, words))

    # grab the character frequency map for the first word
    first = freq.pop(0)

    # make a copy of the dictionary since we'll
    # be modifying it in the loop
    first_orig = dict(first)

    # now check the characters in the first word against
    # the characters in all the subsequent words
    for subsequent in freq:
        for c in first_orig:
            if c not in subsequent:
                # this character isn't in subsequent words,
                # so let's remove it from the frequency map
                # of the first word
                first.pop(c)
            else:
                # the character IS in subsequent words,
                # so let's set the frequency count to be
                # the minimum count found in those words
                first[c] = min(first[c], subsequent[c])

    # now we generate a list of characters in the order they
    # appear in the first word
    output = []
    # once again, loop over the characters in the first word
    for c in words[0]:
        if c not in first:
            continue
        if first[c] > 1:
            first[c] -= 1
        else:
            first.pop(c)
        output.append(c)
    return output

def solution(words):
    quoted = '"' + '", "'.join(words) + '"'
    print(f'Input: @words = ({quoted})')
    output = commonCharacters(words)
    quoted = '"' + '", "'.join(output) + '"'
    print(f'Output: ({quoted})')

print("Example 1:")
solution(["java", "javascript", "julia"])

print("\nExample 2:")
solution(["bella", "label", "roller"])

print("\nExample 3:")
solution(["cool", "lock", "cook"])

Input: @ints = (4, 4, 2, 4, 3)
Ouput: 3

(0, 2, 4) because 4 != 2 != 3
(1, 2, 4) because 4 != 2 != 3
(2, 3, 4) because 2 != 4 != 3

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

Input: @ints = (4, 7, 1, 10, 7, 4, 1, 1)
Output: 28

triplets of 1, 4, 7  = 3x2×2 = 12 combinations
triplets of 1, 4, 10 = 3×2×1 = 6  combinations
triplets of 4, 7, 10 = 2×2×1 = 4  combinations
triplets of 1, 7, 10 = 3x2x1 = 6 combinations

sub findTriplets {
  my @ints = @_;
  my @solutions;
  foreach my $i ( 0 .. $#ints - 2 ) {
    foreach my $j ( $i+1 .. $#ints - 1 ) {
      foreach my $k ( $j+1 .. $#ints ) {
        if ($ints[$i] != $ints[$j] &&
            $ints[$j] != $ints[$k] &&
            $ints[$i] != $ints[$k]) {
          push @solutions, [$i, $j, $k];
        }
      }
    }
  }
  return @solutions;
}

#!/usr/bin/env perl

use v5.38;

sub findTriplets {
  my @ints = @_;
  my @solutions;
  foreach my $i ( 0 .. $#ints - 2 ) {
    foreach my $j ( $i+1 .. $#ints - 1 ) {
      foreach my $k ( $j+1 .. $#ints ) {
        if ($ints[$i] != $ints[$j] &&
            $ints[$j] != $ints[$k] &&
            $ints[$i] != $ints[$k]) {
          push @solutions, [$i, $j, $k];
        }
      }
    }
  }
  return @solutions;
}

sub solution {
  my @ints = @_;
  say 'Input: @ints = (' . join(', ', @ints) . ')';
  my @solutions = findTriplets(@ints);
  say 'Output: ' . scalar(@solutions);
  say "" if @solutions;
  foreach my $triplet ( @solutions ) {
    my($i, $j, $k) = @$triplet;
    say "($i, $j, $k) because "
      . "$ints[$i] != $ints[$j] != $ints[$k]";
  }
}

say "Example 1:";
solution(4, 4, 2, 4, 3);

say "\nExample 2:";
solution(1, 1, 1, 1, 1);

say "\nExample 3:";
solution(4, 7, 1, 10, 7, 4, 1, 1);

Example 3:
Input: @ints = (4, 7, 1, 10, 7, 4, 1, 1)
Output: 28

(0, 1, 2) because 4 != 7 != 1
(0, 1, 3) because 4 != 7 != 10
(0, 1, 6) because 4 != 7 != 1
(0, 1, 7) because 4 != 7 != 1
(0, 2, 3) because 4 != 1 != 10
(0, 2, 4) because 4 != 1 != 7
(0, 3, 4) because 4 != 10 != 7
(0, 3, 6) because 4 != 10 != 1
(0, 3, 7) because 4 != 10 != 1
(0, 4, 6) because 4 != 7 != 1
(0, 4, 7) because 4 != 7 != 1
(1, 2, 3) because 7 != 1 != 10
(1, 2, 5) because 7 != 1 != 4
(1, 3, 5) because 7 != 10 != 4
(1, 3, 6) because 7 != 10 != 1
(1, 3, 7) because 7 != 10 != 1
(1, 5, 6) because 7 != 4 != 1
(1, 5, 7) because 7 != 4 != 1
(2, 3, 4) because 1 != 10 != 7
(2, 3, 5) because 1 != 10 != 4
(2, 4, 5) because 1 != 7 != 4
(3, 4, 5) because 10 != 7 != 4
(3, 4, 6) because 10 != 7 != 1
(3, 4, 7) because 10 != 7 != 1
(3, 5, 6) because 10 != 4 != 1
(3, 5, 7) because 10 != 4 != 1
(4, 5, 6) because 7 != 4 != 1
(4, 5, 7) because 7 != 4 != 1

#!/usr/bin/env raku

use v6;

sub findTriplets(@ints where ($_.all ~~ Int)) {
  my @solutions;
  for 0 .. @ints.elems - 3 -> $i {
    for $i + 1 .. @ints.elems - 2 -> $j {
      for $j + 1 .. @ints.elems - 1 -> $k {
        if (@ints[$i] != @ints[$j] &&
            @ints[$j] != @ints[$k] &&
            @ints[$i] != @ints[$k]) {
          push @solutions, [$i, $j, $k];
        }
      }
    }
  }
  return @solutions;
}

sub solution {
  my @ints = @_;
  say 'Input: @ints = (' ~ @ints.join(', ') ~ ')';
  my @solutions = findTriplets(@ints);
  say 'Output: ' ~ @solutions.elems;
  say "" if @solutions;
  for @solutions -> @triplet {
    my ($i, $j, $k) = @triplet;
    say "($i, $j, $k) because "
      ~ "@ints[$i] != @ints[$j] != @ints[$k]";
  }
}

say "Example 1:";
solution(4, 4, 2, 4, 3);

say "\nExample 2:";
solution(1, 1, 1, 1, 1);

say "\nExample 3:";
solution(4, 7, 1, 10, 7, 4, 1, 1);

#!/usr/bin/env python

def findTriplets(ints):
    solutions = []
    for i in range(0, len(ints) - 3 ):
        for j in range(i + 1, len(ints) - 2):
            for k in range(j + 1, len(ints) - 1):
                if (ints[i] != ints[j] and
                    ints[j] != ints[k] and
                    ints[i] != ints[k]):
                    solutions.append([i, j, k])
    return solutions

def solution(ints):
    intlist = ", ".join([ str(i) for i in ints ])
    print(f'Input: @ints = ({intlist})')
    solutions = findTriplets(ints)
    print(f'Output: {len(solutions)}')
    if solutions:
        print("")
        for triplet in solutions:
            i, j, k = triplet
            print(
                f"({i}, {j}, {k}) because " +
                f"{ints[i]} != {ints[j]} != {ints[k]}"
            )

print("Example 1:")
solution([4, 4, 2, 4, 3])

print("\nExample 2:")
solution([1, 1, 1, 1, 1])

print("\nExample 3:")
solution([4, 7, 1, 10, 7, 4, 1, 1])

Input: @words = ("aba", "aabb", "abcd", "bac", "aabc")
Output: 2

Pair 1: similar words ("aba", "aabb")
Pair 2: similar words ("bac", "aabc")

Input: @words = ("aabb", "ab", "ba")
Output: 3

Pair 1: similar words ("aabb", "ab")
Pair 2: similar words ("aabb", "ba")
Pair 3: similar words ("ab", "ba")

Input: @words = ("nba", "cba", "dba")
Output: 0

sub charsInWord {
    my $word = shift;
    # split the word into characters, then map those characters
    # to a hash
    my %charset = map { $_ => 1 } split //, $word;
    # return the set of characters as a string, sorted
    return join q{}, sort keys %charset;
}

my %similar;
foreach my $word ( @words ) {
  my $charset = charsInWord($word);
  push @{ $similar{$charset} }, $word;
}

# if this is the first time we've seen this charset,
# create an empty arrayref to store the word in
$similar{$charset} = [] if ! exists $similar{$charset};

# append the word to the list for this charset
push @{ $similar{$charset} }, $word;

my @pairs;
while ( scalar(@list) >= 2 ) {
  my $first = shift @list; # remove the first element
  foreach my $second ( @list ) {
    push @pairs, [ $first, $second ];
  }
}

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

sub charsInWord {
  my $word = shift;
  # split the word into characters, then map those
  # characters to a hash so we only have unique ones
  my %charset = map { $_ => 1 } split //, $word;
  # return the set of characters as a string, sorted
  return join q{}, sort keys %charset;
}

sub findSimilarWordPairs {
  my @words = @_;

  # get the set of characters in each word,
  # store each word in an array reference under
  # the hash key for its character set
  my %similar;
  foreach my $word ( @words ) {
    my $charset = charsInWord($word);
    # if $similar{$charset} is undefined when we
    # try to use it as an array reference to store
    # a value, Perl will "autovivify" a reference
    # to an empty array
    push @{ $similar{$charset} }, $word;
  }

  # filter out character sets that only have one word
  my @multiples = grep {
    # only allow letter sets
    # that have more than one word
    scalar( @{ $similar{$_} } ) > 1
  } keys %similar;

  # make pairs by looping over the list
  # of letter sets that had multiple entries
  my @pairs;
  foreach my $charset ( @multiples ) {
    my @list = @{ $similar{$charset} };

    while ( scalar(@list) >= 2 ) {
      # remove the first word from the list of words
      my $first = shift @list;
      # pair it with each of the remaining words
      foreach my $second ( @list ) {
        push @pairs, [ $first, $second ];
      }
    }
  }
  return @pairs;
}

sub solution {
  my @words = @_;
  say 'Input: @words = ("' . join('", "', @words) . '")';

  my @pairs = findSimilarWordPairs(@words);

  say 'Output: ' . scalar(@pairs);
  my $count = 0;
  foreach my $pair ( @pairs ) {
    say "" if $count == 0;
    say 'Pair ' . ++$count . ': similar words ("'
      . join('", "', @$pair) . '")';
  }
}

say "Example 1:";
solution("aba", "aabb", "abcd", "bac", "aabc");

say "";
say "Example 2:";
solution("aabb", "ab", "ba");

say "";
say "Example 3:";
solution("nba", "cba", "dba");

sub charsInWord(Str $word) {
  # split the word into characters, then use the Raku
  # array method unique to have each character appear once.
  return $word.split('').unique.sort.join;
}

my %similar;
for @words -> $word {
  my $charset = charsInWord($word);
  %similar{$charset}.push($word);
}

#!/usr/bin/env raku
  
use v6;

sub charsInWord(Str $word) {
  # split the word into characters, then use the Raku
  # array method unique to have each character appear once.
  return $word.split('').unique.sort.join;
}

sub findSimilarWordPairs(*@words where ($_.all ~~ Str)) {
  my %similar;
  for @words -> $word {
    my $charset = charsInWord($word);
    %similar{$charset}.push($word);
  }

  # filter out character sets that only have one word
  my @multiples = %similar.keys.grep: {
    %similar{$_}.elems > 1
  };

  # make pairs by looping over the list
  # of letter sets that had multiple entries
  my @pairs;
  for @multiples -> $charset {
    # if we assign @list = %similar{$charset}, we get
    # an array with a single element, an array object.
    # By using .splice, I can get all the elements in 
    # the array object assigned to @list
    my @list = %similar{$charset}.splice(0, *);

    while ( @list.elems >= 2 ) {
      # remove the first word from the list of words
      my $first = @list.shift;
      # pair it with each of the remaining words
      for @list -> $second {
        @pairs.push([ $first, $second ]);
      }
    }
  }
  return @pairs;
}

sub solution {
  my @words = @_;
  say 'Input: @words = ("' ~ @words.join('", "') ~ '")';

  my @pairs = findSimilarWordPairs(@words);

  say 'Output: ' ~ @pairs.elems;
  my $count = 0;
  for @pairs -> $pair {
    say "" if $count == 0;
    say 'Pair ' ~ ++$count ~ ': similar words ("'
      ~ $pair.join('", "') ~ '")';
  }
}

say "Example 1:";
solution("aba", "aabb", "abcd", "bac", "aabc");

say "";
say "Example 2:";
solution("aabb", "ab", "ba");

say "";
say "Example 3:";
solution("nba", "cba", "dba");

Input: @ints = (1,1,2,2,2,3)
Ouput: (3,1,1,2,2,2)

'3' has a frequency of 1
'1' has a frequency of 2
'2' has a frequency of 3

Input: @ints = (2,3,1,3,2)
Ouput: (1,3,3,2,2)

'2' and '3' both have a frequency of 2, so they are sorted in decreasing order.

Input: @ints = (-1,1,-6,4,5,-6,1,4,1)
Ouput: (5,-1,4,4,-6,-6,1,1,1)

my %counts;
foreach my $int ( @ints ) {
  $counts{$int}++;
}

my %frequency;
foreach my $int ( keys %counts ) {
  push @{ $frequency{ $counts{$int} } }, $int;
}

my @output;
foreach my $freq ( sort keys %frequency ) {
  # get each integer for this frequency in descending order
  foreach my $int ( reverse sort @{ $frequency{$freq} } ) {
    # we need to put the integer on the list $freq times
    foreach ( 1 .. $freq ) {
      push @output, $int;
    }
  }
}

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

use Lingua::EN::Inflexion qw( wordlist );

sub solution {
  my @ints = @_;
  say 'Input: @ints = (' . join(', ', @ints) . ')';

  # count how often each integer occurs
  my %counts;
  foreach my $int ( @ints ) {
    $counts{$int}++;
  }

  # now create a hash of arrays listing which integers
  # occur at what frequencies
  my %frequency;
  foreach my $int ( keys %counts ) {
    push @{ $frequency{ $counts{$int} } }, $int;
  }

  my @output;
  my $text;
  foreach my $freq ( sort keys %frequency ) {
    my @list = @{ $frequency{$freq} };
    # get each integer for this frequency in descending order
    foreach my $int ( reverse sort @list ) {
      # we need to put the integer on the list $freq times
      foreach ( 1 .. $freq ) {
        push @output, $int;
      }
    }
    # now let's do the English description of the output.
    # have the integers in ascending order in the text,
    # and wrap them in quotes
    @list = map { "'$_'" } sort @list;
    if (@list == 1) {
      $text .= $list[0] . " has a frequency of $freq\n";
    }
    else {
      $text .= wordlist(@list);
      if (@list == 2) {
        $text .= ' both';
      }
      $text .= " have a frequency of $freq, "
            .  "so they are sorted in decreasing order\n";
    }
  }

  say "Output: (" . join(', ', @output) . ")";
  say "\n$text";
}

say "Example 1:";
solution(1,1,2,2,2,3);

say "";
say "Example 2:";
solution(2,3,1,3,2);

say "";
say "Example 3:";
solution(-1,1,-6,4,5,-6,1,4,1);

$ perl/ch-2.pl
Example 1:
Input: @ints = (1, 1, 2, 2, 2, 3)
Output: (3, 1, 1, 2, 2, 2)

'3' has a frequency of 1
'1' has a frequency of 2
'2' has a frequency of 3


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

'1' has a frequency of 1
'2' and '3' both have a frequency of 2, so they are sorted in decreasing order


Example 3:
Input: @ints = (-1, 1, -6, 4, 5, -6, 1, 4, 1)
Output: (5, -1, 4, 4, -6, -6, 1, 1, 1)

'-1' and '5' both have a frequency of 1, so they are sorted in decreasing order
'-6' and '4' both have a frequency of 2, so they are sorted in decreasing order
'1' has a frequency of 3

#!/usr/bin/env raku
  
use v6;

use Lingua::Conjunction;

sub solution (*@ints where {$_.all ~~ Int}) {
  say 'Input: @ints = (' ~ @ints.join(', ') ~ ')';

  # count how often each integer occurs
  my %counts;
  for @ints -> $int {
    %counts{$int}++;
  }

  # now create a hash of arrays listing which integers
  # occur at what frequencies
  my %frequency;
  for %counts.keys -> $int {
    %frequency{ %counts{$int} }.push($int);
  }

  my @output;
  my $text;
  for %frequency.keys.sort -> $freq {
    my @list = %frequency{$freq}.splice(0, *);
    # get each integer for this frequency in descending order
    for @list.sort.reverse -> $int {
      # we need to put the integer on the list $freq times
      @output.append($int xx $freq);
    }
    # now let's do the English description of the output.
    # have the integers in ascending order in the text,
    # and wrap them in quotes
    @list = @list.sort.map: { "'$_'" };
    if (@list.elems == 1) {
      $text ~= @list[0] ~ " has a frequency of $freq\n";
    }
    else {
      $text ~= conjunction @list;
      if (@list.elems == 2) {
        $text ~= ' both';
      }
      $text ~= " have a frequency of $freq, "
            ~  "so they are sorted in decreasing order\n";
    }
  }

  say "Output: (" ~ @output.join(', ') ~ ")";
  say "\n$text";
}

say "Example 1:";
solution(1,1,2,2,2,3);

say "";
say "Example 2:";
solution(2,3,1,3,2);

say "";
say "Example 3:";
solution(-1,1,-6,4,5,-6,1,4,1);

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

The minimum is 1 and maximum is 4 in the given array. So (3, 2) is neither min nor max.

Input: @ints = (3, 1)
Output: -1

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

The minimum is 1 and maximum is 3 in the given array. So 2 is neither min nor max.

sub neither_min_nor_max {
  my $min = min @_; # find the minimum value
  my $max = max @_; # find the maximum value

  # grep preserves the order of the array, it just
  # passes along the elements that meet the criteria
  my @neither = grep { $_ != $min && $_ != $max } @_;
  if (@neither) {
    # if we have elements, pass them back in an array reference
    return ($min, $max, \@neither);
  }
  else {
    # otherwise, pass back the requested -1
    return ($min, $max, -1);
  }
}

my ($min, $max, $neither) = neither_min_nor_max(@ints);

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

use Lingua::EN::Inflexion qw( verb );
use List::Util qw( min max );

sub array_join {
  return '(' . join(', ', @_) . ')';
}

sub neither_min_nor_max {
  my $min = min @_; # find the minimum value
  my $max = max @_; # find the maximum value

  # grep preserves the order of the array, it just
  # passes along the elements that meet the criteria
  my @neither = grep { $_ != $min && $_ != $max } @_;
  if (@neither) {
    # if we have elements, pass them back in an array reference
    return ($min, $max, \@neither);
  }
  else {
    # otherwise, pass back the requested -1
    return ($min, $max, -1);
  }
}

sub solution {
  my @ints = @_;
  say 'Input: @ints = ' . array_join(@ints);

  my ($min, $max, $neither) = neither_min_nor_max(@ints);

  print 'Output: ';
  if ( ref($neither) eq 'ARRAY' ) {
    # if we were passed back an array reference,
    # print it like an array
    say array_join(@$neither);

    # inflect the verb!
    my $is = @$neither == 1
           ? verb('is')->singular(3)
           : verb('is')->plural(3);

    print "The minimum is $min and maximum is $max "
        . "in the given array. ";
    say "So " . array_join(@$neither)
      . " $is neither min nor max.";
  }
  else {
    # otherwise, print the value unadorned
    say $neither;
  }
}

say "Example 1:";
solution(3, 2, 1, 4);

say "";

say "Example 2:";
solution(3, 1);

say "";

say "Example 3:";
solution(2, 1, 3);

#!/usr/bin/env raku
 
use v6;

sub neither_min_nor_max (*@ints where {$_.all ~~ Int}) {
  my $min = @ints.min; # find the minimum value
  my $max = @ints.max; # find the maximum value

  # grep preserves the order of the array, it just
  # passes along the elements that meet the criteria
  my @neither = @ints.grep({ $_ != $min && $_ != $max });
  if (@neither) {
    # if we have elements, pass them back in an array reference
    return $min, $max, @neither;
  }
  else {
    # otherwise, pass back the requested -1
    return $min, $max, -1;
  }
}

sub solution (*@ints where {$_.all ~~ Int}) {
  say 'Input: @ints = (' ~ @ints.join(', ') ~ ')';

  my ($min, $max, $neither) = neither_min_nor_max(@ints);

  print 'Output: ';
  if ( $neither ~~ Array ) {
    # if we were passed back an array reference,
    # print it like an array
    say '(' ~ $neither.join(', ') ~ ')';

    # inflect the verb!
    my $is = @$neither == 1 ?? 'is' !! 'are';

    print "The minimum is $min and maximum is $max "
        ~ "in the given array. ";
    say "So (" ~ $neither.join(', ')
      ~ ") $is neither min nor max.";
  }
  else {
    # otherwise, print the value unadorned
    say $neither;
  }
}

say "Example 1:";
solution(3, 2, 1, 4);

say "";

say "Example 2:";
solution(3, 1);

say "";

say "Example 3:";
solution(2, 1, 3);

Input: @list = ("7868190130M7522","5303914400F9211","9273338290F4010")
Output: 2

The age of the passengers in the given list are 75, 92 and 40.
So we have only 2 senior citizens.

Input: @list = ("1313579440F2036","2921522980M5644")
Output: 0

sub passenger_details {
  my $data = shift;
  my $phone = substr($data, 0, 10);
  my $sex   = substr($data, 10, 1);
  my $age   = substr($data, 11, 2);
  my $seat  = substr($data, 13, 2);
  return ($phone, $sex, $age, $seat);
}

sub passenger_details {
  my $data = shift;
  my($phone, $sex, $age, $seat) = $data
    =~ /\A(\d{10})(\w)(\d{2})(\d{2})\z/;
  return ($phone, $sex, $age, $seat);
}

sub passenger_details {
  my $data = shift;
  my($phone, $sex, $age, $seat) = unpack "A10A1A2A2", $data;
  return ($phone, $sex, $age, $seat);
}

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

use Lingua::EN::Inflexion qw( inflect wordlist );

sub quoted_array {
  return '("' . join('", "', @_) . '")';
}

sub passenger_details {
  my $data = shift;
  my($phone, $sex, $age, $seat) = unpack "A10A1A2A2", $data;
  return ($phone, $sex, $age, $seat);
}

sub ages_only {
  return map {
    my($phone, $sex, $age, $seat) = passenger_details($_);
    $age
  } @_;
}

sub count_senior_citizens {
  my @seniors = grep { $_ >= 60} @_;
  return scalar(@seniors);
}

sub solution {
  my @list = @_;
  say 'Input: ' . quoted_array(@list);
  my @ages  = ages_only(@list);
  my $count = scalar(@ages);
  my $senior_count = count_senior_citizens(@ages);

  say "Output: $senior_count";
  say "";
  my $wordlist = wordlist(@ages);
  say inflect "<#d:$count>The <N:age> of the <N:passenger> "
            . "in the given list <V:is> $wordlist.";
  say inflect "So we have <#n:$senior_count> "
            . "senior <N:citizen>.";
}

say "Example 1:";
solution("7868190130M7522","5303914400F9211","9273338290F4010");

say "";

say "Example 2:";
solution("1313579440F2036","2921522980M5644");

say "";

say "Example 3:";
solution("5188675309F6002");

sub passenger_details (Str $data) {
  $data ~~ /^ $<phone>=(\d ** 10) $<sex>=(\w ** 1) 
              $<age>=(\d ** 2) $<seat>=(\d ** 2) $/;
  return (~$<phone>, ~$<sex>, ~$<age>, ~$<seat>);
}

#!/usr/bin/env raku
 
use v6;

use Lingua::Conjunction;
use Lingua::EN::Numbers;

sub quoted_list ( *@list ) {
  # given a list, quote the elements and join them with commas
  my @quoted = @list.map: { qq{"$_"} };
  return @quoted.join(q{, });
}

sub passenger_details (Str $data) {
  $data ~~ /^ $<phone>=(\d ** 10) $<sex>=(\w ** 1) 
              $<age>=(\d ** 2) $<seat>=(\d ** 2) $/;
  return (~$<phone>, ~$<sex>, ~$<age>, ~$<seat>);
}

sub ages_only (*@list where {$_.all ~~ Str}) {
  return @list.map: {
    my ($phone, $sex, $age, $seat) = passenger_details($_);    
    $age.Int;
  }
}

sub count_senior_citizens (*@list where {$_.all ~~ Int}) {
  my @seniors = @list.grep: { $_ >= 60};
  return @seniors.elems;
}

sub solution (*@list where {$_.all ~~ Str}) {
  say 'Input: @list = (' ~ quoted_list(@list) ~ ')';
  my @ages  = ages_only(@list);
  my $count = @ages.elems;
  my $senior_count = count_senior_citizens(@ages);

  say "Output: $senior_count";
  say "";

  my $str = "The age[|s] of the passenger[|s] "
          ~ "in the given list [is|are] |list|.";
  say conjunction @ages, :$str;
  my $no       = $senior_count == 0 ?? 'no' !! $senior_count.Str;
  my $citizens = $senior_count == 1 ?? 'citizen' !! 'citizens';
  say "So we have $no senior $citizens.";
}

say "Example 1:";
solution("7868190130M7522","5303914400F9211","9273338290F4010");

say "";

say "Example 2:";
solution("1313579440F2036","2921522980M5644");

say "";

say "Example 3:";
solution("5188675309F6002");

Input: @words  = ("pay", "attention", "practice", "attend")
       $prefix = "at"
Ouput: 2

Two words "attention" and "attend" starts with the given prefix "at".

Input: @words  = ("janet", "julia", "java", "javascript")
       $prefix = "ja"
Ouput: 3

Three words "janet", "java" and "javascripr" starts with the given prefix "ja".

#!/usr/bin/env perl

use v5.38;

use Lingua::EN::Inflexion qw( inflect wordlist );

sub quoted_list {
  # given a list, quote the elements and join them with commas
  my @quoted = map { qq{"$_"} } @_;
  return join q{, }, @quoted;
}

sub solution {
  my $prefix = shift;
  my @words  = @_;
  say qq{Input: \@words  = (} . quoted_list(@words) . q{)};
  say qq{       \$prefix = "$prefix"};

  my @matched;
  foreach my $word ( @words ) {
    # "next unless" is a perl idiom
    next unless $word =~ /^$prefix/;
    push @matched, $word;
  }
  my $count = scalar(@matched);
  say "Ouput: $count";
  say "";

  # put the list of words into an English list using "and"
  my $wordlist = wordlist( map { qq{"$_"} } @matched );

  # let's inflect the words 'word' and 'start'
  say ucfirst inflect qq{<#w:$count> <N:word> $wordlist "
    . "<V:start> with the given prefix "$prefix".};
}

say "Example 1:";
solution("at", "pay", "attention", "practice", "attend");

say "";

say "Example 2:";
solution("ja", "janet", "julia", "java", "javascript");

$ perl/ch-2.pl
Example 1:
Input: @words  = ("pay", "attention", "practice", "attend")
       $prefix = "at"
Output: 2

Two words "attention" and "attend" start with the given prefix "at".

Example 2:
Input: @words  = ("janet", "julia", "java", "javascript")
       $prefix = "ja"
Output: 3

Three words "janet", "java", and "javascript" start with the given prefix "ja".

#!/usr/bin/env raku

use v6;

use Lingua::Conjunction;
use Lingua::EN::Numbers;

sub quoted_list ( *@list ) {
  # given a list, quote the elements and join them with commas
  my @quoted = @list.map: { qq{"$_"} };
  return @quoted.join(q{, });
}

sub solution (Str $prefix, *@words where {$_.all ~~ Str}) {
  say qq{Input: \@words  = (} ~ quoted_list(@words) ~ q{)};
  say qq{       \$prefix = "$prefix"};

  my @matched;
  for @words -> $word {
    # "next unless" is a raku idiom, too
    next unless $word ~~ /^$prefix/;
    push @matched, $word;
  }
  my $count = @matched.elems;
  say "Output: $count";
  say "";

  # the examples show the word count in English as well, so
  # let's use the Lingua::EN::Numbers module
  my $count_en = tclc cardinal($count);

  # also, let's inflect the words 'word' and 'start'
  #
  # The documentation for Lingua::Conjunction says "You can use 
  # special sequence [|] (e.g. octop[us|i]) where string to the
  # left of the | will be used when the list contains just one
  # item and the string to the right will be used otherwise."
  # but there's a bug where it uses the left when there is one
  # OR TWO items.
  #
  # I've fixed it and created a pull request
  # https://github.com/raku-community-modules/Lingua-Conjunction/pull/2
  my $str = qq{$count_en word[|s] |list| start[s|] }
          ~ qq{with the given prefix "$prefix".};
  my @quoted = @matched.map: { qq{"$_"} };
  say conjunction @quoted, :$str;
}

say "Example 1:";
solution("at", "pay", "attention", "practice", "attend");

say "";

say "Example 2:";
solution("ja", "janet", "julia", "java", "javascript");

Input: @ints = (1, 34, 5, 6)
Output: (1, 3, 4, 5, 6)

Input: @ints = (1, 24, 51, 60)
Output: (1, 2, 4, 5, 1, 6, 0)

foreach my $digit ( @digits_of_int ) {
  push @digits_in_array, $digit;
}

splice @digits_in_array, scalar(@digits_in_array), 0, @digits_of_int;

#!/usr/bin/env perl

use v5.38;

sub display_array {
  return "(" . join(q{, }, @_) . ")";
}

sub solution {
  my @ints = @_;
  say "Input: \@ints = " . display_array(@ints);
  # the description says that the array is positive integers,
  # so let's treat them as integers and divide them
  my @digits_in_array;
  foreach my $int ( @ints ) {
    my @digits_of_int;
    while ( $int > 0 ) {
      # first get the ones place digit
      my $ones_place = $int % 10;
      # push it onto the BEGINNING of @digits_of_int
      unshift @digits_of_int, $ones_place;
      # divide the number by 10, discarding the fraction
      $int = int( $int / 10 );
    }
    # push the elements from @digits_of_int onto the end
    # of @digits_in_array
    splice @digits_in_array, scalar(@digits_in_array), 0, @digits_of_int;
  }
  say "Output: " . display_array(@digits_in_array);
}

say "Example 1:";
solution(1, 34, 5, 6);

say "";

say "Example 2:";
solution(1, 24, 51, 60);

sub solution (*@ints where {$_.all ~~ Int}) {
  say "Input: \@ints = " ~ display_array(@ints);
  # the description says that the array is positive integers,
  # so let's treat them as integers and divide them
  my @digits_in_array;
  for @ints -> $int {
    my @digits_of_int;
    while ( $int > 0 ) {
      # first get the ones place digit
      my $ones_place = $int % 10;
      # push it onto the BEGINNING of @digits_of_int
      unshift @digits_of_int, $ones_place;
      # divide the number by 10, discarding the fraction
      $int = ($int / 10).truncate;
    }
    # append the elements from @digits_of_int onto the end
    # of @digits_in_array
    @digits_in_array.append: @digits_of_int;
  }
  say "Output: " ~ display_array(@digits_in_array);
}

$ raku/ch-1.raku
Example 1:
Input: @ints = (1, 34, 5, 6)
Parameter '$int' expects a writable container (variable) as an
argument, but got '1' (Int) as a value without a container.
  in sub solution at raku/ch-1.raku line 14
  in block <unit> at raku/ch-1.raku line 32

  for @ints -> $value {
    my $int = Int.new($value);

#!/usr/bin/env raku

use v6;

sub display_array (@array) {
  return "(" ~ @array.join(q{, }) ~ ")";
}

sub solution (*@ints where {$_.all ~~ Int}) {
  say "Input: \@ints = " ~ display_array(@ints);
  # the description says that the array is positive integers,
  # so let's treat them as integers and divide them
  my @digits_in_array;
  for @ints -> $value {
    my $int = Int.new($value);
    my @digits_of_int;
    while ( $int > 0 ) {
      # first get the ones place digit
      my $ones_place = $int % 10;
      # push it onto the BEGINNING of @digits_of_int
      unshift @digits_of_int, $ones_place;
      # divide the number by 10, discarding the fraction
      $int = ($int / 10).truncate;
    }
    # append the elements from @digits_of_int onto the end
    # of @digits_in_array
    @digits_in_array.append: @digits_of_int;
  }
  say "Output: " ~ display_array(@digits_in_array);
}

say "Example 1:";
solution(1, 34, 5, 6);

say "";

say "Example 2:";
solution(1, 24, 51, 60);

Input: @str = ("abc", "bce", "cae")
Output: 1

In the given array "cae" is the only element which is not lexicographically sorted.

Input: @str = ("yxz", "cba", "mon")
Output: 2

In the given array "yxz" and "mon" are not lexicographically sorted.

#!/usr/bin/env perl

use v5.38;

sub quoted_list {
  # given a list, quote the elements and join them with commas
  my @quoted = map { qq{"$_"} } @_;
  return join q{, }, @quoted;
}

sub quoted_english_list {
  # given a list, quote the elements and join them 
  # in a way that makes sense to english speakers
  my @quoted = map { qq{"$_"} } @_;
  my $last = pop @quoted; # last element in array
  if (@quoted == 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 q{, }, @quoted;
  if (@quoted > 1) {
    # if there's more than element, add an Oxford comma
    $joined .= q{,};
  }
  return "$joined and $last";
}

sub is_lexically_sorted {
  my $input = shift @_;

  # get the characters in the input string
  my @characters = split //, $input;

  # generate a string of the characters sorted ascending
  # (with case folding)
  my $forwards  = join q{}, sort {
    fc($a) cmp fc($b)
  } @characters;

  # generate a string of the characters sorted descending
  # (with case folding)
  my $backwards = join q{}, sort {
    fc($b) cmp fc($a)
  } @characters;

  # if the input string is matches either sorted string,
  # then return true
  return( $input eq $forwards || $input eq $backwards );
}

sub solution {
  my @str = @_;
  say "Input: \@str = (" . quoted_list(@str) . ")";

  my @not_lexically_sorted = grep {
    ! is_lexically_sorted($_)
  } @str;

  say "Output: " . scalar(@not_lexically_sorted);
  say "";

  if (@not_lexically_sorted == 0) {
    say "In the given array all elements are"
      . " lexicographically sorted.";
  }
  elsif (@not_lexically_sorted == 1) {
    say "In the given array "
      . quoted_list(@not_lexically_sorted)
      . " is the only element which is not"
      . " lexicographically sorted.";
  }
  else {
    say "In the given array "
      . quoted_english_list(@not_lexically_sorted)
      . " are not lexicographically sorted.";
  }
}

say "Example 1:";
solution("abc", "bce", "cae");

say "";

say "Example 2:";
solution("yxz", "cba", "mon");

#!/usr/bin/env raku

use v6;

sub quoted_list ( *@list ) {
  # given a list, quote the elements and join them with commas
  my @quoted = @list.map: { qq{"$_"} };
  return @quoted.join(q{, });
}

sub quoted_english_list ( *@list ) {
  # given a list, quote the elements and join them 
  # in a way that makes sense to english speakers
  my @quoted = @list.map: { qq{"$_"} };
  my $last = @quoted.pop(); # last element in array
  if (@quoted == 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 q{, }, @quoted;
  if (@quoted > 1) {
    # if there's more than element, add an Oxford comma
    $joined ~= q{,};
  }
  return "$joined and $last";
}

sub is_lexically_sorted ($input) {
  # get the characters in the input string
  # putting $input in quotes casts it as a Str
  my @characters = "$input".split("", :skip-empty);

  # sort the characters ascending
  my @forwards  = @characters.sort: { $^a.fc cmp $^b.fc };

  # sort the characters descending
  my @backwards = @characters.sort: { $^b.fc cmp $^a.fc };

  # if the input string is matches either sorted string,
  # then return true
  return( $input eq @forwards.join("")
          ||
          $input eq @backwards.join("") );
}

sub solution (*@str) {
  say "Input: \@str = (" ~ quoted_list(@str) ~ ")";

  my @not_lexically_sorted = @str.grep({
    !is_lexically_sorted($_)
  });

  say "Output: " ~ @not_lexically_sorted.elems;
  say "";

  if (@not_lexically_sorted.elems == 0) {
    say "In the given array all elements are"
      ~ " lexicographically sorted.";
  }
  elsif (@not_lexically_sorted.elems == 1) {
    say "In the given array "
      ~ quoted_list(@not_lexically_sorted)
      ~ " is the only element which is not"
      ~ " lexicographically sorted.";
  }
  else {
    say "In the given array "
      ~ quoted_english_list(@not_lexically_sorted)
      ~ " are not lexicographically sorted.";
  }
}

say "Example 1:";
solution("abc", "bce", "cae");

say "";

say "Example 2:";
solution("yxz", "cba", "mon");

Input: @array1 = (1, 1, 2, 4)
       @array2 = (2, 4)
       @array3 = (4)
Ouput: (2, 4)

Input: @array1 = (4, 1)
       @array2 = (2, 4)
       @array3 = (1, 2)
Ouput: (1, 2, 4)

#!/usr/bin/env perl

use v5.38;

# function to return unique elements in array
use List::Util qw( uniq );

sub display_array {
  return "(" . join(q{, }, @_) . ")";
}

sub solution {
  my @arrays = @_;
  say "Input: \@array1 = " . display_array( @{ $arrays[0] } );
  say "       \@array2 = " . display_array( @{ $arrays[1] } );
  say "       \@array3 = " . display_array( @{ $arrays[2] } );

  # Return all the elements that are present in at least 2 out
  # of 3 given arrays.  In the sample input, there are arrays 
  # where there elements appear multiple times in a given
  # array, so we want to examine only UNIQUE elements
  my @unique;
  foreach my $arrayref ( @arrays ) {
    push @unique, [ uniq @$arrayref ];
  }

  # now that we have arrays of only unique elements, let's find
  # elements that occur in more than one array using a hash
  my %occurrences;
  foreach my $arrayref ( @unique ) {
    foreach my $element ( @$arrayref ) {
      $occurrences{$element}++;
    }
  }

  say "Output: " . display_array(
    sort # sort the resulting array of elements numerically
    grep {
      # only include elements that were counted more than once
      $occurrences{$_} > 1;
    } keys %occurrences
  );
}

say "Example 1:";
solution(
  [1, 1, 2, 4],
  [2, 4],
  [4]
);

say "";

say "Example 2:";
solution(
  [4, 1],
  [2, 4],
  [1, 2]
);

#!/usr/bin/env raku

use v6;

sub display_array (@array) {
  return "(" ~ @array.join(q{, }) ~ ")";
}

sub solution (@array1, @array2, @array3) {
  say "Input: \@array1 = " ~ display_array(@array1);
  say "       \@array2 = " ~ display_array(@array2);
  say "       \@array3 = " ~ display_array(@array3);

  # Return all the elements that are present in at least 2 out
  # of 3 given arrays.  In the sample input, there are arrays
  # where there elements appear multiple times in a given
  # array, so we want to examine only UNIQUE elements, then
  # find elements that occur in more than one array using
  # a hash
  my %occurrences;
  for ( @array1.unique,
        @array2.unique,
        @array3.unique ).flat -> $element {
    %occurrences{$element}++;
  }

  say "Output: " ~ display_array(
    # only include elements that were counted more than once
    %occurrences.keys().grep: { %occurrences{$_} > 1 } 
  ).sort; # sort the resulting array of elements numerically
}

say "Example 1:";
solution(
  (1, 1, 2, 4),
  (2, 4),
  (4,)
);

say "";

say "Example 2:";
solution(
  (4, 1),
  (2, 4),
  (1, 2)
);