Initial commit
[askhader/m135-tools.git] / scheme / euclidean.ss
1 #lang scheme
2
3 (provide divides? solvable? make-diophant eea
4          eea-solution? printdio e e_solved)
5
6 ; equations are comprised of
7 ; '((5 x) (3 y) 18)
8 (define-struct monomial (constant identifier))
9 (define-struct diophant (a b c))
10 (define-struct solution (x y))
11
12 ; structure printing
13 (define (printdio eqn)
14   (let ((a (diophant-a eqn))
15         (b (diophant-b eqn))
16         (c (diophant-c eqn)))
17     (printf "~ax + ~ay = ~a~n" a b c)))
18
19 ; predicate for divisibility
20 (define (divides? a b) (= (remainder b a) 0))
21
22 ;determines if a linear diophantine equation has a solution
23 (define (solvable? eqn)
24     (divides? (gcd (diophant-a eqn) (diophant-b eqn))
25               (diophant-c eqn)))
26
27 ; extended euclidean algorithm
28 ; return a single solution '(x y)
29 ; diophant -> solution
30 (define (eea eqn)
31   (let ((a (diophant-a eqn))
32         (b (diophant-b eqn))
33         (c (diophant-c eqn)))
34      ; euclidean algo
35      (define (ea s q0 x y x0 y0)
36        (let* ((q (quotient s q0))
37               (r (remainder s q0)))
38          (printf "~a = (~a)(~a) + ~a ~n"
39                 s q0 q r)
40          (cond [(= r 0) (list x y)]
41                [true (ea q0 
42                           r 
43                           (+ (* (- q) x) x0)
44                           (+ (* (- q) y) y0)
45                           x 
46                           y)])))
47     (cond [(> b a) (reverse (eea (make-diophant b a c)))]
48           [(divides? a c) (list (quotient c a) 0)]
49           [(divides? b c) (list 0 (quotient c b))]
50           [true (let* ((z (quotient c (gcd a b))))
51                   (map (lambda (x) (* z x))
52                        (ea a b 0 1 1 0))) ])))
53
54 ; determine if a solution to the equation is correct
55 ; diophant, solution -> bool
56 (define (eea-solution? eqn soln)
57   (let ((a (diophant-a eqn))
58         (b (diophant-b eqn))
59         (c (diophant-c eqn)))
60     (= (+ (* a (car soln)) (* b (cadr soln))) c)))
61
62 ; test definitions
63 (define e (make-diophant 7 19 151))
64 (define e_solved (eea e))