Информационный портал Media Systems & Bear Corp.

Главная Новости Delphi C&C++ Tеория Графов Web-Design Математика Исходники и Проекты Лисп и Пролог Ссылки

Портал :: Программирование на Лиспе :: Лабораторные работы
Лабораторная работа № 2( Скачать архив )  

Рекурсивная обработка списковой информации.

Задание 6: Определить предикат, распознающий списки, имеющие четное количество элементов. Запускать (EvenList ...).

(defun RunEvenList (L n)
(cond ((Null L) (evenP n ))
(T (RunevenList (cdr l) (+ n 1) ))
)
)

(defun EvenList (L)
(cond ((not (listp L)) 'non-list)
((null l) T)
( T (RunEvenList L 0))
)
)

(rds)

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

Задание 7: Подсчитать сумму всех числовых атомов в списке произвольной структуры. Запускать (CountNumAtoms ...).

(defun CountNumAt (l)
(cond ((Null l) 0)
((listp (car l)) (+ (CountNumAt (car l))
(CountNumAt (cdr l))
))
(T (If (NumberP (car L)) (+ (car l) (CountNumAt (cdr l)))
(CountNumAt (cdr l))))
)
)


(defun CountNumAtoms (L)
(cond ((not (listp l)) 'non-list!!)
((Null L) nil)
(T (CountNumAt L))
)
)

(RDS)

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

Задание 8: Определить максимальную глубину списка произвольной структуры. Запускать (MaxDepth..).

(defun RunMAXDEPTH (L X)
(COND ((NULL l) X )
((ATOM (CAR L)) (RunMAXDEPTH (CDR L) X))
(T (IF (< X (RunMAXDEPTH (CAR L) (+ X 1)))
(SETQ X (RunMAXDEPTH (CAR L) (+ X 1)) )
)
(RunMAXDEPTH (CDR L) X)
)
)
)

(defun MaxDepth (L)
(cond ((Not (List L)) 'non-list!!)
(T (RunMaxDepth L 0))
)
)


(rds)

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

Задание 9: Найти максимальный элемент в списке произвольной структуры. Запускать (MaxMem ...)

(defun RunMaxMem (L )
(cond ((null (cdr l)) (if (Numberp (car l)) (car l) (RunMaxMem(car l))))
(T (if (< (RunMaxMem(car l)) (RunMaxMem (cdr l) ))
(RunMaxMem (cdr l))
(RunMaxMem (car l))
)
)
)
)

(defun MaxMem (L)
(cond ((not (listp L)) 'non-list)
((null L) nil)
(T (RunMaxMem L))
)
)
(rds)

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

Задание 10: Написать функцию, выполняющую вычисление арифметических выражений, заданных в виде списка. Используемые операции - умножить (*), разделить (/), сложить (+), вычесть (-). При вычисении учитывать приоритет операций и скобочные выражения. (Запускать (Evaluate '( 3 + 5 * 6))).

(defun RunEvaluate (l)
(Cond ((Null (Cdr L)) (If (ListP (Car L)) (RunEvaluate (Car L)) (Car L)))
( (ListP (Car L))
(Setq L (Append (List (funcall (Cadr L) (RunEvaluate (Car L)) (RunEvaluate (caddr L))))
(cdddr L)
)
)
(RunEvaluate L)
)
(T (Setq L (Append (List (funcall (Cadr L) (Car L) (RunEvaluate (caddr L))))
(cdddr L)
)
)
(RunEvaluate L))
)
)

(defun FindSubL (L NoCheck)
(if (Null NoCheck) (setq L (append (list (CheckIt (Car L))) (cdr l))))
(cond ((Null L) Nil)
( (or (eq (cadr L) "*" ) (eq (cadr L) "/" )
) (Append (list (car L)
(cadr L)
)
(FindSubL (cddr L))
)
)
(T (List (Car L)))
)
)

(defun GetPastSubL (L)
(cond ((Null (cdr L)) Nil)
( (or (eq (cadr L) "*" ) (eq (cadr L) "/" )
)
(GetPastSubL (cddr L))
)
(T (cdr L))
)
)


(defun CheckIt (L)
(Cond ((Null L) Nil)
((Atom L) L )
(T (CrPar L))
)
)

(defun CrPar (L NoCheck)
(if (Null NoCheck) (setq L (append (list (CheckIt (Car L))) (cdr l))))
(cond ((null (cdr L)) L)
((or (eq (cadr L) "*" )
(eq (cadr L) "/" )
)
(setq L (Cons (FindSubL L NoCheck) (GetPastSubL L)))
(CrPar L 1)
)
(T (append (list (car L)
(cadr L)
)
(CrPar (cddr L))
)
)
)
)

(defun Check (L NoCheck)
(cond ((And (Not (NumberP (Car L))) (Not (List (Car L)))) Nil)
((And (ListP (Car L)) (Null NoCheck)) (And (Check (Car L)) (Check L 1)))
((Null (cdr L)) T )
((Null (cddr L)) nil)
((or (eq (cadr L) '+ ) (eq (cadr L) '- ) (eq (cadr L) '* ) (eq (cadr L) '/ ))
(Check (cddr L))
)
(T nil)
)
)


(defun Evaluate (L)
(cond ((not( listp L)) "non-list")
((null L) nil)
((not (Check L nil)) "error-data")
(T (setq L(CrPar L ))
(RunEvaluate L)
)
)
)

(rds)

©Bear Labs, Inc. 2001, All Rights Reserved.

 
   
  Гостевая книга . Связь с разработчиками: Bear Corporation, Media Studio.  
  Это место для вашей рекламы  

Дизайн: Bear Corner, Inc. & Media Sudio.
Последнее обновление: 24.03.2001.

Rambler's Top100 Rambler's Top100
Hosted by uCoz