[system] / trunk / pg / macros / contextPeriodic.pl Repository:
ViewVC logotype

Annotation of /trunk/pg/macros/contextPeriodic.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 4966 - (view) (download) (as text)

1 : gage 4966 package RealPeriodic;
2 :     @ISA = ("Value::Real");
3 :    
4 :     sub new {
5 :     my $self = shift; my $class = ref($self) || $self;
6 :     bless Value::Real->new(@_), $class;
7 :     }
8 :    
9 :     sub compare {
10 :     my ($l,$r,$flag) = @_; my $self = shift;
11 :     my $m = $l->{period};
12 :     return $self->SUPER::compare(@_) unless defined $m;
13 :     if ($l->promotePrecedence($r)) {return $r->compare($l,!$flag)}
14 :     $r = Value::Real::promote($r); if ($flag) {my $tmp = $l; $l = $r; $r = $tmp}
15 :     if ($self->{logPeriodic}) {
16 :     return 1 if $l eq "0" || $r eq "0"; # non-fuzzy checks
17 :     $l = log($l); $r = log($r);
18 :     }
19 :     return modulo($l-$r+$m/2,$m) <=> $m/2;
20 :     }
21 :    
22 :     sub modulo {
23 :     my $a = shift; my $b = shift;
24 :     $a = Value::Real->new($a); $b = Value::Real->new($b); # just in case
25 :     return Value::Real->new(0) if $b eq "0"; # non-fuzzy check
26 :     my $m = ($a/$b)->value;
27 :     my $n = int($m); $n-- if $n > $m; # act as floor() rather than int()
28 :     return $a - $n*$b;
29 :     }
30 :    
31 :     sub isReal {1}
32 :    
33 :    
34 :     package ComplexPeriodic;
35 :     @ISA = ("Value::Complex");
36 :    
37 :     sub new {
38 :     my $self = shift; my $class = ref($self) || $self;
39 :     bless Value::Complex->new(@_), $class;
40 :     }
41 :    
42 :     sub compare {
43 :     my ($l,$r,$flag) = @_; my $self = shift;
44 :     my $m = $l->{period};
45 :     return $self->SUPER::compare(@_) unless defined $m;
46 :     if ($l->promotePrecedence($r)) {return $r->compare($l,!$flag)}
47 :     $r = Value::Complex::promote($r); if ($flag) {my $tmp = $l; $l = $r; $r = $tmp}
48 :     if ($self->{logPeriodic}) {
49 :     return 1 if $l eq "0" || $r eq "0"; # non-fuzzy checks
50 :     $l = log($l); $r = log($r);
51 :     }
52 :     return modulo($l-$r+$m/2,$m) <=> $m/2;
53 :     }
54 :    
55 :     sub modulo {
56 :     my $a = shift; my $b = shift;
57 :     $a = Value::Complex->new($a); $b = Value::Complex->new($b); # just in case
58 :     return Value::Complex->new(0) if $b eq "0"; # non-fuzzy check
59 :     my $m = ($a/$b)->Re->value;
60 :     my $n = int($m); $n-- if $n > $m; # act as floor() rather than int()
61 :     return $a - $n*$b;
62 :     }
63 :    
64 :     sub isComplex {1}
65 :    
66 :     package main;
67 :    
68 :     $context{Complex} = Parser::Context->getCopy(\%context,"Complex");
69 :     $context{Complex}{precedence}{ComplexPeriodic} = $context{Complex}{precedence}{Complex} + .5;
70 :     $context{Complex}{precedence}{RealPeriodic} = $context{Real}{precedence}{Complex} + .5;
71 :    
72 :     $context{Numeric} = Parser::Context->getCopy(\%context,"Numeric");
73 :     $context{Numeric}{precedence}{RealPeriodic} = $context{Numeric}{precedence}{Complex} + .5;
74 :    
75 :     sub Complex {ComplexPeriodic->new(@_)}
76 :     sub Real {RealPeriodic->new(@_)}

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9