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} and defined $_[0] or return '';
104 return "\e[$_[0]m" if defined wantarray;
105 $_ = color(@_) . $_ . color(0) if defined;
110 state $nr = $opt{hidemin} ? $opt{hidemin} - 1 : 0;
111 @lines and @lines > $nr or return;
113 @lines > $nr or return unless $opt{hidemin};
115 @order = sort { $b <=> $a } @order unless tied @order;
116 my $maxval = ($opt{hidemax} ? max grep { length } @values[0 .. $opt{hidemax} - 1] : $order[0]) // 0;
117 my $minval = min $order[-1] // (), 0;
118 my $lenval = $opt{'value-length'} // max map { length } @order;
119 my $len = defined $opt{trim} && $opt{trim} <= 0 ? -$opt{trim} + 1 :
120 max map { length $values[$_] && length $lines[$_] }
121 0 .. min $#lines, $opt{hidemax} || (); # left padding
122 my $size = ($maxval - $minval) &&
123 ($opt{width} - $lenval - $len) / ($maxval - $minval); # bar multiplication
126 if ($opt{markers} // 1 and $size > 0) {
127 my sub orderpos { (($order[$_[0]] + $order[$_[0] + .5]) / 2 - $minval) * $size }
128 $barmark[ (sum(@order) / @order - $minval) * $size ] = '='; # average
129 $barmark[ orderpos($#order * .31731) ] = '>';
130 $barmark[ orderpos($#order * .68269) ] = '<';
131 $barmark[ orderpos($#order / 2) ] = '+'; # mean
132 $barmark[ -$minval * $size ] = '|' if $minval < 0; # zero
133 color(36) for @barmark;
135 state $lastmax = $maxval;
136 if ($maxval > $lastmax) {
137 print ' ' x ($lenval + $len);
140 ($lastmax - $minval) * $size + .5,
141 '-' x (($values[$nr - 1] - $minval) * $size);
143 say '+' x (($maxval - $lastmax - $minval) * $size + .5);
149 @lines > $nr or return if $opt{hidemin};
152 my $unit = int(log(abs $_[0] || 1) / log(10) - 3*($_[0] < 1) + 1e-15);
153 my $float = $_[0] !~ /^0*[-0-9]{1,3}$/;
155 $float && ($unit % 3) == ($unit < 0), # tenths
156 $_[0] / 1000 ** int($unit/3), # number
157 $#{$opt{units}} * 1.5 < abs $unit ? "e$unit" : $opt{units}->[$unit/3]
161 while ($nr <= $#lines) {
162 $nr >= $opt{hidemax} and last if defined $opt{hidemax};
163 my $val = $values[$nr];
165 my $color = !$opt{color} ? undef :
166 $val == $order[0] ? 32 : # max
167 $val == $order[-1] ? 31 : # min
169 $val = $opt{units} ? sival($val) : sprintf "%*s", $lenval, $val;
170 color($color) for $val;
172 my $line = $lines[$nr] =~ s/\n/$val/r;
173 printf '%-*s', $len + length($val), $line;
174 print $barmark[$_] // '-' for 1 .. $size && (($values[$nr] || 0) - $minval) * $size + .5;
184 if ($opt{hidemin} or $opt{hidemax}) {
186 $opt{hidemax} ||= @lines;
187 printf '%s of ', sum(@values[$opt{hidemin} - 1 .. $opt{hidemax} - 1]) // 0;
190 my $total = sum @order;
191 printf '%s total', $total;
192 printf ' in %d values', scalar @values;
193 printf ' (%s min, %*.*f avg, %s max)',
194 $order[-1], 0, 2, $total / @order, $order[0];
204 barcat - graph to visualize input values
208 B<barcat> [<options>] [<input>]
212 Visualizes relative sizes of values read from input (file(s) or STDIN).
213 Contents are concatenated similar to I<cat>,
214 but numbers are reformatted and a bar graph is appended to each line.
220 =item -c, --[no-]color
222 Force colored output of values and bar markers.
223 Defaults on if output is a tty,
224 disabled otherwise such as when piped or redirected.
226 =item -f, --field=(<number>|<regexp>)
228 Compare values after a given number of whitespace separators,
229 or matching a regular expression.
231 Unspecified or I<-f0> means values are at the start of each line.
232 With I<-f1> the second word is taken instead.
233 A string can indicate the starting position of a value
234 (such as I<-f:> if preceded by colons),
235 or capture the numbers itself,
236 for example I<-f'(\d+)'> for the first digits anywhere.
238 =item -H, --human-readable
240 Format values using SI unit prefixes,
241 turning long numbers like I<12356789> into I<12.4M>.
242 Also changes an exponent I<1.602176634e-19> to I<160.2z>.
243 Short integers are aligned but kept without decimal point.
245 =item -t, --interval[=<seconds>]
247 Interval time to output partial progress.
249 =item -l, --length=[-]<size>[%]
251 Trim line contents (between number and bars)
252 to a maximum number of characters.
253 The exceeding part is replaced by an abbreviation sign,
254 unless C<--length=0>.
256 Prepend a dash (i.e. make negative) to enforce padding
257 regardless of encountered contents.
259 =item -L, --limit=(<count>|<start>-[<end>])
261 Stop output after a number of lines.
262 All input is still counted and analyzed for statistics,
263 but disregarded for padding and bar size.
267 Statistical positions to indicate on bars.
268 Cannot be customized yet,
269 only disabled by providing an empty argument.
271 Any value enables all marker characters:
278 the sum of all values divided by the number of counted lines.
283 the middle value or average between middle values.
287 Standard deviation left of the mean.
288 Only 16% of all values are lower.
292 Standard deviation right of the mean.
293 The part between B<< <--> >> encompass all I<normal> results,
294 or 68% of all entries.
300 Total statistics after all data.
302 =item -u, --unmodified
304 Do not strip leading whitespace.
305 Keep original value alignment, which may be significant in some programs.
307 =item --value-length=<size>
309 Reserved space for numbers.
311 =item -w, --width=<columns>
313 Override the maximum number of columns to use.
314 Appended graphics will extend to fill up the entire screen.
322 seq 30 | awk '{print sin($1/10)}' | barcat
324 Compare file sizes (with human-readable numbers):
326 du -d0 -b * | barcat -H
328 Memory usage of user processes with long names truncated:
330 ps xo %mem,pid,cmd | barcat -l40
332 Monitor network latency from prefixed results:
334 ping google.com | barcat -f'time=\K' -t
336 Commonly used after counting, for example users on the current server:
338 users | sed 's/ /\n/g' | sort | uniq -c | barcat
340 Letter frequencies in text files:
342 cat /usr/share/games/fortunes/*.u8 |
343 perl -CS -nE 'say for grep length, split /\PL*/, uc' |
344 sort | uniq -c | barcat
346 Number of HTTP requests per day:
348 cat log/access.log | cut -d\ -f4 | cut -d: -f1 | uniq -c | barcat
350 Any kind of database query with counts, preserving returned alignment:
352 echo 'SELECT count(*),schemaname FROM pg_tables GROUP BY 2' |
355 External datasets, like movies per year:
357 curl https://github.com/prust/wikipedia-movie-data/raw/master/movies.json |
358 perl -054 -nlE 'say if s/^"year"://' | uniq -c | barcat
360 But please get I<jq> to process JSON
361 and replace the manual selection by C<< jq '.[].year' >>.
363 Pokémon height comparison:
365 curl https://github.com/Biuni/PokemonGO-Pokedex/raw/master/pokedex.json |
366 jq -r '.pokemon[] | [.height,.num,.name] | join(" ")' | barcat
368 USD/EUR exchange rate from CSV provided by the ECB:
370 curl https://sdw.ecb.europa.eu/export.do \
371 -Gd 'node=SEARCHRESULTS&q=EXR.D.USD.EUR.SP00.A&exportType=csv' |
372 grep '^[12]' | barcat -f',\K' --value-length=7
374 Total population history from the World Bank dataset (XML):
375 External datasets, like total population in XML from the World Bank:
377 curl http://api.worldbank.org/v2/country/1W/indicator/SP.POP.TOTL |
378 xmllint --xpath '//*[local-name()="date" or local-name()="value"]' - |
379 sed -r 's,</wb:value>,\n,g; s,(<[^>]+>)+, ,g' | barcat -f1 -H
381 And of course various Git statistics, such commit count by year:
383 git log --pretty=%ci | cut -b-4 | uniq -c | barcat
385 Or the top 3 most frequent authors with statistics over all:
387 git shortlog -sn | barcat -L3 -s
391 Mischa POSLAWSKY <perl@shiar.org>