cl-rsm-mod/0002755000175100017510000000000010760276670013301 5ustar pvaneyndpvaneyndcl-rsm-mod/copying0000644000175100017510000000261507724323106014667 0ustar pvaneyndpvaneyndCopyright (c) 2003 by R. Scott McIntire All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. The name of the Authors may not be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. cl-rsm-mod/package.lisp0000644000175100017510000000272107745336073015570 0ustar pvaneyndpvaneynd;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; ;;;; Name: package.lisp ;;;; Purpose: Package definition for Modular arithmetic. ;;;; Author: R. Scott McIntire ;;;; Date Started: Aug 2003 ;;;; ;;;; $Id: package.lisp,v 1.4 2003/10/03 02:21:53 rscottmcintire Exp $ ;;;; ************************************************************************* (in-package #:cl-user) (defpackage rsm.mod (:use #:cl) (:shadow #:+ #:* #:^) (:documentation "This package supports modular arithmetic. Export Summary: +: Add numbers over Z mod n. *: Multiply numbers over Z mod n. ^: Exponentiate over Z mod n. euler-phi: Return the Euler phi function of a number. factors : Return the factors of a number. gcd-with-pair: Gets the gcd of two numbers a and b returning also the integer pair, (r s), such that r*a + s*b = gcd(a,b). has-inverse-p: Does a number have in inverse in Z mod n? inverse : Find the inverse (if it exists) in Z mod n. ppow : Exponentiate over Z mod p where p is prime. rational-approx: Returns a simple rational approximation within a given tolerance. solve-congruence-system: Solve for x: x = a_i mod m_i; i in [1,N] ") (:export #:+ #:* #:^ #:euler-phi #:factors #:gcd-with-pair #:has-inverse-p #:inverse #:ppow #:rational-approx #:solve-congruence-system)) cl-rsm-mod/mod-test.lisp0000644000175100017510000001272507745336072015735 0ustar pvaneyndpvaneynd;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Package: rsm.mod.test -*- ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; ;;;; Name: mod-test.lisp ;;;; Purpose: Regression testing for modular arithmetic. ;;;; Author: R. Scott McIntire ;;;; Date Started: Aug 2003 ;;;; ;;;; $Id: mod-test.lisp,v 1.7 2003/10/21 20:59:44 rscottmcintire Exp $ ;;;; ************************************************************************* (in-package #:cl-user) (defpackage rsm.mod.test (:use #:cl #:ptester) (:documentation "Provides a test harness for modular arithmetic.") ) (in-package rsm.mod.test) ;;;; RUN THE TESTS. (defun run-mod-tests () (with-tests (:name "MOD TESTS") (test 2 (rsm.mod:+ 3 3 5) :fail-info "Test 1") (test 1 (rsm.mod:* 3 2 5) :fail-info "Test 2") (test 2 (rsm.mod:ppow 12 100 7) :fail-info "Test 3") (test 170 (rsm.mod:^ 213317 527131763 173) :fail-info "Test 4") (test '(2 5) (rsm.mod:factors 100) :test #'equal :fail-info "Test 5") (test '(2 2 5 5) (rsm.mod:factors 100 :no-dups nil) :test #'equal :fail-info "Test 6") (test 12 (rsm.mod:euler-phi 13) :fail-info "Test 7") (test 40 (rsm.mod:euler-phi 100) :fail-info "Test 8") (test 9 (rsm.mod:inverse 9 10) :fail-info "Test 9") (test 1529 (rsm.mod:inverse 2341 7919) :fail-info "Test 10") (test 15651 (rsm.mod:ppow 7919 7232937498729837429 104729) :fail-info "Test 11") (test 777/898 (rsm.mod:rational-approx (/ 2.71828 3.14159) 0.000001) :fail-info "Test 12") (test 22/7 (rsm.mod:rational-approx pi 0.002) :fail-info "Test 13") (test 355/113 (rsm.mod:rational-approx pi 0.001) :fail-info "Test 14") (test 152974058/176796123 (rsm.mod:rational-approx 27182845904523536/31415926535897932 0.0000000000000001) :fail-info "Test 15") (test '(12 (1 0)) (rsm.mod:gcd-with-pair 12 60) :test #'equal :multiple-values t :fail-info "Test 16") (test '(2 (1 -2)) (rsm.mod:gcd-with-pair 14 6) :test #'equal :multiple-values t :fail-info "Test 17") (test '(2 (-2 1)) (rsm.mod:gcd-with-pair 6 14) :test #'equal :multiple-values t :fail-info "Test 18") (test '(1 (-1035 676)) (rsm.mod:gcd-with-pair 1529 2341) :test #'equal :multiple-values t :fail-info "Test 19") (test '(2 (-502648 26455)) (rsm.mod:gcd-with-pair 123456 2345678) :test #'equal :multiple-values t) (test 15651 (rsm.mod:ppow 7919 7232937498729837429 104729) :fail-info "Test 21") (test 21762 (rsm.mod:ppow 7919 72329374987298374298 104729) :fail-info "Test 22") (test 43685 (rsm.mod:ppow 7919 723293749872983742983 104729) :fail-info "Test 23") (test 43685 (rsm.mod:^ 7919 723293749872983742983 104729 :e-phi 104728) :fail-info "Test 24") (test 43685 (rsm.mod:^ 7919 723293749872983742983 104729) :fail-info "Test 25") (test 56170 (rsm.mod:^ 79111 723293749872983742983 104727) :fail-info "Test 26") (test 355/113 (rsm.mod:rational-approx pi 0.0000003) :fail-info "Test 27") (test 12317 (rsm.mod:solve-congruence-system '(1 2 2 4 8 6) '(2 3 5 7 11 13)) :fail-info "Test 28") (test 29243 (rsm.mod:solve-congruence-system '(1 2 3 4 5 6) '(2 3 5 7 11 13)) :fail-info "Test 29") (test 54916118429448 (rsm.mod:solve-congruence-system '(1 2 3 4 5 6) '(7909 101 13 37 97 2003)) :fail-info "Test 30") (test 0 (rsm.mod:solve-congruence-system '(0 0 0) '(2 3 5)) :fail-info "Test 31") (test 23 (rsm.mod:solve-congruence-system '(1 2 3) '(2 3 5)) :fail-info "Test 32") (test t (rsm.mod:has-inverse-p 123 713) :fail-info "Test 33") (test nil (rsm.mod:has-inverse-p 123 717) :fail-info "Test 34") (test nil (rsm.mod:has-inverse-p 3 12) :fail-info "Test 35") (test t (rsm.mod:has-inverse-p 3 8) :fail-info "Test 36") (test 16041953 (rsm.mod:solve-congruence-system '(1 2 3 4 5) '(8 9 25 77 221)) :fail-info "Test 37") (test 0 (rsm.mod:inverse 8 10) :fail-info "Test 38") (test nil (rsm.mod:inverse 8 10 nil nil) :fail-info "Test 39") (test-error (rsm.mod:inverse 8 10 t) :fail-info "Test 40") (test -1 (rsm.mod:inverse 8 10 nil -1) :fail-info "Test 41") (test 3 (rsm.mod:inverse 7 10 nil -1) :fail-info "Test 42") (test 28 (rsm.mod:^ 7 2134145213317 33 :e-phi 20) :fail-info "Test 43") ) t ) cl-rsm-mod/rsm-mod.html0000644000175100017510000001461107745336073015551 0ustar pvaneyndpvaneyndrsm.mod

Documentation for package rsm.mod

Author : R. Scott McIntire

Version: 1.2

Overview:

This package supports modular arithmetic.

Export Summary:

+: Add numbers over Z mod n.
*: Multiply numbers over Z mod n.
^: Exponentiate over Z mod n.


euler-phi: Return the Euler phi function of a number.
factors  : Return the factors of a number.
gcd-with-pair: Gets the gcd of two numbers a and b returning also 
    the integer pair, (r s), such that r*a + s*b = gcd(a,b).
has-inverse-p: Does a number have in inverse in Z mod n?
inverse  : Find the inverse (if it exists) in Z mod n.
ppow     : Exponentiate over Z mod p where p is prime.

rational-approx: Returns a simple rational approximation 
                 within a given tolerance.
solve-congruence-system: Solve for x: x = a_i mod m_i; i in [1,N]

*   (mod &rest args)

Multiply <args> in Mod <mod> arithmetic.

Example: (rsm.mod:* 3 2 5) 

            1

+   (mod &rest args)

Add <args> in Mod <mod> arithmetic.

Example: (rsm.mod:+ 3 3 5) 

            2

^   (b n mod &key (e-phi 0))

Raise <b> to the <n>th power mod <mod> by repeated squaring. If <e-phi> 
is non zero, use the generalization of Fermat's little theorem: 
b^phi(mod) = 1 mod mod, when the gcd of b and mod is 1. The theorem is 
used to replace b^n with b^r where r = mod(n, phi(mod)) and phi is 
the Euler Phi function.

Example: (rsm.mod:^ 213317 527131763 173) 

          170

Example: (rsm.mod:^ 7 2134145213317 33 :e-phi 20) 

          28

euler-phi   (n)

Computes the Euler Phi function of <n>.

Example: (rsm.mod:euler-phi 15) 

          8

factors   (n &key (no-dups t))

Computes and returns a list of the primes factors of <n>. If <no-dups> is
true, then no multiple entries of a factor are returned.

Example: (rsm.mod:factors 100) 

         (2 5)

Example: (rsm.mod:factors 100 :no-dups nil) 

         (2 2 5 5)

gcd-with-pair   (n m)

Returns two values: The gcd of <n> and <m>, and the list (r s) such that 
r * n + s * m = gcd(n,m).

Example: (rsm.mod:gcd-with-pair 15 21) 

         3
         (3 -2)

has-inverse-p   (a n)

Does <a> have an inverse in Z mod <n>?

Example: (rsm.mod:has-inverse-p 10 100) 

         nil

inverse   (a n &optional (error nil) (not-invert-return 0))

Finds the inverse of <a> in Z mod <n>. If <a> inverse does not exist, 
an error is thrown if <error> is non nil. If <error> is nil, then 
<not-invert-return> is returned.

Example: (rsm.mod:inverse 21 100) 

          81

ppow   (b n p)

Raise <b> to the <n>th power in the field Z mod <p>. Here <p> must be prime.

Example: (rsm.mod:ppow 12 100 7) 

          2

rational-approx   (number &optional (epsilon nil))

Find a simple rational approximation to <number> within <epsilon>.

Example: (rsm.mod:rational-approx pi 0.0000003) 

         355/113

solve-congruence-system   (as ms)

Use the Chinese remainder theorem to solve for x, the system of 
congruences: x = as_i mod ms_i. The moduli, <ms>, must all be pairwise 
relatively prime. x will be unique in Z mod (product of <ms>'s).

Example: (rsm.mod:solve-congruence-system '(1 2 3) '(2 3 5)) 

          23
cl-rsm-mod/rsm-mod.asd0000644000175100017510000000233307745336073015352 0ustar pvaneyndpvaneynd;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; ;;;; Name: rsm-mod.asd ;;;; Purpose: ASDF Definition File For Package rsm.mod. ;;;; Author: R. Scott McIntire ;;;; Date Started: Aug 2003 ;;;; ;;;; $Id: rsm-mod.asd,v 1.5 2003/10/21 20:59:44 rscottmcintire Exp $ ;;;; ************************************************************************* (in-package #:cl-user) (defpackage rsm-mod-system (:use #:asdf #:cl)) (in-package rsm-mod-system) (defsystem :rsm-mod :name "rsm-mod" :author "R. Scott McIntire ." :version "1.2" :maintainer "Kevin M. Rosenberg ." :licence "BSD-style" :description "Modular arithmetic." :components ((:file "package") (:file "mod" :depends-on ("package")) )) (defsystem :rsm-mod-test :depends-on (rsm-mod ptester) :components ((:file "mod-test"))) (defmethod perform ((o test-op) (c (eql (find-system 'rsm-mod-test)))) (operate 'load-op 'rsm-mod-test) (or (funcall (intern (symbol-name '#:run-mod-tests) (find-package 'rsm.mod.test))) (error "test-op failed"))) cl-rsm-mod/debian/0002755000175100017510000000000010760276733014523 5ustar pvaneyndpvaneyndcl-rsm-mod/debian/changelog0000644000175100017510000000172510760276733016400 0ustar pvaneyndpvaneyndcl-rsm-mod (1.4) unstable; urgency=low * Changed to group maintanance * Added Vcs-Git control field * swap binary-indep and binary-arch * Updated standard version without real changes * debhelper is Build-Depends -- Peter Van Eynde Sun, 24 Feb 2008 15:23:21 +0100 cl-rsm-mod (1.3) unstable; urgency=low * New maintainer. (Closes: #297396: O: cl-rsm-mod -- McIntire's Common Lisp Modular Arithmetic Library) * Adopted by Peter Van Eynde -- Peter Van Eynde Tue, 1 Mar 2005 10:19:18 +0100 cl-rsm-mod (1.2) unstable; urgency=low * New upstream -- Kevin M. Rosenberg Tue, 21 Oct 2003 17:07:51 -0600 cl-rsm-mod (1.1) unstable; urgency=low * Rename system from rsm.mod to rsm-mod -- Kevin M. Rosenberg Sat, 23 Aug 2003 08:58:53 -0600 cl-rsm-mod (1.0) unstable; urgency=low * Initial upload -- Kevin M. Rosenberg Thu, 14 Aug 2003 17:25:21 -0600 cl-rsm-mod/debian/postinst0000755000175100017510000000063107724323110016316 0ustar pvaneyndpvaneynd#! /bin/sh set -e LISP_PKG=rsm-mod case "$1" in configure) /usr/sbin/register-common-lisp-source ${LISP_PKG} ;; abort-upgrade|abort-remove|abort-deconfigure) ;; *) echo "postinst called with unknown argument \`$1'" >&2 exit 1 ;; esac # dh_installdeb will replace this with shell code automatically # generated by other debhelper scripts. #DEBHELPER# exit 0 cl-rsm-mod/debian/control0000644000175100017510000000114710760276720016123 0ustar pvaneyndpvaneyndSource: cl-rsm-mod Section: devel Priority: optional Maintainer: Debian Common Lisp Team Uploaders: Peter Van Eynde Build-Depends: debhelper (>> 4.0.0) Standards-Version: 3.7.3 Vcs-Git: http://git.debian.org/git/pkg-common-lisp/cl-rsm-mod.git Package: cl-rsm-mod Architecture: all Depends: ${shlibs:Depends}, common-lisp-controller (>= 3.37) Recommends: cl-ptester Description: McIntire's Common Lisp Modular Arithmetic Library This is R. Scott McIntire's Common Lisp modular arithmetic function library. It supports large number arithmetic. cl-rsm-mod/debian/copyright0000644000175100017510000000322707724323110016444 0ustar pvaneyndpvaneyndThis package was debianized by Kevin M. Rosenberg on Thu, 21 Aug 2003 14:08:02 -0600. It was downloaded from CVS at http://www.sf.net/projects/com-lisp-utils/ Upstream Author: R. Scott McIntire Copyright: Copyright (c) 2003 by R. Scott McIntire All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. The name of the Authors may not be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. cl-rsm-mod/debian/rules0000755000175100017510000000315010760276700015572 0ustar pvaneyndpvaneynd#!/usr/bin/make -f pkg := rsm-mod debpkg := cl-rsm-mod clc-source := usr/share/common-lisp/source clc-systems := usr/share/common-lisp/systems clc-pkg := $(clc-source)/$(pkg) doc-dir := usr/share/doc/$(debpkg) configure: configure-stamp configure-stamp: dh_testdir # Add here commands to configure the package. touch configure-stamp build: build-stamp build-stamp: configure-stamp dh_testdir # Add here commands to compile the package. touch build-stamp clean: dh_testdir dh_testroot rm -f build-stamp configure-stamp # Add here commands to clean up after the build process. rm -f debian/$(debpkg).postinst.* debian/$(debpkg).prerm.* dh_clean install: build dh_testdir dh_testroot dh_clean -k # Add here commands to install the package into debian/$(pkg). dh_installdirs $(clc-systems) $(clc-pkg) $(doc-dir) dh_install $(pkg).asd $(shell echo *.lisp) $(clc-pkg) dh_link $(clc-pkg)/$(pkg).asd $(clc-systems)/$(pkg).asd # Build architecture-dependent files here. binary-arch: build install # Build architecture-independent files here. binary-indep: build install dh_testdir dh_testroot # dh_installdebconf dh_installdocs $(shell echo *.html) dh_installexamples # dh_installmenu # dh_installlogrotate # dh_installemacsen # dh_installpam # dh_installmime # dh_installinit # dh_installcron # dh_installman # dh_installinfo # dh_undocumented dh_installchangelogs dh_strip dh_compress dh_fixperms # dh_makeshlibs dh_installdeb # dh_perl dh_shlibdeps dh_gencontrol dh_md5sums dh_builddeb binary: binary-indep binary-arch .PHONY: build clean binary-indep binary-arch binary install configure cl-rsm-mod/debian/prerm0000755000175100017510000000061707724323110015564 0ustar pvaneyndpvaneynd#! /bin/sh set -e LISP_PKG=rsm-mod case "$1" in remove|upgrade|deconfigure) /usr/sbin/unregister-common-lisp-source ${LISP_PKG} ;; failed-upgrade) ;; *) echo "prerm called with unknown argument \`$1'" >&2 exit 1 ;; esac # dh_installdeb will replace this with shell code automatically # generated by other debhelper scripts. #DEBHELPER# exit 0 cl-rsm-mod/debian/compat0000644000175100017510000000000207724323110015703 0ustar pvaneyndpvaneynd4 cl-rsm-mod/mod.lisp0000644000175100017510000002103307745336072014750 0ustar pvaneyndpvaneynd;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; ;;;; Name: mod.lisp ;;;; Purpose: Modular arithmetic. ;;;; Author: R. Scott McIntire ;;;; Date Started: Aug 2003 ;;;; ;;;; $Id: mod.lisp,v 1.6 2003/10/21 20:59:44 rscottmcintire Exp $ ;;;; ************************************************************************* (in-package rsm.mod) (eval-when (:compile-toplevel) (declaim (optimize (speed 3) (debug 0) (safety 1) (space 0)))) (declaim (ftype (function (integer &rest integer) integer) +)) (defun + (mod &rest args) "Add in Mod arithmetic. Example: (rsm.mod:+ 3 3 5) 2" (reduce #'(lambda (x y) (mod (cl:+ (mod x mod) (mod y mod)) mod)) args :initial-value 0)) (declaim (ftype (function (integer &rest integer) integer) *)) (defun * (mod &rest args) "Multiply in Mod arithmetic. Example: (rsm.mod:* 3 2 5) 1" (reduce #'(lambda (x y) (mod (cl:* (mod x mod) (mod y mod)) mod)) args :initial-value 1)) (defun ppow (b n p) "Raise to the th power in the field Z mod

. Here

must be prime. Example: (rsm.mod:ppow 12 100 7) 2" (^ b n p :e-phi (1- p))) (declaim (ftype (function (integer integer integer &key (:e-phi integer)) integer) ^)) (defun ^ (b n mod &key (e-phi 0)) "Raise to the th power mod by repeated squaring. If is non zero, use the generalization of Fermat's little theorem: b^phi(mod) = 1 mod mod, when the gcd of b and mod is 1. The theorem is used to replace b^n with b^r where r = mod(n, phi(mod)) and phi is the Euler Phi function. Example: (rsm.mod:^ 213317 527131763 173) 170 Example: (rsm.mod:^ 7 2134145213317 33 :e-phi 20) 28" (let ((bmod (mod b mod))) (when (= bmod 0) (return-from ^ 0)) (when (= bmod 1) (return-from ^ 1)) (when (and (/= e-phi 0) (= (gcd mod bmod) 1)) (setf n (mod n e-phi))) (loop :with prd = 1 :with pow = bmod :with nn = n :while (> nn 0) :if (oddp nn) :do (setf prd (mod (* mod prd pow) mod)) (when (= prd 0) (return 0)) (setf nn (/ (1- nn) 2)) (setf pow (* mod pow pow)) :else :do (setf nn (/ nn 2)) (setf pow (* mod pow pow)) :finally (return prd)))) (defun euler-phi (n) "Computes the Euler Phi function of . Example: (rsm.mod:euler-phi 15) 8" (let ((factors (factors n))) (reduce #'cl:* (mapcar #'(lambda (p) (- 1 (/ p))) factors) :initial-value n))) (defun %get-powers (k n) "Get the list of the factor that appears in ." (loop :with nn = n :with facts = nil :while (= (mod nn k) 0) :do (setf nn (/ nn k)) (push k facts) :finally (return facts))) (defun %get-powers-of-2-3 (n) "Get the list of the primes 2 and 3 that occur in ." (let ((2-facts (%get-powers 2 n)) (3-facts (%get-powers 3 n))) (nconc 2-facts 3-facts))) (defun factors (n &key (no-dups t)) "Computes and returns a list of the primes factors of . If is true, then no multiple entries of a factor are returned. Example: (rsm.mod:factors 100) (2 5) Example: (rsm.mod:factors 100 :no-dups nil) (2 2 5 5)" (let ((2-3-facts (%get-powers-of-2-3 n))) (let ((other-facts (loop :with nn = (/ n (apply #'cl:* 2-3-facts)) :with m = (isqrt nn) :with k = 5 :with factors = nil :with skip fixnum = 2 :while (<= k m) :do (if (= (mod nn k) 0) (progn (setf nn (do ((n1 nn (/ n1 k))) ((> (mod n1 k) 0) n1) (push k factors))) (setf m (isqrt nn))) (progn (incf k skip) (if (= skip 2) (setf skip 4) (setf skip 2)))) :finally (return (nreverse (if (> nn 1) (cons nn factors) factors)))))) (if no-dups (delete-duplicates (nconc 2-3-facts other-facts)) (nconc 2-3-facts other-facts))))) (defun %get-gcd-pair (ms flip) (let ((u 1) (v (- (pop ms)))) (loop :until (null ms) :do (psetq u v v (cl:- u (cl:* (pop ms) v)))) (if flip (list v u) (list u v)))) (defun gcd-with-pair (n m) "Returns two values: The gcd of and , and the list (r s) such that r * n + s * m = gcd(n,m). Example: (rsm.mod:gcd-with-pair 15 21) 3 (3 -2)" (let* ((max (max n m)) (min (min n m)) (flip (when (= min n) t))) (let (ms (qs (list min max))) (loop :with p = max :with q = min :with r = 1 :do (multiple-value-bind (m1 r1) (truncate p q) (setf p q) (setf q r1) (setf r r1) (if (= r 0) (return) (progn (push r qs) (push m1 ms))))) (if (null ms) (values min (if flip (list 1 0) (list 0 1))) (values (pop qs) (%get-gcd-pair ms flip)))))) (defun has-inverse-p (a n) "Does have an inverse in Z mod ? Example: (rsm.mod:has-inverse-p 10 100) nil" (= (gcd a n) 1)) (defun inverse (a n &optional (error nil) (not-invert-return 0)) "Finds the inverse of in Z mod . If inverse does not exist, an error is thrown if is non nil. If is nil, then is returned. Example: (rsm.mod:inverse 21 100) 81" (let ((gcd (gcd a n))) (if (= gcd 1) (multiple-value-bind (r pairs) (gcd-with-pair a n) (declare (ignore r)) (mod (car pairs) n)) (if error (error "rsm.mod:inverse: First arg, ~s, is not invertible in Z mod ~s." a n) not-invert-return)))) (defun solve-congruence-system (as ms) "Use the Chinese remainder theorem to solve for x, the system of congruences: x = as_i mod ms_i. The moduli, , must all be pairwise relatively prime. x will be unique in Z mod (product of 's). Example: (rsm.mod:solve-congruence-system '(1 2 3) '(2 3 5)) 23" (unless (= (length as) (length ms)) (error "rsm.mod:solve-congruence-system: Congruence values, ~s, are not the same length as the moduli, ~s~%" as ms)) (loop for (mod . mod-rest) on ms do (loop for modi in mod-rest do (unless (= (gcd mod modi) 1) (error "rsm.mod:solve-congruence-system: Modulus ~s and ~s are not relatively prime.~%" mod modi)))) (let ((M (reduce #'cl:* ms)) (x 0)) (loop for m in ms as a in as do (let* ((Mi (/ M m)) (Ni (inverse Mi m))) (setf x (+ M x (* M (mod a m) Mi Ni))))) x)) (defun rational-approx (number &optional (epsilon nil)) "Find a simple rational approximation to within . Example: (rsm.mod:rational-approx pi 0.0000003) 355/113" (let ((last-approx (rational number))) (flet ((rat-approx (rat) (let ((num (numerator rat)) (den (denominator rat))) (if (or (= num 1) (= den 1)) rat (multiple-value-bind (gcd pair) (gcd-with-pair num den) (declare (ignore gcd)) (/ (cadr pair) (- (car pair)))))))) (let ((approx (if (rationalp number) (rat-approx number) (rat-approx (rational number))))) (if epsilon (progn (loop :until (or (= approx last-approx) (>= (abs (- approx number)) epsilon)) :do (setf last-approx approx) (setf approx (rat-approx approx))) last-approx) (progn (setf approx (rat-approx approx)) (loop :until (= approx last-approx) :do (setf last-approx approx) (setf approx (rat-approx approx))) approx))))))