source: project/release/4/lognum/trunk/lognum.scm @ 15389

Last change on this file since 15389 was 15389, checked in by Ivan Raikov, 10 years ago

Fixes to lognum's module declaration.

File size: 2.3 KB
Line 
1;;
2;;
3;; Implementation of a logarithmic number system.
4;;
5;; Copyright 2009 Ivan Raikov and the Okinawa Institute of Science and
6;; Technology.
7;;
8;; This program is free software: you can redistribute it and/or
9;; modify it under the terms of the GNU General Public License as
10;; published by the Free Software Foundation, either version 3 of the
11;; License, or (at your option) any later version.
12;;
13;; This program is distributed in the hope that it will be useful, but
14;; WITHOUT ANY WARRANTY; without even the implied warranty of
15;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
16;; General Public License for more details.
17;;
18;; A full copy of the GPL license can be found at
19;; <http://www.gnu.org/licenses/>.
20;;
21
22(module lognum *
23
24(import scheme chicken)
25
26(require-extension extras matchable datatype)
27
28(define-datatype lognum lognum?
29  (L (s integer?) (n number?)))
30
31(define (number->lognum x)
32  (cond ((zero? x)      (L 0 0))
33        ((positive? x)  (L 1 (log x)))
34        ((negative? x)  (L -1 (log (- x))))))
35       
36
37(define (lognum->number x)
38  (match x
39         (($ lognum 'L s n)
40          (case s ((0) 0) ((-1) (- (exp n))) 
41                ((1) (exp n))))
42         (else #f)))
43                             
44
45(define (lognum-sign x)
46  (match x
47         (($ lognum 'L s n) s)
48         (else #f)))
49                             
50(define (lognum-value x)
51  (match x
52         (($ lognum 'L s n) n)
53         (else #f)))
54                             
55
56(define (logify2 op)
57  (lambda (x y)
58    (number->lognum (op (lognum->number x)  (lognum->number y)))))
59
60(define-record-printer (lognum x out)
61  (fprintf out "~S" (lognum->number x) ))
62
63(define lognum+ (logify2 +))
64
65(define lognum- (logify2 -))
66
67(define (lognum* x y)
68  (match (list x y)
69         ((($ lognum 'L s n) ($ lognum 'L s1 n1))
70          (if (or (zero? s) (zero? s1)) (L 0 0)
71              (L (* s s1) (+ n n1))))
72         (else #f)))
73
74(define (lognum-neg x)
75  (match x (($ lognum 'L s n) (L (- s) n))
76         (else #f)))
77
78(define (lognum-abs x)
79  (match x (($ lognum 'L s n) (L (abs s) n))
80         (else #f)))
81
82(define (lognum-signum x)
83  (match x (($ lognum 'L s n) (L s 0))
84         (else #f)))
85
86(define (lognum/ x y)
87  (match (list x y)
88         ((($ lognum 'L 0 n) _) (error 'lognum/ "division by zero"))
89         ((($ lognum 'L s n) ($ lognum 'L s1 n1))
90          (L (* s s1) (- n n1)))
91         (else #f)))
92
93(define (lognum-recip x)
94  (match x (($ lognum 'L s n) (L s (- n)))
95         (else #f)))
96 
97
98#|
99
100    fromRational x = (fromInteger $ numerator x) / (fromInteger $ denominator x)
101
102|#
103)
Note: See TracBrowser for help on using the repository browser.