;========================================================== ; TP Lisp n°2 : Abdellah Oulbaks & Adrien Schrèque ; ;========================================================== ;/////////////////////////////// ;/ fonction dliste ;/////////////////////////////// (defun dliste (&rest Z) (list (pair Z) (impair Z)) ) (defun pair (liste) (if (NULL (cdr liste)) nil (cons (cadr liste) (pair (cddr liste))) ) ) (defun impair (liste) (if (NULL liste) nil (cons (car liste) (impair (cddr liste))) ) ) ;/////////////////////////////////// ;/ execution de dliste ;/////////////////////////////////// (print (dliste 1 2 3 4 5 6 7 )) ;*********************************** ;inverse de liste ;*********************************** (defun inverse (liste) (cond ((NULL liste) ()) ((atom (car liste)) (append (inverse (cdr liste)) (list (car liste)))) (t (append (inverse (cdr liste)) (list (inverse (car liste))))) ) ) ;////////////////////////////////// ;execution de inverse ;////////////////////////////////// (print (inverse '(a ((b c) d) (e f)))) ;************************************ ;profondeur ;************************************ (defun profondeur (liste &optional(niveau 0)) (cond ((NULL liste) niveau) ((atom (car liste)) (profondeur (cdr liste) niveau)) (t (max (profondeur (car liste) (1+ niveau)) (profondeur (cdr liste) (1+ niveau)))) ) ) ;/////////////////////////////////// ; execution de profondeur ;/////////////////////////////////// (print (profondeur '(a (b (c))((((b) c)) c)))) ;*********************************** ; fonction OTER-PRED ;*********************************** (defun oter-pred (predicat liste) (cond ((NULL liste) nil) ((atom (car liste))(if (funcall predicat (car liste)) (oter-pred predicat (cdr liste)) (cons (car liste) (oter-pred predicat (cdr liste))))) (t (append (list (oter-pred predicat (car liste))) (oter-pred predicat (cdr liste)))) ) ) ;////////////////////////////////////// ; execution de oter-pred ;////////////////////////////////////// (print (oter-pred 'numberp '((1 a) ((b 3 5 c) d 7) 10))) ;************************************** ; simplifie ;************************************** (defun simplifie (l) (if (atom l) l (let ((elem1 (simplifie (cadr l))) (elem2 (simplifie (caddr l)))) (cond ((equal (car l) '+) (simplifie+ (simplifie elem1) (simplifie elem2))) ((equal (car l) '-) (simplifie- (simplifie elem1) (simplifie elem2))) ((equal (car l) '*) (simplifie* (simplifie elem1) (simplifie elem2))) ) ) ) ) ;*************************************** ; simplifie+ ;*************************************** (defun simplifie+ (l1 l2) (cond ((and (atom l1) (equal l1 0)) l2) ((and (atom l2) (equal l2 0)) l1) ((and (numberp l1) (numberp l2)) (+ l1 l2)) (t (append (cons '+ (list l1)) (list l2))) ) ) ;*************************************** ; simplifie- ;*************************************** (defun simplifie- (l1 l2) (cond ((and (atom l1) (equal l1 0)) l2) ((and (atom l2) (equal l2 0)) l1) ((and (atom l1)(and (atom l2) (equal l1 l2))) 0) ((and (numberp l1) (numberp l2)) (- l1 l2)) (t (append (cons '- (list l1)) (list l2))) ) ) ;*************************************** ; simplifie* ;*************************************** (defun simplifie* (l1 l2) (cond ((and (atom l1) (equal l1 0)) 0) ((and (atom l2) (equal l2 0)) 0) ((and (atom l1) (equal l1 1)) l2) ((and (atom l2) (equal l2 1)) l1) ((and (numberp l1) (numberp l2)) (* l1 l2)) (t (append (cons '* (list l1)) (list l2))) ) ) ;//////////////////////////////////////// ; test d'execution de simplifie ;//////////////////////////////////////// (print (simplifie '(+ (* x (- z z)) (+ (+ 3 4) (* y 1))))) ;**************************************************** ; transformation funcall --> apply ou vice et versa ;**************************************************** (print (apply #'(lambda (x y z) (+ x y z)) '(2 3 4))) (print (apply #'(lambda (x y) (if (> x y) x y)) '(7 5))) (print (apply #'(lambda (x y) (if (> x y) x y)) '(5 7))) ;------------------------------------------------------- (setq l '(list cons *)) (print (funcall (car l) 'a 'b 'c)) (setq m (list 'cons '*)) (print (funcall (cadr m) '2 '5)) ;***************************************************** ; fonction genere ;***************************************************** (defun genere (n) (cond ((equal n 0) ()) ((numberp n) (append (genere (- n 1)) (list n))) (t ()) ) ) ;////////////////////////////// ; test de genere ;////////////////////////////// (print (genere 5)) ;*********************************************** ; fct cube ;********************************************** (defun cube (liste) (cond ((null liste) 0) (t( mapcar #'(lambda(x)(* x x x)) liste)) ) ) ;///////////////////////// ; test ;////////////////////////// (print ( cube (genere 3))) ;***************************** ; calcul ;****************************** (defun calcul (l) (cond ((null l) 0) ((numberp l) (apply '+ (cube (genere l)))) (t null) ) ) ;///////////////////////////// ; test de calcul ;///////////////////////////// (print (calcul 30)) ;*************************** ;generel ;*************************** (defun generel (n) (cond ((equal n 0) '(0)) ((evenp n) (cons n (generel (- n 1)))) ((oddp n) (append (generel (- n 1)) (list n))) (t ()) ) ) ;////////////////////// ; test ;////////////////////// (print (generel 4)) ;******************************** ;fonction insert ;******************************** (defun insert (at liste) (cond ((null liste) (list (list at))) (t (cons (cons at liste) (mapcar #'(lambda (y) (cons (car liste) y)) (insert at (cdr liste))))) ) ) ;///////////////////////////////: ; test de insert ;///////////////////////////////: (print (insert 'u '(a b c))) ;******************************** ; fonction permute ;******************************** (defun permute (l) (cond ((null l) (list ())) (t (mapcan #'(lambda (x) (insert (car l) x)) (permute(cdr l)))) ) ) ;//////////////////// ; test de permute ;//////////////////// (print (permute (genere 5)))