Skip to content

Instantly share code, notes, and snippets.

@rampion
Created April 9, 2012 21:34
Show Gist options
  • Save rampion/2346691 to your computer and use it in GitHub Desktop.
Save rampion/2346691 to your computer and use it in GitHub Desktop.
{-# 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