Beefy Boxes and Bandwidth Generously Provided by pair Networks
We don't bite newbies here... much
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??
Hello Monks--

I've created a PDL-based plotting tool. I find it very useful at work, and I hope some monks can get some use out of it as well!

Use pdlplot --usage for full help and explaination, but here is a summary:

NAME
pdlplot- A (hopefully) easy to use plotter with a (relatively) simple interface.

SYNOPSIS
pdlplot -file <datafile name> -split '\t' -x <x column name> -y <y column name> -yerr <y error bar column name> options

DESCRIPTION
pdlplot is a simple PDL-based plotter. 2-D plots can be easily made from a file containing columns of data. The columns can be delimited with any character(s) or regular expression.

Using a comma-delimitted file:

pdlplot -f mydata.dat -split ',' -x time -y position

pdlplot -f mydata.dat -split ',' -x time -y position -yerr err

#!/usr/bin/perl use warnings; use strict; use Data::Dumper; use Getopt::Long; use PDL; use PDL::Graphics::PGPLOT; use PGPLOT; #use Tie::IxHash; # The RDB module is tested for and 'use'-ed in parse_args. our ( $VERSION ) = '$Revision: 1.4 $' =~ /([\d.]+)/; eval { main (); }; if ( my $err = $@ ) { print STDERR "# $0: $_\n", foreach split /\n/, $err; exit 1 ; } exit 0; sub main { my $r_pars = parse_args (); my $r_leg; my $r_points = {}; #tie %$r_points, "Tie::IxHash"; ( $r_points, $r_leg ) = read_points ( $r_pars, $r_points ); draw_points ( $r_pars, $r_points, $r_leg ); } sub read_points { my $r_pars = shift () or die "no pars in read_points"; my $r_points = shift () or die "no points in read_points"; my @leg_arr = ( !defined $r_pars->{split} ) ? read_RDB ( $r_pars, $r_points ) : read_file ( $r_pars, $r_points ); print "read-in points: ", Dumper $r_points if $r_pars->{verbose} > 1; print "Legend array: ", Dumper [ map { $_->[1] } @leg_arr ] if $r_pars->{verbose} > 1; $r_points = loggify_data ( $r_points, $r_pars ) if $r_pars->{xlog} || $r_pars->{ylog}; return $r_points, [ map { $_->[1] } @leg_arr ]; } sub read_RDB { my $r_pars = shift () or die "no r_pars in read_RDB"; my $r_points = shift () or die "no r_points in read_RDB"; print "reading with RDB.pm\n" if $r_pars->{verbose}; my $rdb = new RDB; $rdb->open ( $r_pars->{filename} eq 'stdin' ? \*STDIN : $r_pars->{filename} ) or die "RDB open failed on file '$r_pars->{filename}' $!"; my $r_line = {}; my @leg_arr = (); while ( $rdb->read( $r_line ) ) { my $brk = ( defined $r_pars->{break} ) ? $r_line->{$r_pars->{break}} : $r_pars->{only}; push @{$r_points->{$brk}{x}}, $r_line->{$r_pars->{x}}; foreach ( 0 .. scalar @{$r_pars->{y}} - 1 ) { print "read: $_ $r_line->{$r_pars->{y}[$_]} $r_pars->{y}[$ +_]\n" if $r_pars->{verbose} > 3; push @{$r_points->{$brk}{y}[ $_]}, $r_line->{$r_pars->{y}[ $_]}; push @{$r_points->{$brk}{yerr}[$_]}, $r_line->{$r_pars->{yerr}[$_]} if defined $r_pars->{yerr}[$_]; my $leg_key = $r_pars->{y}[$_] . ( $brk ne $r_pars->{only} ? ", $brk:" : "" ); push @leg_arr, [ $brk, $leg_key ] unless grep { $_->[1] eq $leg_key } @leg_arr; } } return @leg_arr; } sub read_file { my $r_pars = shift () or die "no r_pars in read_RDB"; my $r_points = shift () or die "no r_points in read_RDB"; print "reading from regular file\n" if $r_pars->{verbose}; # If a filename is given, read from it; otherwise, read from STDIN +: # my $fh; if ( $r_pars->{filename} ne 'stdin' ) { open $fh, $r_pars->{filename} } else { $fh = 'STDIN'; } my ( @col_names, %col_number, @leg_arr ) = ( (), (), () ); while ( <$fh> ) { next if /^#/; # skip comments next if /^[#SNM\t]+$/; # skip definition lines if you're # kludge-reading a RDB file chomp ( my @vals = split /$r_pars->{split}/, $_ ); die "Split returned only one item per line-- abort!\n" if 1 == scalar @vals; if ( 0 == scalar @col_names ) { @col_names = @vals; %col_number = map {$col_names[$_] => $_} 0..scalar @col_na +mes-1; next; } my $brk = ( defined $r_pars->{break} ) ? $vals[ $col_number{ $r_pars->{break} } ] : $r_pars->{only}; push @{$r_points->{$brk}{x}}, $vals[ $col_number{ $r_pars->{x} + } ]; foreach ( 0 .. scalar @{$r_pars->{y}} - 1 ) { push @{$r_points->{$brk}{y}[$_]}, $vals[ $col_number{$r_pars->{y}[$_]} ]; push @{$r_points->{$brk}{yerr}[$_]}, $vals[ $col_number{$r_pars->{yerr}[$_]} ] if defined $r_pars->{yerr}[$_]; my $leg_key = $r_pars->{y}[$_] . ( $brk ne $r_pars->{only} ? ", $brk:" : "" ); push @leg_arr, [ $brk, $leg_key ] unless grep { $_->[1] eq $leg_key } @leg_arr; } } close $fh if $r_pars->{filename} ne 'stdin'; return @leg_arr; } sub draw_points { my ( $r_pars, $r_points, $r_leg ) = @_; my ( $r_x_data, $r_y_data, $r_y_errs, $r_res_data, $r_res_errs ) = make_pdls ( $r_points, $r_pars ); my $win = setup_win ( $r_pars, $r_x_data, $r_y_data, $r_y_errs ); my @lims1 = get_limits ( $r_pars, $r_x_data, $r_y_data, $r_y_errs, + 0 ); set_window ( $win, $r_pars, \@lims1, 0 ); my $opts = points_draw_loop ( $r_pars, $win, $r_x_data, $r_y_data, $r_y_e +rrs ); my $font_charsize_opts = { Font => $r_pars->{font}, HardFont => $r_pars->{font}, CharSize => $r_pars->{char_size}, HardCH => $r_pars->{char_size}, }; $win->label_axes ( ( defined $r_pars->{residuals} ) ? ( "", @{$r_pars}{'ylabel','title'}, $font_charsize_ +opts ) : ( @{$r_pars}{'xlabel','ylabel','title'}, $font_charsize_ +opts ) ); pgmtxt ( 'T', 0.5, 0.5, 0.5, $r_pars->{subtitle} ); $r_leg = $r_pars->{legend_text} if defined $r_pars->{legend_text}; write_legend ( $r_pars, $win, \@lims1, $opts, $r_leg ) if $r_pars->{legend}; # Return if the residuals do not exist: # return if not defined $r_pars->{residuals}; # Draw the residuals: # my @lims2 = get_limits ( $r_pars, $r_x_data, $r_res_data, $r_res_e +rrs, 1 ); set_window ( $win, $r_pars, \@lims2, 1 ); $opts = points_draw_loop ( $r_pars,$win,$r_x_data,$r_res_data,$r_r +es_errs, 1 ); $win->label_axes ( $r_pars->{xlabel}, $r_pars->{delta_label}, $font_charsize_opts ); } sub points_draw_loop { my $r_pars = shift () or die "no pars in points_draw_loop"; my $win = shift () or die "no win in points_draw_loop"; my $r_x_loc = shift () or die "no x data in points_draw_loop" +; my $r_y_loc = shift () or die "no y data in points_draw_loop" +; my $r_e_loc = shift () || undef; my $bRes = shift () || 0; my ( $opts, $opt_num ) = ( {}, 0 ); my @syms = split /,/, $r_pars->{symbols}; my @colors = split /,/, $r_pars->{colors}; foreach my $brk ( sort keys %$r_x_loc ) { foreach ( 0 .. scalar @{$r_y_loc->{$brk}} - 1 ) { $opts->{pt_col}[$opt_num] = $colors[ $opt_num % scalar @co +lors]; $opts->{symbol}[$opt_num] = $syms[ $opt_num % scalar @sy +ms ]; $opts->{ln_col}[$opt_num] = $colors[ $opt_num % scalar @co +lors]; $opts->{ln_sty}[$opt_num] = 1 + $opt_num % 5; my $pointsopt = { color => $opts->{pt_col}[$opt_num], symbol => $opts->{symbol}[$opt_num], linewidth => $r_pars->{line_width} }; my $lineopt = { color => $opts->{ln_col}[$opt_num], linestyle => $opts->{ln_sty}[$opt_num], linewidth => $r_pars->{line_width} }; my @data = ( $r_x_loc->{$brk}, $r_y_loc->{$brk}[$_] ); $win->line ( @data, $lineopt ) unless $r_pars->{noline +}; $win->points ( @data, $pointsopt ) unless $r_pars->{nopoin +ts}; $win->bin ( hist $data[1] ) if $r_pars->{histog +ram}; my ( $err_lo, $err_hi ); if ( defined $r_e_loc ) { $err_lo = $r_e_loc->{$brk}[$_]; $err_hi = $r_e_loc->{$brk}[$_]; # Data and err is already logged at this point: # if ( $r_pars->{ylog} ) { my $log_kludge_lo = log10 ( 10**($r_y_loc->{$brk}[ +$_]) - 10**($r_e_loc->{$brk}[ +$_]) ); my $log_kludge_hi = log10 ( 10**($r_y_loc->{$brk}[ +$_]) + 10**($r_e_loc->{$brk}[ +$_]) ); $err_lo = $r_y_loc->{$brk}[$_] - $log_kludge_lo; $err_hi = $log_kludge_hi - $r_y_loc->{$brk}[$_]; } $win->errb ( @data, undef, undef, $err_lo, $err_hi, $lineopt ); } ++$opt_num; } last if $bRes; } return $opts; } sub make_pdls { my ( $r_points, $r_pars ) = @_; my $r_x_data; my $r_y_data; my $r_y_errs if $r_pars->{yerr}; my $r_res_data if $r_pars->{residuals}; my $r_res_errs if $r_pars->{residuals} && $r_pars->{yerr}; # Do x and y: # foreach my $brk ( sort keys %$r_points ) { $r_x_data->{$brk} = pdl @{ $r_points->{$brk}{x} }; foreach ( 0 .. scalar @{$r_points->{$brk}{y}} - 1 ) { push @{$r_y_data->{$brk}}, pdl @{ $r_points->{$brk}{y}[ +$_] }; push @{$r_y_errs->{$brk}}, pdl @{ $r_points->{$brk}{yerr}[ +$_] } if defined $r_pars->{yerr}[$_]; } } my @ret = ( $r_x_data, $r_y_data ); $ret[2] = ( $r_pars->{yerr} ) ? $r_y_errs : undef; return @ret unless $r_pars->{residuals}; # Do residuals: # # Two column version-- just subract: # if ( scalar @{$r_pars->{y}} > 1 ) { foreach my $brk ( sort keys %$r_points ) { $r_res_data->{$brk} = [$r_y_data->{$brk}[0] - $r_y_data->{ +$brk}[1]]; $r_res_errs->{$brk} = undef if $r_pars->{yerr}; $r_res_errs->{$brk} = [ sqrt ( $r_y_errs->{$brk}[0]**2 + $r_y_errs->{$brk}[1 +]**2 ) ] if ( $r_pars->{residuals} && defined $r_pars->{yer +r}[0] && defined $r_pars->{yer +r}[1] ) } } # Break column version-- need to interpolate set 1 to get to set 2 +: # elsif ( defined $r_pars->{break} ) { my @brk = ( sort keys %$r_points )[0..1]; foreach ( 0 .. scalar @{$r_y_data->{$brk[0]}} - 1 ) { $r_res_data->{$brk[0]}[$_] = ( interpolate ( $r_x_data->{$brk[1]}, $r_x_data->{$brk[0]}, $r_y_data->{$brk[0]}[$_] ) )[0] - $r_y_data->{$brk[1]}[$_]; $r_res_errs->{$brk[0]}[$_] = $r_y_errs->{$brk[0]}[$_]; } $r_res_data->{$brk[1]} = $r_res_data->{$brk[0]}; } else { die "WTF in make_pdls. trouble with making residuals"; } $ret[3] = ( $r_pars->{residuals} ) ? $r_res_data : undef; $ret[4] = ( $r_pars->{residuals} && $r_pars->{yerr}) ? $r_res_errs + : undef; return @ret; } sub setup_win { my $r_pars = shift () or die "no pars in setup_win"; my $win = PDL::Graphics::PGPLOT::Window->new ( Device => $r_pars->{device}, WindowName => "plot created by $0", AxisColor => 'black', Color => 'black', Axis => $r_pars->{axis} ? 'axes' : 'normal', Font => $r_pars->{font}, HardFont => $r_pars->{font}, CharSize => $r_pars->{char_size}, HardCH => $r_pars->{char_size}, ); return $win } sub set_window { my $win = shift () or die "no window object in set_window"; my $r_pars = shift () or die "no pars in set_window"; my $r_lims = shift () or die "no limits in set_window"; my $iWin = shift () || 0; my @env_pars = ( @$r_lims, { PlotPosition => $r_pars->{PlotPosition}[$iWin], Axis => [ 'BCNST', 'BCMSTV' ], } ); #$env_pars[-1]{Axis} = $r_pars->{WindowSetPars}{Axis} # if defined $r_pars->{WindowSetPars}{Axis}; $env_pars[-1]{Axis}[0] .= 'L' if $r_pars->{xlog}; $env_pars[-1]{Axis}[1] .= 'L' if $r_pars->{ylog}; if ( 0 == $iWin && $r_pars->{residuals} ) { $env_pars[-1]{Axis} = [ "BCST" . ( $r_pars->{xlog} ? 'L' : '' ), "BCSTNV" . ( $r_pars->{ylog} ? 'L' : '' ), ]; } $env_pars[-1]{Axis}[1] =~ s/M/N/ if !$r_pars->{delta_pos}; $win->env ( @env_pars ); } sub write_legend { my $r_pars = shift () or die "no pars in write_legend"; my $win = shift () or die "no win in write_legend"; my $lims = shift () or die "no lims in write_legend"; my $opts = shift () or die "no opts in write_legend"; my $r_leg = shift () or die "no leg in write_legend"; my @loc = ( $lims->[0], $lims->[3] ); my @deltas = ( $lims->[1] - $lims->[0], $lims->[3] - $lims->[2] ); if ( $r_pars->{legend_location} ) { $loc[0] += $r_pars->{legend_location}[0] * $deltas[0]; $loc[1] += $r_pars->{legend_location}[1] * $deltas[1]; } else { $loc[0] += .1 * $deltas[0]; $loc[1] += -.1 * $deltas[1]; } # Legend Usage: # # [ names ], # x,y # { option hash } # $win->legend ( $r_leg, #0.01, .7, @loc, { Symbol => $opts->{symbol}, LineStyle => $opts->{ln_sty}, Color => $opts->{ln_col}, LineWidth => [ 50, 50 ], TextShift => 0, Font => $r_pars->{font}, HardFont => $r_pars->{font}, CharSize => $r_pars->{char_size}, HardCH => $r_pars->{char_size}, Fraction => 0.5, } ); } sub log_ten { my $num = shift () || 0.0; return ( $num <= 0.0 ) ? undef : log ( $num ) / log ( 10.0 ); } sub null_undef_points { my $r_pars = shift () or die "no pars in null_undef_points"; my $r_points = shift () or die "no points in null_undef_points"; # Determine which points are undefined: # my %null = (); foreach my $brk ( sort keys %$r_points ) { foreach ( 0 .. scalar @{$r_points->{$brk}{x}} - 1 ) { ++$null{$_} if not defined $r_points->{$brk}{x}[$_]; foreach my $col ( 0 .. scalar @{$r_points->{$brk}{y}} - 1 +) { ++$null{$_} if not defined $r_points->{$brk}{y}[$col][$_] || (not defined $r_points->{$brk}{yerr}[$col][$_] +&& defined $r_pars->{yerr}[$_]); } } } # And skip them in all columns: # my $ret_points; foreach my $brk ( sort keys %$r_points ) { foreach ( 0 .. scalar @{$r_points->{$brk}{x}} - 1 ) { next if exists $null{$_}; push @{$ret_points->{$brk}{x}}, $r_points->{$brk}{x}[$_]; foreach my $col ( 0 .. scalar @{$r_points->{$brk}{y}} - 1 +) { push @{$ret_points->{$brk}{y}[$col]}, $r_points->{$brk}{y}[$col][$_]; push @{$ret_points->{$brk}{yerr}[$col]}, $r_points->{$brk}{yerr}[$col][$_]; } } } return $ret_points; } sub loggify_data { my ( $r_points, $r_pars ) = @_; # Deal with a logged x- or y-axis (or both). Remove points # that are <= 0.0: # my %log_axis = (); foreach my $brk ( sort keys %$r_points ) { foreach ( 0 .. scalar @{$r_points->{$brk}{x}} - 1 ) { if ( $r_pars->{xlog} ) { $log_axis{x} = 1; $r_points->{$brk}{x}[$_] = log_ten ( $r_points->{$brk}{x}[$_] ); } if ( $r_pars->{ylog} ) { $log_axis{y} = 1; $r_points->{$brk}{residuals}[$_] = log_ten ( $r_points->{$brk}{x}[$_] ); foreach my $col ( 0 .. scalar @{$r_points->{$brk}{y}} +- 1 ) { $r_points->{$brk}{y}[$col][$_] = log_ten ( $r_points->{$brk}{y}[$col][$_] ); $r_points->{$brk}{yerr}[$col][$_] = log_ten ( $r_points->{$brk}{yerr}[$col][$_] ) if defined $r_pars->{yerr}[$col]; } } } } $r_points = null_undef_points ( $r_pars, $r_points ); $r_pars->{WindowSetPars}{Axis} = 'log' . join ( "", sort keys %log +_axis ); return $r_points; } sub get_limits { my $r_pars = shift () or die "no r_pars in get_limits"; my $r_x_data = shift () or die "no x data in get_limits"; my $r_y_data = shift () or die "no y data in get_limits"; my $r_y_errs = shift () || undef; my $bIsResids = shift () || 0; # Limits: # x_low x_high, y_low, y_high my @lims = ( undef, undef, undef, undef ); # Get data extremes, and make them the limits: # my @brks = sort keys %$r_x_data; @brks = @brks[0,1] if $bIsResids && $r_pars->{break}; foreach my $brk ( @brks ) { my ( $min, $max ) = ( $r_x_data->{$brk}->min, $r_x_data->{$brk}->max ); $lims[0] = $min if ! defined $lims[0] || $min < $lims[0]; $lims[1] = $max if ! defined $lims[1] || $max > $lims[1]; foreach ( 0 .. scalar @{$r_y_data->{$brk}} - 1 ) { my ( $min, $max ); if ( $r_pars->{ylog} ) { if ( defined $r_y_errs->{$brk}[$_] ) { # Ignore negative err bars-- they can be huge: $min = log10 ( ( 10**( $r_y_data->{$brk}[$_] ) )- +>min () ); $max = log10 ( ( 10**( $r_y_data->{$brk}[$_] ) + 10**( $r_y_errs->{$brk}[$_] ) )- +>max () ); } else { $min = log10 ( ( 10**( $r_y_data->{$brk}[$_] ) )- +>min () ); $max = log10 ( ( 10**( $r_y_data->{$brk}[$_] ) )- +>max () ); } } else { if ( defined $r_y_errs->{$brk}[$_] ) { $min = ( $r_y_data->{$brk}[$_] - $r_y_errs->{$brk} +[$_] )->min(); $max = ( $r_y_data->{$brk}[$_] + $r_y_errs->{$brk} +[$_] )->max(); } else { $min = ( $r_y_data->{$brk}[$_] )->min(); $max = ( $r_y_data->{$brk}[$_] )->max(); } } $lims[2] = $min if ! defined $lims[2] || $min < $lims[2]; $lims[3] = $max if ! defined $lims[3] || $max > $lims[3]; } } return pad_limits ( $r_pars, @lims ); } sub pad_limits { my $r_pars = shift () or die "no pars in pad_limits"; my @lims = @_; my $dx = $lims[1] - $lims[0]; my $dy = $lims[3] - $lims[2]; # Pad limits to create pleasing margins: # $lims[0] -= .1 * $dx; $lims[1] += .1 * $dx; $lims[2] -= .1 * $dy; $lims[3] += .1 * $dy; # Override if user-specified limits exist: # @lims[0,1] = split /,/, $r_pars->{xrange} if defined $r_pars->{xra +nge}; @lims[2,3] = split /,/, $r_pars->{yrange} if defined $r_pars->{yra +nge}; # Give a 2-unit range is either axis's range is zero: # my $epsilon = 1.0e-9; if ( not defined $r_pars->{xrange} && $lims[0] - $lims[1] < $epsil +on ) { $lims[0] -= .1; $lims[1] += .1; } if ( not defined $r_pars->{yrange} && $lims[2] - $lims[3] < $epsil +on ) { $lims[2] -= .1; $lims[3] += .1; } return @lims; } sub parse_args { # Do the getopt: # my @opts = ( { name => 'title', type => '=s', dval => '', + }, { name => 'subtitle', type => '=s', dval => '', + }, { name => 'xlabel', type => '=s', dval => '', + }, { name => 'ylabel', type => '=s', dval => '', + }, { name => 'delta_label', type => '=s', dval => '', + }, { name => 'delta_pos', type => '', dval => 0, + }, { name => 'legend', type => '!', dval => 1, + }, { name => 'legend_location', type => '=s', dval => '.02,-.05', + }, { name => 'legend_text', type => '=s', dval => undef, + }, { name => 'x', type => '=s', dval => undef, + }, { name => 'y', type => '=s', dval => undef, + }, { name => 'yerr', type => '=s', dval => undef, + }, { name => 'break', type => '=s', dval => undef, + }, { name => 'residuals', type => '', dval => undef, + }, { name => 'xrange', type => '=s', dval => undef, + }, { name => 'yrange', type => '=s', dval => undef, + }, { name => 'xlog', type => '', dval => 0, + }, { name => 'ylog', type => '', dval => 0, + }, { name => 'colors', type => '=s', dval => 'black,red,green,blue,cyan,magenta,gra +y' }, { name => 'symbols', type => '=s', dval => '999' + }, { name => 'font', type => '=f', dval => '1' + }, { name => 'char_size', type => '=f', dval => '1' + }, { name => 'line_width', type => '=f', dval => '2' + }, { name => 'nopoints', type => '', dval => 0, + }, { name => 'noline', type => '', dval => 0, + }, { name => 'histogram', type => '', dval => 0, + }, { name => 'axis', type => '!', dval => 0, + }, { name => 'f', type => '=s', dval => 'stdin', + }, { name => 'filename', type => '=s', dval => undef, + }, { name => 's', type => '=s', dval => undef, + }, { name => 'split', type => '=s', dval => undef, + }, { name => 'device', type => '=s', dval => '/xs', + }, { name => 'only', type => '=s', dval => 'only', + }, { name => 'defaults', type => '', dval => 0, + }, { name => 'verbose', type => '=f', dval => 0, + }, { name => 'help', type => '', dval => 0, + }, { name => 'usage', type => '', dval => 0, + }, { name => 'version', type => '', dval => 0, + }, ); my %pars = map { $opts[$_]{name} => $opts[$_]{dval} } 0..scalar @o +pts - 1; my @args = map { $opts[$_]{name} . $opts[$_]{type} } 0..scalar @o +pts - 1; GetOptions ( \%pars, @args ) or die "bad GetOptions $!"; die "$VERSION" if $pars{version}; $pars{filename} = $pars{f} if !defined $pars{filename}; $pars{split} = $pars{s} if !defined $pars{split}; $pars{symbols} = join ",", 3, 0, 5, 4, 6..99 if $pars{symbols} eq '999'; # Die if defaults are requested # die Data::Dumper->Dump( [ \%pars ], [ qw( pars ) ] ), "Printing defaults and exiting on user request" if ( $pars{defaults} ); help ( 1 ) if $pars{help}; help ( 2 ) if $pars{usage}; # Determine if user wants to use RDB.pm. # Include it if it exists, otherwise, # warn user, and try to soldier on. # if ( not defined $pars{split} ) { eval { require RDB; }; if ( my $err = $@ ) { $pars{split} = "\t"; printf STDERR "RDB.pm not found. Setting --split='\t' and + ", "continuing with crossed fingers. Here goes + ", "nothing.\n"; } } # Massage arguments: # $pars{x} = shift @ARGV unless $pars{x}; $pars{y} = shift @ARGV unless $pars{y}; $pars{yerr} = shift @ARGV unless $pars{yerr}; $pars{y} = [ split /,/, $pars{y} ] if defined $par +s{y}; $pars{yerr} = [ split /,/, $pars{yerr} ] if defined $par +s{yerr}; $pars{legend_location} = [ split /,/, $pars{legend_location} ] if defined $pars{legend_location}; $pars{legend_text} = [ split /,/, $pars{legend_text} ] if defined $pars{legend_text}; #die "Number of y data (" . scalar @{$pars{y}} . # ") and error-bar (" . scalar @{$pars{yerr}} . ") sets must b +e equal" # if defined $pars{yerr} && scalar @{$pars{y}} != @{$pars{yerr} +}; die "Must have two y data columns or have a break column to use -- +residuals" if $pars{residuals} && scalar @{$pars{y}} < 2 && not defined $ +pars{break}; deduce_x_y_names ( \%pars ) if ! defined $pars{x} && ! defined $pars{y}; $pars{PlotPosition} = defined $pars{residuals} ? ( [ [ 0.1, 0.9, 0.25, 0.90 ], [ 0.1, 0.9, 0.1, 0.25 ] ] +) : ( [ [ 0.1, 0.9, 0.1, 0.90 ] ] ); $pars{xlabel} = "$pars{x}" if '' eq $pars{xlabel}; $pars{ylabel} = "@{$pars{y}}" if '' eq $pars{ylabel}; $pars{delta_label} = "deltas" if '' eq $pars{delta_label}; my $tit_fmt = $pars{break} ? "%s vs %s grouped by %s" : "%s v +s %s"; my @print_arr = ( "@{$pars{y}}", "$pars{x}" ); push @print_arr, $pars{break} if $pars{break}; $pars{title} = sprintf $tit_fmt, @print_arr if '' eq $pars{title}; print Dumper \%pars if $pars{verbose} > 3; return \%pars; } sub deduce_x_y_names { my $r_pars = shift () or die "no file in x_y_names"; my $tmpfile = '.plot.hdr'; if ( 'stdin' eq $r_pars->{filename} ) { open my $write_fh, '>', $tmpfile; print $write_fh $_ while <>; close $write_fh; $r_pars->{filename} = $tmpfile; } open my $fh, $r_pars->{filename}; my $definition_line = '#'; chomp ( $definition_line = <$fh> ) while $definition_line =~ /^\s*#/; close $fh; # Non-RDB file case: # if ( defined $r_pars->{split} ) { $r_pars->{x} = ( split /$r_pars->{split}/, $definition_line +)[0]; $r_pars->{y} = [ ( split /$r_pars->{split}/, $definition_line +)[1] ]; } # RDB file case: # else { $r_pars->{x} = ( split /\t/, $definition_line )[0]; $r_pars->{y} = [ ( split /\t/, $definition_line )[1] ]; } } sub help { my ( $verbose ) = @_; require IO::Page; require Pod::Usage; Pod::Usage::pod2usage ( { -exitval => 0, -verbose => $verbose } ); + } =pod =head1 NAME pdlplot- A (hopefully) easy to use plotter with a (relatively) simple +interface. =head1 SYNOPSIS B<pdlplot> -f[ile] <datafile name> [-split '\t'] [-x] <x column name> [-y] <y column name> [ [-yerr] <y error bar colum +n name>] [I<options>] =head1 DESCRIPTION B<pdlplot> is a simple PDL-based plotter. 2-D plots can be easily made from a file containing columns of data. The columns can be delim +ited with any character(s) or regular expression. =head1 OPTIONS Options are specified using a getopt style interface. Long names are +available when preceded with double hyphens C<-->, in which case only the minima +l number of unique characters are required. =over 8 =item B<--file>=I<input data file> The name of the file that contains the data. If not specified, B<pdlp +lot> will read from STDIN. If B<--split> (see below) is not specified, the file + is assumed to be an RDB file (see http://hea-www.harvard.edu/MST/simul/software/docs/rdb.html). B<pdlpl +ot> makes an attempt to read the file if the RDB.pm module is not on the local s +ystem-- RDB comments (leading '#'s) are stripped, the column definition line i +s ignored, and the body of the file is split into columns on tabs. =item B<--split>=I<data separator for non-RDB input files> Used for non-RDB files, B<--split> specifies which character(s) (or r +egex) to split the data from B<--file> on. For a comma-delimitted file, --spli +t ',' would be the correct usage, or --split '\|' for a pipe-delimitted file + (the pipe is a special char in perl regexes, so we must escape it). If the + file specified by B<--file> is an RDB file, this switch should not be used. =item B<--x>=I<X-axis column name> The name of the column in the rdb file that holds the independent vari +able. This can also be given as the first unflagged argument, i.e., 'pdlplot + -f test.rdb position velocity' would take 'position' as the X-axis column + name. =item B<--y>=I<Y-axis column name> The name of the column in the rdb file that holds the dependent variab +le. To plot multiple columns simultaneously, give a comma-separated list of the names of the columns after the --y, e.g. B<--y position,velocity>. This can also be given as the second unflagged argument, i.e., 'pdlplo +t -f test.rdb position velocity' would take 'velocity' as the Y-axis column + name. =item B<--yerr>=I<Y-data uncertainties column name> The name of the column in the rdb file that holds the uncertainties fo +r the Y values (comma-separated list if the y-data is a comma-separated +list). =item B<--residuals> A boolean that tells the program to plot the difference between the fi +rst two y data columns. This data will be plotted in a second, smaller pane. The smaller pane will have identical x-values to the main data +pane. For plots that pull two or more y-data sets from the same rows (i.e., +no break column), the residuals are the difference of the first two speci +fied y-data columns. For plots that use a break column, the residuals are the interpolated differences between the first and the second break-co +lumn sets of y-data. =item B<--xlog> Plot the X-axis in log space. Default is linear plotting. =item B<--ylog> Plot the Y-axis in log space. Default is linear plotting. This option does not currently work with --ylog or --xlog (see below). =item B<--xrange>=I<Comma-separated X range> Specify a comma-separated non-default range for the X values. Example +: -x -5,5 will plot the data from x=-5 to x=5. If the I<xlog> flag is on, the x +range values must be specified in powers of ten. E.G. -xlog -x -1,2 will pl +ot the data on a logged X range from 0.1 to 100. =item B<--yrange>=I<Comma-separated Y range> Specify a comma-separated non-default range for the X values. Example +: -y -5,5 will plot the data from y=-5 to y=5. If the I<ylog> flag is on, the y +range values must be specified in powers of ten. E.G. -ylog -y -1,2 will pl +ot the data on a logged Y range from 0.1 to 100. =item B<--title>=I<Plot title> A title to go at the top of the plot. Default is the y-axis name vs t +he x-axis name. =item B<--subtitle>=I<Plot subtitle> A subtitle to go at the top of the plot. No default. =item B<--xlabel>=I<Label of X axis> A title for the x-axis of the plot. Default is the x-axis name. =item B<--ylabel>=I<Label of Y axis> A title for the y-axis of the plot. Default is the y-axis name. =item B<--delta_label>=I<Label of the residuals y-axis> A title for the y-axis of the residuals plot. Default is "deltas". =item B<--delta_pos> A flag to move the numbering on the residuals plot to the right side o +f the pane. =item B<--nopoints> Suppresses data point drawing; does not suppress the line drawn betwee +n points. =item B<--noline> Suppresses data line drawing; does not suppress data point drawing. =item B<--colors> A comma-separated string that specifies the color set to use for drawi +ng points and lines. For example, if 'red,blue,black' is the argument, the firs +t set of points will be drawn red, the second blue, the third black, and then t +he fourth will be drawn red agan. The default is 'black,red,green,blue,yellow,cyan,magenta,gray'. =item B<--symbols> A comma-separated string that specifies the symbol set to use for draw +ing points and lines. For example, if '0,3,4' is the argument, the first +set of points will be drawn with symbol 0, the second with symbol 3, and the +third with symbol 4. The fourth set of points will be drawn with symbol 0, +and so forth. The default is '5,3,0,4" followed by the sequence 6...99. =item B<--font>=I<integer> A PGPlot font integer. The default is 1, and the range is 1-4. =item B<--char_size>=I<character size in multiples of the standard siz +e> The PGPlot character size. The default is 1. =item B<--line_width>=I<line width in multiples of the standard width> The PGPlot line width. The default is 2. =item B<--histogram> Experimental, incorrect, histogram flag. DO NOT USE! =item B<--nolegend> Using the --nolegend flag will prevent a legend from being drawn. The default is for a legend to be drawn. =item B<--legend_location>=I<legend coordinates> A comma-separated list that to specify a location for the plot's legen +d. The default is .05,-.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>=I<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 da +ta sets are given. =item B<--device>=I<plotting device, or output file name/device name> Either the name of your plotting device, or a filename/device pair. The default is '/xs', other likely options are '/xt', '/xw', and '/xw' +. For Windows, I '/gw' is rumored to work, although this has not been tested. Example: for a color postscript file to be written, use: -device 'out.ps/cps'. =item B<--verbose>=I<verbosity level> Verbosity level 0 results in silent operation. Verbosity level 1 prin +ts out some runtime information (the plot limits, at least), and verbosity le +vel 2 is pretty comprehensive, and level 3 is painfully chatty. =item B<--help> Print out brief help information. =item B<--usage> Print out complete help information. =head1 EXAMPLES Using an RDB file: B<pdlplot> -f mydata.rdb -x time -y position B<pdlplot> -f mydata.rdb -x time -y position -yerr err B<pdlplot> -f mydata.rdb -x time -y position -xr -1,2 -xlog -yr 0,100 B<pdlplot> -f mydata.rdb -x time -y position -xr -1,2 -xlog -yr 0,100 +-row 'energy eq 0.277' B<pdlplot> -file mydata.rdb -x t -y p -title "My Plot" -xlab time -yla +b pos -device 'out.ps/cps' B<pdlplot> -file mydata.rdb -x time -y position,velocity Using a comma-delimitted file: B<pdlplot> -f mydata.dat -split ',' -x time -y position B<pdlplot> -f mydata.dat -split ',' -x time -y position -yerr err =head1 LICENSE This software is released under the GNU General Public License. You may find a copy at http://www.fsf.org/copyleft/gpl.html =head1 AUTHOR Kester Allen (callen@cfa.harvard.edu) =cut
update: fixed readmore tags

In reply to PDL-based plotting tool by kesterkester

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others wandering the Monastery: (16)
    As of 2015-07-30 14:18 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









      Results (271 votes), past polls