[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 4968 - (download) (as text) (annotate)
Thu May 24 12:44:58 2007 UTC (12 years, 6 months ago) by gage
File size: 2861 byte(s)
Pod documentation added

    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 
   15 =cut
   16 
   17 
   18 
   19 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 =head3 ComplexPeriodic
   52 
   53   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 
   57 =cut
   58 
   59 
   60 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