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