1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
|
; "math-integer.scm": mathematical functions restricted to exact integers
; Copyright (C) 2006 Aubrey Jaffer
;
;Permission to copy this software, to modify it, to redistribute it,
;to distribute modified versions, and to use it for any purpose is
;granted, subject to the following restrictions and understandings.
;
;1. Any copy made of this software must include this copyright notice
;in full.
;
;2. I have made no warranty or representation that the operation of
;this software will be error-free, and I am under no obligation to
;provide any services, by way of maintenance, update, or otherwise.
;
;3. In conjunction with products arising from the use of this
;material, there shall be no use of my name in any advertising,
;promotional, or sales literature without prior written consent in
;each case.
(require 'logical) ; srfi-60
;;@code{(require 'math-integer)}
;;@ftindex math-integer
;;@body
;;Returns @1 raised to the power @2 if that result is an exact
;;integer; otherwise signals an error.
;;
;;@code{(integer-expt 0 @2)}
;;
;;returns 1 for @2 equal to 0;
;;returns 0 for positive integer @2;
;;signals an error otherwise.
(define (integer-expt n1 n2)
(cond ((and (exact? n1) (integer? n1)
(exact? n2) (integer? n2)
(not (and (not (<= -1 n1 1)) (negative? n2))))
(expt n1 n2))
(else (slib:error 'integer-expt n1 n2))))
;;@body
;;Returns the largest exact integer whose power of @1 is less than or
;;equal to @2. If @1 or @2 is not a positive exact integer, then
;;@0 signals an error.
(define (integer-log base k)
(define (ilog m b k)
(cond ((< k b) k)
(else
(set! n (+ n m))
(let ((q (ilog (+ m m) (* b b) (quotient k b))))
(cond ((< q b) q)
(else (set! n (+ m n))
(quotient q b)))))))
(define n 1)
(define (eigt? k j) (and (exact? k) (integer? k) (> k j)))
(cond ((not (and (eigt? base 1) (eigt? k 0)))
(slib:error 'integer-log base k))
((< k base) 0)
(else (ilog 1 base (quotient k base)) n)))
;;;; http://www.cs.cmu.edu/afs/cs/project/ai-repository/ai/lang/lisp/code/math/isqrt/isqrt.txt
;;; Akira Kurihara
;;; School of Mathematics
;;; Japan Women's University
;;@args k
;;For non-negative integer @1 returns the largest integer whose square
;;is less than or equal to @1; otherwise signals an error.
(define integer-sqrt
(let ((table '#(0
1 1 1
2 2 2 2 2
3 3 3 3 3 3 3
4 4 4 4 4 4 4 4 4))
(square (lambda (x) (* x x))))
(lambda (n)
(define (isqrt n)
(if (> n 24)
(let* ((len/4 (quotient (- (integer-length n) 1) 4))
(top (isqrt (ash n (* -2 len/4))))
(init (ash top len/4))
(q (quotient n init))
(iter (quotient (+ init q) 2)))
(cond ((odd? q) iter)
((< (remainder n init) (square (- iter init))) (- iter 1))
(else iter)))
(vector-ref table n)))
(if (and (exact? n) (integer? n) (not (negative? n)))
(isqrt n)
(slib:error 'integer-sqrt n)))))
(define (must-be-exact-integer2 name proc)
(lambda (n1 n2)
(if (and (integer? n1) (integer? n2) (exact? n1) (exact? n2)
(not (zero? n2)))
(proc n1 n2)
(slib:error name n1 n2))))
;;@body
;;are redefined so that they accept only exact-integer arguments.
(define quotient (must-be-exact-integer2 'quotient quotient))
(define remainder (must-be-exact-integer2 'remainder remainder))
(define modulo (must-be-exact-integer2 'modulo modulo))
|
