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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 5373 - (download) (as text) (annotate)
Sun Aug 19 02:01:57 2007 UTC (12 years, 3 months ago) by dpvc
File size: 6622 byte(s)
Normalized comments and headers to that they will format their POD
documentation properly.  (I know that the POD processing was supposed
to strip off the initial #, but that doesn't seem to happen, so I've
added a space throughout.)

    1 loadMacros("MathObjects.pl");
    2 
    3 sub _contextLimitedPowers_init {}; # don't load it again
    4 
    5 =head3 LimitedPowers::NoBaseE();
    6 
    7 =head3 LimitedPowers::OnlyIntegers();
    8 
    9 =head3 LimitedPowers::OnlyNonNegativeIntegers();
   10 
   11 =head3 LimitedPowers::OnlyPositiveIntegers();
   12 
   13 =head3 LimitedPowers::OnlyNonTrivialPositiveIntegers();
   14 
   15  ##########################################################
   16  #
   17  #  Implements subclasses of the "^" operator that restrict
   18  #  the base or power that is allowed.  There are four
   19  #  available restrictions:
   20  #
   21  #    No raising e to a power
   22  #    Only allowing integer powers (positive or negative)
   23  #    Only allowing positive interger powers
   24  #    Only allowing positive interger powers (and 0)
   25  #
   26  #  You install these via one of the commands:
   27  #
   28  #    LimitedPowers::NoBaseE();
   29  #    LimitedPowers::OnlyIntegers();
   30  #    LimitedPowers::OnlyPositiveIntegers();
   31  #    LimitedPowers::OnlyNonNegativeIntegers();
   32  #
   33  #  Only one of the three can be in effect at a time; setting
   34  #  a second one overrides the first.
   35  #
   36  #  These function affect the current context, or you can pass
   37  #  a context reference, as in
   38  #
   39  #    $context = Context("Numeric")->copy;
   40  #    LimitedPowers::OnlyIntegers($context);
   41  #
   42  #  For the Interger power functions, you can pass additional
   43  #  parameters that control the range of values that are allowed
   44  #  for the powers.  The oprtions include:
   45  #
   46  #    minPower => m      only integer powers bigger than or equal
   47  #                       to m are allowed.  (If m is undef, then
   48  #                       there is no minimum power.)
   49  #
   50  #    maxPower => M      only integer powers less than or equal
   51  #                       to M are allowed.  (If M is undef, then
   52  #                       there is no maximum power.)
   53  #
   54  #    message => "text"  a description of the type of power
   55  #                       allowed (e.g., "positive integer constants");
   56  #
   57  #    checker => code    a reference to a subroutine that will be
   58  #                       used to check if the powers are acceptable.
   59  #                       It should accept a reference to the BOP::power
   60  #                       structure and return 1 or 0 depending on
   61  #                       whether the power is OK or not.
   62  #
   63  #  For example:
   64  #
   65  #    LimitedPowers::OnlyIntegers(
   66  #         minPower => -5, maxPower => 5,
   67  #         message => "integer constants between -5 and 5",
   68  #    );
   69  #
   70  #  would accept only powers between -5 and 5, while
   71  #
   72  #    LimitedPowers::OnlyIntegers(
   73  #      checker => sub {
   74  #        return 0 unless LimitedPowers::isInteger(@_);
   75  #        my $self = shift; my $p = shift; # the power as a constant
   76  #        return $p != 0 && $p != 1;
   77  #      },
   78  #      message => "integer constants other than 0 or 1",
   79  #    );
   80  #
   81  #  would accept any integer power other than 0 and 1.
   82  #
   83  ##########################################################
   84 
   85 =cut
   86 
   87 package LimitedPowers;
   88 
   89 sub NoBaseE {
   90   my $context = (Value::isContext($_[0]) ? shift : Value->context);
   91   $context->operators->set(
   92     '^'  => {class => 'LimitedPowers::NoBaseE', isCommand=>1, perl=>'LimitedPowers::NoBaseE->_eval', @_},
   93     '**' => {class => 'LimitedPowers::NoBaseE', isCommand=>1, perl=>'LimitedPowers::NoBaseE->_eval', @_},
   94   );
   95 }
   96 
   97 sub OnlyIntegers {
   98   my $context = (Value::isContext($_[0]) ? shift : Value->context);
   99   $context->operators->set(
  100     '^'  => {class => 'LimitedPowers::OnlyIntegers', message => "integer constants", @_},
  101     '**' => {class => 'LimitedPowers::OnlyIntegers', message => "integer constants",@_},
  102   );
  103 }
  104 
  105 sub OnlyNonNegativeIntegers {
  106   my $context = (Value::isContext($_[0]) ? shift : Value->context);
  107   OnlyIntegers($context, minPower=>0, message=>"non-negative integer constants", @_);
  108 }
  109 
  110 sub OnlyPositiveIntegers {
  111   my $context = (Value::isContext($_[0]) ? shift : Value->context);
  112   OnlyIntegers($context, minPower => 1, message => "positive integer constants", @_);
  113 }
  114 
  115 sub OnlyNonTrivialPositiveIntegers {
  116   my $context = (Value::isContext($_[0]) ? shift : Value->context);
  117   OnlyIntegers($context, minPower=>2, message=>"integer constants bigger than 1", @_);
  118 }
  119 
  120 #
  121 #  Test for whether the power is an integer in the specified range
  122 #
  123 sub isInteger {
  124   my $self = shift; my $n = shift;
  125   my $def = $self->{def};
  126   return 0 if defined($def->{minPower}) && $n < $def->{minPower};
  127   return 0 if defined($def->{maxPower}) && $n > $def->{maxPower};
  128   return Value::Real->make($n - int($n)) == 0;
  129 }
  130 
  131 #
  132 #  Legacy code to accommodate older approach to setting the operators
  133 #
  134 our @NoBaseE = (
  135   '^'  => {class => 'LimitedPowers::NoBaseE', isCommand=>1, perl=>'LimitedPowers::NoBaseE->_eval'},
  136   '**' => {class => 'LimitedPowers::NoBaseE', isCommand=>1, perl=>'LimitedPowers::NoBaseE->_eval'},
  137 );
  138 our @OnlyIntegers = (
  139   '^'  => {class => 'LimitedPowers::OnlyIntegers', message => "integer constants"},
  140   '**' => {class => 'LimitedPowers::OnlyIntegers', message => "integer constants"},
  141 );
  142 our @OnlyNonNegativeIntegers = (
  143   '^'  => {class => 'LimitedPowers::OnlyIntegers', minPower => 0, message => "non-negative integer constants"},
  144   '**' => {class => 'LimitedPowers::OnlyIntegers', minPower => 0, message => "non-negative integer constants"},
  145 );
  146 our @OnlyPositiveIntegers = (
  147   '^'  => {class => 'LimitedPowers::OnlyIntegers', minPower => 1, message => "positive integer constants"},
  148   '**' => {class => 'LimitedPowers::OnlyIntegers', minPower => 1, message => "positive integer constants"},
  149 );
  150 our @OnlyNonTrivialPositiveIntegers = (
  151   '^'  => {class => 'LimitedPowers::OnlyIntegers', minPower => 2, message => "integer constants bigger than 1"},
  152   '**' => {class => 'LimitedPowers::OnlyIntegers', minPower => 2, message => "integer constants bigger than 1"},
  153 );
  154 
  155 
  156 ##################################################
  157 
  158 package LimitedPowers::NoBaseE;
  159 @ISA = qw(Parser::BOP::power);
  160 
  161 my $e = CORE::exp(1);
  162 
  163 sub _check {
  164   my $self = shift;
  165   $self->SUPER::_check(@_);
  166   $self->Error("Can't raise e to a power") if $self->{lop}->string eq 'e';
  167 }
  168 
  169 sub _eval {
  170   my $self = shift;
  171   Value::cmp_Message("Can't raise e to a power") if $_[0] - $e == 0;
  172   $self->SUPER::_eval(@_);
  173 }
  174 
  175 ##################################################
  176 
  177 package LimitedPowers::OnlyIntegers;
  178 @ISA = qw(Parser::BOP::power);
  179 
  180 sub _check {
  181   my $self = shift; my $p = $self->{rop}; my $def = $self->{def};
  182   my $checker = (defined($def->{checker}) ? $def->{checker} :  \&LimitedPowers::isInteger);
  183   $self->SUPER::_check(@_);
  184   $self->Error("Powers must be $def->{message}")
  185     if $p->type ne 'Number' || !$p->{isConstant} || !&{$checker}($self,$p->eval);
  186 }
  187 
  188 ##################################################
  189 
  190 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9