new files

Task/Balanced-brackets/Haskell/balanced-brackets-1.hs

@@ -0,0 +1,29 @@
+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 s   = printf "Good \"%s\"\n" s
+          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

Task/Balanced-brackets/Haskell/balanced-brackets-2.hs

@@ -0,0 +1,20 @@
+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