Форумы caduser.ru

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

(rec_- lst_1 lst_2 lst_3)

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

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

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

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

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

(rec_lst_3d lst)

получаем
Код

'((1 2 3) (4 5 6) (7 8 9))  
Хотя, никаких ответов - советов и вопросов нет, рискну продолжить…
Буду считать, что сама идея, как работают приведенные выше функции, вам понятна, если я ошибаюсь,
пожалуйста, поправьте меня!
Пусть это будет урок 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
Здраствуйте Евгения! На мой взгляд рекурсивная
функция выглядит очень красиво. Однако считаю,
что область эффективного применения рекурсии,
очень ограничена. Если рассматривать итеративный метод исчисления, то здесь возможности намного шире. Если функция, создаваемая, как рекурсивная, очень мала, то возможен выигрыш в сокращении объёма кода и красоте программирования. Но рекурсивные версии многих процедур выполняются медленнее, чем итеративный эквивалент, при этом затрачиваются системные ресурсы, из-за локальных переменных и параметров. Т.к. их копии, при каждом вызове рекурсивной функции, записываются в стек до остановки рекурсии.
Если задача труднорешаема итеративным методом, то, конечно, тогда рекурсия незаменима.
А вообще задумка об уроках на форуме - чудесна.
> PahRam (2006-03-03 17:49:09)
Спасибо, за добрые слова!
Я хотел бы вынести в другую ветку обсуждение необходимости и / или нужности рекурсий. Ветка созданна ради развеивания мифов и непониманий вокруг такого подхода к програмированию. По вашему вопросу я с удовольствием пообщаюсь (я с вами не согласен) - создавайте тему.
PS. Большое спасибо, что ответили в этой ветке, а то пишу в никуда...
В никуда? Продолжайте. Я всё прочитаю, с удовольствием. Я вроде бы в рекурсиях неплохо разбираюсь, поэтому понимаю, что тема интересна.
> Евгений Елпанов (2006-03-03 18:02:52)

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

Уверен, вы сможете разобраться в ней самостоятельно.
Я, собственно, тот, для кого подобные уроки являются именно толковым словарем, как замечено выше, поскольку не являюсь программистом, а "пасусь" на форуме в поисках оригинально-прикладного материала непосредственно для работы... Нахожу что-то постаянно! В частности информация из последнего урока подвигнула меня на безжалостную замену более громоздких конструкций, созданных для выполнения задач, аналогичных приведенным в примере. Так что присоединяюсь к "фан-клубу"...
> Kosarev (2006-03-06 09:20:25)
Я рад, что вам понравилась функция из последнего урока. Спасибо за теплые слова!
PS. Жаль, что нет отзывов тех, для кого пишутся уроки (можно на почту)...
Предлагаю такой вариант "разбора" полета последней функции:
Код

;; Шаг 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
;; Возвращает '("мы" "изучаем" "рекурсии")
> kpblc (2006-03-06 10:20:14)
Мне нравится твой вариант!
Если нет возражений, от остальных участников форума, следующие уроки будут в таком формате.
Главное преимущество - весь урок можно читать в лисп редакторе, причем наглядность, не страдает.
Смею предложить вариант функции по заданию Урока 3
Код
(defun F (строка образец)
(if (= строка "")
  '("")
  (apply
  '(lambda (символ остаток)
    (if (= символ образец)
     (cons "" (F остаток образец))
     (apply
     '(lambda (список)
       (cons (strcat символ (car список)) (cdr список)))
      (list (F остаток образец)))))
   (list
    (substr строка 1 1)
    (substr строка 2)))))
Вариант попроще (по заданию Урока 3)
Код
(defun F (строка образец)
(if (= строка "")
  '("")
  ((lambda (символ остаток)
    (if (= символ образец)
     (cons "" (F остаток образец))
     ((lambda (список)
       (cons (strcat символ (car список)) (cdr список)))
      (F остаток образец))))
   (substr строка 1 1)
   (substr строка 2))))
> VH (2006-03-07 13:40:29)
Спасибо за участие.
Надеюсь, многие заинтересовавшиеся этой веткой, будут выкладывать свои варианты.
PS. Ваша программа, гараздо лучше предложенной мной для рассмотрения. Я не стал писать подобную только из за сложности понимания для начинающих. Отсюда и SETQ...
PS. Наверное, на следущем уроке и последующих, я буду рассматривать, как можно создать
vl-every,vl-member-if.....vl-remove-if-not
и только потом, собираюсь рассматривать рекурсии, имеющие несколько вариантов самовызова...
> Евгений Елпанов (2006-03-02 16:30:04)
Добрый почин.
Думаю надо показать особенность рекурсии лисп-машины по отношению к остальным языкам.
А что такое лисп-машина и где её увидеть?
> Пастух (2006-03-07 19:06:16)
Наверное, имеется в виду работа со списками... Лисп - язык списков и в нем, так или иначе все крутится вокруг них.
> PalStudio (2006-03-07 18:41:40)
Если показывать класическую рекурсию (не лисп) - нужно вычислять факториал, как в любом учебнике, согласен, показательный пример...
PS. Ребята, я понимаю, что у вас руки чешутся, не стесняйтесь, возьмите любую понравившуюся вам функцию и разберите ее показательно в этой ветке! Шаблон оформления есть...
Единственное НО - желательно соразмерять уровень предыдущего занятия, с предлагаемым...
Я за!
> Пастух (2006-03-07 19:06:16)
Здесь в конце статьи написано про лисп-машины http://www.5ka.ru/67/27500/3.html
Обнаружив на www.dwg.ru задачу про номера повторяющихся элементов списка и не обратив внимания на то, что требуется перечень номеров одного элемента, предлагается список перечней номеров (в формате исходной задачи) всех элементов списка, авось пригодится:
Код
(defun F (список индекс)
(if список
  ((lambda (элемент ведомость)
    ((lambda (перечень)
      (if перечень
       (subst (cons элемент (cons индекс (cdr перечень))) перечень ведомость)
       (cons (cons элемент (list индекс)) ведомость)))
     (assoc элемент ведомость)))
   (car список)
   (F (cdr список) (1+ индекс)))))
>Евгений!
Ещё раз спасибо. Рекурсии стал использовать в программах значительно чаще и стал их применять для решения большего количества задач.
Функция, обратная к представленной в > 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 ведомость))))))
Структура
Код
(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 ведомость))))))
Урок 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
> VH (2006-03-11 15:57:38)
Это просто здорово, что вы решили приобщиться к передаче своих знаний и навыков!
PS. Пишите, пожалуйста, побольше комментариев и расшифровок.
По возможности, оформляйте свои примеры, поближе к учебному материалу...
;*************************************************;*****************************
Урок 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)
Страницы: 1 2 3 4 5 След.
Читают тему (гостей: 1, пользователей: 0, из них скрытых: 0)