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

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

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : gage 6499 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