couples-3.lisp (3392B)
1 (defun gauss-formula (n) 2 (/ (* n (+ n 1)) 2)) 3 4 (defun get-n (code) 5 (isqrt (* code 2))) 6 7 (defun get-axis (code) 8 (gauss-formula (isqrt (* code 2)))) 9 10 (defun get-axis-from-n (n) 11 (gauss-formula n)) 12 13 (defun axis-code-compare (code) 14 (format t "~d ~d~%" code (get-axis code))) 15 16 (defun axis-code-compare-n (startcode n) 17 (let ((i 0)) 18 (loop 19 (when (> i n) (return)) 20 (axis-code-compare (+ startcode i)) 21 (incf i)))) 22 23 (defun ord-pr-to-code-nat (x y) 24 (let ((sumxy (+ x y))) 25 (if (evenp sumxy) 26 (+ (gauss-formula sumxy) x) 27 (+ (gauss-formula sumxy) y)))) 28 29 (defun code-to-ord-pr-nat (code) 30 (let ((n (get-n code)) 31 (axis (get-axis code)) 32 (diff 0)) 33 (progn 34 (when (> (get-axis code) code) 35 (progn 36 (setf n (- n 1)) 37 (setf axis (get-axis-from-n n)))) 38 (setf diff (- code axis)) 39 (if (evenp n) 40 (cons diff (cons (- n diff) ())) 41 (cons (- n diff) (cons diff ())))))) 42 43 (defun nat-to-int (nat) 44 (if (< nat 0) 45 (- (* 2 (abs nat)) 1) 46 (* 2 (abs nat)))) 47 48 (defun int-to-nat (int) 49 (if (evenp int) 50 (/ int 2) 51 (ceiling (- (- (/ int 2)) 1)))) 52 53 54 (defun ord-pr-to-code-int (x y) 55 (setf x (nat-to-int x)) 56 (setf y (nat-to-int y)) 57 (ord-pr-to-code-nat x y)) 58 59 (defun code-to-ord-pr-int (code) 60 (let ((L (code-to-ord-pr-nat code))) 61 (progn 62 (setf L (cons (int-to-nat (first L)) (cdr L))) 63 (setf L (cons (car L) (cons (int-to-nat (second L)) ()))) 64 L))) 65 66 (defun ord-mult-to-code-nat (L) 67 (if (= (list-length L) 1) 68 (car L) 69 (ord-mult-to-code-nat (append (butlast (butlast L)) 70 (cons (ord-pr-to-code-nat (car (last (butlast L))) (car (last L))) ()))))) 71 72 (defun code-to-ord-mult-nat (L-or-code size) 73 (if (atom L-or-code) 74 (code-to-ord-mult-nat (code-to-ord-pr L-or-code) (- size 1)) 75 (if (not (= size 1)) 76 (code-to-ord-mult-nat (append (butlast L-or-code) (code-to-ord-pr (car (last L-or-code)))) 77 (- size 1)) 78 L-or-code))) 79 80 #| Les codes générés par cette fonction ne correspondent pas au code généré par le 81 diagramme du rapport ni des fonctions ord-mult-to-code et code-to-ord-mult. 82 Toutefois, la fonction ci-dessous a été créées ici car son écriture et beaucoup plus idiomatique 83 en LISP (d'où le nom 'ord-mult-to-code-lisp'). En effet, si on avait à coder les nombres naturels en LISP, on ajouterait 84 (resp. supprimerait) des éléments de la liste en partant du début de la liste afin de créer 85 une paire ou un n-uplet (resp. pour trouver le code correspondant à une paire ou un n-uplet. 86 On aurait pu faire pareil pour les fonctions concernant tous les entiers 87 |# 88 (defun ord-mult-to-code-nat-lisp (L) 89 (if (= (list-length L) 1) 90 (car L) 91 (ord-mult-to-code-lisp (cons (ord-pr-to-code (first L) (second L)) (cddr L))))) 92 93 #| voir le commentaire précédent concernant la fonction ord-mult-to-code-lisp |# 94 (defun code-to-ord-mult-nat-lisp (L-or-code size) 95 (if (atom L-or-code) 96 (code-to-ord-mult-lisp (code-to-ord-pr L-or-code) (- size 1)) 97 (if (not (= size 1)) 98 (code-to-ord-mult-lisp (append (code-to-ord-pr (car L-or-code)) (cdr L-or-code)) (- size 1)) 99 L-or-code))) 100 101 (defun loop-test (n) 102 (let ((n 0)) 103 (loop 104 (when (> n 10) (return)) 105 (format t "~d ~d ~d~%" n (isqrt n) (gauss-formula n)) 106 ;(print n) (write (* n n)) (write n) 107 (incf n)))) 108