************************
;1.union
;
;a. recursive
(de union (e1 e2)
(cond ((null e1) e2)
((member (car e1) e2) (union (cdr e1) e2))
(t (union (cdr e1) (cons (car e1) e2)))
)
)
;b. iterative
(de unioni (e1 e2)
(while e1
(unless (member (car e1) e2)
(setq e2 (cons (car e1) e2))
)
(setq e1 (cdr e1))
)
e2)
;************************
;2. intersection
;
;a. recursive
(de inter (e1 e2)
(cond ((null e1) ())
((member (car e1) e2) (cons (car e1) (inter (cdr e1) e2)))
(t (inter (cdr e1) e2))
)
)
;b. recursive
(de interi (e1 e2)
(setq int ())
(while e1
(when (member (car e1) e2)
(setq int (cons (car e1) int))
)
(setq e1 (cdr e1))
)
int)
(de interi2 (e1 e2)
(let ((int))
(while e1
(when (member (car e1) e2)
(setq int (cons (car e1) int))
)
(setq e1 (cdr e1))
)
int)
)
;************************
;3. difference
;
;a. recursive
(de diff (e1 e2)
(cond ((null e1) ())
((member (car e1) e2) (diff (cdr e1) e2))
(t (cons (car e1) (diff (cdr e1) e2)))
)
)
;b. iterative
( de diffi (e1 e2)
(setq loc ())
(while e1
(unless (member (car e1) e2)
(setq loc (cons (car e1) loc))
)
(setq e1 (cdr e1))
)
loc)
;************************
;4. egalite
(de egalite (e1 e2)
(cond (( and (null e1) (null e2)) (true))
( (member (car e1) e2) (egalite (cdr e1) (diff e2 (list (car e1))))
)
)
)
;************************
;5. tri_insertion
(de inser (a l)
(cond ((<= a (car l)) (cons a l))
((<= (car (last l)) a) (append l (list a)))
(t (cons (car l) (inser a (cdr l))))
)
)
(de triinser (l)
(cond ((nul l) ())
((= (length l) 1) l)
(t (inser (car l) (triinser (cdr l))))
)
)
;************************
;tri_selection
(de select (l)
(let ((res (list (car l))))
(while (cdr l)
(setq l (cdr l))
(if (< (car l) (car res))
(setq res (cons (car l) res))
(setq res (append res (list (car l))))
)
)
res
)
)
(de triselect (l)
(let ((l1))
(cond ((null l) ())
((= (length l) 1) l)
(t (setq l1 (select l))
(cons (car l1) (triselect (cdr l1)))
)
)
)
)
************************
;6. tri_general
;
(de trig (f l)
(cond ((null l) ())
((null (cdr l)) l)
(t (inserg f (car l) (trig f (cdr l)))
)
)
)
(de inserg (f e l)
(cond ((null l) (list e))
((funcall f e (car l)) (cons e l))
(t (cons (car l) (inserg f e (cdr l)))
)
)
)
************************
7. factoriel
(de factoriel (n)
(if (= n 0) 1
(* n (factoriel (1- n))
)
)
)
;************************
;8. moyenne
(de moyenne l
(let ( (somme (car l))
(nb 1)
(s (cdr l))
)
( while s
(setq somme (+ somme (car s)))
(setq nb (1+ nb))
(setq s (cdr s))
)
(/ somme nb)
)
)
;************************
;9. min et max
(de minimum l
(let ( (m (car l))
(s (cdr l))
)
( while s
(if (> m (car s))
(setq m (car s))
)
(setq s (cdr s))
)
m
)
)
;************************
;10.
(de rac_reel (a b c)
(>= (- (times b b) ( times 4. a c)) 0)
)
(de racines (a b c)
(when (rac_reel a b c)
( let ( (rdelta (sqrt (- (time b b))
(time 4. a c)
)
)
( deux_a (times 2. a))
)
(list (\ (+ (- b) rdelta) deux_a
)
(\ (- (- b) rdelta) deux_a
)
)
)
)
)
;************************
;11. hanoi
Hanoi
(de hanoi (n)
(deplacer 'dep 'arr 'sauv n)
'FIN
)
(de deplacer (d a s n)
(if (= n 1)
(depd d a)
(deplacer d s a (1- n))
(depd d a)
(deplacer s a d (1- n))
)
)
(de depd (d a)
(print "deplace un disque de "
d
" vers "
a)
)
(de hanoi () (deplacer 'arr 'sauv (length dep)))
(de depd (d a)
(print "-deplacer le disque " (car (eval d))
" de " d
" vers " a)
(set a (cons (car (eval d))
(eval a))
)
(set d (cdr (eval d))
)
)
Vincent Vajnovszki
ven 27 fév 13:03:55 NFT 1998