[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 5551 - (download) (as text) (annotate)
Tue Oct 2 20:48:05 2007 UTC (12 years, 2 months ago) by sh002i
File size: 6084 byte(s)
improved formatting for docs -- these were in pod sections but were all
formatted as verbatim sections, and i moved them into normal paragraphs,
lists, etc. should make things more readable from the web.

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9