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

Решил потихоньку делиться опытом создания рекурсий, к сожалению, сразу сделать большую статью не могу, но, если тема будет интересна, буду потихоньку выкладывать
функции с максимально возможным объяснением. Наверное, это будет выглядеть как уроки, а может и дискуссия, но в любом случае, единственная задача, которую я хочу решить, это научить вас спокойно создавать и использовать такие функции на равнее с другими.
  Для начала хотелось бы объяснить термин "рекурсия" это обычная функция (процедура), которая в процессе выполнения вызывает сама себя.
  Применительно к Лиспу, некоторое объяснение есть в книге
С.Зуева и Н. Полещука "САПР на базе 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))  

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

Хотя, никаких ответов - советов и вопросов нет, рискну продолжить…
Буду считать, что сама идея, как работают приведенные выше функции, вам понятна, если я ошибаюсь,
пожалуйста, поправьте меня!
    Пусть это будет урок 2.
Рассмотрим последний пример из первого урока.
Там из списка с числами получался список 3д точек, но
бывают случаи, когда нужны только 2д точки. Тогда этот код будет выглядеть:

(setq lst '(1 2 3 4 5 6 7 8 9))
(defun rec_lst_2d (lst)
  (if lst
    (cons
      (list
        (car lst)
        (cadr lst)
      ) ;_  list
      (rec_lst_2d (cdddr lst))
    ) ;_  cons
  ) ;_  if
) ;_  defun

Вызывать:

(rec_lst_2d lst)

получаем

'((1 2) (4 5) (7 8))

И наконец то же самое, но для списка 2д точек, их можно получить после Vla-Get-Coordinates
единственная разница, количество элементов - четное.

(setq lst '(1 2 3 4 5 6 7 8))
(defun rec_lst_2d_pt (lst)
  (if lst
    (cons
      (list
        (car lst)
        (cadr lst)
      ) ;_  list
      (rec_lst_2d_pt (cddr lst))
    ) ;_  cons
  ) ;_  if
) ;_  defun

Вызывать:

(rec_lst_2d_pt lst)

получаем

'((1 2) (3 4) (5 6) (7 8))

       Очень надеюсь, что после всех приведенных функций, для вас,
не составит большого труда сделать рекурсию, с простым перебором элементов,
но думаю, что усложнять код пока рано, лучше понять сам алгоритм.
       Рассмотрим вариант рекурсий с созданием списка.
Допустим, у нас есть два числа 5 и 8, нам нужно получить список,
последовательно заполненный цифрами, начиная с 5 и заканчивая 8 с шагом 1.
       Нужно получить:

'(5 6 7 8)

Рекурсия

(defun rec_2i_lst (a b)
  (if (<= a b)
    (cons a (rec_2i_lst (1+ a) b))
  ) ;_  if
) ;_  defun

Вызывать:

(setq a 5 b 8)
(rec_2i_lst a b)

Разберем, как она работает.
Поскольку, мы объявляем 'a 'b как аргументы, вне функции они остаются неизменными,
но внутри нее, мы можем их изменять! Значит можно организовать цикл с условием:

(<= a b)

и после каждого добавления в список элемента будем увеличивать 'a

(1+ a)

до тех пор, пока условие выполняется.
На этот раз я не буду разворачивать код, а покажу вычисления, для каждого цикла
и вместо переменных вставлю их значения:
        цикл 1

(if (<= 5 8)
  (cons 5 (rec_2i_lst (1+ 5) 8))
) ;_  if

результат:

'(5 6 7 8)

        цикл 2

(if (<= 6 8)
  (cons 6 (rec_2i_lst (1+ 6) 8))
) ;_  if

результат:

'(6 7 8)

        цикл 3

(if (<= 7 8)
  (cons 7 (rec_2i_lst (1+ 7) 8))
) ;_  if

результат:

'(7 8)

        цикл 4

(if (<= 8 8)
  (cons 8 (rec_2i_lst (1+ 8) 8))
) ;_  if

результат:

'(8)

        цикл 5

(if (<= 9 8)
  (cons 9 (rec_2i_lst (1+ 9) 8))
) ;_  if

результат:

 NIL 

Само формирование списка получается:

(cons
  5
  (cons
    6
    (cons
      7
      (cons
        8
        nil
      ) ;_  cons
    ) ;_  cons
  ) ;_  cons
) ;_  cons

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

Здраствуйте Евгения! На мой взгляд рекурсивная
функция выглядит очень красиво. Однако считаю,
что область эффективного применения рекурсии,
очень ограничена. Если рассматривать итеративный метод исчисления, то здесь возможности намного шире. Если функция, создаваемая, как рекурсивная, очень мала, то возможен выигрыш в сокращении объёма кода и красоте программирования. Но рекурсивные версии многих процедур выполняются медленнее, чем итеративный эквивалент, при этом затрачиваются системные ресурсы, из-за локальных переменных и параметров. Т.к. их копии, при каждом вызове рекурсивной функции, записываются в стек до остановки рекурсии.
Если задача труднорешаема итеративным методом, то, конечно, тогда рекурсия незаменима.
А вообще задумка об уроках на форуме - чудесна.

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

> PahRam
Спасибо, за добрые слова!
Я хотел бы вынести в другую ветку обсуждение необходимости и / или нужности рекурсий. Ветка созданна ради развеивания мифов и непониманий вокруг такого подхода к програмированию. По вашему вопросу я с удовольствием пообщаюсь (я с вами не согласен) - создавайте тему.
PS. Большое спасибо, что ответили в этой ветке, а то пишу в никуда...

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

В никуда? Продолжайте. Я всё прочитаю, с удовольствием. Я вроде бы в рекурсиях неплохо разбираюсь, поэтому понимаю, что тема интересна.

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

> Евгений Елпанов

От себя лично приветствую такое подвижничество,
не надо ждать цветов, просто делай свое дело,
благородство ведь не ищет ответной любви.
В свое время каждый убил не один день на
эти рекурсии, а тут хороший толковый словарь,
бери и пользуйся.
Да и не всякий может доходчиво разъяснить...
Мое уважение,
~'J'~

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

Урок 3
На прошлом уроке мы создавали список, сегодня я предлагаю продолжить это занятие, но Лисп умеет работать не только со списками...
Предлагаю рассмотреть мою программу по извлечению из строки данных, разделенных каким либо символом.
Например, у нас есть строка:

"мы;изучаем;рекурсии"

Не сложно заметить, что все слова разделены:

";"

И нам необходимо создать список из слов:

'("мы" "изучаем" "рекурсии")

Для начала, кратко поясню работу vl-string-search .

(vl-string-search "искомая строка" "строка в которой ищем")

возвращаемое значение - число - номер позиции искомого текста во всей строке или NIL . Нумерация начинается с 0 (zero).

(vl-string-search ";" "мы;изучаем;рекурсии") ; => 2 
(vl-string-search "-" "мы;изучаем;рекурсии") ; => NIL  

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

(defun str-str-lst (str pat / i)
  (cond ((= str "") nil)
        ((setq i (vl-string-search pat str))
         (cons
           (substr str 1 i)
           (str-str-lst (substr str (+ 2 i)) pat)
         ) ;_  cons
        )
        (t (list str))
  ) ;_  cond
) ;_  defun

Запускать:

(setq str "мы;изучаем;рекурсии" pat ";")
(str-str-lst str pat)

А теперь разберем, как она работает.

(setq str "мы;изучаем;рекурсии" pat ";")

На этот раз пришлось отказаться от проверки с помощью IF - слишком много нужно делать проверок. Надеюсь, использование COND вас не смутит!
Создавать список мы будем методом, как и на первом уроке.
       В первой проверке COND

((= str "") nil)

Мы проверяем - есть ли в 'STR какие либо символы, точнее сравниваем содержимое 'STR с пустой строкой.
Если содержимого 'STR нет - функция вернет NIL
       Вторая строка кода, начинается с поиска разделителя 'PAT в 'STR и присвоение его позиции в переменную 'I

(setq i (vl-string-search pat str))

Например:

(setq i (vl-string-search ";" "мы;изучаем;рекурсии")) ; i = 2

Короче, в этот момент переменная 'I принимает либо числовое значение, либо NIL
если значение NIL - переход на следующую проверку, иначе выполняется:

(cons
  (substr str 1 i)
  (str-str-lst (substr str (+ 2 i)) pat)
) ;_  cons

Формируем список. Здесь мы добавляем первым элементом результат выражения:

(substr str 1 i)
;Это и есть часть строки 'STR,
;с начала и до первого разделителя 'PAT.
;Например:
(substr "мы;изучаем;рекурсии" 1 2) ; => "мы"

К результату выражения

(str-str-lst (substr str (+ 2 i)) pat)
;Здесь
(substr "мы;изучаем;рекурсии" (+ 2 2)); => "изучаем;рекурсии"
;И все выражение будет выглядеть
(str-str-lst (substr "мы;изучаем;рекурсии" (+ 2 2)) ";")

И наконец, в последней проверке, мы видим T

(t (list str))

Это значит, что ее надо выполнить (если до нее дойдет очередь...)
А очередь может дойти, только, если у нас есть, не пустая строка 'STR и в ней нет разделителей 'PAT.

(list "рекурсии") ; => '("рекурсии")

Как и раньше, я собираюсь показать вычисления, для каждого цикла.
цикл 1

(cond ((= "мы;изучаем;рекурсии" "") nil) ; => nil => переходим дальше
      ((setq i (vl-string-search ";" "мы;изучаем;рекурсии")) ; => 2
       (cons
         (substr "мы;изучаем;рекурсии" 1 2) ; => "мы"
         (str-str-lst
           (substr "мы;изучаем;рекурсии" (+ 2 2)) ; => "изучаем;рекурсии"
           ";"
         ) ; => '("изучаем" "рекурсии")
       ) ;_  cons
      )
      (t (list "мы;изучаем;рекурсии")) ;Не дошли
) ;_  cond

результат:

'("мы" "изучаем" "рекурсии")

цикл 2

(cond ((= "изучаем;рекурсии" "") nil) ; => nil => переходим дальше
      ((setq i (vl-string-search ";" "изучаем;рекурсии")) ; => 7
       (cons
         (substr "изучаем;рекурсии" 1 7) ; => "изучаем"
         (str-str-lst
           (substr "изучаем;рекурсии" (+ 2 7)) ; => "рекурсии"
           ";"
           ) ; => '("рекурсии")
       ) ;_  cons
      )
      (t (list "изучаем;рекурсии")) ;Не дошли
) ;_  cond

результат:

'("изучаем" "рекурсии")

цикл 3

(cond ((= "рекурсии" "") nil) ; => nil => переходим дальше
      ((setq i (vl-string-search ";" "рекурсии")) ; => nil => переходим дальше
       (cons
         (substr "рекурсии" 1 i)
         (str-str-lst
           (substr "рекурсии" (+ 2 i))
           ";"
         ) ; => '("рекурсии")
       ) ;_  cons
      )
      (t (list "рекурсии")) ; => '("рекурсии")
) ;_  cond

результат:

'("рекурсии")

Само формирование списка получается:

(cons
  "мы"
  (cons
    "изучаем"
    '("рекурсии")
  ) ;_  cons
) ;_  cons

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

(defun str-str-lst (str pat / i)
  (cond ((= str "") nil)
        ((setq i (vl-string-search pat str))
         (cons (substr str 1 i)
               (str-str-lst (substr str (+ (strlen pat) 1 i)) pat)
         ) ;_  cons
        )
        (t (list str))
  ) ;_  cond
) ;_  defun

Запускать:

(setq str "мы - изучаем - рекурсии" pat " - ")
(str-str-lst str pat)

Уверен, вы сможете разобраться в ней самостоятельно.

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

Я, собственно, тот, для кого подобные уроки являются именно толковым словарем, как замечено выше, поскольку не являюсь программистом, а "пасусь" на форуме в поисках оригинально-прикладного материала непосредственно для работы... Нахожу что-то постаянно! В частности информация из последнего урока подвигнула меня на безжалостную замену более громоздких конструкций, созданных для выполнения задач, аналогичных приведенным в примере. Так что присоединяюсь к "фан-клубу"...

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

> Kosarev
Я рад, что вам понравилась функция из последнего урока. Спасибо за теплые слова!
PS. Жаль, что нет отзывов тех, для кого пишутся уроки (можно на почту)...

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

Предлагаю такой вариант "разбора" полета последней функции:

;; Шаг 1. str = "мы;изучаем;рекурсии"
;;     pat=";"
(defun str-str-lst (str pat / i)
  (cond     ((= str "") nil)          ; Не проходит, str <> nil
     ((setq i (vl-string-search pat str)) ; i = 2,
      (cons                    ; Соединяем список
        (substr str 1 i)          ; с первой частью: "мы"
        (str-str-lst (substr str (+ 2 i)) pat)
                         ; и уходим на Шаг 2, в качестве параметов передаем
                         ;остаток строки "изучаем;рекурсии" и старый разделитель
        ) ;_  cons
      )
     (t (list str))               ; не дошли.
     ) ;_  cond
  ) ;_  defun
;; Шаг 2. str = "изучаем;рекурскии"
;;     pat = ";"
(defun str-str-lst (str pat / i)
  (cond     ((= str "") nil)          ; Не проходит, str <> nil
     ((setq i (vl-string-search pat str)) ; i = 7
      (cons                    ; Соединяем список
        (substr str 1 i)          ; с первой частью: "изучаем"
        (str-str-lst (substr str (+ 2 i)) pat)
                         ; и уходим на Шаг 3, в качестве параметов передаем
                         ; остаток строки и старый разделитель
        ) ;_  cons
      )
     (t (list str))               ; не дошли.
     ) ;_  cond
  ) ;_  defun
;; Шаг 3. str = "рекурсии"
;;     pat = ";"
(defun str-str-lst (str pat / i)
  (cond     ((= str "") nil)          ; Не проходит, str <> nil
     ((setq i (vl-string-search pat str)) ; i = nil, поэтому уходим на t
                         ; и возвращаем исходное положение
      (cons
        (substr str 1 i)
        (str-str-lst (substr str (+ 2 i)) pat)
        ) ;_  cons
      )
     (t (list str))               ; возвращаем начальную строку: "рекурсии"
                         ; Возврат на Шаг 2
     ) ;_  cond
  ) ;_  defun
;; Возвращает '("рекурсии")
;; Шаг 2. Возврат. str = "ищучаем;рекурсии"
;;     pat = ";"
(defun str-str-lst (str pat / i)
  (cond     ((= str "") nil)          ; Не проходит, str <> nil
     ((setq i (vl-string-search pat str))
      (cons
        (substr str 1 i)          ; соединяем "изучаем"
        (str-str-lst (substr str (+ 2 i)) pat)
                         ; и результат Шага 3 - '("рекурсии")
        ) ;_  cons
      )
     (t (list str))               ; Не дошли
     ) ;_  cond
  ) ;_  defun
;; Возвращает '("изучаем" "рекурсии")
;; Шаг 1. Возврат. str = "мы;изучаем;рекурсии"
;;     pat = ";"
(defun str-str-lst (str pat / i)
  (cond     ((= str "") nil)          ; Не проходит, str <> nil
     ((setq i (vl-string-search pat str))
      (cons
        (substr str 1 i)          ; соединяем "мы"
        (str-str-lst (substr str (+ 2 i)) pat)
                         ; и результат Шага 2 - '("изучаем" "рекурсии")
        ) ;_  cons
      )
     (t (list str))               ; не дошли.
     ) ;_  cond
  ) ;_  defun
;; Возвращает '("мы" "изучаем" "рекурсии")

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

> kpblc
Мне нравится твой вариант!
Если нет возражений, от остальных участников форума, следующие уроки будут в таком формате.
Главное преимущество - весь урок можно читать в лисп редакторе, причем наглядность, не страдает.

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

Смею предложить вариант функции по заданию Урока 3

(defun F (строка образец)
 (if (= строка "")
  '("")
  (apply
  '(lambda (символ остаток)
    (if (= символ образец)
     (cons "" (F остаток образец))
     (apply
     '(lambda (список)
       (cons (strcat символ (car список)) (cdr список)))
      (list (F остаток образец)))))
   (list
    (substr строка 1 1)
    (substr строка 2)))))

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

Вариант попроще (по заданию Урока 3)

(defun F (строка образец)
 (if (= строка "")
  '("")
  ((lambda (символ остаток)
    (if (= символ образец)
     (cons "" (F остаток образец))
     ((lambda (список)
       (cons (strcat символ (car список)) (cdr список)))
      (F остаток образец))))
   (substr строка 1 1)
   (substr строка 2))))

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

> VH
Спасибо за участие.
Надеюсь, многие заинтересовавшиеся этой веткой, будут выкладывать свои варианты.
PS. Ваша программа, гараздо лучше предложенной мной для рассмотрения. Я не стал писать подобную только из за сложности понимания для начинающих. Отсюда и SETQ...
PS. Наверное, на следущем уроке и последующих, я буду рассматривать, как можно создать
vl-every,vl-member-if.....vl-remove-if-not
и только потом, собираюсь рассматривать рекурсии, имеющие несколько вариантов самовызова...

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

> Евгений Елпанов
Добрый почин.
Думаю надо показать особенность рекурсии лисп-машины по отношению к остальным языкам.

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

А что такое лисп-машина и где её увидеть?

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

> Пастух
Наверное, имеется в виду работа со списками... Лисп - язык списков и в нем, так или иначе все крутится вокруг них.

> PalStudio
Если показывать класическую рекурсию (не лисп) - нужно вычислять факториал, как в любом учебнике, согласен, показательный пример...
PS. Ребята, я понимаю, что у вас руки чешутся, не стесняйтесь, возьмите любую понравившуюся вам функцию и разберите ее показательно в этой ветке! Шаблон оформления есть...
Единственное НО - желательно соразмерять уровень предыдущего занятия, с предлагаемым...
Я за!

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

> Пастух
Здесь в конце статьи написано про лисп-машины http://www.5ka.ru/67/27500/3.html

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

Обнаружив на www.dwg.ru задачу про номера повторяющихся элементов списка и не обратив внимания на то, что требуется перечень номеров одного элемента, предлагается список перечней номеров (в формате исходной задачи) всех элементов списка, авось пригодится:

(defun F (список индекс)
 (if список
  ((lambda (элемент ведомость)
    ((lambda (перечень)
      (if перечень
       (subst (cons элемент (cons индекс (cdr перечень))) перечень ведомость)
       (cons (cons элемент (list индекс)) ведомость)))
     (assoc элемент ведомость)))
   (car список)
   (F (cdr список) (1+ индекс)))))

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

> Евгений!
Ещё раз спасибо. Рекурсии стал использовать в программах значительно чаще и стал их применять для решения большего количества задач.

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

Функция, обратная к представленной в > VH (2006-03-09 18:35:30) функции, то есть востанавливающая исходный список:

(defun inv_F (ведомость)
 (if ведомость
  ((lambda (элемент)
    (cons
     элемент
     (inv_F
      ((lambda (перечень)
        (apply 'append
         (mapcar
         '(lambda (список)
           (if список (list список)))
          (subst
           (if (cddr перечень) (cons элемент (cddr перечень)))
           перечень
           ведомость))))
       (assoc элемент ведомость)))))
   ((lambda (выборка)
     (cdr (assoc (apply 'min (mapcar 'car выборка)) выборка)))
    (mapcar
    '(lambda (элемент индекс)
      (cons индекс элемент))
     (mapcar 'car ведомость)
     (mapcar 'cadr ведомость))))))

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

Структура

(apply 'append...

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

(defun LIST_nil_EXCLUDED (список)
 (if список
  ((lambda (элемент остаток)
    (if элемент (cons элемент остаток) остаток))
   (car список)
   (LIST_nil_EXCLUDED (cdr список)))))

возможен следующий вариант (с прочими упрощениями):

(defun inv_F (ведомость)
 (if ведомость
  ((lambda (элемент)
    (cons
     элемент
     (inv_F
      ((lambda (перечень)
        (LIST_nil_EXCLUDED
         (subst
          ((lambda (остаток)
            (if остаток (cons элемент остаток)))
           (cddr перечень))
          перечень
          ведомость)))
       (assoc элемент ведомость)))))
   ((lambda (выборка)
     (cdr (assoc (apply 'min (mapcar 'car выборка)) выборка)))
    (mapcar 'cons
     (mapcar 'cadr ведомость)
     (mapcar 'car ведомость))))))

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

Урок 4
Сегодня будем создавать свои варианты функций с префиксом "VL-" при помощи рекурсии.
Первым делом хочу заметить, такие функции часто встречаются в интернете. Я не  присваиваю себе
уникальные права первооткрывателя, но и искать ссылку на первоисточник не буду!
Просто я буду писать эти функции сам, с использованием своих названий переменных...
Сперва, напишем функцию, работающую подобно vl-every
пример стандартного применения из справки.

(vl-every (function =) '(1 2) '(1 2 3))

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

(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 fun (function =) lst-1'(1 2) lst-2 '(1 2 3))
(rec-every fun lst-1 lst-2); Вернет T
(setq fun (function =) lst-1'(1 2) lst-2 '(5 6 7))
(rec-every fun lst-1 lst-2); Вернет NIL
(setq fun (function <) lst-1'(1 2) lst-2 '(5 6 7))
(rec-every fun lst-1 lst-2); Вернет T

Главное отличие от стандартной функции - мы жестко задали количество аргументов,
а встроенная функция может сравнивать любое их количество...
Наверное, стоит сказать пару слов про аргумент 'FUN - любая функция,
результат которой мы будем отслеживать на отличие от NIL .
А теперь разберем, как работает рекурсия:
В первой строке, как всегда, пишем проверку для выхода.

(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

здесь мы проверяем отличие от NIL результат двух функций, если первый результат отличен от NIL
то проверяется второй.
Рассмотрим их отдельно:

(eval
  (list
    fun
    (car lst-1)
    (car lst-2)
  ) ;_  list
) ;_  eval

EVAL - применяет функцию, сохраненную в переменной 'FAN к первым элементам обоих списков.

(rec-every fun (cdr lst-1) (cdr lst-2))

Вызов рекурсии с укороченными списками - без первых элементов.
И наконец, второе выражение IF - всегда возвращает T
Т.е. если у нас закончился один из списков или оба, то мы возвращаем T
Например, стандартная функция vl-every

(vl-every '= nil '(1 2 3)); возвращает T

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

  ; Сама рекурсия
(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 fun   (function =)
      lst-1 '(1 2)
      lst-2 '(1 2 3)
) ;_  setq
  ; Вызывать
(rec-every fun lst-1 lst-2)
;; Шаг 1.
  ; fun   = (function =)
  ; lst-1 = '(1 2)
  ; lst-2 = '(1 2 3)
(defun rec-every (fun lst-1 lst-2)
  (if (and lst-1 lst-1) ; Получаем T, переходим на следующую строку
    (and
      (eval
        (list
          fun
          (car lst-1) ; Получаем 1
          (car lst-2) ; Получаем 1
        ) ; (list '= 1 1)
      ) ; Вычисляем выражение (= 1 1) и получаем T
  ; Переходим к следующему выражению
      (rec-every
        fun
        (cdr lst-1) ; Получаем '(2)
        (cdr lst-2) ; Получаем '(2 3)
      ) ; самовызов, переходим на шаг 2
    ) ;_  and
    T ; не дошли
  ) ;_  if
) ;_  defun
;; Шаг 2.
  ; fun   = (function =)
  ; lst-1 = '(2)
  ; lst-2 = '(2 3)
(defun rec-every (fun lst-1 lst-2)
  (if (and lst-1 lst-1) ; Получаем T, переходим на следующую строку
    (and
      (eval
        (list
          fun
          (car lst-1) ; Получаем 2
          (car lst-2) ; Получаем 2
        ) ; (list '= 2 2)
      ) ; Вычисляем выражение (= 2 2) и получаем T
  ; Переходим к следующему выражению
      (rec-every
        fun
        (cdr lst-1) ; Получаем NIL
        (cdr lst-2) ; Получаем '(3)
      ) ; самовызов, переходим на шаг 3
    ) ;_  and
    T ; не дошли
  ) ;_  if
) ;_  defun
;; Шаг 3.
  ; fun   = (function =)
  ; lst-1 = NIL
  ; lst-2 = '(3)
(defun rec-every (fun lst-1 lst-2)
  (if (and lst-1 lst-1) ; Получаем NIL, пропускаем первое выражение и переходим ко второму
    (and ; Пропустили
      (eval
        (list
          fun
          (car lst-1)
          (car lst-2)
        ) ;_  list
      ) ;_  eval
      (rec-every
        fun
        (cdr lst-1)
        (cdr lst-2)
      ) ;_  rec-every
    ) ;_  and
    T ; Возвращаем T
  ) ;  Получаем T
) ; Возвращаем T и переходим к шагу 2 подставляя вычисленный результат
;; Шаг 2.
  ; fun   = (function =)
  ; lst-1 = '(2)
  ; lst-2 = '(2 3)
(defun rec-every (fun lst-1 lst-2)
  (if (and lst-1 lst-1) ; Уже вычислено = T
    (and
      (eval ; Уже вычислено = T
        (list
          fun
          (car lst-1)
          (car lst-2)
        ) ;_  list
      ) ;_  eval
      (rec-every ; Уже вычислено = T
        fun
        (cdr lst-1)
        (cdr lst-2)
      ) ;_  rec-every
    ) ; (and T T) Получаем T
    T ; не дошли
  ) ;  Получаем T
) ; возвращаем T и переходим к шагу 1
;; Шаг 1.
  ; fun   = (function =)
  ; lst-1 = '(1 2)
  ; lst-2 = '(1 2 3)
(defun rec-every (fun lst-1 lst-2)
  (if (and lst-1 lst-1) ; Уже вычислено = T
    (and
      (eval ; Уже вычислено = T
        (list
          fun
          (car lst-1)
          (car lst-2)
        ) ;_  list
      ) ;_  eval
      (rec-every ; Уже вычислено = T
        fun
        (cdr lst-1)
        (cdr lst-2)
      ) ;_  rec-every
    ) ; (and T T) Получаем T
    T ; не дошли
  ) ;  Получаем T
) ; возвращаем T

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

> VH
Это просто здорово, что вы решили приобщиться к передаче своих знаний и навыков!
PS. Пишите, пожалуйста, побольше комментариев и расшифровок.
По возможности, оформляйте свои примеры, поближе к учебному материалу...

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

;*************************************************;*****************************
Урок 5
На этом уроке продолжим создавать свои варианты функций,
с префиксом "VL-" при помощи рекурсии.
Напишем функцию, работающую подобно vl-member-if
ее назначение смотрите в справке
пример стандартного применения:

(vl-member-if
  (function (lambda (x) (= (car x) 10)))
  '((100 . "AcDbLine")
    (10 0.0 10.0 0.0)
    (11 30.0 50.0 0.0)
    (210 0.0 0.0 1.0)
   )
)
;Возвращает:
;'((10 0.0 10.0 0.0) (11 30.0 50.0 0.0) (210 0.0 0.0 1.0))

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

(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)
; Вернет '((10 0.0 10.0 0.0) (11 30.0 50.0 0.0) (210 0.0 0.0 1.0))

Наверное, стоит сказать пару слов про аргумент  'FUN - любая функция,
результат которой мы будем отслеживать на отличие от NIL .
А теперь разберем, как работает рекурсия:
В первой строке, как всегда, пишем проверку для выхода.

(apply fun (list(car lst)))

Здесь мы применяем нашу функцию к списку с одним первым элементом 'LST
и если результат отличен от NIL переходим на вторую строку,
иначе на третью.

lst

Во второй строке мы возвращаем текущее содержимое 'LST

(rec-member-if fun (cdr lst))

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

  ; Сама рекурсия
(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)
;; Шаг 1.
;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))
(defun rec-member-if (fun lst)
  (if (apply fun (list (car lst))) ; Получаем NIL переходим на третью строку
    lst ; Пропускаем
    (rec-member-if
      fun
      (cdr lst) ; Получаем
                ; '((10 0.0 10.0 0.0) (11 30.0 50.0 0.0) (210 0.0 0.0 1.0))
    ) ; Самовызов, переходим на шаг 2
  ) ;_  if
) ;_  defun
;; Шаг 2.
;fun = (function (lambda (x) (= (car x) 10)))
;lst = '((10 0.0 10.0 0.0) (11 30.0 50.0 0.0) (210 0.0 0.0 1.0))
(defun rec-member-if (fun lst)
  (if (apply fun (list (car lst))) ; Получаем T переходим на следующую строку
    lst ;Возвращаем '((10 0.0 10.0 0.0) (11 30.0 50.0 0.0) (210 0.0 0.0 1.0))
        ; переходим на шаг 1
    (rec-member-if fun (cdr lst)) ; не дошли
  ) ;Возвращаем '((10 0.0 10.0 0.0) (11 30.0 50.0 0.0) (210 0.0 0.0 1.0))
) ;Возвращаем '((10 0.0 10.0 0.0) (11 30.0 50.0 0.0) (210 0.0 0.0 1.0))
  ; переходим на шаг 1
;; Шаг 1.
;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))
(defun rec-member-if (fun lst)
  (if (apply fun (list (car lst))) ; Уже вычислено NIL переходим на третью строку
    lst ; Пропускаем
    (rec-member-if ; Уже вычислено
      fun
      (cdr lst)
    ); Получаем '((10 0.0 10.0 0.0) (11 30.0 50.0 0.0) (210 0.0 0.0 1.0))
  ); Возвращаем '((10 0.0 10.0 0.0) (11 30.0 50.0 0.0) (210 0.0 0.0 1.0))
); Возвращаем '((10 0.0 10.0 0.0) (11 30.0 50.0 0.0) (210 0.0 0.0 1.0))

Думаю, не трудно догадаться, как будет выглядеть аналог vl-member-if-not

(defun rec-member-if-not (fun lst)
  (if (apply fun (list(car lst)))
    (rec-member-if-not fun (cdr lst))
    lst
  ) ;_  if
) ;_  defun
; Пример вызова
(setq fun (function atom)
      lst '(1 "Str" (0 . "line") nil t)
) ;_  setq
(rec-member-if-not fun lst)