Line | |
---|
1 | #|
|
---|
2 | $Id: xgcd.lisp,v 1.4 2009/01/22 04:09:05 marek Exp $
|
---|
3 | *--------------------------------------------------------------------------*
|
---|
4 | | Copyright (C) 1994, Marek Rychlik (e-mail: rychlik@math.arizona.edu) |
|
---|
5 | | Department of Mathematics, University of Arizona, Tucson, AZ 85721 |
|
---|
6 | | |
|
---|
7 | | Everyone is permitted to copy, distribute and modify the code in this |
|
---|
8 | | directory, as long as this copyright note is preserved verbatim. |
|
---|
9 | *--------------------------------------------------------------------------*
|
---|
10 | |#
|
---|
11 |
|
---|
12 | (defpackage "XGCD"
|
---|
13 | (:use "COMMON-LISP")
|
---|
14 | (:export xgcd))
|
---|
15 | (in-package "XGCD")
|
---|
16 |
|
---|
17 | (proclaim '(optimize (speed 3) (space 0) (safety 0) (debug 0)))
|
---|
18 |
|
---|
19 | (defun xgcd (X Y)
|
---|
20 | "Extended gcd; the call
|
---|
21 | (xgcd X Y)
|
---|
22 | returns a multiple value list:
|
---|
23 | - GCD
|
---|
24 | - U,V such that they solve the equation
|
---|
25 | GCD=U*X+V*Y
|
---|
26 | - U1,V1 such that
|
---|
27 | LCM=U1*X=V1*Y (up to the sign)."
|
---|
28 | (labels ((xgcd-aux (x0 x1 u0 v0 u1 v1)
|
---|
29 | (cond
|
---|
30 | ((= x1 0) (values x0 u0 v0 u1 v1))
|
---|
31 | (t (multiple-value-bind (n x2) (floor x0 x1)
|
---|
32 | (let ((u2 (- u0 (* n u1)))
|
---|
33 | (v2 (- v0 (* n v1))))
|
---|
34 | (xgcd-aux x1 x2 u1 v1 u2 v2)))))))
|
---|
35 | (xgcd-aux X Y 1 0 0 1)))
|
---|
36 |
|
---|
37 |
|
---|
Note:
See
TracBrowser
for help on using the repository browser.