[system] / trunk / pg / lib / Fun.pm Repository:
ViewVC logotype

Diff of /trunk/pg/lib/Fun.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

Revision 1050 Revision 1079
1#!/usr/math/bin/perl -wx 1
2 2
3# Fun.pm 3# Fun.pm
4# methods: 4# methods:
5# new Fun($rule,$graphRef) 5# new Fun($rule,$graphRef)
6# If $rule is a subroutine then a function object is created, 6# If $rule is a subroutine then a function object is created,
7# with default data. If the graphRef is present the function is 7# with default data. If the graphRef is present the function is
8# installed into the 8# installed into the
9# graph and the domain is reset to the graphRef's domain. 9# graph and the domain is reset to the graphRef's domain.
10# If the $rule is another function object then a copy of that function is 10# If the $rule is another function object then a copy of that function is
11# made with all of its data and it is installed in the graphRef if that is present. 11# made with all of its data and it is installed in the graphRef if that is present.
12# In this case the domain of the function is not affected by the domain of the graphRef. 12# In this case the domain of the function is not affected by the domain of the graphRef.
13# initial data 13# initial data
14# @domain = ($tstart, $tstop) the domain of the function -- initially (-1,1) 14# @domain = ($tstart, $tstop) the domain of the function -- initially (-1,1)
15# steps the number of steps in drawing -- initially 20 15# steps the number of steps in drawing -- initially 20
21 21
22# What will the domain of new Fun($rule, $graphRef) be? 22# What will the domain of new Fun($rule, $graphRef) be?
23# It will be the same as $rule if $rule is actually another function object 23# It will be the same as $rule if $rule is actually another function object
24# ELSE the same as the domain of $graphRef if that is present 24# ELSE the same as the domain of $graphRef if that is present
25# ELSE the interval (-1,1) 25# ELSE the interval (-1,1)
26# public access methods: 26# public access methods:
27# domain 27# domain
28# steps 28# steps
29# color 29# color
30# rule 30# rule
31# weight 31# weight
47 $fn = new Fun ( x_rule_ref, y_rule_ref, graph_ref ); 47 $fn = new Fun ( x_rule_ref, y_rule_ref, graph_ref );
48 48
49=head1 DESCRIPTION 49=head1 DESCRIPTION
50 50
51This module defines a parametric or non-parametric function object. The function object is designed to 51This module defines a parametric or non-parametric function object. The function object is designed to
52be inserted into a graph object defined by WWPlot. 52be inserted into a graph object defined by WWPlot.
53 53
54The following functions are provided: 54The following functions are provided:
55 55
56 56
57 57
58=head2 new (non-parametric version) 58=head2 new (non-parametric version)
59 59
60=over 4 60=over 4
61 61
62=item $fn = new Fun( rule_reference); 62=item $fn = new Fun( rule_reference);
63 63
64rule_reference is a reference to a subroutine which accepts a numerical value and returns a numerical value. 64rule_reference is a reference to a subroutine which accepts a numerical value and returns a numerical value.
65The Fun object will draw the graph associated with this subroutine. 65The Fun object will draw the graph associated with this subroutine.
66For example: $rule = sub { my $x= shift; $x**2}; will produce a plot of the x squared. 66For example: $rule = sub { my $x= shift; $x**2}; will produce a plot of the x squared.
67The new method returns a reference to the function object. 67The new method returns a reference to the function object.
68 68
69=item $fn = new Fun( rule_reference , graph_reference); 69=item $fn = new Fun( rule_reference , graph_reference);
70 70
71The function is also placed into the printing queue of the graph object pointed to by graph_reference and the 71The function is also placed into the printing queue of the graph object pointed to by graph_reference and the
72domain of the function object is set to the domain of the graph. 72domain of the function object is set to the domain of the graph.
73 73
74=back 74=back
75 75
76=head2 new (parametric version) 76=head2 new (parametric version)
77 77
78=over 4 78=over 4
79 79
80=item $fn = new Fun ( x_rule_ref, y_rule_ref ); 80=item $fn = new Fun ( x_rule_ref, y_rule_ref );
81 81
82A parametric function object is created where the subroutines refered to by x_rule_ref and y_rule_ref define 82A parametric function object is created where the subroutines refered to by x_rule_ref and y_rule_ref define
83the x and y outputs in terms of the input t. 83the x and y outputs in terms of the input t.
84 84
85=item $fn = new Fun ( x_rule_ref, y_rule_ref, graph_ref ); 85=item $fn = new Fun ( x_rule_ref, y_rule_ref, graph_ref );
86 86
87This variant inserts the parametric function object into the graph object referred to by graph_ref. The domain 87This variant inserts the parametric function object into the graph object referred to by graph_ref. The domain
88of the function object is not adjusted. The domain's default value is (-1, 1). 88of the function object is not adjusted. The domain's default value is (-1, 1).
89 89
90=back 90=back
91 91
92=head2 Properites 92=head2 Properites
93 93
94 All of the properties are set using the construction $new_value = $fn->property($new_value) 94 All of the properties are set using the construction $new_value = $fn->property($new_value)
95 and read using $current_value = $fn->property() 95 and read using $current_value = $fn->property()
96 96
97=over 4 97=over 4
98 98
99=item tstart, tstop, steps 99=item tstart, tstop, steps
100 100
101The domain of the function is (tstart, tstop). steps is the number of subintervals 101The domain of the function is (tstart, tstop). steps is the number of subintervals
102used in graphing the function. 102used in graphing the function.
103 103
104=item color 104=item color
105 105
106The color used to draw the function is specified by a word such as 'orange' or 'yellow'. 106The color used to draw the function is specified by a word such as 'orange' or 'yellow'.
107C<$fn->color('blue')> sets the drawing color to blue. The RGB values for the color are defined in the graph 107C<$fn->color('blue')> sets the drawing color to blue. The RGB values for the color are defined in the graph
108object in which the function is drawn. If the color, e.g. 'mauve', is not defined by the graph object 108object in which the function is drawn. If the color, e.g. 'mauve', is not defined by the graph object
109then the function is drawn using the color 'default_color' which is always defined (and usually black). 109then the function is drawn using the color 'default_color' which is always defined (and usually black).
110 110
111=item x_rule 111=item x_rule
125 125
126=head2 Actions which affect more than one property. 126=head2 Actions which affect more than one property.
127 127
128=over 4 128=over 4
129 129
130=item rule 130=item rule
131 131
132This defines a non-parametric function. 132This defines a non-parametric function.
133 133
134 $fn->rule(sub {my $x =shift; $x**2;} ) 134 $fn->rule(sub {my $x =shift; $x**2;} )
135 135
136 is equivalent to 136 is equivalent to
137 137
138 $fn->x_rule(sub {my $x = shift; $x;}); 138 $fn->x_rule(sub {my $x = shift; $x;});
139 $fn->y_rule(sub {my $x = shift; $x**2;); 139 $fn->y_rule(sub {my $x = shift; $x**2;);
140 140
141 $fn->rule() returns the reference to the y_rule. 141 $fn->rule() returns the reference to the y_rule.
142 142
143=item domain 143=item domain
144 144
145$array_ref = $fn->domain(-1,1) sets tstart to -1 and tstop to 1 and 145$array_ref = $fn->domain(-1,1) sets tstart to -1 and tstop to 1 and
146returns a reference to an array containing this pair of numbers. 146returns a reference to an array containing this pair of numbers.
147 147
148 148
149=item draw 149=item draw
150 150
154 154
155The graph object must 155The graph object must
156respond to the methods below. The draw call is mainly for internal use by the graph object. Most users will not 156respond to the methods below. The draw call is mainly for internal use by the graph object. Most users will not
157call it directly. 157call it directly.
158 158
159=over 4 159=over 4
160 160
161=item $graph_ref->{colors} 161=item $graph_ref->{colors}
162 162
163a hash containing the defined colors 163a hash containing the defined colors
164 164
165=item $graph_ref ->im 165=item $graph_ref ->im
166 166
167a GD image object 167a GD image object
168 168
169=item $graph_ref->lineTo(x,y, color_number) 169=item $graph_ref->lineTo(x,y, color_number)
170 170
177 177
178=item $graph_ref->moveTo(x,y) 178=item $graph_ref->moveTo(x,y)
179 179
180set the current position to (x,y) 180set the current position to (x,y)
181 181
182=back 182=back
183 183
184=back 184=back
185 185
186=cut 186=cut
187 187
203# import gdBrushed from GD. It unclear why, but a good many global methods haven't been imported. 203# import gdBrushed from GD. It unclear why, but a good many global methods haven't been imported.
204sub gdBrushed { 204sub gdBrushed {
205 &GD::gdBrushed(); 205 &GD::gdBrushed();
206} 206}
207 207
208my $GRAPH_REFERENCE = "WWPlot"; 208my $GRAPH_REFERENCE = "WWPlot";
209my $FUNCTION_REFERENCE = "Fun"; 209my $FUNCTION_REFERENCE = "Fun";
210 210
211my %fields =( 211my %fields =(
212 tstart => -1, # (tstart,$tstop) constitutes the domain 212 tstart => -1, # (tstart,$tstop) constitutes the domain
213 tstop => 1, 213 tstop => 1,
221 221
222sub new { 222sub new {
223 my $class = shift; 223 my $class = shift;
224# my ($rule,$graphRef) = @_; 224# my ($rule,$graphRef) = @_;
225 225
226 my $self = { 226 my $self = {
227 _permitted => \%fields, 227 _permitted => \%fields,
228 %fields, 228 %fields,
229 }; 229 };
230 230
231 bless $self, $class; 231 bless $self, $class;
232 $self -> _initialize(@_); 232 $self -> _initialize(@_);
233 return $self; 233 return $self;
234} 234}
235 235
248 $out = $self->y_rule 248 $out = $self->y_rule
249 } 249 }
250 $out; 250 $out;
251} 251}
252 252
253sub _initialize { 253sub _initialize {
254 my $self = shift; 254 my $self = shift;
255 my ($xrule,$yrule, $rule,$graphRef); 255 my ($xrule,$yrule, $rule,$graphRef);
256 my @input = @_; 256 my @input = @_;
257 if (ref($input[$#input]) eq $GRAPH_REFERENCE ) { 257 if (ref($input[$#input]) eq $GRAPH_REFERENCE ) {
258 $graphRef = pop @input; # get the last argument if it refers to a graph. 258 $graphRef = pop @input; # get the last argument if it refers to a graph.
259 $graphRef->fn($self); # Install this function in the graph. 259 $graphRef->fn($self); # Install this function in the graph.
260 } 260 }
261 261
262 if ( @input == 1 ) { # only one argument left -- this is a non parametric function 262 if ( @input == 1 ) { # only one argument left -- this is a non parametric function
263 $rule = $input[0]; 263 $rule = $input[0];
264 if ( ref($rule) eq $FUNCTION_REFERENCE ) { # clone another function 264 if ( ref($rule) eq $FUNCTION_REFERENCE ) { # clone another function
265 my $k; 265 my $k;
266 foreach $k (keys %fields) { 266 foreach $k (keys %fields) {
267 $self->{$k} = $rule->{$k}; 267 $self->{$k} = $rule->{$k};
268 } 268 }
269 } else { 269 } else {
270 $self->rule($rule); 270 $self->rule($rule);
271 if (ref($graphRef) eq $GRAPH_REFERENCE) { # use graph to initialize domain 271 if (ref($graphRef) eq $GRAPH_REFERENCE) { # use graph to initialize domain
272 $self->domain($graphRef->xmin,$graphRef->xmax); 272 $self->domain($graphRef->xmin,$graphRef->xmax);
273 } 273 }
274 } 274 }
275 } elsif (@input == 2 ) { # two arguments -- parametric functions 275 } elsif (@input == 2 ) { # two arguments -- parametric functions
276 $self->x_rule($input[0]); 276 $self->x_rule($input[0]);
277 $self->y_rule($input[1]); 277 $self->y_rule($input[1]);
278 278
279 } else { 279 } else {
280 wwerror("$0:Fun.pm:_initialize:", "Can't call function with more than two arguments", ""); 280 wwerror("$0:Fun.pm:_initialize:", "Can't call function with more than two arguments", "");
281 } 281 }
282 282
283} 283}
284 284
285sub draw { 285sub draw {
286 my $self = shift; # this function 286 my $self = shift; # this function
287 my $g = shift; # the graph containing the function. 287 my $g = shift; # the graph containing the function.
288 my $color; # get color scheme from graph 288 my $color; # get color scheme from graph
289 if ( defined( $g->{'colors'}{$self->color} ) ) { 289 if ( defined( $g->{'colors'}{$self->color} ) ) {
290 $color = $g->{'colors'}{$self->color}; 290 $color = $g->{'colors'}{$self->color};
291 } else { 291 } else {
292 $color = $g->{'colors'}{'default_color'}; # what you do if the color isn't there 292 $color = $g->{'colors'}{'default_color'}; # what you do if the color isn't there
293 } 293 }
294 my $brush = new GD::Image($self->weight,$self->weight); 294 my $brush = new GD::Image($self->weight,$self->weight);
295 my $brush_color = $brush->colorAllocate($g->im->rgb($color)); # transfer color 295 my $brush_color = $brush->colorAllocate($g->im->rgb($color)); # transfer color
296 $g->im->setBrush($brush); 296 $g->im->setBrush($brush);
297 my $stepsize = ( $self->tstop - $self->tstart )/$self->steps; 297 my $stepsize = ( $self->tstop - $self->tstart )/$self->steps;
298 298
299 my ($t,$x,$i,$y); 299 my ($t,$x,$i,$y);
300 my $x_prev = undef; 300 my $x_prev = undef;
301 my $y_prev = undef; 301 my $y_prev = undef;
302 foreach $i (0..$self->steps) { 302 foreach $i (0..$self->steps) {
303 $t=$stepsize*$i + $self->tstart; 303 $t=$stepsize*$i + $self->tstart;
304 $x=&{$self->x_rule}( $t );; 304 $x=&{$self->x_rule}( $t );;
305 $y=&{$self->y_rule}( $t ); 305 $y=&{$self->y_rule}( $t );
306 if (defined($x) && defined($x_prev) && defined($y) && defined($y_prev) ) { 306 if (defined($x) && defined($x_prev) && defined($y) && defined($y_prev) ) {
319 my $tstop = shift; 319 my $tstop = shift;
320 if (defined($tstart) && defined($tstop) ) { 320 if (defined($tstart) && defined($tstop) ) {
321 $self->tstart($tstart); 321 $self->tstart($tstart);
322 $self->tstop($tstop); 322 $self->tstop($tstop);
323 } 323 }
324 [$self->tstart,$self->tstop]; 324 [$self->tstart,$self->tstop];
325} 325}
326 326
327 327
328sub DESTROY { 328sub DESTROY {
329 # doing nothing about destruction, hope that isn't dangerous 329 # doing nothing about destruction, hope that isn't dangerous

Legend:
Removed from v.1050  
changed lines
  Added in v.1079

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9