| Comments: |
Понятно, что с перебором всех перестановок она особой скоростью отличаться не будет :) > (вариант просто отсортировать исходный список не пройдет, например, для "za z")А если отсортировать список функцией, которая в отличие от #'string< трактует б ольшую длину в обратную строну?
(defun fb-string< (a b)
(iter (for char-a in-string a)
(for char-b in-string b)
(cond ((char< char-a char-b) (return t))
((char> char-a char-b) (return nil)))
(finally
(return (> (length a) (length b))))))
|
Не, так тоже не пройдет. Например, "yz y".
Ну и ведь может и много слов в одном умещаться, например слово из десяти символов, несколько слов по 1 и два символа... Вряд ли что-то кроме перебора придумать получится (и ограничения задачи явно на перебор рассчитаны).
Ну и хотелось бы советов, как можно в Lisp именно текущий алгоритм улучшить или переписать. Может, массивы вместо списков или задать длину строк... Вдруг кому-то опытному в Lisp очевидно, как сходу улучшить.
Проседания в производительности можно выявить с помощью time или профайлеров sb-profile или sb-sprof.
В принципе, в данном случае и без них видно, что самая неэффективная часть здесь -- #'concatenate, которая генерит кучу мусора.
Поэтому большую выгоду даст преаллокация рабочего буффера (строки) до map-permutations, и копирование данных туда вручную. Особенно хорошо будет, если в этом же цикле копирования параллельно будет расчитано сравнение с минимальным эталоном (чтобы избежать отдельного вызова #'string<), и еще лучше будет, чтобы по окончании копирования, если условие #'string< сработало, то эталон с рабочим буфером поменялись бы местами (rotatef, это спасет буфер от подбора gc).
Если непонятно, я могу ближе к ночи накидать код.
Ага, #'concatenate тут явно медленно работает (и очень большая разница по времени для слов длиной 10 и слов длиной 1), поэтому я перед конкатенацией делаю проверку, что первый фрагмент строки меньше текущего минимума (если фрагмент не меньше, то вся строка точно не меньше, т.к. ее длина больше; а если фрагмент меньше - то дальше смотреть надо). В принципе, можно эту идею развить и соединять кусочки строк последовательно и сравнивать с текущим минимумом, может быстрее будет.
А код было бы интересно посмотреть, пока непонятно.
Пишу второпях, так как надо убегать, но идея такая:
(defun minimal-string (s-list)
(let* ((total-chars (apply #'+ (mapcar #'length s-list)))
(min-string (make-array total-chars :element-type 'base-char :initial-element #\z))
(tmp-string (make-array total-chars :element-type 'base-char)))
(alexandria:map-permutations
(lambda (words)
(iter scanner
(with index = -1)
(with matched = nil)
(for word in words)
(iter (for char in-string word)
(incf index)
(unless (or matched (char<= char (elt min-string index)))
(return-from scanner))
(setf (elt tmp-string index) char
matched t))
(finally (rotatef min-string tmp-string))))
s-list :copy nil)
min-string))
|
Что касается максимально быстрой реализации алгоритма с перестановками, то у меня это выглядит так (получилось в 30000 раз шустрее исходного minimal-string):
(defun minimal-string (words)
(let ((min-string (make-array (apply #'+ (mapcar #'length words))
:element-type 'character
:initial-element #\z))
(tmp-vec (coerce words 'simple-vector)))
(find-minimal-string min-string tmp-vec)))
(defmacro defun/fast (name typed-args &body body)
`(defun ,name ,(mapcar #'first typed-args)
(declare (optimize (speed 3) (debug 0) (safety 0))
,@(iter (for (arg type) in typed-args)
(collect `(type ,type ,arg))))
,@body))
(defmacro iter/fast (&rest clauses)
`(iter (declare (declare-variables))
,@clauses))
(defun/fast find-minimal-string ((min-string (simple-array character *)) (tmp-vec simple-vector))
(let ((total (length tmp-vec)))
(declare (type fixnum total))
(labels ((permute (start offset)
(declare (type fixnum start offset))
(unless (= start total)
(iter/fast (for (the fixnum i) from start below total)
(rotatef (elt tmp-vec start) (elt tmp-vec i))
(iter/fast (with (the (simple-array character *) word) = (elt tmp-vec start))
(for char in-string word)
(for (the fixnum index) from offset)
(when (char> char (elt min-string index))
(leave))
(when (char< char (elt min-string index))
(words-vec->string tmp-vec min-string)
(finish))
(finally (permute (1+ start) (+ offset (length word)))))
(rotatef (elt tmp-vec start) (elt tmp-vec i))))
nil))
(permute 0 0)
min-string)))
(defun/fast words-vec->string ((words-vec simple-vector) (string (simple-array character *)))
(let ((char-index -1))
(declare (type fixnum char-index))
(flet ((copy-word (word)
(declare (type (simple-array character *) word))
(iter/fast (for (the fixnum i) from 0 below (length word))
(setf (elt string (incf char-index)) (elt word i)))))
(map nil #'copy-word words-vec))))
| Но вариант сортировки по a + b < b + a, разумеется, еще быстрее.
Круто, но уж как-то слишком много кода :-(
А как это скомпилировать? У меня SBCL ругается на "undefined function: COLLECT" и еще много чего.
permute - это какая-то библиотека?
Нужен iterate. Permute -- это я переписал руками генерацию перестановок вместо оного из alexandria. Ну а много кода -- тут все правильно, я же руками изобразил memcpy и перестановки, плюс все аннотации типов :) Это типа пример, как на CL писать производительно, а не кратко.
В общем, тут алгоритм простой - сортируем строки по критерию a + b < b + a. На лиспе все выливается в вызов sort с соответствующим :test.
Слова до 10 символов могут быть.
А вообще да, можно с сортировкой.
Критерий сортировки такой - дополняем строку меньшей длины ее последним символом, и сравниваем получившиеся строки, как обычно.
Т.е. для "za z" сравниваем za и zz, а для "yz y" - сравниваем yz и yy.
Вроде бы будет работать и для строк произвольной длины, еще не проверял.
Но это как бы не слишком очевидно. Т.е. интересно не решение конкретной задачи (для чего и этой программы хватило), а как, грубо говоря, приблизить скорость выполнения к скорости выполнения программы на C++ с этим же алгоритмом.
Ну и вообще по коду. Например, require() is deprecated. А как заменить?
>Слова до 10 символов могут быть.
Хорошо, но это ничего не меняет в алгоритме.
Ваш критерий сортировки не пойдет.
Например, ac acb. acb < acc, поэтому по предложенному вами алгоритму будет acbac. Хотя тут правильное решение - acacb.
На вторую часть и третью части вопроса - как можно ускорить данную программу и что можно улучшить - я постараюсь ответить позднее, так как тут нужен анализ.
К меньшему из слов нужно добавлять не последнюю букву, а само меньшее слово целиком. Мне видится что так сортировка будет работать правильно. Вот примерный код на scala, к сожалению не знаком с CL: def compare(a: String, b: String) = {
@tailrec
def compareRec(posA: Int, posB: Int): Int = {
if (posA == a.length) {
if (posB == b.length)
0
else
compareRec(0, posB)
} else {
if (posB == b.length)
compareRec(posA, 0)
else {
val diff = a.charAt(posA) - b.charAt(posB)
if (diff == 0)
compareRec(posA + 1, posB + 1)
else
diff
}
}
}
compareRec(0, 0)
}
Вместо require нужно использовать ASDF:
(asdf:oos 'asdf:load-op :alexandria)
и тому подобное.
Генерация всех перестановок это как то уже не оптимально, мне кажется лучше было бы использовать изначально более оптимальный алгоритм, например отсортировать все слова затем начать сборку результирующей строки при совпадении i-го слова с началом слова i+1 (i+2 и так далее) составить массив из окончания совпавших слов и слов следующих за ними по порядку в результате задача сводится к предыдущей :)
Но если хочется оптимизировать именно имеющийся алгоритм, то первое что нужно сделать это опять же отсортировать массив слов с учетом вашей проверки if (string< (first ss) minimal-string) это уменьшит количество вызывов concatenate. Либо вообще избавится от concatenate на самом деле он нужен только один для получения окончательного результата, избавляться можно тем же способом как действовали на icfp 2007 т.е. работать не со строкой а со ссылками на слова (массивом/списком содержащим номера слов в нужном порядке) тут придется написать свою функцию сравнения.
From: (Anonymous)
2011-01-18 09:15 am (UTC)
| (Link)
|
У меня получился такой вариант, похоже рабочий. Заранее извиняюсь за императивный код (C#):
string prefix = string.Empty;
while (true) {
words = words.OrderBy(x => x).ToList();
if (sorted.Count == 0) break;
string pr = words.First();
string sf = words.Skip(1)
.Where(a => a.StartsWith(pr))
.Select(s => s.Substring(pr.Length))
.Where(s => !string.IsNullOrEmpty(s))
.OrderBy(x => x + pr)
.FirstOrDefault();
if (string.Compare(pr + pr, pr + sf) < 0)
sf = null;
prefix += pr + sf;
words.Remove(pr + sf);
}
return prefix; | |
