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

View of /trunk/pg/macros/PGanalyzeGraph.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 6499 - (download) (as text) (annotate)
Thu Nov 11 13:03:14 2010 UTC (9 years, 3 months ago) by gage
File size: 2488 byte(s)
transferred some much used macro files to pg/macros for those not including the
NPL/macros/Union  directory in their macros search path

added PGanalyzeGraph to support graphical input

added POD documenta^tion to LiveGraphics3D.pl


    1 sub _PGanalyzeGraph_init {}
    2 
    3 ################################################################
    4 # subroutines
    5 ################################################################
    6 
    7 
    8 
    9 =head4  detect_intervals
   10 
   11    input: $pointDisplayString
   12           return delimited string of triplets
   13           each triplet has the form  x y yp  (space delimited)
   14           giving the x, y and y'(x) values at x respectively
   15    return: (\@combined_intervals, \@values)
   16           @values contains the y values of the function in order
   17           @combined_intervals contains anonymous arrays of the form
   18                [ $slope, $left_x, $right_x]  indicating the gradient on that segment.
   19                successive intervals will have different slopes.
   20 
   21 
   22 =cut
   23 
   24 sub detect_intervals {
   25   my $pointDisplayString = shift;
   26   my @intervals;
   27   my @combined_intervals=();
   28   my @points;
   29   my @values;
   30   $out_string ='';
   31   return "" unless defined $pointDisplayString and $pointDisplayString =~/\S/;
   32   @pointDisplayLines = split("\n",$pointDisplayString);
   33   #drop first line
   34   #shift @pointDisplayLines;
   35   my ($prev_x, $prev_y, $prev_yp) = (undef);
   36   my $slope;
   37 
   38     #first calculate the average gradient on each interval
   39 
   40   foreach my $line (@pointDisplayLines) {
   41       chomp($line);
   42       next unless $line =~/\S/;  # skip blank lines
   43       ($x,$y,$yp) = split(/\s+/, $line);
   44 
   45       if (defined $prev_x) {
   46          $slope = $y - $prev_y;
   47 
   48       if ($slope >0) {
   49         $slope_str="increasing";
   50       } elsif ($slope <0) {
   51         $slope_str="decreasing";
   52       } else {
   53         $slope_str = "constant";
   54       }
   55       push @intervals, [$slope_str, $prev_x, $x];
   56 
   57       #TEXT("f is $slope_str on the interval [$prev_x, $x]$BR");
   58     }
   59     #TEXT("x=$x y = $y yp = $yp $BR");
   60     push @points, [$x, $y, $yp];
   61     push @values, $y;
   62     $prev_x =$x; $prev_y=$y; $prev_yp = $yp;
   63 
   64   }
   65   my $prev_slope = undef;
   66   my ($left_x, $right_x);
   67 
   68   ########
   69   # Combine adjacent intervals with the same properites
   70   ########
   71   foreach my $item (@intervals) {
   72     if (defined $prev_slope) {
   73       if ($prev_slope eq $item->[0]) {
   74         $right_x = $item->[2];
   75       } else {
   76         push @combined_intervals, [$prev_slope, $left_x, $right_x];
   77         $left_x = $item->[1];
   78         $right_x = $item->[2];
   79       }
   80 
   81     } else {
   82       $left_x = $item->[1];
   83       $right_x = $item->[2];
   84     }
   85     $prev_slope = $item->[0];
   86     # warn "intervals",join(" ", @combined_intervals);
   87   }
   88   push @combined_intervals, [$prev_slope, $left_x, $right_x];
   89 
   90   (\@combined_intervals, \@values);
   91 }
   92 
   93 
   94 
   95 
   96 
   97 
   98 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9