Perl Weekly Challenge: So many strings I was searching…

Posted on by

Perl Weekly Challenge 399‘s tasks are “Longest Repeating Character” and “Longest Absolute Path”.

Unfortunately, I already used Billy Joel’s “The Longest Time” last year with PWC 346, so I consulted with my wife and she suggested George Harrison’s song Long Long Long from The Beatles’ White Album…

Task 1: Longest Repeating Character

You are given a string str and an integer k > 0.

Write a script to choose any character of str and change it to another character. You may perform this operation up to k times. Return the length of the longest reachable substring of a single letter.

Example 1

Input: $str = "AAAAA", $k = 2
Output: 5

Every character in the string is already the same letter "A".
The maximum operations allowed (k = 2) do not even need to be used.
The entire string of length 5 is already the longest valid substring.

Example 2

Input: $str = "ABCDE", $k = 4
Output: 5

All 5 characters in the string are distinct.
The most frequent character occurs only 1 time.
To turn the entire string into a single repeated character, we need to replace 5 - 1 = 4 characters.
Since k = 4, we can replace "B","C","D", and "E" with "A" to form "AAAAA".

Example 3

Input: $str = "AAABBBBAA", $k = 1
Output: 5

If we target "A", we could change the "B" in "AAAB" (k=1 replacement) to get length 4 ("AAAA").
If we target "B", we can pick the substring "BBBBA" and change the single trailing "A" to "B" (k=1 replacement) to form "BBBBB", which gives a length of 5.
Targeting "B" gives better result than targeting "A".

Example 4

Input: $str = "ABACADA", $k = 2
Output: 5

Look at the substring [0..4] which is "ABACA" (length 5).
In this window, "A" appears 3 times, and there are 2 non-"A" characters ("B" and "C").
With k = 2, we can replace "B" and "C" with "A" to form "AAAAA".

Look at the substring [2..6] which is "ACADA" (length 5).
Here, "A" appears 3 times, and non-"A" characters ("C" and "D") count to 2.
Replacing them gives "AAAAA".

In both cases, the maximum valid length is 5.

Example 5

Input: $str = "BAAABAAAA", $k = 1
Output: 8

The string has two groups of "A"s separated by a single "B" ("AAABAAAA").

We can replace the character 4 "B" with an "A" to get a sequence of 8 "A".

Approach

I’m sure there’s some clever way to complete this task, but I’m not going to attempt it. I’m going to attack this straight on.

First, I’m going to take the string and divide it into substrings of a single letter. To do this, I’m going to use a regular expression that matches a single character and then zero or more of that character following it. In PCRE, that’s /((.)\g-1*)/. It’s going to provide two matches for each substring: the substring, and the single character that makes up that substring. We’ll repeat the match over the entire string, and we’ll dispose of the single character matches when we’re building a list of substrings. To make it easier to follow, I’m going to separate that functionality off into a substrings() function.

Then we’ll handle the two special stopping cases: either k is zero, and we don’t get to make any changes, or there’s only one substring because the input string is already a single repeated character. In either case, we just return the length of the longest substring.

Then we need to loop over the substrings and make substitutions. If substrings() returned four substrings, we can atttempt to shift characters from adjacent substrings three times, but we can do it in two directions. I’m writing two functions, shiftRight() and shiftLeft(), that will do the following: given a list of n substrings, and a position of 0 to n-1 of a gap between substrings, it will take a character off substrings on one side of the gap and add a character on the other side. So the call shiftRight(1, ["AAA", "BBB", "CCC"]) will target the gap between the "BBB" and "CCC" substrings, add an extra B to the second substring, and take away a C from the third substring. It will then join them together and produce the string "AAABBBBCC", thus shifting a character right. The shiftLeft() function will do the same operation in the other direction (shiftLeft(1, ["AAA", "BBB", "CCC"]) will yield "AAABBCCCC").

Once we’ve generated these new strings, I’ll call my function recursively while decrementing k; if k becomes zero (or we wind up converting the entiere string), we’ll return early with the length of the longest substring, otherwise we’ll repeat the operation until we exhaust k attempts.

Raku

I wanted some way of making shiftRight and shiftLeft share code, and it’s a bit rough, but it feels better than just copy/pasting one of them and then tweaking the values (which is what I did initially).

The substrings() function was easy, because the stringification of the match objects produced by the global match is just the outer capture of each match.

sub substrings($str) { ($str ~~ m:g/((.)$0*)/).map: *.Str; }

sub shiftRight($i, @str) {
  # replace the first character of the ($i+1)th string
  # with the first character of the ($i)th string
  shiftChar($i, "r", @str)
}

sub shiftLeft($i, @str) {
  # replace the last character of the ($i)th string
  # with the first character of the ($i+1)th string
  shiftChar($i, "l", @str)
}

sub shiftChar($i, $dir, @str) {
  my $newstr;
  my $s = $dir eq "r" ?? $i !! $i-1;
  for 0..$s -> $j { $newstr ~= @str[$j]; }
  if ($dir eq "r") {
    $newstr ~= @str[$i].substr(0,1) ~ @str[$i+1].substr(1);
  }
  else {
    $newstr ~= @str[$i].substr(1) ~ @str[$i+1].substr(0,1);
  }
  for $i+2..@str.end -> $j { $newstr ~= @str[$j]; }
  $newstr;
}

sub longestRepeatingCharacter($str, $k) {
  # gather the substrings
  my @subs = substrings($str);

  # no more substitutions or only one substring
  if ($k == 0 || @subs.elems == 1) {
    return @subs.map(*.chars).max;
  }

  # make new substrings recursively
  my (%longest, $newstr);
  for 0..(@subs.end -1) -> $i {
    $newstr = shiftRight($i, @subs);
    %longest{$newstr} = longestRepeatingCharacter($newstr, $k-1);
    $newstr = shiftLeft($i, @subs);
    %longest{$newstr} = longestRepeatingCharacter($newstr, $k-1);
  }
  %longest.values.max;
}

View the entire Raku script for this task on GitHub.

$ raku/ch-1.raku
Example 1
Input: $str = "AAAAA", $k = 2
Output: 5

Example 2
Input: $str = "ABCDE", $k = 4
Output: 5

Example 3
Input: $str = "AAABBBBAA", $k = 1
Output: 5

Example 4
Input: $str = "ABACADA", $k = 2
Output: 5

Example 5
Input: $str = "BAAABAAAA", $k = 1
Output: 8

Perl

The substrings() function is a bit more complicated in Perl, because each match yielded a list of the substring and the character that comprises the substring. So, for instance, "AAABBBBAA" yielded the list ["AAA", "A", "BBBB", "B", "AA", "A"]. I wound up grepping through the list and keeping the even results.

use List::AllUtils qw( max );

sub substrings($str) {
  # gather the substrings
  my @subs = $str =~ m/((.)\g-1*)/g;

  # keep only the substrings (the first match),
  # not the single char char (the second match)
  @subs[grep { $_ % 2 == 0 } 0..$#subs];
}

sub shiftRight($i, @str) {
  # replace the first character of the ($i+1)th string
  # with the first character of the ($i)th string
  shiftChar($i, "r", @str)
}

sub shiftLeft($i, @str) {
  # replace the last character of the ($i)th string
  # with the first character of the ($i+1)th string
  shiftChar($i, "l", @str)
}

sub shiftChar($i, $dir, @str) {
  # replace the last character of the ($i)th string
  # with the first character of the ($i+1)th string
  my $newstr;
  my $s = $dir eq "r" ? $i : $i-1;
  for my $j ( 0..$s ) { $newstr .= $str[$j]; }
  if ($dir eq "r") {
    $newstr .= substr($str[$i],0,1) . substr($str[$i+1],1);
  }
  else {
    $newstr .= substr($str[$i],1) . substr($str[$i+1],0,1);
  }
  for my $j ( $i+2..$#str ) { $newstr .= $str[$j]; }
  $newstr;
}

sub longestRepeatingCharacter($str, $k) {
  # gather the substrings
  my @subs = substrings($str);

  # no more substitutions or only one substring
  if ($k == 0 || @subs == 1) {
    return max map { length($_) } @subs;
  }

  # make new substrings recursively
  my (%longest, $newstr);
  for my $i ( 0..($#subs -1) ) {
    $newstr = shiftRight($i, @subs);
    $longest{$newstr} = longestRepeatingCharacter($newstr, $k-1);
    $newstr = shiftLeft($i, @subs);
    $longest{$newstr} = longestRepeatingCharacter($newstr, $k-1);
  }
  max values %longest;
}

View the entire Perl script for this task on GitHub.

Python

The substrings() function in Python was a bit easier than in Perl, in that the re.findall call returned a list of match objects, and I was able to reflect over the list and pull out just the outer matches. I also found that a named match worked better than trying to refer to the previous positional match, but I didn’t carry that back to other solutions.

def substrings(string):
  # gather the substrings
  matches = re.findall(r"((?P<char>.)(?P=char)*)", string)

  # keep only the substrings (the first match),
  # not the single char char (the second match)
  return [ x[0] for x in matches ]

def shift_right(i, strings):
  # replace the first character of the ($i+1)th string
  # with the first character of the ($i)th string
  return shift_char(i, "r", strings)

def shift_left(i, strings):
  # replace the last character of the ($i)th string
  # with the first character of the ($i+1)th string
  return shift_char(i, "l", strings)

def shift_char(i, dir, strings):
  # replace the last character of the ($i)th string
  # with the first character of the ($i+1)th string
  newstr = ""
  s = i+1 if dir == "r" else i
  e = i+2 if dir == "r" else i+1
  for j in range(0, s): newstr += strings[j]
  if dir == "r":
    newstr += strings[i][0:1] + strings[i+1][1:]
  else:
    newstr += strings[i][1:] + strings[i+1][0:1]
  for j in range(e, len(strings)): newstr += strings[j]
  return newstr

def longest_repeating_character(string, k):
  # gather the substrings
  subs = substrings(string)

  # no more substitutions or only one substring
  if k == 0 or len(subs) == 1:
    return max([ len(s) for s in subs ])

  # make new substrings recursively
  longest = {}
  for i in range(0, len(subs)-1):
    newstr = shift_right(i, subs)
    longest[newstr] = longest_repeating_character(newstr, k-1)
    newstr = shift_left(i, subs)
    longest[newstr] = longest_repeating_character(newstr, k-1)
  return max(longest.values())

View the entire Python script for this task on GitHub.

Elixir

One of the big differences in my Elixir solution is I’m trying to follow the Elixir style guide we use at my day job. The other thing is I’m using Elixir’s mix format command to format the code so it’s consistently formatted. I’m not fond of the style guide’s requirement that I use parens for one-arity functions in pipes, but I understand the idea that the parenthesis make it clear that these are function calls, so I’m accepting it. I’m also adding docstrings to some of my functions where I would otherwise add comments.

One of the other things I’m doing is in the shift_char() function, I’m passing in Atoms (Elixir constants) instead of strings, since I’m not printing these values.

import Enum

@doc """
Extract all the substrings made up of the same character
"""
def substrings(str) do
  ~r/((.)\g-1*)/
  |> Regex.scan(str)
  |> map(&List.first!(&1))
end

@doc """
replace the first character of the ($i+1)th string
with the first character of the ($i)th string
"""
def shift_right(i, strings), do: shift_char(i, :r, strings)

@doc """
replace the last character of the ($i)th string
with the first character of the ($i+1)th string
"""
def shift_left(i, strings), do: shift_char(i, :l, strings)

defp shift_char(i, dir, strings) do
  s = if dir == :r, do: i, else: i - 1

  Range.new(0, s, 1)
  |> reduce("", fn j, newstr -> newstr <> at(strings, j) end)
  |> then(
    &(&1 <>
        case dir do
          :r -> String.slice(at(strings, i), 0..0)
          :l -> String.slice(at(strings, i), 1..-1//1)
        end)
  )
  |> then(
    &(&1 <>
        case dir do
          :r -> String.slice(at(strings, i + 1), 1..-1//1)
          :l -> String.slice(at(strings, i + 1), 0..0)
        end)
  )
  |> then(
    &(Range.new(i + 2, length(strings) - 1, 1)
      |> reduce(&1, fn j, newstr ->
        newstr <> at(strings, j)
      end))
  )
end

def longest_repeating_character(str, k) do
  # gather the substrings
  subs = substrings(str)

  if k == 0 or length(subs) == 1 do
    # no more substitutions or only one substring
    subs
    |> map(&String.length(&1))
    |> max()
  else
    # shorten long name
    lrc = &longest_repeating_character/2

    # make new substrings recursively
    Range.new(0, length(subs) - 2, 1)
    |> reduce(%{}, fn i, longest ->
      newstr = shift_right(i, subs)

      longest = Map.put(longest, newstr, lrc.(newstr, k - 1))

      newstr = shift_left(i, subs)

      Map.put(longest, newstr, lrc.(newstr, k - 1))
    end)
    |> Map.values()
    |> max()
  end
end

View the entire Elixir script for this task on GitHub.

Task 2: Longest Absolute Path

You are given a filesystem as string.

Write a script to return the length of the longest absolute path to a file in the abstracted file system. If there is no file in the system, return 0.

dir
- subdir1
  - file1.ext
  - subsubdir1
- subdir2
  - subsubdir2
    - file2.ext

The above filesystem can be represented as below:

"dir\n\tsubdir1\n\t\tfile1.ext\n\t\tsubsubdir1\n\tsubdir2\n\t\tsubsubdir2\n\t\t\tfile2.ext"

Example 1

Input: $fs = "dir\n\tsubdir1\n\t\tsubsubdir1\n\tsubdir2"
Output: 0

There are no files in the system (a file must contain a . character separating a name and extension).
Since there are no files, the answer is 0.

Example 2

Input: $fs = "file1.txt\nfile2.ext\na.png"
Output: 9

All entries are located at root depth (0 tabs).
Found File Paths:
    "file1.txt" (length = 9)
    "file2.ext" (length = 9)
    "a.png"     (length = 5)
The longest absolute file path length is 9.

Example 3

Input: $fs = "my documents\n\tproject v1.0\n\t\tnotes v1.txt\n\timage.png"
Output: 38

Notice project v1.0 is a directory (it has children beneath it), while notes v1.txt and image.png are files.
Found File Paths:
    "my documents/project v1.0/notes v1.txt" (length = 38)
    "my documents/image.png" (length = 22)
The maximum absolute length is 38.

Example 4

Input: $fs = "root\n\ta\n\t\tb\n\t\t\tc.txt\n\td\n\t\te.txt"
Output: 14

Found File Paths:
    "root/a/b/c.txt" => 4 + 1 + 1 + 1 + 1 + 1 + 5 = 14
    "root/d/e.txt"   => 4 + 1 + 1 + 1 + 5 = 12
The longest file path is "root/a/b/c.txt" with length 14.

Example 5

Input: $fs = "a\n\tb\n\t\tc\n\t\t\td\n\t\t\t\te.txt\n\tvery_long_directory_name\n\t\tf.txt"
Output: 32

Found File Paths:
    "a/b/c/d/e.txt" => 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 5 = 13
    "a/very_long_directory_name/f.txt" => 1 + 1 + 24 + 1 + 5 = 32
The long directory name compensates for depth, giving a max length of 32.

Approach

Really, this is another “find the longest string” problem. The big difference is how we’re building the strings.

The first step is to split the $fs string on the newline characters, so we have a list of directory entries. Then we loop through the entries and figure out how where in the directory structure they fall. Entries that are under subdirectories are indicated with tab characters, so an entry with one tab character is a child of the last entry with no tab characters, and entry with two tab characters is a child of the last entry with one tab character, and so on. Entries with no tabs are top-level entries.

So the first step when examining an entry is to count the number of tab characters it has. If it has none, it’s a top-level entry and we put it on two lists: a level list indicating the last entry with no tab characters, and we add it to a list of files… if it contains a . character separating a name and an extension (I’m saying that the extension must be at the end of the entry). If there are tabs in the entry, we strip them from the entry (because we’ve already counted them) and we then find the value of level for the number of tabs minus 1 and we concatenate the two entries together to yield a full path name. Then we check to see if the previous files entry is a parent to this current entry. If it is, remove that previous entry from files because it’s a directory, not a file.

Then, once we’ve developed a list of files, we find the longest entry and return its length.

Raku

I was hoping I could use the Str.trans method to count the occurences of tabs the way I knew tr/\t// could in Perl, but I couldn’t figure out how to make that work, so I took advantage of Str.indices returning a list of all offsets in the string where the needle was found, and just counted the elements in the list. Initially, I was using @level[$deep-1] three places on lines 12, 13, and 14, but then I realized saving the value in a $dir variable made the code a lot more readable.

sub longestAbsolutePath($fs) {
  my (@files, @level, $explain);
  my @entries = $fs.split("\n");
  for @entries <-> $entry {
    my $deep = $entry.indices("\t").elems; # count the tabs
    if ($deep > 0) {
      $entry ~~ s:g/\t//; # eliminate the tabs
      my $dir = @level[$deep-1];
      $entry = ($dir, $entry).join("/");
      if (@files.elems > 0 && $dir eq @files[*-1]) {
        $explain ~= qq|"{$dir}" is a directory |
                 ~ "(it has children beneath it).\n";
        @files.pop;
      }
    }
    @level[$deep] = $entry;
    @files.push($entry) if $entry ~~ m|<-[/]>+\.<-[/]>+$|;
  }
  if (@files.elems == 0) {
    return
      0,
      "There are no files in the system (a file must contain " ~
      "a . character\nseparating a name and extension).\n" ~
      "Since there are no files, the answer is 0.";
  }
  $explain ~= "Found File Paths:\n";
  $explain ~= @files.map({
    qq|    "$_" (length {$_.chars})|
  }).join("\n");
  return @files.map( *.chars ).max, $explain;
}

View the entire Raku script for this task on GitHub.

$ raku/ch-2.raku
Example 1
Input: $fs = "dir\n\tsubdir1\n\t\tsubsubdir1\n\tsubdir2"
Output: 0

There are no files in the system (a file must contain a . character
separating a name and extension).
Since there are no files, the answer is 0.

Example 2
Input: $fs = "file1.txt\nfile2.ext\na.png"
Output: 9

Found File Paths:
    "file1.txt" (length 9)
    "file2.ext" (length 9)
    "a.png" (length 5)

Example 3
Input: $fs = "my documents\n\tproject v1.0\n\t\tnotes v1.txt\n\timage.png"
Output: 38

"my documents/project v1.0" is a directory (it has children beneath it).
Found File Paths:
    "my documents/project v1.0/notes v1.txt" (length 38)
    "my documents/image.png" (length 22)

Example 4
Input: $fs = "root\n\ta\n\t\tb\n\t\t\tc.txt\n\td\n\t\te.txt"
Output: 14

Found File Paths:
    "root/a/b/c.txt" (length 14)
    "root/d/e.txt" (length 12)

Example 5
Input: $fs = "a\n\tb\n\t\tc\n\t\t\td\n\t\t\t\te.txt\n\tvery_long_directory_name\n\t\tf.txt"
Output: 32

Found File Paths:
    "a/b/c/d/e.txt" (length 13)
    "a/very_long_directory_name/f.txt" (length 32)

Perl

In Perl, I was able to use the transliteration quote-like operator to quickly count the tabs and eliminate them at the same time!

use List::AllUtils qw( max );

sub longestAbsolutePath($fs) {
  my (@files, @level, $explain);
  for my $entry (split /\n/, $fs) {
    my $deep = $entry =~ tr/\t//d; # count and eliminate tabs
    if ($deep > 0) {
      my $dir = $level[$deep-1];
      $entry = join "/", $dir, $entry;
      if (@files > 0 && $dir eq $files[-1]) {
        $explain .= qq|"@{[$dir]}" is a directory |
                 . "(it has children beneath it).\n";
        pop @files;
      }
    }
    $level[$deep] = $entry;
    push @files, $entry if $entry =~ m|[^/]+\.[^/]+$|;
  }
  if (@files == 0) {
    return
      0,
      "There are no files in the system (a file must contain " .
      "a . character\nseparating a name and extension).\n" .
      "Since there are no files, the answer is 0.";
  }
  $explain .= "Found File Paths:\n";
  $explain .= join "\n", map {
    qq|    "$_" (length @{[length $_]})|
  } @files;
  return max(map { length($_) } @files), $explain;
}

View the entire Perl script for this task on GitHub.

Python

In Python, the str.count() method allowed us to count the tabs, and str.replace() to eliminate them.

import re

def longest_absolute_path(fs):
  files, level, explain = [], [], ""
  for entry in fs.split("\n"):
    deep = entry.count("\t") # count the tabs
    if deep > 0:
      entry = entry.replace("\t", "") # eliminate the tabs
      dir = level[deep-1]
      entry = "/".join([dir, entry])
      if len(files) > 0 and dir == files[-1]:
        explain += (f'"{dir}" is a directory ' +
                    "(it has children beneath it).\n")
        files.pop()
    level.insert(deep, entry)
    if re.search(r"[^/]+\.[^/]+$", entry):
      files.append(entry)
  if len(files) == 0:
    return(
      0,
      "There are no files in the system (a file must contain " +
      "a . character\nseparating a name and extension).\n" +
      "Since there are no files, the answer is 0."
    )
  explain += "Found File Paths:\n"
  explain += "\n".join(
    [ f'    "{s}" (length {len(s)})' for s in files ]
  )
  return max([len(s) for s in files ]), explain

View the entire Python script for this task on GitHub.

Elixir

In Elixir, the code being executed by the Enum.reduce/3 call on line 48 got so large it was confusing, so I split it out into its own function reduce_fn/2.

One of the things that makes the code more verbose is the need to return un-modified values from if statements. For example, if I have the code if condition do var = 1 end, the value of var won’t be changed after that code is executed, even if condition is true. I need to do something like var = if condition do 1 else var end, so the value of var is passed back out. This is why I have statements like lines 23-24 and 28-29. Each if block is like its own function, and changes made in it need to be passed back out, and if I don’t make a change, I still need to pass out the unchanged values.

defp reduce_fn(entry, {files, level, explain}) do
  # count the tabs
  deep = String.count(entry, "\t")

  {entry, files, explain} =
    if deep > 0 do
      # eliminate the tabs
      entry = String.replace(entry, "\t", "")

      dir = Map.get(level, deep - 1)
      entry = Enum.join([dir, entry], "/")

      {files, explain} =
        if length(files) > 0 and dir == Enum.at(files, -1) do
          {
            List.delete_at(files, -1),
            "\"#{dir}\" is a directory " <>
              "(it has children beneath it).\n"
          }
        else
          {files, explain}
        end

      {entry, files, explain}
    else
      {entry, files, explain}
    end

  files =
    if Regex.match?(~r"[^/]+\.[^/]+$", entry),
      do: files ++ [entry],
      else: files

  {
    files,
    Map.put(level, deep, entry),
    explain
  }
end

def longest_absolute_path(fs) do
  {files, _level, explain} =
    fs
    |> String.split("\n")
    |> Enum.reduce({[], %{}, ""}, &reduce_fn/2)

  if length(files) == 0 do
    {
      0,
      "There are no files in the system (a file must " <>
        "contain a . character\nseparating a name and " <>
        "extension).\nSince there are no files, " <>
        "the answer is 0."
    }
  else
    explain = explain <> "Found File Paths:\n"

    filelist =
      files
      |> Enum.map(
        &"    \"#{&1}\" (length #{String.length(&1)})"
      )
      |> Enum.join("\n")

    max =
      files
      |> Enum.map(&String.length(&1))
      |> Enum.max()

    {max, explain <> filelist}
  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-399-packy-anderson/challenge-399/packy-anderson

Leave a Reply