Code Review Request: Studious Student

[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
;;;;
;;;; 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)) и указания типов ни к чему хорошему не привели...