Source code in the haskell programming language

isMatching :: String -> Bool
isMatching = null . foldl aut [] 
  where
    aut ('[':s) ']' = s
    -- aut ('{':s) '}' = s -- automaton could be extended
    aut s x = x:s


brackets = filter isMatching 
           $ [1.. ] >>= (`replicateM` "[]{}")


import Control.Monad
import System.Random
import Text.Printf
import VShuffle

-- Return whether a string contains balanced brackets.  Nothing indicates a
-- balanced string, while (Just i) means an imbalance was found at, or just
-- after, the i'th bracket.  We assume the string contains only brackets.
isBalanced :: String -> Maybe Int
isBalanced = bal (-1) 0
  where
    bal :: Int -> Int -> String -> Maybe Int
    bal _ 0 [] = Nothing
    bal i _ [] = Just i
    bal i (-1) _ = Just i
    bal i n ('[':bs) = bal (i + 1) (n + 1) bs
    bal i n (']':bs) = bal (i + 1) (n - 1) bs

-- Print a string, indicating whether it contains balanced brackets.  If not,
-- indicate the bracket at which the imbalance was found.
check :: String -> IO ()
check s = maybe (good s) (bad s) (isBalanced s)
  where
    good = printf "Good \"%s\"\n"
    bad s n = printf "Bad  \"%s\"\n%*s^\n" s (n + 6) " "

main :: IO ()
main = do
  let bs = cycle "[]"
  rs <- replicateM 10 newStdGen
  zipWithM_ (\n r -> check $ shuffle (take n bs) r) [0,2 ..] rs


module VShuffle
  ( shuffle
  ) where

import Data.List (mapAccumL)
import System.Random
import Control.Monad.ST
import qualified Data.Vector as V
import qualified Data.Vector.Generic.Mutable as M

-- Generate a list of array index pairs, each corresponding to a swap.
pairs
  :: (Enum a, Random a, RandomGen g)
  => a -> a -> g -> [(a, a)]
pairs l u r = snd $ mapAccumL step r [l .. pred u]
  where
    step r i =
      let (j, r') = randomR (i, u) r
      in (r', (i, j))

-- Return a random permutation of the list.  We use the algorithm described in
-- http://en.wikipedia.org/wiki/Fisher%E2%80%93Yates_shuffle#The_modern_algorithm.
shuffle
  :: (RandomGen g)
  => [a] -> g -> [a]
shuffle xs r =
  V.toList . runST $
  do v <- V.unsafeThaw $ V.fromList xs
     mapM_ (uncurry $ M.swap v) $ pairs 0 (M.length v - 1) r
     V.unsafeFreeze v


import Control.Applicative ((<|>))
import Data.List (findIndex, replicate, scanl)
import Data.List.Split (chunksOf)
import System.Random

-------------------- BALANCED BRACKETS -------------------

nesting :: String -> [Int]
nesting = tail . scanl (flip level) 0
  where
    level '[' = succ
    level ']' = pred
    level  _  = id
    

bracketProblemIndex :: String -> Maybe Int
bracketProblemIndex s =
  findIndex (< 0) depths <|> unClosed
  where
    depths = nesting s
    unClosed
      | 0 /= last depths = Just $ pred (length s)
      | otherwise = Nothing


--------------------------- TEST -------------------------
main :: IO ()
main = do
  let g = mkStdGen 137
  mapM_ (putStrLn . showProblem) $
    chunksOf
      6
      (bracket <$> take 60 (randomRs (0, 1) g))

showProblem s =
  case bracketProblemIndex s of
    Just i -> s <> ": Unmatched\n" <> replicate i ' ' <> "^"
    _ -> s <> ": OK\n"

bracket :: Int -> Char
bracket 0 = '['
bracket _ = ']'