Perl Weekly Challenge: Exact Change and Array Loops

It’s time for the Perl Weekly Challenge 236!


Task 1: Exact Change

You are asked to sell juice each costs $5. You are given an array of bills. You can only sell ONE juice to each customer but make sure you return exact change back. You only have $5, $10 and $20 notes. You do not have any change in hand at first.

Write a script to find out if it is possible to sell to each customers with correct change.

Example 1

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.

Example 2

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.

Example 3

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

Ok, how to attack this problem. I’m sure there’s a clever way to figure out whether or not the given assortment of bills can produce exact change, but as always, I’m going for straightforward and easy to understand over clever. A clever solution would be worth it if we needed performance.

So, the straightforward way is to keep a count of bills we take in and then return whether we can produce exact change. If at any point we don’t have the exact change on hand for a transaction, we can bail out of the function early and return false. If we get through all the transactions and are able to produce exact change for all of them, we return true. I’m going to use a hash because we’re tracking three bill amounts separated by a bit of space, and keeping those in a numerically indexed array would yield a bunch of empty elements I’d need to deal with.

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;
}

I’m just going to link to the full Perl script in GitHub.


The Raku version is almost identical:

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;
}

The one thing to note is that we can just say that the items being sorted are .Int and Raku will handle the comparison. Here’s the full Raku script in GitHub.


For Python, I had to tweak my logic a little to get around not being able to continue to the next iteration of the outer for bills loop from within the inner for till loop.

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

Here’s the full Python script in GitHub.


And now to the Java version. It’s slightly more annoying because Java Maps aren’t native to the language, but the approach works well:

  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;
  }

Here’s the full Java script in GitHub.


Task 2: Array Loops

You are given an array of unique integers.

Write a script to determine how many loops are in the given array.

To determine a loop: Start at an index and take the number at array[index] and then proceed to that index and continue this until you end up at the starting index.

Example 1

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]

Example 2

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]

Example 3

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]

So to attack this we want to loop over each item in @ints and see if a loop starts at that element. Things I thought about:

  • I was worried about loops that don’t go back to the start, but one of the assumptions is that the list is unique integers, so we’re never going to have to worry about that.
  • Double counting loops: if we start at an element that’s in a loop we’ve already counted, we shouldn’t count it again.
  • When I wanted to pass multiple types of arguments to loopExistsAt(), I decided it would be a good opportunity to use the idea of having named parameters for a Per sub by passing it a hash.
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;
}

Here’s the full Perl script in GitHub.


The Raku version wound up catching on bits of my Raku-newbie knowledge:

  • When I attempted to return nothing with just return;, what I wound up returning was an Any object. If I want to return an empty list, I need to return [];
  • I had to look up how to do named parameters in Raku.
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;
}

Here’s the full Raku script in GitHub.


Python:

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

Here’s the full Python script in GitHub.


Java:

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});
  }
}

Here’s my solutions in GItHub: https://github.com/packy/perlweeklychallenge-club/tree/master/challenge-236/packy-anderson

Perl Weekly Challenge: Remove and Duplicate, Challenge Edition

It’s time for Perl Weekly Challenge 235!


Task 1: Remove One

You are given an array of integers.

Write a script to find out if removing ONLY one integer makes it strictly increasing order.


Example 1

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

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

Example 2

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

Example 3

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

Ok, let’s look at this challenge. We’re looking to return true or false depending on whether removing ONLY one integer from a list makes it strictly increasing order.

So what we need to do is go through the list and keep track of how many times a value is less than or equal to the value before it.

EDITED: As James Curtis-Smith on Facebook pointed out with a counter-example, this logic won’t work. I need to see if removing the value yields a strictly increasing list. So I added a function to test if the list was strictly increasing, and leveraged that:

#!/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);

For those interested, Curtis-Smith does have a very tight, very Perlish solution posted on Facebook. Personally, I’d want to comment the heck out of it so it was clear what was happening, but it does demonstrate using array slices to solve the problem. I will admit that I borrowed the idea of doing it in two functions (one to check whether it’s in order, one to check if only one removal is needed), but I wanted my solution to be a bit easier to read.

EDITED A SECOND TIME! @SpaceLifeForm@infosec.exchange challenged me to do it without removal or recursion, and I managed to do it, but I do have to backtrack in the loop a bit:

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;
}

I’ve already submitted the first edit, so I’m not going to redo all of the other solutions to fit this second edit. I’m just posting it to show it can be done.


The Raku version is almost identical; really the only changes were to how the list of integers was passed to functions, and the syntax of the for loop and the infix ternary operator.

#!/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);

The Python version varies a little because the list of integers is passed into my isStrictlyIncreasing function by reference, so I can’t modify the list while I’m testing it.

#!/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])

Now to the language I’m learning for this challenge, Java. It may seem odd that I’m teaching myself a non-Perl language for the Perl Weekly Challenge, but there’s a method to my madness: there’s a lot of Java code out there, and I want to be able to credibly work with it.

One of the things that’s different about Java is that it’s all statically typed. Not only do variables require a type, but if you’re declaring a native array of a particular type, you need to pre-define the size of the array. However, don’t worry: the language does provide for dynamically sized arrays—they’re just a special class, not a native data type.

Things I had to take note of:

  • Joining arrays of non-string values takes a little bit of work. Fortunately, the Collectors class handles this beautifully, and the third example down in the documentation perfectly demonstrates converting elements into strings and then concatenating them separated by commas.
  • Java allows you to concatenate a boolean to a string; the stringification is handled automatically.
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});
  }
}

Task 2: Duplicate Zeros

You are given an array of integers.

Write a script to duplicate each occurrence of ZERO in the given array and shift the remaining to the right but make sure the size of array remain the same.

Example 1

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

Example 2

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

Example 3

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

This seems like a perfect solution to use Perl’s splice command. Whenever we want to duplicate a 0 at position $i, we execute splice(@ints, $i+1, 0, 0) followed by splice(@ints, -1) (which is essentially a pop(@ints)).

#!/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);

In Raku, the C-style three statement loop is loop, not for. We need to use this form of loop if we want to modify the loop counter after we’ve inserted a 0 so we don’t processes it a second time.

#!/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);

In Python, however, there isn’t a three statement loop. Also, from experience, I know if we explicitly use the array in the control of the loop, Python will complain when we modify the array. So let’s capture the length of the array first, and use a variable to track which iterations through the loop we’re skipping to pass over the 0 we added…

#!/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])

Which, finally, brings us to the Java implementation. We could have used variable-length array objects, but because the whole point of this task is that the array length stays the same, I should lean into that and just move the array elements manually and not rely on some splice method.

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});
  }
}

Here’s my solutions in GItHub: https://github.com/packy/perlweeklychallenge-club/tree/master/challenge-235/packy-anderson

Perl Weekly Challenge: Common, but Unequal, Triplet Characters

Ok, trying to be creative with my title for this week’s Perl Weekly Challenge 234 blog title is probably a miss. But it’s the effort that counts!


Task 1: Common Characters

You are given an array of words made up of alphabetic characters only.
Write a script to return all alphabetic characters that show up in all words including duplicates.

Example 1

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

Example 2

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

Example 3

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

So, looking at this problem, I see that in addition to preserving duplicated characters, the sample output (I’m glad Mohammed fixed the typo “Ouput” that’s been persistent in the past few weeks) is preserving the order of the characters based on the first word in the input list.

Since I’m looking for a new coding gig, I’ve been taking some coding tests, and one of the strategies the preparations for coding tests encourages is to look for patterns in the data once you’ve done an initial pass over it. One of the things I notice in this task is that it feels like a combination of the two tasks from last the challenge. We’re splitting the words into characters, and we’re counting the frequency of those characters. Any character that has a frequency of 1 or greater in each word occurs once, any character that has a frequency of 2 or greater in each word occurs twice, and so on.

This will get us the frequencies of the characters for each word:

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

Then we need to find the common characters:

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});
      }
    }
  }
}

But that’s not enough to satisfy the problem: we need to output the characters in the order they appear in the first word. So let’s add to this function:

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;
}

Which, as an entire script, looks like this:

#!/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");


Things to note in the Raku solution:

  • When splitting a string into its component characters, make sure you add the :skip-empty parameter, otherwise you’ll get leading and trailing empty character entries.
  • Deleting elements from a hash isn’t a method call, it’s a Subscript Adverb, :delete.
  • Similarly, testing for the existence of an element is the Subscript Adverb :exists.
  • If you try to use the construction ! $hash{$key}:exists, you get the error Precedence issue with ! and :exists, perhaps you meant :!exists?
#!/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");

Things to note in the Python solution:

  • You don’t shift elements off the beginning of an array, you pop the 0th element.
  • You don’t push elements onto the end of an array, you append them
  • There’s a Counter type in the collections module that lets you essentially autovivify elements in a dictionary by adding to them
  • In both Perl and Raku, the keys function/method for a hash returned a list that we were then able to iterate over, so we could remove elements from the hash while we were looping over it. Not so in Python: RuntimeError: dictionary changed size during iteration. This is easily handled by making a copy of the dictionary and looping over that.
#!/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"])

But this does go towards demonstrating something I’ve been saying for years: Python isn’t all that different than Perl. It just makes some different decisions and tries to cut down on TMTOWTDI as much as possible.


Task 2: Unequal Triplets

You are given an array of positive integers.

Write a script to find the number of triplets (i, j, k) that satisfies num[i] != num[j], num[j] != num[k] and num[k] != num[i].

Example 1

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

Example 2

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

Example 3

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

I think this time I’m going to break from my tradition of spitting out the exact explanatory text and just generate something that looks like the first example.

The meat of this solution is just a triple-nested loop:

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;
}

The rest of the code is just formatting the results:

#!/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);

And the output from the third example looks like this:

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

Things to note in the Raku solution:

  • Because .elems returns the number of elements in the array, we need to subtract an additional 1 to get the index of the last value.
#!/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);

Things to note in the Python solution:

  • The Python equivalent of x .. y is range(x, y)
  • You can’t just .join() a list of integers. You need to call .join() on the string you want to join them with, and convert each of the integers into strings:
    ", ".join([ str(i) for i in ints ])
    (though last week, I did it like this; ', '.join(map(lambda i: str(i), ints)))
  • Interpolating values in strings got a lot easier in Python 3.6 with the addition of f-strings.
#!/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])

Here’s my solutions in GItHub: https://github.com/packy/perlweeklychallenge-club/tree/master/challenge-234/packy-anderson

Perl Weekly Challenge: What’s the Frequency, Kenneth?

There was no Perl Weekly Challenge last week so we jump from 231 to 233!

Both tasks this week deal with accepting lists of items and then manipulating those lists.


Task 1: Similar Words

You are given an array of words made up of alphabets only.

Write a script to find the number of pairs of similar words. Two words are similar if they consist of the same characters.

Example 1

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

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

Example 2

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")

Example 3

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

So what we’re looking for is a way to break down words into a sorted set of the characters that occur in that word so we can use that list to compare whether the words use only the same characters:

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;
}

We can then use those character set strings as the keys to a hash. By storing each word in an array referenced in a hash by the character set for that word:

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

Now, you might wonder why I’m not checking to see if $similar{$charset} exists already or has an array reference before just pushing a value there. It’s all through the magic of a feature of Perl called autovivification. When we attempt to access the hash %similar using the key $charset, if that key doesn’t exist, Perl will automatically create it and make it undefined. Similarly, when we try to push a value onto an array reference in a variable that is currently undefined, Perl creates an array reference and populates the variable with it. So when %similar is empty and I say
push @{ $similar{$charset} }, $word; the entry in %similar for $charset winds up containing a reference to an array with one entry: $word.

Autovivification can cause problems in your code, because undefined values in a hash can get autovivified just by referencing their keys, so if I’m ever testing to see if something is defined, I always check to see if the key exists in the array using exists rather than just testing the value of $hash{$key}. However, in this case, I’m putting values into a hash or into an array reference, so if they don’t already exist, I want to create them. If Perl didn’t have autovivification, I’d have to do this:

# 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;

The next bit of the problem that I noticed on carefully reading the examples is it doesn’t just want a list of words using the same character set: it wants pairs of words using the same character set. So we need to take our list of words using the same character set and present it as pairs.

A little thought produced the algorithm for this. Given the list of words A, B, C, D, the list can be broken down into pairs by taking the first word off the list (A), pairing it with each of the remaining words (AB, AC, AD), then repeating the process with the shortened list (B, C, D) until we ran out of words (BC, BD, CD). This is easily done in Perl with a pair of loops:

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

And that pretty much does all the heavy lifting for this problem. The rest is presentation:

#!/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");

In the Raku version, some of the language features allowed me to make some different choices:

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;
}

Raku having a .unique method on the array class (really, the Any class) meant I didn’t need to use a hash to get only the unique characters. Autovivification works much the same, however:

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

But then I ran into a problem when I was trying to make the pairs. I wanted to make a copy of the list of similar words so I could modify it, but when I had the assignment my @list = %similar{$charset}, what I got wasn’t what I expected: instead of the elements of the list pointed to by %similar{$charset} being assigned to @list, I got the list itself assigned as the first element of @list. I needed a way to say “return the elements in this list” instead of “return this list”. Unfortunately, the method that feels right for this, .elems, just returns the count of elements, not the elements themselves. I wound up using the .splice method to return a list of all the elements in the array.

So here’s the Raku version:

#!/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");

Task 2: Frequency Sort

You are given an array of integers.

Write a script to sort the given array in increasing order based on the frequency of the values. If multiple values have the same frequency then sort them in decreasing order.

Example 1

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

Example 2

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.

Example 3

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

Ok, the lack of explanatory English text at the end of Example 3 and the lack '1' has a frequency of 1 of at the end of Example 2 makes me believe that Mohammad isn’t expecting that text to be part of the output. I’m including it anyway. 😉

This is the simpler of the two problems. First, we just need to count up how often we see each integer:

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

Easy-peasy. Then, much like with the last task, we use a hash of arrays to group together integers that have the same frequency:

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

Then, putting those integers back into an output array in the proper order:

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;
    }
  }
}

Once I add in all the stuff to print the English output after the required array output, and the boilerplate to echo the input, we get this:

#!/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);

Producing the output

$ 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

The Raku version didn’t change very much:

#!/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);

It does, however use the really cool xx operator that does sort of what x does, except for arrays instead of strings. If you execute say 'a' x 5; in Raku (or in Perl), you’ll get the output aaaaa. But if you execute say 'a' xx 5; in Raku, you’ll get (a a a a a).

Also, if I use .push() to put the elements into @output, I’d wind up pushing the arrays themselves into @output and get output like this:
Output: (3, 1 1, 2 2 2)

By using .append(), I was able to append the individual integers to @output and wind up with output like this:
Output: (3, 1, 1, 2, 2, 2)


I’ve also decided that I’m going to start adding more solutions in what the challenge calls “Guest Languages”… namely, anything that isn’t Perl or Raku. This week, I’m adding solutions in another language I know: Python. I want to pick up more languages so I’m more employable, and as I learn them I’ll be adding them to this exercise.


Here’s my solutions in GItHub: https://github.com/packy/perlweeklychallenge-club/tree/master/challenge-233/packy-anderson