ランレングス変換 ref: http://qiita.com/nobsun/items/5518acd626e81c5944fb

haskell.runlength-fusion.hs

import Control.Applicative ((<*>))
import Control.Arrow (first,(***))

runlength :: (Eq a) => [a] -> [(a,Int)]
runlength = hylo ((:) . runlen) [] null (span' . (==) . head <*> id)

runlen :: ([a],Int) -> (a,Int)
runlen = first head

hylo f e p g x = if p x then e else f y (hylo f e p g x')
  where (y,x') = g x

span' :: (a -> Bool) -> [a] -> (([a],Int),[a])
span' p xxs = case xxs of
  x:xs | p x -> first (cons x) (span' p xs)
  _          -> (([],0),xxs)

cons :: a -> ([a],Int) -> ([a],Int)
cons x = (x:) *** (1+)

runlength-of-list-with-length.hs

import Control.Arrow (first,(***))
import Data.List (unfoldr)

runlength :: (Eq a) => [a] -> [(a,Int)]
runlength = map runlen . group'

runlen :: ([a],Int) -> (a,Int)
runlen = first head

group' :: Eq a => [a] -> [([a],Int)]
group' = unfoldr phi g
  where
    phi []        = Nothing
    phi xxs@(x:_) = Just (span' (x==) xxs)

span' :: (a -> Bool) -> [a] -> (([a],Int),[a])
span' p xxs = case xxs of
  x:xs | p x -> first (cons x) (span' p xs)
  _          -> (([],0),xxs)

cons :: a -> ([a],Int) -> ([a],Int)
cons x = (x:) *** (1+)

runlength-point-free.hs

import Control.Applicative ((<*>))
import Data.List (group)

runlength :: (Eq a) => [a] -> [(a,Int)]
runlength = map runlen . group

runlen :: [a] -> (a,Int)
runlen = (,) . head <*> length

runlength.hs

import Data.List (unfoldr)
runlength :: (Eq a) => [a] -> [(a,Int)]
runlength = unfoldr phi
  where
    phi []        = Nothing
    phi xxs@(x:_) = Just (runlen (x,0) xxs)

runlen :: (Eq a) => (a,Int) -> [a] -> ((a,Int),[a])
runlen xn@(x,n) yys@(y:ys) | x == y    = runlen (x,1+n) ys
                           | otherwise = (xn,yys)