Великому и могучему языку посвящается...

Новая версия сайта, доступна здесь.

Рекурсии, урок 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

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

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

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

Вызывать:

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

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

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

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

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

 
(defun rec-every (fun lst-1 lst-2)
  (if (and lst-1 lst-1)
    (and
      (eval
        (list
          fun
          (car lst-1)
          (car lst-2)
        ) ;_  list
      ) ;_  eval
      (rec-every fun (cdr lst-1) (cdr lst-2))
    ) ;_  and
    T
  ) ;_  if
) ;_  defun

(setq lst-1'(1 2) lst-2 '(1 2 3))
(rec-every (function =) lst-1 lst-2)


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

(setq lst '(1 "Str" (0 . "line") nil t))
(rec-member-if-not (function atom) lst)
 

Powered by MODx cms