• Откуда: Москва
  • На форуме с 2 июля 2004г.
  • Сообщений: 2,538
  • Спасибо: 10

Re: Уроки создания рекурсивных функций

Хочу внести, некоторую ясность, по поводу примеров, приведенных в уроках 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)

  • Lenivij
  • Восстановленный участник
  • На форуме с 10 января 2006г.
  • Сообщений: 32
  • Спасибо: 0

Re: Уроки создания рекурсивных функций

[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]

  • den-si
  • Восстановленный участник
  • На форуме с 1 октября 2001г.
  • Сообщений: 995
  • Спасибо: 0

Re: Уроки создания рекурсивных функций

> Lenivij
Так есть же раздел "Программирование :: Готовые программы".

  • Откуда: Украина / Киев
  • На форуме с 15 апреля 2005г.
  • Сообщений: 8,666
  • Спасибо: 158

Re: Уроки создания рекурсивных функций

> den-si
Мне кажется, что это две совершенно разных вещи, так как Евгений Елпанов обучает, а не пишет готовые программы. Но в той иерархии форумов которая существует я не вижу куда можно было бы поместить эту ветку. Разве что "закрепить" ее (а возможно потом и другие аналогичные), чтобы они не "утонули" в пределах форума LISP. Если, конечно, это возможно...

  • VH 
  • Активный участник
  • На форуме с 14 июня 2001г.
  • Сообщений: 1,381
  • Спасибо: 7

Re: Уроки создания рекурсивных функций

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

Отчего же, с точки зрения LISPа символ можно связать в том числе и с лексическим замыканием (function ...), почему нет?

  • Откуда: Москва
  • На форуме с 2 июля 2004г.
  • Сообщений: 2,538
  • Спасибо: 10

Re: Уроки создания рекурсивных функций

> VH
Наверное, я не очень корректно выразился...
Если есть возможность не занимать лишних переменных, то лучше так и делать. Без упомянутой вами поправки, получается, что я рекомендую, всегда присваивать (function ...) переменной, а только потом вызывать рекурсию! Считаю это неправильным, но удобным для объяснения в уроках

  • Откуда: Москва
  • На форуме с 2 июля 2004г.
  • Сообщений: 2,538
  • Спасибо: 10

Re: Уроки создания рекурсивных функций

Урок 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)

  • Kosarev
  • Активный участник
  • На форуме с 14 октября 2004г.
  • Сообщений: 162
  • Спасибо: 1

Re: Уроки создания рекурсивных функций

Когда смотришь приведенные примеры - понятно, начинаешь сам сочинять что-то посложнее - ступор...
Надо упражняться, конечно, но время не всегда есть. Поэтому, если позволите, небольшие вопросики:
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)
Заранее благодарен.

  • Откуда: Москва
  • На форуме с 2 июля 2004г.
  • Сообщений: 2,538
  • Спасибо: 10

Re: Уроки создания рекурсивных функций

Многие задают мне один и тот же вопрос, отвечу сразу всем.
Продолжение уроков, обязательно будет!
Сейчас очень занят по работе - пришла пора сдавать большой проект...
Еще хотелось бы спросить у вас совета...
Стоит ли и дальше расписывать работу рекурсии пошагово, или достаточно подробного описания ее работы?
Вопрос родился не с потолка, при личном общении, мне были такие предложения.

> Kosarev
По первому вопросу...

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

  • Kosarev
  • Активный участник
  • На форуме с 14 октября 2004г.
  • Сообщений: 162
  • Спасибо: 1

Re: Уроки создания рекурсивных функций

Большое спасибо!
Мне лично достаточно объяснения. Пошаговый разбор требуются, я думаю, когда человек ещё недостаточно представляет работу основных функций VL вообще и, вероятно, для него вопрос о рекурсиях на этом этапе не стоит в принципе. А для ознакомления первые уроки доходчиво разобраны...
С уважением.

  • Откуда: Москва
  • На форуме с 2 июля 2004г.
  • Сообщений: 2,538
  • Спасибо: 10

Re: Уроки создания рекурсивных функций

> Kosarev
Мне уже несколько раз сказали, что если кому нужно пошаговое объяснение - пусть перечитывают первые уроки... Может так и стоит сделать?

  • kpblc
  • kpblc
  • Активный участник
  • Откуда: С.-Петербург
  • На форуме с 29 ноября 2004г.
  • Сообщений: 8,348
  • Спасибо: 24

Re: Уроки создания рекурсивных функций

ИМХО: ДА! За пошаговыми разъяснениями - в начало.

  • Откуда: Москва
  • На форуме с 2 июля 2004г.
  • Сообщений: 2,538
  • Спасибо: 10

Re: Уроки создания рекурсивных функций

Урок 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 - никаких проблем!

  • Откуда: Москва
  • На форуме с 2 июля 2004г.
  • Сообщений: 2,538
  • Спасибо: 10

Re: Уроки создания рекурсивных функций

Урок 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)

  • Откуда: Москва
  • На форуме с 2 июля 2004г.
  • Сообщений: 2,538
  • Спасибо: 10

Re: Уроки создания рекурсивных функций

Урок 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)

Хотелось бы добавить, что этот вариант сортировки быстрее предыдущего,
но не значительно. Его можно еще улучшить, например, изменив функцию удаления, чтоб она брала в качестве аргумента список...
ДОМАШНЕЕ ЗАДАНИЕ:
Измените программу, пусть функция удаления вызывается один раз,
со списком удаляемых элементов.

  • Откуда: Москва
  • На форуме с 2 июля 2004г.
  • Сообщений: 2,538
  • Спасибо: 10

Re: Уроки создания рекурсивных функций

Урок 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)

  • VH 
  • Активный участник
  • На форуме с 14 июня 2001г.
  • Сообщений: 1,381
  • Спасибо: 7

Re: Уроки создания рекурсивных функций

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

  • Откуда: Москва
  • На форуме с 2 июля 2004г.
  • Сообщений: 2,538
  • Спасибо: 10

Re: Уроки создания рекурсивных функций

> VH
Очень хороший и компактный код!
Большое спасибо, что, не только дочитали мои уроки до десятого, но и опубликовали свой вариант.
Уверен, многим он поможет лучше понять тему.

  • Откуда: Москва
  • На форуме с 2 июля 2004г.
  • Сообщений: 2,538
  • Спасибо: 10

Re: Уроки создания рекурсивных функций

> VH
К сожалению, в вашем коде использованна довольно медленная функция

'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>

  • Kosarev
  • Активный участник
  • На форуме с 14 октября 2004г.
  • Сообщений: 162
  • Спасибо: 1

Re: Уроки создания рекурсивных функций

А вот интересно, какие ещё стандартные функции, типа 'append можно отнести к "медленным"? Хотелось бы узнать мнение "секачей" по этому вопросу.

  • Откуда: Москва
  • На форуме с 2 июля 2004г.
  • Сообщений: 2,538
  • Спасибо: 10

Re: Уроки создания рекурсивных функций

> Kosarev
Создай отдельную тему со своим вопросом, там и пообщаемся! Я с удовольствием поучавствую...
Эта ветка посвящена урокам по созданию рекурсий, а твой вопрос не в тему.

  • VH 
  • Активный участник
  • На форуме с 14 июня 2001г.
  • Сообщений: 1,381
  • Спасибо: 7

Re: Уроки создания рекурсивных функций

Ничего себе "вопрос не в тему"
Функция (<) (единственно подходящая по смыслу) заменяется функцией (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 живем?
Канечна, наряду с (*) есть гораздо более быстрая (+), только стоит ли заменять.

  • Откуда: Москва
  • На форуме с 2 июля 2004г.
  • Сообщений: 2,538
  • Спасибо: 10

Re: Уроки создания рекурсивных функций

> VH
По поводу замены  функции (<) на (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>

  • Откуда: Москва
  • На форуме с 2 июля 2004г.
  • Сообщений: 2,538
  • Спасибо: 10

Re: Уроки создания рекурсивных функций

Результаты сравнения скорости...
Тестовые программы:

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

  • Откуда: Москва
  • На форуме с 2 июля 2004г.
  • Сообщений: 2,538
  • Спасибо: 10

Re: Уроки создания рекурсивных функций

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

(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