Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
{-# 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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.