VPF::Помогите написать программу сортировки списка

Actosunc

Дата 7.3.2010, 19:25 (ссылка)

(голосов:1)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 11
Регистрация: 22.1.2010

Репутация: нет
Всего: нет

Прошу помочь в написании программы сортировки списка методом Шелла-Седжвика. Вообще реализацию я нашел, но условие задачи накладывает запрет на использование функций set, setq, setf и циклов, поэтому тот код не подходит.

k0rvin

Дата 8.3.2010, 17:35 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 442
Регистрация: 24.1.2010

Репутация: нет
Всего: 5

Цитата(Actosunc @ 7.3.2010, 19:25)

мб как-то так:

Код


(defvar *sedgewick-sequence*
  (delete-duplicates
   (sort
    (loop for i from 0 to 5
       collect (+ (* 9 (expt 4 i)) (* -9 (expt 2 i)) 1)
       collect (+ (expt 4 i) (* 3 (expt 2 i)) 1))
    #'>)))

(defun shell-sort (xs &optional (sequence *sedgewick-sequence*))
  (let* ((len (length xs))
         (seq (member len sequence :test #'>)))
    (labels ((iter (xs seq)
           (if (null seq)
                   xs
                   (iter (apply #'mapcan #'list
                                (mapcar #'sort-part
                                        (group-each (car seq) xs)))
                         (cdr seq)))))
      (iter xs seq))))

(defun sort-part (xs)
  (if (null xs)
      xs
      (let* ((min  (apply #'min xs))
             (rest (remove-if #'(lambda (x) (= x min))
                              xs
                              :count 1)))
        (cons min (sort-part rest)))))

(defun group-each (n xs)
  (labels ((iter (i xs group groups)
             (cond ((null xs)
                    (mapcar #'(lambda (xs)
                                (remove-if #'null xs))
                            (apply #'mapcar #'list
                                   (nreverse
                                    (cons (nreverse
                                           (append (make-list i)
                                                   group))
                                          groups)))))
                   ((<= i  0) (iter (1- n)
                                    (cdr xs)
                                    (list (car xs))
                                    (cons (nreverse group)
                                          groups)))
                   (t (iter (1- i)
                            (cdr xs)
                            (cons (car xs) group)
                            groups)))))
    (iter n xs nil nil)))

;;; Testing:
CL-USER> (defun random-list (size range)                                                                    
           (let ((r (max 1 range)))                                                                         
             (loop for i below size                                                                         
                collect (random r))))                                                          
RANDOM-LIST                                                                                                 
CL-USER> (let ((xs (random-list 10 10)))                                                                    
           (values xs (shell-sort xs)))
(4 5 2 0 4 8 4 3 3 6)                                                                                       
(0 2 3 3 4 4 4 5 6 8)                                                                                       
CL-USER>

--------------------

“Object-oriented design is the roman numerals of computing.” — Rob Pike
All software sucks

Actosunc

Дата 8.3.2010, 20:57 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 11
Регистрация: 22.1.2010

Репутация: нет
Всего: нет

k0rvin, большое спасибо.

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| LISP \| Следующая тема »