5 use List::Util qw( min max sum );
6 use open qw( :std :utf8 );
7 use experimental qw( lexical_subs );
11 use Getopt::Long '2.33', qw( :config gnu_getopt );
14 Pod::Usage::pod2usage(-exitval => 0, -perldocopt => '-oman', @_);
19 'C' => sub { $opt{color} = 0 },
23 $opt{anchor} = /^[0-9]+$/ ? qr/(?:\S*\h+){$_}\K/ : qr/$_/;
24 } or die $@ =~ s/(?: at .+)?$/ for option $_[0]/r;
28 'trim|length|l=s' => sub {
29 my ($optname, $optval) = @_;
30 $optval =~ s/%$// and $opt{trimpct}++;
31 $optval =~ m/^-?[0-9]+$/ or die(
32 "Value \"$optval\" invalid for option $optname",
33 " (number or percentage expected)\n"
41 my ($optname, $optval) = @_;
43 ($opt{hidemin}, $opt{hidemax}) =
44 $optval =~ m/\A (?: ([0-9]+)? - )? ([0-9]+)? \z/x or die(
45 "Value \"$optval\" invalid for option limit",
53 'usage|h' => sub { podexit() },
54 'help' => sub { podexit(-verbose => 2) },
55 ) or exit 64; # EX_USAGE
57 $opt{width} ||= $ENV{COLUMNS} || 80;
58 $opt{color} //= -t *STDOUT; # enable on tty
59 $opt{trim} *= $opt{width} / 100 if $opt{trimpct};
60 $opt{units} = [split //, ' kMGTPEZYyzafpnμm'] if $opt{'human-readable'};
61 $opt{anchor} //= qr/\A/;
62 $opt{'value-length'} = 6 if $opt{units};
64 my (@lines, @values, @order);
66 if (defined $opt{interval}) {
75 require Tie::Array::Sorted;
76 tie @order, 'Tie::Array::Sorted', sub { $_[1] <=> $_[0] };
77 } or warn $@, "Expect slowdown with large datasets!\n";
80 $SIG{INT} = 'IGNORE'; # continue after assumed eof
82 my $valmatch = qr/$opt{anchor} ( \h* -? [0-9]* \.? [0-9]+ (?: e[+-]?[0-9]+ )? |)/x;
85 s/^\h*// unless $opt{unmodified};
86 push @values, s/$valmatch/\n/ && $1;
87 push @order, $1 if length $1;
88 if (defined $opt{trim} and defined $1) {
89 my $trimpos = abs $opt{trim};
93 elsif (length > $trimpos) {
94 substr($_, $trimpos - 1) = '…';
100 $SIG{INT} = 'DEFAULT';
103 $opt{color} or return '';
109 state $nr = $opt{hidemin} ? $opt{hidemin} - 1 : 0;
110 @lines and @lines > $nr or return;
112 @lines > $nr or return unless $opt{hidemin};
114 @order = sort { $b <=> $a } @order unless tied @order;
115 my $maxval = ($opt{hidemax} ? max grep { length } @values[0 .. $opt{hidemax} - 1] : $order[0]) // 0;
116 my $minval = min $order[-1] // (), 0;
117 my $lenval = $opt{'value-length'} // max map { length } @order;
118 my $len = defined $opt{trim} && $opt{trim} <= 0 ? -$opt{trim} + 1 :
119 max map { length $values[$_] && length $lines[$_] }
120 0 .. min $#lines, $opt{hidemax} || (); # left padding
121 my $size = ($maxval - $minval) &&
122 ($opt{width} - $lenval - $len) / ($maxval - $minval); # bar multiplication
125 if ($opt{markers} // 1 and $size > 0) {
126 my sub orderpos { (($order[$_[0]] + $order[$_[0] + .5]) / 2 - $minval) * $size }
127 $barmark[ (sum(@order) / @order - $minval) * $size ] = '='; # average
128 $barmark[ orderpos($#order * .31731) ] = '>';
129 $barmark[ orderpos($#order * .68269) ] = '<';
130 $barmark[ orderpos($#order / 2) ] = '+'; # mean
131 $barmark[ -$minval * $size ] = '|' if $minval < 0; # zero
132 defined and $_ = color(36).$_.color(0) for @barmark;
134 state $lastmax = $maxval;
135 if ($maxval > $lastmax) {
136 print ' ' x ($lenval + $len);
139 ($lastmax - $minval) * $size + .5,
140 '-' x (($values[$nr - 1] - $minval) * $size);
142 say '+' x (($maxval - $lastmax - $minval) * $size + .5);
148 @lines > $nr or return if $opt{hidemin};
151 my $unit = int(log(abs $_[0] || 1) / log(10) - 3*($_[0] < 1) + 1e-15);
152 my $float = $_[0] !~ /^0*[-0-9]{1,3}$/;
154 $float && ($unit % 3) == ($unit < 0), # tenths
155 $_[0] / 1000 ** int($unit/3), # number
156 $#{$opt{units}} * 1.5 < abs $unit ? "e$unit" : $opt{units}->[$unit/3]
160 while ($nr <= $#lines) {
161 $nr >= $opt{hidemax} and last if defined $opt{hidemax};
162 my $val = $values[$nr];
164 my $color = !$opt{color} ? 0 :
165 $val == $order[0] ? 32 : # max
166 $val == $order[-1] ? 31 : # min
168 $val = $opt{units} ? sival($val) : sprintf "%*s", $lenval, $val;
169 $val = color($color).$val.color(0) if $color;
171 my $line = $lines[$nr] =~ s/\n/$val/r;
172 printf '%-*s', $len + length($val), $line;
173 print $barmark[$_] // '-' for 1 .. $size && (($values[$nr] || 0) - $minval) * $size + .5;
183 if ($opt{hidemin} or $opt{hidemax}) {
185 $opt{hidemax} ||= @lines;
186 printf '%s of ', sum(@values[$opt{hidemin} - 1 .. $opt{hidemax} - 1]) // 0;
189 my $total = sum @order;
190 printf '%s total', $total;
191 printf ' in %d values', scalar @values;
192 printf ' (%s min, %*.*f avg, %s max)',
193 $order[-1], 0, 2, $total / @order, $order[0];
203 barcat - graph to visualize input values
207 B<barcat> [<options>] [<input>]
211 Visualizes relative sizes of values read from input (file(s) or STDIN).
212 Contents are concatenated similar to I<cat>,
213 but numbers are reformatted and a bar graph is appended to each line.
219 =item -c, --[no-]color
221 Force colored output of values and bar markers.
222 Defaults on if output is a tty,
223 disabled otherwise such as when piped or redirected.
225 =item -f, --field=(<number>|<regexp>)
227 Compare values after a given number of whitespace separators,
228 or matching a regular expression.
230 Unspecified or I<-f0> means values are at the start of each line.
231 With I<-f1> the second word is taken instead.
232 A string can indicate the starting position of a value
233 (such as I<-f:> if preceded by colons),
234 or capture the numbers itself,
235 for example I<-f'(\d+)'> for the first digits anywhere.
237 =item -H, --human-readable
239 Format values using SI unit prefixes,
240 turning long numbers like I<12356789> into I<12.4M>.
241 Also changes an exponent I<1.602176634e-19> to I<160.2z>.
242 Short integers are aligned but kept without decimal point.
244 =item -t, --interval[=<seconds>]
246 Interval time to output partial progress.
248 =item -l, --length=[-]<size>[%]
250 Trim line contents (between number and bars)
251 to a maximum number of characters.
252 The exceeding part is replaced by an abbreviation sign,
253 unless C<--length=0>.
255 Prepend a dash (i.e. make negative) to enforce padding
256 regardless of encountered contents.
258 =item -L, --limit=(<count>|<start>-[<end>])
260 Stop output after a number of lines.
261 All input is still counted and analyzed for statistics,
262 but disregarded for padding and bar size.
266 Statistical positions to indicate on bars.
267 Cannot be customized yet,
268 only disabled by providing an empty argument.
270 Any value enables all marker characters:
277 the sum of all values divided by the number of counted lines.
282 the middle value or average between middle values.
286 Standard deviation left of the mean.
287 Only 16% of all values are lower.
291 Standard deviation right of the mean.
292 The part between B<< <--> >> encompass all I<normal> results,
293 or 68% of all entries.
299 Total statistics after all data.
301 =item -u, --unmodified
303 Do not strip leading whitespace.
304 Keep original value alignment, which may be significant in some programs.
306 =item --value-length=<size>
308 Reserved space for numbers.
310 =item -w, --width=<columns>
312 Override the maximum number of columns to use.
313 Appended graphics will extend to fill up the entire screen.
321 seq 30 | awk '{print sin($1/10)}' | barcat
323 Compare file sizes (with human-readable numbers):
325 du -d0 -b * | barcat -H
327 Memory usage of user processes with long names truncated:
329 ps xo %mem,pid,cmd | barcat -l40
331 Monitor network latency from prefixed results:
333 ping google.com | barcat -f'time=\K' -t
335 Commonly used after counting, for example users on the current server:
337 users | sed 's/ /\n/g' | sort | uniq -c | barcat
339 Letter frequencies in text files:
341 cat /usr/share/games/fortunes/*.u8 |
342 perl -CS -nE 'say for grep length, split /\PL*/, uc' |
343 sort | uniq -c | barcat
345 Number of HTTP requests per day:
347 cat log/access.log | cut -d\ -f4 | cut -d: -f1 | uniq -c | barcat
349 Any kind of database query with counts, preserving returned alignment:
351 echo 'SELECT count(*),schemaname FROM pg_tables GROUP BY 2' |
354 External datasets, like movies per year:
356 curl https://github.com/prust/wikipedia-movie-data/raw/master/movies.json |
357 perl -054 -nlE 'say if s/^"year"://' | uniq -c | barcat
359 But please get I<jq> to process JSON
360 and replace the manual selection by C<< jq '.[].year' >>.
362 Pokémon height comparison:
364 curl https://github.com/Biuni/PokemonGO-Pokedex/raw/master/pokedex.json |
365 jq -r '.pokemon[] | [.height,.num,.name] | join(" ")' | barcat
367 USD/EUR exchange rate from CSV provided by the ECB:
369 curl https://sdw.ecb.europa.eu/export.do \
370 -Gd 'node=SEARCHRESULTS&q=EXR.D.USD.EUR.SP00.A&exportType=csv' |
371 grep '^[12]' | barcat -f',\K' --value-length=7
373 Total population history from the World Bank dataset (XML):
374 External datasets, like total population in XML from the World Bank:
376 curl http://api.worldbank.org/v2/country/1W/indicator/SP.POP.TOTL |
377 xmllint --xpath '//*[local-name()="date" or local-name()="value"]' - |
378 sed -r 's,</wb:value>,\n,g; s,(<[^>]+>)+, ,g' | barcat -f1 -H
380 And of course various Git statistics, such commit count by year:
382 git log --pretty=%ci | cut -b-4 | uniq -c | barcat
384 Or the top 3 most frequent authors with statistics over all:
386 git shortlog -sn | barcat -L3 -s
390 Mischa POSLAWSKY <perl@shiar.org>