Рекурсии от Евгения Елпанова

Автор: | Дата: 21 Август 2017 · 2 коммент. 

Очень не хочется потерять отличный учебный материал, выложенный Евгением Елпановым в далеком 2006 году на caduser.ru. Уже были прецеденты переименования ресурсов, удаления страниц и т.д. Цитирую автора материала полностью :)

Часть 1

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

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

Для начала создадим простую рекурсию - аналог mapcar

1
(setq lst (list 1 2 3))

Так выглядит реализация увеличения всех элементов на единицу с использованием mapcar:

1
(mapcar '1+ lst)

А так рекурсия:

1
2
3
4
5
6
7
(defun rec_1+ (lst)
  (if lst
    (cons (1+ (car lst))
      (rec_1+ (cdr lst))
    ) ;_ end cons
  ) ;_ end if
) ;_ end defun

вызывать:

1
(rec_1+ lst)

Теперь разберем ее работу:

1
2
3
4
5
6
7
8
9
10
(defun rec_1+ (lst)
;с первой строкой, я думаю, все понятно
  (if lst
;| со второй, думаю тоже, но на всякий случай поясню - здесь проверяется наличие в переменной lst
каких либо данных - если есть выполняем следующую строку если нет - возвращаем NIL |;
  (cons (1+ (car lst))  (rec_1+ (cdr lst)))
;| добавляем увеличенное на единицу значение первого элемента списка к результату, полученному при выполнении программы rec_1+ со списком без первого элемента |;
  ;если же
  ) ;_ end if
) ;_ end defun

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
(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:

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

и рекурсия:

1
2
3
4
5
6
7
(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

Вызывать:

1
(rec_+ lst_1 lst_2)

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

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

и рекурсия:

1
2
3
4
5
6
7
(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

Вызывать:

1
(rec_- lst_1 lst_2 lst_3)

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

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

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

1
2
3
4
5
6
7
8
9
10
11
12
(defun rec_lst_3d (lst)
  (if lst
    (cons
      (list
        (car lst)
        (cadr lst)
        (caddr lst)
      ) ;_  list
      (rec_lst_3d (cdddr lst))
    ) ;_  cons
  ) ;_  if
) ;_  defun

Вызывать:

1
(rec_lst_3d lst)

получаем

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

Часть 2

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

1
2
3
4
5
6
7
8
9
10
11
12
(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

Вызывать:

1
(rec_lst_2d lst)

получаем

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

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

1
2
3
4
5
6
7
8
9
10
11
12
(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

Вызывать:

1
(rec_lst_2d_pt lst)

получаем

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

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

1
'(5 6 7 8)

Рекурсия

1
2
3
4
5
(defun rec_2i_lst (a b)
  (if (<= a b)
    (cons a (rec_2i_lst (1+ a) b))
  ) ;_  if
) ;_  defun

Вызывать:

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

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

1
(<= a b)

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

1
(1+ a)

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

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

результат:

1
'(5 6 7 8)

цикл 2

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

результат:

1
'(6 7 8)

цикл 3

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

результат:

1
'(7 8)

цикл 4

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

результат:

1
'(8)

цикл 5

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

результат:

1
NIL

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

1
2
3
4
5
6
7
8
9
10
11
12
13
(cons
  5
  (cons
    6
    (cons
      7
      (cons
        8
        nil
      ) ;_  cons
    ) ;_  cons
  ) ;_  cons
) ;_  cons

Часть 3

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

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

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

1
";"

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

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

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

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

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

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

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

1
2
3
4
5
6
7
8
9
10
11
(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

Запускать:

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

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

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

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

1
((= str "") nil)

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

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

Например:

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

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

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

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

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

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

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

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

1
(t (list str))

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

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

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

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

результат:

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

цикл 2

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

результат:

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

цикл 3

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

результат:

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

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

1
2
3
4
5
6
7
(cons
  "мы"
  (cons
    "изучаем"
    '("рекурсии")
  ) ;_  cons
) ;_  cons

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

1
2
3
4
5
6
7
8
9
10
(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

Запускать:

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

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

Часть 4

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

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

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
(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

Вызывать:

1
2
3
4
5
6
(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 . А теперь разберем, как работает рекурсия:
В первой строке, как всегда, пишем проверку для выхода.

1
(and lst-1 lst-1)

Если у нас есть оба списка и они не пустые, то переходим к следующей строке

1
2
3
4
5
6
7
8
9
10
(and
  (eval
    (list
      fun
      (car lst-1)
      (car lst-2)
    ) ;_  list
  ) ;_  eval
  (rec-every fun (cdr lst-1) (cdr lst-2))
) ;_  and

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

1
2
3
4
5
6
7
(eval
  (list
    fun
    (car lst-1)
    (car lst-2)
  ) ;_  list
) ;_  eval

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

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

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

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

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
  ; Сама рекурсия
(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

Часть 5

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

1
2
3
4
5
6
7
8
9
10
(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))

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

1
2
3
4
5
6
(defun rec-member-if (fun lst)
  (if (apply fun (list(car lst)))
    lst
    (rec-member-if fun (cdr lst))
  ) ;_  if
) ;_  defun

Вызывать:

1
2
3
4
5
6
7
8
9
(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 . А теперь разберем, как работает рекурсия:
В первой строке, как всегда, пишем проверку для выхода.

1
(apply fun (list(car lst)))

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

1
lst

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

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

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
  ; Сама рекурсия
(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

1
2
3
4
5
6
7
8
9
10
11
(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)

Часть 6

Хочу внести, некоторую ясность, по поводу примеров, приведенных в уроках 4 и 5.

1
2
3
4
5
6
(defun rec-member-if (fun lst)
  (if (apply fun (list(car lst)))
    lst
    (rec-member-if fun (cdr lst))
  ) ;_  if
) ;_  defun

Вызывать:

1
2
3
4
5
6
7
8
(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
2
3
4
5
6
7
8
9
10
11
12
13
(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 освободится! Аналогично будет выглядеть код и с другими предложенными рекурсиями:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
(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)
1
2
3
4
5
6
7
8
(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)

Часть 7

Урок 6
Рассмотрим функцию, работающую подобно vl-remove (ее назначение смотрите в справке). Пример стандартного применения:

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

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
(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)

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

1
((not lst) nil)

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

1
(= el (car lst))

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

1
(rec-remove el (cdr lst))

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

1
(cons (car lst)

В седьмой строке, самовызов функции без первого элемента

1
(rec-remove el (cdr lst))

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
  ; Сама рекурсия
(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)

Часть 8

Урок 7
На прошлом уроке, мы рассматривали аналог функции VL-REMOVE. Сегодня я хочу показать аналоги функций:
VL-REMOVE-IF
VL-REMOVE-IF-NOT
VL-POSITION
Рассмотрим VL-REMOVE-IF
Пример стандартного применения:

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

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
(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

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

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

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

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

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

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

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

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
(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
Пример стандартного применения:

1
2
3
(vl-position 4 '(2 4 6 4))
;Возвращает:
; 1

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
(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 состоит из двух частей. В первой части мы определяем локальную функцию с тем же названием но с дополнительным аргументом, который будем использовать как счетчик.

1
2
3
4
5
6
7
(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 (зеро)
Во второй части, мы делаем вызов, только, что определенной функции.

1
(rec-position test lst 0)

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

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

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

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

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

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

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

1
2
3
4
5
6
7
8
9
10
11
12
13
(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)

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
(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 с использованием тестовой функции, а не значения и возвращением всех позиций списком...
Например функция:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
(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 - никаких проблем!

Часть 9

Урок 8
Закончить рассмотрение встроенных функций с префиксом VL- и написание их аналогов, хочу функцией VL-SORT. Я написал несколько вариантов этой функции, при помощи рекурсий, используя различные алгоритмы. На нескольких уроках, мы их рассмотрим. Реализация VL-SORT - с помощью рекурсии, гораздо сложнее функций, рассмотренных, на предыдущих занятиях. Если вам не до конца понятны предыдущие уроки, рекомендую рассмотреть их еще раз. Сразу хочу оговориться - эти варианты работают медленнее, чем встроенная функция, но моя задача научить создавать рекурсии, а не написать библиотеку функций.
Для начала, рассмотрим самый простой алгоритм. Его название "Сортировка методом выбора" или "Selection sort". Это самый медленный, из рассматриваемых мной алгоритмов.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
(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 с любым элементом списка. Потом ставим его в начало результирующего списка, удаляем первое вхождение найденного значения в изучаемом списке и к укороченному списку, рекурсивно, применяем функцию еще раз... И так, до окончания списка.
На нашем примере, результат должен выглядеть

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

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
(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 - ей не нужно просматривать весь список! На входе мы имеем удаляемый элемент и список. Ничего необычного в этой функции нет,
надеюсь, что вы уже сами можете написать подобную. В первой проверке, как всегда список. Если он не закончился, проверяем равенство тестового элемента и первого элемента списка. Если не равно, добавляем первый элемент к результату рекурсии без первого элемента, иначе возвращаем список без первого элемента.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
(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 выражения вычисляется строка

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

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
(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)

Часть 10

Урок 9
На прошлом уроке, мы рассмотрели программу сортировки списка методом выбора или "Selection sort". Очевидно, что его можно улучшить, выбирая не только минимальные значения из списка, но и максимальные. Т.е. мы будем выбирать из списка минимальное и максимальное значения и добавлять их в результирующий список в начало и конец, а оставшийся после удаления первых вхождений этих элементов список будем снова обрабатывать с целью поиска минимального и максимального значений. Короче, этот алгоритм аналогичен предыдущему. Очевидно, что для реализации, опять, потребуется три подпрограммы:
1 - поиск самого минимального и максимального значения списка
2 - удаление первого вхождения элемента, заданного аргументом, из списка
3 - запуск в нужной последовательности, первых двух программ
и формирование результирующего списка...

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
(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)

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
(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 дополнительным аргументом и дополнительной проверкой... Дополнительный аргумент - переменная, в которой будем сохранять максимальное значение,
а дополнительная проверка, для его поиска.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
(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)

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

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

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

1
(> (length lst) 1)

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
(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)

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

Часть 11

Урок 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 .Для некоторого упрощения я добавил проверку списка на длину более двух элементов, если элементов всего два - их можно сразу поставить по местам. Что бы реализовать этот алгоритм, я его логически поделил на три программы. Первая программа делит список на два, сравнивая все элементы с тестовым значением. Далее нам нужна программа, вызывающая сортировку и формирующая результирующий список. На входе в программу сортировки подается список, а мы собираемся делить его на подсписки, значит, для начала нужно создать список, в котором первым и единственным элементом, будет весь исходный список для сортировки, далее его будем делить на куски,
внутри этого списка. Исходя из темы урока - изучение рекурсий, нужно максимально использовать рекурсии, но ухудшать скорость не хотелось и я вынес создание вложенного списка из сортируемого, в отдельную программу.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
(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... В первой проверке - проверяем наличие списка - уточняем, что список не пустой. Если список закончился, значит нужно сформировать результирующий список:

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

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
(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 Понятно, что до этого места программа может дойти, только если есть сортируемый список, в котором первый подсписок имеет более двух элементов. Здесь мы первым делом сортируем первый подсписок на три подсписка. Используя, лямбда функцию, временно запоминаем результат, и последовательно добавляем подсписки из полученного списка в сортируемый список без первого подсписка. Вообще то это можно было написать покороче, вместо:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
((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
)

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
(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

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
(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 .
Ее задача, вложить сортируемый список в другой список и запустить программу сортировки.

1
2
3
4
5
6
7
8
9
10
(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)

Размещено в Код LISP, Новости, Разное, Функции LISP · Метки: , , ,



Комментарии

Есть 2 коммент. к “Рекурсии от Евгения Елпанова”
  1. ElpanovEvgeniy пишет:
    21 Август 2017 в 8:45

    Спасибо Алексей за теплые слова!
    Не ожидал, что эти уроки еще востребованы.

    Пользуясь случаем, хочу передать большое спасибо Александру Ривилису и Алексею Кулику. Они мне сильно помогли в написании этой серии уроков своими советами и правками.
    Мой "русская языка" слишком беден, чтоб в одиночку написать и оформить подобную серию статей.

  2. Пётр пишет:
    21 Август 2017 в 9:34

    Фундаментально! Впечатляет! ))

Поделитесь своим мнением


Я не робот.