Solution to https://leetcode.com/problems/longest-valid-parentheses/

longestValidParenthesis.hs

{-# LANGUAGE LambdaCase #-}

-- Solution to https://leetcode.com/problems/longest-valid-parentheses/
-- Same recursive algorithm with
-- 1. function
-- 2. foldl
-- 3. Reader
-- 4. ReaderT
-- 5. StateT
-- 6. foldr
-- 7. State + mapM
-- 6 and 7 are wrong according to quickCheck
-- 6 is wrong on [Left,Right,Right,Left,Right] "())()"
-- 7 is wrong on [Left, Left] "(("

import           Control.Monad.Trans.Class      (lift)
import           Control.Monad.Trans.Reader     (Reader, ReaderT, ask, local,
                                                 runReader, runReaderT)
import           Control.Monad.Trans.State.Lazy (State, StateT, evalStateT, get,
                                                 put, runState)
import           Prelude                        hiding (Left, Right)
import           Test.QuickCheck

data Paren = Left | Right
  deriving Show

parenFromChar :: Char -> Paren
parenFromChar '(' = Left
parenFromChar ')' = Right
parenFromChar _   = undefined

flipParen :: Paren -> Paren
flipParen Left  = Right
flipParen Right = Left

isValidParens :: String -> Bool
isValidParens = isValidParens' . map parenFromChar

isValidParens' :: [Paren] -> Bool
isValidParens' = go 0
  where
    go :: Integer -> [Paren] -> Bool
    go (-1) _            = False
    go 0    []           = True
    go _    []           = False
    go diff (Left  : ps) = go (diff + 1) ps
    go diff (Right : ps) = go (diff - 1) ps

longestValidParenthesis :: String -> Int
longestValidParenthesis = longestValidParenthesis7 . map parenFromChar

longestValidParenthesis1 :: [Paren] -> Int
longestValidParenthesis1 = go (0, 0, 0)
  where
    go :: (Int, Int, Int) -> [Paren] -> Int
    go (  -1,     _, maxL) []           = maxL
    go (   0, currL, maxL) []           = max currL maxL
    go (diff, currL, maxL) []           = max (currL - diff) maxL
    go (  -1,     _, maxL) (Left  : ps) = go (       1,         1,           maxL) ps
    go (   0, currL, maxL) (Left  : ps) = go (       1, currL + 1, max currL maxL) ps
    go (diff, currL, maxL) (Left  : ps) = go (diff + 1, currL + 1,           maxL) ps
    go (  -1,     _, maxL) (Right : ps) = go (      -1,         0,           maxL) ps
    go (   0, currL, maxL) (Right : ps) = go (      -1,         0, max currL maxL) ps
    go (diff, currL, maxL) (Right : ps) = go (diff - 1, currL + 1,           maxL) ps

longestValidParenthesis2 :: [Paren] -> Int
longestValidParenthesis2 = ba . foldl go (0, 0, 0)
  where
    ba :: (Int, Int, Int) -> Int
    ba (  -1,     _, maxL) = maxL
    ba (   0, currL, maxL) = max currL maxL
    ba (diff, currL, maxL) = max (currL - diff) maxL
    go :: (Int, Int, Int) -> Paren -> (Int, Int, Int)
    go (  -1,     _, maxL) Left  = (       1,         1,           maxL)
    go (   0, currL, maxL) Left  = (       1, currL + 1, max currL maxL)
    go (diff, currL, maxL) Left  = (diff + 1, currL + 1,           maxL)
    go (  -1,     _, maxL) Right = (      -1,         0,           maxL)
    go (   0, currL, maxL) Right = (      -1,         0, max currL maxL)
    go (diff, currL, maxL) Right = (diff - 1, currL + 1,           maxL)

longestValidParenthesis3 :: [Paren] -> Int
longestValidParenthesis3 = runReader go (0, 0, 0)
  where
    go :: Reader (Int, Int, Int) ([Paren] -> Int)
    go = do
      (diff, currL, maxL) <- ask
      if diff == -1 then
        return (\case
          []           -> maxL
          (Left  : ps) -> runReader go ( 1, 1, maxL) ps
          (Right : ps) -> runReader go (-1, 0, maxL) ps
          )
      else if diff == 0 then
        return (\case
          []           -> max currL maxL
          (Left  : ps) -> runReader go ( 1, currL + 1, max currL maxL) ps
          (Right : ps) -> runReader go (-1,         0, max currL maxL) ps
          )
      else
        return (\case
          []           -> max (currL - diff) maxL
          (Left  : ps) -> runReader go (diff + 1, currL + 1, maxL) ps
          (Right : ps) -> runReader go (diff - 1, currL + 1, maxL) ps
          )

longestValidParenthesis4 :: [Paren] -> Int
longestValidParenthesis4 = runReader $ runReaderT go (0, 0, 0)
  where
    go :: ReaderT (Int, Int, Int) (Reader [Paren]) Int
    go = do
      (diff, currL, maxL) <- ask
      lift $ if diff == -1 then do
        ps <- ask
        case ps of
          []            -> return maxL
          (Left  : ps') -> local (const ps') $ runReaderT go ( 1, 1, maxL)
          (Right : ps') -> local (const ps') $ runReaderT go (-1, 0, maxL)
      else if diff == 0 then do
        ps <- ask
        case ps of
          []          -> return $ max currL maxL
          (Left  : ps') -> local (const ps') $ runReaderT go ( 1, currL + 1, max currL maxL)
          (Right : ps') -> local (const ps') $ runReaderT go (-1,         0, max currL maxL)
      else do
        ps <- ask
        case ps of
          []          -> return $ max (currL - diff) maxL
          (Left  : ps') -> local (const ps') $ runReaderT go (diff + 1, currL + 1, maxL)
          (Right : ps') -> local (const ps') $ runReaderT go (diff - 1, currL + 1, maxL)

longestValidParenthesis5 :: [Paren] -> Int
longestValidParenthesis5 = runReader $ evalStateT go (0, 0, 0)
  where
    go :: StateT (Int, Int, Int) (Reader [Paren]) Int
    go = do
      (diff, currL, maxL) <- get
      lift $ if diff == -1 then do
        ps <- ask
        case ps of
          []            -> return maxL
          (Left  : ps') -> local (const ps') $ evalStateT go ( 1, 1, maxL)
          (Right : ps') -> local (const ps') $ evalStateT go (-1, 0, maxL)
      else if diff == 0 then do
        ps <- ask
        case ps of
          []            -> return $ max currL maxL
          (Left  : ps') -> local (const ps') $ evalStateT go ( 1, currL + 1, max currL maxL)
          (Right : ps') -> local (const ps') $ evalStateT go (-1,         0, max currL maxL)
      else do
        ps <- ask
        case ps of
          []            -> return $ max (currL - diff) maxL
          (Left  : ps') -> local (const ps') $ evalStateT go (diff + 1, currL + 1, maxL)
          (Right : ps') -> local (const ps') $ evalStateT go (diff - 1, currL + 1, maxL)

longestValidParenthesis6 :: [Paren] -> Int
longestValidParenthesis6 = ba . foldr go (0, 0, 0)
  where
    ba :: (Int, Int, Int) -> Int
    ba (  -1,     _, maxL) = maxL
    ba (   0, currL, maxL) = max currL maxL
    ba (diff, currL, maxL) = max (currL - diff) maxL
    go :: Paren -> (Int, Int, Int) -> (Int, Int, Int)
    go Right (  -1,     _, maxL) = (1, 1, maxL)
    go Right (   0, currL, maxL) = (1, currL + 1, max currL maxL)
    go Right (diff, currL, maxL) = (diff + 1, currL + 1, maxL)
    go Left  (  -1,     _, maxL) = (-1, 0, maxL)
    go Left  (   0, currL, maxL) = (-1, 0, max currL maxL)
    go Left  (diff, currL, maxL) = (diff - 1, currL + 1, maxL)

longestValidParenthesis7 :: [Paren] -> Int
longestValidParenthesis7 = last . results
  where
    results = ba . flip runState (0, 0, 0) . mapM go
    ba :: ([Int], (Int, Int, Int)) -> [Int]
    ba (rs, (  -1,     _, maxL)) = rs ++ [maxL]
    ba (rs, (   0, currL, maxL)) = rs ++ [max currL maxL]
    ba (rs, (diff, currL, maxL)) = rs ++ [max (currL - diff) maxL]
    go :: Paren -> State (Int, Int, Int) Int
    go p = do
      (diff, currL, maxL) <- get
      let diff' = case p of
                    Left  -> if diff == -1 then  1 else diff + 1
                    Right -> if diff == -1 then -1 else diff - 1
      let currL' = case p of
                    Left  -> if diff == -1 then 1 else currL + 1
                    Right -> if diff == -1 then 0 else currL + 1
      let maxL' = if diff == -1 then maxL else max currL maxL
      put (diff', currL', maxL')
      return maxL'

test1 :: Bool
test1 = longestValidParenthesis "(()" == 2

test2 :: Bool
test2 = longestValidParenthesis ")()())" == 4

test3 :: Bool
test3 = longestValidParenthesis "(()()())" == 8

instance Arbitrary Paren where
  arbitrary = ([Left, Right] !!) <$> choose (0, 1)

makeEquivProp :: Eq a => (t -> a) -> (t -> a) -> t -> Bool
makeEquivProp f1 f2 ps = f1 ps == f2 ps

checkAll :: IO ()
checkAll = do
  quickCheck $ makeEquivProp longestValidParenthesis1 longestValidParenthesis2
  quickCheck $ makeEquivProp longestValidParenthesis2 longestValidParenthesis3
  quickCheck $ makeEquivProp longestValidParenthesis3 longestValidParenthesis4
  quickCheck $ makeEquivProp longestValidParenthesis4 longestValidParenthesis5
  quickCheck $ makeEquivProp longestValidParenthesis5 longestValidParenthesis6
  quickCheck $ makeEquivProp longestValidParenthesis6 longestValidParenthesis7
  quickCheck $ makeEquivProp longestValidParenthesis5 longestValidParenthesis7