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

Annotation of /trunk/pg/lib/VectorField.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : sh002i 1050
2 :     =head1 NAME
3 :    
4 :     VectorField
5 :    
6 :     =head1 SYNPOSIS
7 :    
8 :     use Carp;
9 :     use GD;
10 :     use WWPlot;
11 :     use Fun;
12 :     $fn = new Fun( rule_reference);
13 :     $fn = new Fun( rule_reference , graph_reference);
14 :     $fn = new Fun ( x_rule_ref, y_rule_ref );
15 :     $fn = new Fun ( x_rule_ref, y_rule_ref, graph_ref );
16 :    
17 :     =head1 DESCRIPTION
18 :    
19 :     This module defines a phase plane vector field. It can also be used to define direction fields
20 :     for differenential equations.
21 :    
22 :     The following functions are provided:
23 :    
24 :     =head2 new (direction field version)
25 :    
26 : apizer 1079 =over 4
27 : sh002i 1050
28 :     =item $fn = new VectorField( dy_rule_ref);
29 :    
30 :     rule_reference is a reference to a subroutine which accepts a pair of numerical values
31 :     and returns a numerical value.
32 : apizer 1079 The Fun object will draw the direction field associated with this subroutine.
33 : sh002i 1050
34 :     The new method returns a reference to the vector field object.
35 :    
36 :     =item $fn = new Fun( rule_reference , graph_reference);
37 :    
38 :     The vector field is also placed into the printing queue of the graph
39 : apizer 1079 object pointed to by graph_reference and the
40 : sh002i 1050 domain of the vector field object is set to the domain of the graph.
41 :    
42 :     =back
43 :    
44 : apizer 1079 =head2 new (phase plane version)
45 : sh002i 1050
46 : apizer 1079 =over 4
47 : sh002i 1050
48 :     =item $fn = new VectorField ( dx_rule_ref, dy_rule_ref );
49 :    
50 :     A vector field object is created where the subroutines refered to by dx_rule_ref and dy_rule_ref define
51 : apizer 1079 the x and y components of the vector field at (x,y). Both subroutines must be functions of two variables.
52 : sh002i 1050
53 :     =item $fn = new VectorField ( x_rule_ref, y_rule_ref, graph_ref );
54 :    
55 :     This variant inserts the vector field object into the graph object referred to by graph_ref. The domain
56 :     of the vector field object is set to the domain of the graph.
57 :    
58 :     =back
59 :    
60 :     =head2 Properites
61 :    
62 : apizer 1079 All of the properties are set using the construction $new_value = $fn->property($new_value)
63 : sh002i 1050 and read using $current_value = $fn->property()
64 :    
65 : apizer 1079 =over 4
66 : sh002i 1050
67 :     =item xmin, xmax, ymin, ymax
68 :    
69 : apizer 1079 The domain of the vector field defined by these values.
70 : sh002i 1050
71 :     =item x_steps y_steps
72 :    
73 :     This gives the number of intervals in the x direction (respectively the y direction) for plotting the vector
74 :     field arrows.
75 :    
76 :     =item arrow_color, dot_color
77 :    
78 :     The colors of the arrow bodies and the dot "base" of the arrow are
79 : apizer 1079 specified by a word such as 'orange' or 'yellow'.
80 : sh002i 1050 C<$vf->arrow_color('blue'); $vf->dot_color('red');> sets the drawing color to blue for the arrow body, with
81 :     a red dot at the base of the arrow. The RGB values for the color are defined in the graph
82 :     object in which the vector field is drawn. If the color, e.g. 'mauve', is not defined by the graph object
83 :     then the function is drawn using the color 'default_color' which is always defined (and usually black).
84 :    
85 :     =item dx_rule
86 :    
87 : apizer 1079 A reference to the subroutine used to calculate the dx value of the phase plane field.
88 : sh002i 1050 This is set to the constant function 1
89 :     when using the function object in direction field mode.
90 :    
91 :     =item dy_rule
92 :    
93 :     A reference to the subroutine used to calculate the dy value of the phase plane field.
94 :    
95 :     =item arrow_weight, dot_weight
96 :    
97 :     The width in pixels of the pen used to draw the arrow (respectively the dot).
98 :    
99 :     =back
100 :    
101 :     =head2 Actions which affect more than one property.
102 :    
103 :     =over 4
104 :    
105 :    
106 :     =item domain
107 :    
108 :     $array_ref = $fn->domain(-1,-2,1,2) sets xmin to -1, ymin to -2, xmax to 1, and ymax to 2.
109 :    
110 :    
111 :     =item draw
112 :    
113 : apizer 1079 $fn->draw($graph_ref) draws the vector field in the graph object pointed to by $graph_ref.
114 : sh002i 1050
115 :     The graph object must
116 : apizer 1079 respond to the methods below. The draw call is mainly for internal
117 : sh002i 1050 use by the graph object. Most users will not
118 :     call it directly.
119 :    
120 : apizer 1079 =over 4
121 : sh002i 1050
122 : apizer 1079 =item $graph_ref->{colors}
123 : sh002i 1050
124 :     a hash containing the defined colors
125 :    
126 : apizer 1079 =item $graph_ref ->im
127 : sh002i 1050
128 :     a GD image object
129 :    
130 :     =item $graph_ref->lineTo(x,y, color_number)
131 :    
132 :     draw line to the point (x,y) from the current position using the specified color. To obtain the color number
133 :     use a construction such as C<$color_number = $graph_ref->{colors}{'blue'};>
134 :    
135 :     =item $graph_ref->lineTo(x,y,gdBrushed)
136 :    
137 :     draw line to the point (x,y) using the pattern set by SetBrushed (see GD documentation)
138 :    
139 :     =item $graph_ref->moveTo(x,y)
140 :    
141 :     set the current position to (x,y)
142 :    
143 : apizer 1079 =back
144 : sh002i 1050
145 :     =back
146 :    
147 :     =cut
148 :    
149 :     BEGIN {
150 :     be_strict(); # an alias for use strict. This means that all global variable must contain main:: as a prefix.
151 :     }
152 :    
153 :     package VectorField;
154 :    
155 :    
156 :     #use "WWPlot.pm";
157 :     #Because of the way problem modules are loaded 'use' is disabled.
158 :    
159 :    
160 :    
161 :    
162 :    
163 :     @VectorField::ISA = qw(WWPlot);
164 :     # import gdBrushed from GD. It unclear why, but a good many global methods haven't been imported.
165 :     sub gdBrushed {
166 :     &GD::gdBrushed();
167 :     }
168 :    
169 : apizer 1079 my $GRAPH_REFERENCE = "WWPlot";
170 : sh002i 1050 my $VECTORFIELD_REFERENCE = "VectorField";
171 :    
172 :     my %fields =(
173 : apizer 1079 xmin => -4,
174 : sh002i 1050 xmax => 4,
175 :     ymin => -4,
176 :     ymax => 4,
177 :     x_steps => 10,
178 :     y_steps => 10,
179 :     arrow_color => 'blue',
180 :     arrow_weight => 1, #line thickness
181 :     dot_color => 'red',
182 :     dot_radius => 1.5,
183 :     dt => 0.1,
184 :     dx_rule => sub{1;},
185 :     dy_rule => sub{1;},
186 : apizer 1079 rf_arrow_length => sub{my($dx,$dy)=@_;
187 :     return(0) if sqrt($dx**2 + $dy**2) ==0;
188 : sh002i 1050 0.5*1/sqrt($dx**2 + $dy**2);
189 :     },
190 :    
191 :     );
192 :    
193 :    
194 :     sub new {
195 :     my $class = shift;
196 :    
197 : apizer 1079 my $self = {
198 : sh002i 1050 %fields,
199 :     };
200 : apizer 1079
201 : sh002i 1050 bless $self, $class;
202 :     $self -> _initialize(@_);
203 :     return $self;
204 :     }
205 :    
206 :     sub identity { # the identity function
207 :     shift;
208 :     }
209 :    
210 :    
211 : apizer 1079 sub _initialize {
212 : sh002i 1050 my $self = shift;
213 :     my ($xrule,$yrule, $rule,$graphRef);
214 :     my @input = @_;
215 :     if (ref($input[$#input]) eq $GRAPH_REFERENCE ) {
216 : apizer 1079 $graphRef = pop @input; # get the last argument if it refers to a graph.
217 : sh002i 1050 $graphRef->fn($self); # Install this vector field in the graph.
218 :     $self->{xmin} = $graphRef->{xmin};
219 :     $self->{xmax} = $graphRef->{xmax};
220 :     $self->{ymin} = $graphRef->{ymin};
221 :     $self->{ymax} = $graphRef->{ymax};
222 : apizer 1079 }
223 : sh002i 1050 if ( @input == 1 ) { # only one argument left -- this is a non parametric function
224 :     $rule = $input[0];
225 :     if ( ref($rule) eq $VECTORFIELD_REFERENCE ) { # clone another function
226 :     my $k;
227 :     foreach $k (keys %fields) {
228 :     $self->{$k} = $rule->{$k};
229 :     }
230 :     } else {
231 :     $self->{dx_rule} = sub {1; };
232 :     $self->{dy_rule} = $input[0] ;
233 :     }
234 :     } elsif (@input == 2 ) { # two arguments -- parametric functions
235 :     $self->{dx_rule} = $input[0] ;
236 :     $self->{dy_rule} = $input[1] ;
237 : apizer 1079
238 : sh002i 1050 } else {
239 : sh002i 2274 die "VectorField.pm:_initialize: Can't call VectorField with more than two arguments";
240 : apizer 1079 }
241 : sh002i 1050 }
242 :     sub draw {
243 : apizer 1079 my $self = shift; # this function
244 : sh002i 1050 my $g = shift; # the graph containing the function.
245 :     warn "This vector field is not being called from an enclosing graph" unless defined($g);
246 :     my $arrow_color; # get color scheme from graph
247 :     if ( defined( $g->{'colors'}{$self->arrow_color} ) ) {
248 : apizer 1079 $arrow_color = $g->{'colors'}{$self->arrow_color};
249 : sh002i 1050 } else {
250 :     $arrow_color = $g->{'colors'}{'blue'}; # what you do if the color isn't there
251 :     }
252 :     my $dot_color = $self ->dot_color; # colors are defined differently for Circles, then for lines.
253 :     my $dot_radius = $self->dot_radius;
254 :     my $brush = new GD::Image($self->arrow_weight,$self->arrow_weight);
255 :     my $brush_color = $brush->colorAllocate($g->im->rgb($arrow_color)); # transfer color
256 :     $g->im->setBrush($brush);
257 : glarose 5590 my $x_steps = $self->x_steps;
258 : sh002i 1050 my $xmin = $self->xmin;
259 :     my $x_stepsize = ( $self->xmax - $self->xmin )/$x_steps;
260 : glarose 5590 my $y_steps = $self->y_steps;
261 : sh002i 1050 my $ymin = $self->ymin;
262 :     my $y_stepsize = ( $self->ymax - $self->ymin )/$y_steps;
263 :     my $dt = $self->dt;
264 :     my $rf_arrow_length = $self->rf_arrow_length;
265 :    
266 :     foreach my $i (0..$x_steps) {
267 :     my $x = $xmin + $i*$x_stepsize;
268 :     foreach my $j (0..$y_steps) {
269 :     my $y = $ymin + $j*$y_stepsize;
270 :     my $dx = $dt*&{$self->dx_rule}($x,$y);
271 :     my $dy = $dt*&{$self->dy_rule}($x,$y);
272 :     $g->moveTo($x,$y);
273 : gage 6221 $g->stamps(new Circle($x, $y, $dot_radius,$dot_color,$dot_color) ) if $dot_radius > 0;
274 :     # setting the radius to zero omits the dot
275 : sh002i 1050 $g->lineTo($x+$dx*&$rf_arrow_length($dx,$dy), $y+$dy*&$rf_arrow_length($dx,$dy),gdBrushed);
276 : apizer 1079
277 : sh002i 1050 }
278 : apizer 1079 }
279 : sh002i 1050 }
280 :    
281 :     sub domain {
282 :     my $self =shift;
283 :     my @inputs = @_;
284 :     $self->{xmin} = $inputs[0];
285 :     $self->{ymin} = $inputs[1];
286 :     $self->{xmax} = $inputs[2];
287 : apizer 1079 $self->{ymax} = $inputs[3];
288 : sh002i 1050 }
289 :    
290 : gage 6376 ##########################
291 :     # Access methods
292 :     ##########################
293 :     sub ymin {
294 :     my $self = shift;
295 :     my $type = ref($self) || die "$self is not an object";
296 :     unless (exists $self->{ymin} ) {
297 :     die "Can't find ymin field in object of class $type";
298 :     }
299 :    
300 :     if (@_) {
301 :     return $self->{ymin} = shift;
302 :     } else {
303 :     return $self->{ymin}
304 :     }
305 :     }
306 :     sub x_steps {
307 :     my $self = shift;
308 :     my $type = ref($self) || die "$self is not an object";
309 :     unless (exists $self->{x_steps} ) {
310 :     die "Can't find x_steps field in object of class $type";
311 :     }
312 :    
313 :     if (@_) {
314 :     return $self->{x_steps} = shift;
315 :     } else {
316 :     return $self->{x_steps}
317 :     }
318 :     }
319 :     sub y_steps {
320 :     my $self = shift;
321 :     my $type = ref($self) || die "$self is not an object";
322 :     unless (exists $self->{y_steps} ) {
323 :     die "Can't find y_steps field in object of class $type";
324 :     }
325 :    
326 :     if (@_) {
327 :     return $self->{y_steps} = shift;
328 :     } else {
329 :     return $self->{y_steps}
330 :     }
331 :     }
332 :     sub arrow_color {
333 :     my $self = shift;
334 :     my $type = ref($self) || die "$self is not an object";
335 :     unless (exists $self->{arrow_color} ) {
336 :     die "Can't find arrow_color field in object of class $type";
337 :     }
338 :    
339 :     if (@_) {
340 :     return $self->{arrow_color} = shift;
341 :     } else {
342 :     return $self->{arrow_color}
343 :     }
344 :     }
345 :     sub arrow_weight {
346 :     my $self = shift;
347 :     my $type = ref($self) || die "$self is not an object";
348 :     unless (exists $self->{arrow_weight} ) {
349 :     die "Can't find arrow_weight field in object of class $type";
350 :     }
351 :    
352 :     if (@_) {
353 :     return $self->{arrow_weight} = shift;
354 :     } else {
355 :     return $self->{arrow_weight}
356 :     }
357 :     }
358 :     sub dot_color {
359 :     my $self = shift;
360 :     my $type = ref($self) || die "$self is not an object";
361 :     unless (exists $self->{dot_color} ) {
362 :     die "Can't find dot_color field in object of class $type";
363 :     }
364 :    
365 :     if (@_) {
366 :     return $self->{dot_color} = shift;
367 :     } else {
368 :     return $self->{dot_color}
369 :     }
370 :     }
371 :     sub dot_radius {
372 :     my $self = shift;
373 :     my $type = ref($self) || die "$self is not an object";
374 :     unless (exists $self->{dot_radius} ) {
375 :     die "Can't find dot_radius field in object of class $type";
376 :     }
377 :    
378 :     if (@_) {
379 :     return $self->{dot_radius} = shift;
380 :     } else {
381 :     return $self->{dot_radius}
382 :     }
383 :     }
384 : sh002i 1050
385 : gage 6376 sub dt {
386 :     my $self = shift;
387 :     my $type = ref($self) || die "$self is not an object";
388 :     unless (exists $self->{dt} ) {
389 :     die "Can't find dt field in object of class $type";
390 :     }
391 :    
392 :     if (@_) {
393 :     return $self->{dt} = shift;
394 :     } else {
395 :     return $self->{dt}
396 :     }
397 :     }
398 :     sub dx_rule {
399 :     my $self = shift;
400 :     my $type = ref($self) || die "$self is not an object";
401 :     unless (exists $self->{dx_rule} ) {
402 :     die "Can't find dx_rule field in object of class $type";
403 :     }
404 :    
405 :     if (@_) {
406 :     return $self->{dx_rule} = shift;
407 :     } else {
408 :     return $self->{dx_rule}
409 :     }
410 :     }
411 :     sub dy_rule {
412 :     my $self = shift;
413 :     my $type = ref($self) || die "$self is not an object";
414 :     unless (exists $self->{dy_rule} ) {
415 :     die "Can't find dy_rule field in object of class $type";
416 :     }
417 :    
418 :     if (@_) {
419 :     return $self->{dy_rule} = shift;
420 :     } else {
421 :     return $self->{dy_rule}
422 :     }
423 :     }
424 :     sub rf_arrow_length {
425 :     my $self = shift;
426 :     my $type = ref($self) || die "$self is not an object";
427 :     unless (exists $self->{rf_arrow_length} ) {
428 :     die "Can't find rf_arrow_length field in object of class $type";
429 :     }
430 :    
431 :     if (@_) {
432 :     return $self->{rf_arrow_length} = shift;
433 :     } else {
434 :     return $self->{rf_arrow_length}
435 :     }
436 :     }
437 : sh002i 1050 sub DESTROY {
438 :     # doing nothing about destruction, hope that isn't dangerous
439 :     }
440 :    
441 :     1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9