3
\$\begingroup\$

I started learning Haskell a while ago and now I am in this dangerous state where I can produce code that does things but which probably makes experienced developers hit their heads against the wall :) So I thought I'd try posting it here and get some feedback.

The problem I'm looking at is the "Longest Substring Without Repeating Characters" problem from LeetCode (https://leetcode.com/problems/longest-substring-without-repeating-characters/).

The name already says about all there is to know. Here are some examples:

"abcabcbb" -> "abc" (or "bca", or "cab", ...)
"bbbbb" -> "b" 
"pwwkew" -> "wke" (or "kew")
"a" -> "a"
"" -> ""

I started with implementing the naive solution. It goes over each position of the string, tries to extend a substring until a repeated character is encountered and maintains the maximum while doing so. The algorithm is O(n^2).

import           Data.Maybe
import qualified Data.HashMap.Strict           as M
import qualified Data.HashSet                  as S
import           Data.Foldable                  ( maximumBy )
import           Data.Ord                       ( comparing )

type Span = (Int, Int)
type CharacterIndex = M.HashMap Char Int

-- |Calculate length of span.
spanLength :: Span -> Int
spanLength (start, end) = end - start + 1

-- |Return a maximum-length substring without repeating characters.
-- This is the naive O(n^2) implementation.
solutionNaive :: String -> String
solutionNaive xs = solution' xs ""
 where
  -- Recurse over each position and try to expand as far as possible from there.
  solution' [] longest = longest
  solution' xs longest =
    let uniqueStr = takeWhileUnique xs S.empty
    in  solution' (tail xs) (maximumBy (comparing length) [longest, uniqueStr])
  -- Take elements from the list until the first duplicated element is encountered.
  takeWhileUnique []       _    = []
  takeWhileUnique (x : xs) seen = if x `S.member` seen
    then []
    else x : takeWhileUnique xs (x `S.insert` seen)

Next I switched back to imperative programming for a while and implemented (with a bit of inspiration from the official solution) this nicely optimised O(n) sliding window algorithm.

#include <array>
#include <string>

using namespace std;

/**
 * Return a maximum-length substring without repeating characters.
 */
string solution(string s) {
  // invariant: window_left points to start of current unique window
  int window_left = 0;
  int longest = 0;

  // invariant: saved_left points to start of longest unique window
  int saved_left = 0;

  // for each element, stores the position where he have last encountered it
  array<int, 256> chr_idxs;
  chr_idxs.fill(-1);

  // invariant: i points right of current unique window
  int i = 0;
  int candidate_length = 0;
  while (i < s.size()) {
    if (chr_idxs[s[i]] >= window_left) {
      // current character is already in the window
      // we move the window start directly to the
      // right of the last encountered position
      window_left = chr_idxs[s[i]] + 1;
    } else {
      // current character is not in the window yet
      // expand the window
      chr_idxs[s[i]] = i;
      i += 1;

      // check if we have a new max
      candidate_length = i - window_left;
      if (candidate_length > longest) {
        longest = candidate_length;
        saved_left = window_left;
      }
    }
  }

  return s.substr(saved_left, longest);
}

After I had it working in C++, I naturally wanted to optimise my Haskell version in the same way. The resulting code literally looks like this though: imperative code squeezed into Haskell. Lots of ugly index manipulation which makes it super easy to introduce bugs.

-- |Extract span from list.
spanExtract :: Span -> [a] -> [a]
spanExtract (start, end) = drop start . take (end + 1)

-- |Return a maximum-length substring without repeating characters.
-- This is the more sophisticated O(n) implementation.
solution :: String -> String
solution xs = spanExtract (solution' xs M.empty (0, 0) (0, 0)) xs
 where
  -- Slide a window over the string and try to expand it if possible.
  solution' [] _ _ maxWin = maxWin
  solution' (x : xs) seen curWin@(curLeft, curRight) maxWin =
    let lastSeenIdx = fromMaybe (-1) (M.lookup x seen)
        duplicated  = lastSeenIdx >= curLeft
        recurse     = solution' xs (M.insert x curRight seen)
    in  if duplicated
          -- If current element is duplicated, move window start to
          -- the right of the last encountered version and continue.
          then recurse (lastSeenIdx + 1, curRight + 1) maxWin
          -- Otherwise expand window and check if we have a new max.
          else recurse (curLeft, curRight + 1)
                       (maximumBy (comparing spanLength) [maxWin, curWin])

I wonder if there are ways to make this cleaner without changing back into a worse complexity class.

I'd be happy about any kind of feedback - thank you in advance already!

\$\endgroup\$
1
\$\begingroup\$
solutionNaive :: String -> String
solutionNaive xs = maximumBy (comparing length) $ map (takeWhileUnique S.empty) $ tails xs where
  -- Take elements from the list until the first duplicated element is encountered.
  takeWhileUnique _    []       = []
  takeWhileUnique seen (x : xs) = if x `S.member` seen
    then []
    else x : takeWhileUnique xs (x `S.insert` seen)

(Higher-order foldr could get rid of that explicit recursion, but it's not gainful.)

Your second solution does seem to require stateful arithmetic. We can still make it hurt less.

-- |Return a maximum-length substring without repeating characters.
-- This is the more sophisticated O(n) implementation.
solution :: String -> String
solution = spanExtract . maximumBy (comparing spanLength) . mapAccumL step (M.empty, 0) . zip [0..]
  where step (seen, curLeft) (curRight, x) =
    ( (M.insert x curRight seen, max curLeft $ maybe 0 (+1) $ M.lookup x seen)
    , (curLeft, curRight)
    )
\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.