# Longest Substring Without Repeating Characters, Haskell

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.

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