Longest Substring Without Repeating Characters, Haskell

Question

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!

Answer 1

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)
    )