Не пишем quicksort на Common Lisp

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

1. Анаграммы

Имеется массив человеческих слов. Некоторые слова могут являться анаграммами по отношению друг у другу. Надо найти количество таких слов, причем сложность алгоритма должна быть линейной.

Очевидное решение — отсортировать сами слова, потом отсортировать массив, пройтись по нему и посчитать количество слов с самоподобными соседями.

На CL это можно написать так:

(defvar *words* (list "thore" "ganamar" "notanagram" "anagram" "other"))

((lambda (words) 
    (loop for (a b c) in         
        (mapcar #'list words (append '("") words) (append '("" "") words))
        count (or (equal a b) (equal b c))))
    (sort (mapcar (lambda (one-word) (sort one-word #'char-lessp)) *words*) #'string-lessp))

Сразу стоит оговорить, что sort в CL является destructive, то есть может менять входные данные. Поэтому мы и не можем объявить тестовый набор слов константой, придется довольствоваться глобальной переменной.

Теперь к решению. Начнем с аргумента главной лямбды. (sort one-word #'char-lessp) отсортирует буквы в одном слове по заданному предикату. В CL буквы, строки и числа — совершенно разные типы, поэтому для каждого типа приходится указывать свой предикат. В нашем случае для сортировки букв по возрастанию мы возьмем обычный char-lessp, но можно, конечно, и писать свои сколь угодно сложные функции.

Нам потребуется обернуть сортировку в (lambda (one-word) (sort one-word #'char-lessp)), чтобы получить функцию для marcar. Запустив сам mapcar на *words*, мы получим массив отсортированных слов. А отдав его сортировщику с предикатом string-lessp — отсортированный массив отсортированных слов.

Теперь посмотрим в тело лямбды. Там мы сшиваем три массива в один массив 3-списков: (mapcar #'list words (append '("") words) (append '("" "") words)). Вообще-то тут желательно бы использовать кортежи, которых нет, но это вкусовщина. Три массива — это то, что мы насортировали в аргументе, но один из них сдвинут на одно пустое слово, а другой — на два. Такое «размножение» происходит без глубокого копирования, ведь мы не множим данные три раза, а просто перерисовываем списки. В итоге в конечном списке лежит 3-список из: слова отсортированного массива, его соседа справа, соседа соседа справа.

Цикл, который проходит по этому списку списков, написан таким образом, что каждый 3-список в теле цикла превращается в (a b c). А в теле все просто: если b имеет самоподобного соседа справа ©, или слева (a) — это наверняка анаграмма и ее надо учесть.

Макрос loop в Common Lisp предоставляет свой подъязык с широчайшими возможностями. Тут, например, нам не надо создавать счетчик для подсчета, он создается автоматически словом count и его значение возвращается при выходе из цикла.

Самый главный вопрос — зачем вообще нужна главная лямбда. Фактически мы объявляем функцию и тут же ее используем. Разве мы не могли бы определить отсортированный список локально через let и обойтись без лямбды. Ответ на него прост: конечно же могли бы. Здесь лямбда — это просто еще один способ создать локальный контекст.

Возвращаясь к теме. Штатная сравнивающая сортировка в общем случае работает со сложностью O(n log n). Что очень неплохо, но нам не подходит. С линейной сложностью мы могли бы пройтись, например, по массиву, посчитать его сортированные слова в хеш-таблице и потом сложить вместе те ее значения, которые больше единицы. Однако опять же надо сортировать слова. На самом деле, сортировка слов может быть сделана с линейной сложностью. Буквы — довольно немощный ключ, то есть какая-нибудь сортировка подсчетом с такой задачей справится замечательно. Но будем придерживаться.

В Common Lisp поддерживается арифметика с бесконечными числами. То есть у нас нет переполнений, просто с ростом числа тратится память и падает скорость операций. В принципе, для расчета сложности алгоритма этим можно и пренебречь. Анаграмму однозначно идентифицирует то, сколько каких букв в нее входит. Их можно двигать как угодно, но нельзя добавлять и убавлять. То же самое можно сказать и про числа с их простыми множителями. 2*3 = 3*2 точно так же, как и «аб» является анаграммой «ба». Раз так, то мы можем идентифицировать каждое слово числом, найденным как произведение соответствующих простых множителей.

Стоит напомнить, что в CL числа и символы — принципиально разные типы. Нельзя считать, что a = 65, просто потому что это так во множестве кодовых таблиц. Так что нам потребуется некоторое отображение из символов в числа. Почему бы не сделать его хеш-таблицей?

(defconstant +letters-26+ '(#a #b #c #d #e #f #g #h #i #j #k #l #m #n #o #p #q #r #s #t #u #v #w #x #y #z))
(defconstant +primes-26+ '(2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97 101))
(defparameter *letter-to-prime* (make-hash-table))
(loop for (l p) in (mapcar #'list +letters-26+ +primes-26+)
    do (setf (gethash l *letter-to-prime*) p))

Тут все довольно просто. Объявляем список символов, простых чисел, составляем таблицу, в которой каждому символу соответствует число. В Common Lisp немного необычный способ класть что-либо в таблицу. Для этого мы берем оттуда его значение и как бы кладем «в это значение» новое. Берем командой gethash, кладем setf.

Теперь нам потребуется оценочная функция для слова-анаграммы.

(defun evaluate-word (word)
    (apply #'* 
        (loop for letter across word
            collect (gethash letter *letter-to-prime*))))

Достаточно просто. Собираем все простые множители через хеш-таблицу в один списов и применяем к нему оператор *. Все множится. Один нюанс. Строка тут является не совсем списком. И даже массивом она является на совсем, хотя похожа на него больше. Для таких объектов используется предлог across, а не in.

Теперь собственно проход по массиву и проход по таблице.

(let ((word-count (make-hash-table)))
    (loop 
        for word in *words* do 
            (let ((wordn (evaluate-word word))) 
                (let ((cnt (gethash wordn word-count)))
                    (if cnt
                        (setf (gethash wordn word-count) (+ cnt 1))
                        (setf (gethash wordn word-count) 1)))))
     (loop for v being the hash-values of word-count 
          when (> v 1) sum v))

Создаем локально таблицу, проходим по массиву, вычитываем значение для каждой анаграммы: если оно в таблице есть, добавляем к нему единицу; если нет — кладем в таблицу единицу, чтобы было. Потом проходим по таблице и складываем те значения, которые больше единицы. Очень выразительный синтаксис у циклов, тут даже и объяснять ничего не надо.

Единственное, стоит знать, что gethash возвращает первым значением nil, если в таблице нет указанного ключа. А if считает любое значение кроме nil правдой. Поэтому if cnt и работает так просто.

Такой способ выглядит более громоздким, собственно, он таким и является, зато работает достаточно быстро.

2. Ключ в мусоре

Есть массив строк вида:

"key1=blah key2=something key4=else sequence=3"
"sequence=1 key2=xlde key7=eldl"
"blahkey=xxx sequence=2 keyx=adada"

Надо его отсортировать по sequence. Значение sequence уникально и покрывает 1..n.

Это мой любимый случай сортировки — классический pigeonhole. Так как ключ уникальный и покрывает полностью некоторый диапазон, то вместо всяких перестановок со сравнениями нам достаточно просто заготовить массив, пройтись по исходному и положить каждое его значение в соответствующую ячейку нового. Соответствие тривиально. В данном случае: i = s-1, где i — индекс в новом массиве, а s — число справа от sequence.

Но для начала надо бы это число как-то получить. В принципе можно найти положение sequence и от него уже посчитать то, откуда брать ключ. Но вообще для такой работы удобней пользоваться стандартным инструментом, таким как split или, что то же самое, explode. Обычно он работает как-то так: split(«abcdef», «cd») -> [«ab», «ef»]. В Common Lisp, правда, почему-то таких функций из коробки нет. Придется писать.

(defun split (str spc)
    (let ((p (search spc str)))
        (if p
            (append (list (subseq str 0 p)) (split (subseq str (+ p (length spc))) spc))
            (list str))))

Здесь str — строка, а spc — разделитель, по которому мы будем «взрывать» строку. Для начала находим разделитель в строке. Если нашли, отрезаем от нее часть до разделителя, запаковываем ее в список, приклеиваем к ней «взорванный» остаток и возвращаем. Если не нашли, запаковываем и возвращаем строку целиком. Функция очевидно рекурсивная, тут это вполне удобно и уместно.

(let ((strings-array (make-array (length *strings*))))
    (loop for str in *strings* do
        (let ((i (parse-integer (first (split (second (split str "sequence=")) " ")))))
            (setf (aref strings-array (- i 1)) str)))
    (loop for str across strings-array do
        (print str)))

Создаем новый массив строк. Проходим по старому. Режем ее на часть до и после «sequence=», берем то что после, режем ее по пробелам, берем первый кусочек. Это и есть индекс строки в новом массиве. Превращаем его из строки в число функцией parse-integer, кладем строку в новый массив. Обратите внимание на функции first и second. Конечно же это замаскированные car и car cdr, но ведь красиво замаскированные.

Common Lisp вообще отличается от более традиционных диалектов наличием таких вот вкусностей.

3. Префиксы

Есть некоторый массив слов. Некоторые слова являются префиксами других слов. Надо найти все такие слова.

Очевидно, эта задача также легко решается сортировкой и банальным сравнением с соседом справа. Более того, сюда явно просится радиксная, а она имеет сложность O(n*k), где k — мощность ключа, то есть относительно n таки O(n). Но ведь можно использовать принцип радиксной сортировки ничего не сортируя. Этим и займемся.

На каждой итерации будем раскладывать слова по разным ячейкам исходя из их первой буквы. Так, например, слова «qwert», «qwe», «asdf» разойдутся по двум ячейкам: [«qwert», «qwe»] и [«asdf»]. Вторая ячейка нам не интересна, потому что одно само слово никак не может быть префиксом, а первую запустим на новую итерацию, отрезав первую букву. Когда дойдем до «rt» и "", поймем, что там где сейчас "" раньше был префикс.

Снова таки нам потребуется отображение символа на индекс.

(defconstant +letters-26+ '(#a #b #c #d #e #f #g #h #i #j #k #l #m #n #o #p #q #r #s #t #u #v #w #x #y #z))
(defparameter *letter-to-index* (make-hash-table))
(loop for i from 0 to 25
    do (setf (gethash (nth i +letters-26+) *letter-to-index*) i))

Никакого смысла делать список из натуральных чисел нет, нам его сделает сам замечательный loop.

(defparameter *lines* '("qwerty" "qwe" "asddsa" "zxcvb" "zxcvbn" "zxcvbnm"))

(defun find-sub (ine-lines)
    (let ((cells (make-array 26 :initial-element '() )))
        (loop for (ine line) in ine-lines do
            (if (equal ine "")
                (print line)
                (let ((i (gethash (char ine 0) *letter-to-index*)))
                    (setf (aref cells i) 
                        (append (list (list (subseq ine 1) line)) (aref cells i))))))
        (loop for cell across cells do
            (when (> (length cell) 1) (find-sub cell)))))

(find-sub (mapcar #'list *lines* *lines*))

Нам потребуется определить именованную функцию, потому что для рекурсии крайне желательно иметь хоть какое-нибудь имя. Также нам потребуются кортежи, а точнее опять 2-списки из слова и его остатка при обрезании. Чтобы не перепутать, тут он называется ine-lines, то есть первое значение 2-списка — укороченное слово, второе — полное. Вообще-то для того, чтобы не путаться в кортежах, целую объектную систему придумали, но до нее доберемся как-нибудь потом.

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

Проходим по 2-спискам из ine-lines. Если первая часть пустая строка, выводим принтом вторую. Вообще-то это не совсем красиво, лучше бы обойтись вообще без сторонних эффектов: собрать все в один список и отдать на выходе. Но так тоже можно. Язык позволяет делать много чего, в том числе и игнорировать хорошие практики.

Если же первая часть не пустая, находим ячейку, соответствующую первой букве, добавляем туда 2-списком строку без первой буквы и полную. Обратите внимание, у строки есть собственный синтаксис для получения символов: char. Синтаксис хороший, прозрачный, надо просто помнить, что строка — это не совсем список и не совсем массив.

Потом проходим по массиву, снова-таки across, и для всех ячеек, в которых потенциально может быть префикс, запускаем еще раз find-sub.

Работает.

Выводы

Язык Common Lisp отлично подходит для того, чтобы не писать на нем quicksort. Конечно, с одной стороны, не хватает многих привычных вещей: кортежей, сплита, лаконичного синтаксиса для массивов и хеш-таблиц. С другой стороны, есть отличнейший loop, которого нет больше нигде. Синтаксис для массивов может показаться тяжеловатым, собственно, он и тяжеловат, зато инициализировать их одно удовольствие.

Самое главное достоинство CL — гибкость и многовариантность синтаксиса. Одни и те же вещи можно делать множеством разных способов. Иногда это плохо, приходится больше внимания уделять соглашениями и руководствам, но в основном хорошо. Выразительность языка позволяет подойти к проблеме с любой удобной стороны и спросить документы.

Автор: akalenuk

Источник ^[1]