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