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};
66 $opt{'value-length'} = 1 if $opt{unmodified};
68 my (@lines, @values, @order);
70 if (defined $opt{interval}) {
79 require Tie::Array::Sorted;
80 tie @order, 'Tie::Array::Sorted', sub { $_[1] <=> $_[0] };
81 } or warn $@, "Expect slowdown with large datasets!\n";
85 $SIG{INT} = 'DEFAULT'; # reset for subsequent attempts
86 'IGNORE' # continue after assumed eof
89 my $valmatch = qr/$opt{anchor} ( \h* -? [0-9]* \.? [0-9]+ (?: e[+-]?[0-9]+ )? |)/x;
92 s/^\h*// unless $opt{unmodified};
93 push @values, s/$valmatch/\n/ && $1;
94 push @order, $1 if length $1;
95 if (defined $opt{trim} and defined $1) {
96 my $trimpos = abs $opt{trim};
97 $trimpos -= length $1 if $opt{unmodified};
101 elsif (length > $trimpos) {
102 substr($_, $trimpos - 1) = '…';
108 $SIG{INT} = 'DEFAULT';
111 $opt{color} and defined $_[0] or return '';
112 return "\e[$_[0]m" if defined wantarray;
113 $_ = color(@_) . $_ . color(0) if defined;
118 state $nr = $opt{hidemin} ? $opt{hidemin} - 1 : 0;
119 @lines and @lines > $nr or return;
121 @lines > $nr or return unless $opt{hidemin};
123 @order = sort { $b <=> $a } @order unless tied @order;
124 my $maxval = ($opt{hidemax} ? max grep { length } @values[0 .. $opt{hidemax} - 1] : $order[0]) // 0;
125 my $minval = min $order[-1] // (), 0;
126 my $lenval = $opt{'value-length'} // max map { length } @order;
127 my $len = defined $opt{trim} && $opt{trim} <= 0 ? -$opt{trim} + 1 :
128 max map { length $values[$_] && length $lines[$_] }
129 0 .. min $#lines, $opt{hidemax} || (); # left padding
130 my $size = ($maxval - $minval) &&
131 ($opt{width} - $lenval - $len) / ($maxval - $minval); # bar multiplication
134 if ($opt{markers} // 1 and $size > 0) {
135 my sub orderpos { (($order[$_[0]] + $order[$_[0] + .5]) / 2 - $minval) * $size }
136 $barmark[ (sum(@order) / @order - $minval) * $size ] = '='; # average
137 $barmark[ orderpos($#order * .31731) ] = '>';
138 $barmark[ orderpos($#order * .68269) ] = '<';
139 $barmark[ orderpos($#order / 2) ] = '+'; # mean
140 $barmark[ -$minval * $size ] = '|' if $minval < 0; # zero
141 color(36) for @barmark;
143 state $lastmax = $maxval;
144 if ($maxval > $lastmax) {
145 print ' ' x ($lenval + $len);
148 ($lastmax - $minval) * $size + .5,
149 '-' x (($values[$nr - 1] - $minval) * $size);
151 say '+' x (($maxval - $lastmax - $minval) * $size + .5);
157 @lines > $nr or return if $opt{hidemin};
160 my $unit = int(log(abs $_[0] || 1) / log(10) - 3*($_[0] < 1) + 1e-15);
161 my $float = $_[0] !~ /^0*[-0-9]{1,3}$/;
163 $float && ($unit % 3) == ($unit < 0), # tenths
164 $_[0] / 1000 ** int($unit/3), # number
165 $#{$opt{units}} * 1.5 < abs $unit ? "e$unit" : $opt{units}->[$unit/3]
169 while ($nr <= $#lines) {
170 $nr >= $opt{hidemax} and last if defined $opt{hidemax};
171 my $val = $values[$nr];
174 print $opt{spark}->[ ($val - $minval) / $maxval * $#{$opt{spark}} ];
179 my $color = !$opt{color} ? undef :
180 $val == $order[0] ? 32 : # max
181 $val == $order[-1] ? 31 : # min
183 $val = $opt{units} ? sival($val) : sprintf "%*s", $lenval, $val;
184 color($color) for $val;
186 my $line = $lines[$nr] =~ s/\n/$val/r;
187 printf '%-*s', $len + length($val), $line;
188 print $barmark[$_] // '-' for 1 .. $size && (($values[$nr] || 0) - $minval) * $size + .5;
194 say '' if $opt{spark};
200 if ($opt{hidemin} or $opt{hidemax}) {
202 $opt{hidemax} ||= @lines;
203 printf '%s of ', sum(@values[$opt{hidemin} - 1 .. $opt{hidemax} - 1]) // 0;
206 my $total = sum @order;
207 printf '%s total', $total;
208 printf ' in %d values', scalar @values;
209 printf ' (%s min, %*.*f avg, %s max)',
210 $order[-1], 0, 2, $total / @order, $order[0];
220 barcat - graph to visualize input values
224 B<barcat> [<options>] [<input>]
228 Visualizes relative sizes of values read from input (file(s) or STDIN).
229 Contents are concatenated similar to I<cat>,
230 but numbers are reformatted and a bar graph is appended to each line.
236 =item -c, --[no-]color
238 Force colored output of values and bar markers.
239 Defaults on if output is a tty,
240 disabled otherwise such as when piped or redirected.
242 =item -f, --field=(<number>|<regexp>)
244 Compare values after a given number of whitespace separators,
245 or matching a regular expression.
247 Unspecified or I<-f0> means values are at the start of each line.
248 With I<-f1> the second word is taken instead.
249 A string can indicate the starting position of a value
250 (such as I<-f:> if preceded by colons),
251 or capture the numbers itself,
252 for example I<-f'(\d+)'> for the first digits anywhere.
254 =item -H, --human-readable
256 Format values using SI unit prefixes,
257 turning long numbers like I<12356789> into I<12.4M>.
258 Also changes an exponent I<1.602176634e-19> to I<160.2z>.
259 Short integers are aligned but kept without decimal point.
261 =item -t, --interval[=<seconds>]
263 Interval time to output partial progress.
265 =item -l, --length=[-]<size>[%]
267 Trim line contents (between number and bars)
268 to a maximum number of characters.
269 The exceeding part is replaced by an abbreviation sign,
270 unless C<--length=0>.
272 Prepend a dash (i.e. make negative) to enforce padding
273 regardless of encountered contents.
275 =item -L, --limit=(<count>|<start>-[<end>])
277 Stop output after a number of lines.
278 All input is still counted and analyzed for statistics,
279 but disregarded for padding and bar size.
283 Statistical positions to indicate on bars.
284 Cannot be customized yet,
285 only disabled by providing an empty argument.
287 Any value enables all marker characters:
294 the sum of all values divided by the number of counted lines.
299 the middle value or average between middle values.
303 Standard deviation left of the mean.
304 Only 16% of all values are lower.
308 Standard deviation right of the mean.
309 The part between B<< <--> >> encompass all I<normal> results,
310 or 68% of all entries.
316 Total statistics after all data.
318 =item -u, --unmodified
320 Do not reformat values, keeping leading whitespace.
321 Keep original value alignment, which may be significant in some programs.
323 =item --value-length=<size>
325 Reserved space for numbers.
327 =item -w, --width=<columns>
329 Override the maximum number of columns to use.
330 Appended graphics will extend to fill up the entire screen.
338 seq 30 | awk '{print sin($1/10)}' | barcat
340 Compare file sizes (with human-readable numbers):
342 du -d0 -b * | barcat -H
344 Memory usage of user processes with long names truncated:
346 ps xo %mem,pid,cmd | barcat -l40
348 Monitor network latency from prefixed results:
350 ping google.com | barcat -f'time=\K' -t
352 Commonly used after counting, for example users on the current server:
354 users | sed 's/ /\n/g' | sort | uniq -c | barcat
356 Letter frequencies in text files:
358 cat /usr/share/games/fortunes/*.u8 |
359 perl -CS -nE 'say for grep length, split /\PL*/, uc' |
360 sort | uniq -c | barcat
362 Number of HTTP requests per day:
364 cat log/access.log | cut -d\ -f4 | cut -d: -f1 | uniq -c | barcat
366 Any kind of database query with counts, preserving returned alignment:
368 echo 'SELECT count(*),schemaname FROM pg_tables GROUP BY 2' |
371 Earthquakes worldwide magnitude 1+ in the last 24 hours:
373 https://earthquake.usgs.gov/earthquakes/feed/v1.0/summary/1.0_day.csv |
374 column -tns, | graph -f4 -u -l80%
376 External datasets, like movies per year:
378 curl https://github.com/prust/wikipedia-movie-data/raw/master/movies.json |
379 perl -054 -nlE 'say if s/^"year"://' | uniq -c | barcat
381 But please get I<jq> to process JSON
382 and replace the manual selection by C<< jq '.[].year' >>.
384 Pokémon height comparison:
386 curl https://github.com/Biuni/PokemonGO-Pokedex/raw/master/pokedex.json |
387 jq -r '.pokemon[] | [.height,.num,.name] | join(" ")' | barcat
389 USD/EUR exchange rate from CSV provided by the ECB:
391 curl https://sdw.ecb.europa.eu/export.do \
392 -Gd 'node=SEARCHRESULTS&q=EXR.D.USD.EUR.SP00.A&exportType=csv' |
393 grep '^[12]' | barcat -f',\K' --value-length=7
395 Total population history from the World Bank dataset (XML):
396 External datasets, like total population in XML from the World Bank:
398 curl http://api.worldbank.org/v2/country/1W/indicator/SP.POP.TOTL |
399 xmllint --xpath '//*[local-name()="date" or local-name()="value"]' - |
400 sed -r 's,</wb:value>,\n,g; s,(<[^>]+>)+, ,g' | barcat -f1 -H
402 And of course various Git statistics, such commit count by year:
404 git log --pretty=%ci | cut -b-4 | uniq -c | barcat
406 Or the top 3 most frequent authors with statistics over all:
408 git shortlog -sn | barcat -L3 -s
410 Activity of the last days (substitute date C<-v-{}d> on BSD):
412 ( git log --pretty=%ci --since=30day | cut -b-10
413 seq 0 30 | xargs -i date +%F -d-{}day ) |
414 sort | uniq -c | awk '$1--' | graph --spark
418 Mischa POSLAWSKY <perl@shiar.org>