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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 6376 - (download) (as text) (annotate)
Sat Jul 17 19:42:05 2010 UTC (9 years, 7 months ago) by gage
File size: 11321 byte(s)
Updating VectorField.pm so that it works without AUTOLOAD

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9