Perl Weekly Challenge: The Score for Group Therapy

The tasks this week are “Equal Group” and “Final Score”, and I already used The Final Countdown back in PWC 325, so I couldn’t use that. So I went digging though my music collection, and I found this track from Steve Hackett’s Highly Strung album: Group Therapy.

So let’s sit down together for a group session with Perl Weekly Challenge 336.

Task 1: Equal Group

You are given an array of integers.

Write a script to return true if the given array can be divided into one or more groups: each group must be of the same size as the others, with at least two members, and with all members having the same value.

Example 1

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

Groups: (1,1), (2,2), (2,2)

Example 2

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

Groups: (1,1,1), (2,2,2), (3,3)

Example 3

Input: @ints = (5,5,5,5,5,5,7,7,7,7,7,7)
Output: true

Groups: (5,5,5,5,5,5), (7,7,7,7,7,7)

Example 4

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

Example 5

Input: @ints = (8,8,9,9,10,10,11,11)
Output: true

Groups: (8,8), (9,9), (10,10), (11,11)

Approach

You know the saying “When all you have is a hammer, everything looks like a nail?” Sometimes I feel like I’m a broken record when I keep saying “BAG!” whenever I see these problems, but really, it feels like it’s the appropriate data structure for this kind of task.

We’re looking to divide the input list into groups of equal size >= 2, with all members of a group having the same value. So, by turning the input lists into bags, we wind up with the following multisets:

Example 1: %{1 => 2, 2 => 2, 3 => 2}
Example 2: %{1 => 3, 2 => 3, 3 => 2}
Example 3: %{5 => 6, 7 => 6}
Example 4: %{1 => 1, 2 => 1, 3 => 1, 4 => 1}
Example 5: %{8 => 2, 9 => 2, 10 => 2, 11 => 2}

Just by looking at the multisets we can see that examples 2 and 4 won’t work: example 4 doesn’t have enough elements to make a two-element group, and example 2 doesn’t have a way to make two-element groups of 1 or 2 to go with the two-element group for 3. But if we tweaked the input for Example 2 to be (1,1,1,1,2,2,2,2,3,3), then the resulting multiset would be %{1 => 4, 2 => 4, 3 => 2}, and we could make the groups (1,1) (1,1) (2,2), (2,2) (3,3).

So we need all the values in the multiset to be >= 2, and all the values in the multiset to be multiples of either the lowest value in the multiset (in my tweaked example 2, the lowest value is 2, and the other values are 2 x 2) or some denominator of that value and 2.

Raku

Raku made this fairly easy. The Bag class handles a lot of the heavy lifting; but making groups of $smallest integers wound up being something I had to do manually.

sub dividesUnevenly($smallest, $bag) {
  $bag.values.grep({ $_ mod $smallest != 0 })
}

sub equalGroup(@ints) {
  my $bag = @ints.Bag;
  # if we don't have more than 2 instances of
  # a particular int, we can't make groups
  return (False, q{}) if $bag.values.any < 2;

  # find the smallest number of instances of
  # an int in the list
  my $smallest = $bag.values.min;

  # can we divide the list evenly into multiples
  # of the smallest group?
  while (dividesUnevenly($smallest, $bag) && $smallest > 2) {
    # no, let's divide it by 2 and try again
    $smallest = ($smallest / 2).Int;
  }

  # make the groups and return the result
  my $groups;
  if (dividesUnevenly($smallest, $bag)) {
    # we can't evenly divide by $smallest, just
    # make a single group for each unique int
    for $bag.keys.sort -> $k {
      $groups ~= '(' ~ $bag.kxxv.grep($k).join(',') ~ ') ';
    }
    return (False, $groups);
  }
  else {
    # make groups of $smallest
    for $bag.keys.sort -> $k {
      my $count = $bag{$k};
      while ($count) {
        $groups ~= '(' ~ (($k) xx $smallest).join(',') ~ ') ';
        $count -= $smallest;
      }
    }
    return (True, $groups);
  }
}

View the entire Raku script for this task on GitHub.

$ raku/ch-1.raku
Example 1:
Input: @ints = (1,1,2,2,2,2)
Output: True

Groups: (1,1) (2,2) (2,2)

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

Groups: (1,1,1) (2,2,2) (3,3)

Example 3:
Input: @ints = (5,5,5,5,5,5,7,7,7,7,7,7)
Output: True

Groups: (5,5,5,5,5,5) (7,7,7,7,7,7)

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

Example 5:
Input: @ints = (8,8,9,9,10,10,11,11)
Output: True

Groups: (8,8) (9,9) (10,10) (11,11)

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

Groups: (1,1) (1,1) (2,2) (2,2) (3,3)

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

Groups: (1,1,1) (1,1,1) (1,1,1) (2,2,2) (2,2,2) (2,2,2) (3,3,3) (3,3,3)

Example 8 (3a):
Input: @ints = (5,5,5,5,5,7,7,7,7,7,7)
Output: False

Groups: (5,5,5,5,5) (7,7,7,7,7,7)

Elixir

At work this week, we were discussing my Elixir solution to PWC 335 Task 1, and my coworker Jonathan pointed me at Enum.frequencies/1. This is the function I’ve needed to make Bags/multisets all along! I had so much fun I decided to tackle the Elixir solution right after I did my Raku one. I also remembered seeing Stream.chunk_by/2 and Stream.chunk_every/2 a while back, which made rendering the groups pretty easy (though I did write a render_groups/1 function to handle all the common parts).

This is pretty much the same implementation as the Raku solution, except you have to read it from bottom to top: it enters via equal_group/1 on line 54, and equal_group/1 makes calls to functions that have been defined above it. find_smallest/2 (lines 11-23) is the seemingly obligatory recursive function that allows us to bail out when we’ve found the result we want or keep looping until we reach a stopping criteria (in this case, smallest being less than or equal to 2).

def divides_unevenly(smallest, bag) do
  bag
  |> Map.values
  |> Enum.filter(fn v -> rem(v, smallest) != 0 end)
  |> length != 0
end

def find_smallest(smallest, _) when smallest <= 2,
  do: 2

def find_smallest(smallest, bag) when smallest > 2 do
  # can we divide the list evenly into multiples
  # of the smallest group?
  if divides_unevenly(smallest, bag) do
    # no, let's divide it by 2 and try again
    find_smallest(trunc(smallest/2), bag)
  else
    smallest
  end
end

def render_groups(stream) do
  stream
  |> Enum.to_list
  |> Enum.map(fn l -> "(" <> Enum.join(l,",") <> ")" end)
  |> Enum.join(" ")
end

def equal_group(ints, bag) do
  # find the smallest number of instances of
  # an int in the list
  smallest = Map.values(bag) |> Enum.min |> find_smallest(bag)

  # make the groups and return the result
  if divides_unevenly(smallest, bag) do
    # we can't evenly divide by smallest, just
    # make a single group for each unique int
    {
      "false",
      ints |> Stream.chunk_by(&(&1)) |> render_groups
    }
  else
    # make groups of smallest
    {
      "true",
      ints |> Stream.chunk_every(smallest) |> render_groups
    }
  end
end

def equal_group(ints) do
  bag = Enum.frequencies(ints) # one line bag!
  if Enum.any?(Map.values(bag), fn v -> v < 2 end) do
    # if we don't have more than 2 instances of
    # a particular int, we can't make groups
    {"false", ""}
  else
    equal_group(ints, bag)
  end
end

View the entire Elixir script for this task on GitHub.

Perl

For some reason, Set::Bag doesn’t have a method that will return a list of ALL the values in the bag (if $bag->grab() is called with a list of keys, it returns the values for those keys, but if it’s called with no keys, it returns a hash of keys => values). Fortunately, this is one of those cases where Perl’s poor encapsulation works to my advantage: by looking at the Set::Bag source, I could see that it was just a hashref under the hood, so I was able to get the values by calling values(%$bag).

use List::AllUtils qw( any min );
use Set::Bag;

sub dividesUnevenly($smallest, $bag) {
  any { $_ % $smallest != 0 } values(%$bag)
}

sub equalGroup(@ints) {
  my $bag = Set::Bag->new( map { $_ => 1 } @ints );
  # if we don't have more than 2 instances of
  # a particular int, we can't make groups
  return ("false", q{}) if any { $_ < 2 } values(%$bag);

  # find the smallest number of instances of
  # an int in the list
  my $smallest = min values(%$bag);

  # can we divide the list evenly into multiples
  # of the smallest group?
  while (dividesUnevenly($smallest, $bag) && $smallest > 2) {
    # no, let's divide it by 2 and try again
    $smallest = int($smallest / 2);
  }

  # make the groups and return the result
  my $groups;
  if (dividesUnevenly($smallest, $bag)) {
    # we can't evenly divide by $smallest, just
    # make a single group for each unique int
    foreach my $k ( $bag->elements ) {
      my $count = $bag->grab($k);
      $groups .= '(' . join(',', (($k) x $count)) . ') ';
    }
    return ("false", $groups);
  }
  else {
    # make groups of $smallest
    foreach my $k ( $bag->elements ) {
      my $count = $bag->grab($k);
      while ($count) {
        $groups .= '(' . join(',', (($k) x $smallest)) . ') ';
        $count -= $smallest;
      }
    }
    return ("true", $groups);
  }
}

View the entire Perl script for this task on GitHub.

Python

Like Set::Bag in Perl is implemented on top of a hash, Counter in Python is implemented on top of a dict, so we get to use .values() and .keys() to access the keys and values themselves.

from collections import Counter

def int_join(joiner, arr):
  return joiner.join(map(lambda i: str(i), arr))

def divides_unevenly(smallest, bag):
  return [ n for n in bag.values() if n % smallest != 0 ]

def equal_group(ints):
  bag = Counter(ints)

  # if we don't have more than 2 instances of
  # a particular int, we can't make groups
  if [ n for n in bag.values() if n < 2 ]:
    return False, ""
  
  # find the smallest number of instances of
  # an int in the list
  smallest = min(bag.values())

  # can we divide the list evenly into multiples
  # of the smallest group?
  while divides_unevenly(smallest, bag) and smallest > 2:
    smallest = int(smallest / 2)

  # make the groups and return the result  
  groups = ""
  if divides_unevenly(smallest, bag):
    for k in bag.keys():
      group = []
      for i in range(bag[k]): group.append(k)
      groups += "(" + int_join(",",group) + ") "
    return False, groups
  else:
    for k in bag.keys():
      count = bag[k]
      while count > 0:
        group = []
        for i in range(smallest): group.append(k)
        groups += "(" + int_join(",",group) + ") "
        count -= smallest
    return True, groups

View the entire Python script for this task on GitHub.


Task 2: Final Score

You are given an array of scores by a team.

Write a script to find the total score of the given team. The score can be any integer, +C or D. The + adds the sum of previous two scores. The score C invalidates the previous score. The score D will double the previous score.

Example 1

Input: @scores = ("5","2","C","D","+")
Output: 30

Round 1: 5
Round 2: 5 + 2
Round 3: 5 (invalidate the previous score 2)
Round 4: 5 + 10 (double the previous score 5)
Round 5: 5 + 10 + 15 (sum of previous two scores)

Total Scores: 30

Example 2

Input: @scores = ("5","-2","4","C","D","9","+","+")
Output: 27

Round 1: 5
Round 2: 5 + (-2)
Round 3: 5 + (-2) + 4
Round 4: 5 + (-2) (invalidate the previous score 4)
Round 5: 5 + (-2) + (-4) (double the previous score -2)
Round 6: 5 + (-2) + (-4) + 9
Round 7: 5 + (-2) + (-4) + 9 + 5 (sum of previous two scores)
Round 8: 5 + (-2) + (-4) + 9 + 5 + 14 (sum of previous two scores)

Total Scores: 27

Example 3

Input: @scores = ("7","D","D","C","+","3")
Output: 45

Round 1: 7
Round 2: 7 + 14 (double the previous score 7)
Round 3: 7 + 14 + 28 (double the previous score 14)
Round 4: 7 + 14 (invalidate the previous score 28)
Round 5: 7 + 14 + 21 (sum of previous two scores)
Round 6: 7 + 14 + 21 + 3

Total Scores: 45

Example 4

Input: @scores = ("-5","-10","+","D","C","+")
Output: -55

Round 1: (-5)
Round 2: (-5) + (-10)
Round 3: (-5) + (-10) + (-15) (sum of previous two scores)
Round 4: (-5) + (-10) + (-15) + (-30) (double the previous score -15)
Round 5: (-5) + (-10) + (-15) (invalidate the previous score -30)
Round 6: (-5) + (-10) + (-15) + (-25) (sum of previous two scores)

Total Scores: -55

Example 5

Input: @scores = ("3","6","+","D","C","8","+","D","-2","C","+")
Output: 128

Round  1: 3
Round  2: 3 + 6
Round  3: 3 + 6 + 9 (sum of previous two scores)
Round  4: 3 + 6 + 9 + 18 (double the previous score 9)
Round  5: 3 + 6 + 9 (invalidate the previous score 18)
Round  6: 3 + 6 + 9 + 8
Round  7: 3 + 6 + 9 + 8 + 17 (sum of previous two scores)
Round  8: 3 + 6 + 9 + 8 + 17 + 34 (double the previous score 17)
Round  9: 3 + 6 + 9 + 8 + 17 + 34 + (-2)
Round 10: 3 + 6 + 9 + 8 + 17 + 34 (invalidate the previous score -2)
Round 11: 3 + 6 + 9 + 8 + 17 + 34 + 51 (sum of previous two scores)

Total Scores: 128

Approach

I don’t know what game these teams are playing, but this scoring is odd. You can get a score, then you can double the last score you got, but then that score can be invalidated (what happened? Was there a VAR review?)

But if we don’t think about how these rules relate to a game of some sort, they’re fairly easy to follow. We just maintain a list of numbers to be added when we’re done processing the list of rules, and then add them up at the end. The way we can remove the last score from the list makes it feel like a stack to me, so that’s what I’m going to call it.

Raku

I decided I wanted to use a given/when/default statement to handle the actions, because it’s really well suited for this: we’ve got three actions (+, C, and D) that do special things, and anything else just pushes a value onto the stack. In fact, most of the code is handling the explanation of what action we took in each round, not actually doing the actions.

sub finalScore(@scores) {
  my (@stack, $rounds, $count);
  for @scores -> $action {
    my $previous = @stack[*-1];
    given $action {
      when "+" { @stack.push( @stack[*-1] + @stack[*-2] ) }
      when "C" { @stack.pop() }
      when "D" { @stack.push( @stack[*-1] * 2 ) }
      default  { @stack.push($action) }
    }
    $rounds ~= sprintf "Round %2d: ", ++$count;
    $rounds ~= @stack.map({$_ < 0 ?? "($_)" !! $_}).join(" + ");
    $rounds ~= " (sum of previous two scores)"
      if $action eq "+";
    $rounds ~= " (double the previous score $previous)"
      if $action eq "D";
    $rounds ~= " (invalidate the previous score $previous)"
      if $action eq "C";
    $rounds ~= "\n";
  }
  my $sum = sum(@stack);
  $rounds ~= "\nTotal Scores: $sum";
  return ($sum, $rounds);
} 

View the entire Raku script for this task on GitHub.

$ raku/ch-2.raku
Example 1:
Input: @scores = ("5", "2", "C", "D", "+")
Output: 30

Round  1: 5
Round  2: 5 + 2
Round  3: 5 (invalidate the previous score 2)
Round  4: 5 + 10 (double the previous score 5)
Round  5: 5 + 10 + 15 (sum of previous two scores)

Total Scores: 30

Example 2:
Input: @scores = ("5", "-2", "4", "C", "D", "9", "+", "+")
Output: 27

Round  1: 5
Round  2: 5 + (-2)
Round  3: 5 + (-2) + 4
Round  4: 5 + (-2) (invalidate the previous score 4)
Round  5: 5 + (-2) + (-4) (double the previous score -2)
Round  6: 5 + (-2) + (-4) + 9
Round  7: 5 + (-2) + (-4) + 9 + 5 (sum of previous two scores)
Round  8: 5 + (-2) + (-4) + 9 + 5 + 14 (sum of previous two scores)

Total Scores: 27

Example 3:
Input: @scores = ("7", "D", "D", "C", "+", "3")
Output: 45

Round  1: 7
Round  2: 7 + 14 (double the previous score 7)
Round  3: 7 + 14 + 28 (double the previous score 14)
Round  4: 7 + 14 (invalidate the previous score 28)
Round  5: 7 + 14 + 21 (sum of previous two scores)
Round  6: 7 + 14 + 21 + 3

Total Scores: 45

Example 4:
Input: @scores = ("-5", "-10", "+", "D", "C", "+")
Output: -55

Round  1: (-5)
Round  2: (-5) + (-10)
Round  3: (-5) + (-10) + (-15) (sum of previous two scores)
Round  4: (-5) + (-10) + (-15) + (-30) (double the previous score -15)
Round  5: (-5) + (-10) + (-15) (invalidate the previous score -30)
Round  6: (-5) + (-10) + (-15) + (-25) (sum of previous two scores)

Total Scores: -55

Example 5:
Input: @scores = ("3", "6", "+", "D", "C", "8", "+", "D", "-2", "C", "+")
Output: 128

Round  1: 3
Round  2: 3 + 6
Round  3: 3 + 6 + 9 (sum of previous two scores)
Round  4: 3 + 6 + 9 + 18 (double the previous score 9)
Round  5: 3 + 6 + 9 (invalidate the previous score 18)
Round  6: 3 + 6 + 9 + 8
Round  7: 3 + 6 + 9 + 8 + 17 (sum of previous two scores)
Round  8: 3 + 6 + 9 + 8 + 17 + 34 (double the previous score 17)
Round  9: 3 + 6 + 9 + 8 + 17 + 34 + (-2)
Round 10: 3 + 6 + 9 + 8 + 17 + 34 (invalidate the previous score -2)
Round 11: 3 + 6 + 9 + 8 + 17 + 34 + 51 (sum of previous two scores)

Total Scores: 128

Perl

There’s a lot of talk about the switch feature being deprecated in Perl, but even though I see claims that it was deprecated in 5.38 and removed in 5.42, it doesn’t appear in perldeprecation and it’s still listed as valid in perlsyn. Even so, I think I’m going to use foreach to topicalize my actions…

use List::AllUtils qw( sum );

sub finalScore(@scores) {
  my (@stack, $rounds, $count);
  foreach my $action ( @scores ) {
    my $previous = $stack[-1];
    foreach ($action) {
      /\+/ && do { push @stack, $stack[-1] + $stack[-2]; last };
      /C/  && do { pop  @stack; last; };
      /D/  && do { push @stack, $stack[-1] * 2; last; };
      push @stack, $action;
    }
    $rounds .= sprintf "Round %2d: ", ++$count;
    $rounds .= join(" + ", map {$_ < 0 ? "($_)" : $_} @stack);
    $rounds .= " (sum of previous two scores)"
      if $action eq "+";
    $rounds .= " (double the previous score $previous)"
      if $action eq "D";
    $rounds .= " (invalidate the previous score $previous)"
      if $action eq "C";
    $rounds .= "\n";
  }
  my $sum = sum(@stack);
  $rounds .= "\nTotal Scores: $sum";
  return ($sum, $rounds);
}

View the entire Perl script for this task on GitHub.

Python

In Python, the control structure is match/case:

def final_score(scores):
  stack = []
  rounds = ""
  count = 0
  for action in scores:
    if stack: previous = stack[-1]
    match action:
      case '+':
        stack.append( stack[-1] + stack[-2] )
      case 'C':
        stack.pop()
      case 'D':
        stack.append( stack[-1] * 2 )
      case _:
        stack.append( int(action) )
    count += 1
    rounds += "Round {:2d}: ".format(count)
    rounds += " + ".join([
      f'({n})' if n < 0 else f'{n}' for n in stack
    ])
    if action == "+":
      rounds += " (sum of previous two scores)"
    if action == "D":
      rounds += f" (double the previous score {previous})"
    if action == "C":
      rounds += f" (invalidate the previous score {previous})"
    rounds += "\n"
  total = sum(stack)
  rounds += f"\nTotal Scores: {total}"
  return (total, rounds)

View the entire Python script for this task on GitHub.

Elixir

And Elixir has a case statement. Again, we’re using recursion to do our looping, passing the stack list, rounds string, and count counter into each iteration. When we finally exhaust the list scores, we sum our stack and add it to the end of rounds.

I decided to use List.insert_at/3 to append to the stack instead of something like stack ++ [a + b], and I think it’s mostly because I needed to use List.delete_at/2 to remove the last element in the C case, and I wanted the code to be visually consistent.

defp pad(num) do
  String.pad_leading(to_string(num), 2)
end

defp wrap(num) do
  if num < 0 do
    "(#{num})"
  else
    "#{num}"
  end
end

def final_score([], stack, rounds, _) do
  total = Enum.sum(stack)
  { total, rounds <> "\nTotal Scores: #{total}" }
end

def final_score([action | scores], stack, rounds, count) do
  previous = List.last(stack)
  stack = case action do
    "+" ->
      {a, b} = {Enum.at(stack, -1), Enum.at(stack, -2)}
      List.insert_at(stack, -1, a + b)
    "C" ->
      List.delete_at(stack, -1)
    "D" ->
      List.insert_at(stack, -1, Enum.at(stack, -1) * 2)
    _   ->
      List.insert_at(stack, -1, String.to_integer(action) )
  end
  rounds = rounds
    <> "Round #{pad(count)}: "
    <> Enum.join(Enum.map(stack, &wrap/1), " + ")
    <> case action do
      "+" -> " (sum of previous two scores)"
      "C" -> " (invalidate the previous score #{previous})"
      "D" -> " (double the previous score #{previous})"
      _   -> ""
    end
    <> "\n"
  final_score(scores, stack, rounds, count+1)
end

def final_score(scores) do
  final_score(scores, [], "", 1)
end

View the entire Elixir script for this task on GitHub.


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