Chart-Scientific
view release on metacpan or search on metacpan
lib/Chart/Scientific.pm view on Meta::CPAN
}
sub default_args {
return {
title => '',
subtitle => undef,
x_label => '',
y_label => '',
residuals_label => '',
residuals_pos => 0,
nolegend => 0,
legend_location => '.02,-.05',
residuals_size => 0.25,
x_range => undef,
y_range => undef,
x_log => 0,
y_log => 0,
colors => 'black,red,green,blue,cyan,magenta,gray',
symbols => [ 3, 0, 5, 4, 6..99 ],
font => '1',
lib/Chart/Scientific.pm view on Meta::CPAN
# Class hash member and member method to determine if
# a given input is allowed or not:
#
our %legal_inputs = (
axis => 1,
axis_residuals => 1,
char_size => 1,
colors => 1,
defaults => 1,
#derived_legend => 1,
device => 1,
filename => 1,
font => 1,
function => 1,
group_col => 1,
help => 1,
legend_location => 1,
legend_text => 1,
#limits => 1,
line_width => 1,
nopoints => 1,
nolegend => 1,
noline => 1,
#only => 1,
#opts => 1,
#pdls => 1,
#PlotPosition => 1,
#points => 1,
residuals => 1,
residuals_label => 1,
residuals_pos => 1,
residuals_size => 1,
lib/Chart/Scientific.pm view on Meta::CPAN
if not ( -f $self->{filename} || 'stdin' eq $self->{filename} );
# If $self->{split} has been specified, assume the data file is delimitted
# by that. Otherwise, assume it's a RDB (or tab-delimitted) file:
#
( defined $self->{split} )
? $self->read_file ()
: $self->read_RDB ();
print "read-in points: ", Dumper $self->{points}, "\n",
"Legend array: ", Dumper $self->{derived_legend}
if $self->{verbose} > 1;
}
sub read_RDB {
my $self = shift () or die "no self in read_RDB";
print "reading with RDB.pm\n"
if $self->{verbose} > 0;
my $rdb = RDB->new ( $self->{filename} )
or die "RDB open failed on file '$self->{filename}' $!";
my $r_line = {};
$self->{derived_legend} = {};
tie %{$self->{derived_legend}}, "Tie::IxHash";
# Read each line of the RDB file, and stuff it into the
# $self->{points}{$group_col}[$i] structure:
#
while ( $rdb->read( $r_line ) ) {
my $brk = ( defined $self->{group_col} )
? $r_line->{$self->{group_col}}
: $self->{only};
lib/Chart/Scientific.pm view on Meta::CPAN
push @{$self->{points}{$brk}{y}[ $_]},
$r_line->{$self->{y_col}[ $_]};
push @{$self->{points}{$brk}{y_err}[$_]},
$r_line->{$self->{y_err_col}[$_]}
if defined $self->{y_err_col};
my $leg_key = $self->{y_col}[$_];
$leg_key .= $brk
if $brk ne $self->{only};
$self->{derived_legend}{$leg_key} = 1;
}
}
$self->{derived_legend} = [ keys %{$self->{derived_legend}} ];
}
sub get_fh {
my $self = shift () or die "no self";
# If a filename is given, read from it; otherwise, read from STDIN:
#
my $fh;
if ( 'stdin' eq $self->{filename} ) {
$fh = 'STDIN';
lib/Chart/Scientific.pm view on Meta::CPAN
return $fh;
}
sub read_file {
my $self = shift () or die "no self in read_file";
print "reading from regular file\n"
if $self->{verbose} > 0;
my ( $fh, @col_names, %col_number ) = ( $self->get_fh (), (), () );
$self->{derived_legend} = {};
tie %{$self->{derived_legend}}, "Tie::IxHash";
while ( <$fh> ) {
next if /^#/ || /^[#SNM\t]+$/; # skip comments and definition lines (if
# you're kludge-reading an RDB file)
chomp ( my @vals = split /$self->{split}/, $_ );
die "Split returned less than 2 items per line-- abort!\n"
if 2 > scalar @vals;
# Read in the names from the first line, if applicable:
lib/Chart/Scientific.pm view on Meta::CPAN
my $cur_ycol = $col_number{ $self->{y_col}[$_] };
my $cur_ecol = $col_number{ $self->{y_err_col}[$_] }
if defined $self->{y_err_col};
push @{$self->{points}{$brk}{y}[ $_]}, $vals[ $cur_ycol ];
push @{$self->{points}{$brk}{y_err}[$_]}, $vals[ $cur_ecol ]
if defined $self->{y_err_col};
my $leg_key = $self->{y_col}[$_] .
( $brk eq $self->{only} ? "" : ", $brk:" );
$self->{derived_legend}{$leg_key} = 1;
}
}
$self->{derived_legend} = [ keys %{$self->{derived_legend}} ];
close $fh if $self->{filename} ne 'stdin';
}
sub plot {
my $self = shift () or die "no self in draw_points";
$self->make_pdls () if ! $self->pdls_loaded ();
$self->make_pdl_residuals () if $self->{residuals};
$self->logify_pdls () if $self->{x_log} || $self->{y_log};
lib/Chart/Scientific.pm view on Meta::CPAN
};
$self->{win}->label_axes (
( defined $self->{residuals}
? ( "", @{$self}{'y_label','title'} )
: ( @{$self}{'x_label','y_label','title'} ) ),
$font_charsize_opts
);
PGPLOT::pgmtxt ( 'T', 0.5, 0.5, 0.5, $self->{subtitle} )
if defined $self->{subtitle};
$self->write_legend () if ! $self->{nolegend};
$self->plot_residuals ( $font_charsize_opts )
if defined $self->{residuals};
$self->{win}->close ();
}
sub plot_residuals {
my $self = shift () or die "no self";
my $font_charsize_opts = shift () or die "no font_charsize_opts";
lib/Chart/Scientific.pm view on Meta::CPAN
$env_pars[-1]{Axis}[0] .= 'L' if $self->{x_log};
$env_pars[-1]{Axis}[1] .= 'L' if $self->{y_log};
$env_pars[-1]{Axis}[1] =~ s/M/N/
if ! $self->{residuals_pos};
$self->{win}->env ( @env_pars );
}
sub write_legend {
my $self = shift () or die "no self in write_legend";
my @loc = ( $self->{limits}{x}{lo}, $self->{limits}{y}{hi} );
my @deltas = ( $self->{limits}{x}{hi} - $self->{limits}{x}{lo},
$self->{limits}{y}{hi} - $self->{limits}{y}{lo} );
@{$self->{legend_location}} = [ .1, -.1 ]
if ! $self->{legend_location};
@loc = map { $loc[$_] + $self->{legend_location}[$_] * $deltas[$_] } 0..1;
# Legend Usage:
#
# [ names ],
# x,y
# { option hash }
#
my $text = ( $self->{legend_text}
? $self->{legend_text}
: $self->{derived_legend} );
$self->{win}->legend (
$text, @loc,
{
LineStyle => $self->{opts}{ln_sty},
Color => $self->{opts}{ln_col},
},
);
$self->{win}->legend (
$text, @loc,
{
Symbol => $self->{opts}{symbol},
LineStyle => $self->{opts}{ln_sty},
Color => $self->{opts}{ln_col},
LineWidth => [ 50, 50 ],
TextShift => 0,
Font => $self->{font},
HardFont => $self->{font},
CharSize => $self->{char_size},
lib/Chart/Scientific.pm view on Meta::CPAN
# syntax instead of cumbersome y_data => [ $y_pdl ]
#
$self->{y_data} = [ $self->{y_data} ]
if $self->single_y_data ();
$self->setup_RDB_split () if not defined $self->{split};
$self->read_nonfile_points () if defined $self->{x_data};
# Split data params on commas if they are defined:
#
foreach ( qw/y_col y_err_col x_range y_range legend_location legend_text/ ) {
$self->{$_} = [ split /,/, $self->{$_} ]
if exists $self->{$_} &&
defined $self->{$_};
}
die "Must have two y data columns or a group_col column to use residuals"
if $self->{residuals} &&
( grep { defined $self->{$_} &&
scalar @{$self->{$_}} < 2 } qw/y y_data/ )
&& not defined $self->{group_col};
lib/Chart/Scientific.pm view on Meta::CPAN
$self->{pdls}{y_errs}{$brk}[$_];
$self->{pdls}{y_errs_lo}{$brk}[$_] =
$self->{pdls}{y_data}{$brk}[$_] -
$self->{pdls}{y_errs}{$brk}[$_];
}
}
}
else {
die "in read_nonfile_points: this should NEVER be reached";
}
$self->{derived_legend} = ( defined $self->{y_col} )
? [ split /,/, $self->{y_col} ]
: [ map { "y$_" }
0..scalar @{$self->{y_data}} - 1 ];
}
sub set_plot_position {
my $self = shift () or die "no self";
my $height = $self->{residuals_size} * ( 0.90 - 0.10 ) + 0.10;
$self->{PlotPosition} = [ [ 0.1, 0.9, 0.1, 0.9 ] ];
lib/Chart/Scientific.pm view on Meta::CPAN
The fraction of the plotting area that the residuals occupy.
The default is 0.25, and the range is 0.0 to 1.0.
=back
=item I<Legend options>
=over 8
=item B<nolegend>
Setting this to a true value will suppress legend drawing. The
default is 0.
=item B<legend_location>
A comma-separated list that to specify a location for the plot's
legend. The default is .02,-.05. The coordates are in the range
[0-1] for x, and [0,-1] for y, with the origin in the upper-left
corner of the plot.
=item B<legend_text>
A comma-separated list, with one item to specify the text for each
set of dependent data. The list must be given in in the same order
as the data sets are given.
=back
=item I<Labelling options>
=over 8
t/Chart-Scientific.t view on Meta::CPAN
my @pars = (
{ #1
x_data => \@a2,
y_data => [\@b2],
title => 'test: x_data and single y_data',
},
{ #2
x_data => \@a1,
y_data => [ \@b1, \@c1 ],
yerr_data => [ \@berr1, \@cerr1 ],
legend_text => 'LegendTestA,LegendTestB',
title => 'test: x_data and multiple y_data, yerr_data',
},
{ #3
filename => 't/data.dat',
split => '\t',
x_col => 'x',
y_col => 'y,z',
yerr_col => 'err,err',
xlabel => 'range',
ylabel => 'data',
t/Chart-Scientific.t view on Meta::CPAN
group_col=> 'group',
xlabel => 'range',
ylabel => 'data',
title => 'test: read x, multiple y, y_err from RDB file, GROUPED, with resid',
residuals => 1,
},
{ #9
x_data => [0..4],
y_data => \@arr,
yerr_data => \@err,
legend_text => 'test0,test1,test2,test3,test4,test5,test6,test7,test8,test9',
xrange => '-1,5.3',
yrange => '-45,220',
xlabel => 'monkey',
ylabel => 'brains',
title => 'test: x_data, ref to multi y_data, xrange and yrange set',
},
{ #10
x_data => \@a1,
y_data => [ \@b1, \@c1 ],
yerr_data => [ \@berr1, \@cerr1 ],
legend_text => 'LegendTestA,LegendTestB',
title => 'test: x_data and multiple y_data, yerr_data, w/ resids & xrange',
xrange => '-.5,9.5',
residuals => 1,
},
{ #11
x_data => \@p1,
y_data => [ \@p2, \@p3 ],
legend_text => 'TwoPwrSeries,ThreePwrSeries',
title => 'test: x_data and multiple y_data',
},
{ #12
x_data => \@p1,
y_data => [ \@p2, \@p3 ],
legend_text => 'TwoPwrSeries,ThreePwrSeries',
title => 'test: x_data and multiple y_data +resids',
residuals => 1,
},
{ #13
x_data => \@p1,
y_data => [ \@p2, \@p3 ],
legend_text => 'TwoPwrSeries,ThreePwrSeries',
title => 'test: x_data and multiple y_data with xlog',
xlog => 1,
},
{ #14
x_data => \@p1,
y_data => [ \@p2, \@p3 ],
legend_text => 'TwoPwrSeries,ThreePwrSeries',
title => 'test: x_data and multiple y_data with xlog, ylog on',
xlog => 1,
ylog => 1,
},
{ #15
x_data => \@p1,
y_data => [ \@p2, \@p3 ],
legend_text => 'TwoPwrSeries,ThreePwrSeries',
title => 'test: x_data and multiple y_data with ylog on',
ylog => 1,
},
{ #16
x_data => \@p1,
y_data => [ \@p3, \@p2 ],
legend_text => 'ThreePwrSeries,TwoPwrSeries',
title => 'test: x_data and multiple y_data with ylog on',
ylog => 1,
residuals => 1,
},
{ #17
x_data => \@p1,
y_data => [ \@p2, \@p3 ],
legend_text => 'TwoPwrSeries,ThreePwrSeries',
title => 'test: x_data and multiple y_data with ylog on, plus resid',
ylog => 1,
residuals => 1,
},
{ #18
x_data => $pdlx1,
y_data => [$pdly1, $pdly2],
legend_text => 'sin,cos',
title => 'direct pdl inputs: 1 x_pdl 2 y_pdls',
},
{ #19
x_data => $pdlx1,
y_data => [$pdly1, $pdly2],
residuals => 1,
legend_text => 'pdl sin x,pdl cos x',
title => 'direct pdl inputs: 1 x pdl, 2 y pdls, w/ resid',
},
{ #20
x_data => $pdlx1,
y_data => [$pdly1, $pdly2],
residuals => 1,
title => 'direct pdl inputs: 1 x pdl, 2 y pdls, w/ resid and xlog ylog',
xlog => 1,
ylog => 1,
},
t/Chart-Scientific.t view on Meta::CPAN
{ #39
x_data => $logx,
y_data => [$logy,$logy2],
yerr_data => [$loge,$loge ],
residuals => 1,
xlabel => "label for x axis",
ylabel => "label for y axis",
title => "title",
subtitle => "subtitle",
noline => 1,
nolegend => 1,
},
{ #40
x_data => $logx,
y_data => [$logy,$logy2],
yerr_data => [$loge,$loge ],
residuals => 1,
xlabel => "label for x axis",
ylabel => "label for y axis",
title => "title",
subtitle => "subtitle",
noline => 1,
nolegend => 1,
residuals_size => .75,
},
{ #41
x_data => $logx,
y_data => [$logy,$logy2],
yerr_data => [$loge,$loge ],
residuals => 1,
xlabel => "label for x axis",
ylabel => "label for y axis",
title => "axis displayed, no resids",
subtitle => "subtitle",
nolegend => 1,
axis => 1,
xrange => '-1,6',
yrange => '-10,18',
},
{ #42
x_data => [0..4],
y_data => \@arr,
yerr_data => \@err,
legend_text => 'test0,test1,test2,test3,test4,test5,test6,test7,test8,test9',
xrange => '-1,5.3',
yrange => '-50,500',
xlabel => 'monkey',
ylabel => 'brains',
title => 'axis with resids, no axis_resids',
residuals => 1,
axis => 1,
},
{ #43
x_data => [0..4],
y_data => \@arr,
yerr_data => \@err,
legend_text => 'test0,test1,test2,test3,test4,test5,test6,test7,test8,test9',
xrange => '-1,5.3',
yrange => '-50,500',
xlabel => 'monkey',
ylabel => 'brains',
title => 'axis with resids and axis_resids',
residuals => 1,
axis => 1,
axis_residuals => 1,
},
{ #44
( run in 1.051 second using v1.01-cache-2.11-cpan-49f99fa48dc )