Реализация на prolog
Обзор функций
getcharn (string, integer, char)
Осуществляет поиск символа под нужным номером в исходной строке. В отсутствия в строке символа с нужным номером, возвращает fail.
findchar (string, char, integer)
Возвращает номер позиции символа в строке. Если символ не найден, то функция возвращает fail.
findchar (string, char, integer, integer)
Возвращает номер позиции символа в строке, начиная поиск с заданного номера. Если символ не найден, то функция возвращает fail.
Исходный код
predicates
getcharn (string, integer, char)
findchar (string, char, integer)
findchar (string, char, integer, integer)
clauses
% Получена пустая строка, результат – символ не найден
getcharn ("", _, _):- fail,!.
% Номер символа равен 0, результат – символ не найден
getcharn (_, 0, _):- fail,!.
% Номер символа равен 1, результат – первый символ строки
getcharn (S, 1, C):- frontchar(S, C, _),!.
/* Получаем строку без первого символа и для неё рекурсивно вызываем
функцию getcharn, номер искомого символа уменьшаем на единицу */
getcharn (S, N, C):- N>1, frontchar(S,_,S1), N1=N-1,
getcharn (S1, N1, C),!.
% Получена пустая строка, результат – символ не найден
findchar ("", _, _):- fail,!.
% Получаем первый символ строки и сравниваем его с искомым
findchar (S, C, 1):- frontchar(S, C1, _), C1=C,!.
/* Получаем строку без первого символа и для неё рекурсивно вызываем
функцию findchar, результирующий номер увеличиваем на единицу */
findchar (S, C, N):- frontchar(S,_,S1), findchar(S1,C,N1), N=N1+1,!.
% Всё аналогично предыдущему случаю, но с учётом номера P
findchar ("", _, _, _):- fail,!.
findchar (S, C, P, 1):- frontchar(S, C1, _), P<=1, C1=C,!.
findchar (S, C, P, N):- frontchar(S,_,S1), P1=P-1,
findchar(S1,C,P1,N1), N=N1+1,!.
Примеры
goal:
getcharn (“ABCDEF”, -3, N) —> No solution
getcharn (“ABCDEF”, 5, N) —> N=E
getcharn (“ABCDEF”, 12, N) —> No solution
findchar (“ABCDEFBCK”, ‘B’, N) —> N=2
findchar (“ABCDEFBCK”, ‘B’, 3, N) —> N=7
findchar (“ABCDEFXCK”, ‘B’, 3, N) —> No solution
Задание № 2.
Реализовать функцию (@INTERSECT list1 list2) , возвращающую список list1, в котором оставлены только элементы, входящие в список list2.
Реализация на lisp
Обзор функций
(DEFUN @INTERSECT (L1 L2) ...)
L1, L2 – списки
Осуществляет проверку входных данных и в случае отсутствия ошибок передаёт функции @intersect1, @intersect2 или @intersect3 исходные списки. Также функция отлавливает тривиальные ситуации, когда результат заведомо NIL (один из списков пустой).
(DEFUN @SEARCH (L X) ...)
L – список
X – элемент
Поиск элемента X в списке L на всех уровнях.
(DEFUN @INTERSECT1 (L1 L2) ...)
Рекурсивная реализация функции поиска всех элементов списка L1, входящих в список L2 на всех уровнях.
(DEFUN @INTERSECT2 (L1 L2) ...)
Итерационная реализация функции поиска всех элементов списка L1, входящих в список L2.
(DEFUN @INTERSECT3 (L1 L2) ...)
Реализация функции поиска всех элементов списка L1, входящих в список L2 с использованием функционала.
(DEFUN @DELETE (L X) ...)
Функция удаления всех элементов X из списка L с использованием функционала.
Исходный код
(defun @intersect (L1 L2)
(cond
; Контроль корректности входных данных
((or (not (listp L1)) (not (listp L2)))
Error!_Wrong_list_argument!)
; Отлавливание тривиальной ситуации
((or (null L1) (null L2)) nil)
; Вызов основной функции (рекурсивная реализация)
(T (@intersect1 L1 L2))
; или (@intersect2 L1 L2) – итерационная реализация
; или (@intersect3 L1 L2) – с использованием функционала
)
)
(defun @search (L X)
(cond
; Список пуст, результат – элемент не найден
((null L) nil)
; Поиск элемента в подсписке
((listp (car L))
(OR (@search (car L) X) (@search (cdr L) X)))
; Элемент найден, результат - T
((equal X (car L)) T)
; Иначе – рекурсивный вызов функции для остатка списка
(T (@search (cdr L) X))
)
)
Рекурсивная реализация
(defun @intersect1 (L1 L2)
(cond
; Список пуст, результат – пустой список
((null L1) nil)
; Поиск одинаковых элементов на всех подуровнях
((listp (car L1))
(if (null (@intersect1 (car L1) L2))
(if (null (@intersect (cdr L1) L2)) nil
(@intersect (cdr L1) L2)
)
(if (null (@intersect (cdr L1) L2))
(@intersect1 (car L1) L2)
(list (@intersect1 (car L1) L2) (@intersect (cdr L1) L2))
)
)
)
; Элемент списка L1 найден в L2, добавляем его в результат
((@search L2 (car L1)) (cons (car L1) (@intersect1 (cdr L1) L2)))
; Рекурсивный вызов функции, без изменения результата
(T (@intersect1 (cdr L1) L2))
))
Итерационная реализация
(DEFUN @INTERSECT2 (L1 L2)
; Заводим переменную для результирующего списка
(SETQ R '())
(LOOP
; Достигнут конец списка, возвращаем результирующий список
((NULL L1) (REVERSE R))
; Элемент списка L1 найден в L2, добавляем его в результат
(IF (@SEARCH L2 (CAR L1)) (SETQ R (CONS (CAR L1) R)))
; Удаление первого элемента списка L1
(SETQ L1 (CDR L1))
)
)
С использованием функционала
(DEFUN @INTERSECT3 (L1 L2)
; Заводим переменную для результирующего списка
(SETQ R L1)
(LOOP
; Достигнут конец списка, возвращаем результирующий список
((NULL L1) R)
; Элемент списка L1 не найден в L2, удаляем его из
; результирующего списка
(IF (NOT (@SEARCH L2 (CAR L1)))
(SETQ R (@DELETE R (CAR L1))))
; Удаление первого элемента списка L1
(SETQ L1 (CDR L1))
)
)
(DEFUN @DELETE (L X)
(COND
; Список пуст, результат – удалить элемент не удалось
((NULL L) NIL)
; Удаление элемента из списка с помощью функционала
(T (MAPCON '(LAMBDA (L)
(IF (EQ (CAR L) X) NIL (LIST (CAR L)))
)
L)
)
)
)
Примеры
(@INTERSECT ‘(A B C D) 2) —> Error!_Wrong_list_argument!
(@INTERSECT ‘(A B C D) ‘()) —> NIL
(@INTERSECT ‘(A B C D) ‘(B X Y Z C A A)) —> (A B C)
(@INTERSECT ‘(X Y Z) ‘(A B C)) —> NIL
Рекурсивная реализация также поддерживает многоуровневые списки:
(@INTERSECT '(A B (C D) E) (B (D (С) В))) —> (B (С D))