Perl Weekly Challenge: Compression and Matchsticks

Posted on by

I’m not really feeling music recently. I’m not feeling much of anything, but I need to do the challenge. So here’s Perl Weekly Challenge 296.

Task 1: String Compression

You are given a string of alphabetic characters, $chars.

Write a script to compress the string with run-length encoding, as shown in the examples.

A compressed unit can be either a single character or a count followed by a character.

BONUS: Write a decompression function.

Example 1

Input: $chars = "abbc"
Output: "a2bc"

Example 2

Input: $chars = "aaabccc"
Output: "3ab3c"

Example 3

Input: $chars = "abcc"
Output: "ab2c"

Approach

This is pretty simple: make a single pass over the string, character by character, keeping track of the last character seen, how many times that character was seen, and a result string. Populate the last character with the first character in the string, make the count 1, and then proceed through the rest of the string. If the current character is the same as the last character, increment the count and move on. If the current character is different, output the count followed by the last character to the result string, with the special case that if the count is 1, only output the character. Then replace the last character with the current character, reset the count to 1, and move on. At the end of the string, output the last character/count to the result string like we did while we were processing the string.

Decompression is even easier: if we get an alphabetic character, output it to the result. If we have a run of numeric characters, interpret that as a count, and output that many of the next alphabetic character found.

Raku

For the decode function, I decided to let Raku’s .comb routine do the heavy lifting for me. By having .comb match a run of numeric characters or a single alphabetic character. Then the processing just becomes pulling each element off the beginning of the resulting array and checking to see whether it’s a letter or a not.

sub rlEncode($str) {
  my @chars = $str.comb;
  my $last = @chars.shift;
  my $count = 1;
  my $result;
  for @chars -> $c {
    if ($c eq $last) { # same as last char,
      $count++;        # increment the count
    }
    else {
      if ($count > 1) {    # if the count > 1, include the
        $result ~= $count; # count in the encoded output
      }
      $result ~= $last; # add the last character to the output
      $last = $c; # make current char the last
      $count = 1; # and reset the count
    }
  }
  # encode the last run of characters in the string
  if ($count > 1) {
    $result ~= $count;
  }
  $result ~= $last;

  return $result;
}

sub rlDecode($str) {
  my @chars = $str.comb(/<digit>+|<alpha>/);
  my $result;
  while (my $c = @chars.shift) {
    if ($c ~~ /<alpha>/) { # it's an alphabetic character
      $result ~= $c;
    }
    else { # it's a numeric count
      my $count = $c;
      $c = @chars.shift; # get the next character
      $result ~= $c x $count;
    }
  }
  return $result;
}

View the entire Raku script for this task on GitHub.

$ raku/ch-1.raku
Example 1:
Input: $chars = "abbc"
Encoded: "a2bc"
Decoded: "abbc"

Example 2:
Input: $chars = "aaabccc"
Encoded: "3ab3c"
Decoded: "aaabccc"

Example 3:
Input: $chars = "abcc"
Encoded: "ab2c"
Decoded: "abcc"

Example 4:
Input: $chars = "abbbbbbbbbbbbccccccdd"
Encoded: "a12b6c2d"
Decoded: "abbbbbbbbbbbbccccccdd"

Perl

In Perl, I didn’t have something like .comb, so I just built the count character by character.

sub rlEncode($str) {
  my @chars = split //, $str;
  my $last = shift @chars;
  my $count = 1;
  my $result;
  foreach my $c ( @chars ) {
    if ($c eq $last) { # same as last char,
      $count++;        # increment the count
    }
    else {
      if ($count > 1) {    # if the count > 1, include the
        $result .= $count; # count in the encoded output
      }
      $result .= $last; # add the last character to the output
      $last = $c; # make current char the last
      $count = 1; # and reset the count
    }
  }
  # encode the last run of characters in the string
  if ($count > 1) {
    $result .= $count;
  }
  $result .= $last;

  return $result;
}

sub rlDecode($str) {
  my $result = '';
  my $count = '';
  foreach my $c (split //, $str) {
    if ($c =~ /\D/) { # it's an alphabetic character
      if ($count) { # if there's a count
        $result .= $c x $count; # output that many of this char
        $count = ''; # reset the count
      }
      else { # append character to output
        $result .= $c;
      }
    }
    else { # it's part of a numeric count
      $count .= $c;
    }
  }
  return $result;
}

View the entire Perl script for this task on GitHub.

Python

Because Python has slightly more typing than Raku or Perl, on lines 13 and 33 I had to make sure I was dealing with the count as a string and as a number to get the results I wanted.

def rlEncode(charstr):
  chars = [ c for c in charstr ]
  last = chars.pop(0)
  count = 1
  result = ''
  for c in chars:
    if c == last: # same as last char,
      count += 1  # increment the count
    else:
      if count > 1:          # if the count > 1, include the
        result += str(count) # count in the encoded output
      result += last # add the last character to the output
      last = c  # make current char the last
      count = 1 # and reset the count

  # encode the last run of characters in the string
  if count > 1:
    result += str(count)
  result += last

  return result

def rlDecode(charstr):
  result = ''
  count  = ''
  for c in charstr:
    if c.isnumeric():
      count += c
    else:
      if count: # if there's a count
        result += c * int(count) # output that many of this char
        count = '' # reset the count
      else: # append character to output
        result += c

  return result

View the entire Python script for this task on GitHub.

Elixir

Because it’s functional, Elixir required adjusting the approach a little, but not much. We’re still processing the strings character by character. But I did spin out the code to append to the result string into its own function so we can call it multiple times.

  def encodeLastCount(last, count, result) do
    if count > 1 do
      result <> to_string(count) <> last
    else
      result <> last
    end
  end

  def rlEncode([], last, count, result), do:
    encodeLastCount(last, count, result)

  def rlEncode(, last, count, result) do
    if c == last do
      # increment the count of times we saw this character
      rlEncode(rest, last, count + 1, result)
    else
      # make c the new last and 1 the new count
      rlEncode(rest, c, 1, encodeLastCount(last, count, result))
    end
  end

  def rlEncode(chars) do
    chars = String.graphemes(chars) # break string into chars
    [last | rest] = chars # grab the first character
    rlEncode(rest, last, 1, "") # start with that as last char
  end

  def addCharToResult(count, char, result) do
    count = if String.length(count) > 0 do
      # if there's a count, convert to int
      String.to_integer(count)
    else
      1 # empty count string means one char
    end
    result <> String.duplicate(char, count) # repeat the char
  end

  def rlDecode([], _, result), do: result

  def rlDecode([next | rest], count, result) do
    if Regex.match?(~r/\d/, next) do
      # it's a numeric char, add it to the count
      # and process the next character
      rlDecode(rest, count <> next, result)
    else
      # it's an alpha char, add it to the result
      rlDecode(rest, "", addCharToResult(count, next, result))
    end
  end

  def rlDecode(chars) do
    chars = String.graphemes(chars) # break string into chars
    rlDecode(chars, "", "")
  end

  def solution(chars) do
    IO.puts("Input: $chars = \"#{chars}\"")
    encoded = rlEncode(chars)
    IO.puts("Encoded: \"#{encoded}\"")
    decoded = rlDecode(encoded)
    IO.puts("Decoded: \"#{decoded}\"")
  end

View the entire Elixir script for this task on GitHub.

Task 2: Matchstick Square

You are given an array of integers, @ints.

Write a script to find if it is possible to make one square using the sticks as in the given array @ints where $ints[ì] is the length of ith stick.

Example 1

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

Top: $ints[1] = 2
Bottom: $ints[2] = 2
Left: $ints[3] = 2
Right: $ints[0] and $ints[4] = 2

Example 2

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

Example 3

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

Example 4

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

Approach

This should just be a math problem. If we sum up the ints and divide by 4, if we don’t get an integer result, we know we can’t create a square from the integers. But even if we get an integer result, we might not be able to make a square from the matches. Take example 3; it sums up to 12 unit lengths of matches, which divides evenly into a 3 unit length square, but none of the matches can be used to create a 3 unit length side.

So the approach is:

  • Sum the ints, divide by 4. If we get a non-integer result, fail early, because we can’t have fractional sticks.
  • Then loop through the list, seeing if we can build sides of the target length using the given match lengths.
  • If we can’t build four sides, fail. Otherwise, succeed.

Raku

The tricky part to this became exiting from the loop 

sub canBuildSquare(@ints) {
  my $side = @ints.sum / 4;
  return False, '-' unless $side == $side.Int;

  # sort the matches in descending length
  @ints = @ints.sort.reverse;

  # if the longest match is longer than the side length,
  # we can't build a square
  return False, '-' if @ints[0] > $side;

  my @sides = ( [], ); # start with one empty side

  while (True) {
    my @unused;
    for @ints -> $match {
      # this match can be added to other matches to make a side
      if ($match + @sides[*-1].sum <= $side) {
        @sides[*-1].push($match); # add to the matches for this side
        if (@sides[*-1].sum == $side && @sides.elems < 4) {
          # if we've made a complete side, and we have < 4 sides
          @sides.push([]); # add a new empty side
        }
      }
      else {
        @unused.push($match); # save match for later
      }
    }
    # exit the loop if we didn't use any matches,
    # or we've used ALL the matches
    if (@unused.elems == @ints.elems || @unused.elems == 0) {
      last;
    }
    # move the unused matches back to the list
    @ints = @unused;
  }

  if (@sides.elems == 4) {
    return True, @sides.map({ .join('+')}).join(', ');
  }
  return False, '-';
}

View the entire Raku script for this task on GitHub.

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

Example 2:
Input: @ints = (2, 2, 2, 4)
Output: False
Sides: -

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

Example 4:
Input: @ints = (3, 4, 1, 4, 3, 1)
Output: True
Sides: 4, 4, 3+1, 1+3

Example 5:
Input: @ints = (3, 4, 2, 4, 3)
Output: False
Sides: -

Perl

The big thing to note is that we need List::AllUtils’ sum0 function to get the same functionality as Raku’s built-in .sum.

use List::AllUtils qw( sum0 );

sub canBuildSquare(@ints) {
  my $side = sum0(@ints) / 4;
  return "False", '-' unless $side == int($side);

  # sort the matches in descending length
  @ints = reverse sort @ints;

  # if the longest match is longer than the side length,
  # we can't build a square
  return "False", '-' if $ints[0] > $side;

  my @sides = ( [], ); # start with one empty side

  while (true) {
    my @unused;
    foreach my $match ( @ints ) {
      # this match can be added to other matches to make a side
      if ($match + sum0(@{ $sides[-1] }) <= $side) {
        push @{ $sides[-1] }, $match; # add to the matches for this side
        if (sum0(@{ $sides[-1] }) == $side && @sides < 4) {
          # if we've made a complete side, and we have < 4 sides
          push @sides, []; # add a new empty side
        }
      }
      else {
        push @unused, $match; # save match for later
      }
    }
    # exit the loop if we didn't use any matches,
    # or we've used ALL the matches
    if (scalar(@unused) == scalar(@ints) || @unused == 0) {
      last;
    }
    # move the unused matches back to the list
    @ints = @unused;
  }

  if (@sides == 4) {
    return "True", join(', ', map { join('+', @$_) } @sides);
  }
  return "False", '-';
}

View the entire Perl script for this task on GitHub.

Python

xxx

def canBuildSquare(ints):
  side = sum(ints) / 4
  if side != int(side):
    return "False", '-'

  # sort the matches in descending length
  ints.sort(reverse = True)

  # if the longest match is longer than the side length,
  # we can't build a square
  if ints[0] > side:
    return "False", '-'

  sides = [ [], ]; # start with one empty side

  while True:
    unused = []
    for match in ints:
      # this match can be added to other matches to make a side
      if match + sum(sides[-1]) <= side:
        sides[-1].append(match) # add to the matches for this side
        if sum(sides[-1]) == side and len(sides) < 4:
          # if we've made a complete side, and we have < 4 sides
          sides.append([]) # add a new empty side
        usedSomeMatch = True
      else:
        unused.append(match) # save match for later

    # exit the loop if we didn't use any matches,
    # or we've used ALL the matches
    if len(ints) == len(unused) or len(unused) == 0:
      break

    # move the unused matches back to the list
    ints = unused

  if (len(sides) == 4):
    return "True", ', '.join([
      '+'.join([ str(m) for m in side] ) for side in sides
    ])

  return "False", '-'

View the entire Python script for this task on GitHub.

Elixir

As always, Elixir’s functional nature made me think a bit harder about things. I keep getting tripped up on not being able to modify values from within a statement without returning that value from the statement, hence the littering of label = if (condition) do (some operation on label) else label end throughout the code.

  def loopThroughMatches([], %{
    ints: ints, unused: unused, sides: sides
  } = data) do
    # return if we didn't use any matches,
    # or we've used ALL the matches
    if length(ints) == length(unused) or length(unused) == 0 do
      if length(sides) == 4 do # did we build 4 sides?
        {"True", sides}
      else
        {"False", '-'}
      end
    else
      # move the unused matches back to the list
      data = data
      |> Map.put(:ints, unused)
      |> Map.put(:unused, [])
      # loop through the remaining matches
      loopThroughMatches(unused, data)
    end
  end

  def loopThroughMatches([match | remaining], %{
    unused: unused, sideLen: sideLen, sides: sides
  } = data) do
    # this match can be added to other matches to make a side
    data = if match + Enum.sum(List.last(sides)) <= sideLen do
      # add to the matches for this side
      this_side = List.last(sides) ++ [ match ]
      # put this side back in the sides list
      sides = List.replace_at(sides, -1, this_side)
      # if we've made a complete side, and we have < 4 sides
      sides =
      if Enum.sum(this_side) == sideLen and length(sides) < 4 do
        sides ++ [ [] ] # add a new empty side
      else
        sides
      end
      Map.put(data, :sides, sides)
    else
      unused = unused ++ [ match ] # save match for later
      Map.put(data, :unused, unused)
    end
    loopThroughMatches(remaining, data)
  end

  def canBuildSquare(ints, sideLen) do
    data = %{
      ints: ints,
      unused: [],
      sideLen: sideLen,
      sides: [ [] ] # start with one empty side
    }
    loopThroughMatches(ints, data)
  end

  def canBuildSquare(ints) do
    # find the length of the sides of a square
    sideLen = Enum.sum(ints) / 4

    # sort the matches in descending length
    ints = Enum.sort(ints, &(&1 >= &2))

    {result, sides} = cond do
      # sides aren't integer length
      sideLen != Float.floor(sideLen) ->
        {"False", '-'}

      # if the longest match is longer than the side length,
      # we can't build a square
      List.first(ints) > sideLen ->
        {"False", '-'}

      # build sides from the matches
      true -> canBuildSquare(ints, sideLen)
    end

    {
      result,
      if result == "True" do
        Enum.map(sides, fn matches ->
          Enum.join(matches, "+")
        end)
        |> Enum.join(", ")
      else
        sides
      end
    }
  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-296/packy-anderson

Leave a Reply