Ассоциативные списки и списки свойств.

Задание 26: Извлечь из ассоциативного списка элементы, ключи которых удовлетворяют заданным условиям. Запускать (Assel ...).

(defun ASSEL (F AL)
(COND
((NULL AL) NIL)
((FUNCALL F (CAR (CAR AL))) (CONS (CDR (CAR AL)) (ASSEL F (CDR AL))))
(T (ASSEL F (CDR AL)))
)
)

-----------------------------------------------------------------

Задание 27: Исходный список содержит имена объектов, списки свойств которых содержат некоторую информацию. Определить для каждого объекта количество пар <ключ-значение>. Запускать (Defit ...).

(DEFUN L2 (AL) (LENGTH (CDR AL)));

(defun DEFIT (L)
(COND
((NULL L) NIL)
(T (CONS (L2 (CAR L)) (DEFIT (CDR L)) ))
)
)
;
(rds)

-----------------------------------------------------------------

Задание 28: Исходный список содержит имена объектов, списки свойств которых содержат некоторую информацию. Другой список содержит некоторое количество (>1) флагов. Сформировать список объектов, содержащих не менее двух флагов из заданного списка. Запускать (FgMain ...).

; Предикат определяющий содержится ли флаг в списке
(DEFUN FLP (L F)
(SETQ L (FLAGP L F))
(COND
((NULL L) 0)
(T 1)
)
)

(DEFUN FG1 (L1 L2)
(SETQ C '0)
(LOOP
((NULL L2) (COND ((> C 1) T) (T NIL)))
(SETQ C (+ C (FLP L1 (CAR L2))))
(SETQ L2 (CDR L2))
)
)

(defun FGMAIN (L1 L2)
(SETQ KC NIL)
(LOOP
((NULL L1) KC)
(IF (FG1 (CDR (CAR L1)) L2)
(SETQ KC (APPEND KC (LIST (CAR L1))))
)
(SETQ L1 (CDR L1))
)
)

(SETQ L '(A B C V))

(flag A 'F)
(flag A 'D)
(flag B 'F)
(flag B 'H)
(flag B 'G)
(flag C 'J)
(flag C 'K)
(flag C 'O)

(SETQ K '(F G H J))

(FGMAIN L K)
;
(rds)

----------------------------------------------------------------

Задание 29: Пусть в списке свойств атома может быть специальное свойство с ключом ISA, значение которого является именем другого списка свойств, называемого списком-прототипом, из которого могут наследоваться дополнительные свойства. Написать функцию (Get-Isa <имя списка> <имя свойства>), которая в случае отсутствия искомого свойства в исходном списке выдаёт значение первого найденного такаго же свойства среди всех Isa-прототипов данного списка свойств. Запускать (GetIsa ...).

(SETQ L1 '((S0 . A1) (ISA . A1) (S1 . 1) (S2 . 1) ))
(put A1 's4 '1)
(put A1 's5 '7)

(DEFUN GET-ISA (L K)
(COND
((GET L K) (GET L K))
(T
(SETQ L3754 (GET L 'ISA))
(GET L3754 K)
)
)
)

;
(rds)

----------------------------------------------------------------

Задание 30: На складе имеется несколько видов продукции. Ассортимент каждого вида продукции представлен несколькими наименованиями. Задать инфомацию о имеющихся на складе товарах и их количестве с помощью списков свойств. Определить функции, позволяющие получать информацию о наличии некоторого товара на складе и корректирующие информацию о наличии при завозе и вывозе заданного количестве товара.

(SETQ SCLAD '(TEXTBOOKS PENS))

(put textboOKS 'OB '100)
(put textboOKS 'TO '2500)

(put PENS 'ROL '1000)
(put pens 'GEL '12000)
(put pens 'PER '0)

(DEFUN ISINSCLAD (SCL S)
(LOOP
((GET (CAR SCL) S) (GET (CAR SCL) S))
((NULL SCL) 'NO THIS OBJECT IN OUR SCLAD)
(SETQ SCL (CDR SCL))
)
)

(DEFUN GETFROMSCLAD (SCL S N)
(LOOP
((GET (CAR SCL) S)
(PUT (CAR SCL) S (- (GET (CAR SCL) S) N))
)
((NULL SCL) 'NO THIS OBJECT IN OUR SCLAD)
(SETQ SCL (CDR SCL))
)
)

(DEFUN PUTTOSCLAD (SCL S N)
(LOOP
((GET (CAR SCL) S)
(PUT (CAR SCL) S (+ (GET (CAR SCL) S) N))
)
((NULL SCL) 'NO THIS OBJECT IN OUR SCLAD)
(SETQ SCL (CDR SCL))
)
)

;
(rds)

©Media Studio 2001, All Rights Reserved.