Функциональная задачка by rigidus.ru

Сегодня совершенно случайно наткнулся на статью под названием "Функциональная задачка".
В ней описывалась простая задача и способ её решения на Common Lisp. На самом деле я не знаю, чего в этой задаче "функционального", но это слово привлекло мое внимание.

Вы можете ознакомиться с решением на CL и самой статьей тут.

Я же решу задачу на Haskell. Причем двумя способами. Сам я хоть и не люблю спортивное программирование, но вот такие "быстрые" задачки люблю. Они не занимают много времени и их приятнее решать, нежели всякие абстрактные сказки.



Хотя на самом деле мне было интереснее сравнить решения. Решение на Common Lisp с решением на Haskell.

Текст задачи:

Дан текст. В каждом слове каждого предложения для повторяющихся литер произвести следующую замену: повторные вхождения литер удалить, к первому вхождению литеры приписать число вхождений литеры в слово. Пример : '((aaabb ccccddd)(eeefggg hhkl)) преобразуется в '((a3b2 c4d3)(e3fg3 h2kl)).

И первое решение на Haskell. Оно не совсем честное, ибо мы используем функцию group, которая сама по себе решает половину задачи.

import Data.List (group)
cheatSolution = concatMap worker . group
    where worker e | any (`elem` e) "( )" || length e <= 1 = e
                   | otherwise = head e : show (length e)

Очень простое и короткое решение. Но как я говорил, это жульничество.

Второе решение также не является длинным, но код воспринимается тяжелее. Вообще задачу можно было решить с помощью рекурсии, но я захотел использовать State.

И вот что получилось:

import Control.Monad.State

solution i = fst $ runState (f i) []

f :: String -> State [(Int, Char)] String
f i | null i    = fmap (reverse . concatMap conc) get
    | otherwise = add (head i) >> f (tail i)
      where add c                 = get >>= worker c
            conc (x, y)           = if x /= 1 then show x ++ [y] else [y]
            worker c []           = put [(1, c)]
            worker c l@((i,ch):t) = if ch == c && c `notElem` "( )"
                                    then put $ (i + 1, ch) : t
                                    else put $ (1, c) : l

Логика этого решения такова:

Мы храним список с tuple из числа и символа.
Первый символ мы просто записываем в State, ибо список в State еще пуст.
Получив следующий символ - мы проверяем, равен ли он предыдущему. Если равен, то не записываем его в список, а увеличиваем на единицу предыдущий записанный элемент (голова списка).  Если не равен или символ является одним из служебных (скобки и пробел), тогда просто записываем его в начало списка с числом 1.
Далее мы используем функцию concatMap, записывая символы с ключом 1 как есть, а с ключом больше единицы - записываем в начало строки число, а за ним символ.
Далее все переворачиваем (ибо ответ то у нас правильный, но вверх-тормашками) и возвращаем управление функции solution, которая выдает нам ответ.

Получим ответ:

*> cheatSolution "((aaabb ccccddd)(eeefggg hhkl))"
"((a3b2 c4d3)(e3fg3 h2kl))"

*> solution "((aaabb ccccddd)(eeefggg hhkl))"
"((a3b2 c4d3)(e3fg3 h2kl))"

Все верно, мы получили правильный ответ.

Также задача очень просто решается с regexp'ами, что нам подсказал анонимный комментатор. Его Ruby-вариант:

"((aaabb ccccddd)(eeefggg hhkl))".gsub(/(\w)\1+/){|x| x[0,1] + x.length.to_s}

И аналогичный Haskell-вариант:

import Text.RegexPR
gsubRegexPRBy "(\\w)\\1+" (\x -> [head x] ++ show (length x)) "((aaabb ccccddd)(eeefggg hhkl))"

Рекурсивный Haskell-вариант, предоставленный анонимным комментатором:

import Data.Char

f [] = []
f (x:xs) | isLetter x && not (null l) = x : show (1 + length l) ++ f r
         | otherwise = x : f xs
where (l,r) = span (== x) xs

Задача решена! И в сравнении с LISP-кодом, у нас получилось короче. :)