line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Math::FractionManip; |
2
|
|
|
|
|
|
|
our $AUTHORITY = 'cpan:GENE'; |
3
|
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
# ABSTRACT: Manipulate fractions |
5
|
|
|
|
|
|
|
|
6
|
1
|
|
|
1
|
|
724
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
36
|
|
7
|
|
|
|
|
|
|
#use warnings; |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
our $VERSION = '0.5504'; |
10
|
|
|
|
|
|
|
|
11
|
1
|
|
|
1
|
|
5
|
use Carp qw(croak); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
38
|
|
12
|
1
|
|
|
1
|
|
981
|
use Math::BigInt (); |
|
1
|
|
|
|
|
22328
|
|
|
1
|
|
|
|
|
36
|
|
13
|
1
|
|
|
1
|
|
970
|
use Math::BigFloat (); |
|
1
|
|
|
|
|
24451
|
|
|
1
|
|
|
|
|
53
|
|
14
|
|
|
|
|
|
|
use overload |
15
|
1
|
|
|
|
|
7
|
'+' => 'add', |
16
|
|
|
|
|
|
|
'-' => 'sub', |
17
|
|
|
|
|
|
|
'*' => 'mul', |
18
|
|
|
|
|
|
|
'/' => 'div', |
19
|
|
|
|
|
|
|
'abs' => 'abs', |
20
|
|
|
|
|
|
|
'**' => 'pow', |
21
|
|
|
|
|
|
|
'sqrt' => 'sqrt', |
22
|
|
|
|
|
|
|
'<=>' => 'cmp', |
23
|
|
|
|
|
|
|
'""' => 'string', |
24
|
|
|
|
|
|
|
'0+' => 'decimal', |
25
|
1
|
|
|
1
|
|
11
|
fallback => 1; |
|
1
|
|
|
|
|
2
|
|
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
my %DEF = ( |
28
|
|
|
|
|
|
|
CURRENT => { TAGS => [qw/ NORMAL REDUCE SMALL AUTO /], DIGITS => undef, SYSTEM => 1, NAME => 'DEFAULT' }, |
29
|
|
|
|
|
|
|
DEFAULT => { TAGS => [qw/ NORMAL REDUCE SMALL AUTO /], DIGITS => undef, READONLY => 1, SYSTEM => 1 }, |
30
|
|
|
|
|
|
|
BLANK => { TAGS => ['', '', ''], DIGITS => '', READONLY => 1, SYSTEM => 1 }, |
31
|
|
|
|
|
|
|
); |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
my ($OUTFORMAT, $REDUCE, $SIZE, $AUTO, $INTERNAL, $RED_STATE) = (0 .. 5); |
34
|
|
|
|
|
|
|
my $TAG_END = 3; #Last index of tags meant to be kept. |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
my %TAGS = ( |
37
|
|
|
|
|
|
|
NORMAL => [$OUTFORMAT, 'NORMAL'], |
38
|
|
|
|
|
|
|
MIXED => [$OUTFORMAT, 'MIXED'], |
39
|
|
|
|
|
|
|
MIXED_RAW => [$OUTFORMAT, 'MIXED_RAW'], |
40
|
|
|
|
|
|
|
RAW => [$OUTFORMAT, 'RAW'], |
41
|
|
|
|
|
|
|
DEF_MIXED => [$OUTFORMAT, undef], |
42
|
|
|
|
|
|
|
REDUCE => [$REDUCE, 'REDUCE'], |
43
|
|
|
|
|
|
|
NO_REDUCE => [$REDUCE, 'NO_REDUCE'], |
44
|
|
|
|
|
|
|
DEF_REDUCE => [$REDUCE, undef], |
45
|
|
|
|
|
|
|
SMALL => [$SIZE, 'SMALL'], |
46
|
|
|
|
|
|
|
BIG => [$SIZE, 'BIG'], |
47
|
|
|
|
|
|
|
DEF_BIG => [$SIZE, undef], |
48
|
|
|
|
|
|
|
AUTO => [$AUTO, 'AUTO'], |
49
|
|
|
|
|
|
|
NO_AUTO => [$AUTO, 'NO_AUTO'], |
50
|
|
|
|
|
|
|
DEF_AUTO => [$AUTO, undef], |
51
|
|
|
|
|
|
|
CONVERTED => [$INTERNAL, 'CONVERTED'], |
52
|
|
|
|
|
|
|
IS_REDUCED => [$RED_STATE, 'IS_REDUCED'], |
53
|
|
|
|
|
|
|
); |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
my @DEF_TAG = qw(DEF_MIXED DEF_REDUCE DEF_BIG DEF_AUTO); |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
my $ID = 01; |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
sub new { |
60
|
64
|
|
|
64
|
1
|
5065
|
my $proto = shift; |
61
|
64
|
|
33
|
|
|
247
|
my $class = ref($proto) || $proto; |
62
|
64
|
|
|
|
|
118
|
my ($self, @frac, @tags, $tag, $decimal, $p1, $p2, $p3); |
63
|
64
|
100
|
100
|
|
|
107
|
if (_is_decimal($_[0]) and _is_decimal($_[1]) and _is_decimal($_[2])) { |
|
|
100
|
100
|
|
|
|
|
|
|
100
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
64
|
2
|
|
|
|
|
6
|
my $sign = $_[0] / abs($_[0]); |
65
|
2
|
|
|
|
|
6
|
@tags = _tags(@_[3 .. $#_]); |
66
|
2
|
|
|
|
|
6
|
($decimal, $p1, $p2, $p3) = _fix_num(\@tags, @_[0 .. 2]); |
67
|
2
|
|
|
|
|
6
|
($p1, $p2, $p3) = (abs($p1), abs($p2), abs($p3)); |
68
|
2
|
|
|
|
|
5
|
@frac = ($p1 * $p3 + $p2, $sign * $p3); |
69
|
2
|
50
|
|
|
|
5
|
@frac = _de_decimal(@frac, \@tags) if $decimal; |
70
|
|
|
|
|
|
|
} |
71
|
|
|
|
|
|
|
elsif (_is_decimal($_[0]) and _is_decimal($_[1])) { |
72
|
50
|
|
|
|
|
119
|
@tags = _tags(@_[2 .. $#_]); |
73
|
50
|
|
|
|
|
129
|
($decimal, @frac) = _fix_num(\@tags, @_[0 .. 1]); |
74
|
50
|
100
|
|
|
|
80
|
@frac = _de_decimal(@frac, \@tags) if $decimal; |
75
|
50
|
|
|
|
|
82
|
@frac = _simplify_sign(@frac); |
76
|
|
|
|
|
|
|
} |
77
|
|
|
|
|
|
|
elsif (_is_decimal($_[0])) { |
78
|
|
|
|
|
|
|
{ |
79
|
5
|
|
|
|
|
7
|
@tags = _tags(@_[1 .. $#_]); |
|
5
|
|
|
|
|
13
|
|
80
|
5
|
|
|
|
|
12
|
($decimal, $p1) = _fix_num(\@tags, $_[0]); |
81
|
5
|
100
|
|
|
|
11
|
@frac = ($p1, 1), last if not $decimal; |
82
|
3
|
|
|
|
|
6
|
(@frac[0 .. 1], $tag) = _from_decimal($p1); |
83
|
3
|
|
|
|
|
7
|
@tags = _tags(@tags, $tag); |
84
|
3
|
|
|
|
|
8
|
($decimal, @frac) = _fix_num(\@tags, @frac); |
85
|
3
|
50
|
|
|
|
7
|
@frac = _de_decimal(@frac, \@tags) if $decimal; |
86
|
|
|
|
|
|
|
} |
87
|
|
|
|
|
|
|
} |
88
|
|
|
|
|
|
|
elsif ($_[0] =~ /\s*([\+\-]?)\s*([0-9e\.\+\-]+)\s+([0-9e\.\+\-]+)\s*\/\s*([0-9e\.\+\-]+)/) { |
89
|
2
|
|
|
|
|
7
|
my $sign = $1 . '1'; |
90
|
2
|
|
|
|
|
6
|
@tags = _tags(@_[1 .. $#_]); |
91
|
2
|
|
|
|
|
6
|
($decimal, $p1, $p2, $p3) = _fix_num(\@tags, $2, $3, $4); |
92
|
2
|
|
|
|
|
5
|
($p1, $p2, $p3) = (abs($p1), abs($p2), abs($p3)); |
93
|
2
|
|
|
|
|
5
|
@frac = ($p1 * $p3 + $p2, $sign * $p3); |
94
|
2
|
50
|
|
|
|
5
|
@frac = _de_decimal($p1 * $p3 + $p2, $sign * $p3, \@tags) if $decimal; |
95
|
|
|
|
|
|
|
} |
96
|
|
|
|
|
|
|
elsif ($_[0] =~ /\s*([0-9e\.\+\-]+)\s*\/\s*([0-9e\.\+\-]+)/) { |
97
|
5
|
|
|
|
|
16
|
@tags = _tags(@_[1 .. $#_]); |
98
|
5
|
|
|
|
|
15
|
($decimal, @frac) = _fix_num(\@tags, $1, $2); |
99
|
5
|
50
|
|
|
|
12
|
@frac = _de_decimal(@frac, \@tags) if $decimal; |
100
|
5
|
|
|
|
|
11
|
@frac = _simplify_sign(@frac); |
101
|
|
|
|
|
|
|
} |
102
|
|
|
|
|
|
|
else { |
103
|
0
|
|
|
|
|
0
|
croak("\"$_[0]\" is of unknown format"); |
104
|
|
|
|
|
|
|
} |
105
|
64
|
50
|
|
|
|
135
|
croak("Can not have 0 as the denominator") if $frac[1] == 0; |
106
|
64
|
100
|
100
|
|
|
477
|
if (_tag($REDUCE, \@tags) ne 'NO_REDUCE' and _tag($RED_STATE, \@tags) ne 'IS_REDUCED') { |
107
|
33
|
|
|
|
|
110
|
my $not_reduced; |
108
|
33
|
|
|
|
|
46
|
($not_reduced, @frac) = _reduce(@frac); |
109
|
33
|
100
|
66
|
|
|
150
|
@frac = _fix_auto('DOWN', \@tags, @frac) if $not_reduced and _tag($AUTO, \@tags) eq 'AUTO'; |
110
|
|
|
|
|
|
|
} |
111
|
64
|
100
|
|
|
|
97
|
@tags[$RED_STATE] = undef if _tag($RED_STATE, \@tags) eq 'IS_REDUCED'; |
112
|
64
|
|
|
|
|
156
|
$self->{frac} = \@frac; |
113
|
64
|
|
|
|
|
87
|
$self->{tags} = \@tags; |
114
|
64
|
|
|
|
|
105
|
bless($self, $class); |
115
|
64
|
|
|
|
|
237
|
return $self; |
116
|
|
|
|
|
|
|
} |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
sub string { |
119
|
40
|
|
|
40
|
1
|
19810
|
my $self = shift; |
120
|
40
|
|
|
|
|
50
|
my @frac; |
121
|
40
|
|
|
|
|
100
|
my $mixed = _tag($OUTFORMAT, [$_[0]], $self->{tags}); |
122
|
40
|
100
|
|
|
|
111
|
if ($mixed eq 'MIXED') { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
123
|
14
|
|
|
|
|
29
|
@frac = $self->list('MIXED'); |
124
|
14
|
|
|
|
|
21
|
my $string = ""; |
125
|
14
|
100
|
|
|
|
27
|
$string .= "$frac[0]" if $frac[0] != 0; |
126
|
14
|
100
|
100
|
|
|
312
|
$string .= " " if $frac[0] != 0 and $frac[1] != 0; |
127
|
14
|
100
|
|
|
|
273
|
$string .= "$frac[1]/$frac[2]" if $frac[1] != 0; |
128
|
14
|
50
|
|
|
|
418
|
$string = "0" if $string eq ''; |
129
|
14
|
|
|
|
|
150
|
return $string; |
130
|
|
|
|
|
|
|
} |
131
|
|
|
|
|
|
|
elsif ($mixed eq 'MIXED_RAW') { |
132
|
0
|
|
|
|
|
0
|
@frac = $self->list('MIXED'); |
133
|
0
|
|
|
|
|
0
|
return "$frac[0] $frac[1]/$frac[2]"; |
134
|
|
|
|
|
|
|
} |
135
|
|
|
|
|
|
|
elsif ($mixed eq 'RAW') { |
136
|
0
|
|
|
|
|
0
|
@frac = $self->list; |
137
|
0
|
0
|
|
|
|
0
|
return ($frac[0] >= 0 ? '+' : '') . "$frac[0]/$frac[1]"; |
138
|
|
|
|
|
|
|
} |
139
|
|
|
|
|
|
|
else { |
140
|
26
|
|
|
|
|
50
|
@frac = $self->list; |
141
|
26
|
|
|
|
|
230
|
return "$frac[0]/$frac[1]"; |
142
|
|
|
|
|
|
|
} |
143
|
|
|
|
|
|
|
} |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
sub list { |
146
|
40
|
|
|
40
|
1
|
50
|
my $self = shift; |
147
|
40
|
|
|
|
|
44
|
my @frac = @{ $self->{frac} }; |
|
40
|
|
|
|
|
79
|
|
148
|
40
|
100
|
|
|
|
74
|
if ($_[0] eq "MIXED") { |
149
|
14
|
|
|
|
|
25
|
my $whole = $frac[0] / $frac[1]; |
150
|
14
|
100
|
|
|
|
266
|
$whole = int($whole) if not ref($frac[0]); |
151
|
14
|
|
|
|
|
23
|
$frac[0] = abs($frac[0] - $frac[1] * $whole); |
152
|
14
|
|
|
|
|
280
|
@frac = ($whole, @frac); |
153
|
|
|
|
|
|
|
} |
154
|
40
|
|
|
|
|
57
|
foreach (@frac) { s/^\+//; } |
|
94
|
|
|
|
|
366
|
|
155
|
40
|
|
|
|
|
171
|
return @frac; |
156
|
|
|
|
|
|
|
} |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
sub reduce { |
159
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
160
|
0
|
|
|
|
|
0
|
my ($undef, @frac) = _reduce(@{ $self->{frac} }); |
|
0
|
|
|
|
|
0
|
|
161
|
0
|
|
|
|
|
0
|
return Math::FractionManip->new(@frac, @{ $self->{tags} }); |
|
0
|
|
|
|
|
0
|
|
162
|
|
|
|
|
|
|
} |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
sub decimal { |
166
|
2
|
|
|
2
|
1
|
2
|
my $self = shift; |
167
|
2
|
|
|
|
|
3
|
my @frac = @{ $self->{frac} }; |
|
2
|
|
|
|
|
4
|
|
168
|
2
|
50
|
|
|
|
17
|
return $frac[0] / $frac[1] if not ref($frac[0]); |
169
|
0
|
0
|
|
|
|
0
|
return Math::BigFloat->new(Math::BigFloat::bdiv($frac[0], $frac[1], $DEF{CURRENT}{DIGITS})) if ref($frac[0]); |
170
|
|
|
|
|
|
|
} |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
sub num { |
173
|
1
|
|
|
1
|
1
|
955
|
my $self = shift; |
174
|
1
|
|
|
|
|
2
|
my @frac = @{ $self->{frac} }; |
|
1
|
|
|
|
|
3
|
|
175
|
1
|
50
|
|
|
|
23
|
return $frac[0] / $frac[1] if not ref $frac[0]; |
176
|
0
|
0
|
|
|
|
0
|
return Math::BigFloat->new(Math::BigFloat::bdiv($frac[0], $frac[1], $DEF{CURRENT}{DIGITS})) if ref($frac[0]); |
177
|
|
|
|
|
|
|
} |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
## For the next three methods: |
180
|
|
|
|
|
|
|
# If used on the object use the tags of the object |
181
|
|
|
|
|
|
|
# If given a class use the dafault tags, |
182
|
|
|
|
|
|
|
# .... if a default set is specified then return for that set. |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
sub is_tag { |
185
|
6
|
|
|
6
|
1
|
1226
|
my $self = shift; |
186
|
6
|
|
|
|
|
9
|
my $tag = shift; |
187
|
6
|
50
|
|
|
|
20
|
my $default = 1 if $_[0] eq 'INC_DEF'; |
188
|
6
|
|
|
|
|
8
|
my $is_tag = 0; |
189
|
6
|
|
|
|
|
8
|
my @tags; |
190
|
|
|
|
|
|
|
{ |
191
|
6
|
50
|
|
|
|
8
|
$is_tag = 0, last if not $TAGS{$tag}; #if there is no such tag ret=0 |
|
6
|
|
|
|
|
16
|
|
192
|
6
|
|
|
|
|
7
|
my ($num, $tag) = @{ $TAGS{$tag} }; |
|
6
|
|
|
|
|
14
|
|
193
|
6
|
50
|
|
|
|
13
|
if (ref($self) eq "Math::FractionManip") { |
194
|
6
|
|
|
|
|
8
|
@tags = @{ $self->{tags} }; |
|
6
|
|
|
|
|
14
|
|
195
|
6
|
100
|
|
|
|
14
|
$is_tag = 1, last if $tags[$num] eq $tag; |
196
|
3
|
50
|
33
|
|
|
9
|
$is_tag = undef, last if $tags[$num] eq undef and not $default; |
197
|
3
|
0
|
33
|
|
|
10
|
$is_tag = -1, last if $DEF{CURRENT}{TAGS}[$num] eq $tag |
|
|
|
33
|
|
|
|
|
198
|
|
|
|
|
|
|
and $tags[$num] eq undef and $default; |
199
|
3
|
|
|
|
|
4
|
$is_tag = 0; |
200
|
|
|
|
|
|
|
} |
201
|
|
|
|
|
|
|
else { |
202
|
0
|
|
|
|
|
0
|
my $set; |
203
|
0
|
0
|
|
|
|
0
|
$set = 'CURRENT' unless $set = $_[0]; |
204
|
0
|
0
|
|
|
|
0
|
$set = 'BLANK' unless exists $DEF{$set}; |
205
|
0
|
0
|
|
|
|
0
|
$is_tag = 1, last if $DEF{$set}{TAGS}[$num] eq $tag; |
206
|
0
|
|
|
|
|
0
|
$is_tag = 0; |
207
|
|
|
|
|
|
|
} |
208
|
|
|
|
|
|
|
} |
209
|
6
|
|
|
|
|
24
|
return $is_tag; |
210
|
|
|
|
|
|
|
} |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
sub tags { |
213
|
5
|
|
|
5
|
1
|
9
|
my $self = shift; |
214
|
5
|
|
|
|
|
6
|
my @tags; |
215
|
5
|
50
|
|
|
|
16
|
if (ref($self) eq "Math::FractionManip") { |
|
|
50
|
|
|
|
|
|
216
|
0
|
0
|
|
|
|
0
|
my $inc_def = 1 if $_[0] eq 'INC_DEF'; |
217
|
0
|
|
|
|
|
0
|
@tags = @{ $self->{tags} }[0 .. $TAG_END]; |
|
0
|
|
|
|
|
0
|
|
218
|
0
|
|
|
|
|
0
|
my $num; |
219
|
0
|
|
|
|
|
0
|
foreach $num (0 .. $#tags) { |
220
|
0
|
0
|
0
|
|
|
0
|
$tags[$num] = $DEF_TAG[$num] if $tags[$num] eq undef and not $inc_def; |
221
|
0
|
0
|
0
|
|
|
0
|
$tags[$num] = $DEF{CURRENT}{TAGS}[$num] if $tags[$num] eq undef and $inc_def; |
222
|
|
|
|
|
|
|
} |
223
|
|
|
|
|
|
|
} |
224
|
|
|
|
|
|
|
elsif (ref($self) ne "Math::FractionManip") { |
225
|
5
|
|
|
|
|
8
|
my $set; |
226
|
5
|
100
|
|
|
|
12
|
$set = 'CURRENT' unless $set = $_[0]; |
227
|
5
|
50
|
|
|
|
9
|
$set = 'BLANK' unless exists $DEF{$set}; |
228
|
5
|
|
|
|
|
6
|
@tags = @{ $DEF{$set}{TAGS} }; |
|
5
|
|
|
|
|
42
|
|
229
|
|
|
|
|
|
|
} |
230
|
5
|
|
|
|
|
32
|
return @tags; |
231
|
|
|
|
|
|
|
} |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
sub digits { |
234
|
5
|
|
|
5
|
1
|
9
|
my $self = shift; |
235
|
5
|
|
|
|
|
6
|
my $set; |
236
|
5
|
100
|
|
|
|
12
|
$set = 'CURRENT' unless $set = $_[0]; |
237
|
5
|
50
|
|
|
|
11
|
$set = 'BLANK' unless exists $DEF{$set}; |
238
|
5
|
|
|
|
|
18
|
return $DEF{$set}{DIGITS}; |
239
|
|
|
|
|
|
|
} |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
############################### |
242
|
|
|
|
|
|
|
# These methods are used for managing default sets. |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
sub sets { |
245
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
246
|
0
|
|
|
|
|
0
|
return keys %DEF; |
247
|
|
|
|
|
|
|
} |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
sub name_set { |
250
|
1
|
|
|
1
|
1
|
3
|
shift; |
251
|
1
|
50
|
|
|
|
3
|
return $DEF{CURRENT}{NAME} if not $_[0]; |
252
|
1
|
50
|
|
|
|
4
|
$DEF{CURRENT}{NAME} = $_[0] if $_[0]; |
253
|
|
|
|
|
|
|
} |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
sub exists_set { |
256
|
0
|
|
|
0
|
1
|
0
|
return exists $DEF{ $_[1] }; |
257
|
|
|
|
|
|
|
} |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
sub use_set { |
260
|
1
|
|
|
1
|
1
|
3
|
my $self = shift; |
261
|
1
|
|
|
|
|
2
|
my $name = shift; |
262
|
1
|
50
|
33
|
|
|
6
|
if (exists $DEF{$name} and not $DEF{$name}{READONLY}) { |
263
|
1
|
|
|
|
|
3
|
$DEF{CURRENT} = $DEF{$name}; |
264
|
1
|
|
|
|
|
2
|
return $name; |
265
|
|
|
|
|
|
|
} |
266
|
|
|
|
|
|
|
else { |
267
|
0
|
|
|
|
|
0
|
return undef; |
268
|
|
|
|
|
|
|
} |
269
|
|
|
|
|
|
|
} |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
sub temp_set { |
272
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
273
|
0
|
|
|
|
|
0
|
my $name = shift; |
274
|
0
|
0
|
|
|
|
0
|
if (not $name) { |
275
|
0
|
|
|
|
|
0
|
$ID++; |
276
|
0
|
|
|
|
|
0
|
$name = "\cI\cD$ID"; |
277
|
0
|
|
|
|
|
0
|
$self->copy_set('CURRENT', $name); |
278
|
0
|
|
|
|
|
0
|
$self->copy_set('DEFAULT', 'CURRENT'); |
279
|
0
|
|
|
|
|
0
|
return $name; |
280
|
|
|
|
|
|
|
} |
281
|
|
|
|
|
|
|
else { #if $name; |
282
|
0
|
|
|
|
|
0
|
my $return = $self->copy_set($name, 'CURRENT'); |
283
|
0
|
|
|
|
|
0
|
$self->del_set($name); |
284
|
0
|
|
|
|
|
0
|
return $return; |
285
|
|
|
|
|
|
|
} |
286
|
|
|
|
|
|
|
} |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
sub load_set { |
289
|
2
|
|
|
2
|
1
|
10
|
my $self = shift; |
290
|
2
|
50
|
|
|
|
6
|
if (exists $DEF{ $_[0] }) { |
291
|
2
|
50
|
|
|
|
14
|
$self->copy_set($_[0], 'CURRENT') if exists $DEF{ $_[0] }; |
292
|
2
|
|
|
|
|
4
|
return $_[0]; |
293
|
|
|
|
|
|
|
} |
294
|
|
|
|
|
|
|
else { |
295
|
0
|
|
|
|
|
0
|
return undef; |
296
|
|
|
|
|
|
|
} |
297
|
|
|
|
|
|
|
} |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
sub save_set { |
300
|
1
|
|
|
1
|
1
|
2
|
my $self = shift; |
301
|
1
|
|
|
|
|
2
|
my $name; |
302
|
1
|
50
|
|
|
|
4
|
$name = $DEF{CURRENT}{NAME} unless $name = shift; |
303
|
1
|
50
|
33
|
|
|
7
|
++$ID, $name = "\cI\cD:$ID" if not $name or $name eq 'RAND'; |
304
|
1
|
|
50
|
|
|
22
|
return $self->copy_set('CURRENT', $name) && $name; |
305
|
|
|
|
|
|
|
} |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
sub copy_set { |
308
|
3
|
|
|
3
|
1
|
5
|
shift; |
309
|
3
|
|
|
|
|
7
|
my ($name1, $name2) = @_; |
310
|
3
|
50
|
33
|
|
|
17
|
if ($DEF{$name2}{READONLY} or $name2 eq 'BLANK' or not exists $DEF{$name1}) { |
|
|
|
33
|
|
|
|
|
311
|
0
|
|
|
|
|
0
|
return 0; |
312
|
|
|
|
|
|
|
} |
313
|
|
|
|
|
|
|
else { |
314
|
3
|
|
|
|
|
9
|
$DEF{$name2} = {}; # kill any links from use; |
315
|
3
|
|
|
|
|
4
|
$DEF{$name2}{TAGS} = [@{ $DEF{$name1}{TAGS} }]; |
|
3
|
|
|
|
|
10
|
|
316
|
3
|
|
|
|
|
6
|
$DEF{$name2}{DIGITS} = $DEF{$name1}{DIGITS}; |
317
|
3
|
100
|
|
|
|
8
|
$DEF{$name2}{NAME} = $name2 unless $name2 eq 'CURRENT'; |
318
|
3
|
100
|
|
|
|
20
|
$DEF{$name2}{NAME} = $name1 if $name2 eq 'CURRENT'; |
319
|
3
|
|
|
|
|
7
|
return 1; |
320
|
|
|
|
|
|
|
} |
321
|
|
|
|
|
|
|
} |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
sub del_set { |
324
|
0
|
0
|
0
|
0
|
1
|
0
|
if (exists $DEF{ $_[1] } and not $DEF{ $_[1] }{SYSTEM}) { |
325
|
0
|
|
|
|
|
0
|
delete $DEF{ $_[1] }; |
326
|
0
|
|
|
|
|
0
|
return $_[1]; |
327
|
|
|
|
|
|
|
} |
328
|
|
|
|
|
|
|
} |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
############################### |
331
|
|
|
|
|
|
|
# All of the modify methods are not meant to return anything, they modify |
332
|
|
|
|
|
|
|
# the object being referenced. |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
# This method works almost like the new method except that it takes an |
335
|
|
|
|
|
|
|
# object as an argement and will modify it instead of creating a new |
336
|
|
|
|
|
|
|
# object, also any tags associated with the object are left in tact |
337
|
|
|
|
|
|
|
# unless a new tag is given to override the old. |
338
|
|
|
|
|
|
|
sub modify { |
339
|
0
|
|
|
0
|
1
|
0
|
my $me = shift; |
340
|
0
|
|
|
|
|
0
|
my $self; |
341
|
0
|
|
|
|
|
0
|
my @tags = @{ $me->{tags} }; |
|
0
|
|
|
|
|
0
|
|
342
|
0
|
|
|
|
|
0
|
$self = Math::FractionManip->new(@_, @tags, @_); # The extra @_ is there to override tags |
343
|
0
|
|
|
|
|
0
|
$me->{frac} = $self->{frac}; |
344
|
0
|
|
|
|
|
0
|
$me->{tags} = $self->{tags}; |
345
|
|
|
|
|
|
|
} |
346
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
# XXX This method appears to break things? -GB |
348
|
|
|
|
|
|
|
sub modify_digits { |
349
|
1
|
|
|
1
|
1
|
3
|
my $self = shift; |
350
|
1
|
|
|
|
|
3
|
$DEF{CURRENT}{DIGITS} = shift; |
351
|
|
|
|
|
|
|
} |
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
sub modify_reduce { |
354
|
0
|
|
|
0
|
1
|
0
|
my $me = shift; |
355
|
0
|
|
|
|
|
0
|
my $self = $me->reduce; |
356
|
0
|
|
|
|
|
0
|
$me->{frac} = $self->{frac}; |
357
|
0
|
|
|
|
|
0
|
$me->{tags} = $self->{tags}; |
358
|
|
|
|
|
|
|
} |
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
sub modify_num { |
361
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
362
|
0
|
|
|
|
|
0
|
$self->[0] = $_[0]; |
363
|
|
|
|
|
|
|
} |
364
|
|
|
|
|
|
|
|
365
|
|
|
|
|
|
|
sub modify_den { |
366
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
367
|
0
|
|
|
|
|
0
|
$self->[1] = $_[0]; |
368
|
|
|
|
|
|
|
} |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
sub modify_tag { |
371
|
5
|
|
|
5
|
1
|
676
|
my $self = shift; |
372
|
5
|
|
|
|
|
11
|
my ($return, @return); |
373
|
5
|
|
|
|
|
0
|
my $newtag; |
374
|
5
|
|
|
|
|
8
|
foreach $newtag (@_) { |
375
|
7
|
|
|
|
|
13
|
my $tagnum = _tagnum($newtag); |
376
|
7
|
50
|
|
|
|
21
|
if ($tagnum == -1) { |
|
|
100
|
|
|
|
|
|
377
|
0
|
|
|
|
|
0
|
push @return, undef; |
378
|
|
|
|
|
|
|
} |
379
|
|
|
|
|
|
|
elsif (ref($self) eq "Math::FractionManip") { |
380
|
3
|
|
|
|
|
6
|
my @frac = @{ $self->{frac} }; |
|
3
|
|
|
|
|
7
|
|
381
|
3
|
|
|
|
|
4
|
my @tags = @{ $self->{tags} }; |
|
3
|
|
|
|
|
6
|
|
382
|
3
|
|
|
|
|
6
|
my @newtags = _tags(@tags, $newtag); |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
# Now transform the Fraction based on the new tag. |
385
|
3
|
100
|
|
|
|
8
|
if ($tagnum == $SIZE) { |
|
|
50
|
|
|
|
|
|
386
|
1
|
|
|
|
|
3
|
my $newtag = _tag($SIZE, \@newtags); |
387
|
1
|
50
|
|
|
|
3
|
@frac = map { "$_" + 0 } @frac if $newtag eq 'SMALL'; |
|
0
|
|
|
|
|
0
|
|
388
|
1
|
50
|
|
|
|
4
|
@frac = map { Math::BigInt->new($_) } @frac if $newtag eq 'BIG'; |
|
2
|
|
|
|
|
82
|
|
389
|
|
|
|
|
|
|
} |
390
|
|
|
|
|
|
|
elsif ($tagnum == $REDUCE) { |
391
|
0
|
0
|
|
|
|
0
|
(undef, @frac) = _reduce(@frac) if _tag($REDUCE, \@newtags) eq 'REDUCE'; |
392
|
|
|
|
|
|
|
} |
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
# Finally Modify the Fraction |
395
|
3
|
|
|
|
|
45
|
$self->{frac} = \@frac; |
396
|
3
|
|
|
|
|
8
|
$self->{tags} = \@newtags; |
397
|
|
|
|
|
|
|
} |
398
|
|
|
|
|
|
|
else { |
399
|
4
|
|
|
|
|
6
|
$DEF{CURRENT}{TAGS}[$tagnum] = $newtag; |
400
|
|
|
|
|
|
|
} |
401
|
7
|
|
|
|
|
15
|
push @return, $newtag; |
402
|
|
|
|
|
|
|
} |
403
|
5
|
|
|
|
|
9
|
return @return; |
404
|
|
|
|
|
|
|
} |
405
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
############################### |
407
|
|
|
|
|
|
|
# These methods are meant to be called with the overload operators. |
408
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
sub add { |
410
|
16
|
|
|
16
|
1
|
22
|
my @frac1 = @{ $_[0]->{frac} }; |
|
16
|
|
|
|
|
30
|
|
411
|
16
|
|
|
|
|
22
|
my @tags1 = @{ $_[0]->{tags} }; |
|
16
|
|
|
|
|
28
|
|
412
|
16
|
|
|
|
|
25
|
my (@frac2, @frac, @tags2, $frac); |
413
|
16
|
|
|
|
|
16
|
my $skipauto = 0; |
414
|
16
|
100
|
|
|
|
47
|
@frac2 = @{ $_[1]->{frac} }, @tags2 = @{ $_[1]->{tags} } if ref($_[1]) eq "Math::FractionManip"; |
|
10
|
|
|
|
|
19
|
|
|
10
|
|
|
|
|
16
|
|
415
|
16
|
100
|
|
|
|
46
|
@frac2 = _from_decimal($_[1]), $tags2[$INTERNAL] = 'CONVERTED' if ref($_[1]) ne "Math::FractionManip"; |
416
|
16
|
|
|
|
|
42
|
my @tags = _tags_preserve([@tags1], [@tags2]); |
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
LOOP: { |
419
|
16
|
100
|
|
|
|
34
|
if (_tag($REDUCE, \@tags) eq 'NO_REDUCE') { |
|
17
|
|
|
|
|
34
|
|
420
|
4
|
|
|
|
|
13
|
@frac = ($frac1[0] * $frac2[1] + $frac2[0] * $frac1[1], $frac1[1] * $frac2[1]); |
421
|
|
|
|
|
|
|
} |
422
|
|
|
|
|
|
|
else { |
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
# Taken from Knuth v2 (rev 2), p313. |
425
|
|
|
|
|
|
|
# It will always return a reduced fraction. |
426
|
13
|
|
|
|
|
23
|
my $gcd1 = _gcd($frac1[1], $frac2[1]); |
427
|
13
|
|
|
|
|
29
|
my $tmp = $frac1[0] * ($frac2[1] / $gcd1) + $frac2[0] * ($frac1[1] / $gcd1); |
428
|
13
|
|
|
|
|
18
|
my $gcd2 = _gcd($tmp, $gcd1); |
429
|
13
|
|
|
|
|
27
|
@frac = ($tmp / $gcd2, ($frac1[1] / $gcd1) * ($frac2[1] / $gcd2)); |
430
|
13
|
|
|
|
|
19
|
$tags[$RED_STATE] = 'IS_REDUCED'; |
431
|
|
|
|
|
|
|
} |
432
|
17
|
100
|
66
|
|
|
502
|
if ((_tag($AUTO, \@tags) eq 'AUTO') and (not $skipauto) and |
|
|
|
66
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
66
|
|
|
|
|
433
|
|
|
|
|
|
|
($tags[$SIZE] eq 'SMALL') and ($frac[0] =~ /[eE]/ or $frac[1] =~ /[eE]/)) |
434
|
|
|
|
|
|
|
{ |
435
|
1
|
|
|
|
|
3
|
(@frac1[0 .. 1], @frac2[0 .. 1]) = map { Math::BigInt->new($_) } (@frac1, @frac2); |
|
4
|
|
|
|
|
19390
|
|
436
|
1
|
|
|
|
|
39
|
$tags[$SIZE] = 'BIG'; |
437
|
1
|
|
|
|
|
2
|
$skipauto = 1; |
438
|
1
|
|
|
|
|
3
|
redo LOOP; |
439
|
|
|
|
|
|
|
} |
440
|
|
|
|
|
|
|
} |
441
|
16
|
|
|
|
|
55
|
return Math::FractionManip->new(@frac, @tags); |
442
|
|
|
|
|
|
|
} |
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
sub sub { |
445
|
1
|
|
|
1
|
1
|
7
|
my ($frac1, $frac2) = ($_[$_[2]], $_[not $_[2]]); # swap if needed |
446
|
1
|
50
|
|
|
|
3
|
$frac1 = Math::FractionManip->new($frac1, 'CONVERTED') if ref($frac1) ne "Math::FractionManip"; |
447
|
1
|
50
|
|
|
|
3
|
$frac2 = Math::FractionManip->new($frac2, 'CONVERTED') if ref($frac2) ne "Math::FractionManip"; |
448
|
|
|
|
|
|
|
|
449
|
1
|
|
|
|
|
3
|
$frac2 = Math::FractionManip->new($frac2->{frac}[0], -$frac2->{frac}[1], @{ $frac2->{tags} }); |
|
1
|
|
|
|
|
3
|
|
450
|
|
|
|
|
|
|
|
451
|
1
|
|
|
|
|
3
|
return $frac1 + $frac2; |
452
|
|
|
|
|
|
|
} |
453
|
|
|
|
|
|
|
|
454
|
|
|
|
|
|
|
sub mul { |
455
|
7
|
|
|
7
|
1
|
9
|
my @frac1 = @{ $_[0]{frac} }; |
|
7
|
|
|
|
|
16
|
|
456
|
7
|
|
|
|
|
7
|
my @tags1 = @{ $_[0]{tags} }; |
|
7
|
|
|
|
|
15
|
|
457
|
7
|
|
|
|
|
10
|
my (@frac2, @frac, @tags2); |
458
|
7
|
100
|
|
|
|
14
|
@frac2 = @{ $_[1]->{frac} }, @tags2 = @{ $_[1]->{tags} } if ref($_[1]) eq "Math::FractionManip"; |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
5
|
|
459
|
7
|
100
|
|
|
|
18
|
@frac2 = (_from_decimal($_[1])), $tags2[$INTERNAL] = 'CONVERTED' if ref($_[1]) ne "Math::FractionManip"; |
460
|
7
|
|
|
|
|
21
|
my @tags = _tags_preserve([@tags1], [@tags2]); |
461
|
7
|
|
|
|
|
16
|
my $skipauto = 0; |
462
|
|
|
|
|
|
|
LOOP: { |
463
|
7
|
100
|
|
|
|
7
|
if (_tag($REDUCE, \@tags) eq 'NO_REDUCE') { |
|
8
|
|
|
|
|
41
|
|
464
|
2
|
|
|
|
|
6
|
@frac = ($frac1[0] * $frac2[0], $frac1[1] * $frac2[1]); |
465
|
|
|
|
|
|
|
} |
466
|
|
|
|
|
|
|
else { |
467
|
6
|
|
|
|
|
10
|
my ($gcd1, $gcd2) = (_gcd($frac1[0], $frac2[1]), _gcd($frac2[0], $frac1[1])); |
468
|
6
|
|
|
|
|
13
|
$frac[0] = ($frac1[0] / $gcd1) * ($frac2[0] / $gcd2); |
469
|
6
|
|
|
|
|
11
|
$frac[1] = ($frac1[1] / $gcd2) * ($frac2[1] / $gcd1); |
470
|
6
|
|
|
|
|
8
|
$tags[$RED_STATE] = 'IS_REDUCED'; |
471
|
|
|
|
|
|
|
} |
472
|
8
|
100
|
66
|
|
|
217
|
if ((_tag($AUTO, \@tags) eq 'AUTO') and (not $skipauto) and |
|
|
|
66
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
66
|
|
|
|
|
473
|
|
|
|
|
|
|
($tags[$SIZE] eq 'SMALL') and ($frac[0] =~ /[eE]/ or $frac[1] =~ /[eE]/)) |
474
|
|
|
|
|
|
|
{ |
475
|
1
|
|
|
|
|
3
|
(@frac1[0 .. 1], @frac2[0 .. 1]) = map { Math::BigInt->new($_) } (@frac1, @frac2); |
|
4
|
|
|
|
|
125
|
|
476
|
1
|
|
|
|
|
36
|
$tags[$SIZE] = 'BIG'; |
477
|
1
|
|
|
|
|
2
|
$skipauto = 1; |
478
|
1
|
|
|
|
|
3
|
redo LOOP; |
479
|
|
|
|
|
|
|
} |
480
|
|
|
|
|
|
|
} |
481
|
7
|
|
|
|
|
20
|
return Math::FractionManip->new(@frac, @tags); |
482
|
|
|
|
|
|
|
} |
483
|
|
|
|
|
|
|
|
484
|
|
|
|
|
|
|
sub div { |
485
|
1
|
|
|
1
|
1
|
4
|
my ($frac1, $frac2) = ($_[$_[2]], $_[not $_[2]]); # swap if needed |
486
|
1
|
50
|
|
|
|
4
|
$frac1 = Math::FractionManip->new($frac1, 'CONVERTED') if ref($frac1) ne "Math::FractionManip"; |
487
|
1
|
50
|
|
|
|
3
|
$frac2 = Math::FractionManip->new($frac2, 'CONVERTED') if ref($frac2) ne "Math::FractionManip"; |
488
|
|
|
|
|
|
|
|
489
|
1
|
|
|
|
|
2
|
$frac2 = Math::FractionManip->new($frac2->{frac}[1], $frac2->{frac}[0], @{ $frac2->{tags} }); |
|
1
|
|
|
|
|
4
|
|
490
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
#Makes a copy of the fraction with the num and den switched. |
492
|
|
|
|
|
|
|
|
493
|
1
|
|
|
|
|
4
|
return $frac1 * $frac2; |
494
|
|
|
|
|
|
|
} |
495
|
|
|
|
|
|
|
|
496
|
|
|
|
|
|
|
sub pow { |
497
|
2
|
|
|
2
|
1
|
5
|
my (@frac, @frac1, @tags1); |
498
|
2
|
50
|
|
|
|
7
|
@frac1 = @{ $_[$_[2]]->{frac} }, @tags1 = @{ $_[$_[2]]->{tags} } if ref($_[$_[2]]) eq "Math::FractionManip"; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
5
|
|
499
|
2
|
50
|
|
|
|
7
|
@frac1 = _from_decimal($_[$_[2]]) if ref($_[$_[2]]) ne "Math::FractionManip"; |
500
|
2
|
|
|
|
|
3
|
my $frac2; |
501
|
2
|
50
|
|
|
|
4
|
$frac2 = $_[not $_[2]]->decimal if ref($_[not $_[2]]) eq "Math::FractionManip"; |
502
|
2
|
50
|
|
|
|
5
|
$frac2 = $_[not $_[2]] if ref($_[not $_[2]]) ne "Math::FractionManip"; |
503
|
2
|
|
|
|
|
4
|
my @tags = @tags1; |
504
|
2
|
|
|
|
|
3
|
my $skipauto = 0; |
505
|
|
|
|
|
|
|
|
506
|
|
|
|
|
|
|
LOOP: { |
507
|
2
|
|
|
|
|
4
|
@frac = ($frac1[0] ** $frac2, $frac1[1] ** $frac2); |
|
2
|
|
|
|
|
8
|
|
508
|
|
|
|
|
|
|
|
509
|
2
|
50
|
33
|
|
|
5
|
if ((_tag($AUTO, \@tags) eq 'AUTO') and (not $skipauto) and |
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
510
|
|
|
|
|
|
|
($tags[$SIZE] eq 'SMALL') and ($frac[0] =~ /[eE]/ or $frac[1] =~ /[eE]/)) |
511
|
|
|
|
|
|
|
{ |
512
|
0
|
|
|
|
|
0
|
@frac1 = map { Math::BigInt->new($_) } @frac1; |
|
0
|
|
|
|
|
0
|
|
513
|
0
|
|
|
|
|
0
|
$tags[$SIZE] = 'BIG'; |
514
|
0
|
|
|
|
|
0
|
$skipauto = 1; |
515
|
0
|
|
|
|
|
0
|
redo LOOP; |
516
|
|
|
|
|
|
|
} |
517
|
|
|
|
|
|
|
} |
518
|
|
|
|
|
|
|
|
519
|
2
|
|
|
|
|
7
|
return Math::FractionManip->new(@frac, @tags); |
520
|
|
|
|
|
|
|
} |
521
|
|
|
|
|
|
|
|
522
|
|
|
|
|
|
|
sub sqrt { |
523
|
1
|
|
|
1
|
1
|
910
|
my $self = shift; |
524
|
1
|
|
|
|
|
2
|
my @frac = @{ $self->{frac} }; |
|
1
|
|
|
|
|
3
|
|
525
|
1
|
|
|
|
|
2
|
my @tags = @{ $self->{tags} }; |
|
1
|
|
|
|
|
3
|
|
526
|
1
|
|
|
|
|
2
|
my $ans; |
527
|
1
|
50
|
|
|
|
3
|
if (ref($frac[0])) { |
528
|
0
|
|
|
|
|
0
|
$frac[0] = Math::BigFloat->new(Math::BigFloat::fsqrt($frac[0], $DEF{CURRENT}{DIGITS})); |
529
|
0
|
|
|
|
|
0
|
$frac[1] = Math::BigFloat->new(Math::BigFloat::fsqrt($frac[1], $DEF{CURRENT}{DIGITS})); |
530
|
|
|
|
|
|
|
} |
531
|
|
|
|
|
|
|
else { |
532
|
1
|
|
|
|
|
4
|
@frac = (sqrt($frac[0]), sqrt($frac[1])); |
533
|
|
|
|
|
|
|
} |
534
|
1
|
|
|
|
|
4
|
return Math::FractionManip->new(@frac, @tags); |
535
|
|
|
|
|
|
|
} |
536
|
|
|
|
|
|
|
|
537
|
|
|
|
|
|
|
sub abs { |
538
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
539
|
0
|
|
|
|
|
0
|
my @frac = @{ $self->{frac} }; |
|
0
|
|
|
|
|
0
|
|
540
|
0
|
|
|
|
|
0
|
my @tags = @{ $self->{tags} }; |
|
0
|
|
|
|
|
0
|
|
541
|
0
|
|
|
|
|
0
|
return Math::FractionManip->new(abs($frac[0]), abs($frac[1]), @tags, 'IS_REDUCED'); |
542
|
|
|
|
|
|
|
} |
543
|
|
|
|
|
|
|
|
544
|
|
|
|
|
|
|
sub cmp { |
545
|
0
|
|
|
0
|
1
|
0
|
my @frac1 = @{ $_[0]->{frac} }; |
|
0
|
|
|
|
|
0
|
|
546
|
0
|
|
|
|
|
0
|
my @tags1 = @{ $_[0]->{tags} }; |
|
0
|
|
|
|
|
0
|
|
547
|
0
|
|
|
|
|
0
|
my (@frac2, @frac, @tags2, $x, $y); |
548
|
0
|
0
|
|
|
|
0
|
@frac2 = @{ $_[1]->{frac} }, @tags2 = @{ $_[1]->{tags} } if ref($_[1]) eq "Math::FractionManip"; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
549
|
0
|
0
|
|
|
|
0
|
@frac2 = _from_decimal($_[1]), @tags2 = qw(CONVERTED) if ref($_[1]) ne "Math::FractionManip"; |
550
|
0
|
|
|
|
|
0
|
my @tags = _tags_preserve([@tags1], [@tags2]); |
551
|
0
|
0
|
|
|
|
0
|
if (_tag($REDUCE, \@tags) == 'NO_REDUCE') { |
552
|
0
|
|
|
|
|
0
|
$x = $frac1[0] * $frac2[1]; |
553
|
0
|
|
|
|
|
0
|
$y = $frac2[0] * $frac1[1]; |
554
|
|
|
|
|
|
|
} |
555
|
|
|
|
|
|
|
else { |
556
|
0
|
|
|
|
|
0
|
my $gcd1 = _gcd($frac1[1], $frac2[1]); |
557
|
0
|
|
|
|
|
0
|
$x = $frac1[0] * ($frac2[1] / $gcd1); |
558
|
0
|
|
|
|
|
0
|
$y = $frac2[0] * ($frac1[1] / $gcd1); |
559
|
|
|
|
|
|
|
} |
560
|
0
|
|
|
|
|
0
|
return $x <=> $y; |
561
|
|
|
|
|
|
|
} |
562
|
|
|
|
|
|
|
|
563
|
|
|
|
|
|
|
################################ |
564
|
|
|
|
|
|
|
# These functions are internal |
565
|
|
|
|
|
|
|
|
566
|
|
|
|
|
|
|
sub _fix_num { |
567
|
67
|
|
|
67
|
|
88
|
my $tagsref = shift; |
568
|
67
|
|
|
|
|
114
|
my @return = @_; |
569
|
67
|
|
|
|
|
99
|
my $auto = _tag($AUTO, $tagsref) eq 'AUTO'; |
570
|
67
|
|
|
|
|
128
|
$tagsref->[$SIZE] = _tag($SIZE, $tagsref); |
571
|
67
|
50
|
|
|
|
106
|
$tagsref->[$SIZE] = 'SMALL' if $auto; |
572
|
67
|
|
|
|
|
80
|
my $num; |
573
|
67
|
|
|
|
|
75
|
my $decimal = 0; |
574
|
67
|
|
|
|
|
86
|
foreach $num (@return) { |
575
|
133
|
50
|
|
|
|
378
|
if (ref($num) eq "Math::BigFloat") { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
576
|
0
|
0
|
|
|
|
0
|
$tagsref->[$SIZE] = 'BIG' unless $auto; |
577
|
0
|
|
|
|
|
0
|
$decimal = 1; |
578
|
|
|
|
|
|
|
} |
579
|
|
|
|
|
|
|
elsif (ref($num) eq "Math::BigInt") { |
580
|
4
|
50
|
|
|
|
7
|
$tagsref->[$SIZE] = 'BIG' unless $auto; |
581
|
|
|
|
|
|
|
} |
582
|
|
|
|
|
|
|
elsif (ref($num)) { |
583
|
|
|
|
|
|
|
|
584
|
|
|
|
|
|
|
# do nothing |
585
|
|
|
|
|
|
|
} |
586
|
|
|
|
|
|
|
elsif ($num =~ /[\.\e]/) { |
587
|
9
|
|
|
|
|
12
|
$decimal = 1; |
588
|
|
|
|
|
|
|
} |
589
|
133
|
50
|
|
|
|
212
|
if ($auto) { |
590
|
133
|
|
|
|
|
313
|
$num =~ /[\+\-]?\s*0*([0-9]*)\s*\.?\s*([0-9]*)0*/; |
591
|
133
|
|
|
|
|
363
|
my $length = length($1) + length($2); |
592
|
133
|
100
|
|
|
|
243
|
$tagsref->[$SIZE] = 'BIG' if $length > 15; |
593
|
|
|
|
|
|
|
} |
594
|
|
|
|
|
|
|
} |
595
|
67
|
100
|
|
|
|
109
|
if ($tagsref->[$SIZE] eq 'BIG') { |
596
|
2
|
50
|
|
|
|
6
|
@return = map { Math::BigInt->new("$_") } @return if not $decimal; |
|
4
|
|
|
|
|
132
|
|
597
|
2
|
50
|
|
|
|
127
|
@return = map { Math::BigFloat->new("$_") } @return if $decimal; |
|
0
|
|
|
|
|
0
|
|
598
|
|
|
|
|
|
|
} |
599
|
67
|
100
|
66
|
|
|
178
|
if ($tagsref->[$SIZE] eq 'SMALL' and $auto) { |
600
|
65
|
|
|
|
|
97
|
@return = map { "$_" + 0 } @return; |
|
129
|
|
|
|
|
352
|
|
601
|
|
|
|
|
|
|
} |
602
|
67
|
|
|
|
|
157
|
return ($decimal, @return); |
603
|
|
|
|
|
|
|
} |
604
|
|
|
|
|
|
|
|
605
|
|
|
|
|
|
|
sub _fix_auto { |
606
|
6
|
|
|
6
|
|
9
|
my $direction = shift; |
607
|
6
|
|
|
|
|
6
|
my $tagsref = shift; |
608
|
6
|
|
|
|
|
10
|
my @return = @_; |
609
|
6
|
|
|
|
|
9
|
$tagsref->[$SIZE] = 'SMALL'; |
610
|
6
|
|
|
|
|
6
|
my $num; |
611
|
6
|
|
|
|
|
10
|
foreach $num (@return) { |
612
|
12
|
|
|
|
|
54
|
$num =~ /[\+\-]?\s*0*([0-9]*)\s*\.?\s*([0-9]*)0*/; |
613
|
12
|
|
|
|
|
24
|
my $length = length($1) + length($2); |
614
|
12
|
50
|
|
|
|
22
|
$tagsref->[$SIZE] = 'BIG' if $length > 15; |
615
|
|
|
|
|
|
|
} |
616
|
6
|
50
|
33
|
|
|
29
|
if ($tagsref->[$SIZE] eq 'BIG' and $direction eq 'BOTH') { |
|
|
50
|
|
|
|
|
|
617
|
0
|
|
|
|
|
0
|
@return = map { Math::BigInt->new("$_") } @return; |
|
0
|
|
|
|
|
0
|
|
618
|
|
|
|
|
|
|
} |
619
|
|
|
|
|
|
|
elsif ($tagsref->[$SIZE] eq 'SMALL') { |
620
|
6
|
|
|
|
|
8
|
@return = map { "$_" + 0 } @return; |
|
12
|
|
|
|
|
38
|
|
621
|
|
|
|
|
|
|
} |
622
|
6
|
|
|
|
|
13
|
return (@return); |
623
|
|
|
|
|
|
|
} |
624
|
|
|
|
|
|
|
|
625
|
|
|
|
|
|
|
sub _is_decimal { |
626
|
302
|
100
|
|
302
|
|
547
|
return undef unless defined $_[0]; |
627
|
254
|
|
|
|
|
729
|
my $return = $_[0] =~ /^\s*[\+\-0-9eE\.]+\s*$/; |
628
|
254
|
|
|
|
|
997
|
return $return; |
629
|
|
|
|
|
|
|
} |
630
|
|
|
|
|
|
|
|
631
|
|
|
|
|
|
|
sub _reduce { |
632
|
33
|
|
|
33
|
|
49
|
my @frac = @_; |
633
|
33
|
|
|
|
|
50
|
my $gcd = _gcd(@frac); |
634
|
33
|
100
|
|
|
|
58
|
if ($gcd == 1) { |
635
|
27
|
|
|
|
|
58
|
return (0, @frac); |
636
|
|
|
|
|
|
|
} |
637
|
|
|
|
|
|
|
else { |
638
|
6
|
|
|
|
|
16
|
return (1, $frac[0] / $gcd, $frac[1] / $gcd); |
639
|
|
|
|
|
|
|
} |
640
|
|
|
|
|
|
|
} |
641
|
|
|
|
|
|
|
|
642
|
|
|
|
|
|
|
sub _simplify_sign { |
643
|
55
|
|
|
55
|
|
77
|
my @frac = @_; |
644
|
55
|
|
|
|
|
68
|
my $sign = 1; |
645
|
55
|
100
|
|
|
|
116
|
$sign = ($frac[0] / CORE::abs($frac[0])) * ($frac[1] / CORE::abs($frac[1])) if $frac[0]; |
646
|
55
|
|
|
|
|
847
|
@frac = ($sign * CORE::abs($frac[0]), CORE::abs($frac[1])); |
647
|
55
|
|
|
|
|
735
|
return @frac; |
648
|
|
|
|
|
|
|
} |
649
|
|
|
|
|
|
|
|
650
|
|
|
|
|
|
|
sub _tags { |
651
|
70
|
|
|
70
|
|
112
|
my @return = (undef, undef); |
652
|
70
|
|
|
|
|
92
|
my ($NUM, $VALUE) = (0, 1); |
653
|
|
|
|
|
|
|
|
654
|
70
|
|
|
|
|
182
|
foreach (@_) { |
655
|
194
|
100
|
|
|
|
331
|
next if not $TAGS{$_}; |
656
|
81
|
|
|
|
|
99
|
my ($num, $value) = @{ $TAGS{$_} }; |
|
81
|
|
|
|
|
132
|
|
657
|
81
|
|
|
|
|
137
|
$return[$num] = $value; |
658
|
|
|
|
|
|
|
} |
659
|
|
|
|
|
|
|
|
660
|
70
|
|
|
|
|
145
|
return @return; |
661
|
|
|
|
|
|
|
} |
662
|
|
|
|
|
|
|
|
663
|
|
|
|
|
|
|
sub _tag { |
664
|
416
|
|
|
416
|
|
511
|
my $item = shift; |
665
|
416
|
|
|
|
|
457
|
my $return; |
666
|
|
|
|
|
|
|
my $ref; |
667
|
416
|
|
|
|
|
652
|
foreach $ref (@_, $DEF{CURRENT}{TAGS}) { |
668
|
769
|
100
|
|
|
|
783
|
last if $return = ${$ref}[$item]; |
|
769
|
|
|
|
|
1449
|
|
669
|
|
|
|
|
|
|
} |
670
|
416
|
|
|
|
|
1159
|
return $return; |
671
|
|
|
|
|
|
|
} |
672
|
|
|
|
|
|
|
|
673
|
|
|
|
|
|
|
sub _tagnum { |
674
|
7
|
|
|
7
|
|
8
|
my $item = shift; |
675
|
7
|
50
|
|
|
|
16
|
if (exists $TAGS{$item}) { |
676
|
7
|
|
|
|
|
14
|
return $TAGS{$item}[0]; |
677
|
|
|
|
|
|
|
} |
678
|
|
|
|
|
|
|
else { |
679
|
0
|
|
|
|
|
0
|
return -1; |
680
|
|
|
|
|
|
|
} |
681
|
|
|
|
|
|
|
} |
682
|
|
|
|
|
|
|
|
683
|
|
|
|
|
|
|
sub _tags_preserve { |
684
|
23
|
|
|
23
|
|
26
|
my @tags1 = @{ $_[0] }; |
|
23
|
|
|
|
|
36
|
|
685
|
23
|
|
|
|
|
29
|
my @tags2 = @{ $_[1] }; |
|
23
|
|
|
|
|
42
|
|
686
|
23
|
|
|
|
|
28
|
my @tags; |
687
|
23
|
50
|
|
|
|
52
|
if ($tags1[$INTERNAL] eq 'CONVERTED') { |
|
|
100
|
|
|
|
|
|
688
|
0
|
|
|
|
|
0
|
@tags = @tags2; |
689
|
|
|
|
|
|
|
} |
690
|
|
|
|
|
|
|
elsif ($tags2[$INTERNAL] eq 'CONVERTED') { |
691
|
10
|
|
|
|
|
41
|
@tags = @tags1; |
692
|
|
|
|
|
|
|
} |
693
|
|
|
|
|
|
|
else { |
694
|
13
|
50
|
|
|
|
24
|
@tags = map { $tags1[$_] eq $tags2[$_] and $tags1[$_] } (0 .. $#tags1); |
|
51
|
|
|
|
|
144
|
|
695
|
|
|
|
|
|
|
} |
696
|
23
|
|
|
|
|
50
|
return @tags; |
697
|
|
|
|
|
|
|
} |
698
|
|
|
|
|
|
|
|
699
|
|
|
|
|
|
|
sub _gcd { |
700
|
71
|
|
|
71
|
|
113
|
my ($x, $y) = (CORE::abs($_[0]), CORE::abs($_[1])); |
701
|
71
|
50
|
|
|
|
95
|
if (ref($x)) { |
702
|
0
|
|
|
|
|
0
|
$x = Math::BigInt->new($x->bgcd($y)); |
703
|
|
|
|
|
|
|
} |
704
|
|
|
|
|
|
|
else { |
705
|
|
|
|
|
|
|
{ |
706
|
71
|
50
|
|
|
|
77
|
$x = 1, last if $y > 1e17; # If this is so % will thinks its a zero so if |
|
71
|
|
|
|
|
117
|
|
707
|
|
|
|
|
|
|
# $y>1e17 will simply will basicly give up and |
708
|
|
|
|
|
|
|
# have it return 1 as the GCD. |
709
|
71
|
|
|
|
|
115
|
my ($x0); |
710
|
71
|
|
|
|
|
114
|
while ($y != 0) { |
711
|
179
|
|
|
|
|
189
|
$x0 = $x; |
712
|
179
|
|
|
|
|
233
|
($x, $y) = ($y, $x % $y); |
713
|
|
|
|
|
|
|
|
714
|
|
|
|
|
|
|
# Note $x0 = $x, $x = $y, $y= $x % $y Before the Swith |
715
|
179
|
100
|
66
|
|
|
508
|
$x = 1, last if ($x0 > 99999999 or $x > 999999999) and int($x0 / $x) * $x + $y != $x0; |
|
|
|
100
|
|
|
|
|
716
|
|
|
|
|
|
|
|
717
|
|
|
|
|
|
|
# This is to see if the mod operater through up on us when dealing with |
718
|
|
|
|
|
|
|
# large numbers. If it did set the gcd = 1 and quit. |
719
|
|
|
|
|
|
|
} |
720
|
|
|
|
|
|
|
} |
721
|
|
|
|
|
|
|
} |
722
|
71
|
|
|
|
|
110
|
return $x; |
723
|
|
|
|
|
|
|
} |
724
|
|
|
|
|
|
|
|
725
|
|
|
|
|
|
|
sub _de_decimal { |
726
|
3
|
|
|
3
|
|
5
|
my @frac = @_; |
727
|
3
|
|
|
|
|
5
|
my @return; |
728
|
3
|
|
|
|
|
5
|
my $big = _tag($SIZE, $_[2]); |
729
|
3
|
|
|
|
|
3
|
my (@int_part, @decimal_part); |
730
|
3
|
|
|
|
|
18
|
($int_part[0], $decimal_part[0]) = $frac[0] =~ /(\d+)\.(\d+)/; |
731
|
3
|
|
|
|
|
14
|
($int_part[1], $decimal_part[1]) = $frac[1] =~ /(\d+)\.(\d+)/; |
732
|
3
|
|
|
|
|
11
|
@decimal_part = sort { $a <=> $b } (length($decimal_part[0]), length($decimal_part[1])); |
|
3
|
|
|
|
|
10
|
|
733
|
3
|
|
|
|
|
6
|
my $factor = 10 ** $decimal_part[1]; |
734
|
3
|
|
|
|
|
7
|
@frac = ($_[0] * $factor, $_[1] * $factor); |
735
|
3
|
|
|
|
|
7
|
return @frac; |
736
|
|
|
|
|
|
|
} |
737
|
|
|
|
|
|
|
|
738
|
|
|
|
|
|
|
sub _from_decimal { |
739
|
13
|
|
|
13
|
|
19
|
my $decimal = shift; # the decimal (1.312671267127) |
740
|
13
|
50
|
|
|
|
22
|
my $big = 'BIG' if ref($decimal); |
741
|
13
|
|
|
|
|
95
|
my ($repeat); # flag to keep track if it is repeating or not |
742
|
|
|
|
|
|
|
my ($sign); |
743
|
13
|
|
|
|
|
0
|
my ($factor, $int_factor); |
744
|
13
|
|
|
|
|
0
|
my ($factor2); |
745
|
13
|
|
|
|
|
0
|
my ($whole_num, $whole_num_len); |
746
|
13
|
|
|
|
|
0
|
my ($int_part); # integer part (1) |
747
|
13
|
|
|
|
|
0
|
my ($decimal_part, $decimal_part_len); # decimal part (312671267127) |
748
|
13
|
|
|
|
|
0
|
my ($decimal_part2); # decimal part - last bit \/ (312671267) |
749
|
13
|
|
|
|
|
0
|
my ($pat, $pat_len); # repeating pat (1267) |
750
|
13
|
|
|
|
|
0
|
my ($pat_lastb); # last bit of repeating pat (127) |
751
|
13
|
|
|
|
|
0
|
my ($beg_part, $beg_part_len); # non-repeating part (3) |
752
|
13
|
|
|
|
|
0
|
my ($other_part, $other_part_len); # repeating part (1267126712127) |
753
|
13
|
|
|
|
|
0
|
my ($frac1, $frac2, $frac3); |
754
|
|
|
|
|
|
|
|
755
|
13
|
|
|
|
|
48
|
my $rnd_mode = $Math::BigFloat::rnd_mode; # to avoid problems with incon. |
756
|
13
|
|
|
|
|
57
|
$Math::BigFloat::rnd_mode = 'trunc'; # rounding |
757
|
|
|
|
|
|
|
|
758
|
13
|
|
|
|
|
218
|
$decimal = "$decimal"; |
759
|
13
|
|
|
|
|
24
|
$decimal =~ s/\s//g; |
760
|
13
|
|
|
|
|
30
|
($sign, $int_part, $decimal_part) = $decimal =~ /([\+\-]?)\s*(\d*)\.(\d+)$/; |
761
|
13
|
|
|
|
|
19
|
$sign .= '1'; |
762
|
13
|
|
|
|
|
14
|
$decimal_part_len = length($decimal_part); |
763
|
13
|
100
|
|
|
|
24
|
$int_part = "" unless $int_part; |
764
|
13
|
|
|
|
|
24
|
$factor = '1' . '0' x (length($decimal_part)); |
765
|
13
|
50
|
|
|
|
20
|
$factor = Math::BigFloat->new($factor) if $big; |
766
|
|
|
|
|
|
|
|
767
|
|
|
|
|
|
|
# Make it a BigFloat now to simplfy latter |
768
|
13
|
|
|
|
|
16
|
$int_factor = '1' . '0' x (length($int_part)); |
769
|
13
|
|
|
|
|
17
|
$beg_part_len = 0; |
770
|
|
|
|
|
|
|
OuterBlock: |
771
|
13
|
|
|
|
|
26
|
while ($beg_part_len < $decimal_part_len) { |
772
|
4
|
|
|
|
|
8
|
$beg_part = substr($decimal_part, 0, $beg_part_len); |
773
|
4
|
|
|
|
|
5
|
$other_part = substr($decimal_part, $beg_part_len); |
774
|
4
|
|
|
|
|
5
|
$other_part_len = length($other_part); |
775
|
4
|
|
|
|
|
4
|
my $i; |
776
|
4
|
|
|
|
|
21
|
for ($i = 1; $i < ($other_part_len / 2 + 1); $i++) { |
777
|
4
|
|
|
|
|
7
|
$pat = substr($other_part, 0, $i); |
778
|
4
|
|
|
|
|
5
|
$pat_len = $i; |
779
|
4
|
|
|
|
|
7
|
local $_ = $other_part; |
780
|
4
|
|
|
|
|
5
|
$repeat = undef; |
781
|
4
|
|
|
|
|
4
|
while (1) { |
782
|
21
|
|
|
|
|
231
|
($_) = /^$pat(.*)/; |
783
|
21
|
|
|
|
|
36
|
my $length = length($_); |
784
|
|
|
|
|
|
|
|
785
|
21
|
100
|
|
|
|
36
|
if ($length <= $pat_len) { |
786
|
4
|
50
|
|
|
|
7
|
last unless $length; |
787
|
4
|
|
|
|
|
7
|
$pat_lastb = substr($pat, 0, $length); |
788
|
4
|
100
|
|
|
|
10
|
$repeat = 1, last OuterBlock if $pat_lastb eq $_; |
789
|
2
|
50
|
|
|
|
7
|
if ($pat_lastb eq $_ - 1) { |
790
|
|
|
|
|
|
|
|
791
|
|
|
|
|
|
|
# this is needed to see if it really is the repeating fracton |
792
|
|
|
|
|
|
|
# we intented it to be. If we don't do this 1.1212 would become |
793
|
|
|
|
|
|
|
# 1120/999 = 1.1211211211. |
794
|
|
|
|
|
|
|
# The first three lines converts it to a fraction and the |
795
|
|
|
|
|
|
|
# rests tests it to the actual repeating decimal/ |
796
|
|
|
|
|
|
|
# The NO_REDUCE flag is their to save time as reducing large |
797
|
|
|
|
|
|
|
# fraction can take a bit of time which is unnecessary as we will |
798
|
|
|
|
|
|
|
# be converting it to a decimal. |
799
|
2
|
|
|
|
|
20
|
$decimal_part2 = substr($decimal_part, 0, $decimal_part_len - length($pat_lastb)); |
800
|
2
|
|
|
|
|
6
|
$factor2 = '1' . '0' x (length($decimal_part2)); |
801
|
2
|
|
|
|
|
20
|
$frac1 = Math::FractionManip->new('0' . $beg_part, 1 . 0 x $beg_part_len, 'NO_REDUCE', $big); |
802
|
2
|
|
|
|
|
9
|
$frac2 = Math::FractionManip->new('0' . $pat, 9 x $pat_len . 0 x $beg_part_len, 'NO_REDUCE', $big); |
803
|
2
|
|
|
|
|
9
|
$frac3 = $frac1 + $frac2; |
804
|
2
|
|
|
|
|
6
|
my $what_i_get = $frac3->decimal; |
805
|
2
|
|
|
|
|
10
|
my $places = length($what_i_get); |
806
|
2
|
50
|
|
|
|
9
|
my $decimal_p_tmp = $decimal_part2 if not $big; |
807
|
2
|
50
|
|
|
|
4
|
$decimal_p_tmp = Math::BigFloat->new($decimal_part2) if $big; |
808
|
2
|
|
|
|
|
10
|
my $what_i_should_get = (($decimal_p_tmp) / $factor2) . "$pat" x ($places); |
809
|
|
|
|
|
|
|
|
810
|
|
|
|
|
|
|
# The rest of this is doing nothing more but trying to compare |
811
|
|
|
|
|
|
|
# the what_i_get and what_i_should_get but becuse the stupid |
812
|
|
|
|
|
|
|
# BigFloat module is so pragmentic all this hopla is nessary |
813
|
2
|
50
|
|
|
|
10
|
$what_i_should_get = Math::BigFloat->new($what_i_should_get) if $big; |
814
|
2
|
50
|
|
|
|
5
|
$what_i_should_get = $what_i_should_get->fround(length($what_i_get) - 1) if $big; |
815
|
2
|
50
|
|
|
|
13
|
$what_i_should_get = Math::BigFloat->new($what_i_should_get) if $big; |
816
|
|
|
|
|
|
|
# ^^ Needed because the fround method does not return a BigFloat object! |
817
|
|
|
|
|
|
|
|
818
|
2
|
50
|
|
|
|
5
|
my $pass = "$what_i_get" eq "$what_i_should_get" if $big; |
819
|
2
|
50
|
|
|
|
7
|
$pass = $what_i_get == $what_i_should_get if not $big; |
820
|
2
|
50
|
|
|
|
9
|
$repeat = 1, last OuterBlock if ($pass); |
821
|
|
|
|
|
|
|
} |
822
|
|
|
|
|
|
|
} |
823
|
|
|
|
|
|
|
} |
824
|
|
|
|
|
|
|
} |
825
|
0
|
|
|
|
|
0
|
$beg_part_len++; |
826
|
|
|
|
|
|
|
} |
827
|
13
|
100
|
|
|
|
22
|
if ($repeat) { |
828
|
4
|
|
|
|
|
15
|
$frac1 = Math::FractionManip->new('0' . $beg_part, 1 . 0 x $beg_part_len, $big); |
829
|
4
|
|
|
|
|
13
|
$frac2 = Math::FractionManip->new('0' . $pat, 9 x $pat_len . 0 x $beg_part_len, $big); |
830
|
4
|
50
|
|
|
|
9
|
$int_part = Math::FractionManip->new('0' . $int_part, 1, 'BIG') if $big; |
831
|
4
|
|
|
|
|
9
|
$frac3 = $sign * ($int_part + $frac1 + $frac2); |
832
|
4
|
|
|
|
|
9
|
return @{ $frac3->{frac} }; |
|
4
|
|
|
|
|
19
|
|
833
|
|
|
|
|
|
|
} |
834
|
|
|
|
|
|
|
else { |
835
|
9
|
|
|
|
|
33
|
return ($decimal * $factor, $factor, $big); |
836
|
|
|
|
|
|
|
} |
837
|
0
|
|
|
|
|
|
$Math::BigFloat::rnd_mode = $rnd_mode; # set it back to what it was. |
838
|
|
|
|
|
|
|
} |
839
|
|
|
|
|
|
|
|
840
|
|
|
|
|
|
|
1; |
841
|
|
|
|
|
|
|
|
842
|
|
|
|
|
|
|
__END__ |