# Untitled

By: a guest on Aug 22nd, 2012  |  syntax: None  |  size: 2.87 KB  |  hits: 7  |  expires: Never
Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
1. {-# LANGUAGE TupleSections #-}
2. module Main where
4. -- context
5.
6. -- what we essentially have is a non-associative operation (represented by
7. -- concatenation):
8. --
9. --    ab = ba = c
10. --    bc = cb = a
11. --    ac = ca = b
12. --
13. -- Non-associative since:
14. --
15. --    aa == a(bc) /= (ab)c == cc
16. --
17. -- The question boils down to what's the minimum length value we can generate
18. -- for some parenthesization of the input.
19. --
20. -- We know that any minimum length value must be a homogenous string,
21. -- so any parenthesization that doesn't produce a homogenous string
22. -- we can disregard
23.
25. import Data.Map (assocs, insertWith, empty)
26. import Data.Vector (fromList, (!))
27. import Data.List (minimumBy)
28. import Data.Function (on)
29.
30. -- a region (c, n) is a homogeneous substring of n c characters
31. type Region = (Char, Int)
32.
33. -- this is our basic operation
34. (#) :: Region -> Region -> Maybe Region
35. -- if we can reduce two singleton regions into another, do so
36. ('a', 1) # ('b', 1)      = Just ('c', 1)
37. ('b', 1) # ('a', 1)      = Just ('c', 1)
38. ('b', 1) # ('c', 1)      = Just ('a', 1)
39. ('c', 1) # ('b', 1)      = Just ('a', 1)
40. ('c', 1) # ('a', 1)      = Just ('b', 1)
41. ('a', 1) # ('c', 1)      = Just ('b', 1)
42. -- if we can concat two regions of the same character, do so
43. (x, n) # (y, m) | x == y = Just (x, n + m)
44. -- otherwise, we can't produce a homogenous region
45. _        # _             = Nothing
46.
47. -- transform the given list of pairs, combining values
48. -- for each key so the result only has one key per value
49. combineBy :: Ord a => (b -> b -> b) -> [(a,b)] -> [(a,b)]
50. combineBy f = assocs . foldr (uncurry \$ insertWith f) empty
51.
52. -- find all the reductions to a homogeneous region
53. reductions :: String -> [Region]
54. reductions "" = []
55. reductions s = lookup 0 n
56.   where n = length s
57.         lookup i m = cache ! i ! (m - 1)
58.         -- break the string up into a vector of singleton regions
59.         v = fromList \$ map (,1) s
60.         -- for each span of regions, cache the reductions
61.         cache = fromList [ fromList [ calc i m | m <- [1 .. n-i] ] | i <- [0 .. n-1] ]
62.         -- for a given span of regions, find the smallest reductions
63.         calc i 1 = [ v!i ] -- singleton
64.         calc i m = combineBy min \$ do
65.           -- for each split of the span into two halves
66.           k <- [1 .. m-1]
67.           -- for each combination of reductions
68.           -- of the two halves
69.           x <- lookup i k
70.           y <- lookup (i+k) (m-k)
71.           -- see if the result can be combined into
72.           -- a homogenous region
73.           maybe [] return (x#y)
74.
75. -- just the smallest reduction
76. reduce :: String -> Maybe Region
77. reduce "" = Nothing
78. reduce s = Just . minimumBy (compare `on` snd) . reductions \$ s
79.
80. main :: IO ()
81. main = do
82.   forM_ ["", "aab", "bbcccccc", "cab", "bcab", "ccaca", "abcc", "aabcbccbaacaccabcbcab"] \$ \s -> do
83.     putStrLn \$ s ++ ": " ++ show (reduce s)