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
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
|
; test big integer operators
(unless bigint
(println "big integers not enabled in this version")
(exit))
(println ">>>>> testing big ints arithmetik ... ")
(set-locale "C")
;; check embedded bigint 0's
(set 'nums '(
; aligned
12345678901000000000L
123456789010000000001234567890L
123456789010000000000000000001234567890L
123456789010000000000000000000L
123000000000000000000000000000L
123000000000000000001L
; not aligned
123456789010000000000L
1234567890100000000001234567890L
1234567890100000000000000000000L
1230000000000000000000000000000L
1230000000000000000001L
1234578901000000000L
12345789010000000001234567890L
12345789010000000000000000000L
123000000000000000000000000L
123000000000000001L
))
(dolist (num nums)
(unless (= (/ num 1) num)
(println num)
(println ">>>>> ERROR in big integer zeros")
(exit))
)
; some special cases
(unless (and
(= (/ 1234567890123456789012345678901234567890 12345678901234567890) 100000000000000000001L)
(= (/ 1234567890L 12345L) 100005L)
(= (/ 1234567891L 1234567890L) 1L)
(= (/ 1234567890L 1234567890L) 1L)
(= (/ 888888888888888888888888888888888888888888888888888888888888888888888888
888888888888888888888888888888888888888888888888888888888888889) 999999999L)
(= (/ 888888888888888888888888888888888888888888888888888888888888888888888888
888888888888888888888888888888888888888888888888888888888888888) 1000000000L)
(= (/ 888888888888888888888888888888888888888888888888888888888888888888888888
888888888888888888888888888888888888888888888888888888888888887) 1000000000L)
(= (/ 11111111111111111L 11111111111111111L) 1L) ; problems with gcc optimizations on Linux
(= (/ 22222222222222222L 22222222222222222L) 1L)
(= (/ 44444444444444444L 44444444444444444L) 1L)
(= (/ 88888888888888888L 88888888888888888L) 1L)
(= (/ 99999999999999999L 99999999999999999L) 1L) )
(println ">>>>> ERROR in special cases")
(exit)
)
(seed 5212011)
(if (> (length (main-args)) 2)
(set 'N (int (main-args -1)))
(set 'N 100000))
(if eval-string-js (set 'N 1000)) ; for JavaScript compiled newLISP
(dotimes (i N)
(set 'f (pow (random 10 100) (+ 15 (rand 50))))
(set 'f1 (float (bigint f)))
(unless eval-string-js
(when (= i (* (/ i 1000) 1000)) (print ".")))
;(println "=>" (sub (abs (div f f1)) 1.0))
(unless (<= (abs (sub (abs (div f f1)) 1.0)) 0.000000001)
(println f " " f1 " " (abs (sub (abs (div f f1)) 1)))
(println ">>>>> ERROR in big integer/float conversion")
(exit))
)
(println)
(define (get-bignum n , num)
(set 'num (amb "-" ""))
(if (zero? n) (++ n))
(dotimes (i n)
(extend num (string (+ (rand 1000) 1))))
(extend num (dup (string (rand 10)) (rand 10)))
(extend num "L")
(bigint num))
(dotimes (i N)
(setq x (get-bignum (rand 30)))
(setq y (get-bignum (rand 30)))
;(println "x=" x " y=" y)
(unless eval-string-js
(when (= i (* (/ i 1000) 1000)) (print ".")))
(unless (= (zero? x) (= x 0))
(println ">>>>> ERROR in zero? for x = " x)
(exit))
(unless (and
(= (/ x x) 1L)
(= (/ y y) 1L)
)
(println ">>>>> ERROR in x/x y/y " x " " y)
(exit))
(setq x+y (+ x y))
(setq x-y (- x y))
(setq x*y (* x y))
(setq x/y (/ x y))
(set 'xx x)
(unless (= (++ xx y) x+y)
(println ">>>>> ERROR in ++ with " x " " y)
(exit))
(set 'xx x)
(unless (= (-- xx y) x-y)
(println ">>>>> ERROR in -- with " x " " y)
(exit))
(unless (and (= (- x+y y) x) (= (- x+y x) y) (= (+ x-y y) x) )
(println ">>>>> ERROR in +, - with " x " " y)
(exit))
(unless (and (= (/ x*y x) y) (= (/ x*y y) x))
(println ">>>>> ERROR in * / with:\n" x "\n" y "\nat: " i)
(println "x*y / x ->" (/ x*y x) )
(println "x*y / y ->" (/ x*y y) )
(exit))
(unless (= (% x y) (- x (* x/y y)))
(println ">>>>> ERROR in %, * , / operation with " x " " y)
(exit))
(when (> (abs x/y) 0)
;(println x " " y " remainder " (- (abs x) (* (abs x/y) (abs y))))
(unless (< (- (abs x) (* (abs x/y) (abs y))) (abs y))
(println ">>>>> ERROR in abs, -, *, - with " x " " y)
(exit))
)
)
(println)
; gcd for bigint
; from http://bit-player.org/2013/the-keys-to-the-keydom
; and: http://en.wikipedia.org/wiki/Euclidean_algorithm
(set 'x 123784517654557044204572030015647643260197571566202790882488143432336664289530131607571273603815008562006802500078945576463726847087638846268210782306492856139635102768022084368721012277184508607370805021154629821395702654988748083875440199841915223400907734192655713097895866822706517949507993107455319103401)
(set 'y 139752806258570179719657334941265463008205415047073349942370461270597321020717639292879992151626413610247750429267916230424010955054750502833517070395986289724237112410816000558148623785411568845517146303421384063525091824898318226175234193815950597041627518140906384889218054867887058429444934835873139133193)
(define (gcd-big a b)
(if (= b 0) a (gcd-big b (% a b))))
(define (gcd-big a b , t)
(until (= b 0)
(set 't b)
(set 'b (% a b))
(set 'a t)
))
(set 'f 10704679319376067064256301459487150226969621912489596482628509800922080318199635726117009340189103336170841315900354200725312700639146605265442630619090531)
(unless (= (gcd x y) f)
(println ">>>>> ERROR in big integer gcd")
(exit))
(unless (= (length 1234567890123456789012345) 25)
(println ">>>>> ERROR in big integer length")
(exit))
(dotimes (i 1000)
(unless (= (gcd i (- 1000 i)) (gcd (bigint i) (- 1000 i)))
(println ">>>>> ERROR in gcd to bigint gcd comparison")))
;;(println ">>> big int gcd benchmark " (time (gcd x y) 1000) " micro secs")
(println ">>>>> abs bigint float gcd length zero? + - * / % ++ -- big ints tested SUCCESSFUL")
(exit)
;; eof
|
