?

Log in

Code Review Request: Studious Student - Жить не можем без проблем! [entries|archive|friends|userinfo]
Жить не можем без проблем!

[ userinfo | livejournal userinfo ]
[ archive | journal archive ]

Code Review Request: Studious Student [Jan. 11th, 2011|04:46 pm]
Жить не можем без проблем!

ru_lisp

[kit1980ukr]
Решил вернуться к изучению Common Lisp, в рамках чего порешал задачки на квалификации Facebook Hacker Cup.

Под катом мое решение задачи "Studious Student".
Прошу посмотреть код и подсказать, что можно сделать лучше (быстрее, проще).

Краткое условие задачи (оригинальное условие сейчас уже не посмотришь, к сожалению):

Во входном файле в первой строке - количество тестов N.
В каждой последующей строке - первое число - количество слов M, далее M разделенных пробелами слов.
Для каждого теста вывести лексикографически минимальную комбинацию всех слов для данного теста.
1 <= N <= 100
1 <= M <= 9
В каждом слове максимум 10 символов.
Лимит времени - 6 минут на весь входной файл (плюс еще надо успеть скопировать и отправить результаты).

Тесты-примеры:

example.in:

5
6 facebook hacker cup for studious students
5 k duz q rc lvraw
5 mybea zdr yubx xe dyroiy
5 jibw ji jp bw jibw
5 uiuy hopji li j dcyi

example.out:

cupfacebookforhackerstudentsstudious
duzklvrawqrc
dyroiymybeaxeyubxzdr
bwjibwjibwjijp
dcyihopjijliuiuy


Алгоритм я использовал очень простой (с небольшой вариацией) - генерация всех перестановок слов, конкатенация слов для этой перестановки и выбор из всех минимальной строки (вариант просто отсортировать исходный список не пройдет, например, для "za z").


;;;; Facebook Hacker Cup - 2011
;;;; Qualification Round
;;;; Studious Student
;;;;
;;;; Sergey Dymchenko <kit1980@gmail.com>
;;;;
;;;; Language: Common Lisp
;;;; Tested with SBCL 1.0.29 - http://www.sbcl.org/
;;;; sbcl --noinform --load lisp-file < in-file > out-file
;;;;
;;;; Libraries used:
;;;; Alexandria - http://common-lisp.net/project/alexandria/
;;;; split-sequence - http://www.cliki.net/SPLIT-SEQUENCE

(eval-when (:compile-toplevel :load-toplevel :execute)
  (require 'alexandria)
  (require 'split-sequence))

(defun minimal-string (s-list)
  (let ((minimal-string (apply #'concatenate 'simple-base-string s-list)) 
        current-string)
    (alexandria:map-permutations 
     #'(lambda (ss) 
         (if (string< (first ss) minimal-string)
             (progn 
               (setf current-string (apply #'concatenate 'simple-base-string ss))
               (if (string< current-string minimal-string)
                   (setf minimal-string current-string))))) 
     s-list :copy nil)
    minimal-string))

(defun case-string-to-list (s)
  (split-sequence:split-sequence 
   #\Space s
   :start 1 :remove-empty-subseqs t))

(defun solve ()
  (let ((n (read)))
    (dotimes (i n) 
      (format t "~a~%" (minimal-string (case-string-to-list (read-line))))))
  0)

(solve)
(quit)


Программа работает, но не очень быстро: на максимальном входном файле (100 тестов по 9 слов по 10 символов в каждом) на моем компьютере считает чуть больше 4 минут. Попытки добавления (declare (optimize (speed 3) (safety 0)) и указания типов ни к чему хорошему не привели...
linkReply

Comments:
[User Picture]From: swizard
2011-01-11 04:45 pm (UTC)
Понятно, что с перебором всех перестановок она особой скоростью отличаться не будет :)

> (вариант просто отсортировать исходный список не пройдет, например, для "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))))))

(Reply) (Thread)
[User Picture]From: kit1980ukr
2011-01-11 05:06 pm (UTC)
Не, так тоже не пройдет. Например, "yz y".
Ну и ведь может и много слов в одном умещаться, например слово из десяти символов, несколько слов по 1 и два символа... Вряд ли что-то кроме перебора придумать получится (и ограничения задачи явно на перебор рассчитаны).

Ну и хотелось бы советов, как можно в Lisp именно текущий алгоритм улучшить или переписать. Может, массивы вместо списков или задать длину строк... Вдруг кому-то опытному в Lisp очевидно, как сходу улучшить.
(Reply) (Parent) (Thread)
[User Picture]From: swizard
2011-01-11 05:35 pm (UTC)
Проседания в производительности можно выявить с помощью time или профайлеров sb-profile или sb-sprof.

В принципе, в данном случае и без них видно, что самая неэффективная часть здесь -- #'concatenate, которая генерит кучу мусора.

Поэтому большую выгоду даст преаллокация рабочего буффера (строки) до map-permutations, и копирование данных туда вручную. Особенно хорошо будет, если в этом же цикле копирования параллельно будет расчитано сравнение с минимальным эталоном (чтобы избежать отдельного вызова #'string<), и еще лучше будет, чтобы по окончании копирования, если условие #'string< сработало, то эталон с рабочим буфером поменялись бы местами (rotatef, это спасет буфер от подбора gc).

Если непонятно, я могу ближе к ночи накидать код.
(Reply) (Parent) (Thread)
[User Picture]From: kit1980ukr
2011-01-11 05:53 pm (UTC)
Ага, #'concatenate тут явно медленно работает (и очень большая разница по времени для слов длиной 10 и слов длиной 1), поэтому я перед конкатенацией делаю проверку, что первый фрагмент строки меньше текущего минимума (если фрагмент не меньше, то вся строка точно не меньше, т.к. ее длина больше; а если фрагмент меньше - то дальше смотреть надо). В принципе, можно эту идею развить и соединять кусочки строк последовательно и сравнивать с текущим минимумом, может быстрее будет.

А код было бы интересно посмотреть, пока непонятно.
(Reply) (Parent) (Thread)
[User Picture]From: swizard
2011-01-11 06:23 pm (UTC)
Пишу второпях, так как надо убегать, но идея такая:


(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))

(Reply) (Parent) (Thread)
[User Picture]From: swizard
2011-01-12 09:26 pm (UTC)
Что касается максимально быстрой реализации алгоритма с перестановками, то у меня это выглядит так (получилось в 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, разумеется, еще быстрее.
(Reply) (Parent) (Thread)
[User Picture]From: kit1980ukr
2011-01-12 10:44 pm (UTC)
Круто, но уж как-то слишком много кода :-(

А как это скомпилировать? У меня SBCL ругается на "undefined function: COLLECT" и еще много чего.
permute - это какая-то библиотека?
(Reply) (Parent) (Thread)
[User Picture]From: swizard
2011-01-12 11:04 pm (UTC)
Нужен iterate.

Permute -- это я переписал руками генерацию перестановок вместо оного из alexandria.

Ну а много кода -- тут все правильно, я же руками изобразил memcpy и перестановки, плюс все аннотации типов :) Это типа пример, как на CL писать производительно, а не кратко.
(Reply) (Parent) (Thread)
[User Picture]From: dmitry_vk
2011-01-11 05:58 pm (UTC)
В общем, тут алгоритм простой - сортируем строки по критерию a + b < b + a. На лиспе все выливается в вызов sort с соответствующим :test.
(Reply) (Thread)
[User Picture]From: kit1980ukr
2011-01-11 06:26 pm (UTC)
Слова до 10 символов могут быть.

А вообще да, можно с сортировкой.
Критерий сортировки такой - дополняем строку меньшей длины ее последним символом, и сравниваем получившиеся строки, как обычно.

Т.е. для "za z" сравниваем za и zz, а для "yz y" - сравниваем yz и yy.

Вроде бы будет работать и для строк произвольной длины, еще не проверял.

Но это как бы не слишком очевидно. Т.е. интересно не решение конкретной задачи (для чего и этой программы хватило), а как, грубо говоря, приблизить скорость выполнения к скорости выполнения программы на C++ с этим же алгоритмом.

Ну и вообще по коду. Например, require() is deprecated. А как заменить?
(Reply) (Parent) (Thread)
[User Picture]From: dmitry_vk
2011-01-11 06:49 pm (UTC)
>Слова до 10 символов могут быть.

Хорошо, но это ничего не меняет в алгоритме.

Ваш критерий сортировки не пойдет.
Например, ac acb. acb < acc, поэтому по предложенному вами алгоритму будет acbac. Хотя тут правильное решение - acacb.

На вторую часть и третью части вопроса - как можно ускорить данную программу и что можно улучшить - я постараюсь ответить позднее, так как тут нужен анализ.
(Reply) (Parent) (Thread)
[User Picture]From: kit1980ukr
2011-01-11 07:04 pm (UTC)
Да, точно.
Спасибо.
(Reply) (Parent) (Thread)
[User Picture]From: incrab
2011-01-13 09:18 am (UTC)
К меньшему из слов нужно добавлять не последнюю букву, а само меньшее слово целиком.
Мне видится что так сортировка будет работать правильно.

Вот примерный код на 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)
    }
(Reply) (Parent) (Thread)
[User Picture]From: lispnik
2011-01-12 05:35 am (UTC)

Вместо require нужно использовать ASDF:

(asdf:oos 'asdf:load-op :alexandria)

и тому подобное.

(Reply) (Parent) (Thread)
From: ln_123
2011-01-12 06:50 am (UTC)
Генерация всех перестановок это как то уже не оптимально, мне кажется лучше было бы использовать изначально более оптимальный алгоритм, например отсортировать все слова затем начать сборку результирующей строки при совпадении i-го слова с началом слова i+1 (i+2 и так далее) составить массив из окончания совпавших слов и слов следующих за ними по порядку в результате задача сводится к предыдущей :)

Но если хочется оптимизировать именно имеющийся алгоритм, то первое что нужно сделать это опять же отсортировать массив слов с учетом вашей проверки if (string< (first ss) minimal-string) это уменьшит количество вызывов concatenate. Либо вообще избавится от concatenate на самом деле он нужен только один для получения окончательного результата, избавляться можно тем же способом как действовали на icfp 2007 т.е. работать не со строкой а со ссылками на слова (массивом/списком содержащим номера слов в нужном порядке) тут придется написать свою функцию сравнения.
(Reply) (Thread)
From: (Anonymous)
2011-01-18 09:15 am (UTC)
У меня получился такой вариант, похоже рабочий. Заранее извиняюсь за императивный код (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;
(Reply) (Thread)