Perl Weekly Challenge: Fanfare for the Common Character

Posted on by

This week I could have picked Aaron Copeland’s original arrangement of his work, but I really wanted to show off Keith Emerson’s masterful arrangement for ELP’s 1977 album.

So with plenty of fanfare, let’s dive into Perl Weekly Challenge 335!

Task 1: Common Characters

You are given an array of words.

Write a script to return all characters that is in every word in the given array including duplicates.

Example 1

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

Example 2

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

Example 3

Input: @words = ("hello", "world", "pole")
Output: ("l", "o")

Example 4

Input: @words = ("abc", "def", "ghi")
Output: ()

Example 5

Input: @words = ("aab", "aac", "aaa")
Output: ("a", "a")

Approach

This screams “Bag” to me. The bag will count the number of occurrences in each word, and we just need to find the common keys in each bag and the minimum number of occurrences for each of those characters.

Raku

In fact, the Raku class Bag allows us to do this entirely in one line. We take the array of words, map each of the elements to a bag, then use the reduce routine to repeatedly get the intersection of the bags, and then use the kxxv method to return a list of the keys multiplied by their weight.

sub commonCharacters(@words) {
  @words.map({ $_.comb.Bag }).reduce(&infix:<∩>).kxxv.sort;
}

View the entire Raku script for this task on GitHub.

$ raku/ch-1.raku
Example 1:
Input: @words = ("bella", "label", "roller")
Output: ("e", "l", "l")

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

Example 3:
Input: @words = ("hello", "world", "pole")
Output: ("l", "o")

Example 4:
Input: @words = ("abc", "def", "ghi")
Output: ()

Example 5:
Input: @words = ("aab", "aac", "aaa")
Output: ("a", "a")

Perl

And because I was so spoiled by Raku’s Bag, instead of just using a hash as a bag like I usually do, I reached out for the Set::Bag module on CPAN, because it did all the intersection work for me. Really, the only thing I needed to do myself was generate the input list for the constructor on line 10 (because just passing a list of values doesn’t work in Set::Bag like the Bag constructor does in Raku), and emulating Raku’s kxxv method by doing map { ($_) x $common->grab($_) } $common->elements on line 13.

use List::AllUtils qw( reduce );
use Set::Bag;

sub commonCharacters(@words) {
  my @bags = map {
    Set::Bag->new( map { $_ => 1 } split //, $_ )
  } @words;
  my $common = reduce { $a & $b } @bags;
  return sort map { ($_) x $common->grab($_) } $common->elements;
}

View the entire Perl script for this task on GitHub.

Python

Unfortunately, Python’s Counter does not do intersections for us, so we have to convert the list of bags Counters into a list of sets, use set.intersection() to get the intersection of the keys, and the manually find the lowest count of the keys by using min().

from collections import Counter

def common_characters(words):
  # make multisets of the words' characters
  bags = [ Counter(list(w)) for w in words ]
  # make a list of sets of the keys in each bag
  sets = [ set(b.keys()) for b in bags ]
  # convert the keys to sets so we can find the intersection
  keys = set.intersection(*sets)
  common = []
  for key in keys:
    # get the lowest count for the key from each bag
    lowest = min([ b[key] for b in bags ])
    # insert that many of the key into the common array
    for i in range(lowest): common.append(key)
  return sorted(common)

View the entire Python script for this task on GitHub.

Elixir

Elixir saved me a lot of work, however, by having Map.intersect/3 accept a function to determine the value associated with the key in the intersection; the example in the documentation showed the two values being summed, but I knew immediately that we could use min() to get the minimum value and it would work just like the Raku functionality. So I was only left with manually creating the bags (lines 4-11) and manually converting the Map of common characters back to a list, and that was assisted by List.duplicate/2.

def bag(word) do
  {_, bag} = word
  |> String.graphemes
  |> Enum.map_reduce(%{}, fn c, b ->
    {c, Map.put(b, c, Map.get(b, c, 0) + 1)}
  end)
  bag
end

def common_characters(words) do
  common =
    # make multisets of the words' characters
    words |> Enum.map(fn word -> bag(word) end)
    # find the intersection of the multisets
    |> Enum.reduce(fn b, c ->
         # the function returns the smallest count
         Map.intersect(b, c, fn _k, v1, v2 -> min(v1, v2) end)
       end)
  # convert the map into a list of common characters
  {_, list} = common
    |> Map.keys
    |> Enum.map_reduce([], fn char, list ->
         count = Map.get(common, char)
         {char, list ++ List.duplicate(char, count)}
       end)
  list
end

View the entire Elixir script for this task on GitHub.

Task 2: Find Winner

You are given an array of all moves by the two players.

Write a script to find the winner of the TicTacToe game if found based on the moves provided in the given array.

UPDATE: Order move is in the order – A, B, A, B, A, ….

Example 1

Input: @moves = ([0,0],[2,0],[1,1],[2,1],[2,2])
Output: A

Game Board:
[ A _ _ ]
[ B A B ]
[ _ _ A ]

Example 2

Input: @moves = ([0,0],[1,1],[0,1],[0,2],[1,0],[2,0])
Output: B

Game Board:
[ A A B ]
[ A B _ ]
[ B _ _ ]

Example 3

Input: @moves = ([0,0],[1,1],[2,0],[1,0],[1,2],[2,1],[0,1],[0,2],[2,2])
Output: Draw

Game Board:
[ A A B ]
[ B B A ]
[ A B A ]

Example 4

Input: @moves = ([0,0],[1,1])
Output: Pending

Game Board:
[ A _ _ ]
[ _ B _ ]
[ _ _ _ ]

Example 5

Input: @moves = ([1,1],[0,0],[2,2],[0,1],[1,0],[0,2])
Output: B

Game Board:
[ B B B ]
[ A A _ ]
[ _ _ A ]

Approach

The first thing I needed to figure out is how the moves mapped to the game board. After walking through the move list, I was able to figure out the board looks like this:

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

It took me a while to realize that the final game board shown in Example 1 is incorrect. A is still the winner, but because the moves B makes are [2,0] and [2,1] it looks like this:

[ A _ _ ]
[ _ A _ ]
[ B B A ]

For it to look like the board shown in Example 1, the moves would have to be ([0,0],[1,0],[1,1],[1,2],[2,2]).

Raku

I was kinda tired when I coded this, so I went for verbose and compartmentalized. The first thing I wrote were the emptyGameBoard, displayGameBoard, and makeMove routines, so I could double-check my impression of how moves were represented. Then I worked up findWinner just to make the moves and display the board, so I could confirm that I was getting the correct end state (and that the end state shown in Example 1 was, in fact, wrong). The last thing I did was checking for the winner from lines 34-58, and it went through three iterations:

  • Finding the winners based on rows, columns, and diagonals by checking if the three locations being checked had the same value, and returning one of those values as the winner, only to find the winner of example 4 was player “_“.
  • Adding a check to each of the conditions to exclude “_” when matching a winner, only to find that both examples 3 and 4 were “Pending”.
  • Adding the move count variable to line 27, and then only returning “Pending” if there were fewer than 9 moves made.
sub emptyGameBoard() {
  return [
    [ '_', '_', '_' ] xx 3
  ];
}

sub displayGameBoard(@board) {
  my $output = "Game Board:\n";
  for @board -> @row {
    $output ~= '[ ' ~ @row.join(' ') ~ ' ]' ~ "\n";
  }
  $output;
}

sub makeMove($letter, @move, @board) {
  my ($y,$x) = (@move[0;0], @move[0;1]);
  @board[$y;$x] = $letter;
}

sub findWinner(@moves) {
  my @board = emptyGameBoard();

  my $letter = 'A';
  my $movecount = @moves.elems;
  while (@moves) {
    my @move = @moves.shift;
    makeMove($letter, @move, @board);
    $letter = ($letter eq 'A') ?? 'B' !! 'A';
  }

  # check rows
  for 0..2 -> $y {
    return(@board[$y;0], displayGameBoard(@board))
      if (@board[$y;0] eq @board[$y;1] eq @board[$y;2])
      && @board[$y;0] ne '_';
  }

  # check columns
  for 0..2 -> $x {
    return(@board[0;$x], displayGameBoard(@board))
      if (@board[0;$x] eq @board[1;$x] eq @board[2;$x])
      && @board[0;$x] ne '_';
  }

  # check diagonals
  return(@board[1;1], displayGameBoard(@board))
    if ((@board[0;0] eq @board[1;1] eq @board[2;2])
     || (@board[2;0] eq @board[1;1] eq @board[0;2]))
      && @board[1;1] ne '_';

  # no winner
  return(
    $movecount < 9 ?? 'Pending' !! 'Draw',
    displayGameBoard(@board)
  );
}

View the entire Raku script for this task on GitHub.

$ raku/ch-2.raku
Example 1:
Input: @moves = ([0,0], [2,0], [1,1], [2,1], [2,2])
Output: A

Game Board:
[ A _ _ ]
[ _ A _ ]
[ B B A ]

Example 2:
Input: @moves = ([0,0], [1,1], [0,1], [0,2], [1,0], [2,0])
Output: B

Game Board:
[ A A B ]
[ A B _ ]
[ B _ _ ]

Example 3:
Input: @moves = ([0,0], [1,1], [2,0], [1,0], [1,2], [2,1], [0,1], [0,2], [2,2])
Output: Draw

Game Board:
[ A A B ]
[ B B A ]
[ A B A ]

Example 4:
Input: @moves = ([0,0], [1,1])
Output: Pending

Game Board:
[ A _ _ ]
[ _ B _ ]
[ _ _ _ ]

Example 5:
Input: @moves = ([1,1], [0,0], [2,2], [0,1], [1,0], [0,2])
Output: B

Game Board:
[ B B B ]
[ A A _ ]
[ _ _ A ]

Perl

I discovered when I tried to generate the game board with (['_','_','_']) x 3 I wound up not getting three lists, but the same list three times! Which meant when I tried making moves, they happened in all three rows at once. Changing emptyGameBoard to just explicitly have three separate lists fixed everything.

sub emptyGameBoard() {
  return [
    [ '_', '_', '_' ],
    [ '_', '_', '_' ],
    [ '_', '_', '_' ]
  ];
}

sub displayGameBoard(@board) {
  my $output = "Game Board:\n";
  foreach my $row (@board) {
    $output .= "[ " . join(' ', @$row) . " ]\n";
  }
  $output;
}

sub makeMove($letter, $move, $board) {
  my ($y,$x) = ($move->[0], $move->[1]);
  $board->[$y]->[$x] = $letter;
}

sub findWinner(@moves) {
  my $board = emptyGameBoard();

  my $letter = 'A';
  my $movecount = scalar(@moves);

  while (@moves) {
    my $move = shift @moves;
    makeMove($letter, $move, $board);
    $letter = ($letter eq 'A') ? 'B' : 'A';
  }

  # check rows
  for my $y (0..2) {
    return($board->[$y][0], displayGameBoard(@$board))
      if ($board->[$y][0] eq $board->[$y][1] eq $board->[$y][2])
      && $board->[$y][0] ne '_';
  }

  # check columns
  for my $x (0..2) {
    return($board->[0][$x], displayGameBoard(@$board))
      if ($board->[0][$x] eq $board->[1][$x] eq $board->[2][$x])
      && $board->[0][$x] ne '_';
  }

  # check diagonals
  return($board->[1][1], displayGameBoard(@$board))
    if (($board->[0][0] eq $board->[1][1] eq $board->[2][2])
     || ($board->[2][0] eq $board->[1][1] eq $board->[0][2]))
      && $board->[1][1] ne '_';

  # no winner
  return(
    $movecount < 9 ? 'Pending' : 'Draw',
    displayGameBoard(@$board)
  );
}

View the entire Perl script for this task on GitHub.

Python

After coding the Perl solution, the Python solution fell right into place. It’s fewer lines because indentation takes the place of block delimiters at the expense of readability.

def emptyGameBoard():
  return [
    [ '_', '_', '_' ],
    [ '_', '_', '_' ],
    [ '_', '_', '_' ]
  ]

def displayGameBoard(board):
  output = "Game Board:\n"
  for r in board:
    output += "[ " + " ".join(r) + " ]\n"
  return output

def makeMove(letter, move, board):
  y,x = move[0], move[1]
  board[y][x] = letter

def find_winner(moves):
  board = emptyGameBoard()

  letter = 'A'
  movecount = len(moves)
  while moves:
    move = moves.pop(0)
    makeMove(letter, move, board)
    letter = 'B' if letter == 'A' else 'A'

  # check rows
  for y in range(3):
    if (board[y][0] != '_' and
        (board[y][0] == board[y][1] == board[y][2])):
      return board[y][0], displayGameBoard(board)

  # check columns
  for x in range(3):
    if (board[0][x] != '_' and
        (board[0][x] == board[1][x] == board[2][x])):
      return board[0][x], displayGameBoard(board)

  # check diagonals
  if (board[1][1] != '_' and 
      ((board[0][0] == board[1][1] == board[2][2]) or
       (board[2][0] == board[1][1] == board[0][2]))):
    return board[1][1], displayGameBoard(board)

  # no winner
  return (
    'Pending' if movecount < 9 else 'Draw',
    displayGameBoard(board)
  )

View the entire Python script for this task on GitHub.

Elixir

Ok, the Elixir solution was a lot of fun, because I learned some things about the language. I started out in pretty familiar territory, recursively looping through the game board to display it…

def empty_game_board() do
  [
    [ "_", "_", "_" ],
    [ "_", "_", "_" ],
    [ "_", "_", "_" ]
  ]
end

def display_game_board([], output), do: output
def display_game_board([r | board], output) do
  display_game_board(board,
    output <> "\n[ " <> Enum.join(r, " ") <> " ]"
  )
end

def display_game_board(board) do
  display_game_board(board, "Game Board:")
end

But then to actually make the moves, I had to manipulate a list of lists. I found that Enum.at/3 could be used to get a row from the board, and then List.replace_at/3 could be used twice to change a value in that row and then to replace that row in the list of lists. Then I could write a recursive make_moves/3 function to loop through the moves and make the call to my make_move/3 function.

def make_move(letter, move, board) do
  y = List.first(move)
  x = List.last(move)
  List.replace_at(
    board, y,
    List.replace_at(
      Enum.at(board, y), x, letter
    )
  )
end

def make_moves([], _, board), do: board
def make_moves([move | moves], letter, board) do
  board = make_move(letter, move, board)
  letter = if letter == "A", do: "B", else: "A"
  make_moves(moves, letter, board)
end

When I finally got to the part where I was checking for a winner, I tried doing a three-way comparison the way I’ve done in all the other languages, x == y == z. But in Elixir, the == binary operator returns a boolean value, so you wind up comparing x == y, getting true, then comparing true == z… and unless z is the boolean truth value, the result will be false:

iex> 1 == 1
true
iex> 1 == 1 == 1
false
iex> 1 == 1 && 1 == 1
true

So… I decided to write a quick same/3 function that would accept three arguments, and then test each of them for equality to each other. While I was at it, I had the function do the test to see if the values being tested were equal to "_".

Then I also whipped up a at_2d/3 function to shorten the code needed to fetch a particular location on the board (from 18 characters down to 7 characters), and then whipped up check_rows/1, check_columns/2, and check_diagonals/1 functions to check for winners.

def same(x, y, z), do: x != "_" && x == y && y == z

def check_rows([]), do: {:error, :not_found}
def check_rows([row | board]) do
  if same(Enum.at(row, 0),
          Enum.at(row, 1),
          Enum.at(row, 2)) do
    {:ok, Enum.at(row, 0)} # winner
  else
    check_rows(board) # check next row
  end
end

def at_2d(board, y, x), do: Enum.at(Enum.at(board, y), x)

def check_columns(_, x) when x > 2, do: {:error, :not_found}
def check_columns(board, x) do
  if same(at_2d(board, 0, x),
          at_2d(board, 1, x),
          at_2d(board, 2, x)) do
    {:ok, at_2d(board, 0, x)} # winner
  else
    check_columns(board, x+1) # check next column
  end
end

def check_diagonals(board) do
  cond do
    same(at_2d(board, 0, 0),
         at_2d(board, 1, 1),
         at_2d(board, 2, 2)) ->
      {:ok, at_2d(board, 1, 1)} # winner
    same(at_2d(board, 2, 0),
         at_2d(board, 1, 1),
         at_2d(board, 0, 2)) ->
      {:ok, at_2d(board, 1, 1)} # winner
    true ->
      {:error, :not_found}
  end
end

Then comes the part I’m particularly proud about. Notice that each of the check functions above returns a {:ok, winner} tuple with an :ok atom and the winner if they succeed, and an {:error, :not_found} tuple with two atoms if they fail.

Late last week, my coworker Diego pointed out the following pattern he’d discovered in our Elixir code at work

with {:error, :not_found} <- find_data_in_db_one_way(args),
     {:error, :not_found} <- find_data_in_db_another_way(args) do
  insert_data_into_db(args)
else
  {:ok, data} -> data
end

If the first function call returns an {:error, :not_found} tuple, it calls the second function. If the second function returns an {:error, :not_found} tuple, it calls a function to insert the data into the DB and return the record with the data. If either of the functions returns a tuple with an :ok atom and the record with the data from the DB, it just falls through to the else clause that handles the success case. I knew immediately I wanted to use it, but I didn’t realize how quickly I would get to use it.

def check_for_winner(board, moves) do
  with {:error, :not_found} <- check_rows(board),
       {:error, :not_found} <- check_columns(board, 0),
       {:error, :not_found} <- check_diagonals(board) do
    if length(moves) < 9, do: "Pending", else: "Draw"
  else
    {:ok, winner} -> winner
  end
end

Then finally, we have the almost anticlimactic main function, which generates an empty game board, passes that to make_moves/3 with the list of moves and the starting player and assigns the result to a board label. The it returns a tuple of the winning player and a string representing the final state of the game board.

def find_winner(moves) do
  board = make_moves(moves, "A", empty_game_board())
  { check_for_winner(board, moves), display_game_board(board) }
end

And finally the housekeeping functions to display the “Input:” and “Output:” lines, and a helper function to render the list of moves appropriately.

def move_list(moves) do
  moves
  |> Enum.map(fn m -> "[#{List.first(m)},#{List.last(m)}]" end)
  |> Enum.join(", ")
end

def solution(moves) do
  IO.puts("Input: @moves = (#{move_list(moves)})")
  {winner, board} = find_winner(moves)
  IO.puts("Output: #{winner}\n\n#{board}")
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-335/packy-anderson