[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 4968 - (view) (download) (as text)

1 : gage 4967 =head1 contextPeriodic.pl
2 :    
3 :     The features in this file will probably be added to the Real and
4 :     Complex contexts in the future and this file will not be needed.
5 :    
6 :     =cut
7 :    
8 :     =head3 RealPeriodic
9 :    
10 :     usage Context("RealPeriodic");
11 :     $a = Real("pi/2")->with(period=>pi);
12 :     $a->cmp # will match pi/2, 3pi/2 etc.
13 : gage 4968
14 :    
15 : gage 4967 =cut
16 :    
17 :    
18 :    
19 : gage 4966 package RealPeriodic;
20 :     @ISA = ("Value::Real");
21 :    
22 :     sub new {
23 :     my $self = shift; my $class = ref($self) || $self;
24 :     bless Value::Real->new(@_), $class;
25 :     }
26 :    
27 :     sub compare {
28 :     my ($l,$r,$flag) = @_; my $self = shift;
29 :     my $m = $l->{period};
30 :     return $self->SUPER::compare(@_) unless defined $m;
31 :     if ($l->promotePrecedence($r)) {return $r->compare($l,!$flag)}
32 :     $r = Value::Real::promote($r); if ($flag) {my $tmp = $l; $l = $r; $r = $tmp}
33 :     if ($self->{logPeriodic}) {
34 :     return 1 if $l eq "0" || $r eq "0"; # non-fuzzy checks
35 :     $l = log($l); $r = log($r);
36 :     }
37 :     return modulo($l-$r+$m/2,$m) <=> $m/2;
38 :     }
39 :    
40 :     sub modulo {
41 :     my $a = shift; my $b = shift;
42 :     $a = Value::Real->new($a); $b = Value::Real->new($b); # just in case
43 :     return Value::Real->new(0) if $b eq "0"; # non-fuzzy check
44 :     my $m = ($a/$b)->value;
45 :     my $n = int($m); $n-- if $n > $m; # act as floor() rather than int()
46 :     return $a - $n*$b;
47 :     }
48 :    
49 :     sub isReal {1}
50 :    
51 : gage 4967 =head3 ComplexPeriodic
52 : gage 4966
53 : gage 4967 usage Context("ComplexPeriodic");
54 :     $z0 = Real("i^i")->with(period=>2pi, logPeriodic=>1);
55 :     $z0->cmp # will match exp( i (ln(1) + Arg(pi/2)+2k pi ) )
56 : gage 4968
57 : gage 4967 =cut
58 :    
59 :    
60 : gage 4966 package ComplexPeriodic;
61 :     @ISA = ("Value::Complex");
62 :    
63 :     sub new {
64 :     my $self = shift; my $class = ref($self) || $self;
65 :     bless Value::Complex->new(@_), $class;
66 :     }
67 :    
68 :     sub compare {
69 :     my ($l,$r,$flag) = @_; my $self = shift;
70 :     my $m = $l->{period};
71 :     return $self->SUPER::compare(@_) unless defined $m;
72 :     if ($l->promotePrecedence($r)) {return $r->compare($l,!$flag)}
73 :     $r = Value::Complex::promote($r); if ($flag) {my $tmp = $l; $l = $r; $r = $tmp}
74 :     if ($self->{logPeriodic}) {
75 :     return 1 if $l eq "0" || $r eq "0"; # non-fuzzy checks
76 :     $l = log($l); $r = log($r);
77 :     }
78 :     return modulo($l-$r+$m/2,$m) <=> $m/2;
79 :     }
80 :    
81 :     sub modulo {
82 :     my $a = shift; my $b = shift;
83 :     $a = Value::Complex->new($a); $b = Value::Complex->new($b); # just in case
84 :     return Value::Complex->new(0) if $b eq "0"; # non-fuzzy check
85 :     my $m = ($a/$b)->Re->value;
86 :     my $n = int($m); $n-- if $n > $m; # act as floor() rather than int()
87 :     return $a - $n*$b;
88 :     }
89 :    
90 :     sub isComplex {1}
91 :    
92 :     package main;
93 :    
94 :     $context{Complex} = Parser::Context->getCopy(\%context,"Complex");
95 :     $context{Complex}{precedence}{ComplexPeriodic} = $context{Complex}{precedence}{Complex} + .5;
96 :     $context{Complex}{precedence}{RealPeriodic} = $context{Real}{precedence}{Complex} + .5;
97 :    
98 :     $context{Numeric} = Parser::Context->getCopy(\%context,"Numeric");
99 :     $context{Numeric}{precedence}{RealPeriodic} = $context{Numeric}{precedence}{Complex} + .5;
100 :    
101 :     sub Complex {ComplexPeriodic->new(@_)}
102 :     sub Real {RealPeriodic->new(@_)}

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9