Parent Directory
| 
Revision Log
Revision 413 - (view) (download) (as text)
| 1 : | sh002i | 413 | #!/usr/math/bin/perl -wx |
| 2 : | |||
| 3 : | |||
| 4 : | |||
| 5 : | =head1 NAME | ||
| 6 : | |||
| 7 : | VectorField | ||
| 8 : | |||
| 9 : | =head1 SYNPOSIS | ||
| 10 : | |||
| 11 : | use Carp; | ||
| 12 : | use GD; | ||
| 13 : | use WWPlot; | ||
| 14 : | use Fun; | ||
| 15 : | $fn = new Fun( rule_reference); | ||
| 16 : | $fn = new Fun( rule_reference , graph_reference); | ||
| 17 : | $fn = new Fun ( x_rule_ref, y_rule_ref ); | ||
| 18 : | $fn = new Fun ( x_rule_ref, y_rule_ref, graph_ref ); | ||
| 19 : | |||
| 20 : | =head1 DESCRIPTION | ||
| 21 : | |||
| 22 : | This module defines a phase plane vector field. It can also be used to define direction fields | ||
| 23 : | for differenential equations. | ||
| 24 : | |||
| 25 : | The following functions are provided: | ||
| 26 : | |||
| 27 : | =head2 new (direction field version) | ||
| 28 : | |||
| 29 : | =over 4 | ||
| 30 : | |||
| 31 : | =item $fn = new VectorField( dy_rule_ref); | ||
| 32 : | |||
| 33 : | rule_reference is a reference to a subroutine which accepts a pair of numerical values | ||
| 34 : | and returns a numerical value. | ||
| 35 : | The Fun object will draw the direction field associated with this subroutine. | ||
| 36 : | |||
| 37 : | The new method returns a reference to the vector field object. | ||
| 38 : | |||
| 39 : | =item $fn = new Fun( rule_reference , graph_reference); | ||
| 40 : | |||
| 41 : | The vector field is also placed into the printing queue of the graph | ||
| 42 : | object pointed to by graph_reference and the | ||
| 43 : | domain of the vector field object is set to the domain of the graph. | ||
| 44 : | |||
| 45 : | =back | ||
| 46 : | |||
| 47 : | =head2 new (phase plane version) | ||
| 48 : | |||
| 49 : | =over 4 | ||
| 50 : | |||
| 51 : | =item $fn = new VectorField ( dx_rule_ref, dy_rule_ref ); | ||
| 52 : | |||
| 53 : | A vector field object is created where the subroutines refered to by dx_rule_ref and dy_rule_ref define | ||
| 54 : | the x and y components of the vector field at (x,y). Both subroutines must be functions of two variables. | ||
| 55 : | |||
| 56 : | =item $fn = new VectorField ( x_rule_ref, y_rule_ref, graph_ref ); | ||
| 57 : | |||
| 58 : | This variant inserts the vector field object into the graph object referred to by graph_ref. The domain | ||
| 59 : | of the vector field object is set to the domain of the graph. | ||
| 60 : | |||
| 61 : | =back | ||
| 62 : | |||
| 63 : | =head2 Properites | ||
| 64 : | |||
| 65 : | All of the properties are set using the construction $new_value = $fn->property($new_value) | ||
| 66 : | and read using $current_value = $fn->property() | ||
| 67 : | |||
| 68 : | =over 4 | ||
| 69 : | |||
| 70 : | =item xmin, xmax, ymin, ymax | ||
| 71 : | |||
| 72 : | The domain of the vector field defined by these values. | ||
| 73 : | |||
| 74 : | =item x_steps y_steps | ||
| 75 : | |||
| 76 : | This gives the number of intervals in the x direction (respectively the y direction) for plotting the vector | ||
| 77 : | field arrows. | ||
| 78 : | |||
| 79 : | =item arrow_color, dot_color | ||
| 80 : | |||
| 81 : | The colors of the arrow bodies and the dot "base" of the arrow are | ||
| 82 : | specified by a word such as 'orange' or 'yellow'. | ||
| 83 : | C<$vf->arrow_color('blue'); $vf->dot_color('red');> sets the drawing color to blue for the arrow body, with | ||
| 84 : | a red dot at the base of the arrow. The RGB values for the color are defined in the graph | ||
| 85 : | object in which the vector field is drawn. If the color, e.g. 'mauve', is not defined by the graph object | ||
| 86 : | then the function is drawn using the color 'default_color' which is always defined (and usually black). | ||
| 87 : | |||
| 88 : | =item dx_rule | ||
| 89 : | |||
| 90 : | A reference to the subroutine used to calculate the dx value of the phase plane field. | ||
| 91 : | This is set to the constant function 1 | ||
| 92 : | when using the function object in direction field mode. | ||
| 93 : | |||
| 94 : | =item dy_rule | ||
| 95 : | |||
| 96 : | A reference to the subroutine used to calculate the dy value of the phase plane field. | ||
| 97 : | |||
| 98 : | =item arrow_weight, dot_weight | ||
| 99 : | |||
| 100 : | The width in pixels of the pen used to draw the arrow (respectively the dot). | ||
| 101 : | |||
| 102 : | =back | ||
| 103 : | |||
| 104 : | =head2 Actions which affect more than one property. | ||
| 105 : | |||
| 106 : | =over 4 | ||
| 107 : | |||
| 108 : | |||
| 109 : | =item domain | ||
| 110 : | |||
| 111 : | $array_ref = $fn->domain(-1,-2,1,2) sets xmin to -1, ymin to -2, xmax to 1, and ymax to 2. | ||
| 112 : | |||
| 113 : | |||
| 114 : | =item draw | ||
| 115 : | |||
| 116 : | $fn->draw($graph_ref) draws the vector field in the graph object pointed to by $graph_ref. | ||
| 117 : | |||
| 118 : | The graph object must | ||
| 119 : | respond to the methods below. The draw call is mainly for internal | ||
| 120 : | use by the graph object. Most users will not | ||
| 121 : | call it directly. | ||
| 122 : | |||
| 123 : | =over 4 | ||
| 124 : | |||
| 125 : | =item $graph_ref->{colors} | ||
| 126 : | |||
| 127 : | a hash containing the defined colors | ||
| 128 : | |||
| 129 : | =item $graph_ref ->im | ||
| 130 : | |||
| 131 : | a GD image object | ||
| 132 : | |||
| 133 : | =item $graph_ref->lineTo(x,y, color_number) | ||
| 134 : | |||
| 135 : | draw line to the point (x,y) from the current position using the specified color. To obtain the color number | ||
| 136 : | use a construction such as C<$color_number = $graph_ref->{colors}{'blue'};> | ||
| 137 : | |||
| 138 : | =item $graph_ref->lineTo(x,y,gdBrushed) | ||
| 139 : | |||
| 140 : | draw line to the point (x,y) using the pattern set by SetBrushed (see GD documentation) | ||
| 141 : | |||
| 142 : | =item $graph_ref->moveTo(x,y) | ||
| 143 : | |||
| 144 : | set the current position to (x,y) | ||
| 145 : | |||
| 146 : | =back | ||
| 147 : | |||
| 148 : | =back | ||
| 149 : | |||
| 150 : | =cut | ||
| 151 : | |||
| 152 : | BEGIN { | ||
| 153 : | be_strict(); # an alias for use strict. This means that all global variable must contain main:: as a prefix. | ||
| 154 : | } | ||
| 155 : | |||
| 156 : | package VectorField; | ||
| 157 : | |||
| 158 : | |||
| 159 : | #use "WWPlot.pm"; | ||
| 160 : | #Because of the way problem modules are loaded 'use' is disabled. | ||
| 161 : | |||
| 162 : | |||
| 163 : | |||
| 164 : | |||
| 165 : | |||
| 166 : | @VectorField::ISA = qw(WWPlot); | ||
| 167 : | # import gdBrushed from GD. It unclear why, but a good many global methods haven't been imported. | ||
| 168 : | sub gdBrushed { | ||
| 169 : | &GD::gdBrushed(); | ||
| 170 : | } | ||
| 171 : | |||
| 172 : | my $GRAPH_REFERENCE = "WWPlot"; | ||
| 173 : | my $VECTORFIELD_REFERENCE = "VectorField"; | ||
| 174 : | |||
| 175 : | my %fields =( | ||
| 176 : | xmin => -4, | ||
| 177 : | xmax => 4, | ||
| 178 : | ymin => -4, | ||
| 179 : | ymax => 4, | ||
| 180 : | x_steps => 10, | ||
| 181 : | y_steps => 10, | ||
| 182 : | arrow_color => 'blue', | ||
| 183 : | arrow_weight => 1, #line thickness | ||
| 184 : | dot_color => 'red', | ||
| 185 : | dot_radius => 1.5, | ||
| 186 : | dt => 0.1, | ||
| 187 : | dx_rule => sub{1;}, | ||
| 188 : | dy_rule => sub{1;}, | ||
| 189 : | rf_arrow_length => sub{my($dx,$dy)=@_; | ||
| 190 : | return(0) if sqrt($dx**2 + $dy**2) ==0; | ||
| 191 : | 0.5*1/sqrt($dx**2 + $dy**2); | ||
| 192 : | }, | ||
| 193 : | |||
| 194 : | ); | ||
| 195 : | |||
| 196 : | |||
| 197 : | sub new { | ||
| 198 : | my $class = shift; | ||
| 199 : | |||
| 200 : | my $self = { | ||
| 201 : | _permitted => \%fields, | ||
| 202 : | %fields, | ||
| 203 : | }; | ||
| 204 : | |||
| 205 : | bless $self, $class; | ||
| 206 : | $self -> _initialize(@_); | ||
| 207 : | return $self; | ||
| 208 : | } | ||
| 209 : | |||
| 210 : | sub identity { # the identity function | ||
| 211 : | shift; | ||
| 212 : | } | ||
| 213 : | |||
| 214 : | |||
| 215 : | sub _initialize { | ||
| 216 : | my $self = shift; | ||
| 217 : | my ($xrule,$yrule, $rule,$graphRef); | ||
| 218 : | my @input = @_; | ||
| 219 : | if (ref($input[$#input]) eq $GRAPH_REFERENCE ) { | ||
| 220 : | $graphRef = pop @input; # get the last argument if it refers to a graph. | ||
| 221 : | $graphRef->fn($self); # Install this vector field in the graph. | ||
| 222 : | $self->{xmin} = $graphRef->{xmin}; | ||
| 223 : | $self->{xmax} = $graphRef->{xmax}; | ||
| 224 : | $self->{ymin} = $graphRef->{ymin}; | ||
| 225 : | $self->{ymax} = $graphRef->{ymax}; | ||
| 226 : | } | ||
| 227 : | if ( @input == 1 ) { # only one argument left -- this is a non parametric function | ||
| 228 : | $rule = $input[0]; | ||
| 229 : | if ( ref($rule) eq $VECTORFIELD_REFERENCE ) { # clone another function | ||
| 230 : | my $k; | ||
| 231 : | foreach $k (keys %fields) { | ||
| 232 : | $self->{$k} = $rule->{$k}; | ||
| 233 : | } | ||
| 234 : | } else { | ||
| 235 : | $self->{dx_rule} = sub {1; }; | ||
| 236 : | $self->{dy_rule} = $input[0] ; | ||
| 237 : | } | ||
| 238 : | } elsif (@input == 2 ) { # two arguments -- parametric functions | ||
| 239 : | $self->{dx_rule} = $input[0] ; | ||
| 240 : | $self->{dy_rule} = $input[1] ; | ||
| 241 : | |||
| 242 : | } else { | ||
| 243 : | wwerror("$0:VectorField.pm:_initialize:", "Can't call VectorField with more than two arguments", ""); | ||
| 244 : | } | ||
| 245 : | } | ||
| 246 : | sub draw { | ||
| 247 : | my $self = shift; # this function | ||
| 248 : | my $g = shift; # the graph containing the function. | ||
| 249 : | warn "This vector field is not being called from an enclosing graph" unless defined($g); | ||
| 250 : | my $arrow_color; # get color scheme from graph | ||
| 251 : | if ( defined( $g->{'colors'}{$self->arrow_color} ) ) { | ||
| 252 : | $arrow_color = $g->{'colors'}{$self->arrow_color}; | ||
| 253 : | } else { | ||
| 254 : | $arrow_color = $g->{'colors'}{'blue'}; # what you do if the color isn't there | ||
| 255 : | } | ||
| 256 : | my $dot_color = $self ->dot_color; # colors are defined differently for Circles, then for lines. | ||
| 257 : | my $dot_radius = $self->dot_radius; | ||
| 258 : | my $brush = new GD::Image($self->arrow_weight,$self->arrow_weight); | ||
| 259 : | my $brush_color = $brush->colorAllocate($g->im->rgb($arrow_color)); # transfer color | ||
| 260 : | $g->im->setBrush($brush); | ||
| 261 : | my $x_steps = 10; | ||
| 262 : | my $xmin = $self->xmin; | ||
| 263 : | my $x_stepsize = ( $self->xmax - $self->xmin )/$x_steps; | ||
| 264 : | my $y_steps = 10; | ||
| 265 : | my $ymin = $self->ymin; | ||
| 266 : | my $y_stepsize = ( $self->ymax - $self->ymin )/$y_steps; | ||
| 267 : | my $dt = $self->dt; | ||
| 268 : | my $rf_arrow_length = $self->rf_arrow_length; | ||
| 269 : | |||
| 270 : | foreach my $i (0..$x_steps) { | ||
| 271 : | my $x = $xmin + $i*$x_stepsize; | ||
| 272 : | foreach my $j (0..$y_steps) { | ||
| 273 : | my $y = $ymin + $j*$y_stepsize; | ||
| 274 : | my $dx = $dt*&{$self->dx_rule}($x,$y); | ||
| 275 : | my $dy = $dt*&{$self->dy_rule}($x,$y); | ||
| 276 : | $g->moveTo($x,$y); | ||
| 277 : | $g->stamps(new Circle($x, $y, $dot_radius,$dot_color,$dot_color) ); | ||
| 278 : | $g->lineTo($x+$dx*&$rf_arrow_length($dx,$dy), $y+$dy*&$rf_arrow_length($dx,$dy),gdBrushed); | ||
| 279 : | |||
| 280 : | } | ||
| 281 : | } | ||
| 282 : | } | ||
| 283 : | |||
| 284 : | sub domain { | ||
| 285 : | my $self =shift; | ||
| 286 : | my @inputs = @_; | ||
| 287 : | $self->{xmin} = $inputs[0]; | ||
| 288 : | $self->{ymin} = $inputs[1]; | ||
| 289 : | $self->{xmax} = $inputs[2]; | ||
| 290 : | $self->{ymax} = $inputs[3]; | ||
| 291 : | } | ||
| 292 : | |||
| 293 : | |||
| 294 : | sub DESTROY { | ||
| 295 : | # doing nothing about destruction, hope that isn't dangerous | ||
| 296 : | } | ||
| 297 : | |||
| 298 : | 1; |
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |