Parent Directory
| 
Revision Log
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 |