LISP TD2 corrections    

************************
;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