String Compression


In [1]:
import Data.List (group, foldl')

In [2]:
compress :: String -> String
compress xs
    | length compressedString < length xs = compressedString
    | otherwise = xs
        where compressedString = 
                concatMap (\ys -> head ys : show (length ys)) $ group xs

In [3]:
compress' :: String -> String
compress' xs = if length result < length xs then result else xs
    where
        countToReversedString = reverse . show
        
        computeState :: Maybe (Char, Int, String) -> Char -> Maybe (Char, Int, String)
        computeState Nothing current = Just (current, 1, [current])
        computeState (Just (previous, count, accumulator)) current
            | previous == current = Just (current, succ count, accumulator)
            | otherwise = Just (current, 1, current : countToReversedString count ++ accumulator)

        result = case foldl' computeState Nothing xs of
            Nothing -> ""
            Just (previous, count, accumulator) -> reverse $ countToReversedString count ++ accumulator

In [4]:
decompress :: String -> String
decompress xs
    | not isCompressed = xs
    | otherwise = decompress' xs
    where
        isCompressed = any (`elem` ['1'..'9']) xs :: Bool
            
        decompress' :: String -> String
        decompress' "" = ""
        decompress' (chr:ys) = replicate (read count) chr ++ decompress' ys'
            where
                (count, ys') = span (`elem` ['0'..'9']) ys

In [5]:
compress "aaabcccddddeffaab"
decompress "a3b1c3d4e1f2a2b1"


"a3b1c3d4e1f2a2b1"
"aaabcccddddeffaab"

In [6]:
compress "aaaaaaaaaaaaabcdefg"
decompress "a13b1c1d1e1f1g1"


"a13b1c1d1e1f1g1"
"aaaaaaaaaaaaabcdefg"

Tests


In [7]:
import Test.QuickCheck

In [8]:
newtype CompressibleString = CompressibleString String deriving (Show)

instance Arbitrary CompressibleString where
    arbitrary = CompressibleString <$> concat <$> mapM (listOf . elements) (group ['a'..'z'])

In [9]:
testRoundtrip :: (String -> String) -> (String -> String) -> CompressibleString -> Bool
testRoundtrip compressFunc decompressFunc (CompressibleString xs) =
    xs == decompressFunc xs' && length xs' <= length xs
        where
            xs' = compressFunc xs

In [10]:
quickCheck $ testRoundtrip compress decompress
quickCheck $ testRoundtrip compress' decompress


+++ OK, passed 100 tests.
+++ OK, passed 100 tests.