Last change
on this file since 1 was 1, checked in by Marek Rychlik, 15 years ago |
First import of a version circa 1997.
|
File size:
1.3 KB
|
Rev | Line | |
---|
[1] | 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 | #+debug(proclaim '(optimize (speed 0) (debug 3)))
|
---|
| 18 | #-debug(proclaim '(optimize (speed 3) (debug 0)))
|
---|
| 19 |
|
---|
| 20 | (defun xgcd (X Y)
|
---|
| 21 | "Extended gcd; the call
|
---|
| 22 | (xgcd X Y)
|
---|
| 23 | returns a multiple value list:
|
---|
| 24 | - GCD
|
---|
| 25 | - U,V such that they solve the equation
|
---|
| 26 | GCD=U*X+V*Y
|
---|
| 27 | - U1,V1 such that
|
---|
| 28 | LCM=U1*X=V1*Y (up to the sign)."
|
---|
| 29 | (labels ((xgcd-aux (x0 x1 u0 v0 u1 v1)
|
---|
| 30 | (cond
|
---|
| 31 | ((= x1 0) (values x0 u0 v0 u1 v1))
|
---|
| 32 | (t (multiple-value-bind (n x2) (floor x0 x1)
|
---|
| 33 | (let ((u2 (- u0 (* n u1)))
|
---|
| 34 | (v2 (- v0 (* n v1))))
|
---|
| 35 | (xgcd-aux x1 x2 u1 v1 u2 v2)))))))
|
---|
| 36 | (xgcd-aux X Y 1 0 0 1)))
|
---|
| 37 |
|
---|
| 38 |
|
---|
Note:
See
TracBrowser
for help on using the repository browser.