Created
April 9, 2012 21:34
-
-
Save rampion/2346691 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# LANGUAGE TupleSections #-} | |
module Main where | |
-- see https://plus.google.com/u/0/105746006385940131491/posts/9Uev6KVRUgK for | |
-- context | |
-- what we essentially have is a non-associative operation (represented by | |
-- concatenation): | |
-- | |
-- ab = ba = c | |
-- bc = cb = a | |
-- ac = ca = b | |
-- | |
-- Non-associative since: | |
-- | |
-- aa == a(bc) /= (ab)c == cc | |
-- | |
-- The question boils down to what's the minimum length value we can generate | |
-- for some parenthesization of the input. | |
-- | |
-- We know that any minimum length value must be a homogenous string, | |
-- so any parenthesization that doesn't produce a homogenous string | |
-- we can disregard | |
import Control.Monad (forM_) | |
import Data.Map (assocs, insertWith, empty) | |
import Data.Vector (fromList, (!)) | |
import Data.List (minimumBy) | |
import Data.Function (on) | |
-- a region (c, n) is a homogeneous substring of n c characters | |
type Region = (Char, Int) | |
-- this is our basic operation | |
(#) :: Region -> Region -> Maybe Region | |
-- if we can reduce two singleton regions into another, do so | |
('a', 1) # ('b', 1) = Just ('c', 1) | |
('b', 1) # ('a', 1) = Just ('c', 1) | |
('b', 1) # ('c', 1) = Just ('a', 1) | |
('c', 1) # ('b', 1) = Just ('a', 1) | |
('c', 1) # ('a', 1) = Just ('b', 1) | |
('a', 1) # ('c', 1) = Just ('b', 1) | |
-- if we can concat two regions of the same character, do so | |
(x, n) # (y, m) | x == y = Just (x, n + m) | |
-- otherwise, we can't produce a homogenous region | |
_ # _ = Nothing | |
-- transform the given list of pairs, combining values | |
-- for each key so the result only has one key per value | |
combineBy :: Ord a => (b -> b -> b) -> [(a,b)] -> [(a,b)] | |
combineBy f = assocs . foldr (uncurry $ insertWith f) empty | |
-- find all the reductions to a homogeneous region | |
reductions :: String -> [Region] | |
reductions "" = [] | |
reductions s = lookup 0 n | |
where n = length s | |
lookup i m = cache ! i ! (m - 1) | |
-- break the string up into a vector of singleton regions | |
v = fromList $ map (,1) s | |
-- for each span of regions, cache the reductions | |
cache = fromList [ fromList [ calc i m | m <- [1 .. n-i] ] | i <- [0 .. n-1] ] | |
-- for a given span of regions, find the smallest reductions | |
calc i 1 = [ v!i ] -- singleton | |
calc i m = combineBy min $ do | |
-- for each split of the span into two halves | |
k <- [1 .. m-1] | |
-- for each combination of reductions | |
-- of the two halves | |
x <- lookup i k | |
y <- lookup (i+k) (m-k) | |
-- see if the result can be combined into | |
-- a homogenous region | |
maybe [] return (x#y) | |
-- just the smallest reduction | |
reduce :: String -> Maybe Region | |
reduce "" = Nothing | |
reduce s = Just . minimumBy (compare `on` snd) . reductions $ s | |
main :: IO () | |
main = do | |
forM_ ["", "aab", "bbcccccc", "cab", "bcab", "ccaca", "abcc", "aabcbccbaacaccabcbcab"] $ \s -> do | |
putStrLn $ s ++ ": " ++ show (reduce s) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment