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

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

Рекурсии, урок 7

На прошлом уроке, мы рассматривали аналог функции vl-remove Сегодня я хочу показать аналоги функций: vl-remove-if vl-remove-if-not vl-position Рассмотрим vl-remove-if Пример стандартного применения:

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

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

 
(defun rec-remove-if (f lst)
 (cond
  ((not lst)
   nil
  )
  (((eval f)
    (car lst)
   )
   (rec-remove-if
    f
    (cdr lst)
   ) ;_  rec-remove-if
  )
  (T
   (cons
    (car lst)
    (rec-remove-if
     f
     (cdr lst)
    ) ;_  rec-remove-if
   ) ;_  cons
  ) ;_  T
 ) ;_  cond
) ;_  defun

; Вызывать:
(setq f (function(lambda (x)(< 8 x 12)))
      lst '(5 10 15 20)
) ;_  setq

(rec-remove-if f lst)
; Вернет '(5 15 20)
 

Разберем, как она работает. В первой проверке, как всегда, организуем выход, на случай пустого списка и возвращаем NIL

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

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

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

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

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

Рассмотрим vl-remove-if-not
Пример стандартного применения:

 
(setq f (function(lambda (x)(< 8 x 17)))
      lst '(5 10 15 20)
) ;_  setq

(vl-remove-if-not f lst)
;Возвращает:
;  '(10 15)
 

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

 
(defun rec-remove-if-not (f lst)
 (cond
  ((not lst)
   nil
  )
  (((eval f)
     (car lst)
    )
   (cons
    (car lst)
    (rec-remove-if-not
     f
     (cdr lst)
    ) ;_  rec-remove-if
   )
  )
  (T
   (rec-remove-if-not
     f
     (cdr lst)
    ) ;_  rec-remove-if
  ) ;_  T
 ) ;_  cond
) ;_  defun

;Вызывать:
(setq f (function(lambda (x)(< 8 x 17)))
      lst '(5 10 15 20)
) ;_  setq

(rec-remove-if-not f lst)
;Возвращает:
;  '(10 15)
 

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

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

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

 
(defun rec-position (test lst / rec-position)
  (defun rec-position (test lst i)
    (cond
      ((not lst) nil)
      ((equal test (car lst)) i)
      (t (rec-position test (cdr lst) (1+ i)))
    ) ;_  cond
  ) ;_  defun
  (rec-position test lst 0)
) ;_  defun

;Вызывать:
(setq test 4
      lst  '(2 4 6 4)
) ;_  setq

(rec-position test lst)
; Вернет 1
 

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

 
(defun rec-position (test lst i)
 (cond
  ((not lst) nil)
  ((equal test (car lst)) i)
  (t (rec-position test (cdr lst) (1+ i)))
 ) ;_  cond
) ;_  defun
 

Аргументы:
test — Тестовое значение, позицию которого определяем в списке.
lst — Список, в котором ищем позицию тестового значения.
i — Счетчик, при первом вызове устанавливаем на 0 (зеро).
Во второй части, мы делаем вызов определенной выше функции.

 
(rec-position test lst 0)
 

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

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

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

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

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

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

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

 
(defun rec-position (test lst i)
 (cond
  ((not lst) nil)
  ((equal test (car lst)) i)
  (t (rec-position test (cdr lst) (1+ i)))
 ) ;_  cond
) ;_  defun

; Аргументы:
(setq test 4
      lst  '(2 4 6 4)
) ;_  setq

; Вызывать:
(rec-position test lst 0)
 

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

 
(defun rec-position (test lst)
 (rec-position-1 test lst 0)
) ;_  defun

(defun rec-position-1 (test lst i)
 (cond
  ((not lst) nil)
  ((equal test (car lst)) i)
  (t (rec-position-1 test (cdr lst) (1+ i)))
 ) ;_  cond
) ;_  defun

; Аргументы:
(setq test 4
      lst  '(2 4 6 4)
) ;_  setq

; Вызывать:
(rec-position test lst)
 

По аналогии с функциями vl-remove-if можно написать vl-position с использованием тестовой функции, а не значения и возвращением всех позиций списком...
Например функция:

 
(defun rec-position-list-if (f lst / rec-position-list-if)
  (defun rec-position-list-if (f lst i)
   (cond
    ((not lst) nil)
    (((eval f) (car lst)) (cons i (rec-position-list-if f (cdr lst) (1+ i))))
    (t (rec-position-list-if f (cdr lst) (1+ i)))
   ) ;_  cond
  ) ;_  defun
  (rec-position-list-if f lst 0)
) ;_  defun

;Вызывать:
(setq f (function minusp)
      lst '(5 -10 15 -20)
) ;_  setq

(rec-position-list-if f lst)
; Вернет
; '(1 3)
 

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

Powered by MODx cms