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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 5555 - (view) (download) (as text)

1 : sh002i 5551 =head1 NAME
2 : dpvc 4664
3 : sh002i 5551 contextLimitedPowers.pl - Restrict the base or power allowed in exponentials.
4 : dpvc 4664
5 : sh002i 5551 =head1 DESCRIPTION
6 : dpvc 5373
7 : sh002i 5551 Implements subclasses of the "^" operator that restrict
8 :     the base or power that is allowed. There are four
9 :     available restrictions:
10 : dpvc 5373
11 : sh002i 5555 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 : dpvc 5373
16 : sh002i 5551 You install these via one of the commands:
17 : dpvc 5373
18 : sh002i 5555 LimitedPowers::NoBaseE();
19 :     LimitedPowers::OnlyIntegers();
20 :     LimitedPowers::OnlyPositiveIntegers();
21 :     LimitedPowers::OnlyNonNegativeIntegers();
22 : gage 4997
23 : sh002i 5551 Only one of the three can be in effect at a time; setting
24 :     a second one overrides the first.
25 : dpvc 4664
26 : sh002i 5551 These function affect the current context, or you can pass
27 :     a context reference, as in
28 :    
29 : sh002i 5555 $context = Context("Numeric")->copy;
30 :     LimitedPowers::OnlyIntegers($context);
31 : sh002i 5551
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 : gage 4997 =cut
86 : dpvc 4664
87 : sh002i 5551 loadMacros("MathObjects.pl");
88 :    
89 :     sub _contextLimitedPowers_init {}; # don't load it again
90 :    
91 : dpvc 4664 package LimitedPowers;
92 :    
93 : dpvc 5350 sub NoBaseE {
94 :     my $context = (Value::isContext($_[0]) ? shift : Value->context);
95 :     $context->operators->set(
96 : dpvc 5351 '^' => {class => 'LimitedPowers::NoBaseE', isCommand=>1, perl=>'LimitedPowers::NoBaseE->_eval', @_},
97 :     '**' => {class => 'LimitedPowers::NoBaseE', isCommand=>1, perl=>'LimitedPowers::NoBaseE->_eval', @_},
98 : dpvc 5350 );
99 :     }
100 :    
101 :     sub OnlyIntegers {
102 :     my $context = (Value::isContext($_[0]) ? shift : Value->context);
103 :     $context->operators->set(
104 : dpvc 5351 '^' => {class => 'LimitedPowers::OnlyIntegers', message => "integer constants", @_},
105 :     '**' => {class => 'LimitedPowers::OnlyIntegers', message => "integer constants",@_},
106 : dpvc 5350 );
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 : dpvc 5351 # 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 : dpvc 5350 # Legacy code to accommodate older approach to setting the operators
137 :     #
138 : dpvc 4664 our @NoBaseE = (
139 : dpvc 5351 '^' => {class => 'LimitedPowers::NoBaseE', isCommand=>1, perl=>'LimitedPowers::NoBaseE->_eval'},
140 :     '**' => {class => 'LimitedPowers::NoBaseE', isCommand=>1, perl=>'LimitedPowers::NoBaseE->_eval'},
141 : dpvc 4664 );
142 :     our @OnlyIntegers = (
143 : dpvc 5351 '^' => {class => 'LimitedPowers::OnlyIntegers', message => "integer constants"},
144 :     '**' => {class => 'LimitedPowers::OnlyIntegers', message => "integer constants"},
145 : dpvc 4664 );
146 : dpvc 5350 our @OnlyNonNegativeIntegers = (
147 : dpvc 5351 '^' => {class => 'LimitedPowers::OnlyIntegers', minPower => 0, message => "non-negative integer constants"},
148 :     '**' => {class => 'LimitedPowers::OnlyIntegers', minPower => 0, message => "non-negative integer constants"},
149 : dpvc 5350 );
150 : dpvc 4664 our @OnlyPositiveIntegers = (
151 : dpvc 5351 '^' => {class => 'LimitedPowers::OnlyIntegers', minPower => 1, message => "positive integer constants"},
152 :     '**' => {class => 'LimitedPowers::OnlyIntegers', minPower => 1, message => "positive integer constants"},
153 : dpvc 4664 );
154 : dpvc 5350 our @OnlyNonTrivialPositiveIntegers = (
155 : dpvc 5351 '^' => {class => 'LimitedPowers::OnlyIntegers', minPower => 2, message => "integer constants bigger than 1"},
156 :     '**' => {class => 'LimitedPowers::OnlyIntegers', minPower => 2, message => "integer constants bigger than 1"},
157 : dpvc 5332 );
158 :    
159 : dpvc 5350
160 : dpvc 4664 ##################################################
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 : dpvc 5350 my $self = shift; my $p = $self->{rop}; my $def = $self->{def};
186 : dpvc 5351 my $checker = (defined($def->{checker}) ? $def->{checker} : \&LimitedPowers::isInteger);
187 : dpvc 4664 $self->SUPER::_check(@_);
188 : dpvc 5350 $self->Error("Powers must be $def->{message}")
189 : dpvc 5351 if $p->type ne 'Number' || !$p->{isConstant} || !&{$checker}($self,$p->eval);
190 : dpvc 4664 }
191 :    
192 :     ##################################################
193 :    
194 :     1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9