;; Notizen der Algorithmen für "Elementare Zahlentheorie"

(defun euclid (a b)			;erweiterter `GCD'
  (if (zerop b) (values a 1 0)
      (multiple-value-bind (q r) (truncate a b)
	(multiple-value-bind (v s u) (euclid b r)
	  (values v u (- s (* u q)))))))

(defun inverse (n m)
  (multiple-value-bind (q s u) (euclid n m)
    (assert (= (+ (* s n) (* u m)) q 1))
    (assert (= (mod (* n s) m) 1))
    (mod s m)))

(defun zahl->basis (n b)
  (if (zerop n) '()
      (multiple-value-bind (q r) (truncate n b)
	(cons r (num->basis q b)))))

(defun basis->zahl (n b)
  (if (null n) 0
      (+ (car n) (* b (basis->num (cdr n) b)))))

(defun modexpt (b e m)
  (do ((c 1 (if (oddp e) (mod (* c b) m) c))
       (e e (ash e -1))
       (b b (mod (* b b) m)))
      ((<= e 0) c)))

(defun teilbar-durch-p (n &rest ps)
  (assert (every (lambda (x) (>= x 1)) ps))
  (dolist (p ps (= n 1))
    (loop (multiple-value-bind (q r) (truncate n p)
	    (if (zerop r) (setf n q) (return))))))

(defun zaehler (a b) (/ a (euclid a b))) ;siehe auch `NUMERATOR'
(defun teiler (a b)  (/ b (euclid a b))) ;siehe auch `DENOMINATOR'

(defun bruch-typ-p (a b)
  (cond
    ((teilbar-durch-p (teiler a b) 5 2)	'endlich)
    ((= (euclid (teiler a b) 10) 1)	'rein-periodisch)
    (t					'gemischt-periodisch)))

(defun kettenbruch (a &optional (b 1))
  (multiple-value-bind (q r) (truncate a b)
    (cons q (and (not (zerop r)) (kettenbruch b r)))))

(defun ent-kettenbruch (kb)
  (+ (car kb) (if (cdr kb) (/ 1 (ent-kettenbruch (cdr kb))) 0)))

(defun crs (&rest eqs)			;chinesischer Restsatz
  (loop :with mx := (reduce #'* eqs :key #'cdr)
	:for (a . m) :in eqs
	:for q = (/ mx m)
	:do (assert (= (euclid q m) 1))
	:sum (* a q (inverse q m)) :into x
	:finally (loop :for (a . m) :in eqs
		       :do (assert (= (mod x m) (mod a m))))
		 (return x)))