line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Math::BigInt::Calc; |
2
|
|
|
|
|
|
|
|
3
|
51
|
|
|
51
|
|
154665
|
use 5.006001; |
|
51
|
|
|
|
|
204
|
|
4
|
51
|
|
|
51
|
|
321
|
use strict; |
|
51
|
|
|
|
|
122
|
|
|
51
|
|
|
|
|
1315
|
|
5
|
51
|
|
|
51
|
|
326
|
use warnings; |
|
51
|
|
|
|
|
103
|
|
|
51
|
|
|
|
|
1926
|
|
6
|
|
|
|
|
|
|
|
7
|
51
|
|
|
51
|
|
332
|
use Carp qw< carp croak >; |
|
51
|
|
|
|
|
148
|
|
|
51
|
|
|
|
|
3446
|
|
8
|
51
|
|
|
51
|
|
37850
|
use Math::BigInt::Lib; |
|
51
|
|
|
|
|
153
|
|
|
51
|
|
|
|
|
260
|
|
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
our $VERSION = '1.999842'; |
11
|
|
|
|
|
|
|
$VERSION =~ tr/_//d; |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
our @ISA = ('Math::BigInt::Lib'); |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
# Package to store unsigned big integers in decimal and do math with them |
16
|
|
|
|
|
|
|
# |
17
|
|
|
|
|
|
|
# Internally the numbers are stored in an array with at least 1 element, no |
18
|
|
|
|
|
|
|
# leading zero parts (except the first) and in base 1eX where X is determined |
19
|
|
|
|
|
|
|
# automatically at loading time to be the maximum possible value |
20
|
|
|
|
|
|
|
# |
21
|
|
|
|
|
|
|
# todo: |
22
|
|
|
|
|
|
|
# - fully remove funky $# stuff in div() (maybe - that code scares me...) |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
############################################################################## |
25
|
|
|
|
|
|
|
# global constants, flags and accessory |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
# constants for easier life |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
my $MAX_EXP_F; # the maximum possible base 10 exponent with "no integer" |
30
|
|
|
|
|
|
|
my $MAX_EXP_I; # the maximum possible base 10 exponent with "use integer" |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
my $MAX_BITS; # the maximum possible number of bits for $AND_BITS etc. |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
my $BASE_LEN; # the current base exponent in use |
35
|
|
|
|
|
|
|
my $USE_INT; # whether "use integer" is used in the computations |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
my $BASE; # the current base, e.g., 10000 if $BASE_LEN is 5 |
38
|
|
|
|
|
|
|
my $MAX_VAL; # maximum value for an element, i.e., $BASE - 1 |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
my $AND_BITS; # maximum value used in binary and, e.g., 0xffff |
41
|
|
|
|
|
|
|
my $OR_BITS; # ditto for binary or |
42
|
|
|
|
|
|
|
my $XOR_BITS; # ditto for binary xor |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
my $AND_MASK; # $AND_BITS + 1, e.g., 0x10000 if $AND_BITS is 0xffff |
45
|
|
|
|
|
|
|
my $OR_MASK; # ditto for binary or |
46
|
|
|
|
|
|
|
my $XOR_MASK; # ditto for binary xor |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
sub config { |
49
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
50
|
|
|
|
|
|
|
|
51
|
0
|
0
|
|
|
|
0
|
croak "Missing input argument" unless @_; |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
# Called as a getter. |
54
|
|
|
|
|
|
|
|
55
|
0
|
0
|
|
|
|
0
|
if (@_ == 1) { |
56
|
0
|
|
|
|
|
0
|
my $param = shift; |
57
|
0
|
0
|
0
|
|
|
0
|
croak "Parameter name must be a non-empty string" |
58
|
|
|
|
|
|
|
unless defined $param && length $param; |
59
|
0
|
0
|
|
|
|
0
|
return $BASE_LEN if $param eq 'base_len'; |
60
|
0
|
0
|
|
|
|
0
|
return $USE_INT if $param eq 'use_int'; |
61
|
0
|
|
|
|
|
0
|
croak "Unknown parameter '$param'"; |
62
|
|
|
|
|
|
|
} |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
# Called as a setter. |
65
|
|
|
|
|
|
|
|
66
|
0
|
|
|
|
|
0
|
my $opts; |
67
|
0
|
|
|
|
|
0
|
while (@_) { |
68
|
0
|
|
|
|
|
0
|
my $param = shift; |
69
|
0
|
0
|
0
|
|
|
0
|
croak "Parameter name must be a non-empty string" |
70
|
|
|
|
|
|
|
unless defined $param && length $param; |
71
|
0
|
0
|
|
|
|
0
|
croak "Missing value for parameter '$param'" |
72
|
|
|
|
|
|
|
unless @_; |
73
|
0
|
|
|
|
|
0
|
my $value = shift; |
74
|
|
|
|
|
|
|
|
75
|
0
|
0
|
0
|
|
|
0
|
if ($param eq 'base_len' || $param eq 'use_int') { |
76
|
0
|
|
|
|
|
0
|
$opts -> {$param} = $value; |
77
|
0
|
|
|
|
|
0
|
next; |
78
|
|
|
|
|
|
|
} |
79
|
|
|
|
|
|
|
|
80
|
0
|
|
|
|
|
0
|
croak "Unknown parameter '$param'"; |
81
|
|
|
|
|
|
|
} |
82
|
|
|
|
|
|
|
|
83
|
0
|
0
|
|
|
|
0
|
$BASE_LEN = $opts -> {base_len} if exists $opts -> {base_len}; |
84
|
0
|
0
|
|
|
|
0
|
$USE_INT = $opts -> {use_int} if exists $opts -> {use_int}; |
85
|
0
|
|
|
|
|
0
|
__PACKAGE__ -> _base_len($BASE_LEN, $USE_INT); |
86
|
|
|
|
|
|
|
|
87
|
0
|
|
|
|
|
0
|
return $self; |
88
|
|
|
|
|
|
|
} |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
sub _base_len { |
91
|
|
|
|
|
|
|
#my $class = shift; # $class is not used |
92
|
73
|
|
|
73
|
|
3060
|
shift; |
93
|
|
|
|
|
|
|
|
94
|
73
|
100
|
|
|
|
296
|
if (@_) { # if called as setter ... |
95
|
62
|
|
|
|
|
158
|
my ($base_len, $use_int) = @_; |
96
|
|
|
|
|
|
|
|
97
|
62
|
50
|
33
|
|
|
753
|
croak "The base length must be a positive integer" |
|
|
|
33
|
|
|
|
|
98
|
|
|
|
|
|
|
unless defined($base_len) && $base_len == int($base_len) |
99
|
|
|
|
|
|
|
&& $base_len > 0; |
100
|
|
|
|
|
|
|
|
101
|
62
|
50
|
66
|
|
|
703
|
if ( $use_int && ($base_len > $MAX_EXP_I) || |
|
|
|
66
|
|
|
|
|
|
|
|
33
|
|
|
|
|
102
|
|
|
|
|
|
|
!$use_int && ($base_len > $MAX_EXP_F)) |
103
|
|
|
|
|
|
|
{ |
104
|
0
|
0
|
|
|
|
0
|
croak "The maximum base length (exponent) is $MAX_EXP_I with", |
105
|
|
|
|
|
|
|
" 'use integer' and $MAX_EXP_F without 'use integer'. The", |
106
|
|
|
|
|
|
|
" requested settings, a base length of $base_len ", |
107
|
|
|
|
|
|
|
$use_int ? "with" : "without", " 'use integer', is invalid."; |
108
|
|
|
|
|
|
|
} |
109
|
|
|
|
|
|
|
|
110
|
62
|
|
|
|
|
158
|
$BASE_LEN = $base_len; |
111
|
62
|
|
|
|
|
766
|
$BASE = 0 + ("1" . ("0" x $BASE_LEN)); |
112
|
62
|
|
|
|
|
152
|
$MAX_VAL = $BASE - 1; |
113
|
62
|
100
|
|
|
|
297
|
$USE_INT = $use_int ? 1 : 0; |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
{ |
116
|
51
|
|
|
51
|
|
487
|
no warnings "redefine"; |
|
51
|
|
|
|
|
193
|
|
|
51
|
|
|
|
|
46039
|
|
|
62
|
|
|
|
|
139
|
|
117
|
62
|
100
|
|
|
|
255
|
if ($use_int) { |
118
|
61
|
|
|
|
|
311
|
*_mul = \&_mul_use_int; |
119
|
61
|
|
|
|
|
219
|
*_div = \&_div_use_int; |
120
|
|
|
|
|
|
|
} else { |
121
|
1
|
|
|
|
|
3
|
*_mul = \&_mul_no_int; |
122
|
1
|
|
|
|
|
3
|
*_div = \&_div_no_int; |
123
|
|
|
|
|
|
|
} |
124
|
|
|
|
|
|
|
} |
125
|
|
|
|
|
|
|
} |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
# Find max bits. This is the largest power of two that is both no larger |
128
|
|
|
|
|
|
|
# than $BASE and no larger than the maximum integer (i.e., ~0). We need |
129
|
|
|
|
|
|
|
# this limitation because _and(), _or(), and _xor() only work on one |
130
|
|
|
|
|
|
|
# element at a time. |
131
|
|
|
|
|
|
|
|
132
|
73
|
|
|
|
|
167
|
my $umax = ~0; # largest unsigned integer |
133
|
73
|
50
|
|
|
|
260
|
my $tmp = $umax < $BASE ? $umax : $BASE; |
134
|
|
|
|
|
|
|
|
135
|
73
|
|
|
|
|
128
|
$MAX_BITS = 0; |
136
|
73
|
|
|
|
|
270
|
while ($tmp >>= 1) { |
137
|
2065
|
|
|
|
|
3192
|
$MAX_BITS++; |
138
|
|
|
|
|
|
|
} |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
# Limit to 32 bits for portability. Is this really necessary? XXX |
141
|
|
|
|
|
|
|
|
142
|
73
|
50
|
|
|
|
315
|
$MAX_BITS = 32 if $MAX_BITS > 32; |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
# Find out how many bits _and, _or and _xor can take (old default = 16). |
145
|
|
|
|
|
|
|
# Are these tests really necessary? Can't we just use $MAX_BITS? XXX |
146
|
|
|
|
|
|
|
|
147
|
73
|
|
|
|
|
317
|
for ($AND_BITS = $MAX_BITS ; $AND_BITS > 0 ; $AND_BITS--) { |
148
|
73
|
|
|
|
|
448
|
my $x = CORE::oct('0b' . '1' x $AND_BITS); |
149
|
73
|
|
|
|
|
165
|
my $y = $x & $x; |
150
|
73
|
|
|
|
|
266
|
my $z = 2 * (2 ** ($AND_BITS - 1)) + 1; |
151
|
73
|
0
|
33
|
|
|
385
|
last unless $AND_BITS < $MAX_BITS && $x == $z && $y == $x; |
|
|
|
33
|
|
|
|
|
152
|
|
|
|
|
|
|
} |
153
|
|
|
|
|
|
|
|
154
|
73
|
|
|
|
|
322
|
for ($XOR_BITS = $MAX_BITS ; $XOR_BITS > 0 ; $XOR_BITS--) { |
155
|
73
|
|
|
|
|
235
|
my $x = CORE::oct('0b' . '1' x $XOR_BITS); |
156
|
73
|
|
|
|
|
170
|
my $y = $x ^ $x; |
157
|
73
|
|
|
|
|
196
|
my $z = 2 * (2 ** ($XOR_BITS - 1)) + 1; |
158
|
73
|
0
|
33
|
|
|
428
|
last unless $XOR_BITS < $MAX_BITS && $x == $z && $y == $x; |
|
|
|
33
|
|
|
|
|
159
|
|
|
|
|
|
|
} |
160
|
|
|
|
|
|
|
|
161
|
73
|
|
|
|
|
320
|
for ($OR_BITS = $MAX_BITS ; $OR_BITS > 0 ; $OR_BITS--) { |
162
|
73
|
|
|
|
|
279
|
my $x = CORE::oct('0b' . '1' x $OR_BITS); |
163
|
73
|
|
|
|
|
167
|
my $y = $x | $x; |
164
|
73
|
|
|
|
|
183
|
my $z = 2 * (2 ** ($OR_BITS - 1)) + 1; |
165
|
73
|
0
|
33
|
|
|
397
|
last unless $OR_BITS < $MAX_BITS && $x == $z && $y == $x; |
|
|
|
33
|
|
|
|
|
166
|
|
|
|
|
|
|
} |
167
|
|
|
|
|
|
|
|
168
|
73
|
|
|
|
|
304
|
$AND_MASK = __PACKAGE__->_new(( 2 ** $AND_BITS )); |
169
|
73
|
|
|
|
|
287
|
$XOR_MASK = __PACKAGE__->_new(( 2 ** $XOR_BITS )); |
170
|
73
|
|
|
|
|
252
|
$OR_MASK = __PACKAGE__->_new(( 2 ** $OR_BITS )); |
171
|
|
|
|
|
|
|
|
172
|
73
|
100
|
|
|
|
64516
|
return $BASE_LEN unless wantarray; |
173
|
6
|
|
|
|
|
56
|
return ($BASE_LEN, $BASE, $AND_BITS, $XOR_BITS, $OR_BITS, $BASE_LEN, $MAX_VAL, |
174
|
|
|
|
|
|
|
$MAX_BITS, $MAX_EXP_F, $MAX_EXP_I, $USE_INT); |
175
|
|
|
|
|
|
|
} |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
sub _new { |
178
|
|
|
|
|
|
|
# Given a string representing an integer, returns a reference to an array |
179
|
|
|
|
|
|
|
# of integers, where each integer represents a chunk of the original input |
180
|
|
|
|
|
|
|
# integer. |
181
|
|
|
|
|
|
|
|
182
|
188716
|
|
|
188716
|
|
431396
|
my ($class, $str) = @_; |
183
|
|
|
|
|
|
|
#unless ($str =~ /^([1-9]\d*|0)\z/) { |
184
|
|
|
|
|
|
|
# croak("Invalid input string '$str'"); |
185
|
|
|
|
|
|
|
#} |
186
|
|
|
|
|
|
|
|
187
|
188716
|
|
|
|
|
302318
|
my $input_len = length($str) - 1; |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
# Shortcut for small numbers. |
190
|
188716
|
100
|
|
|
|
607117
|
return bless [ $str ], $class if $input_len < $BASE_LEN; |
191
|
|
|
|
|
|
|
|
192
|
27265
|
|
|
|
|
62690
|
my $format = "a" . (($input_len % $BASE_LEN) + 1); |
193
|
27265
|
50
|
|
|
|
65077
|
$format .= $] < 5.008 ? "a$BASE_LEN" x int($input_len / $BASE_LEN) |
194
|
|
|
|
|
|
|
: "(a$BASE_LEN)*"; |
195
|
|
|
|
|
|
|
|
196
|
27265
|
|
|
|
|
168840
|
my $self = [ reverse(map { 0 + $_ } unpack($format, $str)) ]; |
|
294991
|
|
|
|
|
555084
|
|
197
|
27265
|
|
|
|
|
117248
|
return bless $self, $class; |
198
|
|
|
|
|
|
|
} |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
BEGIN { |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
# Compute $MAX_EXP_F, the maximum usable base 10 exponent. |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
# The largest element in base 10**$BASE_LEN is 10**$BASE_LEN-1. For instance, |
205
|
|
|
|
|
|
|
# with $BASE_LEN = 5, the largest element is 99_999, and the largest carry is |
206
|
|
|
|
|
|
|
# |
207
|
|
|
|
|
|
|
# int( 99_999 * 99_999 / 100_000 ) = 99_998 |
208
|
|
|
|
|
|
|
# |
209
|
|
|
|
|
|
|
# so make sure that 99_999 * 99_999 + 99_998 is within the range of integers |
210
|
|
|
|
|
|
|
# that can be represented accuratly. |
211
|
|
|
|
|
|
|
# |
212
|
|
|
|
|
|
|
# Note that on some systems with quadmath support, the following is within |
213
|
|
|
|
|
|
|
# the range of numbers that can be represented exactly, but it still gives |
214
|
|
|
|
|
|
|
# the incorrect value $r = 2 (even though POSIX::fmod($x, $y) gives the |
215
|
|
|
|
|
|
|
# correct value of 1: |
216
|
|
|
|
|
|
|
# |
217
|
|
|
|
|
|
|
# $x = 99999999999999999; |
218
|
|
|
|
|
|
|
# $y = 100000000000000000; |
219
|
|
|
|
|
|
|
# $r = $x * $x % $y; # should be 1 |
220
|
|
|
|
|
|
|
# |
221
|
|
|
|
|
|
|
# so also check for this. |
222
|
|
|
|
|
|
|
|
223
|
51
|
|
|
51
|
|
354
|
for ($MAX_EXP_F = 1 ; ; $MAX_EXP_F++) { # when $MAX_EXP_F = 5 |
224
|
510
|
|
|
|
|
763
|
my $MAX_EXP_FM1 = $MAX_EXP_F - 1; # = 4 |
225
|
510
|
|
|
|
|
1123
|
my $bs = "1" . ("0" x $MAX_EXP_F); # = "100000" |
226
|
510
|
|
|
|
|
854
|
my $xs = "9" x $MAX_EXP_F; # = "99999" |
227
|
510
|
|
|
|
|
828
|
my $cs = ("9" x $MAX_EXP_FM1) . "8"; # = "99998" |
228
|
510
|
|
|
|
|
945
|
my $ys = $cs . ("0" x $MAX_EXP_FM1) . "1"; # = "9999800001" |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
# Compute and check the product. |
231
|
510
|
|
|
|
|
921
|
my $yn = $xs * $xs; # = 9999800001 |
232
|
510
|
50
|
|
|
|
1146
|
last if $yn != $ys; |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
# Compute and check the remainder. |
235
|
510
|
|
|
|
|
1746
|
my $rn = $yn % $bs; # = 1 |
236
|
510
|
100
|
|
|
|
1048
|
last if $rn != 1; |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
# Compute and check the carry. The division here is exact. |
239
|
459
|
|
|
|
|
750
|
my $cn = ($yn - $rn) / $bs; # = 99998 |
240
|
459
|
50
|
|
|
|
1045
|
last if $cn != $cs; |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
# Compute and check product plus carry. |
243
|
459
|
|
|
|
|
839
|
my $zs = $cs . ("9" x $MAX_EXP_F); # = "9999899999" |
244
|
459
|
|
|
|
|
645
|
my $zn = $yn + $cn; # = 99998999999 |
245
|
459
|
50
|
|
|
|
906
|
last if $zn != $zs; |
246
|
459
|
50
|
|
|
|
1080
|
last if $zn - ($zn - 1) != 1; |
247
|
|
|
|
|
|
|
} |
248
|
51
|
|
|
|
|
147
|
$MAX_EXP_F--; # last test failed, so retract one step |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
# Compute $MAX_EXP_I, the maximum usable base 10 exponent within the range |
251
|
|
|
|
|
|
|
# of what is available with "use integer". On older versions of Perl, |
252
|
|
|
|
|
|
|
# integers are converted to floating point numbers, even though they are |
253
|
|
|
|
|
|
|
# within the range of what can be represented as integers. For example, on |
254
|
|
|
|
|
|
|
# some 64 bit Perls, 999999999 * 999999999 becomes 999999998000000000, not |
255
|
|
|
|
|
|
|
# 999999998000000001, even though the latter is less than the maximum value |
256
|
|
|
|
|
|
|
# for a 64 bit integer, 18446744073709551615. |
257
|
|
|
|
|
|
|
|
258
|
51
|
|
|
|
|
135
|
my $umax = ~0; # largest unsigned integer |
259
|
51
|
|
|
|
|
473
|
for ($MAX_EXP_I = int(0.5 * log($umax) / log(10)); |
260
|
|
|
|
|
|
|
$MAX_EXP_I > 0; |
261
|
|
|
|
|
|
|
$MAX_EXP_I--) |
262
|
|
|
|
|
|
|
{ # when $MAX_EXP_I = 5 |
263
|
51
|
|
|
|
|
117
|
my $MAX_EXP_IM1 = $MAX_EXP_I - 1; # = 4 |
264
|
51
|
|
|
|
|
215
|
my $bs = "1" . ("0" x $MAX_EXP_I); # = "100000" |
265
|
51
|
|
|
|
|
562
|
my $xs = "9" x $MAX_EXP_I; # = "99999" |
266
|
51
|
|
|
|
|
251
|
my $cs = ("9" x $MAX_EXP_IM1) . "8"; # = "99998" |
267
|
51
|
|
|
|
|
188
|
my $ys = $cs . ("0" x $MAX_EXP_IM1) . "1"; # = "9999800001" |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
# Compute and check the product. |
270
|
51
|
|
|
|
|
155
|
my $yn = $xs * $xs; # = 9999800001 |
271
|
51
|
50
|
|
|
|
233
|
next if $yn != $ys; |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
# Compute and check the remainder. |
274
|
51
|
|
|
|
|
173
|
my $rn = $yn % $bs; # = 1 |
275
|
51
|
50
|
|
|
|
261
|
next if $rn != 1; |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
# Compute and check the carry. The division here is exact. |
278
|
51
|
|
|
|
|
157
|
my $cn = ($yn - $rn) / $bs; # = 99998 |
279
|
51
|
50
|
|
|
|
265
|
next if $cn != $cs; |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
# Compute and check product plus carry. |
282
|
51
|
|
|
|
|
186
|
my $zs = $cs . ("9" x $MAX_EXP_I); # = "9999899999" |
283
|
51
|
|
|
|
|
104
|
my $zn = $yn + $cn; # = 99998999999 |
284
|
51
|
50
|
|
|
|
194
|
next if $zn != $zs; |
285
|
51
|
50
|
|
|
|
333
|
next if $zn - ($zn - 1) != 1; |
286
|
51
|
|
|
|
|
181
|
last; |
287
|
|
|
|
|
|
|
} |
288
|
|
|
|
|
|
|
|
289
|
51
|
50
|
|
|
|
278
|
($BASE_LEN, $USE_INT) = $MAX_EXP_F > $MAX_EXP_I |
290
|
|
|
|
|
|
|
? ($MAX_EXP_F, 0) : ($MAX_EXP_I, 1); |
291
|
|
|
|
|
|
|
|
292
|
51
|
|
|
|
|
391
|
__PACKAGE__ -> _base_len($BASE_LEN, $USE_INT); |
293
|
|
|
|
|
|
|
} |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
############################################################################### |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
sub _zero { |
298
|
|
|
|
|
|
|
# create a zero |
299
|
45807
|
|
|
45807
|
|
70942
|
my $class = shift; |
300
|
45807
|
|
|
|
|
137264
|
return bless [ 0 ], $class; |
301
|
|
|
|
|
|
|
} |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
sub _one { |
304
|
|
|
|
|
|
|
# create a one |
305
|
5064
|
|
|
5064
|
|
8217
|
my $class = shift; |
306
|
5064
|
|
|
|
|
13093
|
return bless [ 1 ], $class; |
307
|
|
|
|
|
|
|
} |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
sub _two { |
310
|
|
|
|
|
|
|
# create a two |
311
|
2316
|
|
|
2316
|
|
3756
|
my $class = shift; |
312
|
2316
|
|
|
|
|
6403
|
return bless [ 2 ], $class; |
313
|
|
|
|
|
|
|
} |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
sub _ten { |
316
|
|
|
|
|
|
|
# create a 10 |
317
|
29997
|
|
|
29997
|
|
50032
|
my $class = shift; |
318
|
29997
|
50
|
|
|
|
66897
|
my $self = $BASE_LEN == 1 ? [ 0, 1 ] : [ 10 ]; |
319
|
29997
|
|
|
|
|
80010
|
bless $self, $class; |
320
|
|
|
|
|
|
|
} |
321
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
sub _1ex { |
323
|
|
|
|
|
|
|
# create a 1Ex |
324
|
5
|
|
|
5
|
|
15
|
my $class = shift; |
325
|
|
|
|
|
|
|
|
326
|
5
|
|
|
|
|
8
|
my $rem = $_[0] % $BASE_LEN; # remainder |
327
|
5
|
|
|
|
|
13
|
my $div = ($_[0] - $rem) / $BASE_LEN; # parts |
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
# With a $BASE_LEN of 6, 1e14 becomes |
330
|
|
|
|
|
|
|
# [ 000000, 000000, 100 ] -> [ 0, 0, 100 ] |
331
|
5
|
|
|
|
|
36
|
bless [ (0) x $div, 0 + ("1" . ("0" x $rem)) ], $class; |
332
|
|
|
|
|
|
|
} |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
sub _copy { |
335
|
|
|
|
|
|
|
# make a true copy |
336
|
104520
|
|
|
104520
|
|
161461
|
my $class = shift; |
337
|
104520
|
|
|
|
|
137769
|
return bless [ @{ $_[0] } ], $class; |
|
104520
|
|
|
|
|
309631
|
|
338
|
|
|
|
|
|
|
} |
339
|
|
|
|
|
|
|
|
340
|
|
|
|
|
|
|
sub import { |
341
|
11
|
|
|
11
|
|
285
|
my $self = shift; |
342
|
|
|
|
|
|
|
|
343
|
11
|
|
|
|
|
31
|
my $opts; |
344
|
11
|
|
|
|
|
30
|
my ($base_len, $use_int); |
345
|
11
|
|
|
|
|
65
|
while (@_) { |
346
|
2
|
|
|
|
|
4
|
my $param = shift; |
347
|
2
|
50
|
33
|
|
|
10
|
croak "Parameter name must be a non-empty string" |
348
|
|
|
|
|
|
|
unless defined $param && length $param; |
349
|
2
|
50
|
|
|
|
4
|
croak "Missing value for parameter '$param'" |
350
|
|
|
|
|
|
|
unless @_; |
351
|
2
|
|
|
|
|
4
|
my $value = shift; |
352
|
|
|
|
|
|
|
|
353
|
2
|
50
|
66
|
|
|
8
|
if ($param eq 'base_len' || $param eq 'use_int') { |
354
|
2
|
|
|
|
|
4
|
$opts -> {$param} = $value; |
355
|
2
|
|
|
|
|
5
|
next; |
356
|
|
|
|
|
|
|
} |
357
|
|
|
|
|
|
|
|
358
|
0
|
|
|
|
|
0
|
croak "Unknown parameter '$param'"; |
359
|
|
|
|
|
|
|
} |
360
|
|
|
|
|
|
|
|
361
|
11
|
100
|
|
|
|
44
|
$base_len = exists $opts -> {base_len} ? $opts -> {base_len} : $BASE_LEN; |
362
|
11
|
100
|
|
|
|
49
|
$use_int = exists $opts -> {use_int} ? $opts -> {use_int} : $USE_INT; |
363
|
11
|
|
|
|
|
42
|
__PACKAGE__ -> _base_len($base_len, $use_int); |
364
|
|
|
|
|
|
|
|
365
|
11
|
|
|
|
|
9355
|
return $self; |
366
|
|
|
|
|
|
|
} |
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
############################################################################## |
369
|
|
|
|
|
|
|
# convert back to string and number |
370
|
|
|
|
|
|
|
|
371
|
|
|
|
|
|
|
sub _str { |
372
|
|
|
|
|
|
|
# Convert number from internal base 1eN format to string format. Internal |
373
|
|
|
|
|
|
|
# format is always normalized, i.e., no leading zeros. |
374
|
|
|
|
|
|
|
|
375
|
61653
|
|
|
61653
|
|
101406
|
my $ary = $_[1]; |
376
|
61653
|
|
|
|
|
101246
|
my $idx = $#$ary; # index of last element |
377
|
|
|
|
|
|
|
|
378
|
61653
|
50
|
|
|
|
124642
|
if ($idx < 0) { # should not happen |
379
|
0
|
|
|
|
|
0
|
croak("$_[1] has no elements"); |
380
|
|
|
|
|
|
|
} |
381
|
|
|
|
|
|
|
|
382
|
|
|
|
|
|
|
# Handle first one differently, since it should not have any leading zeros. |
383
|
61653
|
|
|
|
|
107051
|
my $ret = int($ary->[$idx]); |
384
|
61653
|
100
|
|
|
|
125411
|
if ($idx > 0) { |
385
|
|
|
|
|
|
|
# Interestingly, the pre-padd method uses more time. |
386
|
|
|
|
|
|
|
# The old grep variant takes longer (14 vs. 10 sec). |
387
|
27502
|
|
|
|
|
60452
|
my $z = '0' x ($BASE_LEN - 1); |
388
|
27502
|
|
|
|
|
58110
|
while (--$idx >= 0) { |
389
|
269390
|
|
|
|
|
593885
|
$ret .= substr($z . $ary->[$idx], -$BASE_LEN); |
390
|
|
|
|
|
|
|
} |
391
|
|
|
|
|
|
|
} |
392
|
61653
|
|
|
|
|
146921
|
$ret; |
393
|
|
|
|
|
|
|
} |
394
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
sub _num { |
396
|
|
|
|
|
|
|
# Make a Perl scalar number (int/float) from a BigInt object. |
397
|
74823
|
|
|
74823
|
|
117129
|
my $x = $_[1]; |
398
|
|
|
|
|
|
|
|
399
|
74823
|
100
|
|
|
|
212888
|
return $x->[0] if @$x == 1; # below $BASE |
400
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
# Start with the most significant element and work towards the least |
402
|
|
|
|
|
|
|
# significant element. Avoid multiplying "inf" (which happens if the number |
403
|
|
|
|
|
|
|
# overflows) with "0" (if there are zero elements in $x) since this gives |
404
|
|
|
|
|
|
|
# "nan" which propagates to the output. |
405
|
|
|
|
|
|
|
|
406
|
16
|
|
|
|
|
32
|
my $num = 0; |
407
|
16
|
|
|
|
|
59
|
for (my $i = $#$x ; $i >= 0 ; --$i) { |
408
|
41
|
|
|
|
|
62
|
$num *= $BASE; |
409
|
41
|
|
|
|
|
97
|
$num += $x -> [$i]; |
410
|
|
|
|
|
|
|
} |
411
|
16
|
|
|
|
|
43
|
return $num; |
412
|
|
|
|
|
|
|
} |
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
############################################################################## |
415
|
|
|
|
|
|
|
# actual math code |
416
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
sub _add { |
418
|
|
|
|
|
|
|
# (ref to int_num_array, ref to int_num_array) |
419
|
|
|
|
|
|
|
# |
420
|
|
|
|
|
|
|
# Routine to add two base 1eX numbers stolen from Knuth Vol 2 Algorithm A |
421
|
|
|
|
|
|
|
# pg 231. There are separate routines to add and sub as per Knuth pg 233. |
422
|
|
|
|
|
|
|
# This routine modifies array x, but not y. |
423
|
|
|
|
|
|
|
|
424
|
55282
|
|
|
55282
|
|
101275
|
my ($c, $x, $y) = @_; |
425
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
# $x + 0 => $x |
427
|
|
|
|
|
|
|
|
428
|
55282
|
100
|
100
|
|
|
191989
|
return $x if @$y == 1 && $y->[0] == 0; |
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
# 0 + $y => $y->copy |
431
|
|
|
|
|
|
|
|
432
|
48411
|
100
|
100
|
|
|
140557
|
if (@$x == 1 && $x->[0] == 0) { |
433
|
7339
|
|
|
|
|
17179
|
@$x = @$y; |
434
|
7339
|
|
|
|
|
17089
|
return $x; |
435
|
|
|
|
|
|
|
} |
436
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
# For each in Y, add Y to X and carry. If after that, something is left in |
438
|
|
|
|
|
|
|
# X, foreach in X add carry to X and then return X, carry. Trades one |
439
|
|
|
|
|
|
|
# "$j++" for having to shift arrays. |
440
|
|
|
|
|
|
|
|
441
|
41072
|
|
|
|
|
57676
|
my $car = 0; |
442
|
41072
|
|
|
|
|
55148
|
my $j = 0; |
443
|
41072
|
|
|
|
|
71356
|
for my $i (@$y) { |
444
|
78962
|
100
|
|
|
|
179515
|
$x->[$j] -= $BASE if $car = (($x->[$j] += $i + $car) >= $BASE) ? 1 : 0; |
|
|
100
|
|
|
|
|
|
445
|
78962
|
|
|
|
|
115545
|
$j++; |
446
|
|
|
|
|
|
|
} |
447
|
41072
|
|
|
|
|
80563
|
while ($car != 0) { |
448
|
345
|
100
|
|
|
|
1853
|
$x->[$j] -= $BASE if $car = (($x->[$j] += $car) >= $BASE) ? 1 : 0; |
|
|
100
|
|
|
|
|
|
449
|
345
|
|
|
|
|
669
|
$j++; |
450
|
|
|
|
|
|
|
} |
451
|
41072
|
|
|
|
|
93323
|
$x; |
452
|
|
|
|
|
|
|
} |
453
|
|
|
|
|
|
|
|
454
|
|
|
|
|
|
|
sub _inc { |
455
|
|
|
|
|
|
|
# (ref to int_num_array, ref to int_num_array) |
456
|
|
|
|
|
|
|
# Add 1 to $x, modify $x in place |
457
|
4592
|
|
|
4592
|
|
8978
|
my ($c, $x) = @_; |
458
|
|
|
|
|
|
|
|
459
|
4592
|
|
|
|
|
8685
|
for my $i (@$x) { |
460
|
4605
|
100
|
|
|
|
15086
|
return $x if ($i += 1) < $BASE; # early out |
461
|
18
|
|
|
|
|
34
|
$i = 0; # overflow, next |
462
|
|
|
|
|
|
|
} |
463
|
5
|
50
|
|
|
|
36
|
push @$x, 1 if $x->[-1] == 0; # last overflowed, so extend |
464
|
5
|
|
|
|
|
14
|
$x; |
465
|
|
|
|
|
|
|
} |
466
|
|
|
|
|
|
|
|
467
|
|
|
|
|
|
|
sub _dec { |
468
|
|
|
|
|
|
|
# (ref to int_num_array, ref to int_num_array) |
469
|
|
|
|
|
|
|
# Sub 1 from $x, modify $x in place |
470
|
831
|
|
|
831
|
|
1864
|
my ($c, $x) = @_; |
471
|
|
|
|
|
|
|
|
472
|
831
|
|
|
|
|
1339
|
my $MAX = $BASE - 1; # since MAX_VAL based on BASE |
473
|
831
|
|
|
|
|
1596
|
for my $i (@$x) { |
474
|
847
|
100
|
|
|
|
2117
|
last if ($i -= 1) >= 0; # early out |
475
|
16
|
|
|
|
|
27
|
$i = $MAX; # underflow, next |
476
|
|
|
|
|
|
|
} |
477
|
831
|
100
|
100
|
|
|
2401
|
pop @$x if $x->[-1] == 0 && @$x > 1; # last underflowed (but leave 0) |
478
|
831
|
|
|
|
|
1581
|
$x; |
479
|
|
|
|
|
|
|
} |
480
|
|
|
|
|
|
|
|
481
|
|
|
|
|
|
|
sub _sub { |
482
|
|
|
|
|
|
|
# (ref to int_num_array, ref to int_num_array, swap) |
483
|
|
|
|
|
|
|
# |
484
|
|
|
|
|
|
|
# Subtract base 1eX numbers -- stolen from Knuth Vol 2 pg 232, $x > $y |
485
|
|
|
|
|
|
|
# subtract Y from X by modifying x in place |
486
|
55071
|
|
|
55071
|
|
109547
|
my ($c, $sx, $sy, $s) = @_; |
487
|
|
|
|
|
|
|
|
488
|
55071
|
|
|
|
|
80136
|
my $car = 0; |
489
|
55071
|
|
|
|
|
73299
|
my $j = 0; |
490
|
55071
|
100
|
|
|
|
102792
|
if (!$s) { |
491
|
48976
|
|
|
|
|
90953
|
for my $i (@$sx) { |
492
|
69195
|
100
|
100
|
|
|
148641
|
last unless defined $sy->[$j] || $car; |
493
|
67632
|
100
|
100
|
|
|
191096
|
$i += $BASE if $car = (($i -= ($sy->[$j] || 0) + $car) < 0); |
494
|
67632
|
|
|
|
|
106218
|
$j++; |
495
|
|
|
|
|
|
|
} |
496
|
|
|
|
|
|
|
# might leave leading zeros, so fix that |
497
|
48976
|
|
|
|
|
96798
|
return __strip_zeros($sx); |
498
|
|
|
|
|
|
|
} |
499
|
6095
|
|
|
|
|
11815
|
for my $i (@$sx) { |
500
|
|
|
|
|
|
|
# We can't do an early out if $x < $y, since we need to copy the high |
501
|
|
|
|
|
|
|
# chunks from $y. Found by Bob Mathews. |
502
|
|
|
|
|
|
|
#last unless defined $sy->[$j] || $car; |
503
|
6173
|
100
|
100
|
|
|
24208
|
$sy->[$j] += $BASE |
504
|
|
|
|
|
|
|
if $car = ($sy->[$j] = $i - ($sy->[$j] || 0) - $car) < 0; |
505
|
6173
|
|
|
|
|
10741
|
$j++; |
506
|
|
|
|
|
|
|
} |
507
|
|
|
|
|
|
|
# might leave leading zeros, so fix that |
508
|
6095
|
|
|
|
|
11422
|
__strip_zeros($sy); |
509
|
|
|
|
|
|
|
} |
510
|
|
|
|
|
|
|
|
511
|
|
|
|
|
|
|
sub _mul_use_int { |
512
|
|
|
|
|
|
|
# (ref to int_num_array, ref to int_num_array) |
513
|
|
|
|
|
|
|
# multiply two numbers in internal representation |
514
|
|
|
|
|
|
|
# modifies first arg, second need not be different from first |
515
|
|
|
|
|
|
|
# works for 64 bit integer with "use integer" |
516
|
54307
|
|
|
54307
|
|
103725
|
my ($c, $xv, $yv) = @_; |
517
|
51
|
|
|
51
|
|
31560
|
use integer; |
|
51
|
|
|
|
|
887
|
|
|
51
|
|
|
|
|
335
|
|
518
|
|
|
|
|
|
|
|
519
|
54307
|
100
|
|
|
|
118569
|
if (@$yv == 1) { |
520
|
|
|
|
|
|
|
# shortcut for two very short numbers (improved by Nathan Zook) works |
521
|
|
|
|
|
|
|
# also if xv and yv are the same reference, and handles also $x == 0 |
522
|
42431
|
100
|
|
|
|
78101
|
if (@$xv == 1) { |
523
|
32102
|
100
|
|
|
|
73227
|
if (($xv->[0] *= $yv->[0]) >= $BASE) { |
524
|
1417
|
|
|
|
|
5027
|
$xv->[0] = |
525
|
|
|
|
|
|
|
$xv->[0] - ($xv->[1] = $xv->[0] / $BASE) * $BASE; |
526
|
|
|
|
|
|
|
} |
527
|
32102
|
|
|
|
|
68953
|
return $xv; |
528
|
|
|
|
|
|
|
} |
529
|
|
|
|
|
|
|
# $x * 0 => 0 |
530
|
10329
|
100
|
|
|
|
23058
|
if ($yv->[0] == 0) { |
531
|
15
|
|
|
|
|
70
|
@$xv = (0); |
532
|
15
|
|
|
|
|
74
|
return $xv; |
533
|
|
|
|
|
|
|
} |
534
|
|
|
|
|
|
|
|
535
|
|
|
|
|
|
|
# multiply a large number a by a single element one, so speed up |
536
|
10314
|
|
|
|
|
17513
|
my $y = $yv->[0]; |
537
|
10314
|
|
|
|
|
15219
|
my $car = 0; |
538
|
10314
|
|
|
|
|
19033
|
foreach my $i (@$xv) { |
539
|
|
|
|
|
|
|
#$i = $i * $y + $car; $car = $i / $BASE; $i -= $car * $BASE; |
540
|
57807
|
|
|
|
|
75627
|
$i = $i * $y + $car; |
541
|
57807
|
|
|
|
|
85902
|
$i -= ($car = $i / $BASE) * $BASE; |
542
|
|
|
|
|
|
|
} |
543
|
10314
|
100
|
|
|
|
21107
|
push @$xv, $car if $car != 0; |
544
|
10314
|
|
|
|
|
26674
|
return $xv; |
545
|
|
|
|
|
|
|
} |
546
|
|
|
|
|
|
|
|
547
|
|
|
|
|
|
|
# shortcut for result $x == 0 => result = 0 |
548
|
11876
|
100
|
100
|
|
|
30068
|
return $xv if @$xv == 1 && $xv->[0] == 0; |
549
|
|
|
|
|
|
|
|
550
|
|
|
|
|
|
|
# since multiplying $x with $x fails, make copy in this case |
551
|
11605
|
100
|
|
|
|
33730
|
$yv = $c->_copy($xv) if $xv == $yv; # same references? |
552
|
|
|
|
|
|
|
|
553
|
11605
|
|
|
|
|
21537
|
my @prod = (); |
554
|
11605
|
|
|
|
|
18083
|
my ($prod, $car, $cty); |
555
|
11605
|
|
|
|
|
20682
|
for my $xi (@$xv) { |
556
|
89839
|
|
|
|
|
113753
|
$car = 0; |
557
|
89839
|
|
|
|
|
108235
|
$cty = 0; |
558
|
|
|
|
|
|
|
# looping through this if $xi == 0 is silly - so optimize it away! |
559
|
89839
|
100
|
100
|
|
|
148472
|
$xi = (shift(@prod) || 0), next if $xi == 0; |
560
|
88142
|
|
|
|
|
124968
|
for my $yi (@$yv) { |
561
|
1219407
|
|
100
|
|
|
2013645
|
$prod = $xi * $yi + ($prod[$cty] || 0) + $car; |
562
|
1219407
|
|
|
|
|
1757435
|
$prod[$cty++] = $prod - ($car = $prod / $BASE) * $BASE; |
563
|
|
|
|
|
|
|
} |
564
|
88142
|
100
|
|
|
|
152478
|
$prod[$cty] += $car if $car; # need really to check for 0? |
565
|
88142
|
|
100
|
|
|
164222
|
$xi = shift(@prod) || 0; # || 0 makes v5.005_3 happy |
566
|
|
|
|
|
|
|
} |
567
|
11605
|
|
|
|
|
26492
|
push @$xv, @prod; |
568
|
11605
|
|
|
|
|
31535
|
$xv; |
569
|
|
|
|
|
|
|
} |
570
|
|
|
|
|
|
|
|
571
|
|
|
|
|
|
|
sub _mul_no_int { |
572
|
|
|
|
|
|
|
# (ref to int_num_array, ref to int_num_array) |
573
|
|
|
|
|
|
|
# multiply two numbers in internal representation |
574
|
|
|
|
|
|
|
# modifies first arg, second need not be different from first |
575
|
0
|
|
|
0
|
|
0
|
my ($c, $xv, $yv) = @_; |
576
|
|
|
|
|
|
|
|
577
|
0
|
0
|
|
|
|
0
|
if (@$yv == 1) { |
578
|
|
|
|
|
|
|
# shortcut for two very short numbers (improved by Nathan Zook) works |
579
|
|
|
|
|
|
|
# also if xv and yv are the same reference, and handles also $x == 0 |
580
|
0
|
0
|
|
|
|
0
|
if (@$xv == 1) { |
581
|
0
|
0
|
|
|
|
0
|
if (($xv->[0] *= $yv->[0]) >= $BASE) { |
582
|
0
|
|
|
|
|
0
|
my $rem = $xv->[0] % $BASE; |
583
|
0
|
|
|
|
|
0
|
$xv->[1] = ($xv->[0] - $rem) / $BASE; |
584
|
0
|
|
|
|
|
0
|
$xv->[0] = $rem; |
585
|
|
|
|
|
|
|
} |
586
|
0
|
|
|
|
|
0
|
return $xv; |
587
|
|
|
|
|
|
|
} |
588
|
|
|
|
|
|
|
# $x * 0 => 0 |
589
|
0
|
0
|
|
|
|
0
|
if ($yv->[0] == 0) { |
590
|
0
|
|
|
|
|
0
|
@$xv = (0); |
591
|
0
|
|
|
|
|
0
|
return $xv; |
592
|
|
|
|
|
|
|
} |
593
|
|
|
|
|
|
|
|
594
|
|
|
|
|
|
|
# multiply a large number a by a single element one, so speed up |
595
|
0
|
|
|
|
|
0
|
my $y = $yv->[0]; |
596
|
0
|
|
|
|
|
0
|
my $car = 0; |
597
|
0
|
|
|
|
|
0
|
my $rem; |
598
|
0
|
|
|
|
|
0
|
foreach my $i (@$xv) { |
599
|
0
|
|
|
|
|
0
|
$i = $i * $y + $car; |
600
|
0
|
|
|
|
|
0
|
$rem = $i % $BASE; |
601
|
0
|
|
|
|
|
0
|
$car = ($i - $rem) / $BASE; |
602
|
0
|
|
|
|
|
0
|
$i = $rem; |
603
|
|
|
|
|
|
|
} |
604
|
0
|
0
|
|
|
|
0
|
push @$xv, $car if $car != 0; |
605
|
0
|
|
|
|
|
0
|
return $xv; |
606
|
|
|
|
|
|
|
} |
607
|
|
|
|
|
|
|
|
608
|
|
|
|
|
|
|
# shortcut for result $x == 0 => result = 0 |
609
|
0
|
0
|
0
|
|
|
0
|
return $xv if @$xv == 1 && $xv->[0] == 0; |
610
|
|
|
|
|
|
|
|
611
|
|
|
|
|
|
|
# since multiplying $x with $x fails, make copy in this case |
612
|
0
|
0
|
|
|
|
0
|
$yv = $c->_copy($xv) if $xv == $yv; # same references? |
613
|
|
|
|
|
|
|
|
614
|
0
|
|
|
|
|
0
|
my @prod = (); |
615
|
0
|
|
|
|
|
0
|
my ($prod, $rem, $car, $cty); |
616
|
0
|
|
|
|
|
0
|
for my $xi (@$xv) { |
617
|
0
|
|
|
|
|
0
|
$car = 0; |
618
|
0
|
|
|
|
|
0
|
$cty = 0; |
619
|
|
|
|
|
|
|
# looping through this if $xi == 0 is silly - so optimize it away! |
620
|
0
|
0
|
0
|
|
|
0
|
$xi = (shift(@prod) || 0), next if $xi == 0; |
621
|
0
|
|
|
|
|
0
|
for my $yi (@$yv) { |
622
|
0
|
|
0
|
|
|
0
|
$prod = $xi * $yi + ($prod[$cty] || 0) + $car; |
623
|
0
|
|
|
|
|
0
|
$rem = $prod % $BASE; |
624
|
0
|
|
|
|
|
0
|
$car = ($prod - $rem) / $BASE; |
625
|
0
|
|
|
|
|
0
|
$prod[$cty++] = $rem; |
626
|
|
|
|
|
|
|
} |
627
|
0
|
0
|
|
|
|
0
|
$prod[$cty] += $car if $car; # need really to check for 0? |
628
|
0
|
|
0
|
|
|
0
|
$xi = shift(@prod) || 0; # || 0 makes v5.005_3 happy |
629
|
|
|
|
|
|
|
} |
630
|
0
|
|
|
|
|
0
|
push @$xv, @prod; |
631
|
0
|
|
|
|
|
0
|
$xv; |
632
|
|
|
|
|
|
|
} |
633
|
|
|
|
|
|
|
|
634
|
|
|
|
|
|
|
sub _div_use_int { |
635
|
|
|
|
|
|
|
# ref to array, ref to array, modify first array and return remainder if |
636
|
|
|
|
|
|
|
# in list context |
637
|
|
|
|
|
|
|
|
638
|
|
|
|
|
|
|
# This version works on integers |
639
|
51
|
|
|
51
|
|
32213
|
use integer; |
|
51
|
|
|
|
|
160
|
|
|
51
|
|
|
|
|
268
|
|
640
|
|
|
|
|
|
|
|
641
|
15346
|
|
|
15346
|
|
31686
|
my ($c, $x, $yorg) = @_; |
642
|
|
|
|
|
|
|
|
643
|
|
|
|
|
|
|
# the general div algorithm here is about O(N*N) and thus quite slow, so |
644
|
|
|
|
|
|
|
# we first check for some special cases and use shortcuts to handle them. |
645
|
|
|
|
|
|
|
|
646
|
|
|
|
|
|
|
# if both numbers have only one element: |
647
|
15346
|
100
|
100
|
|
|
41727
|
if (@$x == 1 && @$yorg == 1) { |
648
|
|
|
|
|
|
|
# shortcut, $yorg and $x are two small numbers |
649
|
2917
|
100
|
|
|
|
5766
|
if (wantarray) { |
650
|
2612
|
|
|
|
|
7194
|
my $rem = [ $x->[0] % $yorg->[0] ]; |
651
|
2612
|
|
|
|
|
4454
|
bless $rem, $c; |
652
|
2612
|
|
|
|
|
4737
|
$x->[0] = $x->[0] / $yorg->[0]; |
653
|
2612
|
|
|
|
|
7418
|
return ($x, $rem); |
654
|
|
|
|
|
|
|
} else { |
655
|
305
|
|
|
|
|
714
|
$x->[0] = $x->[0] / $yorg->[0]; |
656
|
305
|
|
|
|
|
700
|
return $x; |
657
|
|
|
|
|
|
|
} |
658
|
|
|
|
|
|
|
} |
659
|
|
|
|
|
|
|
|
660
|
|
|
|
|
|
|
# if x has more than one, but y has only one element: |
661
|
12429
|
100
|
|
|
|
25467
|
if (@$yorg == 1) { |
662
|
3439
|
|
|
|
|
5213
|
my $rem; |
663
|
3439
|
100
|
|
|
|
7171
|
$rem = $c->_mod($c->_copy($x), $yorg) if wantarray; |
664
|
|
|
|
|
|
|
|
665
|
|
|
|
|
|
|
# shortcut, $y is < $BASE |
666
|
3439
|
|
|
|
|
5196
|
my $j = @$x; |
667
|
3439
|
|
|
|
|
4699
|
my $r = 0; |
668
|
3439
|
|
|
|
|
5795
|
my $y = $yorg->[0]; |
669
|
3439
|
|
|
|
|
4629
|
my $b; |
670
|
3439
|
|
|
|
|
7380
|
while ($j-- > 0) { |
671
|
108954
|
|
|
|
|
137176
|
$b = $r * $BASE + $x->[$j]; |
672
|
108954
|
|
|
|
|
133796
|
$r = $b % $y; |
673
|
108954
|
|
|
|
|
181258
|
$x->[$j] = $b / $y; |
674
|
|
|
|
|
|
|
} |
675
|
3439
|
100
|
66
|
|
|
14221
|
pop(@$x) if @$x > 1 && $x->[-1] == 0; # remove any trailing zero |
676
|
3439
|
100
|
|
|
|
7122
|
return ($x, $rem) if wantarray; |
677
|
3096
|
|
|
|
|
8431
|
return $x; |
678
|
|
|
|
|
|
|
} |
679
|
|
|
|
|
|
|
|
680
|
|
|
|
|
|
|
# now x and y have more than one element |
681
|
|
|
|
|
|
|
|
682
|
|
|
|
|
|
|
# check whether y has more elements than x, if so, the result is 0 |
683
|
8990
|
100
|
|
|
|
19863
|
if (@$yorg > @$x) { |
684
|
248
|
|
|
|
|
342
|
my $rem; |
685
|
248
|
100
|
|
|
|
670
|
$rem = $c->_copy($x) if wantarray; # make copy |
686
|
248
|
|
|
|
|
507
|
@$x = 0; # set to 0 |
687
|
248
|
100
|
|
|
|
1051
|
return ($x, $rem) if wantarray; # including remainder? |
688
|
7
|
|
|
|
|
19
|
return $x; # only x, which is [0] now |
689
|
|
|
|
|
|
|
} |
690
|
|
|
|
|
|
|
|
691
|
|
|
|
|
|
|
# check whether the numbers have the same number of elements, in that case |
692
|
|
|
|
|
|
|
# the result will fit into one element and can be computed efficiently |
693
|
8742
|
100
|
|
|
|
17421
|
if (@$yorg == @$x) { |
694
|
784
|
|
|
|
|
1465
|
my $cmp = 0; |
695
|
784
|
|
|
|
|
2197
|
for (my $j = $#$x ; $j >= 0 ; --$j) { |
696
|
913
|
100
|
|
|
|
2377
|
last if $cmp = $x->[$j] - $yorg->[$j]; |
697
|
|
|
|
|
|
|
} |
698
|
|
|
|
|
|
|
|
699
|
784
|
100
|
|
|
|
1667
|
if ($cmp == 0) { # x = y |
700
|
21
|
|
|
|
|
80
|
@$x = 1; |
701
|
21
|
100
|
|
|
|
111
|
return $x, $c->_zero() if wantarray; |
702
|
8
|
|
|
|
|
41
|
return $x; |
703
|
|
|
|
|
|
|
} |
704
|
|
|
|
|
|
|
|
705
|
763
|
100
|
|
|
|
1730
|
if ($cmp < 0) { # x < y |
706
|
445
|
100
|
|
|
|
996
|
if (wantarray) { |
707
|
21
|
|
|
|
|
53
|
my $rem = $c->_copy($x); |
708
|
21
|
|
|
|
|
58
|
@$x = 0; |
709
|
21
|
|
|
|
|
78
|
return $x, $rem; |
710
|
|
|
|
|
|
|
} |
711
|
424
|
|
|
|
|
882
|
@$x = 0; |
712
|
424
|
|
|
|
|
821
|
return $x; |
713
|
|
|
|
|
|
|
} |
714
|
|
|
|
|
|
|
} |
715
|
|
|
|
|
|
|
|
716
|
|
|
|
|
|
|
# all other cases: |
717
|
|
|
|
|
|
|
|
718
|
8276
|
|
|
|
|
18207
|
my $y = $c->_copy($yorg); # always make copy to preserve |
719
|
|
|
|
|
|
|
|
720
|
8276
|
|
|
|
|
12431
|
my $tmp; |
721
|
8276
|
|
|
|
|
15530
|
my $dd = $BASE / ($y->[-1] + 1); |
722
|
8276
|
100
|
|
|
|
15690
|
if ($dd != 1) { |
723
|
8087
|
|
|
|
|
11236
|
my $car = 0; |
724
|
8087
|
|
|
|
|
15069
|
for my $xi (@$x) { |
725
|
96727
|
|
|
|
|
121430
|
$xi = $xi * $dd + $car; |
726
|
96727
|
|
|
|
|
134442
|
$xi -= ($car = $xi / $BASE) * $BASE; |
727
|
|
|
|
|
|
|
} |
728
|
8087
|
|
|
|
|
15065
|
push(@$x, $car); |
729
|
8087
|
|
|
|
|
11304
|
$car = 0; |
730
|
8087
|
|
|
|
|
13281
|
for my $yi (@$y) { |
731
|
44777
|
|
|
|
|
56906
|
$yi = $yi * $dd + $car; |
732
|
44777
|
|
|
|
|
64044
|
$yi -= ($car = $yi / $BASE) * $BASE; |
733
|
|
|
|
|
|
|
} |
734
|
|
|
|
|
|
|
} else { |
735
|
189
|
|
|
|
|
825
|
push(@$x, 0); |
736
|
|
|
|
|
|
|
} |
737
|
|
|
|
|
|
|
|
738
|
|
|
|
|
|
|
# @q will accumulate the final result, $q contains the current computed |
739
|
|
|
|
|
|
|
# part of the final result |
740
|
|
|
|
|
|
|
|
741
|
8276
|
|
|
|
|
13494
|
my @q = (); |
742
|
8276
|
|
|
|
|
18140
|
my ($v2, $v1) = @$y[-2, -1]; |
743
|
8276
|
100
|
|
|
|
16474
|
$v2 = 0 unless $v2; |
744
|
8276
|
|
|
|
|
18990
|
while ($#$x > $#$y) { |
745
|
61707
|
|
|
|
|
112699
|
my ($u2, $u1, $u0) = @$x[-3 .. -1]; |
746
|
61707
|
100
|
|
|
|
106158
|
$u2 = 0 unless $u2; |
747
|
|
|
|
|
|
|
#warn "oups v1 is 0, u0: $u0 $y->[-2] $y->[-1] l ",scalar @$y,"\n" |
748
|
|
|
|
|
|
|
# if $v1 == 0; |
749
|
61707
|
|
|
|
|
85879
|
my $tmp = $u0 * $BASE + $u1; |
750
|
61707
|
|
|
|
|
80948
|
my $rem = $tmp % $v1; |
751
|
61707
|
100
|
|
|
|
105538
|
my $q = $u0 == $v1 ? $MAX_VAL : (($tmp - $rem) / $v1); |
752
|
61707
|
|
|
|
|
132094
|
--$q while $v2 * $q > ($u0 * $BASE + $u1 - $q * $v1) * $BASE + $u2; |
753
|
61707
|
100
|
|
|
|
101186
|
if ($q) { |
754
|
57039
|
|
|
|
|
68401
|
my $prd; |
755
|
57039
|
|
|
|
|
82698
|
my ($car, $bar) = (0, 0); |
756
|
57039
|
|
|
|
|
125561
|
for (my $yi = 0, my $xi = $#$x - $#$y - 1; $yi <= $#$y; ++$yi, ++$xi) { |
757
|
485734
|
|
|
|
|
637989
|
$prd = $q * $y->[$yi] + $car; |
758
|
485734
|
|
|
|
|
619795
|
$prd -= ($car = int($prd / $BASE)) * $BASE; |
759
|
485734
|
100
|
|
|
|
1147714
|
$x->[$xi] += $BASE if $bar = (($x->[$xi] -= $prd + $bar) < 0); |
760
|
|
|
|
|
|
|
} |
761
|
57039
|
100
|
|
|
|
114327
|
if ($x->[-1] < $car + $bar) { |
762
|
17
|
|
|
|
|
53
|
$car = 0; |
763
|
17
|
|
|
|
|
36
|
--$q; |
764
|
17
|
|
|
|
|
101
|
for (my $yi = 0, my $xi = $#$x - $#$y - 1; $yi <= $#$y; ++$yi, ++$xi) { |
765
|
103
|
100
|
|
|
|
291
|
$x->[$xi] -= $BASE |
766
|
|
|
|
|
|
|
if $car = (($x->[$xi] += $y->[$yi] + $car) >= $BASE); |
767
|
|
|
|
|
|
|
} |
768
|
|
|
|
|
|
|
} |
769
|
|
|
|
|
|
|
} |
770
|
61707
|
|
|
|
|
81795
|
pop(@$x); |
771
|
61707
|
|
|
|
|
140263
|
unshift(@q, $q); |
772
|
|
|
|
|
|
|
} |
773
|
|
|
|
|
|
|
|
774
|
8276
|
100
|
|
|
|
16695
|
if (wantarray) { |
775
|
1254
|
|
|
|
|
2241
|
my $d = bless [], $c; |
776
|
1254
|
100
|
|
|
|
2208
|
if ($dd != 1) { |
777
|
1246
|
|
|
|
|
1638
|
my $car = 0; |
778
|
1246
|
|
|
|
|
1571
|
my $prd; |
779
|
1246
|
|
|
|
|
2091
|
for my $xi (reverse @$x) { |
780
|
4792
|
|
|
|
|
6053
|
$prd = $car * $BASE + $xi; |
781
|
4792
|
|
|
|
|
6116
|
$car = $prd - ($tmp = $prd / $dd) * $dd; |
782
|
4792
|
|
|
|
|
7624
|
unshift @$d, $tmp; |
783
|
|
|
|
|
|
|
} |
784
|
|
|
|
|
|
|
} else { |
785
|
8
|
|
|
|
|
25
|
@$d = @$x; |
786
|
|
|
|
|
|
|
} |
787
|
1254
|
|
|
|
|
2812
|
@$x = @q; |
788
|
1254
|
|
|
|
|
2975
|
__strip_zeros($x); |
789
|
1254
|
|
|
|
|
2466
|
__strip_zeros($d); |
790
|
1254
|
|
|
|
|
4392
|
return ($x, $d); |
791
|
|
|
|
|
|
|
} |
792
|
7022
|
|
|
|
|
20645
|
@$x = @q; |
793
|
7022
|
|
|
|
|
18189
|
__strip_zeros($x); |
794
|
7022
|
|
|
|
|
25462
|
$x; |
795
|
|
|
|
|
|
|
} |
796
|
|
|
|
|
|
|
|
797
|
|
|
|
|
|
|
sub _div_no_int { |
798
|
|
|
|
|
|
|
# ref to array, ref to array, modify first array and return remainder if |
799
|
|
|
|
|
|
|
# in list context |
800
|
|
|
|
|
|
|
|
801
|
0
|
|
|
0
|
|
0
|
my ($c, $x, $yorg) = @_; |
802
|
|
|
|
|
|
|
|
803
|
|
|
|
|
|
|
# the general div algorithm here is about O(N*N) and thus quite slow, so |
804
|
|
|
|
|
|
|
# we first check for some special cases and use shortcuts to handle them. |
805
|
|
|
|
|
|
|
|
806
|
|
|
|
|
|
|
# if both numbers have only one element: |
807
|
0
|
0
|
0
|
|
|
0
|
if (@$x == 1 && @$yorg == 1) { |
808
|
|
|
|
|
|
|
# shortcut, $yorg and $x are two small numbers |
809
|
0
|
|
|
|
|
0
|
my $rem = [ $x->[0] % $yorg->[0] ]; |
810
|
0
|
|
|
|
|
0
|
bless $rem, $c; |
811
|
0
|
|
|
|
|
0
|
$x->[0] = ($x->[0] - $rem->[0]) / $yorg->[0]; |
812
|
0
|
0
|
|
|
|
0
|
return ($x, $rem) if wantarray; |
813
|
0
|
|
|
|
|
0
|
return $x; |
814
|
|
|
|
|
|
|
} |
815
|
|
|
|
|
|
|
|
816
|
|
|
|
|
|
|
# if x has more than one, but y has only one element: |
817
|
0
|
0
|
|
|
|
0
|
if (@$yorg == 1) { |
818
|
0
|
|
|
|
|
0
|
my $rem; |
819
|
0
|
0
|
|
|
|
0
|
$rem = $c->_mod($c->_copy($x), $yorg) if wantarray; |
820
|
|
|
|
|
|
|
|
821
|
|
|
|
|
|
|
# shortcut, $y is < $BASE |
822
|
0
|
|
|
|
|
0
|
my $j = @$x; |
823
|
0
|
|
|
|
|
0
|
my $r = 0; |
824
|
0
|
|
|
|
|
0
|
my $y = $yorg->[0]; |
825
|
0
|
|
|
|
|
0
|
my $b; |
826
|
0
|
|
|
|
|
0
|
while ($j-- > 0) { |
827
|
0
|
|
|
|
|
0
|
$b = $r * $BASE + $x->[$j]; |
828
|
0
|
|
|
|
|
0
|
$r = $b % $y; |
829
|
0
|
|
|
|
|
0
|
$x->[$j] = ($b - $r) / $y; |
830
|
|
|
|
|
|
|
} |
831
|
0
|
0
|
0
|
|
|
0
|
pop(@$x) if @$x > 1 && $x->[-1] == 0; # remove any trailing zero |
832
|
0
|
0
|
|
|
|
0
|
return ($x, $rem) if wantarray; |
833
|
0
|
|
|
|
|
0
|
return $x; |
834
|
|
|
|
|
|
|
} |
835
|
|
|
|
|
|
|
|
836
|
|
|
|
|
|
|
# now x and y have more than one element |
837
|
|
|
|
|
|
|
|
838
|
|
|
|
|
|
|
# check whether y has more elements than x, if so, the result is 0 |
839
|
0
|
0
|
|
|
|
0
|
if (@$yorg > @$x) { |
840
|
0
|
|
|
|
|
0
|
my $rem; |
841
|
0
|
0
|
|
|
|
0
|
$rem = $c->_copy($x) if wantarray; # make copy |
842
|
0
|
|
|
|
|
0
|
@$x = 0; # set to 0 |
843
|
0
|
0
|
|
|
|
0
|
return ($x, $rem) if wantarray; # including remainder? |
844
|
0
|
|
|
|
|
0
|
return $x; # only x, which is [0] now |
845
|
|
|
|
|
|
|
} |
846
|
|
|
|
|
|
|
|
847
|
|
|
|
|
|
|
# check whether the numbers have the same number of elements, in that case |
848
|
|
|
|
|
|
|
# the result will fit into one element and can be computed efficiently |
849
|
0
|
0
|
|
|
|
0
|
if (@$yorg == @$x) { |
850
|
0
|
|
|
|
|
0
|
my $cmp = 0; |
851
|
0
|
|
|
|
|
0
|
for (my $j = $#$x ; $j >= 0 ; --$j) { |
852
|
0
|
0
|
|
|
|
0
|
last if $cmp = $x->[$j] - $yorg->[$j]; |
853
|
|
|
|
|
|
|
} |
854
|
|
|
|
|
|
|
|
855
|
0
|
0
|
|
|
|
0
|
if ($cmp == 0) { # x = y |
856
|
0
|
|
|
|
|
0
|
@$x = 1; |
857
|
0
|
0
|
|
|
|
0
|
return $x, $c->_zero() if wantarray; |
858
|
0
|
|
|
|
|
0
|
return $x; |
859
|
|
|
|
|
|
|
} |
860
|
|
|
|
|
|
|
|
861
|
0
|
0
|
|
|
|
0
|
if ($cmp < 0) { # x < y |
862
|
0
|
0
|
|
|
|
0
|
if (wantarray) { |
863
|
0
|
|
|
|
|
0
|
my $rem = $c->_copy($x); |
864
|
0
|
|
|
|
|
0
|
@$x = 0; |
865
|
0
|
|
|
|
|
0
|
return $x, $rem; |
866
|
|
|
|
|
|
|
} |
867
|
0
|
|
|
|
|
0
|
@$x = 0; |
868
|
0
|
|
|
|
|
0
|
return $x; |
869
|
|
|
|
|
|
|
} |
870
|
|
|
|
|
|
|
} |
871
|
|
|
|
|
|
|
|
872
|
|
|
|
|
|
|
# all other cases: |
873
|
|
|
|
|
|
|
|
874
|
0
|
|
|
|
|
0
|
my $y = $c->_copy($yorg); # always make copy to preserve |
875
|
|
|
|
|
|
|
|
876
|
0
|
|
|
|
|
0
|
my $tmp = $y->[-1] + 1; |
877
|
0
|
|
|
|
|
0
|
my $rem = $BASE % $tmp; |
878
|
0
|
|
|
|
|
0
|
my $dd = ($BASE - $rem) / $tmp; |
879
|
0
|
0
|
|
|
|
0
|
if ($dd != 1) { |
880
|
0
|
|
|
|
|
0
|
my $car = 0; |
881
|
0
|
|
|
|
|
0
|
for my $xi (@$x) { |
882
|
0
|
|
|
|
|
0
|
$xi = $xi * $dd + $car; |
883
|
0
|
|
|
|
|
0
|
$rem = $xi % $BASE; |
884
|
0
|
|
|
|
|
0
|
$car = ($xi - $rem) / $BASE; |
885
|
0
|
|
|
|
|
0
|
$xi = $rem; |
886
|
|
|
|
|
|
|
} |
887
|
0
|
|
|
|
|
0
|
push(@$x, $car); |
888
|
0
|
|
|
|
|
0
|
$car = 0; |
889
|
0
|
|
|
|
|
0
|
for my $yi (@$y) { |
890
|
0
|
|
|
|
|
0
|
$yi = $yi * $dd + $car; |
891
|
0
|
|
|
|
|
0
|
$rem = $yi % $BASE; |
892
|
0
|
|
|
|
|
0
|
$car = ($yi - $rem) / $BASE; |
893
|
0
|
|
|
|
|
0
|
$yi = $rem; |
894
|
|
|
|
|
|
|
} |
895
|
|
|
|
|
|
|
} else { |
896
|
0
|
|
|
|
|
0
|
push(@$x, 0); |
897
|
|
|
|
|
|
|
} |
898
|
|
|
|
|
|
|
|
899
|
|
|
|
|
|
|
# @q will accumulate the final result, $q contains the current computed |
900
|
|
|
|
|
|
|
# part of the final result |
901
|
|
|
|
|
|
|
|
902
|
0
|
|
|
|
|
0
|
my @q = (); |
903
|
0
|
|
|
|
|
0
|
my ($v2, $v1) = @$y[-2, -1]; |
904
|
0
|
0
|
|
|
|
0
|
$v2 = 0 unless $v2; |
905
|
0
|
|
|
|
|
0
|
while ($#$x > $#$y) { |
906
|
0
|
|
|
|
|
0
|
my ($u2, $u1, $u0) = @$x[-3 .. -1]; |
907
|
0
|
0
|
|
|
|
0
|
$u2 = 0 unless $u2; |
908
|
|
|
|
|
|
|
#warn "oups v1 is 0, u0: $u0 $y->[-2] $y->[-1] l ",scalar @$y,"\n" |
909
|
|
|
|
|
|
|
# if $v1 == 0; |
910
|
0
|
|
|
|
|
0
|
my $tmp = $u0 * $BASE + $u1; |
911
|
0
|
|
|
|
|
0
|
my $rem = $tmp % $v1; |
912
|
0
|
0
|
|
|
|
0
|
my $q = $u0 == $v1 ? $MAX_VAL : (($tmp - $rem) / $v1); |
913
|
0
|
|
|
|
|
0
|
--$q while $v2 * $q > ($u0 * $BASE + $u1 - $q * $v1) * $BASE + $u2; |
914
|
0
|
0
|
|
|
|
0
|
if ($q) { |
915
|
0
|
|
|
|
|
0
|
my $prd; |
916
|
0
|
|
|
|
|
0
|
my ($car, $bar) = (0, 0); |
917
|
0
|
|
|
|
|
0
|
for (my $yi = 0, my $xi = $#$x - $#$y - 1; $yi <= $#$y; ++$yi, ++$xi) { |
918
|
0
|
|
|
|
|
0
|
$prd = $q * $y->[$yi] + $car; |
919
|
0
|
|
|
|
|
0
|
$rem = $prd % $BASE; |
920
|
0
|
|
|
|
|
0
|
$car = ($prd - $rem) / $BASE; |
921
|
0
|
|
|
|
|
0
|
$prd -= $car * $BASE; |
922
|
0
|
0
|
|
|
|
0
|
$x->[$xi] += $BASE if $bar = (($x->[$xi] -= $prd + $bar) < 0); |
923
|
|
|
|
|
|
|
} |
924
|
0
|
0
|
|
|
|
0
|
if ($x->[-1] < $car + $bar) { |
925
|
0
|
|
|
|
|
0
|
$car = 0; |
926
|
0
|
|
|
|
|
0
|
--$q; |
927
|
0
|
|
|
|
|
0
|
for (my $yi = 0, my $xi = $#$x - $#$y - 1; $yi <= $#$y; ++$yi, ++$xi) { |
928
|
0
|
0
|
|
|
|
0
|
$x->[$xi] -= $BASE |
929
|
|
|
|
|
|
|
if $car = (($x->[$xi] += $y->[$yi] + $car) >= $BASE); |
930
|
|
|
|
|
|
|
} |
931
|
|
|
|
|
|
|
} |
932
|
|
|
|
|
|
|
} |
933
|
0
|
|
|
|
|
0
|
pop(@$x); |
934
|
0
|
|
|
|
|
0
|
unshift(@q, $q); |
935
|
|
|
|
|
|
|
} |
936
|
|
|
|
|
|
|
|
937
|
0
|
0
|
|
|
|
0
|
if (wantarray) { |
938
|
0
|
|
|
|
|
0
|
my $d = bless [], $c; |
939
|
0
|
0
|
|
|
|
0
|
if ($dd != 1) { |
940
|
0
|
|
|
|
|
0
|
my $car = 0; |
941
|
0
|
|
|
|
|
0
|
my ($prd, $rem); |
942
|
0
|
|
|
|
|
0
|
for my $xi (reverse @$x) { |
943
|
0
|
|
|
|
|
0
|
$prd = $car * $BASE + $xi; |
944
|
0
|
|
|
|
|
0
|
$rem = $prd % $dd; |
945
|
0
|
|
|
|
|
0
|
$tmp = ($prd - $rem) / $dd; |
946
|
0
|
|
|
|
|
0
|
$car = $rem; |
947
|
0
|
|
|
|
|
0
|
unshift @$d, $tmp; |
948
|
|
|
|
|
|
|
} |
949
|
|
|
|
|
|
|
} else { |
950
|
0
|
|
|
|
|
0
|
@$d = @$x; |
951
|
|
|
|
|
|
|
} |
952
|
0
|
|
|
|
|
0
|
@$x = @q; |
953
|
0
|
|
|
|
|
0
|
__strip_zeros($x); |
954
|
0
|
|
|
|
|
0
|
__strip_zeros($d); |
955
|
0
|
|
|
|
|
0
|
return ($x, $d); |
956
|
|
|
|
|
|
|
} |
957
|
0
|
|
|
|
|
0
|
@$x = @q; |
958
|
0
|
|
|
|
|
0
|
__strip_zeros($x); |
959
|
0
|
|
|
|
|
0
|
$x; |
960
|
|
|
|
|
|
|
} |
961
|
|
|
|
|
|
|
|
962
|
|
|
|
|
|
|
############################################################################## |
963
|
|
|
|
|
|
|
# testing |
964
|
|
|
|
|
|
|
|
965
|
|
|
|
|
|
|
sub _acmp { |
966
|
|
|
|
|
|
|
# Internal absolute post-normalized compare (ignore signs) |
967
|
|
|
|
|
|
|
# ref to array, ref to array, return <0, 0, >0 |
968
|
|
|
|
|
|
|
# Arrays must have at least one entry; this is not checked for. |
969
|
110675
|
|
|
110675
|
|
200924
|
my ($c, $cx, $cy) = @_; |
970
|
|
|
|
|
|
|
|
971
|
|
|
|
|
|
|
# shortcut for short numbers |
972
|
110675
|
100
|
100
|
|
|
466714
|
return (($cx->[0] <=> $cy->[0]) <=> 0) |
973
|
|
|
|
|
|
|
if @$cx == 1 && @$cy == 1; |
974
|
|
|
|
|
|
|
|
975
|
|
|
|
|
|
|
# fast comp based on number of array elements (aka pseudo-length) |
976
|
18528
|
|
100
|
|
|
61169
|
my $lxy = (@$cx - @$cy) |
977
|
|
|
|
|
|
|
# or length of first element if same number of elements (aka difference 0) |
978
|
|
|
|
|
|
|
|| |
979
|
|
|
|
|
|
|
# need int() here because sometimes the last element is '00018' vs '18' |
980
|
|
|
|
|
|
|
(length(int($cx->[-1])) - length(int($cy->[-1]))); |
981
|
|
|
|
|
|
|
|
982
|
18528
|
100
|
|
|
|
43136
|
return -1 if $lxy < 0; # already differs, ret |
983
|
15593
|
100
|
|
|
|
36552
|
return 1 if $lxy > 0; # ditto |
984
|
|
|
|
|
|
|
|
985
|
|
|
|
|
|
|
# manual way (abort if unequal, good for early ne) |
986
|
11533
|
|
|
|
|
14849
|
my $a; |
987
|
11533
|
|
|
|
|
16302
|
my $j = @$cx; |
988
|
11533
|
|
|
|
|
21941
|
while (--$j >= 0) { |
989
|
37831
|
100
|
|
|
|
78629
|
last if $a = $cx->[$j] - $cy->[$j]; |
990
|
|
|
|
|
|
|
} |
991
|
11533
|
|
|
|
|
43701
|
$a <=> 0; |
992
|
|
|
|
|
|
|
} |
993
|
|
|
|
|
|
|
|
994
|
|
|
|
|
|
|
sub _len { |
995
|
|
|
|
|
|
|
# compute number of digits in base 10 |
996
|
|
|
|
|
|
|
|
997
|
|
|
|
|
|
|
# int() because add/sub sometimes leaves strings (like '00005') instead of |
998
|
|
|
|
|
|
|
# '5' in this place, thus causing length() to report wrong length |
999
|
103112
|
|
|
103112
|
|
166727
|
my $cx = $_[1]; |
1000
|
|
|
|
|
|
|
|
1001
|
103112
|
|
|
|
|
317600
|
(@$cx - 1) * $BASE_LEN + length(int($cx->[-1])); |
1002
|
|
|
|
|
|
|
} |
1003
|
|
|
|
|
|
|
|
1004
|
|
|
|
|
|
|
sub _digit { |
1005
|
|
|
|
|
|
|
# Return the nth digit. Zero is rightmost, so _digit(123, 0) gives 3. |
1006
|
|
|
|
|
|
|
# Negative values count from the left, so _digit(123, -1) gives 1. |
1007
|
97
|
|
|
97
|
|
271
|
my ($c, $x, $n) = @_; |
1008
|
|
|
|
|
|
|
|
1009
|
97
|
|
|
|
|
207
|
my $len = _len('', $x); |
1010
|
|
|
|
|
|
|
|
1011
|
97
|
100
|
|
|
|
248
|
$n += $len if $n < 0; # -1 last, -2 second-to-last |
1012
|
|
|
|
|
|
|
|
1013
|
|
|
|
|
|
|
# Math::BigInt::Calc returns 0 if N is out of range, but this is not done |
1014
|
|
|
|
|
|
|
# by the other backend libraries. |
1015
|
|
|
|
|
|
|
|
1016
|
97
|
100
|
100
|
|
|
389
|
return "0" if $n < 0 || $n >= $len; # return 0 for digits out of range |
1017
|
|
|
|
|
|
|
|
1018
|
95
|
|
|
|
|
205
|
my $elem = int($n / $BASE_LEN); # index of array element |
1019
|
95
|
|
|
|
|
170
|
my $digit = $n % $BASE_LEN; # index of digit within the element |
1020
|
95
|
|
|
|
|
1158
|
substr("0" x $BASE_LEN . "$x->[$elem]", -1 - $digit, 1); |
1021
|
|
|
|
|
|
|
} |
1022
|
|
|
|
|
|
|
|
1023
|
|
|
|
|
|
|
sub _zeros { |
1024
|
|
|
|
|
|
|
# Return number of trailing zeros in decimal. |
1025
|
|
|
|
|
|
|
# Check each array element for having 0 at end as long as elem == 0 |
1026
|
|
|
|
|
|
|
# Upon finding a elem != 0, stop. |
1027
|
|
|
|
|
|
|
|
1028
|
78937
|
|
|
78937
|
|
2070351
|
my $x = $_[1]; |
1029
|
|
|
|
|
|
|
|
1030
|
78937
|
100
|
100
|
|
|
228043
|
return 0 if @$x == 1 && $x->[0] == 0; |
1031
|
|
|
|
|
|
|
|
1032
|
76485
|
|
|
|
|
113321
|
my $zeros = 0; |
1033
|
76485
|
|
|
|
|
141064
|
foreach my $elem (@$x) { |
1034
|
222025
|
100
|
|
|
|
376767
|
if ($elem != 0) { |
1035
|
76485
|
|
|
|
|
345523
|
$elem =~ /[^0](0*)\z/; |
1036
|
76485
|
|
|
|
|
181898
|
$zeros += length($1); # count trailing zeros |
1037
|
76485
|
|
|
|
|
119351
|
last; # early out |
1038
|
|
|
|
|
|
|
} |
1039
|
145540
|
|
|
|
|
194313
|
$zeros += $BASE_LEN; |
1040
|
|
|
|
|
|
|
} |
1041
|
76485
|
|
|
|
|
160137
|
$zeros; |
1042
|
|
|
|
|
|
|
} |
1043
|
|
|
|
|
|
|
|
1044
|
|
|
|
|
|
|
############################################################################## |
1045
|
|
|
|
|
|
|
# _is_* routines |
1046
|
|
|
|
|
|
|
|
1047
|
|
|
|
|
|
|
sub _is_zero { |
1048
|
|
|
|
|
|
|
# return true if arg is zero |
1049
|
384382
|
100
|
100
|
384382
|
|
531891
|
@{$_[1]} == 1 && $_[1]->[0] == 0 ? 1 : 0; |
1050
|
|
|
|
|
|
|
} |
1051
|
|
|
|
|
|
|
|
1052
|
|
|
|
|
|
|
sub _is_even { |
1053
|
|
|
|
|
|
|
# return true if arg is even |
1054
|
86
|
100
|
|
86
|
|
1019
|
$_[1]->[0] % 2 ? 0 : 1; |
1055
|
|
|
|
|
|
|
} |
1056
|
|
|
|
|
|
|
|
1057
|
|
|
|
|
|
|
sub _is_odd { |
1058
|
|
|
|
|
|
|
# return true if arg is odd |
1059
|
706
|
100
|
|
706
|
|
4075
|
$_[1]->[0] % 2 ? 1 : 0; |
1060
|
|
|
|
|
|
|
} |
1061
|
|
|
|
|
|
|
|
1062
|
|
|
|
|
|
|
sub _is_one { |
1063
|
|
|
|
|
|
|
# return true if arg is one |
1064
|
6213
|
100
|
100
|
6213
|
|
9913
|
@{$_[1]} == 1 && $_[1]->[0] == 1 ? 1 : 0; |
1065
|
|
|
|
|
|
|
} |
1066
|
|
|
|
|
|
|
|
1067
|
|
|
|
|
|
|
sub _is_two { |
1068
|
|
|
|
|
|
|
# return true if arg is two |
1069
|
154
|
100
|
100
|
154
|
|
1098
|
@{$_[1]} == 1 && $_[1]->[0] == 2 ? 1 : 0; |
1070
|
|
|
|
|
|
|
} |
1071
|
|
|
|
|
|
|
|
1072
|
|
|
|
|
|
|
sub _is_ten { |
1073
|
|
|
|
|
|
|
# return true if arg is ten |
1074
|
2
|
50
|
|
2
|
|
7
|
if ($BASE_LEN == 1) { |
1075
|
0
|
0
|
0
|
|
|
0
|
@{$_[1]} == 2 && $_[1]->[0] == 0 && $_[1]->[1] == 1 ? 1 : 0; |
1076
|
|
|
|
|
|
|
} else { |
1077
|
2
|
100
|
66
|
|
|
4
|
@{$_[1]} == 1 && $_[1]->[0] == 10 ? 1 : 0; |
1078
|
|
|
|
|
|
|
} |
1079
|
|
|
|
|
|
|
} |
1080
|
|
|
|
|
|
|
|
1081
|
|
|
|
|
|
|
sub __strip_zeros { |
1082
|
|
|
|
|
|
|
# Internal normalization function that strips leading zeros from the array. |
1083
|
|
|
|
|
|
|
# Args: ref to array |
1084
|
64610
|
|
|
64610
|
|
108375
|
my $x = shift; |
1085
|
|
|
|
|
|
|
|
1086
|
64610
|
100
|
|
|
|
128938
|
push @$x, 0 if @$x == 0; # div might return empty results, so fix it |
1087
|
64610
|
100
|
|
|
|
181734
|
return $x if @$x == 1; # early out |
1088
|
|
|
|
|
|
|
|
1089
|
|
|
|
|
|
|
#print "strip: cnt $cnt i $i\n"; |
1090
|
|
|
|
|
|
|
# '0', '3', '4', '0', '0', |
1091
|
|
|
|
|
|
|
# 0 1 2 3 4 |
1092
|
|
|
|
|
|
|
# cnt = 5, i = 4 |
1093
|
|
|
|
|
|
|
# i = 4 |
1094
|
|
|
|
|
|
|
# i = 3 |
1095
|
|
|
|
|
|
|
# => fcnt = cnt - i (5-2 => 3, cnt => 5-1 = 4, throw away from 4th pos) |
1096
|
|
|
|
|
|
|
# >= 1: skip first part (this can be zero) |
1097
|
|
|
|
|
|
|
|
1098
|
13064
|
|
|
|
|
19661
|
my $i = $#$x; |
1099
|
13064
|
|
|
|
|
27004
|
while ($i > 0) { |
1100
|
22079
|
100
|
|
|
|
41949
|
last if $x->[$i] != 0; |
1101
|
9502
|
|
|
|
|
16476
|
$i--; |
1102
|
|
|
|
|
|
|
} |
1103
|
13064
|
|
|
|
|
17751
|
$i++; |
1104
|
13064
|
100
|
|
|
|
28035
|
splice(@$x, $i) if $i < @$x; |
1105
|
13064
|
|
|
|
|
24115
|
$x; |
1106
|
|
|
|
|
|
|
} |
1107
|
|
|
|
|
|
|
|
1108
|
|
|
|
|
|
|
############################################################################### |
1109
|
|
|
|
|
|
|
# check routine to test internal state for corruptions |
1110
|
|
|
|
|
|
|
|
1111
|
|
|
|
|
|
|
sub _check { |
1112
|
|
|
|
|
|
|
# used by the test suite |
1113
|
5498
|
|
|
5498
|
|
1934876
|
my ($class, $x) = @_; |
1114
|
|
|
|
|
|
|
|
1115
|
5498
|
|
|
|
|
19461
|
my $msg = $class -> SUPER::_check($x); |
1116
|
5498
|
100
|
|
|
|
13055
|
return $msg if $msg; |
1117
|
|
|
|
|
|
|
|
1118
|
5497
|
|
|
|
|
8186
|
my $n; |
1119
|
5497
|
|
|
|
|
8843
|
eval { $n = @$x }; |
|
5497
|
|
|
|
|
10188
|
|
1120
|
5497
|
50
|
|
|
|
13207
|
return "Not an array reference" unless $@ eq ''; |
1121
|
|
|
|
|
|
|
|
1122
|
5497
|
50
|
|
|
|
11272
|
return "Reference to an empty array" unless $n > 0; |
1123
|
|
|
|
|
|
|
|
1124
|
|
|
|
|
|
|
# The following fails with Math::BigInt::FastCalc because a |
1125
|
|
|
|
|
|
|
# Math::BigInt::FastCalc "object" is an unblessed array ref. |
1126
|
|
|
|
|
|
|
# |
1127
|
|
|
|
|
|
|
#return 0 unless ref($x) eq $class; |
1128
|
|
|
|
|
|
|
|
1129
|
5497
|
|
|
|
|
15675
|
for (my $i = 0 ; $i <= $#$x ; ++ $i) { |
1130
|
6292
|
|
|
|
|
11098
|
my $e = $x -> [$i]; |
1131
|
|
|
|
|
|
|
|
1132
|
6292
|
50
|
|
|
|
12155
|
return "Element at index $i is undefined" |
1133
|
|
|
|
|
|
|
unless defined $e; |
1134
|
|
|
|
|
|
|
|
1135
|
6292
|
50
|
|
|
|
12703
|
return "Element at index $i is a '" . ref($e) . |
1136
|
|
|
|
|
|
|
"', which is not a scalar" |
1137
|
|
|
|
|
|
|
unless ref($e) eq ""; |
1138
|
|
|
|
|
|
|
|
1139
|
|
|
|
|
|
|
# It would be better to use the regex /^([1-9]\d*|0)\z/, but that fails |
1140
|
|
|
|
|
|
|
# in Math::BigInt::FastCalc, because it sometimes creates array |
1141
|
|
|
|
|
|
|
# elements like "000000". |
1142
|
6292
|
50
|
|
|
|
22500
|
return "Element at index $i is '$e', which does not look like an" . |
1143
|
|
|
|
|
|
|
" normal integer" unless $e =~ /^\d+\z/; |
1144
|
|
|
|
|
|
|
|
1145
|
6292
|
50
|
|
|
|
13337
|
return "Element at index $i is '$e', which is not smaller than" . |
1146
|
|
|
|
|
|
|
" the base '$BASE'" if $e >= $BASE; |
1147
|
|
|
|
|
|
|
|
1148
|
6292
|
50
|
100
|
|
|
26861
|
return "Element at index $i (last element) is zero" |
|
|
|
66
|
|
|
|
|
1149
|
|
|
|
|
|
|
if $#$x > 0 && $i == $#$x && $e == 0; |
1150
|
|
|
|
|
|
|
} |
1151
|
|
|
|
|
|
|
|
1152
|
5497
|
|
|
|
|
13219
|
return 0; |
1153
|
|
|
|
|
|
|
} |
1154
|
|
|
|
|
|
|
|
1155
|
|
|
|
|
|
|
############################################################################### |
1156
|
|
|
|
|
|
|
|
1157
|
|
|
|
|
|
|
sub _mod { |
1158
|
|
|
|
|
|
|
# if possible, use mod shortcut |
1159
|
2985
|
|
|
2985
|
|
5712
|
my ($c, $x, $yo) = @_; |
1160
|
|
|
|
|
|
|
|
1161
|
|
|
|
|
|
|
# slow way since $y too big |
1162
|
2985
|
100
|
|
|
|
6043
|
if (@$yo > 1) { |
1163
|
805
|
|
|
|
|
1738
|
my ($xo, $rem) = $c->_div($x, $yo); |
1164
|
805
|
|
|
|
|
1579
|
@$x = @$rem; |
1165
|
805
|
|
|
|
|
1997
|
return $x; |
1166
|
|
|
|
|
|
|
} |
1167
|
|
|
|
|
|
|
|
1168
|
2180
|
|
|
|
|
3621
|
my $y = $yo->[0]; |
1169
|
|
|
|
|
|
|
|
1170
|
|
|
|
|
|
|
# if both are single element arrays |
1171
|
2180
|
100
|
|
|
|
4268
|
if (@$x == 1) { |
1172
|
1654
|
|
|
|
|
2816
|
$x->[0] %= $y; |
1173
|
1654
|
|
|
|
|
3788
|
return $x; |
1174
|
|
|
|
|
|
|
} |
1175
|
|
|
|
|
|
|
|
1176
|
|
|
|
|
|
|
# if @$x has more than one element, but @$y is a single element |
1177
|
526
|
|
|
|
|
1064
|
my $b = $BASE % $y; |
1178
|
526
|
100
|
|
|
|
1417
|
if ($b == 0) { |
|
|
100
|
|
|
|
|
|
1179
|
|
|
|
|
|
|
# when BASE % Y == 0 then (B * BASE) % Y == 0 |
1180
|
|
|
|
|
|
|
# (B * BASE) % $y + A % Y => A % Y |
1181
|
|
|
|
|
|
|
# so need to consider only last element: O(1) |
1182
|
15
|
|
|
|
|
35
|
$x->[0] %= $y; |
1183
|
|
|
|
|
|
|
} elsif ($b == 1) { |
1184
|
|
|
|
|
|
|
# else need to go through all elements in @$x: O(N), but loop is a bit |
1185
|
|
|
|
|
|
|
# simplified |
1186
|
155
|
|
|
|
|
242
|
my $r = 0; |
1187
|
155
|
|
|
|
|
350
|
foreach (@$x) { |
1188
|
310
|
|
|
|
|
535
|
$r = ($r + $_) % $y; # not much faster, but heh... |
1189
|
|
|
|
|
|
|
#$r += $_ % $y; $r %= $y; |
1190
|
|
|
|
|
|
|
} |
1191
|
155
|
50
|
|
|
|
332
|
$r = 0 if $r == $y; |
1192
|
155
|
|
|
|
|
285
|
$x->[0] = $r; |
1193
|
|
|
|
|
|
|
} else { |
1194
|
|
|
|
|
|
|
# else need to go through all elements in @$x: O(N) |
1195
|
356
|
|
|
|
|
574
|
my $r = 0; |
1196
|
356
|
|
|
|
|
574
|
my $bm = 1; |
1197
|
356
|
|
|
|
|
736
|
foreach (@$x) { |
1198
|
2555
|
|
|
|
|
3369
|
$r = ($_ * $bm + $r) % $y; |
1199
|
2555
|
|
|
|
|
3796
|
$bm = ($bm * $b) % $y; |
1200
|
|
|
|
|
|
|
|
1201
|
|
|
|
|
|
|
#$r += ($_ % $y) * $bm; |
1202
|
|
|
|
|
|
|
#$bm *= $b; |
1203
|
|
|
|
|
|
|
#$bm %= $y; |
1204
|
|
|
|
|
|
|
#$r %= $y; |
1205
|
|
|
|
|
|
|
} |
1206
|
356
|
50
|
|
|
|
814
|
$r = 0 if $r == $y; |
1207
|
356
|
|
|
|
|
657
|
$x->[0] = $r; |
1208
|
|
|
|
|
|
|
} |
1209
|
526
|
|
|
|
|
1242
|
@$x = $x->[0]; # keep one element of @$x |
1210
|
526
|
|
|
|
|
1140
|
return $x; |
1211
|
|
|
|
|
|
|
} |
1212
|
|
|
|
|
|
|
|
1213
|
|
|
|
|
|
|
############################################################################## |
1214
|
|
|
|
|
|
|
# shifts |
1215
|
|
|
|
|
|
|
|
1216
|
|
|
|
|
|
|
sub _rsft { |
1217
|
29993
|
|
|
29993
|
|
60964
|
my ($c, $x, $n, $b) = @_; |
1218
|
29993
|
50
|
33
|
|
|
67380
|
return $x if $c->_is_zero($x) || $c->_is_zero($n); |
1219
|
|
|
|
|
|
|
|
1220
|
|
|
|
|
|
|
# For backwards compatibility, allow the base $b to be a scalar. |
1221
|
|
|
|
|
|
|
|
1222
|
29993
|
50
|
|
|
|
81293
|
$b = $c->_new($b) unless ref $b; |
1223
|
|
|
|
|
|
|
|
1224
|
29993
|
100
|
|
|
|
70094
|
if ($c -> _acmp($b, $c -> _ten())) { |
1225
|
49
|
|
|
|
|
175
|
return scalar $c->_div($x, $c->_pow($c->_copy($b), $n)); |
1226
|
|
|
|
|
|
|
} |
1227
|
|
|
|
|
|
|
|
1228
|
|
|
|
|
|
|
# shortcut (faster) for shifting by 10) |
1229
|
|
|
|
|
|
|
# multiples of $BASE_LEN |
1230
|
29944
|
|
|
|
|
59555
|
my $dst = 0; # destination |
1231
|
29944
|
|
|
|
|
66275
|
my $src = $c->_num($n); # as normal int |
1232
|
29944
|
|
|
|
|
73073
|
my $xlen = (@$x - 1) * $BASE_LEN + length(int($x->[-1])); |
1233
|
29944
|
100
|
33
|
|
|
97827
|
if ($src >= $xlen or ($src == $xlen and !defined $x->[1])) { |
|
|
|
66
|
|
|
|
|
1234
|
|
|
|
|
|
|
# 12345 67890 shifted right by more than 10 digits => 0 |
1235
|
165
|
|
|
|
|
401
|
splice(@$x, 1); # leave only one element |
1236
|
165
|
|
|
|
|
336
|
$x->[0] = 0; # set to zero |
1237
|
165
|
|
|
|
|
550
|
return $x; |
1238
|
|
|
|
|
|
|
} |
1239
|
29779
|
|
|
|
|
48106
|
my $rem = $src % $BASE_LEN; # remainder to shift |
1240
|
29779
|
|
|
|
|
62339
|
$src = int($src / $BASE_LEN); # source |
1241
|
29779
|
100
|
|
|
|
52054
|
if ($rem == 0) { |
1242
|
1701
|
|
|
|
|
4139
|
splice(@$x, 0, $src); # even faster, 38.4 => 39.3 |
1243
|
|
|
|
|
|
|
} else { |
1244
|
28078
|
|
|
|
|
43342
|
my $len = @$x - $src; # elems to go |
1245
|
28078
|
|
|
|
|
37075
|
my $vd; |
1246
|
28078
|
|
|
|
|
53795
|
my $z = '0' x $BASE_LEN; |
1247
|
28078
|
|
|
|
|
66077
|
$x->[ @$x ] = 0; # avoid || 0 test inside loop |
1248
|
28078
|
|
|
|
|
56883
|
while ($dst < $len) { |
1249
|
180903
|
|
|
|
|
256216
|
$vd = $z . $x->[$src]; |
1250
|
180903
|
|
|
|
|
282963
|
$vd = substr($vd, -$BASE_LEN, $BASE_LEN - $rem); |
1251
|
180903
|
|
|
|
|
220399
|
$src++; |
1252
|
180903
|
|
|
|
|
345205
|
$vd = substr($z . $x->[$src], -$rem, $rem) . $vd; |
1253
|
180903
|
50
|
|
|
|
332008
|
$vd = substr($vd, -$BASE_LEN, $BASE_LEN) if length($vd) > $BASE_LEN; |
1254
|
180903
|
|
|
|
|
282219
|
$x->[$dst] = int($vd); |
1255
|
180903
|
|
|
|
|
307592
|
$dst++; |
1256
|
|
|
|
|
|
|
} |
1257
|
28078
|
50
|
|
|
|
73242
|
splice(@$x, $dst) if $dst > 0; # kill left-over array elems |
1258
|
28078
|
100
|
66
|
|
|
92922
|
pop(@$x) if $x->[-1] == 0 && @$x > 1; # kill last element if 0 |
1259
|
|
|
|
|
|
|
} # else rem == 0 |
1260
|
29779
|
|
|
|
|
92497
|
$x; |
1261
|
|
|
|
|
|
|
} |
1262
|
|
|
|
|
|
|
|
1263
|
|
|
|
|
|
|
sub _lsft { |
1264
|
23383
|
|
|
23383
|
|
48438
|
my ($c, $x, $n, $b) = @_; |
1265
|
|
|
|
|
|
|
|
1266
|
23383
|
100
|
100
|
|
|
49277
|
return $x if $c->_is_zero($x) || $c->_is_zero($n); |
1267
|
|
|
|
|
|
|
|
1268
|
|
|
|
|
|
|
# For backwards compatibility, allow the base $b to be a scalar. |
1269
|
|
|
|
|
|
|
|
1270
|
19451
|
100
|
|
|
|
57198
|
$b = $c->_new($b) unless ref $b; |
1271
|
|
|
|
|
|
|
|
1272
|
|
|
|
|
|
|
# If the base is a power of 10, use shifting, since the internal |
1273
|
|
|
|
|
|
|
# representation is in base 10eX. |
1274
|
|
|
|
|
|
|
|
1275
|
19451
|
|
|
|
|
46343
|
my $bstr = $c->_str($b); |
1276
|
19451
|
100
|
|
|
|
90449
|
if ($bstr =~ /^1(0+)\z/) { |
1277
|
|
|
|
|
|
|
|
1278
|
|
|
|
|
|
|
# Adjust $n so that we're shifting in base 10. Do this by multiplying |
1279
|
|
|
|
|
|
|
# $n by the base 10 logarithm of $b: $b ** $n = 10 ** (log10($b) * $n). |
1280
|
|
|
|
|
|
|
|
1281
|
19423
|
|
|
|
|
47800
|
my $log10b = length($1); |
1282
|
19423
|
|
|
|
|
41466
|
$n = $c->_mul($c->_new($log10b), $n); |
1283
|
19423
|
|
|
|
|
44319
|
$n = $c->_num($n); # shift-len as normal int |
1284
|
|
|
|
|
|
|
|
1285
|
|
|
|
|
|
|
# $q is the number of places to shift the elements within the array, |
1286
|
|
|
|
|
|
|
# and $r is the number of places to shift the values within the |
1287
|
|
|
|
|
|
|
# elements. |
1288
|
|
|
|
|
|
|
|
1289
|
19423
|
|
|
|
|
45176
|
my $r = $n % $BASE_LEN; |
1290
|
19423
|
|
|
|
|
38890
|
my $q = ($n - $r) / $BASE_LEN; |
1291
|
|
|
|
|
|
|
|
1292
|
|
|
|
|
|
|
# If we must shift the values within the elements ... |
1293
|
|
|
|
|
|
|
|
1294
|
19423
|
100
|
|
|
|
39506
|
if ($r) { |
1295
|
17766
|
|
|
|
|
27047
|
my $i = @$x; # index |
1296
|
17766
|
|
|
|
|
35060
|
$x->[$i] = 0; # initialize most significant element |
1297
|
17766
|
|
|
|
|
35719
|
my $z = '0' x $BASE_LEN; |
1298
|
17766
|
|
|
|
|
24552
|
my $vd; |
1299
|
17766
|
|
|
|
|
38232
|
while ($i >= 0) { |
1300
|
134602
|
|
|
|
|
186143
|
$vd = $x->[$i]; |
1301
|
134602
|
|
|
|
|
212432
|
$vd = $z . $vd; |
1302
|
134602
|
|
|
|
|
231231
|
$vd = substr($vd, $r - $BASE_LEN, $BASE_LEN - $r); |
1303
|
134602
|
100
|
|
|
|
289860
|
$vd .= $i > 0 ? substr($z . $x->[$i - 1], -$BASE_LEN, $r) |
1304
|
|
|
|
|
|
|
: '0' x $r; |
1305
|
134602
|
50
|
|
|
|
229980
|
$vd = substr($vd, -$BASE_LEN, $BASE_LEN) if length($vd) > $BASE_LEN; |
1306
|
134602
|
|
|
|
|
212675
|
$x->[$i] = int($vd); # e.g., "0...048" -> 48 etc. |
1307
|
134602
|
|
|
|
|
226715
|
$i--; |
1308
|
|
|
|
|
|
|
} |
1309
|
|
|
|
|
|
|
|
1310
|
17766
|
100
|
|
|
|
41334
|
pop(@$x) if $x->[-1] == 0; # if most significant element is zero |
1311
|
|
|
|
|
|
|
} |
1312
|
|
|
|
|
|
|
|
1313
|
|
|
|
|
|
|
# If we must shift the elements within the array ... |
1314
|
|
|
|
|
|
|
|
1315
|
19423
|
100
|
|
|
|
39814
|
if ($q) { |
1316
|
15563
|
|
|
|
|
58627
|
unshift @$x, (0) x $q; |
1317
|
|
|
|
|
|
|
} |
1318
|
|
|
|
|
|
|
|
1319
|
|
|
|
|
|
|
} else { |
1320
|
28
|
|
|
|
|
110
|
$x = $c->_mul($x, $c->_pow($b, $n)); |
1321
|
|
|
|
|
|
|
} |
1322
|
|
|
|
|
|
|
|
1323
|
19451
|
|
|
|
|
66008
|
return $x; |
1324
|
|
|
|
|
|
|
} |
1325
|
|
|
|
|
|
|
|
1326
|
|
|
|
|
|
|
sub _pow { |
1327
|
|
|
|
|
|
|
# power of $x to $y |
1328
|
|
|
|
|
|
|
# ref to array, ref to array, return ref to array |
1329
|
1014
|
|
|
1014
|
|
2436
|
my ($c, $cx, $cy) = @_; |
1330
|
|
|
|
|
|
|
|
1331
|
1014
|
100
|
66
|
|
|
4349
|
if (@$cy == 1 && $cy->[0] == 0) { |
1332
|
64
|
|
|
|
|
173
|
splice(@$cx, 1); |
1333
|
64
|
|
|
|
|
152
|
$cx->[0] = 1; # y == 0 => x => 1 |
1334
|
64
|
|
|
|
|
183
|
return $cx; |
1335
|
|
|
|
|
|
|
} |
1336
|
|
|
|
|
|
|
|
1337
|
950
|
100
|
100
|
|
|
5864
|
if ((@$cx == 1 && $cx->[0] == 1) || # x == 1 |
|
|
|
66
|
|
|
|
|
|
|
|
100
|
|
|
|
|
1338
|
|
|
|
|
|
|
(@$cy == 1 && $cy->[0] == 1)) # or y == 1 |
1339
|
|
|
|
|
|
|
{ |
1340
|
144
|
|
|
|
|
440
|
return $cx; |
1341
|
|
|
|
|
|
|
} |
1342
|
|
|
|
|
|
|
|
1343
|
806
|
100
|
100
|
|
|
2794
|
if (@$cx == 1 && $cx->[0] == 0) { |
1344
|
1
|
|
|
|
|
5
|
splice (@$cx, 1); |
1345
|
1
|
|
|
|
|
3
|
$cx->[0] = 0; # 0 ** y => 0 (if not y <= 0) |
1346
|
1
|
|
|
|
|
4
|
return $cx; |
1347
|
|
|
|
|
|
|
} |
1348
|
|
|
|
|
|
|
|
1349
|
805
|
|
|
|
|
1944
|
my $pow2 = $c->_one(); |
1350
|
|
|
|
|
|
|
|
1351
|
805
|
|
|
|
|
2331
|
my $y_bin = $c->_as_bin($cy); |
1352
|
805
|
|
|
|
|
2739
|
$y_bin =~ s/^0b//; |
1353
|
805
|
|
|
|
|
1462
|
my $len = length($y_bin); |
1354
|
805
|
|
|
|
|
1926
|
while (--$len > 0) { |
1355
|
1869
|
100
|
|
|
|
4939
|
$c->_mul($pow2, $cx) if substr($y_bin, $len, 1) eq '1'; # is odd? |
1356
|
1869
|
|
|
|
|
3956
|
$c->_mul($cx, $cx); |
1357
|
|
|
|
|
|
|
} |
1358
|
|
|
|
|
|
|
|
1359
|
805
|
|
|
|
|
2351
|
$c->_mul($cx, $pow2); |
1360
|
805
|
|
|
|
|
2597
|
$cx; |
1361
|
|
|
|
|
|
|
} |
1362
|
|
|
|
|
|
|
|
1363
|
|
|
|
|
|
|
sub _nok { |
1364
|
|
|
|
|
|
|
# Return binomial coefficient (n over k). |
1365
|
|
|
|
|
|
|
# Given refs to arrays, return ref to array. |
1366
|
|
|
|
|
|
|
# First input argument is modified. |
1367
|
|
|
|
|
|
|
|
1368
|
56
|
|
|
56
|
|
129
|
my ($c, $n, $k) = @_; |
1369
|
|
|
|
|
|
|
|
1370
|
|
|
|
|
|
|
# If k > n/2, or, equivalently, 2*k > n, compute nok(n, k) as |
1371
|
|
|
|
|
|
|
# nok(n, n-k), to minimize the number if iterations in the loop. |
1372
|
|
|
|
|
|
|
|
1373
|
|
|
|
|
|
|
{ |
1374
|
56
|
|
|
|
|
92
|
my $twok = $c->_mul($c->_two(), $c->_copy($k)); # 2 * k |
|
56
|
|
|
|
|
148
|
|
1375
|
56
|
100
|
|
|
|
182
|
if ($c->_acmp($twok, $n) > 0) { # if 2*k > n |
1376
|
28
|
|
|
|
|
81
|
$k = $c->_sub($c->_copy($n), $k); # k = n - k |
1377
|
|
|
|
|
|
|
} |
1378
|
|
|
|
|
|
|
} |
1379
|
|
|
|
|
|
|
|
1380
|
|
|
|
|
|
|
# Example: |
1381
|
|
|
|
|
|
|
# |
1382
|
|
|
|
|
|
|
# / 7 \ 7! 1*2*3*4 * 5*6*7 5 * 6 * 7 6 7 |
1383
|
|
|
|
|
|
|
# | | = --------- = --------------- = --------- = 5 * - * - |
1384
|
|
|
|
|
|
|
# \ 3 / (7-3)! 3! 1*2*3*4 * 1*2*3 1 * 2 * 3 2 3 |
1385
|
|
|
|
|
|
|
|
1386
|
56
|
100
|
|
|
|
210
|
if ($c->_is_zero($k)) { |
1387
|
21
|
|
|
|
|
73
|
@$n = 1; |
1388
|
|
|
|
|
|
|
} else { |
1389
|
|
|
|
|
|
|
|
1390
|
|
|
|
|
|
|
# Make a copy of the original n, since we'll be modifying n in-place. |
1391
|
|
|
|
|
|
|
|
1392
|
35
|
|
|
|
|
296
|
my $n_orig = $c->_copy($n); |
1393
|
|
|
|
|
|
|
|
1394
|
|
|
|
|
|
|
# n = 5, f = 6, d = 2 (cf. example above) |
1395
|
|
|
|
|
|
|
|
1396
|
35
|
|
|
|
|
125
|
$c->_sub($n, $k); |
1397
|
35
|
|
|
|
|
144
|
$c->_inc($n); |
1398
|
|
|
|
|
|
|
|
1399
|
35
|
|
|
|
|
75
|
my $f = $c->_copy($n); |
1400
|
35
|
|
|
|
|
105
|
$c->_inc($f); |
1401
|
|
|
|
|
|
|
|
1402
|
35
|
|
|
|
|
99
|
my $d = $c->_two(); |
1403
|
|
|
|
|
|
|
|
1404
|
|
|
|
|
|
|
# while f <= n (the original n, that is) ... |
1405
|
|
|
|
|
|
|
|
1406
|
35
|
|
|
|
|
100
|
while ($c->_acmp($f, $n_orig) <= 0) { |
1407
|
|
|
|
|
|
|
|
1408
|
|
|
|
|
|
|
# n = (n * f / d) == 5 * 6 / 2 (cf. example above) |
1409
|
|
|
|
|
|
|
|
1410
|
105
|
|
|
|
|
280
|
$c->_mul($n, $f); |
1411
|
105
|
|
|
|
|
270
|
$c->_div($n, $d); |
1412
|
|
|
|
|
|
|
|
1413
|
|
|
|
|
|
|
# f = 7, d = 3 (cf. example above) |
1414
|
|
|
|
|
|
|
|
1415
|
105
|
|
|
|
|
355
|
$c->_inc($f); |
1416
|
105
|
|
|
|
|
189
|
$c->_inc($d); |
1417
|
|
|
|
|
|
|
} |
1418
|
|
|
|
|
|
|
|
1419
|
|
|
|
|
|
|
} |
1420
|
|
|
|
|
|
|
|
1421
|
56
|
|
|
|
|
520
|
return $n; |
1422
|
|
|
|
|
|
|
} |
1423
|
|
|
|
|
|
|
|
1424
|
|
|
|
|
|
|
sub _fac { |
1425
|
|
|
|
|
|
|
# factorial of $x |
1426
|
|
|
|
|
|
|
# ref to array, return ref to array |
1427
|
140
|
|
|
140
|
|
378
|
my ($c, $cx) = @_; |
1428
|
|
|
|
|
|
|
|
1429
|
|
|
|
|
|
|
# We cache the smallest values. Don't assume that a single element has a |
1430
|
|
|
|
|
|
|
# value larger than 9 or else it won't work with a $BASE_LEN of 1. |
1431
|
|
|
|
|
|
|
|
1432
|
140
|
50
|
|
|
|
345
|
if (@$cx == 1) { |
1433
|
140
|
|
|
|
|
449
|
my @factorials = |
1434
|
|
|
|
|
|
|
( |
1435
|
|
|
|
|
|
|
'1', |
1436
|
|
|
|
|
|
|
'1', |
1437
|
|
|
|
|
|
|
'2', |
1438
|
|
|
|
|
|
|
'6', |
1439
|
|
|
|
|
|
|
'24', |
1440
|
|
|
|
|
|
|
'120', |
1441
|
|
|
|
|
|
|
'720', |
1442
|
|
|
|
|
|
|
'5040', |
1443
|
|
|
|
|
|
|
'40320', |
1444
|
|
|
|
|
|
|
'362880', |
1445
|
|
|
|
|
|
|
); |
1446
|
140
|
100
|
|
|
|
434
|
if ($cx->[0] <= $#factorials) { |
1447
|
69
|
|
|
|
|
185
|
my $tmp = $c -> _new($factorials[ $cx->[0] ]); |
1448
|
69
|
|
|
|
|
205
|
@$cx = @$tmp; |
1449
|
69
|
|
|
|
|
262
|
return $cx; |
1450
|
|
|
|
|
|
|
} |
1451
|
|
|
|
|
|
|
} |
1452
|
|
|
|
|
|
|
|
1453
|
|
|
|
|
|
|
# The old code further below doesn't work for small values of $BASE_LEN. |
1454
|
|
|
|
|
|
|
# Alas, I have not been able to (or taken the time to) decipher it, so for |
1455
|
|
|
|
|
|
|
# the case when $BASE_LEN is small, we call the parent class. This code |
1456
|
|
|
|
|
|
|
# works in for every value of $x and $BASE_LEN. We could use this code for |
1457
|
|
|
|
|
|
|
# all cases, but it is a little slower than the code further below, so at |
1458
|
|
|
|
|
|
|
# least for now we keep the code below. |
1459
|
|
|
|
|
|
|
|
1460
|
71
|
50
|
|
|
|
212
|
if ($BASE_LEN <= 2) { |
1461
|
0
|
|
|
|
|
0
|
my $tmp = $c -> SUPER::_fac($cx); |
1462
|
0
|
|
|
|
|
0
|
@$cx = @$tmp; |
1463
|
0
|
|
|
|
|
0
|
return $cx; |
1464
|
|
|
|
|
|
|
} |
1465
|
|
|
|
|
|
|
|
1466
|
|
|
|
|
|
|
# This code does not work for small values of $BASE_LEN. |
1467
|
|
|
|
|
|
|
|
1468
|
71
|
100
|
66
|
|
|
666
|
if ((@$cx == 1) && # we do this only if $x >= 12 and $x <= 7000 |
|
|
|
33
|
|
|
|
|
1469
|
|
|
|
|
|
|
($cx->[0] >= 12 && $cx->[0] < 7000)) { |
1470
|
|
|
|
|
|
|
|
1471
|
|
|
|
|
|
|
# Calculate (k-j) * (k-j+1) ... k .. (k+j-1) * (k + j) |
1472
|
|
|
|
|
|
|
# See http://blogten.blogspot.com/2007/01/calculating-n.html |
1473
|
|
|
|
|
|
|
# The above series can be expressed as factors: |
1474
|
|
|
|
|
|
|
# k * k - (j - i) * 2 |
1475
|
|
|
|
|
|
|
# We cache k*k, and calculate (j * j) as the sum of the first j odd integers |
1476
|
|
|
|
|
|
|
|
1477
|
|
|
|
|
|
|
# This will not work when N exceeds the storage of a Perl scalar, however, |
1478
|
|
|
|
|
|
|
# in this case the algorithm would be way too slow to terminate, anyway. |
1479
|
|
|
|
|
|
|
|
1480
|
|
|
|
|
|
|
# As soon as the last element of $cx is 0, we split it up and remember |
1481
|
|
|
|
|
|
|
# how many zeors we got so far. The reason is that n! will accumulate |
1482
|
|
|
|
|
|
|
# zeros at the end rather fast. |
1483
|
55
|
|
|
|
|
137
|
my $zero_elements = 0; |
1484
|
|
|
|
|
|
|
|
1485
|
|
|
|
|
|
|
# If n is even, set n = n -1 |
1486
|
55
|
|
|
|
|
174
|
my $k = $c->_num($cx); |
1487
|
55
|
|
|
|
|
148
|
my $even = 1; |
1488
|
55
|
100
|
|
|
|
184
|
if (($k & 1) == 0) { |
1489
|
35
|
|
|
|
|
67
|
$even = $k; |
1490
|
35
|
|
|
|
|
72
|
$k --; |
1491
|
|
|
|
|
|
|
} |
1492
|
|
|
|
|
|
|
# set k to the center point |
1493
|
55
|
|
|
|
|
146
|
$k = ($k + 1) / 2; |
1494
|
|
|
|
|
|
|
# print "k $k even: $even\n"; |
1495
|
|
|
|
|
|
|
# now calculate k * k |
1496
|
55
|
|
|
|
|
97
|
my $k2 = $k * $k; |
1497
|
55
|
|
|
|
|
95
|
my $odd = 1; |
1498
|
55
|
|
|
|
|
248
|
my $sum = 1; |
1499
|
55
|
|
|
|
|
115
|
my $i = $k - 1; |
1500
|
|
|
|
|
|
|
# keep reference to x |
1501
|
55
|
|
|
|
|
271
|
my $new_x = $c->_new($k * $even); |
1502
|
55
|
|
|
|
|
177
|
@$cx = @$new_x; |
1503
|
55
|
50
|
|
|
|
174
|
if ($cx->[0] == 0) { |
1504
|
0
|
|
|
|
|
0
|
$zero_elements ++; |
1505
|
0
|
|
|
|
|
0
|
shift @$cx; |
1506
|
|
|
|
|
|
|
} |
1507
|
|
|
|
|
|
|
# print STDERR "x = ", $c->_str($cx), "\n"; |
1508
|
55
|
|
|
|
|
145
|
my $BASE2 = int(sqrt($BASE))-1; |
1509
|
55
|
|
|
|
|
84
|
my $j = 1; |
1510
|
55
|
|
|
|
|
133
|
while ($j <= $i) { |
1511
|
282
|
|
|
|
|
425
|
my $m = ($k2 - $sum); |
1512
|
282
|
|
|
|
|
376
|
$odd += 2; |
1513
|
282
|
|
|
|
|
362
|
$sum += $odd; |
1514
|
282
|
|
|
|
|
361
|
$j++; |
1515
|
282
|
|
100
|
|
|
1309
|
while ($j <= $i && ($m < $BASE2) && (($k2 - $sum) < $BASE2)) { |
|
|
|
66
|
|
|
|
|
1516
|
366
|
|
|
|
|
512
|
$m *= ($k2 - $sum); |
1517
|
366
|
|
|
|
|
462
|
$odd += 2; |
1518
|
366
|
|
|
|
|
501
|
$sum += $odd; |
1519
|
366
|
|
|
|
|
1054
|
$j++; |
1520
|
|
|
|
|
|
|
# print STDERR "\n k2 $k2 m $m sum $sum odd $odd\n"; sleep(1); |
1521
|
|
|
|
|
|
|
} |
1522
|
282
|
50
|
|
|
|
501
|
if ($m < $BASE) { |
1523
|
282
|
|
|
|
|
695
|
$c->_mul($cx, [$m]); |
1524
|
|
|
|
|
|
|
} else { |
1525
|
0
|
|
|
|
|
0
|
$c->_mul($cx, $c->_new($m)); |
1526
|
|
|
|
|
|
|
} |
1527
|
282
|
100
|
|
|
|
816
|
if ($cx->[0] == 0) { |
1528
|
10
|
|
|
|
|
36
|
$zero_elements ++; |
1529
|
10
|
|
|
|
|
42
|
shift @$cx; |
1530
|
|
|
|
|
|
|
} |
1531
|
|
|
|
|
|
|
# print STDERR "Calculate $k2 - $sum = $m (x = ", $c->_str($cx), ")\n"; |
1532
|
|
|
|
|
|
|
} |
1533
|
|
|
|
|
|
|
# multiply in the zeros again |
1534
|
55
|
|
|
|
|
164
|
unshift @$cx, (0) x $zero_elements; |
1535
|
55
|
|
|
|
|
225
|
return $cx; |
1536
|
|
|
|
|
|
|
} |
1537
|
|
|
|
|
|
|
|
1538
|
|
|
|
|
|
|
# go forward until $base is exceeded limit is either $x steps (steps == 100 |
1539
|
|
|
|
|
|
|
# means a result always too high) or $base. |
1540
|
16
|
|
|
|
|
40
|
my $steps = 100; |
1541
|
16
|
50
|
|
|
|
56
|
$steps = $cx->[0] if @$cx == 1; |
1542
|
16
|
|
|
|
|
37
|
my $r = 2; |
1543
|
16
|
|
|
|
|
46
|
my $cf = 3; |
1544
|
16
|
|
|
|
|
32
|
my $step = 2; |
1545
|
16
|
|
|
|
|
30
|
my $last = $r; |
1546
|
16
|
|
66
|
|
|
110
|
while ($r * $cf < $BASE && $step < $steps) { |
1547
|
136
|
|
|
|
|
185
|
$last = $r; |
1548
|
136
|
|
|
|
|
212
|
$r *= $cf++; |
1549
|
136
|
|
|
|
|
631
|
$step++; |
1550
|
|
|
|
|
|
|
} |
1551
|
16
|
50
|
33
|
|
|
149
|
if ((@$cx == 1) && $step == $cx->[0]) { |
1552
|
|
|
|
|
|
|
# completely done, so keep reference to $x and return |
1553
|
16
|
|
|
|
|
41
|
$cx->[0] = $r; |
1554
|
16
|
|
|
|
|
68
|
return $cx; |
1555
|
|
|
|
|
|
|
} |
1556
|
|
|
|
|
|
|
|
1557
|
|
|
|
|
|
|
# now we must do the left over steps |
1558
|
0
|
|
|
|
|
0
|
my $n; # steps still to do |
1559
|
0
|
0
|
|
|
|
0
|
if (@$cx == 1) { |
1560
|
0
|
|
|
|
|
0
|
$n = $cx->[0]; |
1561
|
|
|
|
|
|
|
} else { |
1562
|
0
|
|
|
|
|
0
|
$n = $c->_copy($cx); |
1563
|
|
|
|
|
|
|
} |
1564
|
|
|
|
|
|
|
|
1565
|
|
|
|
|
|
|
# Set $cx to the last result below $BASE (but keep ref to $x) |
1566
|
0
|
|
|
|
|
0
|
$cx->[0] = $last; |
1567
|
0
|
|
|
|
|
0
|
splice (@$cx, 1); |
1568
|
|
|
|
|
|
|
# As soon as the last element of $cx is 0, we split it up and remember |
1569
|
|
|
|
|
|
|
# how many zeors we got so far. The reason is that n! will accumulate |
1570
|
|
|
|
|
|
|
# zeros at the end rather fast. |
1571
|
0
|
|
|
|
|
0
|
my $zero_elements = 0; |
1572
|
|
|
|
|
|
|
|
1573
|
|
|
|
|
|
|
# do left-over steps fit into a scalar? |
1574
|
0
|
0
|
|
|
|
0
|
if (ref $n eq 'ARRAY') { |
1575
|
|
|
|
|
|
|
# No, so use slower inc() & cmp() |
1576
|
|
|
|
|
|
|
# ($n is at least $BASE here) |
1577
|
0
|
|
|
|
|
0
|
my $base_2 = int(sqrt($BASE)) - 1; |
1578
|
|
|
|
|
|
|
#print STDERR "base_2: $base_2\n"; |
1579
|
0
|
|
|
|
|
0
|
while ($step < $base_2) { |
1580
|
0
|
0
|
|
|
|
0
|
if ($cx->[0] == 0) { |
1581
|
0
|
|
|
|
|
0
|
$zero_elements ++; |
1582
|
0
|
|
|
|
|
0
|
shift @$cx; |
1583
|
|
|
|
|
|
|
} |
1584
|
0
|
|
|
|
|
0
|
my $b = $step * ($step + 1); |
1585
|
0
|
|
|
|
|
0
|
$step += 2; |
1586
|
0
|
|
|
|
|
0
|
$c->_mul($cx, [$b]); |
1587
|
|
|
|
|
|
|
} |
1588
|
0
|
|
|
|
|
0
|
$step = [$step]; |
1589
|
0
|
|
|
|
|
0
|
while ($c->_acmp($step, $n) <= 0) { |
1590
|
0
|
0
|
|
|
|
0
|
if ($cx->[0] == 0) { |
1591
|
0
|
|
|
|
|
0
|
$zero_elements ++; |
1592
|
0
|
|
|
|
|
0
|
shift @$cx; |
1593
|
|
|
|
|
|
|
} |
1594
|
0
|
|
|
|
|
0
|
$c->_mul($cx, $step); |
1595
|
0
|
|
|
|
|
0
|
$c->_inc($step); |
1596
|
|
|
|
|
|
|
} |
1597
|
|
|
|
|
|
|
} else { |
1598
|
|
|
|
|
|
|
# Yes, so we can speed it up slightly |
1599
|
|
|
|
|
|
|
|
1600
|
|
|
|
|
|
|
# print "# left over steps $n\n"; |
1601
|
|
|
|
|
|
|
|
1602
|
0
|
|
|
|
|
0
|
my $base_4 = int(sqrt(sqrt($BASE))) - 2; |
1603
|
|
|
|
|
|
|
#print STDERR "base_4: $base_4\n"; |
1604
|
0
|
|
|
|
|
0
|
my $n4 = $n - 4; |
1605
|
0
|
|
0
|
|
|
0
|
while ($step < $n4 && $step < $base_4) { |
1606
|
0
|
0
|
|
|
|
0
|
if ($cx->[0] == 0) { |
1607
|
0
|
|
|
|
|
0
|
$zero_elements ++; |
1608
|
0
|
|
|
|
|
0
|
shift @$cx; |
1609
|
|
|
|
|
|
|
} |
1610
|
0
|
|
|
|
|
0
|
my $b = $step * ($step + 1); |
1611
|
0
|
|
|
|
|
0
|
$step += 2; |
1612
|
0
|
|
|
|
|
0
|
$b *= $step * ($step + 1); |
1613
|
0
|
|
|
|
|
0
|
$step += 2; |
1614
|
0
|
|
|
|
|
0
|
$c->_mul($cx, [$b]); |
1615
|
|
|
|
|
|
|
} |
1616
|
0
|
|
|
|
|
0
|
my $base_2 = int(sqrt($BASE)) - 1; |
1617
|
0
|
|
|
|
|
0
|
my $n2 = $n - 2; |
1618
|
|
|
|
|
|
|
#print STDERR "base_2: $base_2\n"; |
1619
|
0
|
|
0
|
|
|
0
|
while ($step < $n2 && $step < $base_2) { |
1620
|
0
|
0
|
|
|
|
0
|
if ($cx->[0] == 0) { |
1621
|
0
|
|
|
|
|
0
|
$zero_elements ++; |
1622
|
0
|
|
|
|
|
0
|
shift @$cx; |
1623
|
|
|
|
|
|
|
} |
1624
|
0
|
|
|
|
|
0
|
my $b = $step * ($step + 1); |
1625
|
0
|
|
|
|
|
0
|
$step += 2; |
1626
|
0
|
|
|
|
|
0
|
$c->_mul($cx, [$b]); |
1627
|
|
|
|
|
|
|
} |
1628
|
|
|
|
|
|
|
# do what's left over |
1629
|
0
|
|
|
|
|
0
|
while ($step <= $n) { |
1630
|
0
|
|
|
|
|
0
|
$c->_mul($cx, [$step]); |
1631
|
0
|
|
|
|
|
0
|
$step++; |
1632
|
0
|
0
|
|
|
|
0
|
if ($cx->[0] == 0) { |
1633
|
0
|
|
|
|
|
0
|
$zero_elements ++; |
1634
|
0
|
|
|
|
|
0
|
shift @$cx; |
1635
|
|
|
|
|
|
|
} |
1636
|
|
|
|
|
|
|
} |
1637
|
|
|
|
|
|
|
} |
1638
|
|
|
|
|
|
|
# multiply in the zeros again |
1639
|
0
|
|
|
|
|
0
|
unshift @$cx, (0) x $zero_elements; |
1640
|
0
|
|
|
|
|
0
|
$cx; # return result |
1641
|
|
|
|
|
|
|
} |
1642
|
|
|
|
|
|
|
|
1643
|
|
|
|
|
|
|
sub _log_int { |
1644
|
|
|
|
|
|
|
# calculate integer log of $x to base $base |
1645
|
|
|
|
|
|
|
# ref to array, ref to array - return ref to array |
1646
|
85
|
|
|
85
|
|
182
|
my ($c, $x, $base) = @_; |
1647
|
|
|
|
|
|
|
|
1648
|
|
|
|
|
|
|
# X == 0 => NaN |
1649
|
85
|
50
|
66
|
|
|
335
|
return if @$x == 1 && $x->[0] == 0; |
1650
|
|
|
|
|
|
|
|
1651
|
|
|
|
|
|
|
# BASE 0 or 1 => NaN |
1652
|
85
|
50
|
66
|
|
|
326
|
return if @$base == 1 && $base->[0] < 2; |
1653
|
|
|
|
|
|
|
|
1654
|
|
|
|
|
|
|
# X == 1 => 0 (is exact) |
1655
|
85
|
50
|
66
|
|
|
255
|
if (@$x == 1 && $x->[0] == 1) { |
1656
|
0
|
|
|
|
|
0
|
@$x = 0; |
1657
|
0
|
|
|
|
|
0
|
return $x, 1; |
1658
|
|
|
|
|
|
|
} |
1659
|
|
|
|
|
|
|
|
1660
|
85
|
|
|
|
|
196
|
my $cmp = $c->_acmp($x, $base); |
1661
|
|
|
|
|
|
|
|
1662
|
|
|
|
|
|
|
# X == BASE => 1 (is exact) |
1663
|
85
|
50
|
|
|
|
193
|
if ($cmp == 0) { |
1664
|
0
|
|
|
|
|
0
|
@$x = 1; |
1665
|
0
|
|
|
|
|
0
|
return $x, 1; |
1666
|
|
|
|
|
|
|
} |
1667
|
|
|
|
|
|
|
|
1668
|
|
|
|
|
|
|
# 1 < X < BASE => 0 (is truncated) |
1669
|
85
|
100
|
|
|
|
208
|
if ($cmp < 0) { |
1670
|
4
|
|
|
|
|
18
|
@$x = 0; |
1671
|
4
|
|
|
|
|
24
|
return $x, 0; |
1672
|
|
|
|
|
|
|
} |
1673
|
|
|
|
|
|
|
|
1674
|
81
|
|
|
|
|
192
|
my $x_org = $c->_copy($x); # preserve x |
1675
|
|
|
|
|
|
|
|
1676
|
|
|
|
|
|
|
# Compute a guess for the result based on: |
1677
|
|
|
|
|
|
|
# $guess = int ( length_in_base_10(X) / ( log(base) / log(10) ) ) |
1678
|
81
|
|
|
|
|
212
|
my $len = $c->_len($x_org); |
1679
|
81
|
|
|
|
|
308
|
my $log = log($base->[-1]) / log(10); |
1680
|
|
|
|
|
|
|
|
1681
|
|
|
|
|
|
|
# for each additional element in $base, we add $BASE_LEN to the result, |
1682
|
|
|
|
|
|
|
# based on the observation that log($BASE, 10) is BASE_LEN and |
1683
|
|
|
|
|
|
|
# log(x*y) == log(x) + log(y): |
1684
|
81
|
|
|
|
|
175
|
$log += (@$base - 1) * $BASE_LEN; |
1685
|
|
|
|
|
|
|
|
1686
|
|
|
|
|
|
|
# calculate now a guess based on the values obtained above: |
1687
|
81
|
|
|
|
|
267
|
my $res = $c->_new(int($len / $log)); |
1688
|
|
|
|
|
|
|
|
1689
|
81
|
|
|
|
|
263
|
@$x = @$res; |
1690
|
81
|
|
|
|
|
181
|
my $trial = $c->_pow($c->_copy($base), $x); |
1691
|
81
|
|
|
|
|
213
|
my $acmp = $c->_acmp($trial, $x_org); |
1692
|
|
|
|
|
|
|
|
1693
|
|
|
|
|
|
|
# Did we get the exact result? |
1694
|
|
|
|
|
|
|
|
1695
|
81
|
100
|
|
|
|
289
|
return $x, 1 if $acmp == 0; |
1696
|
|
|
|
|
|
|
|
1697
|
|
|
|
|
|
|
# Too small? |
1698
|
|
|
|
|
|
|
|
1699
|
64
|
|
|
|
|
170
|
while ($acmp < 0) { |
1700
|
7
|
|
|
|
|
44
|
$c->_mul($trial, $base); |
1701
|
7
|
|
|
|
|
38
|
$c->_inc($x); |
1702
|
7
|
|
|
|
|
21
|
$acmp = $c->_acmp($trial, $x_org); |
1703
|
|
|
|
|
|
|
} |
1704
|
|
|
|
|
|
|
|
1705
|
|
|
|
|
|
|
# Too big? |
1706
|
|
|
|
|
|
|
|
1707
|
64
|
|
|
|
|
129
|
while ($acmp > 0) { |
1708
|
81
|
|
|
|
|
218
|
$c->_div($trial, $base); |
1709
|
81
|
|
|
|
|
232
|
$c->_dec($x); |
1710
|
81
|
|
|
|
|
166
|
$acmp = $c->_acmp($trial, $x_org); |
1711
|
|
|
|
|
|
|
} |
1712
|
|
|
|
|
|
|
|
1713
|
64
|
100
|
|
|
|
265
|
return $x, 1 if $acmp == 0; # result is exact |
1714
|
19
|
|
|
|
|
86
|
return $x, 0; # result is too small |
1715
|
|
|
|
|
|
|
} |
1716
|
|
|
|
|
|
|
|
1717
|
|
|
|
|
|
|
# for debugging: |
1718
|
51
|
|
|
51
|
|
270762
|
use constant DEBUG => 0; |
|
51
|
|
|
|
|
127
|
|
|
51
|
|
|
|
|
80837
|
|
1719
|
|
|
|
|
|
|
my $steps = 0; |
1720
|
0
|
|
|
0
|
0
|
0
|
sub steps { $steps }; |
1721
|
|
|
|
|
|
|
|
1722
|
|
|
|
|
|
|
sub _sqrt { |
1723
|
|
|
|
|
|
|
# square-root of $x in-place |
1724
|
|
|
|
|
|
|
|
1725
|
932
|
|
|
932
|
|
1981
|
my ($c, $x) = @_; |
1726
|
|
|
|
|
|
|
|
1727
|
932
|
100
|
|
|
|
2122
|
if (@$x == 1) { |
1728
|
|
|
|
|
|
|
# fits into one Perl scalar, so result can be computed directly |
1729
|
292
|
|
|
|
|
965
|
$x->[0] = int(sqrt($x->[0])); |
1730
|
292
|
|
|
|
|
858
|
return $x; |
1731
|
|
|
|
|
|
|
} |
1732
|
|
|
|
|
|
|
|
1733
|
|
|
|
|
|
|
# Create an initial guess for the square root. |
1734
|
|
|
|
|
|
|
|
1735
|
640
|
|
|
|
|
1009
|
my $s; |
1736
|
640
|
100
|
|
|
|
1516
|
if (@$x % 2) { |
1737
|
225
|
|
|
|
|
1012
|
$s = [ (0) x ((@$x - 1) / 2), int(sqrt($x->[-1])) ]; |
1738
|
|
|
|
|
|
|
} else { |
1739
|
415
|
|
|
|
|
1918
|
$s = [ (0) x ((@$x - 2) / 2), int(sqrt($x->[-2] + $x->[-1] * $BASE)) ]; |
1740
|
|
|
|
|
|
|
} |
1741
|
|
|
|
|
|
|
|
1742
|
|
|
|
|
|
|
# Newton's method for the square root of y: |
1743
|
|
|
|
|
|
|
# |
1744
|
|
|
|
|
|
|
# x(n) * x(n) - y |
1745
|
|
|
|
|
|
|
# x(n+1) = x(n) - ----------------- |
1746
|
|
|
|
|
|
|
# 2 * x(n) |
1747
|
|
|
|
|
|
|
|
1748
|
640
|
|
|
|
|
1191
|
my $cmp; |
1749
|
640
|
|
|
|
|
942
|
while (1) { |
1750
|
1999
|
|
|
|
|
4490
|
my $sq = $c -> _mul($c -> _copy($s), $s); |
1751
|
1999
|
|
|
|
|
4662
|
$cmp = $c -> _acmp($sq, $x); |
1752
|
|
|
|
|
|
|
|
1753
|
|
|
|
|
|
|
# If x(n)*x(n) > y, compute |
1754
|
|
|
|
|
|
|
# |
1755
|
|
|
|
|
|
|
# x(n) * x(n) - y |
1756
|
|
|
|
|
|
|
# x(n+1) = x(n) - ----------------- |
1757
|
|
|
|
|
|
|
# 2 * x(n) |
1758
|
|
|
|
|
|
|
|
1759
|
1999
|
100
|
|
|
|
4931
|
if ($cmp > 0) { |
|
|
100
|
|
|
|
|
|
1760
|
1352
|
|
|
|
|
3105
|
my $num = $c -> _sub($c -> _copy($sq), $x); |
1761
|
1352
|
|
|
|
|
3498
|
my $den = $c -> _mul($c -> _two(), $s); |
1762
|
1352
|
|
|
|
|
3529
|
my $delta = $c -> _div($num, $den); |
1763
|
1352
|
100
|
|
|
|
3193
|
last if $c -> _is_zero($delta); |
1764
|
934
|
|
|
|
|
2168
|
$s = $c -> _sub($s, $delta); |
1765
|
|
|
|
|
|
|
} |
1766
|
|
|
|
|
|
|
|
1767
|
|
|
|
|
|
|
# If x(n)*x(n) < y, compute |
1768
|
|
|
|
|
|
|
# |
1769
|
|
|
|
|
|
|
# y - x(n) * x(n) |
1770
|
|
|
|
|
|
|
# x(n+1) = x(n) + ----------------- |
1771
|
|
|
|
|
|
|
# 2 * x(n) |
1772
|
|
|
|
|
|
|
|
1773
|
|
|
|
|
|
|
elsif ($cmp < 0) { |
1774
|
538
|
|
|
|
|
1319
|
my $num = $c -> _sub($c -> _copy($x), $sq); |
1775
|
538
|
|
|
|
|
1801
|
my $den = $c -> _mul($c -> _two(), $s); |
1776
|
538
|
|
|
|
|
1679
|
my $delta = $c -> _div($num, $den); |
1777
|
538
|
100
|
|
|
|
1477
|
last if $c -> _is_zero($delta); |
1778
|
425
|
|
|
|
|
1213
|
$s = $c -> _add($s, $delta); |
1779
|
|
|
|
|
|
|
} |
1780
|
|
|
|
|
|
|
|
1781
|
|
|
|
|
|
|
# If x(n)*x(n) = y, we have the exact result. |
1782
|
|
|
|
|
|
|
|
1783
|
|
|
|
|
|
|
else { |
1784
|
109
|
|
|
|
|
270
|
last; |
1785
|
|
|
|
|
|
|
} |
1786
|
|
|
|
|
|
|
} |
1787
|
|
|
|
|
|
|
|
1788
|
640
|
100
|
|
|
|
2350
|
$s = $c -> _dec($s) if $cmp > 0; # never overshoot |
1789
|
640
|
|
|
|
|
1657
|
@$x = @$s; |
1790
|
640
|
|
|
|
|
1916
|
return $x; |
1791
|
|
|
|
|
|
|
} |
1792
|
|
|
|
|
|
|
|
1793
|
|
|
|
|
|
|
sub _root { |
1794
|
|
|
|
|
|
|
# Take n'th root of $x in place. |
1795
|
|
|
|
|
|
|
|
1796
|
109
|
|
|
109
|
|
476
|
my ($c, $x, $n) = @_; |
1797
|
|
|
|
|
|
|
|
1798
|
|
|
|
|
|
|
# Small numbers. |
1799
|
|
|
|
|
|
|
|
1800
|
109
|
100
|
|
|
|
279
|
if (@$x == 1) { |
1801
|
68
|
50
|
33
|
|
|
335
|
return $x if $x -> [0] == 0 || $x -> [0] == 1; |
1802
|
|
|
|
|
|
|
|
1803
|
68
|
50
|
|
|
|
158
|
if (@$n == 1) { |
1804
|
|
|
|
|
|
|
# Result can be computed directly. Adjust initial result for |
1805
|
|
|
|
|
|
|
# numerical errors, e.g., int(1000**(1/3)) is 2, not 3. |
1806
|
68
|
|
|
|
|
382
|
my $y = int($x->[0] ** (1 / $n->[0])); |
1807
|
68
|
|
|
|
|
135
|
my $yp1 = $y + 1; |
1808
|
68
|
100
|
|
|
|
199
|
$y = $yp1 if $yp1 ** $n->[0] == $x->[0]; |
1809
|
68
|
|
|
|
|
115
|
$x->[0] = $y; |
1810
|
68
|
|
|
|
|
224
|
return $x; |
1811
|
|
|
|
|
|
|
} |
1812
|
|
|
|
|
|
|
} |
1813
|
|
|
|
|
|
|
|
1814
|
|
|
|
|
|
|
# If x <= n, the result is always (truncated to) 1. |
1815
|
|
|
|
|
|
|
|
1816
|
41
|
50
|
33
|
|
|
229
|
if ((@$x > 1 || $x -> [0] > 0) && # if x is non-zero ... |
|
|
|
33
|
|
|
|
|
1817
|
|
|
|
|
|
|
$c -> _acmp($x, $n) <= 0) # ... and x <= n |
1818
|
|
|
|
|
|
|
{ |
1819
|
0
|
|
|
|
|
0
|
my $one = $c -> _one(); |
1820
|
0
|
|
|
|
|
0
|
@$x = @$one; |
1821
|
0
|
|
|
|
|
0
|
return $x; |
1822
|
|
|
|
|
|
|
} |
1823
|
|
|
|
|
|
|
|
1824
|
|
|
|
|
|
|
# If $n is a power of two, take sqrt($x) repeatedly, e.g., root($x, 4) = |
1825
|
|
|
|
|
|
|
# sqrt(sqrt($x)), root($x, 8) = sqrt(sqrt(sqrt($x))). |
1826
|
|
|
|
|
|
|
|
1827
|
41
|
|
|
|
|
160
|
my $b = $c -> _as_bin($n); |
1828
|
41
|
100
|
|
|
|
247
|
if ($b =~ /0b1(0+)$/) { |
1829
|
24
|
|
|
|
|
78
|
my $count = length($1); # 0b100 => len('00') => 2 |
1830
|
24
|
|
|
|
|
50
|
my $cnt = $count; # counter for loop |
1831
|
24
|
|
|
|
|
69
|
unshift @$x, 0; # add one element, together with one |
1832
|
|
|
|
|
|
|
# more below in the loop this makes 2 |
1833
|
24
|
|
|
|
|
65
|
while ($cnt-- > 0) { |
1834
|
|
|
|
|
|
|
# 'Inflate' $x by adding one element, basically computing |
1835
|
|
|
|
|
|
|
# $x * $BASE * $BASE. This gives us more $BASE_LEN digits for |
1836
|
|
|
|
|
|
|
# result since len(sqrt($X)) approx == len($x) / 2. |
1837
|
99
|
|
|
|
|
163
|
unshift @$x, 0; |
1838
|
|
|
|
|
|
|
# Calculate sqrt($x), $x is now one element to big, again. In the |
1839
|
|
|
|
|
|
|
# next round we make that two, again. |
1840
|
99
|
|
|
|
|
237
|
$c -> _sqrt($x); |
1841
|
|
|
|
|
|
|
} |
1842
|
|
|
|
|
|
|
|
1843
|
|
|
|
|
|
|
# $x is now one element too big, so truncate result by removing it. |
1844
|
24
|
|
|
|
|
40
|
shift @$x; |
1845
|
|
|
|
|
|
|
|
1846
|
24
|
|
|
|
|
89
|
return $x; |
1847
|
|
|
|
|
|
|
} |
1848
|
|
|
|
|
|
|
|
1849
|
17
|
|
|
|
|
42
|
my $DEBUG = 0; |
1850
|
|
|
|
|
|
|
|
1851
|
|
|
|
|
|
|
# Now the general case. This works by finding an initial guess. If this |
1852
|
|
|
|
|
|
|
# guess is incorrect, a relatively small delta is chosen. This delta is |
1853
|
|
|
|
|
|
|
# used to find a lower and upper limit for the correct value. The delta is |
1854
|
|
|
|
|
|
|
# doubled in each iteration. When a lower and upper limit is found, |
1855
|
|
|
|
|
|
|
# bisection is applied to narrow down the region until we have the correct |
1856
|
|
|
|
|
|
|
# value. |
1857
|
|
|
|
|
|
|
|
1858
|
|
|
|
|
|
|
# Split x into mantissa and exponent in base 10, so that |
1859
|
|
|
|
|
|
|
# |
1860
|
|
|
|
|
|
|
# x = xm * 10^xe, where 0 < xm < 1 and xe is an integer |
1861
|
|
|
|
|
|
|
|
1862
|
17
|
|
|
|
|
58
|
my $x_str = $c -> _str($x); |
1863
|
17
|
|
|
|
|
74
|
my $xm = "." . $x_str; |
1864
|
17
|
|
|
|
|
37
|
my $xe = length($x_str); |
1865
|
|
|
|
|
|
|
|
1866
|
|
|
|
|
|
|
# From this we compute the base 10 logarithm of x |
1867
|
|
|
|
|
|
|
# |
1868
|
|
|
|
|
|
|
# log_10(x) = log_10(xm) + log_10(xe^10) |
1869
|
|
|
|
|
|
|
# = log(xm)/log(10) + xe |
1870
|
|
|
|
|
|
|
# |
1871
|
|
|
|
|
|
|
# and then the base 10 logarithm of y, where y = x^(1/n) |
1872
|
|
|
|
|
|
|
# |
1873
|
|
|
|
|
|
|
# log_10(y) = log_10(x)/n |
1874
|
|
|
|
|
|
|
|
1875
|
17
|
|
|
|
|
150
|
my $log10x = log($xm) / log(10) + $xe; |
1876
|
17
|
|
|
|
|
56
|
my $log10y = $log10x / $c -> _num($n); |
1877
|
|
|
|
|
|
|
|
1878
|
|
|
|
|
|
|
# And from this we compute ym and ye, the mantissa and exponent (in |
1879
|
|
|
|
|
|
|
# base 10) of y, where 1 < ym <= 10 and ye is an integer. |
1880
|
|
|
|
|
|
|
|
1881
|
17
|
|
|
|
|
47
|
my $ye = int $log10y; |
1882
|
17
|
|
|
|
|
79
|
my $ym = 10 ** ($log10y - $ye); |
1883
|
|
|
|
|
|
|
|
1884
|
|
|
|
|
|
|
# Finally, we scale the mantissa and exponent to incraese the integer |
1885
|
|
|
|
|
|
|
# part of ym, before building the string representing our guess of y. |
1886
|
|
|
|
|
|
|
|
1887
|
17
|
50
|
|
|
|
54
|
if ($DEBUG) { |
1888
|
0
|
|
|
|
|
0
|
print "\n"; |
1889
|
0
|
|
|
|
|
0
|
print "xm = $xm\n"; |
1890
|
0
|
|
|
|
|
0
|
print "xe = $xe\n"; |
1891
|
0
|
|
|
|
|
0
|
print "log10x = $log10x\n"; |
1892
|
0
|
|
|
|
|
0
|
print "log10y = $log10y\n"; |
1893
|
0
|
|
|
|
|
0
|
print "ym = $ym\n"; |
1894
|
0
|
|
|
|
|
0
|
print "ye = $ye\n"; |
1895
|
0
|
|
|
|
|
0
|
print "\n"; |
1896
|
|
|
|
|
|
|
} |
1897
|
|
|
|
|
|
|
|
1898
|
17
|
50
|
|
|
|
61
|
my $d = $ye < 15 ? $ye : 15; |
1899
|
17
|
|
|
|
|
40
|
$ym *= 10 ** $d; |
1900
|
17
|
|
|
|
|
34
|
$ye -= $d; |
1901
|
|
|
|
|
|
|
|
1902
|
17
|
|
|
|
|
78
|
my $y_str = sprintf('%.0f', $ym) . "0" x $ye; |
1903
|
17
|
|
|
|
|
71
|
my $y = $c -> _new($y_str); |
1904
|
|
|
|
|
|
|
|
1905
|
17
|
50
|
|
|
|
58
|
if ($DEBUG) { |
1906
|
0
|
|
|
|
|
0
|
print "ym = $ym\n"; |
1907
|
0
|
|
|
|
|
0
|
print "ye = $ye\n"; |
1908
|
0
|
|
|
|
|
0
|
print "\n"; |
1909
|
0
|
|
|
|
|
0
|
print "y_str = $y_str (initial guess)\n"; |
1910
|
0
|
|
|
|
|
0
|
print "\n"; |
1911
|
|
|
|
|
|
|
} |
1912
|
|
|
|
|
|
|
|
1913
|
|
|
|
|
|
|
# See if our guess y is correct. |
1914
|
|
|
|
|
|
|
|
1915
|
17
|
|
|
|
|
56
|
my $trial = $c -> _pow($c -> _copy($y), $n); |
1916
|
17
|
|
|
|
|
61
|
my $acmp = $c -> _acmp($trial, $x); |
1917
|
|
|
|
|
|
|
|
1918
|
17
|
100
|
|
|
|
130
|
if ($acmp == 0) { |
1919
|
5
|
|
|
|
|
28
|
@$x = @$y; |
1920
|
5
|
|
|
|
|
26
|
return $x; |
1921
|
|
|
|
|
|
|
} |
1922
|
|
|
|
|
|
|
|
1923
|
|
|
|
|
|
|
# Find a lower and upper limit for the correct value of y. Start off with a |
1924
|
|
|
|
|
|
|
# delta value that is approximately the size of the accuracy of the guess. |
1925
|
|
|
|
|
|
|
|
1926
|
12
|
|
|
|
|
29
|
my $lower; |
1927
|
|
|
|
|
|
|
my $upper; |
1928
|
|
|
|
|
|
|
|
1929
|
12
|
|
|
|
|
82
|
my $delta = $c -> _new("1" . ("0" x $ye)); |
1930
|
12
|
|
|
|
|
71
|
my $two = $c -> _two(); |
1931
|
|
|
|
|
|
|
|
1932
|
12
|
100
|
|
|
|
66
|
if ($acmp < 0) { |
|
|
50
|
|
|
|
|
|
1933
|
7
|
|
|
|
|
28
|
$lower = $y; |
1934
|
7
|
|
|
|
|
30
|
while ($acmp < 0) { |
1935
|
7
|
|
|
|
|
20
|
$upper = $c -> _add($c -> _copy($lower), $delta); |
1936
|
|
|
|
|
|
|
|
1937
|
7
|
50
|
|
|
|
30
|
if ($DEBUG) { |
1938
|
0
|
|
|
|
|
0
|
print "lower = $lower\n"; |
1939
|
0
|
|
|
|
|
0
|
print "upper = $upper\n"; |
1940
|
0
|
|
|
|
|
0
|
print "delta = $delta\n"; |
1941
|
0
|
|
|
|
|
0
|
print "\n"; |
1942
|
|
|
|
|
|
|
} |
1943
|
7
|
|
|
|
|
24
|
$acmp = $c -> _acmp($c -> _pow($c -> _copy($upper), $n), $x); |
1944
|
7
|
50
|
|
|
|
46
|
if ($acmp == 0) { |
1945
|
0
|
|
|
|
|
0
|
@$x = @$upper; |
1946
|
0
|
|
|
|
|
0
|
return $x; |
1947
|
|
|
|
|
|
|
} |
1948
|
7
|
|
|
|
|
23
|
$delta = $c -> _mul($delta, $two); |
1949
|
|
|
|
|
|
|
} |
1950
|
|
|
|
|
|
|
} |
1951
|
|
|
|
|
|
|
|
1952
|
|
|
|
|
|
|
elsif ($acmp > 0) { |
1953
|
5
|
|
|
|
|
10
|
$upper = $y; |
1954
|
5
|
|
|
|
|
19
|
while ($acmp > 0) { |
1955
|
5
|
50
|
|
|
|
12
|
if ($c -> _acmp($upper, $delta) <= 0) { |
1956
|
0
|
|
|
|
|
0
|
$lower = $c -> _zero(); |
1957
|
0
|
|
|
|
|
0
|
last; |
1958
|
|
|
|
|
|
|
} |
1959
|
5
|
|
|
|
|
22
|
$lower = $c -> _sub($c -> _copy($upper), $delta); |
1960
|
|
|
|
|
|
|
|
1961
|
5
|
50
|
|
|
|
26
|
if ($DEBUG) { |
1962
|
0
|
|
|
|
|
0
|
print "lower = $lower\n"; |
1963
|
0
|
|
|
|
|
0
|
print "upper = $upper\n"; |
1964
|
0
|
|
|
|
|
0
|
print "delta = $delta\n"; |
1965
|
0
|
|
|
|
|
0
|
print "\n"; |
1966
|
|
|
|
|
|
|
} |
1967
|
5
|
|
|
|
|
19
|
$acmp = $c -> _acmp($c -> _pow($c -> _copy($lower), $n), $x); |
1968
|
5
|
50
|
|
|
|
30
|
if ($acmp == 0) { |
1969
|
0
|
|
|
|
|
0
|
@$x = @$lower; |
1970
|
0
|
|
|
|
|
0
|
return $x; |
1971
|
|
|
|
|
|
|
} |
1972
|
5
|
|
|
|
|
30
|
$delta = $c -> _mul($delta, $two); |
1973
|
|
|
|
|
|
|
} |
1974
|
|
|
|
|
|
|
} |
1975
|
|
|
|
|
|
|
|
1976
|
|
|
|
|
|
|
# Use bisection to narrow down the interval. |
1977
|
|
|
|
|
|
|
|
1978
|
12
|
|
|
|
|
40
|
my $one = $c -> _one(); |
1979
|
|
|
|
|
|
|
{ |
1980
|
|
|
|
|
|
|
|
1981
|
12
|
|
|
|
|
20
|
$delta = $c -> _sub($c -> _copy($upper), $lower); |
|
12
|
|
|
|
|
47
|
|
1982
|
12
|
50
|
|
|
|
75
|
if ($c -> _acmp($delta, $one) <= 0) { |
1983
|
12
|
|
|
|
|
43
|
@$x = @$lower; |
1984
|
12
|
|
|
|
|
72
|
return $x; |
1985
|
|
|
|
|
|
|
} |
1986
|
|
|
|
|
|
|
|
1987
|
0
|
0
|
|
|
|
0
|
if ($DEBUG) { |
1988
|
0
|
|
|
|
|
0
|
print "lower = $lower\n"; |
1989
|
0
|
|
|
|
|
0
|
print "upper = $upper\n"; |
1990
|
0
|
|
|
|
|
0
|
print "delta = $delta\n"; |
1991
|
0
|
|
|
|
|
0
|
print "\n"; |
1992
|
|
|
|
|
|
|
} |
1993
|
|
|
|
|
|
|
|
1994
|
0
|
|
|
|
|
0
|
$delta = $c -> _div($delta, $two); |
1995
|
0
|
|
|
|
|
0
|
my $middle = $c -> _add($c -> _copy($lower), $delta); |
1996
|
|
|
|
|
|
|
|
1997
|
0
|
|
|
|
|
0
|
$acmp = $c -> _acmp($c -> _pow($c -> _copy($middle), $n), $x); |
1998
|
0
|
0
|
|
|
|
0
|
if ($acmp < 0) { |
|
|
0
|
|
|
|
|
|
1999
|
0
|
|
|
|
|
0
|
$lower = $middle; |
2000
|
|
|
|
|
|
|
} elsif ($acmp > 0) { |
2001
|
0
|
|
|
|
|
0
|
$upper = $middle; |
2002
|
|
|
|
|
|
|
} else { |
2003
|
0
|
|
|
|
|
0
|
@$x = @$middle; |
2004
|
0
|
|
|
|
|
0
|
return $x; |
2005
|
|
|
|
|
|
|
} |
2006
|
|
|
|
|
|
|
|
2007
|
0
|
|
|
|
|
0
|
redo; |
2008
|
|
|
|
|
|
|
} |
2009
|
|
|
|
|
|
|
|
2010
|
0
|
|
|
|
|
0
|
$x; |
2011
|
|
|
|
|
|
|
} |
2012
|
|
|
|
|
|
|
|
2013
|
|
|
|
|
|
|
############################################################################## |
2014
|
|
|
|
|
|
|
# binary stuff |
2015
|
|
|
|
|
|
|
|
2016
|
|
|
|
|
|
|
sub _and { |
2017
|
130
|
|
|
130
|
|
304
|
my ($c, $x, $y) = @_; |
2018
|
|
|
|
|
|
|
|
2019
|
|
|
|
|
|
|
# the shortcut makes equal, large numbers _really_ fast, and makes only a |
2020
|
|
|
|
|
|
|
# very small performance drop for small numbers (e.g. something with less |
2021
|
|
|
|
|
|
|
# than 32 bit) Since we optimize for large numbers, this is enabled. |
2022
|
130
|
100
|
|
|
|
377
|
return $x if $c->_acmp($x, $y) == 0; # shortcut |
2023
|
|
|
|
|
|
|
|
2024
|
66
|
|
|
|
|
210
|
my $m = $c->_one(); |
2025
|
66
|
|
|
|
|
130
|
my ($xr, $yr); |
2026
|
66
|
|
|
|
|
151
|
my $mask = $AND_MASK; |
2027
|
|
|
|
|
|
|
|
2028
|
66
|
|
|
|
|
162
|
my $x1 = $c->_copy($x); |
2029
|
66
|
|
|
|
|
205
|
my $y1 = $c->_copy($y); |
2030
|
66
|
|
|
|
|
173
|
my $z = $c->_zero(); |
2031
|
|
|
|
|
|
|
|
2032
|
51
|
|
|
51
|
|
516
|
use integer; |
|
51
|
|
|
|
|
118
|
|
|
51
|
|
|
|
|
290
|
|
2033
|
66
|
|
100
|
|
|
196
|
until ($c->_is_zero($x1) || $c->_is_zero($y1)) { |
2034
|
53
|
|
|
|
|
182
|
($x1, $xr) = $c->_div($x1, $mask); |
2035
|
53
|
|
|
|
|
151
|
($y1, $yr) = $c->_div($y1, $mask); |
2036
|
|
|
|
|
|
|
|
2037
|
53
|
|
|
|
|
309
|
$c->_add($z, $c->_mul([ 0 + $xr->[0] & 0 + $yr->[0] ], $m)); |
2038
|
53
|
|
|
|
|
225
|
$c->_mul($m, $mask); |
2039
|
|
|
|
|
|
|
} |
2040
|
|
|
|
|
|
|
|
2041
|
66
|
|
|
|
|
207
|
@$x = @$z; |
2042
|
66
|
|
|
|
|
273
|
return $x; |
2043
|
|
|
|
|
|
|
} |
2044
|
|
|
|
|
|
|
|
2045
|
|
|
|
|
|
|
sub _xor { |
2046
|
194
|
|
|
194
|
|
460
|
my ($c, $x, $y) = @_; |
2047
|
|
|
|
|
|
|
|
2048
|
194
|
100
|
|
|
|
522
|
return $c->_zero() if $c->_acmp($x, $y) == 0; # shortcut (see -and) |
2049
|
|
|
|
|
|
|
|
2050
|
130
|
|
|
|
|
377
|
my $m = $c->_one(); |
2051
|
130
|
|
|
|
|
232
|
my ($xr, $yr); |
2052
|
130
|
|
|
|
|
204
|
my $mask = $XOR_MASK; |
2053
|
|
|
|
|
|
|
|
2054
|
130
|
|
|
|
|
303
|
my $x1 = $c->_copy($x); |
2055
|
130
|
|
|
|
|
276
|
my $y1 = $c->_copy($y); # make copy |
2056
|
130
|
|
|
|
|
309
|
my $z = $c->_zero(); |
2057
|
|
|
|
|
|
|
|
2058
|
51
|
|
|
51
|
|
11363
|
use integer; |
|
51
|
|
|
|
|
173
|
|
|
51
|
|
|
|
|
291
|
|
2059
|
130
|
|
100
|
|
|
351
|
until ($c->_is_zero($x1) || $c->_is_zero($y1)) { |
2060
|
81
|
|
|
|
|
281
|
($x1, $xr) = $c->_div($x1, $mask); |
2061
|
81
|
|
|
|
|
352
|
($y1, $yr) = $c->_div($y1, $mask); |
2062
|
|
|
|
|
|
|
# make ints() from $xr, $yr (see _and()) |
2063
|
|
|
|
|
|
|
#$b = 1; $xrr = 0; foreach (@$xr) { $xrr += $_ * $b; $b *= $BASE; } |
2064
|
|
|
|
|
|
|
#$b = 1; $yrr = 0; foreach (@$yr) { $yrr += $_ * $b; $b *= $BASE; } |
2065
|
|
|
|
|
|
|
#$c->_add($x, $c->_mul($c->_new($xrr ^ $yrr)), $m) ); |
2066
|
|
|
|
|
|
|
|
2067
|
81
|
|
|
|
|
383
|
$c->_add($z, $c->_mul([ 0 + $xr->[0] ^ 0 + $yr->[0] ], $m)); |
2068
|
81
|
|
|
|
|
247
|
$c->_mul($m, $mask); |
2069
|
|
|
|
|
|
|
} |
2070
|
|
|
|
|
|
|
# the loop stops when the shorter of the two numbers is exhausted |
2071
|
|
|
|
|
|
|
# the remainder of the longer one will survive bit-by-bit, so we simple |
2072
|
|
|
|
|
|
|
# multiply-add it in |
2073
|
130
|
100
|
|
|
|
341
|
$c->_add($z, $c->_mul($x1, $m) ) if !$c->_is_zero($x1); |
2074
|
130
|
100
|
|
|
|
300
|
$c->_add($z, $c->_mul($y1, $m) ) if !$c->_is_zero($y1); |
2075
|
|
|
|
|
|
|
|
2076
|
130
|
|
|
|
|
306
|
@$x = @$z; |
2077
|
130
|
|
|
|
|
522
|
return $x; |
2078
|
|
|
|
|
|
|
} |
2079
|
|
|
|
|
|
|
|
2080
|
|
|
|
|
|
|
sub _or { |
2081
|
189
|
|
|
189
|
|
442
|
my ($c, $x, $y) = @_; |
2082
|
|
|
|
|
|
|
|
2083
|
189
|
100
|
|
|
|
541
|
return $x if $c->_acmp($x, $y) == 0; # shortcut (see _and) |
2084
|
|
|
|
|
|
|
|
2085
|
125
|
|
|
|
|
372
|
my $m = $c->_one(); |
2086
|
125
|
|
|
|
|
243
|
my ($xr, $yr); |
2087
|
125
|
|
|
|
|
199
|
my $mask = $OR_MASK; |
2088
|
|
|
|
|
|
|
|
2089
|
125
|
|
|
|
|
296
|
my $x1 = $c->_copy($x); |
2090
|
125
|
|
|
|
|
283
|
my $y1 = $c->_copy($y); # make copy |
2091
|
125
|
|
|
|
|
314
|
my $z = $c->_zero(); |
2092
|
|
|
|
|
|
|
|
2093
|
51
|
|
|
51
|
|
12570
|
use integer; |
|
51
|
|
|
|
|
133
|
|
|
51
|
|
|
|
|
304
|
|
2094
|
125
|
|
100
|
|
|
353
|
until ($c->_is_zero($x1) || $c->_is_zero($y1)) { |
2095
|
80
|
|
|
|
|
274
|
($x1, $xr) = $c->_div($x1, $mask); |
2096
|
80
|
|
|
|
|
248
|
($y1, $yr) = $c->_div($y1, $mask); |
2097
|
|
|
|
|
|
|
# make ints() from $xr, $yr (see _and()) |
2098
|
|
|
|
|
|
|
# $b = 1; $xrr = 0; foreach (@$xr) { $xrr += $_ * $b; $b *= $BASE; } |
2099
|
|
|
|
|
|
|
# $b = 1; $yrr = 0; foreach (@$yr) { $yrr += $_ * $b; $b *= $BASE; } |
2100
|
|
|
|
|
|
|
# $c->_add($x, $c->_mul(_new( $c, ($xrr | $yrr) ), $m) ); |
2101
|
80
|
|
|
|
|
407
|
$c->_add($z, $c->_mul([ 0 + $xr->[0] | 0 + $yr->[0] ], $m)); |
2102
|
80
|
|
|
|
|
272
|
$c->_mul($m, $mask); |
2103
|
|
|
|
|
|
|
} |
2104
|
|
|
|
|
|
|
# the loop stops when the shorter of the two numbers is exhausted |
2105
|
|
|
|
|
|
|
# the remainder of the longer one will survive bit-by-bit, so we simple |
2106
|
|
|
|
|
|
|
# multiply-add it in |
2107
|
125
|
100
|
|
|
|
345
|
$c->_add($z, $c->_mul($x1, $m) ) if !$c->_is_zero($x1); |
2108
|
125
|
100
|
|
|
|
286
|
$c->_add($z, $c->_mul($y1, $m) ) if !$c->_is_zero($y1); |
2109
|
|
|
|
|
|
|
|
2110
|
125
|
|
|
|
|
287
|
@$x = @$z; |
2111
|
125
|
|
|
|
|
558
|
return $x; |
2112
|
|
|
|
|
|
|
} |
2113
|
|
|
|
|
|
|
|
2114
|
|
|
|
|
|
|
sub _as_hex { |
2115
|
|
|
|
|
|
|
# convert a decimal number to hex (ref to array, return ref to string) |
2116
|
261
|
|
|
261
|
|
532
|
my ($c, $x) = @_; |
2117
|
|
|
|
|
|
|
|
2118
|
261
|
100
|
100
|
|
|
1057
|
return "0x0" if @$x == 1 && $x->[0] == 0; |
2119
|
|
|
|
|
|
|
|
2120
|
218
|
|
|
|
|
477
|
my $x1 = $c->_copy($x); |
2121
|
|
|
|
|
|
|
|
2122
|
218
|
|
|
|
|
463
|
my $x10000 = [ 0x10000 ]; |
2123
|
|
|
|
|
|
|
|
2124
|
218
|
|
|
|
|
396
|
my $es = ''; |
2125
|
218
|
|
|
|
|
325
|
my $xr; |
2126
|
218
|
|
100
|
|
|
787
|
until (@$x1 == 1 && $x1->[0] == 0) { # _is_zero() |
2127
|
274
|
|
|
|
|
646
|
($x1, $xr) = $c->_div($x1, $x10000); |
2128
|
274
|
|
|
|
|
1686
|
$es = sprintf('%04x', $xr->[0]) . $es; |
2129
|
|
|
|
|
|
|
} |
2130
|
|
|
|
|
|
|
#$es = reverse $es; |
2131
|
218
|
|
|
|
|
850
|
$es =~ s/^0*/0x/; |
2132
|
218
|
|
|
|
|
826
|
return $es; |
2133
|
|
|
|
|
|
|
} |
2134
|
|
|
|
|
|
|
|
2135
|
|
|
|
|
|
|
sub _as_bin { |
2136
|
|
|
|
|
|
|
# convert a decimal number to bin (ref to array, return ref to string) |
2137
|
1144
|
|
|
1144
|
|
2264
|
my ($c, $x) = @_; |
2138
|
|
|
|
|
|
|
|
2139
|
1144
|
100
|
100
|
|
|
4205
|
return "0b0" if @$x == 1 && $x->[0] == 0; |
2140
|
|
|
|
|
|
|
|
2141
|
1095
|
|
|
|
|
2543
|
my $x1 = $c->_copy($x); |
2142
|
|
|
|
|
|
|
|
2143
|
1095
|
|
|
|
|
2131
|
my $x10000 = [ 0x10000 ]; |
2144
|
|
|
|
|
|
|
|
2145
|
1095
|
|
|
|
|
1871
|
my $es = ''; |
2146
|
1095
|
|
|
|
|
1625
|
my $xr; |
2147
|
|
|
|
|
|
|
|
2148
|
1095
|
|
100
|
|
|
4304
|
until (@$x1 == 1 && $x1->[0] == 0) { # _is_zero() |
2149
|
1175
|
|
|
|
|
3043
|
($x1, $xr) = $c->_div($x1, $x10000); |
2150
|
1175
|
|
|
|
|
9103
|
$es = sprintf('%016b', $xr->[0]) . $es; |
2151
|
|
|
|
|
|
|
} |
2152
|
1095
|
|
|
|
|
5211
|
$es =~ s/^0*/0b/; |
2153
|
1095
|
|
|
|
|
3909
|
return $es; |
2154
|
|
|
|
|
|
|
} |
2155
|
|
|
|
|
|
|
|
2156
|
|
|
|
|
|
|
sub _as_oct { |
2157
|
|
|
|
|
|
|
# convert a decimal number to octal (ref to array, return ref to string) |
2158
|
56
|
|
|
56
|
|
132
|
my ($c, $x) = @_; |
2159
|
|
|
|
|
|
|
|
2160
|
56
|
100
|
100
|
|
|
260
|
return "00" if @$x == 1 && $x->[0] == 0; |
2161
|
|
|
|
|
|
|
|
2162
|
46
|
|
|
|
|
132
|
my $x1 = $c->_copy($x); |
2163
|
|
|
|
|
|
|
|
2164
|
46
|
|
|
|
|
105
|
my $x1000 = [ 1 << 15 ]; # 15 bits = 32768 = 0100000 |
2165
|
|
|
|
|
|
|
|
2166
|
46
|
|
|
|
|
84
|
my $es = ''; |
2167
|
46
|
|
|
|
|
104
|
my $xr; |
2168
|
46
|
|
100
|
|
|
211
|
until (@$x1 == 1 && $x1->[0] == 0) { # _is_zero() |
2169
|
104
|
|
|
|
|
264
|
($x1, $xr) = $c->_div($x1, $x1000); |
2170
|
104
|
|
|
|
|
662
|
$es = sprintf("%05o", $xr->[0]) . $es; |
2171
|
|
|
|
|
|
|
} |
2172
|
46
|
|
|
|
|
212
|
$es =~ s/^0*/0/; # excactly one leading zero |
2173
|
46
|
|
|
|
|
223
|
return $es; |
2174
|
|
|
|
|
|
|
} |
2175
|
|
|
|
|
|
|
|
2176
|
|
|
|
|
|
|
sub _from_oct { |
2177
|
|
|
|
|
|
|
# convert a octal number to decimal (string, return ref to array) |
2178
|
13
|
|
|
13
|
|
34
|
my ($c, $os) = @_; |
2179
|
|
|
|
|
|
|
|
2180
|
13
|
|
|
|
|
34
|
my $m = $c->_new(1 << 30); # 30 bits at a time (<32 bits!) |
2181
|
13
|
|
|
|
|
27
|
my $d = 10; # 10 octal digits at a time |
2182
|
|
|
|
|
|
|
|
2183
|
13
|
|
|
|
|
33
|
my $mul = $c->_one(); |
2184
|
13
|
|
|
|
|
30
|
my $x = $c->_zero(); |
2185
|
|
|
|
|
|
|
|
2186
|
13
|
|
|
|
|
39
|
my $len = int((length($os) - 1) / $d); # $d digit parts, w/o the '0' |
2187
|
13
|
|
|
|
|
28
|
my $val; |
2188
|
13
|
|
|
|
|
27
|
my $i = -$d; |
2189
|
13
|
|
|
|
|
52
|
while ($len >= 0) { |
2190
|
20
|
|
|
|
|
51
|
$val = substr($os, $i, $d); # get oct digits |
2191
|
20
|
|
|
|
|
36
|
$val = CORE::oct($val); |
2192
|
20
|
|
|
|
|
32
|
$i -= $d; |
2193
|
20
|
|
|
|
|
28
|
$len --; |
2194
|
20
|
|
|
|
|
47
|
my $adder = $c -> _new($val); |
2195
|
20
|
100
|
|
|
|
68
|
$c->_add($x, $c->_mul($adder, $mul)) if $val != 0; |
2196
|
20
|
100
|
|
|
|
78
|
$c->_mul($mul, $m) if $len >= 0; # skip last mul |
2197
|
|
|
|
|
|
|
} |
2198
|
13
|
|
|
|
|
60
|
$x; |
2199
|
|
|
|
|
|
|
} |
2200
|
|
|
|
|
|
|
|
2201
|
|
|
|
|
|
|
sub _from_hex { |
2202
|
|
|
|
|
|
|
# convert a hex number to decimal (string, return ref to array) |
2203
|
1470
|
|
|
1470
|
|
3049
|
my ($c, $hs) = @_; |
2204
|
|
|
|
|
|
|
|
2205
|
1470
|
|
|
|
|
2876
|
my $m = $c->_new(0x10000000); # 28 bit at a time (<32 bit!) |
2206
|
1470
|
|
|
|
|
2434
|
my $d = 7; # 7 hexadecimal digits at a time |
2207
|
1470
|
|
|
|
|
3211
|
my $mul = $c->_one(); |
2208
|
1470
|
|
|
|
|
3067
|
my $x = $c->_zero(); |
2209
|
|
|
|
|
|
|
|
2210
|
1470
|
|
|
|
|
3968
|
my $len = int((length($hs) - 2) / $d); # $d digit parts, w/o the '0x' |
2211
|
1470
|
|
|
|
|
2120
|
my $val; |
2212
|
1470
|
|
|
|
|
2360
|
my $i = -$d; |
2213
|
1470
|
|
|
|
|
3098
|
while ($len >= 0) { |
2214
|
2227
|
|
|
|
|
4376
|
$val = substr($hs, $i, $d); # get hex digits |
2215
|
2227
|
100
|
|
|
|
7150
|
$val =~ s/^0x// if $len == 0; # for last part only because |
2216
|
2227
|
|
|
|
|
4280
|
$val = CORE::hex($val); # hex does not like wrong chars |
2217
|
2227
|
|
|
|
|
3108
|
$i -= $d; |
2218
|
2227
|
|
|
|
|
2849
|
$len --; |
2219
|
2227
|
|
|
|
|
4166
|
my $adder = $c->_new($val); |
2220
|
|
|
|
|
|
|
# if the resulting number was to big to fit into one element, create a |
2221
|
|
|
|
|
|
|
# two-element version (bug found by Mark Lakata - Thanx!) |
2222
|
2227
|
50
|
|
|
|
4967
|
if (CORE::length($val) > $BASE_LEN) { |
2223
|
0
|
|
|
|
|
0
|
$adder = $c->_new($val); |
2224
|
|
|
|
|
|
|
} |
2225
|
2227
|
100
|
|
|
|
6115
|
$c->_add($x, $c->_mul($adder, $mul)) if $val != 0; |
2226
|
2227
|
100
|
|
|
|
6668
|
$c->_mul($mul, $m) if $len >= 0; # skip last mul |
2227
|
|
|
|
|
|
|
} |
2228
|
1470
|
|
|
|
|
4513
|
$x; |
2229
|
|
|
|
|
|
|
} |
2230
|
|
|
|
|
|
|
|
2231
|
|
|
|
|
|
|
sub _from_bin { |
2232
|
|
|
|
|
|
|
# convert a hex number to decimal (string, return ref to array) |
2233
|
248
|
|
|
248
|
|
554
|
my ($c, $bs) = @_; |
2234
|
|
|
|
|
|
|
|
2235
|
|
|
|
|
|
|
# instead of converting X (8) bit at a time, it is faster to "convert" the |
2236
|
|
|
|
|
|
|
# number to hex, and then call _from_hex. |
2237
|
|
|
|
|
|
|
|
2238
|
248
|
|
|
|
|
394
|
my $hs = $bs; |
2239
|
248
|
|
|
|
|
1033
|
$hs =~ s/^[+-]?0b//; # remove sign and 0b |
2240
|
248
|
|
|
|
|
472
|
my $l = length($hs); # bits |
2241
|
248
|
100
|
|
|
|
1028
|
$hs = '0' x (8 - ($l % 8)) . $hs if ($l % 8) != 0; # padd left side w/ 0 |
2242
|
248
|
|
|
|
|
1359
|
my $h = '0x' . unpack('H*', pack ('B*', $hs)); # repack as hex |
2243
|
|
|
|
|
|
|
|
2244
|
248
|
|
|
|
|
697
|
$c->_from_hex($h); |
2245
|
|
|
|
|
|
|
} |
2246
|
|
|
|
|
|
|
|
2247
|
|
|
|
|
|
|
############################################################################## |
2248
|
|
|
|
|
|
|
# special modulus functions |
2249
|
|
|
|
|
|
|
|
2250
|
|
|
|
|
|
|
sub _modinv { |
2251
|
|
|
|
|
|
|
|
2252
|
|
|
|
|
|
|
# modular multiplicative inverse |
2253
|
124
|
|
|
124
|
|
273
|
my ($c, $x, $y) = @_; |
2254
|
|
|
|
|
|
|
|
2255
|
|
|
|
|
|
|
# modulo zero |
2256
|
124
|
50
|
|
|
|
256
|
if ($c->_is_zero($y)) { |
2257
|
0
|
|
|
|
|
0
|
return; |
2258
|
|
|
|
|
|
|
} |
2259
|
|
|
|
|
|
|
|
2260
|
|
|
|
|
|
|
# modulo one |
2261
|
124
|
50
|
|
|
|
331
|
if ($c->_is_one($y)) { |
2262
|
0
|
|
|
|
|
0
|
return $c->_zero(), '+'; |
2263
|
|
|
|
|
|
|
} |
2264
|
|
|
|
|
|
|
|
2265
|
124
|
|
|
|
|
278
|
my $u = $c->_zero(); |
2266
|
124
|
|
|
|
|
280
|
my $v = $c->_one(); |
2267
|
124
|
|
|
|
|
302
|
my $a = $c->_copy($y); |
2268
|
124
|
|
|
|
|
271
|
my $b = $c->_copy($x); |
2269
|
|
|
|
|
|
|
|
2270
|
|
|
|
|
|
|
# Euclid's Algorithm for bgcd(), only that we calc bgcd() ($a) and the result |
2271
|
|
|
|
|
|
|
# ($u) at the same time. See comments in BigInt for why this works. |
2272
|
124
|
|
|
|
|
188
|
my $q; |
2273
|
124
|
|
|
|
|
200
|
my $sign = 1; |
2274
|
|
|
|
|
|
|
{ |
2275
|
124
|
|
|
|
|
206
|
($a, $q, $b) = ($b, $c->_div($a, $b)); # step 1 |
|
269
|
|
|
|
|
570
|
|
2276
|
269
|
100
|
|
|
|
591
|
last if $c->_is_zero($b); |
2277
|
|
|
|
|
|
|
|
2278
|
145
|
|
|
|
|
371
|
my $t = $c->_add( # step 2: |
2279
|
|
|
|
|
|
|
$c->_mul($c->_copy($v), $q), # t = v * q |
2280
|
|
|
|
|
|
|
$u); # + u |
2281
|
145
|
|
|
|
|
307
|
$u = $v; # u = v |
2282
|
145
|
|
|
|
|
211
|
$v = $t; # v = t |
2283
|
145
|
|
|
|
|
211
|
$sign = -$sign; |
2284
|
145
|
|
|
|
|
229
|
redo; |
2285
|
|
|
|
|
|
|
} |
2286
|
|
|
|
|
|
|
|
2287
|
|
|
|
|
|
|
# if the gcd is not 1, then return NaN |
2288
|
124
|
100
|
|
|
|
269
|
return unless $c->_is_one($a); |
2289
|
|
|
|
|
|
|
|
2290
|
103
|
100
|
|
|
|
543
|
($v, $sign == 1 ? '+' : '-'); |
2291
|
|
|
|
|
|
|
} |
2292
|
|
|
|
|
|
|
|
2293
|
|
|
|
|
|
|
sub _modpow { |
2294
|
|
|
|
|
|
|
# modulus of power ($x ** $y) % $z |
2295
|
432
|
|
|
432
|
|
1014
|
my ($c, $num, $exp, $mod) = @_; |
2296
|
|
|
|
|
|
|
|
2297
|
|
|
|
|
|
|
# a^b (mod 1) = 0 for all a and b |
2298
|
432
|
100
|
|
|
|
927
|
if ($c->_is_one($mod)) { |
2299
|
150
|
|
|
|
|
387
|
@$num = 0; |
2300
|
150
|
|
|
|
|
369
|
return $num; |
2301
|
|
|
|
|
|
|
} |
2302
|
|
|
|
|
|
|
|
2303
|
|
|
|
|
|
|
# 0^a (mod m) = 0 if m != 0, a != 0 |
2304
|
|
|
|
|
|
|
# 0^0 (mod m) = 1 if m != 0 |
2305
|
282
|
100
|
|
|
|
664
|
if ($c->_is_zero($num)) { |
2306
|
36
|
100
|
|
|
|
81
|
if ($c->_is_zero($exp)) { |
2307
|
9
|
|
|
|
|
55
|
@$num = 1; |
2308
|
|
|
|
|
|
|
} else { |
2309
|
27
|
|
|
|
|
90
|
@$num = 0; |
2310
|
|
|
|
|
|
|
} |
2311
|
36
|
|
|
|
|
130
|
return $num; |
2312
|
|
|
|
|
|
|
} |
2313
|
|
|
|
|
|
|
|
2314
|
|
|
|
|
|
|
# $num = $c->_mod($num, $mod); # this does not make it faster |
2315
|
|
|
|
|
|
|
|
2316
|
246
|
|
|
|
|
575
|
my $acc = $c->_copy($num); |
2317
|
246
|
|
|
|
|
545
|
my $t = $c->_one(); |
2318
|
|
|
|
|
|
|
|
2319
|
246
|
|
|
|
|
608
|
my $expbin = $c->_as_bin($exp); |
2320
|
246
|
|
|
|
|
790
|
$expbin =~ s/^0b//; |
2321
|
246
|
|
|
|
|
455
|
my $len = length($expbin); |
2322
|
246
|
|
|
|
|
584
|
while (--$len >= 0) { |
2323
|
951
|
100
|
|
|
|
2290
|
if (substr($expbin, $len, 1) eq '1') { # is_odd |
2324
|
507
|
|
|
|
|
1158
|
$t = $c->_mul($t, $acc); |
2325
|
507
|
|
|
|
|
1152
|
$t = $c->_mod($t, $mod); |
2326
|
|
|
|
|
|
|
} |
2327
|
951
|
|
|
|
|
2042
|
$acc = $c->_mul($acc, $acc); |
2328
|
951
|
|
|
|
|
2001
|
$acc = $c->_mod($acc, $mod); |
2329
|
|
|
|
|
|
|
} |
2330
|
246
|
|
|
|
|
631
|
@$num = @$t; |
2331
|
246
|
|
|
|
|
706
|
$num; |
2332
|
|
|
|
|
|
|
} |
2333
|
|
|
|
|
|
|
|
2334
|
|
|
|
|
|
|
sub _gcd { |
2335
|
|
|
|
|
|
|
# Greatest common divisor. |
2336
|
|
|
|
|
|
|
|
2337
|
88
|
|
|
88
|
|
198
|
my ($c, $x, $y) = @_; |
2338
|
|
|
|
|
|
|
|
2339
|
|
|
|
|
|
|
# gcd(0, 0) = 0 |
2340
|
|
|
|
|
|
|
# gcd(0, a) = a, if a != 0 |
2341
|
|
|
|
|
|
|
|
2342
|
88
|
100
|
66
|
|
|
412
|
if (@$x == 1 && $x->[0] == 0) { |
2343
|
8
|
100
|
66
|
|
|
53
|
if (@$y == 1 && $y->[0] == 0) { |
2344
|
4
|
|
|
|
|
13
|
@$x = 0; |
2345
|
|
|
|
|
|
|
} else { |
2346
|
4
|
|
|
|
|
16
|
@$x = @$y; |
2347
|
|
|
|
|
|
|
} |
2348
|
8
|
|
|
|
|
28
|
return $x; |
2349
|
|
|
|
|
|
|
} |
2350
|
|
|
|
|
|
|
|
2351
|
|
|
|
|
|
|
# Until $y is zero ... |
2352
|
|
|
|
|
|
|
|
2353
|
80
|
|
66
|
|
|
343
|
until (@$y == 1 && $y->[0] == 0) { |
2354
|
|
|
|
|
|
|
|
2355
|
|
|
|
|
|
|
# Compute remainder. |
2356
|
|
|
|
|
|
|
|
2357
|
226
|
|
|
|
|
611
|
$c->_mod($x, $y); |
2358
|
|
|
|
|
|
|
|
2359
|
|
|
|
|
|
|
# Swap $x and $y. |
2360
|
|
|
|
|
|
|
|
2361
|
226
|
|
|
|
|
444
|
my $tmp = $c->_copy($x); |
2362
|
226
|
|
|
|
|
491
|
@$x = @$y; |
2363
|
226
|
|
|
|
|
773
|
$y = $tmp; # no deref here; that would modify input $y |
2364
|
|
|
|
|
|
|
} |
2365
|
|
|
|
|
|
|
|
2366
|
80
|
|
|
|
|
225
|
return $x; |
2367
|
|
|
|
|
|
|
} |
2368
|
|
|
|
|
|
|
|
2369
|
|
|
|
|
|
|
1; |
2370
|
|
|
|
|
|
|
|
2371
|
|
|
|
|
|
|
=pod |
2372
|
|
|
|
|
|
|
|
2373
|
|
|
|
|
|
|
=head1 NAME |
2374
|
|
|
|
|
|
|
|
2375
|
|
|
|
|
|
|
Math::BigInt::Calc - pure Perl module to support Math::BigInt |
2376
|
|
|
|
|
|
|
|
2377
|
|
|
|
|
|
|
=head1 SYNOPSIS |
2378
|
|
|
|
|
|
|
|
2379
|
|
|
|
|
|
|
# to use it with Math::BigInt |
2380
|
|
|
|
|
|
|
use Math::BigInt lib => 'Calc'; |
2381
|
|
|
|
|
|
|
|
2382
|
|
|
|
|
|
|
# to use it with Math::BigFloat |
2383
|
|
|
|
|
|
|
use Math::BigFloat lib => 'Calc'; |
2384
|
|
|
|
|
|
|
|
2385
|
|
|
|
|
|
|
# to use it with Math::BigRat |
2386
|
|
|
|
|
|
|
use Math::BigRat lib => 'Calc'; |
2387
|
|
|
|
|
|
|
|
2388
|
|
|
|
|
|
|
# explicitly set base length and whether to "use integer" |
2389
|
|
|
|
|
|
|
use Math::BigInt::Calc base_len => 4, use_int => 1; |
2390
|
|
|
|
|
|
|
use Math::BigInt lib => 'Calc'; |
2391
|
|
|
|
|
|
|
|
2392
|
|
|
|
|
|
|
=head1 DESCRIPTION |
2393
|
|
|
|
|
|
|
|
2394
|
|
|
|
|
|
|
Math::BigInt::Calc inherits from Math::BigInt::Lib. |
2395
|
|
|
|
|
|
|
|
2396
|
|
|
|
|
|
|
In this library, the numbers are represented interenally in base B = 10**N, |
2397
|
|
|
|
|
|
|
where N is the largest possible integer that does not cause overflow in the |
2398
|
|
|
|
|
|
|
intermediate computations. The base B elements are stored in an array, with the |
2399
|
|
|
|
|
|
|
least significant element stored in array element zero. There are no leading |
2400
|
|
|
|
|
|
|
zero elements, except a single zero element when the number is zero. For |
2401
|
|
|
|
|
|
|
instance, if B = 10000, the number 1234567890 is represented internally as |
2402
|
|
|
|
|
|
|
[7890, 3456, 12]. |
2403
|
|
|
|
|
|
|
|
2404
|
|
|
|
|
|
|
=head1 OPTIONS |
2405
|
|
|
|
|
|
|
|
2406
|
|
|
|
|
|
|
When the module is loaded, it computes the maximum exponent, i.e., power of 10, |
2407
|
|
|
|
|
|
|
that can be used with and without "use integer" in the computations. The default |
2408
|
|
|
|
|
|
|
is to use this maximum exponent. If the combination of the 'base_len' value and |
2409
|
|
|
|
|
|
|
the 'use_int' value exceeds the maximum value, an error is thrown. |
2410
|
|
|
|
|
|
|
|
2411
|
|
|
|
|
|
|
=over 4 |
2412
|
|
|
|
|
|
|
|
2413
|
|
|
|
|
|
|
=item base_len |
2414
|
|
|
|
|
|
|
|
2415
|
|
|
|
|
|
|
The base length can be specified explicitly with the 'base_len' option. The |
2416
|
|
|
|
|
|
|
value must be a positive integer. |
2417
|
|
|
|
|
|
|
|
2418
|
|
|
|
|
|
|
use Math::BigInt::Calc base_len => 4; # use 10000 as internal base |
2419
|
|
|
|
|
|
|
|
2420
|
|
|
|
|
|
|
=item use_int |
2421
|
|
|
|
|
|
|
|
2422
|
|
|
|
|
|
|
This option is used to specify whether "use integer" should be used in the |
2423
|
|
|
|
|
|
|
internal computations. The value is interpreted as a boolean value, so use 0 or |
2424
|
|
|
|
|
|
|
"" for false and anything else for true. If the 'base_len' is not specified |
2425
|
|
|
|
|
|
|
together with 'use_int', the current value for the base length is used. |
2426
|
|
|
|
|
|
|
|
2427
|
|
|
|
|
|
|
use Math::BigInt::Calc use_int => 1; # use "use integer" internally |
2428
|
|
|
|
|
|
|
|
2429
|
|
|
|
|
|
|
=back |
2430
|
|
|
|
|
|
|
|
2431
|
|
|
|
|
|
|
=head1 METHODS |
2432
|
|
|
|
|
|
|
|
2433
|
|
|
|
|
|
|
This overview constains only the methods that are specific to |
2434
|
|
|
|
|
|
|
C. For the other methods, see L. |
2435
|
|
|
|
|
|
|
|
2436
|
|
|
|
|
|
|
=over 4 |
2437
|
|
|
|
|
|
|
|
2438
|
|
|
|
|
|
|
=item _base_len() |
2439
|
|
|
|
|
|
|
|
2440
|
|
|
|
|
|
|
Specify the desired base length and whether to enable "use integer" in the |
2441
|
|
|
|
|
|
|
computations. |
2442
|
|
|
|
|
|
|
|
2443
|
|
|
|
|
|
|
Math::BigInt::Calc -> _base_len($base_len, $use_int); |
2444
|
|
|
|
|
|
|
|
2445
|
|
|
|
|
|
|
Note that it is better to specify the base length and whether to use integers as |
2446
|
|
|
|
|
|
|
options when the module is loaded, for example like this |
2447
|
|
|
|
|
|
|
|
2448
|
|
|
|
|
|
|
use Math::BigInt::Calc base_len => 6, use_int => 1; |
2449
|
|
|
|
|
|
|
|
2450
|
|
|
|
|
|
|
=back |
2451
|
|
|
|
|
|
|
|
2452
|
|
|
|
|
|
|
=head1 SEE ALSO |
2453
|
|
|
|
|
|
|
|
2454
|
|
|
|
|
|
|
L for a description of the API. |
2455
|
|
|
|
|
|
|
|
2456
|
|
|
|
|
|
|
Alternative libraries L, L, |
2457
|
|
|
|
|
|
|
L, L, and L. |
2458
|
|
|
|
|
|
|
|
2459
|
|
|
|
|
|
|
Some of the modules that use these libraries L, |
2460
|
|
|
|
|
|
|
L, and L. |
2461
|
|
|
|
|
|
|
|
2462
|
|
|
|
|
|
|
=cut |