Perl Weekly Challenge: A heaven on earth, they call it Base-N Street

Posted on by

Perl Weekly Challenge 384‘s tasks are “Base N” and “Special Binary Substrings”.

I asked my wife about the music, and she said “Base N? Basin. Basin Street Blues.” So I went on a journey down a rabbit hole of an old jazz/blues standard. I picked the Ella Fitzgerald & Louis Armstrong version to play here.

Task 1: Base N

You are given a number and a base integer.

Write a script to convert the given number in the given base integer.

Example 1

Input: $num = 42, $base = 2
Output: 101010

Example 2

Input: $num = 15642094, $base = 16
Output: EEADEE

Example 3

Input: $num = 493, $base = 8
Output: 755

Example 4

Input: $num = 2228519, $base = 36
Output: 1BRJB

Base 36 uses numbers 0-9 and letters A-Z.

Example 5

Input: $num = 123456789, $base = 64
Output: 7MyqL

Base 64 (using 0-9, A-Z, a-z, and extra symbols like + and /)

Approach

I figure using the built-in functions to do this would be cheating. 🙁

So the core of converting numbers into base N is generating the powers of N until we generate a power greater than the number we’re converting, then integer divide the number by the largest power (yielding the value of the digit in that place), and then dividing the remainder by the next lowest digit, and so on until we divide the last remainder by N0.

According to the Wikipedia article on Base64, RFC 4648 says base64 characters are A-Za-z0-9+/, but I guess we’re using 0-9A-Za-z+/.

Raku

One of the things I was particularly chuffed about was being able to specify the of characters we’re using as (0…9,'A'…'Z','a'…'z','+','/'). I’m using unshift to put the powers into the list so the front of the list has the largest power (most significant digit), so I’m able to loop through the list when I need it. Another thing is that I’m really enamored of Python’s divmod(a, b) function, so I call div and % in a tuple so the results occur in the same line. If I were going to use it more often than just once, I’d declare a helper function.

sub baseN($num is copy, $base) {
  my @chars = (0...9,'A'...'Z','a'...'z','+','/')[0..$base-1];
  my @powers;
  my $pow = 0;
  while ($base ** $pow < $num) {
    unshift @powers, $base ** $pow++;
  }
  my ($result, $d);
  for @powers -> $pow {
    ($d, $num) = ($num div $pow, $num % $pow);
    $result ~= @chars[$d];
  }
  $result;
}

View the entire Raku script for this task on GitHub.

$ raku/ch-1.raku
Example 1:
Input: $num = 42, $base = 2
Output: 101010

Example 2:
Input: $num = 15642094, $base = 16
Output: EEADEE

Example 3:
Input: $num = 493, $base = 8
Output: 755

Example 4:
Input: $num = 2228519, $base = 36
Output: 1BRJB

Example 5:
Input: $num = 123456789, $base = 64
Output: 7MyqL

Perl

As usual, the Perl solution looks a lot like the Raku solution. Really, the big difference is that Perl doesn’t have an integer division operator, so we have to implement it as int($num / $pow), which yields a floating point result and then truncates it to an integer.

sub baseN($num, $base) {
  my @chars = (0..9,'A'..'Z','a'..'z','+','/')[0..$base-1];
  my @powers;
  my $pow = 0;
  while ($base ** $pow < $num) {
    unshift @powers, $base ** $pow++;
  }
  my ($result, $d);
  for my $pow ( @powers ) {
    ($d, $num) = (int($num / $pow), $num % $pow);
    $result .= $chars[$d];
  }
  $result;
}

View the entire Perl script for this task on GitHub.

Python

Rather than generate the list of characters each time we call the function, I did it once up front, mostly because there isn’t an easy way to generate a range of characters in Python, so I used list reflection on ranges of numbers and appended them into a single list.

I could have used powers.insert(0, base ** pow) to do the same thing as Raku/Perl’s unshift, but instead I decided to just append it to the end of the list and just reverse it when I’m done.

And, of course, I love Python’s divmod(a, b) function for returning both the quotient and remainder of an integer division operation.

chars = (
  [chr(i) for i in range(ord('0'),ord('9')+1)] +
  [chr(i) for i in range(ord('A'),ord('Z')+1)] +
  [chr(i) for i in range(ord('a'),ord('z')+1)] +
  [ '+', '/' ]
)

def base_n(num, base):
  powers = []
  pow = 0
  while base ** pow < num:
    powers.append(base ** pow)
    pow += 1
  powers.reverse() # reverse the power list in place
  result = ''
  for pow in powers:
    (d, num) = divmod(num, pow)
    result += chars[d]
  return result

View the entire Python script for this task on GitHub.

Elixir

In the Elixir solution, I decided to declare the character list as a compile-time constant (lines 4-7). As usual with Elixir, I tried to pipe the output of one statement into the next: the Enum.reduce_while/3 (lines 10-17) which calculates the power list which produces a reverse-sorted list of powers of base, which then feeds into Enum.reduce/3 (lines 18-21) that then uses an accumulator of a tuple { num, result } to build the string version of the base N number, and because Enum.reduce/3 yields that accumulator, that feeds into Kernel.then/2 (line 22) to strip off the num value from the tuple using Tuple.elem/2.

The Kernel.div/2 and Kernel.rem/2 calls aren’t functions, they’re guards.

@chars Enum.to_list(?0..?9) ++
       Enum.to_list(?A..?Z) ++
       Enum.to_list(?a..?z) ++
       [ ?+, ?/ ] |> Enum.map(&( <<&1 :: utf8>> ))

def base_n(num, base) do
  Enum.reduce_while(0..64, [], fn p, powers ->
    pow = Integer.pow(base, p)
    if pow < num do
      {:cont, [pow] ++ powers}
    else
      {:halt, powers}
    end
  end)
  |> Enum.reduce({num, ""}, fn pow, {num, result} ->
    { d, num } = { div(num,pow), rem(num, pow) }
    { num, result <> Enum.at(@chars, d) }
  end)
  |> then( &( elem(&1, 1) ) )
end

View the entire Elixir script for this task on GitHub.

Task 2: Special Binary Substrings

You are given a binary string.

Write a script to return all non-empty substrings (distinct) that have the same number of 0’s and 1’s, and all the 0’s and all the 1’s in these substrings are grouped consecutively.

Example 1

Input: $binary = "0101"
Output: ("01", "10")

Example 2

Input: $binary = "000111"
Output: ("000111", "0011", "01")

Example 3

Input: $binary = "000011"
Output:  ("0011", "01")

Example 4

Input: $binary = "10011100"
Output: ("10", "0011", "01", "1100")

Example 5

Input: $binary = "00000"
Output: ()

Approach

I’ve been backfilling challenges that I missed while my mother was in the hospital, so to me, PWC 297 Task 1 is only about a month ago. That task was similar: substrings of binary strings and equal numbers of 1’s and 0’s. This just has the added wrinkle of wanting the 1’s and 0’s to be grouped consecutively. So we’re going to do what we did last week with similar lists; check criteria to fail a substring for inclusion in the output:

  • Sum the digits; if an n digit string doesn’t sum to n/2, it doesn’t have equal numbers of 1’s and 0’s.
  • Remove all the 0’s from either the front or the back of the string (but not both). If the string isn’t entirely 1’s, it didn’t have all those 0’s consecutively.

Raku

I’m using Str.subst as a non-destructive regex substitution so I can remove the 0’s from either the front or the back without changing the string itself. By using a hash to keep track of substrings we’ve already checked and then at the end, use the keys to produce the list of substrings, we also get distinct results. By sorting the results, we get consistent output.

sub specialBinarySubstrings($binary) {
  my @arr = $binary.comb;
  # special case: all 0s or all 1s
  my $len = @arr.elems;
  my $sum = @arr.sum;
  return () if $sum == 0 || $sum == $len;
  my %seen; # keep track of substrings already checked
  # generate substrings and check
  for 0 .. @arr.end - 1 -> $i {
    for $i + 1 .. @arr.end -> $j {
      my @subarr = @arr[$i .. $j];
      my $substr = @subarr.join;
      next if %seen{$substr}:exists;
      if (@subarr.sum == @subarr.elems/2) { # equal num 0 & 1
        if ($substr.subst(/^0+/, "") ~~ /^1+$/ ||
            $substr.subst(/0+$/, "") ~~ /^1+$/) { # consecutive
          %seen{$substr} = True;
          next;
        }
      }
      %seen{$substr} = False;
    }
  }
  %seen.keys.grep({ %seen{$_} }).sort;
}

View the entire Raku script for this task on GitHub.

$ raku/ch-2.raku
Example 1:
Input: $binary = "0101"
Output: ("01", "10")

Example 2:
Input: $binary = "000111"
Output: ("000111", "0011", "01")

Example 3:
Input: $binary = "000011"
Output: ("0011", "01")

Example 4:
Input: $binary = "10011100"
Output: ("0011", "01", "10", "1100")

Example 5:
Input: $binary = "00000"
Output: ()

Perl

The Perl solution is very much like the Raku solution. /r is a modifier that’s easy to overlook in perlre: “perform non-destructive substitution and return the new value”.

use List::AllUtils qw( sum );

sub specialBinarySubstrings($binary) {
  my @arr = split //, $binary;
  # special case: all 0s or all 1s
  my $len = @arr;
  my $sum = sum @arr;
  return () if $sum == 0 || $sum == $len;
  my %seen; # keep track of substrings already checked
  # generate substrings and check
  for my $i ( 0 .. $#arr - 1 ) {
    for my $j ( $i + 1 .. $#arr ) {
      my @subarr = @arr[$i .. $j];
      my $substr = join '', @subarr;
      next if exists $seen{$substr};
      if (sum(@subarr) == scalar(@subarr)/2) { # equal num 0 & 1
        if (($substr =~ s/^0+//r) =~ /^1+$/ ||
            ($substr =~ s/0+$//r) =~ /^1+$/) { # consecutive
          $seen{$substr} = 1;
          next;
        }
      }
      $seen{$substr} = 0;
    }
  }
  sort grep { $seen{$_} } keys %seen;
}

View the entire Perl script for this task on GitHub.

Python

There’s not much that changes in the Python version, but I need to remember that range returns a sequence that goes up to but does not include the stop value. Oh, and I need to remember to convert values from characters to numbers if I’m going to be summing them.

import re

def special_binary_substrings(binary):
  arr = [ int(d) for d in binary ]
  # special case: all 0s or all 1s
  alen = len(arr)
  asum = sum(arr)
  if asum == 0 or asum == alen: return []

  seen = {} # keep track of substrings already checked
  # generate substrings and check
  for i in range(alen):
    for j in range(i+1, alen+1):
      subarr = arr[i:j]
      substr = ''.join([str(c) for c in subarr])
      if substr in seen: continue
      if (sum(subarr) == len(subarr)/2): # equal num 0 & 1
        if (re.match(r'^1+$', re.sub(r'^0+','',substr)) or
            re.match(r'^1+$', re.sub(r'0+$','',substr))):
          # consecutive
          seen[substr] = True
          continue
      seen[substr] = False
  return sorted([ k for k in seen.keys() if seen[k] ])

View the entire Python script for this task on GitHub.

Elixir

Elixir doesn’t change much from the Python version: we still have to convert between chars and numerics, we still have to push regular expressions through functions to get replacements or matches.

def rematch?(re, substr), do:
  Regex.match?(~r/^1+$/, Regex.replace(re, substr, ""))

def special_binary_substrings(binary) do
  arr = String.codepoints(binary)
  |> Enum.map(&( String.to_integer(&1) ))
  len = length(arr)
  sum = Enum.sum(arr)
  cond do
    # special case: all 0s or all 1s
    sum == 0 or sum == len -> []
    true ->
      Enum.reduce(0 .. len-1, %{}, fn i, seen ->
        Enum.reduce(i+1 .. len, seen, fn j, seen ->
          subarr = Enum.slice(arr, i..j)
          substr = Enum.map(subarr, &( Integer.to_string(&1) ))
          |> Enum.join
          if Map.has_key?(seen, substr) do
            seen
          else
            if Enum.sum(subarr) == length(subarr)/2 do
              # equal num 0 & 1
              cond do
                rematch?(~r/^0+/, substr) or
                rematch?(~r/0+$/, substr) ->
                  Map.put(seen, substr, true) # consecutive
                true -> Map.put(seen, substr, false)
              end
            else
              Map.put(seen, substr, false)
            end
          end
        end)
      end)
      |> Map.filter(fn {_k, v} -> v end)
      |> Map.keys
      |> Enum.sort
  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/challenge-384-packy-anderson/challenge-384/packy-anderson

Leave a Reply