(define zero 0)

(define 
  (valeur-absolue n)
  (if (< n 0)
    (* n -1)
    n
  )
)

(define 
  (false? n)
  (if (or #f n)
    #f
    #t
  )
)

(define 
  (true? n)
  (not
    (false? n)
  )
)

(define
  (orex? x y)
  (if (and x y)
    #f
    (if (or x y)
      #t
      #f
    )
  ) 
)

(orex? #t #t)
(orex? #f #f)
(orex? #t #f)

;
; atom
;
(define
  (atom? x)
  (not (pair? x))
)

;
; npair?
;
(define
  (npair? x)
  (if (= (modulo x 2) 0)
    #t
    #f
  )
)

;
; nimpair?
;
(define
  (nimpair? x)
  (not (npair? x))
)

;
; append1
;
(define
  (append1 l e)
  (append l (list e))
)

(append '(a b c) '(d e))
(append1 '(a b c) 3)

;
; bissextile?
;
(define
  (bissextile n)
  (if (= 0 (modulo n 4))
      (if (= 0 (modulo n 100))
          (if (= 0 (modulo n 400))
              #t
              #f
          )
          #t
      )
      #f
   )
) 

(bissextile 1900)
(bissextile 1995)
(bissextile 1996)
(bissextile 2000)

;
; 3.2 Fonctions recursives
;

(define 
  (npair? n)
  (if (= n zero)
     #t
     (not (nimpair? (valeur-absolue n)))
  )
) 

(define
  (nimpair? n)
  (if (npair? (- (valeur-absolue n) 1))
    #t
    #f
  )
)

(npair? 0)
(nimpair? 1)

(npair? 32)
(npair? 33)
(nimpair? 34)
(nimpair? 35)

;
; puissance x p
;
(define
  (puissance x p)
  (if (= p 0)
    1
    (* x (puissance x (- p 1)))
  )
) 

(puissance 3 3)

;
; compte
;
(define
  (compte x l)
  (if (null? l)
    0
    (if (equal? (car l) x)
      (+ (compte x (cdr l)) 1)
      (compte x (cdr l))
    )
  )
)

;
; compte2 (compte avec (cond)
;
(define
  (compte x l)
  (cond ((null? l) 0)
        ((equal? (car l) x) (+ (compte x (cdr l)) 1)) 
        (else (compte x (cdr l)))
  )
) 


(compte 1 '(1 2 3 4 1 1))

;
; renverse
;
(define
  (renverse l)
  (if (null? l)
      '()
      (append1 (renverse (cdr l)) (car l))
  )
)

(renverse '(1 2 3 4 5))

;
; renverse-tout
;

(define
  (renverse-tout l)
  (if (null? l) 
      '()
      (append1 (renverse-tout (cdr l)) 
               (if (pair? (car l))
                   (renverse-tout (car l))
                   (car l)
               )
      )
  )
)

(renverse-tout '((1 2 3) (4 5 6) (7 8 9)))

(define
  (dernier-element l)
    (if (not (pair? (cdr l)))
        (car l)
        (dernier-element (cdr l))
    )
)

(dernier-element '(1 2 3))
; XXX
;(dernier-element '())

(define
  (dernier-atome l)
    (if (list? l)
        (dernier-atome (dernier-element l))
        l
    )
)

;(dernier-atome '())
(dernier-atome '(1 2 3))
(dernier-atome '((1 2 3) (4 5 6) (7 8 9)))

(define
  (aplat l)
  (cond ( (not (list? l)) (cons l '()) )
        ( (= (length l) 0) '() )
        ( (= (length l) 1) (aplat (car l)) )
        (else (append (aplat (car l)) (aplat (cdr l)) ))
  ) 
)


;(define
;  (aplat l)
;  (if (list? l)
;      (if (= (length l) 0)
;          '()
;          (if (= (length l) 1)
;              (aplat (car l))
;              (append (aplat (car l)) (aplat (cdr l)))
;          )
;      )
;      (cons l '())
;  )
;)
 
(aplat '((a b) (c d)))

(aplat '((1 2 3)))
(aplat '((1 2 3) (4 5 6) ((1 2) (2 3))))

;(define
;  (inlist? a l)
;    (if (list? l)
;        (if (> (length l) 0)
;            (if (= (car l) a)
;                #t
;                (inlist? a (cdr l))
;            )
;        #f
;        )
;    )
;)

(define
  (inlist? a l)
    (cond ( (not (list? l)) #f)
          ( (<=  (length l) 0) #f)
          ( (= (car l) a) #t)
          (else (inlist? a (cdr l)))
    )
)

(inlist? 0 '())
(inlist? 5 '(1 2 3 4))
(inlist? 5 '(1 2 3 4 5))
(inlist? 5 '(1 2 3 4 5 6))

;
; on reprend le résultat d'aplat, on crée une nouvelle liste.
;

;(define
;  (ensemble-atome liste)
;  (let ( (l (aplat liste)) )
;    (if (list? l)
;        (if (> (length l) 0)
;            (if (inlist? (car l) (cdr l))
;                (ensemble-atome (cdr l))
;                (cons (car l) (ensemble-atome (cdr l)))
;            )
;            '()
;        )
;        (cons l '())
;    )
;  )
;)

(define
  (ensemble-atome liste)
  (let ( (l (aplat liste)) )
    (cond ( (not (list? l)) (cons l '()) )
          ( (<= (length l) 0) '() )
          ( (inlist? (car l) (cdr l)) (ensemble-atome (cdr l)) )
          (else (cons (car l) (ensemble-atome (cdr l))))
    )
  )
)

(ensemble-atome '(1 2 3))
(ensemble-atome '((1 2 3) (4 5 6) ((1 2) (2 3))))

;
; convertir-base
;

(define
  (convertir-base a b)
  (if (= a 0)
      0
      (+ (modulo a b) (* 10 (convertir-base (quotient a b) b)))
  )
)

(convertir-base 4 2)
(convertir-base 5 2)
(convertir-base 42 8)
(convertir-base 42 2)

(define
  (convertir-base-extra a b)
  (if (= a 0)
      '() 
      (append (convertir-base-extra (quotient a b) b)
              (let ((l (modulo a b)))
                   (cons (cond ((= l 10) 'a)
                                ((= l 11) 'b)
                                ((= l 12) 'c)
                                ((= l 13) 'd)
                                ((= l 14) 'e)
                                ((= l 15) 'f)
                                (else l)
                          )
                         '())
              )
      )
  )
)

(convertir-base-extra 42 8)
(convertir-base-extra 42 16)


;
; Calcul sur les fonctions
;

(define
  (somme-fonctions-arite-1 f1 f2)
  (lambda (x) (+ (f1 x) (f2 x)))
)

(define (addme a) (+ a 1))
(define (subme a) (- a 1))

((somme-fonctions-arite-1 addme subme) 1)

(define
  (somme-fonctions-arite-2 f1 f2)
  (lambda (x y) (+ (f1 x y) (f2 x y)))
)

(define (addmebis a b) (+ a b))

((somme-fonctions-arite-2 addmebis addmebis) 2 3)

;
; Fonctionnelles map et apply
;

;(define
;  (mapcar1 f l)
;  (if (not (list? l))
;      '()
;      (if (= (length l) 0)
;             '()
;             (cons (f (car l)) (mapcar1 f (cdr l)))
;      )
;  )
;)

(define
  (mapcar1 f l)
  (cond ( (not (list? l)) '())
        ( (= (length l) 0) '())
        (else (cons (f (car l)) (mapcar1 f (cdr l))))
  )
) 

(mapcar1 addme '())
(mapcar1 addme '(1 2 3 4))

;(define
;  (mapcdr1 f l)
;  (if (not (list? l))
;      '()
;      (if (= (length l) 0)
;             '()
;             (cons (f l) (mapcdr1 f (cdr l)))
;      )
;  )
;)

(define
  (mapcdr1 f l)
  (cond ( (not (list? l)) '())
        ( (= (length l) 0) '())
        (else (cons (f l) (mapcdr1 f (cdr l))))
  ) 
)

(mapcdr1 cdr '())
(mapcdr1 cdr '(1 2 3 4))

(define
  (carre a)
  (* a a)
)

(define
  (liste-carre l)
  (mapcar1 carre l)
)

(liste-carre '(1 2 3 4))
(mapcar1 carre '(1 2 3 4))

(apply map carre '((1 2 3 4)))

;
; procédure compte avec apply et map
;

(lambda(x)(lambda(y)(if(= x y)(1)(0))))

(lambda(x) (lambda(y) (if (= x y) (1) (0))))

(define
  (compte x l)
  (apply + (map (lambda(y) (if (= x y) '1 '0)) l))
)

(compte 1 '(1 2 1 2 1 2 1))

'(1 . (2 . (4 . ())))

(define
  (profondeur l)
  (apply max (map (lambda(y) (if (pair? y) '1 '0)) l)) 
)

(profondeur '(1 2 1 2 1 2 1))
(profondeur '(1 . (2 . (4 . ()))))

(define
  (profondeur l)
    (if (pair? l)
        (+ 1 (apply max (map profondeur l)))
        0 
    )
)

(profondeur '((1 2 3) (1 2 3 4) (1)))

;
; On ne peut pas utiliser and, parce que apply veut l'evaluer et il n'est 
; pas defini.
;

(define
  (every f l)
  (not (memq #f (map f l)))
)

(define
  (isone u)
  (if (= u 1)
      #t
      #f
  )
)

(every isone '(2 2 2))
(every isone '(2 1 1))
(every isone '(1 1 1)) 

(define
  (some f l)
  (if (pair? (memq #t (map f l)))
    #t
    #f
  )
)

(some isone '(2 2 2))
(some isone '(2 1 1))
(some isone '(1 1 1))

(define 
  (mega-or c)
  (some (lambda(x)x) c)
)

;
; Si on reutilise la meme chose, on aura peut etre (#t #t #f #t)
;

;
; 3.5 Fonctions sur les ensembles.
;

;
; 1

(define
  (supprime-doubles l)
  (ensemble-atome l)
)

(supprime-doubles '(1 2 1 2 1 1 2 3 2 1 1 2 3))

;
; 2

(define
  (ens-union k l)
  (ensemble-atome (append k l))
)

(ens-union '() '(1 2 3))
(ens-union '(1 2) '(4 5 6))
(ens-union '(1 2) '(1 2))

;
; 3
;(define
;  (ens-inter k l)
;  (let ( (l1 (supprime-doubles k)) (l2 (supprime-doubles l)) )
;    (if (> (length l1) 0)
;        (if (not (inlist? (car l1) l2))
;            (ens-inter (cdr l1) l2)
;            (cons (car l1) (ens-inter (cdr l1) l2))
;        )
;        '()
;    ) 
;  )
;)
(define
  (ens-inter k l)
  (let ( (l1 (supprime-doubles k)) (l2 (supprime-doubles l)) )
    (cond ( (<= (length l1) 0) '())
          ( (not (inlist? (car l1) l2)) (ens-inter (cdr l1) l2) )
          (else (cons (car l1) (ens-inter (cdr l1) l2)) )
    )
  )
)

(ens-inter '(1 2) '(1 2))
(ens-inter '(1 2) '(4 5 6))
(ens-inter '(1 3) '(1 2))

;
; 4

(define
  (ens-inclus? p l)
  (if (= (length p) (length (ens-inter p l)))
    #t
    #f
  )
)

(ens-inclus? '(1 2) '(1 2 3 4))
(ens-inclus? '(1) '())

;
; 5

(define
  (ens-remplace-inclus liste e)
  (cond ( (<= (length liste) 0) '())
        ( (ens-inclus? e (car liste)) (cons e (ens-remplace-inclus (cdr liste) e)))
        (else (cons (car liste) (ens-remplace-inclus (cdr liste) e)))
  ) 
)

(ens-remplace-inclus '( (1 2) (1 2 3)) '(1))
(ens-remplace-inclus '( (1 3) (1 2) ) '(2))

;
; 6

(define
  (ens-prod-union-1 e liste)
  (map (lambda(x)(ens-union e x)) liste)
)

(ens-prod-union-1 '(1 2) '((3 4) (1))) 

(define
  (ens-prod-union-2 liste1 liste2)
  (map (lambda(y)(ens-prod-union-1 y liste2)) liste1)
)

(ens-prod-union-2 '( (1 2) ) '( (3 4) (5 6)))

;
; 7