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",
51 $opt{spark} = [split //, $_[1] || '⎽▁▂▃▄▅▆▇█'];
56 'usage|h' => sub { podexit() },
57 'help' => sub { podexit(-verbose => 2) },
58 ) or exit 64; # EX_USAGE
60 $opt{width} ||= $ENV{COLUMNS} || 80;
61 $opt{color} //= -t *STDOUT; # enable on tty
62 $opt{trim} *= $opt{width} / 100 if $opt{trimpct};
63 $opt{units} = [split //, ' kMGTPEZYyzafpnμm'] if $opt{'human-readable'};
64 $opt{anchor} //= qr/\A/;
65 $opt{'value-length'} = 6 if $opt{units};
67 my (@lines, @values, @order);
69 if (defined $opt{interval}) {
78 require Tie::Array::Sorted;
79 tie @order, 'Tie::Array::Sorted', sub { $_[1] <=> $_[0] };
80 } or warn $@, "Expect slowdown with large datasets!\n";
84 $SIG{INT} = 'DEFAULT'; # reset for subsequent attempts
85 'IGNORE' # continue after assumed eof
88 my $valmatch = qr/$opt{anchor} ( \h* -? [0-9]* \.? [0-9]+ (?: e[+-]?[0-9]+ )? |)/x;
91 s/^\h*// unless $opt{unmodified};
92 push @values, s/$valmatch/\n/ && $1;
93 push @order, $1 if length $1;
94 if (defined $opt{trim} and defined $1) {
95 my $trimpos = abs $opt{trim};
99 elsif (length > $trimpos) {
100 substr($_, $trimpos - 1) = '…';
106 $SIG{INT} = 'DEFAULT';
109 $opt{color} and defined $_[0] or return '';
110 return "\e[$_[0]m" if defined wantarray;
111 $_ = color(@_) . $_ . color(0) if defined;
116 state $nr = $opt{hidemin} ? $opt{hidemin} - 1 : 0;
117 @lines and @lines > $nr or return;
119 @lines > $nr or return unless $opt{hidemin};
121 @order = sort { $b <=> $a } @order unless tied @order;
122 my $maxval = ($opt{hidemax} ? max grep { length } @values[0 .. $opt{hidemax} - 1] : $order[0]) // 0;
123 my $minval = min $order[-1] // (), 0;
124 my $lenval = $opt{'value-length'} // max map { length } @order;
125 my $len = defined $opt{trim} && $opt{trim} <= 0 ? -$opt{trim} + 1 :
126 max map { length $values[$_] && length $lines[$_] }
127 0 .. min $#lines, $opt{hidemax} || (); # left padding
128 my $size = ($maxval - $minval) &&
129 ($opt{width} - $lenval - $len) / ($maxval - $minval); # bar multiplication
132 if ($opt{markers} // 1 and $size > 0) {
133 my sub orderpos { (($order[$_[0]] + $order[$_[0] + .5]) / 2 - $minval) * $size }
134 $barmark[ (sum(@order) / @order - $minval) * $size ] = '='; # average
135 $barmark[ orderpos($#order * .31731) ] = '>';
136 $barmark[ orderpos($#order * .68269) ] = '<';
137 $barmark[ orderpos($#order / 2) ] = '+'; # mean
138 $barmark[ -$minval * $size ] = '|' if $minval < 0; # zero
139 color(36) for @barmark;
141 state $lastmax = $maxval;
142 if ($maxval > $lastmax) {
143 print ' ' x ($lenval + $len);
146 ($lastmax - $minval) * $size + .5,
147 '-' x (($values[$nr - 1] - $minval) * $size);
149 say '+' x (($maxval - $lastmax - $minval) * $size + .5);
155 @lines > $nr or return if $opt{hidemin};
158 my $unit = int(log(abs $_[0] || 1) / log(10) - 3*($_[0] < 1) + 1e-15);
159 my $float = $_[0] !~ /^0*[-0-9]{1,3}$/;
161 $float && ($unit % 3) == ($unit < 0), # tenths
162 $_[0] / 1000 ** int($unit/3), # number
163 $#{$opt{units}} * 1.5 < abs $unit ? "e$unit" : $opt{units}->[$unit/3]
167 while ($nr <= $#lines) {
168 $nr >= $opt{hidemax} and last if defined $opt{hidemax};
169 my $val = $values[$nr];
172 print $opt{spark}->[ ($val - $minval) / $maxval * $#{$opt{spark}} ];
177 my $color = !$opt{color} ? undef :
178 $val == $order[0] ? 32 : # max
179 $val == $order[-1] ? 31 : # min
181 $val = $opt{units} ? sival($val) : sprintf "%*s", $lenval, $val;
182 color($color) for $val;
184 my $line = $lines[$nr] =~ s/\n/$val/r;
185 printf '%-*s', $len + length($val), $line;
186 print $barmark[$_] // '-' for 1 .. $size && (($values[$nr] || 0) - $minval) * $size + .5;
192 say '' if $opt{spark};
198 if ($opt{hidemin} or $opt{hidemax}) {
200 $opt{hidemax} ||= @lines;
201 printf '%s of ', sum(@values[$opt{hidemin} - 1 .. $opt{hidemax} - 1]) // 0;
204 my $total = sum @order;
205 printf '%s total', $total;
206 printf ' in %d values', scalar @values;
207 printf ' (%s min, %*.*f avg, %s max)',
208 $order[-1], 0, 2, $total / @order, $order[0];
218 barcat - graph to visualize input values
222 B<barcat> [<options>] [<input>]
226 Visualizes relative sizes of values read from input (file(s) or STDIN).
227 Contents are concatenated similar to I<cat>,
228 but numbers are reformatted and a bar graph is appended to each line.
234 =item -c, --[no-]color
236 Force colored output of values and bar markers.
237 Defaults on if output is a tty,
238 disabled otherwise such as when piped or redirected.
240 =item -f, --field=(<number>|<regexp>)
242 Compare values after a given number of whitespace separators,
243 or matching a regular expression.
245 Unspecified or I<-f0> means values are at the start of each line.
246 With I<-f1> the second word is taken instead.
247 A string can indicate the starting position of a value
248 (such as I<-f:> if preceded by colons),
249 or capture the numbers itself,
250 for example I<-f'(\d+)'> for the first digits anywhere.
252 =item -H, --human-readable
254 Format values using SI unit prefixes,
255 turning long numbers like I<12356789> into I<12.4M>.
256 Also changes an exponent I<1.602176634e-19> to I<160.2z>.
257 Short integers are aligned but kept without decimal point.
259 =item -t, --interval[=<seconds>]
261 Interval time to output partial progress.
263 =item -l, --length=[-]<size>[%]
265 Trim line contents (between number and bars)
266 to a maximum number of characters.
267 The exceeding part is replaced by an abbreviation sign,
268 unless C<--length=0>.
270 Prepend a dash (i.e. make negative) to enforce padding
271 regardless of encountered contents.
273 =item -L, --limit=(<count>|<start>-[<end>])
275 Stop output after a number of lines.
276 All input is still counted and analyzed for statistics,
277 but disregarded for padding and bar size.
281 Statistical positions to indicate on bars.
282 Cannot be customized yet,
283 only disabled by providing an empty argument.
285 Any value enables all marker characters:
292 the sum of all values divided by the number of counted lines.
297 the middle value or average between middle values.
301 Standard deviation left of the mean.
302 Only 16% of all values are lower.
306 Standard deviation right of the mean.
307 The part between B<< <--> >> encompass all I<normal> results,
308 or 68% of all entries.
314 Total statistics after all data.
316 =item -u, --unmodified
318 Do not strip leading whitespace.
319 Keep original value alignment, which may be significant in some programs.
321 =item --value-length=<size>
323 Reserved space for numbers.
325 =item -w, --width=<columns>
327 Override the maximum number of columns to use.
328 Appended graphics will extend to fill up the entire screen.
336 seq 30 | awk '{print sin($1/10)}' | barcat
338 Compare file sizes (with human-readable numbers):
340 du -d0 -b * | barcat -H
342 Memory usage of user processes with long names truncated:
344 ps xo %mem,pid,cmd | barcat -l40
346 Monitor network latency from prefixed results:
348 ping google.com | barcat -f'time=\K' -t
350 Commonly used after counting, for example users on the current server:
352 users | sed 's/ /\n/g' | sort | uniq -c | barcat
354 Letter frequencies in text files:
356 cat /usr/share/games/fortunes/*.u8 |
357 perl -CS -nE 'say for grep length, split /\PL*/, uc' |
358 sort | uniq -c | barcat
360 Number of HTTP requests per day:
362 cat log/access.log | cut -d\ -f4 | cut -d: -f1 | uniq -c | barcat
364 Any kind of database query with counts, preserving returned alignment:
366 echo 'SELECT count(*),schemaname FROM pg_tables GROUP BY 2' |
369 Earthquakes worldwide magnitude 1+ in the last 24 hours:
371 https://earthquake.usgs.gov/earthquakes/feed/v1.0/summary/1.0_day.csv |
372 column -tns, | graph -f4 -u -l80%
374 External datasets, like movies per year:
376 curl https://github.com/prust/wikipedia-movie-data/raw/master/movies.json |
377 perl -054 -nlE 'say if s/^"year"://' | uniq -c | barcat
379 But please get I<jq> to process JSON
380 and replace the manual selection by C<< jq '.[].year' >>.
382 Pokémon height comparison:
384 curl https://github.com/Biuni/PokemonGO-Pokedex/raw/master/pokedex.json |
385 jq -r '.pokemon[] | [.height,.num,.name] | join(" ")' | barcat
387 USD/EUR exchange rate from CSV provided by the ECB:
389 curl https://sdw.ecb.europa.eu/export.do \
390 -Gd 'node=SEARCHRESULTS&q=EXR.D.USD.EUR.SP00.A&exportType=csv' |
391 grep '^[12]' | barcat -f',\K' --value-length=7
393 Total population history from the World Bank dataset (XML):
394 External datasets, like total population in XML from the World Bank:
396 curl http://api.worldbank.org/v2/country/1W/indicator/SP.POP.TOTL |
397 xmllint --xpath '//*[local-name()="date" or local-name()="value"]' - |
398 sed -r 's,</wb:value>,\n,g; s,(<[^>]+>)+, ,g' | barcat -f1 -H
400 And of course various Git statistics, such commit count by year:
402 git log --pretty=%ci | cut -b-4 | uniq -c | barcat
404 Or the top 3 most frequent authors with statistics over all:
406 git shortlog -sn | barcat -L3 -s
408 Activity of the last days (substitute date C<-v-{}d> on BSD):
410 ( git log --pretty=%ci --since=30day | cut -b-10
411 seq 0 30 | xargs -i date +%F -d-{}day ) |
412 sort | uniq -c | awk '$1--' | graph --spark
416 Mischa POSLAWSKY <perl@shiar.org>