File Coverage

blib/lib/Math/Cephes/Fraction.pm
Criterion Covered Total %
statement 60 103 58.2
branch 14 34 41.1
condition n/a
subroutine 14 18 77.7
pod 0 14 0.0
total 88 169 52.0


line stmt bran cond sub pod time code
1             ############# Class : fract ##############
2             package Math::Cephes::Fraction;
3 2     2   10773 use strict;
  2         5  
  2         80  
4 2     2   11 use warnings;
  2         2  
  2         68  
5 2         5199 use vars qw(%OWNER @ISA %ITERATORS
6 2     2   9 @EXPORT_OK %EXPORT_TAGS $VERSION);
  2         4  
7              
8             require Exporter;
9             *import = \&Exporter::import;
10             #my @fract = qw(radd rsub rmul rdiv euclid fract mixed_fract);
11             my @fract = qw(euclid fract mixed_fract);
12             @EXPORT_OK = (@fract);
13             %EXPORT_TAGS = ('fract' => [@fract]);
14              
15             $VERSION = '0.5304';
16             #use Math::Cephes qw(new_fract euclid);
17             require Math::Cephes;
18             @ISA = qw( Math::Cephes );
19              
20             %OWNER = ();
21             %ITERATORS = ();
22              
23             *swig_n_get = *Math::Cephesc::fract_n_get;
24             *swig_n_set = *Math::Cephesc::fract_n_set;
25             *swig_d_get = *Math::Cephesc::fract_d_get;
26             *swig_d_set = *Math::Cephesc::fract_d_set;
27             sub new {
28 47     47 0 1627 my $pkg = shift;
29 47         592 my $self = Math::Cephesc::new_fract(@_);
30 47 50       350 bless $self, $pkg if defined($self);
31             }
32              
33             sub DESTROY {
34 94 100   94   899 return unless $_[0]->isa('HASH');
35 47         47 my $self = tied(%{$_[0]});
  47         96  
36 47 50       83 return unless defined $self;
37 47         114 delete $ITERATORS{$self};
38 47 50       164 if (exists $OWNER{$self}) {
39 47         125 Math::Cephesc::delete_fract($self);
40 47         192 delete $OWNER{$self};
41             }
42             }
43              
44             sub DISOWN {
45 0     0 0 0 my $self = shift;
46 0         0 my $ptr = tied(%$self);
47 0         0 delete $OWNER{$ptr};
48             }
49              
50             sub ACQUIRE {
51 0     0 0 0 my $self = shift;
52 0         0 my $ptr = tied(%$self);
53 0         0 $OWNER{$ptr} = 1;
54             }
55              
56              
57             sub fract {
58 2     2 0 11955 return Math::Cephes::Fraction->new(@_);
59             }
60              
61             sub n {
62 45     45 0 1076 my ($self, $value) = @_;
63 45 100       762 return $self->{n} unless $value;
64 2         21 $self->{n} = $value;
65 2         6 return $value;
66             }
67              
68             sub d {
69 45     45 0 75 my ($self, $value) = @_;
70 45 100       270 return $self->{d} unless $value;
71 2         9 $self->{d} = $value;
72 2         4 return $value;
73             }
74              
75             sub euclid {
76 3     3 0 583 return Math::Cephes::euclid($_[0], $_[1]);
77             }
78              
79              
80             sub mixed_fract {
81 2     2 0 3 my $f = shift;
82 2         9 my $nin = int($f->{n});
83 2         8 my $din = int($f->{d});
84 2         5 my $gcd;
85 2 50       7 if ($din < 0) {
86 0         0 $din *= -1;
87 0         0 $nin *= -1;
88             }
89 2 100       5 if (abs($nin) < abs($din)) {
90 1 50       3 if ( $nin == 0 ) {
91 0         0 return (0, 0, 0);
92             }
93             else {
94 1         4 ($gcd, $nin, $din) = euclid($nin, $din);
95 1         4 return (0, $nin, $din);
96             }
97             }
98             else {
99 1         5 my $n = abs($nin) % $din;
100 1         3 my $w = int($nin / $din);
101 1 50       4 if ($n == 0) {
102 0         0 return ($w, 0, 1);
103             }
104             else {
105 1         4 ($gcd, $n, $din) = euclid($n, $din);
106 1         5 return ($w, $n, $din);
107             }
108             }
109             }
110              
111             sub as_string {
112 0     0 0 0 my $f = shift;
113 0         0 my ($gcd, $string);
114 0         0 my $num = int($f->{n});
115 0         0 my $den = int($f->{d});
116 0 0       0 if ( abs($num % $den) == 0) {
    0          
117 0         0 my $w = $num / $den;
118 0         0 $string = "$w";
119             }
120             elsif ($num == 0) {
121 0         0 $string = '0';
122             }
123             else {
124 0 0       0 if ($den < 0) {
125 0         0 $num *= -1;
126 0         0 $den *= -1;
127             }
128 0         0 ($gcd, $num, $den) = euclid($num, $den);
129 0         0 $string = "$num/$den";
130             }
131 0         0 return $string;
132             }
133              
134             sub as_mixed_string {
135 0     0 0 0 my $f = shift;
136 0         0 my ($gcd, $string);
137 0         0 my $num = int($f->{n});
138 0         0 my $den = int($f->{d});
139 0 0       0 if ($den < 0) {
140 0         0 $den *= -1;
141 0         0 $num *= -1;
142             }
143 0 0       0 if (abs($num) < abs($den)) {
144 0 0       0 if ( $num == 0 ) {
145 0         0 $string = '0';
146             }
147             else {
148 0         0 ($gcd, $num, $den) = euclid($num, $den);
149 0         0 $string = "$num/$den";
150             }
151             }
152             else {
153 0         0 my $n = abs($num) % $den;
154 0         0 my $w = int($num / $den);
155 0 0       0 if ($n == 0) {
156 0         0 $string = "$w";
157             }
158             else {
159 0         0 ($gcd, $num, $den) = euclid($num, $den);
160 0         0 $string = "$w $n/$den";
161             }
162             }
163 0         0 return $string;
164             }
165              
166            
167             sub radd {
168 1     1 0 7 my ($f1, $f2) = @_;
169 1         5 my $f = Math::Cephes::Fraction->new();
170 1         39 Math::Cephes::radd($f1, $f2, $f);
171 1         4 return $f;
172             }
173              
174             sub rsub {
175 1     1 0 6 my ($f1, $f2) = @_;
176 1         5 my $f = Math::Cephes::Fraction->new();
177 1         18 Math::Cephes::rsub($f2, $f1, $f);
178 1         3 return $f;
179             }
180              
181             sub rmul {
182 1     1 0 3 my ($f1, $f2) = @_;
183 1         4 my $f = Math::Cephes::Fraction->new();
184 1         19 Math::Cephes::rmul($f1, $f2, $f);
185 1         3 return $f;
186             }
187              
188             sub rdiv {
189 1     1 0 4 my ($f1, $f2) = @_;
190 1         4 my $f = Math::Cephes::Fraction->new();
191 1         8 Math::Cephes::rdiv($f2, $f1, $f);
192 1         3 return $f;
193             }
194              
195             1;
196              
197             __END__