Форумы caduser.ru

 
Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти  
   RSS
Уроки создания рекурсивных функций
Решил потихоньку делиться опытом создания рекурсий, к сожалению, сразу сделать большую статью не могу, но, если тема будет интересна, буду потихоньку выкладывать
функции с максимально возможным объяснением. Наверное, это будет выглядеть как уроки, а может и дискуссия, но в любом случае, единственная задача, которую я хочу решить, это научить вас спокойно создавать и использовать такие функции на равнее с другими.
Для начала хотелось бы объяснить термин "рекурсия" это обычная функция (процедура), которая в процессе выполнения вызывает сама себя.
Применительно к Лиспу, некоторое объяснение есть в книге
С.Зуева и Н. Полещука "САПР на базе AutoCAD. Как это делается"
на страницах 273 - 286
Петр Лоскутов очень доступно изложил принципы работы рекурсий и сделал некоторое расследование - стоит ли их использовать и зачем. Мое личное мнение - СТОИТ, но убеждать не буду.
Структура рекурсивной функции:
(скопировано из вышеупомянутой книги)
Код

(defun my-test-function (arg)
  (if <условие>
    (my-test-function (<некая тестовая функция> arg))
     <действие  при невыполненном условии>
  ) ;_  if
) ;_  defun

Для начала создадим простую рекурсию - аналог mapcar
Код
(setq lst (list 1 2 3))

Так выглядит реализация увеличения всех элементов на единицу с использованием mapcar
Код
(mapcar '1+ lst)

А так рекурсия
Код

(defun rec_1+ (lst)
  (if lst
    (cons (1+ (car lst))
      (rec_1+ (cdr lst))
    ) ;_  cons
  ) ;_  if
) ;_  defun

вызывать:
Код
(rec_1+ lst)

Теперь разберем ее работу
Код
(defun rec_1+ (lst)
;с первой строкой, я думаю, все понятно
  (if lst
;| со второй, думаю тоже, но на всякий случай поясню - здесь проверяется наличие в переменной lst
каких либо данных - если есть выполняем следующую строку если нет - возвращаем NIL |;
  (cons (1+ (car lst))  (rec_1+ (cdr lst)))
;| добавляем увеличенное на единицу значение первого элемента списка к результату, полученному при выполнении программы rec_1+ со списком без первого элемента |;
  ;если же
  ) ;_  if
) ;_  defun

Для простоты разверну рекурсию со списком '(1 2 3) заменив программу на ее содержимое
Код

(if  '(1 2 3)
  (cons
    (1+
      (car '(1 2 3))
    ) ;_  1+  => 2
    (if (cdr '(1 2 3))
       (cons
         (1+
           (cadr '(1 2 3))
         ) ;_  1+  => 3
         (if  (cddr '(1 2 3))
           (cons
             (1+
               (caddr '(1 2 3))
             ) ;_  1+  => 4
             (if  (cdddr '(1 2 3))
               (cons (1+ (car lst)) (rec_1+ (cdr lst)))
             ) ;_  if  => NIL
           ) ;_  cons  => '(4)
         ) ;_  if  => '(4)
       ) ;_  cons  => '(3 4)
     ) ;_  if  => '(3 4)
   ) ;_  cons  => '(2 3 4)
) ;_  if  => '(2 3 4)

теперь сделаем тоже самое, но с двумя списками, опять же аналог mapcar
Код

(setq lst_1 (list 1 2 3)  lst_2 (list 4 5 6))
(mapcar '+ lst_1 lst_2) ;  => '(5 7 9)

и рекурсия
Код

(defun rec_+ (lst_1 lst_2)
  (if (and lst_1 lst_2)
      (cons (+ (car lst_1)(car lst_2))
        (rec_+ (cdr lst_1)(cdr lst_2))
      ) ;_  cons
   ) ;_  if
) ;_  defun

Вызывать:
Код
(rec_+ lst_1 lst_2)

Надеюсь, не трудно догадаться, как будет выглядеть функция для трех и более аргументов...
Код

(setq lst_1 '(7 8 9) lst_2 '(4 5 6) lst_3 '(1 2 3))
(mapcar '- lst_1 lst_2 lst_3) ;  => '(2 1 0)

и рекурсия
Код

(defun rec_- (lst_1 lst_2 lst_3)
  (if (and lst_1 lst_2 lst_3)
    (cons (- (car lst_1)(car lst_2)(car lst_3))
      (rec_- (cdr lst_1)(cdr lst_2)(cdr lst_3))
    ) ;_  cons
  ) ;_  if
) ;_  defun

Вызывать:
Код

(rec_- lst_1 lst_2 lst_3)

Аналогию с mapcar можно продолжать и дальше, но думаю, интереснее различия, например, mapcar умеет подавать на вход функции только по одному первому элементу из каждого аргумента - списка, а для рекурсии это не проблема!
Возьмем простейший пример,
Код

(setq lst '(1 2 3 4 5 6 7 8 9))

Такой список координат "точек" можно получить после vla-IntersectWith и других функций, но для Лиспа их нужно преобразовать в список точек.
Код

(defun rec_lst_3d (lst)
  (if lst
    (cons
      (list
        (car lst)
        (cadr lst)
        (caddr lst)
      ) ;_  list
      (rec_lst_3d (cdddr lst))
    ) ;_  cons
  ) ;_  if
) ;_  defun

Вызывать:
Код

(rec_lst_3d lst)

получаем
Код

'((1 2 3) (4 5 6) (7 8 9))  
Страницы: Пред. 1 2 3 4 5 След.
Ответы
Хочу внести, некоторую ясность, по поводу примеров, приведенных в уроках 4 и 5.
Код

(defun rec-member-if (fun lst)
  (if (apply fun (list(car lst)))
    lst
    (rec-member-if fun (cdr lst))
  ) ;_  if
) ;_  defun

Вызывать:
Код

(setq fun (function (lambda (x) (= (car x) 10)))
      lst '((100 . "AcDbLine")
            (10 0.0 10.0 0.0)
            (11 30.0 50.0 0.0)
            (210 0.0 0.0 1.0)
           )
) ;_  setq
(rec-member-if fun lst)

Здесь, мы неименованную функцию, присваиваем переменной.
Это не правильно, с точки зрения Лиспа, но удобно, для написания урока
и разбора работы рекурсии.
Если вы будете использовать такой код, то делайте его вызов:
Код

(defun rec-member-if (fun lst)
  (if (apply fun (list(car lst)))
    lst
    (rec-member-if fun (cdr lst))
  ) ;_  if
) ;_  defun
(setq lst '((100 . "AcDbLine")
            (10 0.0 10.0 0.0)
            (11 30.0 50.0 0.0)
            (210 0.0 0.0 1.0)
           )
) ;_  setq
(rec-member-if (function (lambda (x) (= (car x) 10))) lst)

После вызова программы rec-member-if неименованная функция,
автоматически присвоится переменной 'FUN на время работы
программы. После завершения программы, переменная 'FUN освободится!
Аналогично будет выглядеть код и с другими предложенными рекурсиями:
Код

(defun rec-every (fun lst-1 lst-2)
  (if (and lst-1 lst-1)
    (and
      (eval
        (list
          fun
          (car lst-1)
          (car lst-2)
        ) ;_  list
      ) ;_  eval
      (rec-every fun (cdr lst-1) (cdr lst-2))
    ) ;_  and
    T
  ) ;_  if
) ;_  defun
(setq lst-1'(1 2) lst-2 '(1 2 3))
(rec-every (function =) lst-1 lst-2)

Код

(defun rec-member-if-not (fun lst)
  (if (apply fun (list(car lst)))
    (rec-member-if-not fun (cdr lst))
    lst
  ) ;_  if
) ;_  defun
(setq lst '(1 "Str" (0 . "line") nil t))
(rec-member-if-not (function atom) lst)
[rus]Predlagaju adminu sdelat' dopolnitel'nuju
vetku pod nazvaniem 'obuchenie potomu chto
proidet vremja i my delitanty lispa ne naidem
sxodu takie zamechatel'nie primery
spasibo tebe evgenij prosto super[/rus]
> Lenivij (2006-03-13 14:28:14)
Так есть же раздел [url board.cgi?p=44]"Программирование :: Готовые программы"[/url].
> den-si (2006-03-13 14:53:10)
Мне кажется, что это две совершенно разных вещи, так как Евгений Елпанов обучает, а не пишет готовые программы. Но в той иерархии форумов которая существует я не вижу куда можно было бы поместить эту ветку. Разве что "закрепить" ее (а возможно потом и другие аналогичные), чтобы они не "утонули" в пределах форума LISP. Если, конечно, это возможно...
Цитата
Здесь мы неименованную функцию присваиваем переменной.
Это не правильно, с точки зрения Лиспа...

Отчего же, с точки зрения LISPа символ можно связать в том числе и с лексическим замыканием (function ...), почему нет?
> VH (2006-03-13 17:50:41)
Наверное, я не очень корректно выразился...
Если есть возможность не занимать лишних переменных, то лучше так и делать. Без упомянутой вами поправки, получается, что я рекомендую, всегда присваивать (function ...) переменной, а только потом вызывать рекурсию! Считаю это неправильным, но удобным для объяснения в уроках
Урок 6
Рассмотрим функцию, работающую подобно vl-remove
ее назначение смотрите в справке
пример стандартного применения:
Код

(vl-remove 10 '(5 10 15 20))
;Возвращает:
;'(5 15 20)

А вот и сама рекурсия.
Код

(defun rec-remove (el lst)
  (cond
    ((not lst)
     nil
    )
    ((= el (car lst))
     (rec-remove el (cdr lst))
    )
    (T
     (cons (car lst)
           (rec-remove el (cdr lst))
     ) ;_  cons
    ) ;_  T
  ) ;_  cond
) ;_  defun
;Вызывать:
(setq el 10
      lst '(5 10 15 20)
) ;_  setq
(rec-remove el lst)
; Вернет '(5 15 20)

Очень надеюсь - вас не смутит, что в рекурсии есть два места,
из которых, она может вызвать сама себя.
А теперь разберем, как работает рекурсия:
В первой строке, как всегда, пишем проверку для выхода.
Код
((not lst) nil)

Здесь мы проверяем переменную 'LST на наличие данных
и если результат отличен от NIL переходим на вторую строку.
Во второй строке мы проверяем равенство удаляемого элемента
и первого элемента в списке 'LST
Код
(= el (car lst))

Если 'EL равен первому элементу в 'LST переходим на третью строку,
иначе на пятую (четвертая - закрывающая скобка).
В третьей строке
Код
(rec-remove el (cdr lst))

мы вызываем рекурсию, с укороченным списком - без первого элемента
т.е. если удаляемый элемент равен первому элементу в списке, то
продолжаем программу, просто его пропустив.
В пятой строке, вместо проверки, у нас стоит T - это значит,
что если программа дошла до проверки, то она всегда верна.
Другими словами, если у нас есть непустой список и его первый элемент
не равен удаляемому, то переходим на шестую строку
В шестой мы добавляем к списку полученному
в результате вычислений в седьмой строке первый элемент списка 'LST
Код
(cons (car lst)

В седьмой строке, самовызов функции без первого элемента
Код
(rec-remove el (cdr lst))

Теперь, пошагово, рассмотрим работу рекурсии.
С этого места будет удобно скопировать урок в ЛИСП-редактор...
Код

  ; Сама рекурсия
(defun rec-remove (el lst)
  (cond
    ((not lst)
     nil
    )
    ((= el (car lst))
     (rec-remove el (cdr lst))
    )
    (T
     (cons (car lst)
           (rec-remove el (cdr lst))
     ) ;_  cons
    ) ;_  T
  ) ;_  cond
) ;_  defun
  ; Аргументы
(setq el 10
      lst '(5 10 15 20)
) ;_  setq
  ; Вызывать
(rec-remove el lst)
;; Шаг 1.
  ;el = 10
  ;lst = '(5 10 15 20)
(defun rec-remove (el lst)
  (cond
    ((not lst) ; Получаем Nil переходим на следующую проверку
     nil ; Пропускаем
    )
    ((= el (car lst)) ; (= 10 5) Получаем Nil переходим на следующую проверку
     (rec-remove el (cdr lst)) ; Пропускаем
    )
    (T
     (cons
       (car lst) ; Получаем 5
       (rec-remove
         el
         (cdr lst) ; Получаем '(10 15 20)
       ) ; Переходим на шаг 2 для вычислений
     ) ;_  cons
    ) ;_  T
  ) ;_  cond
) ;_  defun
;; Шаг 2.
  ;el = 10
  ;lst = '(10 15 20)
(defun rec-remove (el lst)
  (cond
    ((not lst) ; Получаем Nil переходим на следующую проверку
     nil ; Пропускаем
    )
    ((= el (car lst)) ; (= 10 10) Получаем  T переходим на следующую строку
     (rec-remove
       el
       (cdr lst) ; Получаем '(15 20)
     ) ;Переходим на шаг 3 для вычислений
    )
    (T ; не дошли
     (cons
       (car lst) ; не дошли
       (rec-remove
         el
         (cdr lst) ; не дошли
       ) ; не дошли
     ) ;_  cons
    ) ;_  T
  ) ;_  cond
) ;_  defun
;; Шаг 3.
  ;el = 10
  ;lst = '(15 20)
(defun rec-remove (el lst)
  (cond
    ((not lst) ; Получаем Nil переходим на следующую проверку
     nil ; Пропускаем
    )
    ((= el (car lst)) ; (= 10 15) Получаем Nil переходим на следующую проверку
     (rec-remove ; Пропускаем
       el
       (cdr lst) ; Пропускаем
     ) ; Пропускаем
    )
    (T
     (cons
       (car lst) ; Получаем 15
       (rec-remove
         el
         (cdr lst) ; Получаем '(20)
       ) ; Переходим на шаг 4 для вычислений
     ) ;_  cons
    ) ;_  T
  ) ;_  cond
) ;_  defun
;; Шаг 4.
  ;el = 10
  ;lst = '(20)
(defun rec-remove (el lst)
  (cond
    ((not lst) ; Получаем Nil переходим на следующую проверку
     nil ; Пропускаем
    )
    ((= el (car lst)) ; (= 10 20) Получаем NIL переходим на следующую проверку
     (rec-remove ; Пропускаем
       el
       (cdr lst) ; Пропускаем
     ) ;  Пропускаем
    )
    (T
     (cons
       (car lst) ; Получаем 20
       (rec-remove
         el
         (cdr lst) ; Получаем NIL
       ) ; Переходим на шаг 5 для вычислений
     ) ;_  cons
    ) ;_  T
  ) ;_  cond
) ;_  defun
;; Шаг 5.
  ;el = 10
  ;lst = NIL
(defun rec-remove (el lst)
  (cond
    ((not lst) ; Получаем T переходим на следующую строку
     nil
    ) ; Возвращаем NIL
    ((= el (car lst)) ; не дошли
     (rec-remove ; не дошли
       el
       (cdr lst) ; не дошли
     ) ; не дошли
    )
    (T ; не дошли
     (cons
       (car lst) ; не дошли
       (rec-remove
         el
         (cdr lst) ; не дошли
       ) ; не дошли
     ) ; не дошли
    ) ; не дошли
  ) ; Возвращаем NIL
) ; Возвращаем NIL переходим на шаг 4
;; Шаг 4.
  ;el = 10
  ;lst = '(20)
(defun rec-remove (el lst)
  (cond
    ((not lst) ; Пропускаем - уже вычислено
     nil
    )
    ((= el (car lst)) ; Пропускаем - уже вычислено
     (rec-remove
       el
       (cdr lst)
     ) ;_  rec-remove
    )
    (T
     (cons
       (car lst) ; Уже вычислено 20
       (rec-remove ; Уже вычислено NIL
         el
         (cdr lst)
       ) ; Уже вычисленно NIL
     ) ; (cons 20 nil) Получаем '(20)
    ) ; Возвращаем '(20)
  ) ; Возвращаем '(20)
) ; Возвращаем '(20) и переходим на шаг 3
;; Шаг 3.
  ;el = 10
  ;lst = '(15 20)
(defun rec-remove (el lst)
  (cond
    ((not lst) ; Пропускаем - уже вычислено
     nil
    )
    ((= el (car lst)) ; Пропускаем - уже вычислено
     (rec-remove
       el
       (cdr lst)
     ) ;_  rec-remove
    )
    (T
     (cons
       (car lst) ; Уже вычислено 15
       (rec-remove ; Уже вычислено '(20)
         el
         (cdr lst)
       ) ; Уже вычислено '(20)
     ) ; (cons 15 '(20)) Получаем '(15 20)
    ) ; Возвращаем '(15 20)
  ) ; Возвращаем '(15 20)
) ; Возвращаем '(15 20) и переходим на шаг 2
;; Шаг 2.
  ;el = 10
  ;lst = '(10 15 20)
(defun rec-remove (el lst)
  (cond
    ((not lst) ; Пропускаем - уже вычислено
     nil
    )
    ((= el (car lst)) ; переходим на следующую строку - уже вычислено
     (rec-remove ; Уже вычислено '(15 20)
       el
       (cdr lst)
     ) ; Уже вычислено '(15 20)
    ) ; Возвращаем '(15 20)
    (T ; не дошли
     (cons
       (car lst)
       (rec-remove
         el
         (cdr lst)
       ) ;_  rec-remove
     ) ;_  cons
    ) ; не дошли
  ) ; Возвращаем '(15 20)
) ; Возвращаем '(15 20) и переходим на шаг 1
;; Шаг 1.
  ;el = 10
  ;lst = '(5 10 15 20)
(defun rec-remove (el lst)
  (cond
    ((not lst) ; Пропускаем - уже вычислено
     nil
    )
    ((= el (car lst)) ; Пропускаем - уже вычислено
     (rec-remove
       el
       (cdr lst)
     ) ;_  rec-remove
    )
    (T
     (cons
       (car lst) ; Уже вычислено 5
       (rec-remove ; Уже вычислено '(15 20)
         el
         (cdr lst)
       ) ; Уже вычислено '(15 20)
     ) ; (cons 5 '(15 20)) Получаем '(5 15 20)
    ) ; Возвращаем '(5 15 20)
  ) ; Возвращаем '(5 15 20)
) ; Возвращаем '(5 15 20)
Когда смотришь приведенные примеры - понятно, начинаешь сам сочинять что-то посложнее - ступор...
Надо упражняться, конечно, но время не всегда есть. Поэтому, если позволите, небольшие вопросики:
1) Попробовал написать функцию удаления дубликатов из списка, вроде работает, но хотелось бы без (member...), как?
Код

(defun rec-remove-dbl (LST)
  (if LST
    (if (member (car LST)(cdr LST))
      (rec-remove-dbl (cdr LST))
      (cons (car LST)(rec-remove-dbl (cdr LST)))
    )
  )
)

2) Набросайте пример рекурсии, удаляющей елементы, заданные списком ILST, из основного списка LST
Код
(defun rec-remove-idbl (ILST LST))

т.е.
Код
(defun rec-remove-idbl '(1 4) '(1 2 3 4 4 5 1 1 6 1 4))

должна возвратить (2 3 5 6)
Заранее благодарен.
Многие задают мне один и тот же вопрос, отвечу сразу всем.
Продолжение уроков, обязательно будет!
Сейчас очень занят по работе - пришла пора сдавать большой проект...
Еще хотелось бы спросить у вас совета...
Стоит ли и дальше расписывать работу рекурсии пошагово, или достаточно подробного описания ее работы?
Вопрос родился не с потолка, при личном общении, мне были такие предложения.
> Kosarev (2006-04-01 10:35:27)
По первому вопросу...
Код

(defun rec-rem-dupl (lst)
  (if lst
    (cons (car lst) (rec-rem-dupl (rec-remove (car lst) (cdr lst))))
  ) ;_  if
) ;_  defun
(defun rec-remove (el lst)
  (cond
    ((not lst) nil)
    ((= el (car lst))(rec-remove el (cdr lst)))
    (T(cons (car lst)(rec-remove el (cdr lst))))
  ) ;_  cond
) ;_  defun
;Проверка
(rec-rem-dupl '(1 2 3 4 4 5 1 1 6 1 4))

По второму вопросу...
Код

(defun rec-remove-idbl (ilst lst)
  (if ilst
    (rec-remove-idbl (cdr ilst) (rec-remove (car ilst) lst))
    lst
  ) ;_  if
) ;_  defun
;Проверка
(rec-remove-idbl '(1 4) '(1 2 3 4 4 5 1 1 6 1 4))
Большое спасибо!
Мне лично достаточно объяснения. Пошаговый разбор требуются, я думаю, когда человек ещё недостаточно представляет работу основных функций VL вообще и, вероятно, для него вопрос о рекурсиях на этом этапе не стоит в принципе. А для ознакомления первые уроки доходчиво разобраны...
С уважением.
> Kosarev (2006-04-01 11:36:34)
Мне уже несколько раз сказали, что если кому нужно пошаговое объяснение - пусть перечитывают первые уроки... Может так и стоит сделать?
ИМХО: ДА! За пошаговыми разъяснениями - в начало.
Урок 7
На прошлом уроке, мы рассматривали аналог функции VL-REMOVE
Сегодня я хочу показать аналоги функций:
VL-REMOVE-IF
VL-REMOVE-IF-NOT
VL-POSITION
Рассмотрим VL-REMOVE-IF
Пример стандартного применения:
Код

(setq f (function(lambda (x)(< 8 x 12)))
      lst '(5 10 15 20)
) ;_  setq
(vl-remove-if f lst)
;Возвращает:
;  '(5 15 20)

А вот и сама рекурсия.
Код

(defun rec-remove-if (f lst)
(cond
  ((not lst)
   nil
  )
  (((eval f)
    (car lst)
   )
   (rec-remove-if
    f
    (cdr lst)
   ) ;_  rec-remove-if
  )
  (T
   (cons
    (car lst)
    (rec-remove-if
     f
     (cdr lst)
    ) ;_  rec-remove-if
   ) ;_  cons
  ) ;_  T
) ;_  cond
) ;_  defun
; Вызывать:
(setq f (function(lambda (x)(< 8 x 12)))
      lst '(5 10 15 20)
) ;_  setq
(rec-remove-if f lst)
; Вернет '(5 15 20)

Разберем, как она работает.
В первой проверке, как всегда, организуем выход,
на случай пустого списка и возвращаем NIL
Код

((not lst) ; Проверка списка.
nil ; Возвращаемое значение, для пустого списка.
)

Во второй проверке, применяем тестовую функцию
к первому элементу списка. Если тестовая функция вернет
значение, отличное от NIL делаем самовызов рекурсии
со списком без первого элемента.
Код

(((eval f) ; Активируем тестовую функцию.
  (car lst) ; Вычисляем первый элемент списка.
) ; Применяем тестовую функцию к первому элементу списка.
(rec-remove-if
  f ; Тестовая функция
  (cdr lst) ; Список без первого элемента
) ; Самовызов рекурсии с укороченным списком
)

Третья проверка всегда верна (вместо проверки стоит T).
До этой строки программа дойдет только в случае, если мы имеем,
не пустой список с первым элементом, пропущенным тестовой функцией.
Здесь мы добавляем первый элемент списка, к результату рекурсии,
примененной к укороченному списку - без первого элемента.
Код

(T ; проверка - всегда верна
(cons
  (car lst) ; Вычисляем первый элемент списка.
  (rec-remove-if
   f ; Тестовая функция.
   (cdr lst) ; Список без первого элемента.
  ) ; Самовызов рекурсии с укороченным списком.
) ; Добавление первого элемента к результату рекурсии.
) ;_  T

Рассмотрим VL-REMOVE-IF-NOT
Пример стандартного применения:
Код

(setq f (function(lambda (x)(< 8 x 17)))
      lst '(5 10 15 20)
) ;_  setq
(vl-remove-if-not f lst)
;Возвращает:
;  '(10 15)

А вот и сама рекурсия.
Код

(defun rec-remove-if-not (f lst)
(cond
  ((not lst)
   nil
  )
  (((eval f)
     (car lst)
    )
   (cons
    (car lst)
    (rec-remove-if-not
     f
     (cdr lst)
    ) ;_  rec-remove-if
   )
  )
  (T
   (rec-remove-if-not
     f
     (cdr lst)
    ) ;_  rec-remove-if
  ) ;_  T
) ;_  cond
) ;_  defun
;Вызывать:
(setq f (function(lambda (x)(< 8 x 17)))
      lst '(5 10 15 20)
) ;_  setq
(rec-remove-if-not f lst)
;Возвращает:
;  '(10 15)

Эта функция очень похожа на предыдущую, разница только
во второй и третьей проверках, действия после проверок
поменялись местами. Надеюсь, вас не затруднит,
самостоятельно разобраться в этой рекурсии.
Рассмотрим VL-POSITION
Пример стандартного применения:
Код

(vl-position 4 '(2 4 6 4))
;Возвращает:
; 1
А вот и сама рекурсия.
(defun rec-position (test lst / rec-position)
  (defun rec-position (test lst i)
    (cond
      ((not lst) nil)
      ((equal test (car lst)) i)
      (t (rec-position test (cdr lst) (1+ i)))
    ) ;_  cond
  ) ;_  defun
  (rec-position test lst 0)
) ;_  defun
;Вызывать:
(setq test 4
      lst  '(2 4 6 4)
) ;_  setq
(rec-position test lst)
; Вернет 1

А теперь разберем, как работает рекурсия:
Функция REC-POSITION состоит из двух частей.
В первой части мы определяем локальную функцию
с тем же названием но с дополнительным аргументом,
который будем использовать как счетчик.
Код

(defun rec-position (test lst i)
(cond
  ((not lst) nil)
  ((equal test (car lst)) i)
  (t (rec-position test (cdr lst) (1+ i)))
) ;_  cond
) ;_  defun

Аргументы:
test - Тестовое значение, позицию которого определяем в списке.
lst - Список, в котором ищем позицию тестового значения.
i - Счетчик, при первом вызове устанавливаем на 0 (зеро)
Во второй части, мы делаем вызов, только, что определенной
функции.
Код

(rec-position test lst 0)

Теперь, немного подробнее, рассмотрим внутреннюю функцию.
Как всегда, в первой проверке COND , мы делаем возможность выхода.
Проверяем, что список не пустой. Если пустой - возвращаем NIL
Код

((not lst) ; Проверка списка.
nil ; Возвращаемое значение, для пустого списка.
)

Во второй проверке, мы сверяем тестовое значение
с первым элементом списка. Если они одинаковые,
возвращаем содержимое счетчика.
Код

((equal
  test ; Тестовое значение.
  (car lst) ; Первый элемент списка.
  ) ; Сравниваем первый элемент списка и тестовое значение.
i ; Счетчик - возвращаем при равенстве тестовой функции.
)

Третья проверка всегда верна (вместо проверки стоит T).
До этой строки программа дойдет только в случае, если мы имеем,
не пустой список с первым элементом неравным тестовому значению.
Здесь мы делаем самовызов функции, со списком, без первого элемента,
и счетчиком, увеличенным на единицу.
Код

(t ; проверка - всегда верна.
(rec-position
  test ; Тестовое значение.
  (cdr lst) ; Укороченный список.
  (1+ i) ; Счетчик увеличенный на единицу.
) ; Самовызов функции rec-position.
)

Теперь пару слов о переопределении функции.
Можно пользоваться этой рекурсией без внутреннего переопределения,
но тогда, придется каждый раз, указывать начальное значение счетчика,
при вызове.
Например:
Код

(defun rec-position (test lst i)
(cond
  ((not lst) nil)
  ((equal test (car lst)) i)
  (t (rec-position test (cdr lst) (1+ i)))
) ;_  cond
) ;_  defun
; Аргументы:
(setq test 4
      lst  '(2 4 6 4)
) ;_  setq
; Вызывать:
(rec-position test lst 0)

Или можно определить две независимые функции,
первая - вызываемая, вторая - вспомогательная.
Например:
Код

(defun rec-position (test lst)
(rec-position-1 test lst 0)
) ;_  defun
(defun rec-position-1 (test lst i)
(cond
  ((not lst) nil)
  ((equal test (car lst)) i)
  (t (rec-position-1 test (cdr lst) (1+ i)))
) ;_  cond
) ;_  defun
; Аргументы:
(setq test 4
      lst  '(2 4 6 4)
) ;_  setq
; Вызывать:
(rec-position test lst)

По аналогии с функциями
VL-REMOVE-IF
можно написать аналог для
VL-POSITION
с использованием тестовой функции,
а не значения и возвращением всех позиций списком...
Например функция:
Код

(defun rec-position-list-if (f lst / rec-position-list-if)
  (defun rec-position-list-if (f lst i)
   (cond
    ((not lst) nil)
    (((eval f) (car lst)) (cons i (rec-position-list-if f (cdr lst) (1+ i))))
    (t (rec-position-list-if f (cdr lst) (1+ i)))
   ) ;_  cond
  ) ;_  defun
  (rec-position-list-if f lst 0)
) ;_  defun
;Вызывать:
(setq f (function minusp)
      lst '(5 -10 15 -20)
) ;_  setq
(rec-position-list-if f lst)
; Вернет
; '(1 3)

Все предложенные варианты работают.
Вариант, с переопределением функции,
я предложил с надеждой, что вы его разберете и сможете использовать,
при необходимости...
PS. Хочу сказать пару слов, по поводу компиляции проектов, содержащих рекурсии.
Все нижесказанное относится к AutoCad 2004 - в других версиях не исследовал,
возможно, вы сможете дать рекомендации для других версий.
При компиляции нельзя использовать опции:
"Separate Namespace" (Отдельное именное пространство)
"Optimize and Link" (Оптимизация и связывание)
При их использовании, рекурсии либо не работают, либо работают не корректно.
Причем, это относится только к *.VLX
При использовании *.FAS либо *.LSP - никаких проблем!
Урок 8
Закончить рассмотрение встроенных функций
с префиксом VL- и написание их аналогов,
хочу функцией VL-SORT
Я написал несколько вариантов этой функции,
при помощи рекурсий, используя различные алгоритмы.
На нескольких уроках, мы их рассмотрим.
Реализация VL-SORT - с помощью рекурсии, гораздо сложнее функций,
рассмотренных, на предыдущих занятиях. Если вам не до конца понятны
предыдущие уроки, рекомендую рассмотреть их еще раз.
Сразу хочу оговориться - эти варианты работают медленнее,
чем встроенная функция, но моя задача научить создавать рекурсии,
а не написать библиотеку функций.
Для начала, рассмотрим самый простой алгоритм.
Его название "Сортировка методом выбора" или "Selection sort".
Это самый медленный, из рассматриваемых мной алгоритмов.
Код

(defun rec-min (lst mi f)
  ; Вычисляем минимальное
  ; значение списка, применяя тестовую функцию
  ;(rec-min (cdr lst) (car lst) f)
  (cond
    ((not lst) mi)
    (((eval f) (car lst) mi)
     (rec-min (cdr lst) (car lst) f)
    )
    (t (rec-min (cdr lst) mi f))
  ) ;_  cond
) ;_  defun
(defun rec-remove-singl (i lst)
  ; Удаляем первое вхождение элемента из списка
  ;(rec-remove-singl (cadr lst) lst)
  (if lst
    (if (equal i (car lst))
      (cdr lst)
      (cons (car lst) (rec-remove-singl i (cdr lst)))
    ) ;_  if
  ) ;_  if
) ;_  defun
(defun rec-sort-min (lst f)
  ;(rec-sort-min lst)
  (if lst
    ((lambda (x)
       (cons
         x
         (rec-sort-min
           (rec-remove-singl
             x
             lst
           ) ;_  заканчиваем удаление
           f
         ) ;_  заканчиваем рекурсию для дочерней рекурсии с укороченным списком
       ) ;
     ) ;_  lambda
      (rec-min (cdr lst) (car lst) f)
    )
  ) ;_  if
) ;_  defun
  ; Проверим:
(setq lst '(7 3 4 6 9 6 7 2 5 3 2 3 6 4 6 3 1)
      f   (function <)
) ;_  setq
(rec-sort-min lst f)
; Возвращает
; '(1 2 2 3 3 3 3 4 4 5 6 6 6 6 7 7 9)

У нас есть список и функция сравнения, по результату которой,
либо T либо NIL
Например
список '(1 3 2)
функция '<
Мы можем просмотреть весь список и выбрать самое маленькое значение
Точнее то, которое будет давать T с любым элементом списка.
Потом ставим его в начало результирующего списка,
удаляем первое вхождение найденного значения в изучаемом списке и к укороченному списку,
рекурсивно, применяем функцию еще раз... И так, до окончания списка.
На нашем примере, результат должен выглядеть
Код

(cons 1(cons 2(cons 3 nil))); => '(1 2 3)

Из описания алгоритма понятно, что нам понадобится три программы.
Первая, должна искать в списке минимальное значение.
Вторая - удалять первое вхождение, найденного элемента, из списка.
Третья - запускать в нужной последовательности, первые две
и формировать конечный список...
Функция поиска минимального значения:
На входе мы имеем тестовое значение, список и функцию.
Если применяя функцию к первому элементу списка и тестовому значению
мы получаем T - значит первое значение списка ближе к искомому значению
и мы перезапускаем функцию с укороченным списком, а бывший, первый элемент,
ставим вместо тестового значения.
Иначе, перезапускаем функцию с укороченным списком, но тем же тестовым значением.
Вот и рекурсия, для поиска минимального значения:
Код

(defun rec-min (lst mi f)
  (cond
    ((not lst) ; Если кончился список
     mi ; Возвращаем найденное минимальное значение
    )
    (((eval f) ; Активируем функцию
       (car lst) ; Первый элемент списка
       mi ; Текущее минимальное значение
     ) ; Если Т переходим на следующую строку и меняем минимальное значение
     (rec-min ; Самовызов рекурсии
       (cdr lst) ; Укороченный список
       (car lst) ; Новое минимальное значение
       f ; Тестовая функция
     ) ;  rec-min
    )
    (t ; Если дошли, всегда правда
     (rec-min ; Самовызов рекурсии
       (cdr lst) ; Укороченный список
       mi ; Старое минимальное значение
       f ; Тестовая функция
     ) ;_  rec-min
    ) ;_  t
  ) ;_  cond
) ;_  defun
; Проверим:
(setq lst '(7 3 4 6 9 6 7 2 5 3 2 3 6 4 6 3 1)
      f   (function <)
) ;_  setq
(rec-min (cdr lst) (car lst) f)
; Возвращает
; 1

Я специально, в проверке, запускаю функцию с укороченным списком,
указывая тестовым значением первый элемент.
Именно так она и будет работать.
Функция удаления первого вхождения элемента в списке.
Кстати, во многих случаях, она будет работать быстрее,
чем VL-REMOVE - ей не нужно просматривать весь список!
На входе мы имеем удаляемый элемент и список.
Ничего необычного в этой функции нет,
надеюсь, что вы уже сами можете написать подобную.
В первой проверке, как всегда список. Если он не закончился,
проверяем равенство тестового элемента и первого элемента списка.
Если не равно, добавляем первый элемент к результату рекурсии без первого элемента,
иначе возвращаем список без первого элемента.
Код

(defun rec-remove-singl (i lst)
  (if lst ; Если не кончился список
    (if (equal i (car lst)) ; Сравниваем тестовое значение и первый элемент списка
      (cdr lst) ; Укороченный список
      (cons ; Формируем список
        (car lst) ; Первый элемент списка
        (rec-remove-singl ; Самовызов рекурсии
          i ; Тестовое значение
          (cdr lst) ; Укороченный список
        ) ;_  rec-remove-singl
      ) ;_  cons
    ) ;_  if
  ) ;_  if
) ;_  defun
; Проверка:
(setq lst '(7 3 4 6 9)
      i   4
      f   (function <)
) ;_  setq
(rec-remove-singl i lst)
; Возвращает
; '(7 3 6 9)

Хотелось бы добавить, проверка на наличие списка не обязательна,
но я добавил ее, зная, что эту функцию будут копировать в свои программы,
забыв добавить такую проверку.
Функция формирования отсортированного списка из минимальных значений,
в порядке их нахождения, с одновременным удалением найденных значений
из сортируемого списка.
На входе мы имеем список и тестовую функцию.
В этой программе, всего одна проверка на окончание списка.
Чтобы не плодить лишние переменные,
я воспользовался пользовательской функцией LAMBDA
очень надеюсь, что вас это не смутит.
Т.е. первым делом, после загрузки LAMBDA выражения
вычисляется строка
Код

(rec-min (cdr lst) (car lst) f)

или, другими словами, ищется минимальное значение в списке.
Потом, найденное значение, передается как аргумент,
в функцию LAMBDA
где удаляется первое вхождение этого значения из списка
и происходит самовызов рекурсии с добавлением найденного
значения к результату.
Код

(defun rec-sort-min (lst f)
  (if lst ; Если не кончился список
    ((lambda (x)
       ;; Пользовательская функция
       ;; С аргументом - вычисленное минимальное значение списка
       (cons ; Формируем список
         x ; Минимальное значение списка
         (rec-sort-min ; Самовызов рекурсии
           (rec-remove-singl ; Удаление первого вхождения элемента в списке
             x ; Минимальное значение списка
             lst ; Список
           ) ;_  заканчиваем удаление
           f ; Тестовая функция
         ) ;_  заканчиваем рекурсию для дочерней рекурсии с укороченным списком
       ) ;_  cons
     ) ;_  lambda
      (rec-min (cdr lst) (car lst) f) ; Поиск минимального значения
    )
  ) ;_  if
) ;_  defun
  ; Проверим:
(setq lst '(7 3 4 6 9 6 7 2 5 3 2 3 6 4 6 3 1)
      f   (function <)
) ;_  setq
(rec-sort-min lst f)
; Возвращает
; '(1 2 2 3 3 3 3 4 4 5 6 6 6 6 7 7 9)
Урок 9
На прошлом уроке, мы рассмотрели программу сортировки списка
методом выбора или "Selection sort".
Очевидно, что его можно улучшить, выбирая не только минимальные значения
из списка, но и максимальные.
Т.е. мы будем выбирать из списка минимальное и максимальное значения
и добавлять их в результирующий список в начало и конец,
а оставшийся после удаления первых вхождений этих элементов список
будем снова обрабатывать с целью поиска минимального и максимального
значений.
Короче, этот алгоритм аналогичен предыдущему.
Очевидно, что для реализации, опять, потребуется три подпрограммы:
1 - поиск самого минимального и максимального значения списка
2 - удаление первого вхождения элемента, заданного аргументом, из списка
3 - запуск в нужной последовательности, первых двух программ
и формирование результирующего списка...
Код

(defun rec-min-max (lst mi ma f)
  ; Вычисляем минимальное и максимальные
  ; значения списка применяя тестовую функцию
  (cond
    ((not lst) (list mi ma))
    (((eval f) (car lst) mi)
     (rec-min-max (cdr lst) (car lst) ma f)
    )
    (((eval f) ma (car lst))
     (rec-min-max (cdr lst) mi (car lst) f)
    )
    (t (rec-min-max (cdr lst) mi ma f))
  ) ;_  cond
) ;_  defun
(defun rec-remove-singl (i lst)
  ; Удаляем первое вхождение элемента из списка
  (if lst
    (if (equal i (car lst))
      (cdr lst)
      (cons (car lst) (rec-remove-singl i (cdr lst)))
    ) ;_  if
  ) ;_  if
) ;_  defun
(defun rec-sort-min-max (lst f)
  ;(rec-sort-min-max lst f)
  (cond
    ((not lst) nil)
    ((not(cdr lst)) lst)
    (t
     ((lambda (x)
        (cons
          (car x)
          (append
            (rec-sort-min-max
              (rec-remove-singl
                (car x)
                (rec-remove-singl
                  (cadr x)
                  lst
                ) ;_  rec-remove-singl
              ) ;_  rec-remove-singl
              f
            ) ;_  rec-sort-lists
            (cdr x)
          ) ;_  append
        ) ;_  cons
      ) ;_  lambda
       (rec-min-max (cdr lst) (car lst) (car lst) f)
     )
    )
  ) ;_  cond
) ;_  defun
  ; Проверим:
(setq lst '(7 3 4 6 9 6 7 2 5 3 2 3 6 4 6 3 1)
      f   (function <)
) ;_  setq
(rec-sort-min-max lst f)
; Возвращает
; '(1 2 2 3 3 3 3 4 4 5 6 6 6 6 7 7 9)

Т.к. работа рекурсии очень похожа на рассмотренную на восьмом уроке,
я собираюсь более коротко рассматривать работу функций, делая акцент
на изменениях.
Рассмотрим работу рекурсии,
которая ищет минимальное и максимальные значения.
Код

(defun rec-min-max (lst mi ma f)
  ; Вычисляем минимальное и максимальные
  ; значения списка применяя тестовую функцию
  (cond
    ((not lst) (list mi ma))
    (((eval f) (car lst) mi)
     (rec-min-max (cdr lst) (car lst) ma f)
    )
    (((eval f) ma (car lst))
     (rec-min-max (cdr lst) mi (car lst) f)
    )
    (t (rec-min-max (cdr lst) mi ma f))
  ) ;_  cond
) ;_  defun
; Проверим:
(setq lst '(7 3 4 6 9 6 7 2 5 3 2 3 6 4 6 3 1)
      f   (function <)
) ;_  setq
(rec-min-max (cddr lst) (car lst)(car lst) f)
; Возвращает
; '(1 9)

Как видно из кода - программа отличается от REC-MIN
дополнительным аргументом и дополнительной проверкой...
Дополнительный аргумент - переменная,
в которой будем сохранять максимальное значение,
а дополнительная проверка, для его поиска.
Код

(defun rec-min-max (lst mi ma f)
  (cond
    ((not lst) ; Если кончился список
     (list mi ma)
  ; Возвращаем список из минимального и максимального значения
    )
    (((eval f) ; Активируем функцию
       (car lst) ; Первый элемент списка
       mi ; Текущее минимальное значение
     ) ; Если Т переходим на следующую строку и меняем минимальное значение
     (rec-min-max ; Самовызов рекурсии
       (cdr lst) ; Укороченный список
       (car lst) ; Новое минимальное значение
       ma ; Старое максимальное значение
       f ; Тестовая функция
     ) ;_  rec-min-max
    )
    (((eval f) ; Активируем функцию
       ma ; Текущее максимальное значение
       (car lst) ; Первый элемент списка
     ) ; Если Т переходим на следующую строку и меняем максимальное значение
     (rec-min-max ; Самовызов рекурсии
       (cdr lst) ; Укороченный список
       mi ; Старое минимальное значение
       (car lst) ; Новое максимальное значение
       f ; Тестовая функция
     ) ;_  rec-min-max
    )
    (t ; Если дошли, всегда правда
     (rec-min-max ; Самовызов рекурсии
       (cdr lst) ; Укороченный список
       mi ; Старое минимальное значение
       ma ; Старое максимальное значение
       f ; Тестовая функция
     ) ;_  rec-min-max
    )
  ) ;_  cond
) ;_  defun
; Проверим:
(setq lst '(10 7 3 4 6 9 6 7 2 5 3 2 3 1 6 4 6 3)
      f   (function <)
) ;_  setq
(rec-min-max (cddr lst) (car lst)(car lst) f)
; Возвращает
; '(1 10)

Функция удаления первого вхождения элемента вообще не изменилась,
поэтому я ее не рассматриваю.
С основной функцией несколько сложнее.
Здесь нам нужна еще одна проверка на длину списка,
т.е. перед поиском минимального и максимального значений,
нужно проверить, что список имеет более одного элемента и если
список состоит из одного элемента искать минимальное и максимальное
значения бессмысленно.
Для этой проверки будем пользоваться выражением:
Код

(not(cdr lst)) ;Если список без первого элемента не пустой.

Такой подход, очевидно быстрее, чем:
Код

(> (length lst) 1)

Далее все по аналогии с предыдущей функцией rec-sort-min.
Два раза вызываем функцию удаления первого вхождения элемента,
первый раз для минимального, второй для максимального значения.
Потом формируем окончательный список,
минимальное значение ставим в начало функцией CONS
а максимальное APPEND ...
Код

(defun rec-sort-min-max (lst f)
  (cond
    ((not lst) ; Если кончился список
     nil
    )
    ((not (cdr lst)) ;Если список без первого элемента не пустой.
     lst ; Список с одним элементом
    )
    (t
     ((lambda (x)
        ;; Пользовательская функция
        ;; С аргументом - список из минимального
        ;; и максимального значения
        (cons ; Формируем начало списка
          (car x) ; Минимальное значение списка
          (append ; Формируем конец списка
            (rec-sort-min-max
              (rec-remove-singl
                (car x)
                (rec-remove-singl
                  (cadr x)
                  lst
                ) ;_  заканчиваем удаление максимального значения
              ) ;_  заканчиваем удаление минимального значения
              f ; Тестовая функция
            ) ;_  заканчиваем рекурсию для дочерней рекурсии с укороченным списком
            (cdr x) ; Максимальное значение списка
          ) ;_  append
        ) ;_  cons
      ) ;_  lambda
       (rec-min-max (cdr lst) (car lst) (car lst) f)
  ; Поиск минимального и максимального значения
     )
    )
  ) ;_  cond
) ;_  defun
  ; Проверим:
(setq lst '(7 3 4 6 9 6 7 2 5 3 2 3 6 4 6 3 1)
      f   (function <)
) ;_  setq
(rec-sort-min-max lst f)
; Возвращает
; '(1 2 2 3 3 3 3 4 4 5 6 6 6 6 7 7 9)

Хотелось бы добавить, что этот вариант сортировки быстрее предыдущего,
но не значительно. Его можно еще улучшить, например, изменив функцию удаления, чтоб она брала в качестве аргумента список...
ДОМАШНЕЕ ЗАДАНИЕ:
Измените программу, пусть функция удаления вызывается один раз,
со списком удаляемых элементов.
Урок 10
Метод быстрой сортировки.
Немного справки:
Быстрая сортировка (англ. quicksort)
- широко известный алгоритм сортировки,
разработанный английским информатиком Чарльзом Хоаром.
Более подробно:
http://en.wikipedia.org/wiki/Quicksort
http://ru.wikipedia.org/wiki/Быстрая_сортировка
Заключается алгоритм в разделении списка на две части по условию,
что все элементы первого списка меньше, чем все элементы второго.
На практике, я беру первый элемент списка и сравниваю его со всеми
остальными элементами. Все, что меньше, добавляем в список минимальных значений,
остальные в список с максимальными значениями. Далее, рекурсивно применяем такую функцию
к обоим спискам. Элемент считается стоящим на месте, если он один в списке.
Объясню алгоритм на примере:
Есть список '(2 3 1 0)
и функция <
Т.к. мы будем разделять список на подсписки, сначала его преобразуем во
вложенный список '((2 3 1 0)).
Далее берем для сравнения первый элемент первого подсписка
и сравниваем его с каждым элементом первого подсписка без первого элемента,
добавляя сравниваемый элемент в список минимальных значений, при условии,
что сравниваемый элемент меньше тестового, иначе в список максимальных значений.
получаем:
тестовое значение 2
минимальный список '(1 0)
максимальный список '(3)
потом объединяем все в один список
'((1 0)(2)(3))
И начинаем все сначала...
При таком подходе, может оказаться, что один из списков пустой, а значит
на его месте появится пустой список - NIL .Для некоторого упрощения
я добавил проверку списка на длину более двух элементов,
если элементов всего два - их можно сразу поставить по местам.
Что бы реализовать этот алгоритм, я его логически поделил на три программы.
Первая программа делит список на два, сравнивая все элементы с тестовым значением.
Далее нам нужна программа, вызывающая сортировку и формирующая результирующий список.
На входе в программу сортировки подается список,
а мы собираемся делить его на подсписки,
значит, для начала нужно создать список, в котором первым и единственным элементом,
будет весь исходный список для сортировки, далее его будем делить на куски,
внутри этого списка. Исходя из темы урока - изучение рекурсий,
нужно максимально использовать рекурсии, но ухудшать скорость не хотелось
и я вынес создание вложенного списка из сортируемого, в отдельную программу.
Код

(defun rec-quicksort-2 (lst lst1 lst2 test f)
  (cond
    ((not lst)
      (list lst1 (list test) lst2)
    )
    (((eval f) (car lst) test)
     (rec-quicksort-2 (cdr lst) (cons (car lst) lst1) lst2 test f)
    )
    (t (rec-quicksort-2 (cdr lst) lst1 (cons (car lst) lst2) test f))
  ) ;_  cond
) ;_  defun
(defun rec-quicksort-1 (lst f)
  (cond
    ((not lst) nil)
    ((not (car lst)) (rec-quicksort-1 (cdr lst) f))
    ((not (cdar lst))
     (cons (caar lst) (rec-quicksort-1 (cdr lst) f))
    )
    ((not (cddar lst))
     (if (apply f (car lst))
       (cons (caar lst) (cons (cadar lst) (rec-quicksort-1 (cdr lst) f)))
       (cons (cadar lst) (cons (caar lst) (rec-quicksort-1 (cdr lst) f)))
     ) ;_  if
    )
    (t
     ((lambda (x)
        (rec-quicksort-1 (cons (car x) (cons (cadr x) (cons (caddr x) (cdr lst)))) f)
      ) ;_  lambda
       (rec-quicksort-2 (cdar lst) nil nil (caar lst) f)
     )
    )
  ) ;_  cond
) ;_  defun
(defun rec-quicksort (lst f)
  ;(rec-quicksort '(7 3 4 6 9 6 7 2 5 3 2 3 6 4 6 3 1) (function <))
  (rec-quicksort-1 (list lst) f)
) ;_  defun
  ; Проверим:
(setq lst '(7 3 4 6 9 6 7 2 5 3 2 3 6 4 6 3 1)
      f   (function <)
) ;_  setq
(rec-quicksort lst f)
  ; Возвращает
  ; '(1 2 2 3 3 3 3 4 4 5 6 6 6 6 7 7 9)

Рассмотрим работу первой подпрограммы rec-quicksort-2
она имеет на входе:
lst - сортируемый список
lst1 - пустой список, будем наполнять его минимальными значениями
lst2 - пустой список, будем наполнять его максимальными значениями
test - тестовое значение, сравнивая с ним, будем решать,
в какой из списков добавить элемент
F - тестовая функция
Алгоритм работы программы довольно прост - всего три проверки COND...
В первой проверке - проверяем наличие списка - уточняем, что список не пустой.
Если список закончился, значит нужно сформировать результирующий список:
Код

'((минимальные значения)
  (тестовый элемент, относительно которого сортировали)
  (максимальные значения)
)

Понятно, что списки максимальных и минимальных значений могут быть пустыми,
а значит, мы будем использовать NIL .
Вторая проверка - применение тестовой функции к первому элементу списка
и тестовому элементу. Если первый элемент меньше тестового элемента,
значит, первый элемент списка нужно добавить в список минимальных значений.
Другими словами, вызываем рекурсивно программу с укороченным сортируемым списком,
а в список минимальных элементов добавляем первый элемент списка.
Третья проверка COND всегда верна - если программа до нее дошла,
значит, у нас есть не пустой сортируемый список и первый элемент этого списка
не меньше тестового значения. Значит, в этой ветке COND нужно добавить
первый элемент списка в список максимальных значений и вызвать рекурсию
с укороченным сортируемым списком.
Код

(defun rec-quicksort-2 (lst lst1 lst2 test f)
  (cond
    ((not lst) ; Если кончился список
     (list ; Формируем список
       lst1 ; Список минимальных значений
       (list test) ; Список с тестовым значением
       lst2 ; Список максимальных значений
     ) ;_  list
    )
    (((eval f) ; Активируем функцию
       (car lst) ; Первый элемент списка
       test ; Тестовое значение
     ) ; Если Т добавляем первый элемент в список минимальных значений
     (rec-quicksort-2 ; Самовызов рекурсии
       (cdr lst) ; Укороченный список
       (cons ; Формируем список
         (car lst) ; Первый элемент списка
         lst1 ; Список минимальных значений
       ) ;_  cons
       lst2 ; Список максимальных значений
       test ; Тестовое значение
       f ; Тестовая функция
     ) ;_  rec-quicksort-2
    )
    (t ; Если дошли, значит есть не пустой список
  ; и первое значение не меньше тестового значения
     (rec-quicksort-2 ; Самовызов рекурсии
       (cdr lst) ; Укороченный список
       lst1 ; Список минимальных значений
       (cons ; Формируем список
         (car lst) ; Первый элемент списка
         lst2 ; Список максимальных значений
       ) ;_  cons
       test ; Тестовое значение
       f ; Тестовая функция
     ) ;_  rec-quicksort-2
    ) ;_  t
  ) ;_  cond
) ;_  defun
  ; Проверим:
(setq lst '((7 3 4 6 9 6 7 2 5 3 2 3 6 4 6 3 1))
      f   (function <)
) ;_  setq
(rec-quicksort-2 (cdar lst) nil nil (caar lst) f)
  ; Возвращает
  ; '((1 3 6 4 6 3 2 3 5 2 6 6 4 3) (7) (7 9))

Рассмотрим вторую рекурсивную подпрограмму - rec-quicksort-1
в ней будет пять проверок в COND :
В первой проверке проверим, что сортируемый список не пустой,
другими словами, что еще не весь список отсортирован.
Во второй проверке, проверим, что первый подсписок не пустой.
Пустым он может оказаться, если в предыдущей программе у нас список минимальных или
максимальных значений оказался пустым. В этом случае запускаем рекурсивно
программу rec-quicksort-1 без первого подсписка.
В третьей проверке, проверяем, что первый подсписок сортируемого списка,
имеет не более одного элемента - если в подсписке один элемент, значит элемент стоит
на своем месте и его уже не надо сортировать относительно остальных элементов списка
и мы можем его добавить в результирующий список.
В четвертой проверке мы проверяем, что первый подсписок имеет не более двух элементов.
Если элементов всего два, значит, нет смысла вызывать сортирующую программу - их проще
поставить на место сразу. Для начала применяем тестовую функцию к подсписку
из двух элементов и формируем результирующий отсортированный список,
добавляя к нему элементы из этого подсписка в порядке возрастания.
В пятой проверке, если ее можно так назвать - никакой проверки нет - всегда T
Понятно, что до этого места программа может дойти,
только если есть сортируемый список, в котором первый подсписок имеет более
двух элементов. Здесь мы первым делом сортируем первый подсписок на три подсписка.
Используя, лямбда функцию, временно запоминаем результат,
и последовательно добавляем подсписки из полученного списка в сортируемый список
без первого подсписка. Вообще то это можно было написать покороче,
вместо:
Код

((lambda (x)
   (rec-quicksort-1
     (cons
       (car x)
       (cons
         (cadr x)
         (cons
           (caddr x)
           (cdr lst)
         ) ;_  cons
       ) ;_  cons
     ) ;_  cons
     f
   ) ;_  rec-quicksort-1
) ;_  lambda
  (rec-quicksort-2
    (cdar lst)
    nil
    nil
    (caar lst)
    f
  ) ;_  rec-quicksort-2
)

используя конструкцию:
Код

(rec-quicksort-1
  (apply
    (function append)
    (list
      (rec-quicksort-2
        (cdar lst)
        nil
        nil
        (caar lst)
        f
      ) ;_  rec-quicksort-2
      (cdr lst)
    ) ;_  list
  ) ;_  apply
  f
) ;_  rec-quicksort-1

Но эта конструкция работает несколько медленнее, чем предложенная выше...
Вот собственно и сама рекурсия:
Код

(defun rec-quicksort-1 (lst f)
  (cond
    ((not lst) ; Если кончился список
     nil ; Заканчиваем рекурсию и возвращаем пустой список
    )
    ((not (car lst))
     (rec-quicksort-1
       (cdr lst)
       f
     ) ;_  rec-quicksort-1
    )
    ((not (cdar lst)) ; Если в первом подсписке только один элемент
     (cons ; Формируем список
       (caar lst) ; Первый и единственный элемент первого подсписка
       (rec-quicksort-1 ; Самовызов рекурсии
         (cdr lst) ; Укороченный список
         f ; Тестовая функция
       ) ;_  rec-quicksort-1
     ) ;_  cons
    )
    ((not (cddar lst)) ; Если в первом подсписке только два элемента
     (if (apply ; Применяем функцию к списку
           f ; Тестовая функция
           (car lst) ; Первый подсписок
         ) ;_  apply
       (cons ; Формируем список
         (caar lst) ; Первый элемент первого подсписка
         (cons ; Формируем список
           (cadar lst) ; Второй элемент первого подсписка
           (rec-quicksort-1 ; Самовызов рекурсии
             (cdr lst) ; Укороченный список
             f ; Тестовая функция
           ) ;_  rec-quicksort-1
         ) ;_  cons
       ) ;_  cons
       (cons ; Формируем список
         (cadar lst) ; Второй элемент первого подсписка
         (cons ; Формируем список
           (caar lst) ; Первый элемент первого подсписка
           (rec-quicksort-1 ; Самовызов рекурсии
             (cdr lst) ; Укороченный список
             f ; Тестовая функция
           ) ;_  rec-quicksort-1
         ) ;_  cons
       ) ;_  cons
     ) ;_  if
    )
    (t ; Если дошли, значит есть не пустой список
  ; и первый подсписок имеет более двух элементов
     ((lambda (x)
  ; Аргументом лямбда функции является результат программы rec-quicksort-2
        (rec-quicksort-1 ; Самовызов рекурсии
          (cons ; Формируем список
            (car x) ; Список минимальных значений
            (cons ; Формируем список
              (cadr x) ; Список со средним элементом - один в списке
              (cons ; Формируем список
                (caddr x) ; Список максимальных значений
                (cdr lst) ; Сортируемый список без первого элемента
              ) ;_  cons
            ) ;_  cons
          ) ;_  cons
          f ; Тестовая функция
        ) ;_  rec-quicksort-1
      ) ;_  lambda
       (rec-quicksort-2 ; Программа сортировки
         (cdar lst) ; Первый подсписок без первого элемента
         nil ; Пустой список минимальных элементов
         nil ; Пустой список максимальных элементов
         (caar lst) ; Первый элемент первого подсписка
         f ; Тестовая функция
       ) ;_  rec-quicksort-2
     )
    ) ;_  t
  ) ;_  cond
) ;_  defun
  ; Проверим:
(setq lst '((7 3 4 6 9 6 7 2 5 3 2 3 6 4 6 3 1))
      f   (function <)
) ;_  setq
(rec-quicksort-1 lst f)
  ; Возвращает
  ; '(1 2 2 3 3 3 3 4 4 5 6 6 6 6 7 7 9)

Последняя подпрограмма самая простая, можно сказать, что она вспомогательная,
т.к. написана только для вызова функции сортировки с такими же аргументами,
как у функции VL-SORT .
Ее задача, вложить сортируемый список в другой список и запустить программу сортировки.
Код

(defun rec-quicksort (lst f)
  (rec-quicksort-1 (list lst) f)
) ;_  defun
  ; Проверим:
(setq lst '(7 3 4 6 9 6 7 2 5 3 2 3 6 4 6 3 1)
      f   (function <)
) ;_  setq
(rec-quicksort lst f)
  ; Возвращает
  ; '(1 2 2 3 3 3 3 4 4 5 6 6 6 6 7 7 9)
Код
(defun PARTITION (меньший исходный больший)
(if (null (cdr исходный))
  (list меньший исходный больший)
  (if (> (car исходный) (cadr исходный))
   (PARTITION (cons (cadr исходный) меньший) (cons (car исходный) (cddr исходный)) больший)
   (PARTITION меньший (cons (car исходный) (cddr исходный)) (cons (cadr исходный) больший)))))

Код
(defun QUICKSORT (список)
(cond
  ((null список) nil)
  ((null (cdr список)) список)
  (T (apply 'append (mapcar 'QUICKSORT (PARTITION nil список nil))))))
> VH (2006-05-11 10:59:13)
Очень хороший и компактный код!
Большое спасибо, что, не только дочитали мои уроки до десятого, но и опубликовали свой вариант.
Уверен, многим он поможет лучше понять тему.
> VH (2006-05-11 10:59:13)
К сожалению, в вашем коде использованна довольно медленная функция
Код
'append

И из за нее, код получился медленнее моего.
Правда, если его привести к общему знаменателю...
Т.е. заменить вызов функции сравнения
Код
<
на
Код
(eval f)

Дело в том, что eval тоже имеет время выполнения и не маленькое.
Вот весь ваш код с изменениями:
Код
(defun PARTITION (меньший исходный больший)
  (if (null (cdr исходный))
    (list меньший исходный больший)
    (if ((eval f) (cadr исходный) (car исходный))
      (PARTITION (cons (cadr исходный) меньший) (cons (car исходный) (cddr исходный))больший)
      (PARTITION меньший (cons (car исходный) (cddr исходный)) (cons (cadr исходный) больший))
    ) ;_  if
  ) ;_  if
) ;_  defun
(defun QUICKSORT (список)
  (cond
    ((null список) nil)
    ((null (cdr список)) список)
    (T (apply 'append (mapcar 'QUICKSORT (PARTITION nil список nil))))
  ) ;_  cond
) ;_  defun

Привожу отчет о сравнении скорости:
Код

; Вызов сортировки с большим списком:
(setq lst (ATOMS-FAMILY 1) f '<)
(benchmark '((QUICKSORT lst)(rec-quicksort lst '<)))
; Результат сравнения скорости:
Benchmarking .....Elapsed milliseconds / relative speed for 4 iteration(s):
    (REC-QUICKSORT LST (QUOTE <)).....1125 / 1.26 <fastest>
    (QUICKSORT LST)...................1422 / 1 <slowest>
; Немного пояснений
; За время выполнения QUICKSORT
; функция REC-QUICKSORT успевает выполниться 1.26 раз
; Вариант с маленьким списком:
(setq lst '(1 5 21 6 8 0 11 7) f '<)
(benchmark '((QUICKSORT lst)(rec-quicksort lst f)))
; Результат сравнения скорости:
< Benchmarking ................Elapsed milliseconds / relative speed for 8192 iteration(s):
    (REC-QUICKSORT LST F).....1656 / 1.34 <fastest>
    (QUICKSORT LST)...........2219 / 1 <slowest>
А вот интересно, какие ещё стандартные функции, типа 'append можно отнести к "медленным"? Хотелось бы узнать мнение "секачей" по этому вопросу.
> Kosarev (2006-05-12 10:00:50)
Создай отдельную тему со своим вопросом, там и пообщаемся! Я с удовольствием поучавствую...
Эта ветка посвящена урокам по созданию рекурсий, а твой вопрос не в тему.
Ничего себе "вопрос не в тему"
Функция (<) (единственно подходящая по смыслу) заменяется функцией (eval) (которая "...тоже имеет время выполнения и не маленькое"), что ухудшает (или нет?) скоростные характеристики (каким боком скорость связана со смыслом?), после чего вызывают на старт.
На тему (append) не откажу себе в удовольствии процитировать Хювёнена-Сеппянена:
Цитата
Разумно использованные структуроразрушающие функции могут, как и нож хирурга, быть эффективными и полезными инструментами. Далее мы для примера рассмотрим, как можно с помощью структуроразрушающих псевдофункций повысить эффективность лисповской функции APPEND. APPEND объединяет в один список списки, являющиеся его аргументами:
Код
_(setq начало '(a b))
(A B)
(setq конец '(c d))
(C D)
_(setq результат (append начало конец))
(A B C D)

...APPEND создает копию списка, являющегося первым аргументом. Если этот список очень длинный, то долгими будут и вычисления. Создание списочных ячеек с помощью функции CONS требует времени и в будущем добавляет работы мусорщику. Если, например, список НАЧАЛО содержит 1000 элементов, а КОНЕЦ – один элемент, то во время вычисления будет создано 1000 новых ячеек, хотя вопрос состоит лишь в добавлении одного элемента к списку. Если бы последовательность аргументов была другой, то создалась бы одна ячейка, и списки были бы объединены приблизительно в 1000 раз быстрее.
Если для нас не существенно, что значение переменной НАЧАЛО изменится, то мы можем вместо функции APPEND использовать более быструю функцию NCONC (concatenate). Функция NCONC делает то же самое, что и APPEND, с той лишь разницей, что она просто объединяет списки, изменяя указатель в поле CDR последней ячейки списка, являющегося первым аргументом, на начало списка, являющегося вторым аргументом...

И как мы без NCONC живем?
Канечна, наряду с (*) есть гораздо более быстрая (+), только стоит ли заменять.
> VH (2006-05-12 12:18:24)
По поводу замены функции (<) на (eval), все очень просто...
Я рассматривал аналог функции vl-sort, а значит в аргументе нужно применять именно
'(<) Если вы не согласны, могу изменить свою программу, напрямую вписав в нее функцию проверки и сделать сравнение скорости выполнения...
По поводу темы, возможно вы и правы, но эта ветка уже очень разрослась, наверняка, у многих долго грузится.
PS. По поводу сравнения скорости (*) и (+) я иногда заменяю умножение на сложение и выигрываю драгоценное время...
Код
(benchmark '((+ 2 2)(* 2 2)))
    (+ 2 2).....1485 / 1.01 <fastest>
    (* 2 2).....1500 / 1 <slowest>
(benchmark '((+ pi pi)(* pi 2)))
    (+ PI PI).....1500 / 1.01 <fastest>
    (* PI 2)......1516 / 1 <slowest>
(benchmark '((+ 1520.3 1520.3) (* 1520.3 2)))
    (+ 1520.3 1520.3).....1516 / 1.01 <fastest>
    (* 1520.3 2)..........1531 / 1 <slowest>
(benchmark '((+ 2 2 2)(* 2 3)))
    (* 2 3).......1484 / 1.01 <fastest>
    (+ 2 2 2).....1500 / 1 <slowest>
(benchmark '((+ 1520.3 1520.3 1520.3)(* 1520.3 3)))
    (* 1520.3 3).................1516 / 1.05 <fastest>
    (+ 1520.3 1520.3 1520.3).....1594 / 1 <slowest>
(benchmark '((+ pi pi pi)(* pi 3)))
    (+ PI PI PI).....1500 / 1.01 <fastest>
    (* PI 3).........1516 / 1 <slowest>
(benchmark '((+ pi pi pi pi)(* pi 4)))
    (* PI 4)............1515 / 1.02 <fastest>
    (+ PI PI PI PI).....1547 / 1 <slowest>
Результаты сравнения скорости...
Тестовые программы:
Код

(defun PARTITION (меньший исходный больший)
(if (null (cdr исходный))
  (list меньший исходный больший)
  (if (> (car исходный) (cadr исходный))
   (PARTITION (cons (cadr исходный) меньший) (cons (car исходный) (cddr исходный)) больший)
   (PARTITION меньший (cons (car исходный) (cddr исходный)) (cons (cadr исходный) больший)))))
(defun QUICKSORT (список)
(cond
  ((null список) nil)
  ((null (cdr список)) список)
  (T (apply 'append (mapcar 'QUICKSORT (PARTITION nil список nil))))))
(defun rec-quicksort-2 (lst lst1 lst2 test)
  (cond
    ((not lst)
      (list lst1 (list test) lst2)
    )
    ((< (car lst) test)
     (rec-quicksort-2 (cdr lst) (cons (car lst) lst1) lst2 test)
    )
    (t (rec-quicksort-2 (cdr lst) lst1 (cons (car lst) lst2) test))
  ) ;_  cond
) ;_  defun
(defun rec-quicksort-1 (lst)
  (cond
    ((not lst) nil)
    ((not (car lst)) (rec-quicksort-1 (cdr lst)))
    ((not (cdar lst))
     (cons (caar lst) (rec-quicksort-1 (cdr lst)))
    )
    ((not (cddar lst))
     (if (apply '< (car lst))
       (cons (caar lst) (cons (cadar lst) (rec-quicksort-1 (cdr lst))))
       (cons (cadar lst) (cons (caar lst) (rec-quicksort-1 (cdr lst))))
     ) ;_  if
    )
    (t
     ((lambda (x)
        (rec-quicksort-1 (cons (car x) (cons (cadr x) (cons (caddr x) (cdr lst)))))
      ) ;_  lambda
       (rec-quicksort-2 (cdar lst) nil nil (caar lst))
     )
    )
  ) ;_  cond
) ;_  defun
(defun rec-quicksort (lst)
  (rec-quicksort-1 (list lst))
) ;_  defun

Результаты сравнения скорости:
Код

(setq lst (ATOMS-FAMILY 1))
(benchmark '((QUICKSORT lst)(rec-quicksort lst)))
; Результат сравнения скорости:
Benchmarking ......Elapsed milliseconds / relative speed for 8 iteration(s):
    (REC-QUICKSORT LST).....1203 / 1.48 <fastest>
    (QUICKSORT LST).........1781 / 1 <slowest>
; Немного пояснений
; За время выполнения QUICKSORT
; функция REC-QUICKSORT успевает выполниться 1.48 раз
; Вариант с маленьким списком:
(setq lst '(1 5 21 6 8 0 11 7))
(benchmark '((QUICKSORT lst)(rec-quicksort lst)))
; Результат сравнения скорости:
Benchmarking ................Elapsed milliseconds / relative speed for 8192 iteration(s):
    (REC-QUICKSORT LST).....1235 / 1.51 <fastest>
    (QUICKSORT LST).........1860 / 1 <slowest>
Видимо, имеет смысл опубликовать программу, которой я сравниваю скорость...
Код
(defun benchmark
;;;==================================================­===============
;;;
;;;  Benchmark.lsp | © 2005 Michael Puckett | All Rights Reserved
;;;
;;;==================================================­===============
;;;
;;;  Purpose:
;;;
;;;      Compare the performance of various statements.
;;;
;;;  Notes:
;;;
;;;      I make no claims that this is definitive benchmarking. I
;;;      wrote this utility for my own purposes and thought I'd
;;;      share it. Many considerations go into evaluating the
;;;      performance or suitability of an algorythm for a given
;;;      task. Raw performance as profiled herein is just one.
;;;
;;;      Please note that background dramatically affect results.
;;;
;;;  Disclaimer:
;;;
;;;      This program is flawed in one or more ways and is not fit
;;;      for any particular purpose, stated or implied. Use at your
;;;      own risk.
;;;
;;;==================================================­===============
;;;
;;;  Syntax:
;;;
;;;      (Benchmark statements)
;;;
;;;          Where statements is a quoted list of statements.
;;;
;;;==================================================­===============
;;;
;;;  Example:
;;;
;;;      (BenchMark
;;;         '(
;;;              (1+ 1)
;;;              (+ 1 1)
;;;              (+ 1 1.0)
;;;              (+ 1.0 1.0)
;;;          )
;;;      )
;;;
;;;==================================================­===============
;;;
;;;  Output:
;;;
;;;      Elapsed milliseconds / relative speed for 32768 iteration(s):
;;;
;;;          (1+ 1)..........1969 / 1.09 <fastest>
;;;          (+ 1 1).........2078 / 1.03
;;;          (+ 1 1.0).......2125 / 1.01
;;;          (+ 1.0 1.0).....2140 / 1.00 <slowest>
;;;
;;;==================================================­===============
                 (statements / _lset _rset _tostring _eval _princ _main)
;;;==================================================­===============
;;;
;;;  (_LSet text len fillChar)
;;;
;;;==================================================­===============
(defun _lset (text len fillchar / padding result)
  (setq
   padding (list (ascii fillchar))
   result  (vl-string->list text)
  ) ;_  setq
  (while
   (< (length
       (setq padding
             (append padding padding)
       ) ;_  setq
      ) ;_  length
      len
   ) ;_  <
  ) ;_  while
  (while
   (< (length
       (setq result
             (append result padding)
       ) ;_  setq
      ) ;_  length
      len
   ) ;_  <
  ) ;_  while
  (substr (vl-list->string result) 1 len)
) ;_  defun
;;;==================================================­===============
;;;
;;;  (_RSet text len fillChar)
;;;
;;;==================================================­===============
(defun _rset (text len fillchar / padding result)
  (setq
   padding (list (ascii fillchar))
   result  (vl-string->list text)
  ) ;_  setq
  (while
   (< (length
       (setq padding
             (append padding padding)
       ) ;_  setq
      ) ;_  length
      len
   ) ;_  <
  ) ;_  while
  (while
   (< (length
       (setq result
             (append padding result)
       ) ;_  setq
      ) ;_  length
      len
   ) ;_  <
  ) ;_  while
  (substr
   (vl-list->string result)
   (1+ (- (length result) len))
  ) ;_  substr
) ;_  defun
;;;==================================================­===============
;;;
;;;  (_ToString x)
;;;
;;;==================================================­===============
(defun _tostring (x / result)
  (if
   (< (strlen
       (setq result
             (vl-prin1-to-string x)
       ) ;_  setq
      ) ;_  strlen
      40
   ) ;_  <
   result
   (strcat (substr result 1 36) "..." (chr 41))
  ) ;_  if
) ;_  defun
;;;==================================================­===============
;;;
;;;  (_Eval statement iterations)
;;;
;;;==================================================­===============
(defun _eval (statement iterations / start)
  (gc)
  (setq start (getvar "millisecs"))
  (repeat iterations (eval statement))
  (- (getvar "millisecs") start)
) ;_  defun
;;;==================================================­===============
;;;
;;;  (_Princ x)
;;;
;;;==================================================­===============
(defun _princ (x)
  (princ x)
  (princ)
;;; forces screen update
) ;_  defun
;;;==================================================­===============
;;;
;;;  (_Main statements)
;;;
;;;==================================================­===============
(defun _main
        (statements / boundary iterations timings slowest fastest lsetlen rsetlen index count)
  (setq
   boundary 1000
   iterations 1
  ) ;_  setq
  (_princ "Benchmarking ...")
  (while
   (or
    (< (apply 'max
              (setq timings
                    (mapcar
                     '(lambda (statement)
                       (_eval statement iterations)
                      ) ;_  lambda
                     statements
                    ) ;_  mapcar
              ) ;_  setq
       ) ;_  apply
       boundary
    ) ;_  <
    (< (apply 'min timings)
       boundary
    ) ;_  <
   ) ;_  or
   (setq iterations
         (* 2 iterations)
   ) ;_  setq
   (_princ ".")
  ) ;_  while
  (_princ
   (strcat
    "\rElapsed milliseconds / relative speed for "
    (itoa iterations)
    " iteration(s):\n\n"
   ) ;_  strcat
  ) ;_  _princ
  (setq
   slowest (float (apply 'max timings))
   fastest (apply 'min timings)
  ) ;_  setq
  (setq lsetlen
        (+ 5
           (apply 'max
                  (mapcar 'strlen
                          (setq statements
                                (mapcar '_tostring
                                        statements­
                                ) ;_  mapcar
                          ) ;_  setq
                  ) ;_  mapcar
           ) ;_  apply
        ) ;_  +
  ) ;_  setq
  (setq rsetlen
        (apply 'max
               (mapcar
                '(lambda (ms) (strlen (itoa ms)))
                timings
               ) ;_  mapcar
        ) ;_  apply
  ) ;_  setq
  (setq
   index 0
   count (length statements)
  ) ;_  setq
  (foreach pair
                (vl-sort
                 (mapcar 'cons statements timings)
                 '(lambda (a b) (< (cdr a) (cdr b)))
                ) ;_  vl-sort
   ((lambda (pair / ms)
     (_princ
      (strcat
       "    "
       (_lset (car pair) lsetlen ".")
       (_rset
        (itoa (setq ms (cdr pair)))
        rsetlen
        "."
       ) ;_  _rset
       " / "
       (rtos (/ slowest ms) 2 2)
       (cond
        ((eq 1 (setq index (1+ index))) " <fastest>")
        ((eq index count) " <slowest>")
        ("")
       ) ;_  cond
       "\n"
      ) ;_  strcat
     ) ;_  _princ
    ) ;_  lambda
    pair
   )
  ) ;_  foreach
  (princ)
) ;_  defun
;;;==================================================­===============
;;;
;;;  Program is defined, let's rock and roll ...
;;;
;;;==================================================­===============
(_main statements)
) ;_  defun
Страницы: Пред. 1 2 3 4 5 След.
Читают тему (гостей: 4, пользователей: 0, из них скрытых: 0)