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];
199 barcat - graph to visualize input values
203 B<barcat> [<options>] [<input>]
207 Visualizes relative sizes of values read from input (file(s) or STDIN).
208 Contents are concatenated similar to I<cat>,
209 but numbers are reformatted and a bar graph is appended to each line.
215 =item -c, --[no-]color
217 Force colored output of values and bar markers.
218 Defaults on if output is a tty,
219 disabled otherwise such as when piped or redirected.
221 =item -f, --field=(<number>|<regexp>)
223 Compare values after a given number of whitespace separators,
224 or matching a regular expression.
226 Unspecified or I<-f0> means values are at the start of each line.
227 With I<-f1> the second word is taken instead.
228 A string can indicate the starting position of a value
229 (such as I<-f:> if preceded by colons),
230 or capture the numbers itself,
231 for example I<-f'(\d+)'> for the first digits anywhere.
233 =item -H, --human-readable
235 Format values using SI unit prefixes,
236 turning long numbers like I<12356789> into I<12.4M>.
237 Also changes an exponent I<1.602176634e-19> to I<160.2z>.
238 Short integers are aligned but kept without decimal point.
240 =item -t, --interval[=<seconds>]
242 Interval time to output partial progress.
244 =item -l, --length=[-]<size>[%]
246 Trim line contents (between number and bars)
247 to a maximum number of characters.
248 The exceeding part is replaced by an abbreviation sign,
249 unless C<--length=0>.
251 Prepend a dash (i.e. make negative) to enforce padding
252 regardless of encountered contents.
254 =item -L, --limit=(<count>|<start>-[<end>])
256 Stop output after a number of lines.
257 All input is still counted and analyzed for statistics,
258 but disregarded for padding and bar size.
262 Statistical positions to indicate on bars.
263 Cannot be customized yet,
264 only disabled by providing an empty argument.
266 Any value enables all marker characters:
273 the sum of all values divided by the number of counted lines.
278 the middle value or average between middle values.
282 Standard deviation left of the mean.
283 Only 16% of all values are lower.
287 Standard deviation right of the mean.
288 The part between B<< <--> >> encompass all I<normal> results,
289 or 68% of all entries.
295 Total statistics after all data.
297 =item -u, --unmodified
299 Do not strip leading whitespace.
300 Keep original value alignment, which may be significant in some programs.
302 =item --value-length=<size>
304 Reserved space for numbers.
306 =item -w, --width=<columns>
308 Override the maximum number of columns to use.
309 Appended graphics will extend to fill up the entire screen.
317 seq 30 | awk '{print sin($1/10)}' | barcat
319 Compare file sizes (with human-readable numbers):
321 du -d0 -b * | barcat -H
323 Memory usage of user processes with long names truncated:
325 ps xo %mem,pid,cmd | barcat -l40
327 Monitor network latency from prefixed results:
329 ping google.com | barcat -f'time=\K' -t
331 Commonly used after counting, for example users on the current server:
333 users | sed 's/ /\n/g' | sort | uniq -c | barcat
335 Letter frequencies in text files:
337 cat /usr/share/games/fortunes/*.u8 |
338 perl -CS -nE 'say for grep length, split /\PL*/, uc' |
339 sort | uniq -c | barcat
341 Number of HTTP requests per day:
343 cat log/access.log | cut -d\ -f4 | cut -d: -f1 | uniq -c | barcat
345 Any kind of database query with counts, preserving returned alignment:
347 echo 'SELECT count(*),schemaname FROM pg_tables GROUP BY 2' |
350 External datasets, like movies per year:
352 curl https://github.com/prust/wikipedia-movie-data/raw/master/movies.json |
353 perl -054 -nlE 'say if s/^"year"://' | uniq -c | barcat
355 But please get I<jq> to process JSON
356 and replace the manual selection by C<< jq '.[].year' >>.
358 Pokémon height comparison:
360 curl https://github.com/Biuni/PokemonGO-Pokedex/raw/master/pokedex.json |
361 jq -r '.pokemon[] | [.height,.num,.name] | join(" ")' | barcat
363 USD/EUR exchange rate from CSV provided by the ECB:
365 curl https://sdw.ecb.europa.eu/export.do \
366 -Gd 'node=SEARCHRESULTS&q=EXR.D.USD.EUR.SP00.A&exportType=csv' |
367 grep '^[12]' | barcat -f',\K' --value-length=7
369 Total population history from the World Bank dataset (XML):
370 External datasets, like total population in XML from the World Bank:
372 curl http://api.worldbank.org/v2/country/1W/indicator/SP.POP.TOTL |
373 xmllint --xpath '//*[local-name()="date" or local-name()="value"]' - |
374 sed -r 's,</wb:value>,\n,g; s,(<[^>]+>)+, ,g' | barcat -f1 -H
376 And of course various Git statistics, such commit count by year:
378 git log --pretty=%ci | cut -b-4 | uniq -c | barcat
380 Or the top 3 most frequent authors with statistics over all:
382 git shortlog -sn | barcat -L3 -s
386 Mischa POSLAWSKY <perl@shiar.org>