На "Форуме программистов и сисадминов" некто "ksu9304" создал топик с довольно интересной задачкой. С первого взгляда она мне показалась не очень сложной, однако когда я начал ее решать, сразу нашлось интересного аж на пару часов :) Увлекательная оказалась :) Вот задание:

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

Начнем с того, "дан текст" - это неправда :) На самом деле, как видно из примера, дано дерево списков, содержащее в своих конечных узлах символы, которые мы и должны преобразовать. Но для начала мы просто предствим себе, что у нас есть некоторая функция-транслятор, которая умеет преобразовывать "eeefggg" в "e3fg3".

<source lang=""> (defun translator (input) …) </source>

Внутри этой функции будет функционал map, который будет двигаться по входной строке и что-то с ней делать посимвольно:

<source lang=""> (defun translator (input) (map 'list #'(lambda (c) …) input)) </source>

Здесь можно подумать, как бы ловчее все это преобразовывать? Я решил заталкивать буквы в стек (tmp) и смотреть два верхних элемента - если они равны - увеличивать счетчик на единицу и выходить из лямбды, в противном случае возвращать преобразование:

<source lang=""> (defun translator (input) (let ((tmp) (cnt 1)) (map 'list #'(lambda (c) (block functional (push c tmp) (let ((len (length tmp))) (if (> len 1) (let ((a (nth 0 tmp)) (b (nth 1 tmp))) (when (equal a b) (incf cnt) (return-from functional nil)) (prog1 (format nil "~C~D" b (if (equal 1 cnt) "" cnt)) (setf cnt 1))))))) input)))

(translator "aaabbbbbccc") => (NIL NIL NIL "a3" NIL NIL NIL NIL "b5" NIL NIL) </source>

Осталось только удалить NIL, но что это? Мы совсем забыли записать последние три буквы "с"! Здесь пригодится макрос SAVE, который занимается возвратом значения - он будет раскрываться дважды, внутри обработки строки и после ее окончания:

<source lang=""> (defmacro save (ch) `(format nil "~C~D" ,ch (if (equal 1 cnt) "" cnt))) </source>

Теперь склеим все значащие элементы списка и преобразуем результат к строке:

<source lang=""> (defun translator (input) (let ((tmp) (cnt 1)) (format nil "{~a}" (remove-if #'null (append (map 'list #'(lambda (c) (block functional (push c tmp) (let ((len (length tmp))) (if (> len 1) (let ((a (nth 0 tmp)) (b (nth 1 tmp))) (when (equal a b) (incf cnt) (return-from functional nil)) (prog1 (save b) (setf cnt 1))))))) input) (list (save (pop tmp))))))))

(translator "aaabbbbbccc") => "a3b5c3" </source>

Отлично, это работает, но только для строк. Чтобы распарсить вложенные списки символов напишем вот такую рекурсивную функцию:

<source lang=""> (defun parser (in) (typecase in (cons (map 'list #'parser in)) (symbol (intern (string-upcase (translator (symbol-name in))))))) </source>

Теперь можно передать ей исходный пример и убедиться в том, что результат верный:

<source lang=""> (parser '((aaabb ccccddd) (eeefggg hhkl) dddd)) => ((A3B2 C4D3) (E3FG3 H2KL) D4) </source>

Думаю, такого рода задачку можно смело давать лисперам в качестве тестового задания на собеседовании, так как она дает возможность проверить не только умеет ли претендент работать с функционалами, но и позволяет применить макросы и проверяет понимание символов лиспа.