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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 4967 - (download) (as text) (annotate)
Thu May 24 12:05:30 2007 UTC (12 years, 8 months ago) by gage
File size: 2868 byte(s)
Added pod documentation

    1 =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 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 =head3 ComplexPeriodic
   51 
   52   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 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