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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9