564 lines
12 KiB
Perl
Executable file
564 lines
12 KiB
Perl
Executable file
#!/usr/bin/perl
|
|
|
|
=pod
|
|
|
|
=head1 NAME
|
|
|
|
plotpipe - Plot CSV data from a pipe
|
|
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
I<datagenerator> | B<plotpipe> [-n] [-H] [-0] [--log axis] [-C str] [-h] [-V] [I<expression>]
|
|
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
B<plotpipe> is a simple wrapper for Gnuplot to simply plotting data.
|
|
|
|
The input is a CSV-file. Lines starting with '#' will be used as
|
|
titles on the plot.
|
|
|
|
|
|
=head1 OPTIONS
|
|
|
|
=over 4
|
|
|
|
=item I<expression>
|
|
|
|
Evaluate I<expression>. I<expression> consists of parts separated by
|
|
,. Each part is evaluated as a Perl expression. You can use {I<n>} as
|
|
the column value:
|
|
|
|
seq 10 | plotpipe '{1},{1},{1}**2,sqrt({1})'
|
|
(echo x y;paste <(seq 10) <(seq 11 20)) |
|
|
plotpipe {1},{2},{2}/{1}
|
|
|
|
=item B<--colsep> I<string>
|
|
|
|
=item B<-C> I<string>
|
|
|
|
Use I<string> as column separator. B<plotpipe> will try to autoguess
|
|
the separator. If it guesses wrong, use B<--colsep>.
|
|
|
|
|
|
=item B<--header>
|
|
|
|
=item B<-H>
|
|
|
|
Use the first line as legend for data in columns. B<plotpipe> will try
|
|
to autoguess if the first line is a header. If it guesses wrong, use
|
|
B<--header>.
|
|
|
|
|
|
=item B<--help>
|
|
|
|
=item B<-h>
|
|
|
|
Show help.
|
|
|
|
|
|
=item B<--log x>
|
|
|
|
=item B<--log y>
|
|
|
|
=item B<--log xy>
|
|
|
|
Logarithmic X/Y/X&Y axis.
|
|
|
|
|
|
=item B<--nox>
|
|
|
|
=item B<-n>
|
|
|
|
No x-value. In a multi-column input the first value will normally be
|
|
used as x-value. B<--nox> will use line number as x-value.
|
|
|
|
|
|
=item B<--null>
|
|
|
|
=item B<-0>
|
|
|
|
Use \0 (NUL) instead of newline (\n) as record separator.
|
|
|
|
|
|
=item B<--smooth> I<width>
|
|
|
|
=item B<-s> I<width>
|
|
|
|
Smooth values. Take the median of I<width> y-values.
|
|
|
|
|
|
=item B<--version>
|
|
|
|
=item B<-V>
|
|
|
|
Show version
|
|
|
|
|
|
=back
|
|
|
|
|
|
=head1 EXAMPLE
|
|
|
|
Plot (1,100) .. (100,1):
|
|
|
|
paste <(seq 100 -1 1) | plotpipe
|
|
|
|
Plot (1,101) .. (100,200):
|
|
|
|
paste <(seq 100) <(seq 101 200) | plotpipe
|
|
|
|
Plot (1,101) .. (100,200) and (1,300) .. (100,102):
|
|
|
|
paste <(seq 100) <(seq 101 200) <(seq 300 -2 102) | plotpipe
|
|
|
|
=head1 EXAMPLE
|
|
|
|
input.csv:
|
|
|
|
#Title line 1
|
|
#This is title line 2
|
|
X-axis-header Values1 Values2
|
|
1 28 32
|
|
2 12 35
|
|
3 3.5 3.5
|
|
|
|
cat input.csv | plotpipe
|
|
|
|
=head1 EXAMPLE: No x column
|
|
|
|
input.csv:
|
|
|
|
#Plot with no x-value column
|
|
Values 1,Values 2
|
|
28,32
|
|
12,35
|
|
3.5,3.5
|
|
|
|
cat input.csv | plotpipe --nox
|
|
|
|
=head1 EXAMPLE: Log
|
|
|
|
input.csv:
|
|
|
|
#Plot with log y
|
|
2^n 3^n 4^n
|
|
1 1 1
|
|
2 3 4
|
|
4 9 16
|
|
8 27 64
|
|
|
|
cat input.csv | plotpipe --nox --log y
|
|
|
|
=head1 EXAMPLE: XY-line plots
|
|
|
|
You are not limited to a simple graph, but can also do XY-line plots.
|
|
|
|
seq 0 0.001 6.29 |
|
|
plotpipe 'sin({1}*100)*0.3+0.5*cos({1}*2),
|
|
sin({1}*2)-cos({1}*100)*0.3,
|
|
sin({1})+cos({1}*99),
|
|
sin({1}*3)-cos({1}*101)'
|
|
|
|
|
|
=head1 LIMITS
|
|
|
|
B<plotpipe> is limited by Gnuplot.
|
|
|
|
|
|
=head1 AUTHOR
|
|
|
|
Copyright (C) 2019-2021 Ole Tange,
|
|
http://ole.tange.dk and Free Software Foundation, Inc.
|
|
|
|
|
|
=head1 LICENSE
|
|
|
|
Copyright (C) 2012 Free Software Foundation, Inc.
|
|
|
|
This program is free software; you can redistribute it and/or modify
|
|
it under the terms of the GNU General Public License as published by
|
|
the Free Software Foundation; either version 3 of the License, or
|
|
at your option any later version.
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
GNU General Public License for more details.
|
|
|
|
You should have received a copy of the GNU General Public License
|
|
along with this program. If not, see <http://www.gnu.org/licenses/>.
|
|
|
|
|
|
=head1 DEPENDENCIES
|
|
|
|
B<pipeplot> uses B<gnuplot> and B<perl>.
|
|
|
|
|
|
=head1 SEE ALSO
|
|
|
|
B<gnuplot>, B<perl>, B<ploticus>
|
|
(http://ploticus.sourceforge.net/doc/welcome.html), B<feedgnuplot>
|
|
(https://github.com/dkogan/feedgnuplot), B<ttyplot>
|
|
(https://github.com/tenox7/ttyplot)
|
|
|
|
|
|
=cut
|
|
|
|
use Getopt::Long;
|
|
|
|
sub options_hash() {
|
|
# Returns:
|
|
# %hash = the GetOptions config
|
|
return
|
|
("debug|D=s" => \$opt::D,
|
|
"version|V" => \$opt::version,
|
|
"colsep|col-sep|C=s" => \$opt::colsep,
|
|
"help|h" => \$opt::help,
|
|
"log=s" => \$opt::log,
|
|
"null|0" => \$opt::null,
|
|
"nox|n" => \$opt::nox,
|
|
"header|H" => \$opt::header,
|
|
"smooth|s=i" => \$opt::smooth,
|
|
);
|
|
}
|
|
|
|
sub version() {
|
|
# Returns: N/A
|
|
print join
|
|
("\n",
|
|
"$Global::progname $Global::version",
|
|
"Copyright (C) 2020-2021 Ole Tange, http://ole.tange.dk and Free Software",
|
|
"Foundation, Inc.",
|
|
"License GPLv3+: GNU GPL version 3 or later <http://gnu.org/licenses/gpl.html>",
|
|
"This is free software: you are free to change and redistribute it.",
|
|
"$Global::progname comes with no warranty.",
|
|
"",
|
|
"Web site: https://gitlab.com/ole.tange/tangetools/-/tree/master/${Global::progname}\n",
|
|
"",
|
|
);
|
|
}
|
|
|
|
sub status(@) {
|
|
my @w = @_;
|
|
my $fh = $Global::status_fd || *STDERR;
|
|
print $fh map { ($_, "\n") } @w;
|
|
flush $fh;
|
|
}
|
|
|
|
sub error(@) {
|
|
my @w = @_;
|
|
my $prog = $Global::progname || "plotpipe";
|
|
status(map { ($prog.": Error: ". $_); } @w);
|
|
}
|
|
|
|
sub help() {
|
|
# Returns: N/A
|
|
print join
|
|
("\n",
|
|
"Usage:",
|
|
"",
|
|
"... | plotpipe [-H] [-0] [-C str]",
|
|
"",
|
|
"-H Ignore first line (header)",
|
|
'-0 Records separated by \0 instead of \n',
|
|
'-C str Columns separator',
|
|
'-V Show version',
|
|
'--log A Log axis A (x y xy)',
|
|
'-n No X value',
|
|
'-s num Smooth num Y-values',
|
|
"",
|
|
"See 'man $Global::progname' for details",
|
|
"",);
|
|
}
|
|
|
|
sub shell_quote_scalar_default($) {
|
|
# Quote for other shells (Bourne compatibles)
|
|
# Inputs:
|
|
# $string = string to be quoted
|
|
# Returns:
|
|
# $shell_quoted = string quoted as needed by the shell
|
|
my $s = $_[0];
|
|
if($s =~ /[^-_.+a-z0-9\/]/i) {
|
|
$s =~ s/'/'"'"'/g; # "-quote single quotes
|
|
$s = "'$s'"; # '-quote entire string
|
|
$s =~ s/^''//; # Remove unneeded '' at ends
|
|
$s =~ s/''$//; # (faster than s/^''|''$//g)
|
|
return $s;
|
|
} elsif ($s eq "") {
|
|
return "''";
|
|
} else {
|
|
# No quoting needed
|
|
return $s;
|
|
}
|
|
}
|
|
|
|
sub Q($) {
|
|
return shell_quote_scalar_default($_[0]);
|
|
}
|
|
|
|
sub my_dump(@) {
|
|
# Returns:
|
|
# ascii expression of object if Data::Dump(er) is installed
|
|
# error code otherwise
|
|
my @dump_this = (@_);
|
|
eval "use Data::Dump qw(dump);";
|
|
if ($@) {
|
|
# Data::Dump not installed
|
|
eval "use Data::Dumper;";
|
|
if ($@) {
|
|
my $err = "Neither Data::Dump nor Data::Dumper is installed\n".
|
|
"Not dumping output\n";
|
|
::status($err);
|
|
return $err;
|
|
} else {
|
|
return Dumper(@dump_this);
|
|
}
|
|
} else {
|
|
# Create a dummy Data::Dump:dump as Hans Schou sometimes has
|
|
# it undefined
|
|
eval "sub Data::Dump:dump {}";
|
|
eval "use Data::Dump qw(dump);";
|
|
return (Data::Dump::dump(@dump_this));
|
|
}
|
|
}
|
|
|
|
sub sum(@) {
|
|
# Returns:
|
|
# Sum of values of array
|
|
my @args = @_;
|
|
my $sum = 0;
|
|
for (@args) {
|
|
# Skip undefs
|
|
$_ and do { $sum += $_; }
|
|
}
|
|
return $sum;
|
|
}
|
|
|
|
sub max(@) {
|
|
# Returns:
|
|
# Maximum value of array
|
|
my $max;
|
|
for (@_) {
|
|
# Skip undefs
|
|
defined $_ or next;
|
|
defined $max or do { $max = $_; next; }; # Set $_ to the first non-undef
|
|
$max = ($max > $_) ? $max : $_;
|
|
}
|
|
return $max;
|
|
}
|
|
|
|
sub find_sep(@) {
|
|
# Try common find the separators.
|
|
# Do we get the same for each line?
|
|
my @csv = grep { not /^#/ } @_;
|
|
my @sep = (",", "\t", ";", '\s+');
|
|
my $columns;
|
|
my %col;
|
|
for my $sep (@sep) {
|
|
for my $line (@csv) {
|
|
$columns = split /$sep/, $line;
|
|
if($columns > 1) {
|
|
$col{$sep."\0".$columns}++
|
|
}
|
|
}
|
|
}
|
|
# Find max $col{$sep,$columns}
|
|
my $most_lines = max(values %col);
|
|
|
|
my %sepcol = (map { split /\0/, $_ }
|
|
grep { $col{$_} == $most_lines } keys %col);
|
|
my $most_cols = max(values %sepcol);
|
|
return ((grep { $sepcol{$_} == $most_cols } keys %sepcol)[0]);
|
|
}
|
|
|
|
|
|
Getopt::Long::Configure("bundling","require_order");
|
|
if(not GetOptions(options_hash())) {
|
|
exit(255);
|
|
}
|
|
|
|
$Global::progname = "plotpipe";
|
|
$Global::version = 20210302;
|
|
if($opt::version) { version(); exit 0; }
|
|
if($opt::help) { help(); exit 0; }
|
|
if($opt::null) { $/ = "\0"; }
|
|
|
|
my @eval_function = split/,/, join(" ",@ARGV);
|
|
|
|
# Read csv
|
|
my @csv = <STDIN>;
|
|
|
|
# Title = lines starting with #
|
|
my @title = map { s/^#//; s/"/''/g; $_ } map { "$_" } grep { /^#/ } @csv;
|
|
if(@title) { chomp($title[$#title]); }
|
|
@csv = grep { not /^#/ } @csv;
|
|
|
|
# Autoguess separator
|
|
if(not defined $opt::colsep) {
|
|
$opt::colsep = find_sep(@csv);
|
|
}
|
|
if($opt::colsep eq "") {
|
|
$opt::colsep = "\001soMe valUE tHat dOes nOT eXisT\002";
|
|
}
|
|
|
|
# Autoguess header
|
|
my @header;
|
|
if(not defined $opt::header) {
|
|
# Autodetect header
|
|
# if line 1 contains a-z => header
|
|
@header = split /$opt::colsep/, $csv[0];
|
|
for(@header) {
|
|
if(/[a-z]/i) { $opt::header = 1; last; }
|
|
}
|
|
}
|
|
if($opt::header) {
|
|
@header = split /$opt::colsep/, $csv[0];
|
|
chomp(@header);
|
|
shift @csv;
|
|
} else {
|
|
@header = ();
|
|
}
|
|
|
|
# Convert input to perl table
|
|
my @tbl;
|
|
for(@csv) {
|
|
chomp;
|
|
my @row = split /$opt::colsep/, $_;
|
|
push @tbl,\@row;
|
|
}
|
|
|
|
# Eval
|
|
if(@eval_function) {
|
|
for(@eval_function) {
|
|
my $new_header = $_;
|
|
$new_header =~ s/\{(\d+)\}/$header[$1-1] || "\\\\{$1\\\\}"/ge;
|
|
push @new_header, $new_header;
|
|
}
|
|
$opt::header = 1;
|
|
@header = @new_header;
|
|
for my $row (@tbl) {
|
|
my @newrow = map {
|
|
s/\{(\d+)\}/$row->[$1-1]/g;
|
|
eval "$_"
|
|
} map { $_ } @eval_function;
|
|
$row = \@newrow;
|
|
}
|
|
}
|
|
|
|
# Add x-axis if needed
|
|
my $ncols = $#{$tbl[0]}+1;
|
|
if($ncols >= 2 and not $opt::nox) {
|
|
# Column 1 = x-axis => Data is fine
|
|
} else {
|
|
# All data = y-axis => Invent x-axis
|
|
my $x = 0;
|
|
for my $row (@tbl) {
|
|
my @newrow = ($x++, @$row);
|
|
$row = \@newrow;
|
|
}
|
|
# Prepend dummy header for x-axis
|
|
unshift(@header,"");
|
|
$ncols += 1;
|
|
}
|
|
|
|
# Smooth data
|
|
if($opt::smooth) {
|
|
my (@sum,@new);
|
|
if($#tbl < $opt::smooth) {
|
|
error("--smooth must be lower than the number of rows (".(1+$#tbl).")");
|
|
exit(255);
|
|
}
|
|
my $smooth = $opt::smooth-1;
|
|
|
|
sub median {
|
|
return ((sort { $a <=> $b } @_)[$#_/2]);
|
|
}
|
|
sub avg {
|
|
my $s=0;
|
|
map { $s += $_ } @_;
|
|
return ($s / ($#_+1));
|
|
}
|
|
|
|
for(my $x = 0; $x < $#tbl-$smooth; $x++) {
|
|
for (my $y = 0; $y <= $#{$tbl[$x]}; $y++) {
|
|
my @med;
|
|
for(my $m = $x; $m < $x+$smooth; $m++) {
|
|
push @med, $tbl[$m][$y];
|
|
}
|
|
$new[$x+$smooth/2][$y] = median(@med);
|
|
}
|
|
}
|
|
@tbl = @new;
|
|
|
|
sub do_average() {
|
|
for(my $x = 0; $x < $smooth; $x++) {
|
|
for (my $y = 0; $y <= $#{$tbl[$x]}; $y++) {
|
|
$sum[$y] += $tbl[$x][$y] / $opt::smooth;
|
|
}
|
|
}
|
|
for(my $x = $smooth; $x <= $#tbl; $x++) {
|
|
for (my $y = 0; $y <= $#{$tbl[$x]}; $y++) {
|
|
$sum[$y] += $tbl[$x][$y] / $opt::smooth;
|
|
$new[$x-$smooth][$y] = $sum[$y];
|
|
$sum[$y] -= $tbl[$x-$smooth][$y] / $opt::smooth;
|
|
}
|
|
}
|
|
@tbl = @new;
|
|
}
|
|
}
|
|
|
|
# Save data to tmpfile that will be read by Gnuplot
|
|
use File::Temp qw(tempfile);
|
|
$ENV{'TMPDIR'} ||= "/tmp";
|
|
my($filehandle,$filename) =
|
|
tempfile(DIR=>$ENV{'TMPDIR'}, TEMPLATE => 'plotXXXXX');
|
|
for(@tbl) {
|
|
print $filehandle (join "\001", @$_)."\n";
|
|
}
|
|
close $filehandle;
|
|
|
|
# Generate the variant part of Gnuplot script
|
|
for(my $col = 2; $col <= $ncols; $col++) {
|
|
my $legend;
|
|
if($opt::header) {
|
|
$legend = qq( title "$header[$col-1]");
|
|
}
|
|
push @legend, qq("$filename" using 1:$col with lines $legend,);
|
|
}
|
|
|
|
# Add --log axis to Gnuplot script
|
|
my @logscale;
|
|
if($opt::log) {
|
|
if($opt::log eq "x") {
|
|
push @logscale, "set logscale x 10;";
|
|
} elsif($opt::log eq "y") {
|
|
push @logscale, "set logscale y 10;";
|
|
} elsif($opt::log eq "xy" or $opt::log eq "yx") {
|
|
push @logscale, "set logscale x 10;";
|
|
push @logscale, "set logscale y 10;";
|
|
} else {
|
|
error("--log $opt::log is not supported. Only x y xy are supported");
|
|
exit(255);
|
|
}
|
|
}
|
|
|
|
# Make full Gnuplot script
|
|
my $plotscript=<<_EOS ;
|
|
set title "@title";
|
|
@logscale
|
|
set xtics rotate;
|
|
set autoscale;
|
|
set xlabel "$header[0]";
|
|
set grid;
|
|
set key right center;
|
|
set datafile separator "\001";
|
|
plot @legend
|
|
_EOS
|
|
|
|
open GNUPLOT,"|-", "gnuplot -p -e ".Q($plotscript) or die;
|
|
close GNUPLOT;
|
|
# print "gnuplot -p -e ".($plotscript);
|
|
unlink $filename;
|