?

Log in

No account? Create an account
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 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)