barcat

   1 #!/usr/bin/perl -CA
   2 use 5.018;
   3 use warnings;
   4 use utf8;
   5 use List::Util qw( min max sum );
   6 use open qw( :std :utf8 );
   7 use experimental qw( lexical_subs );
   8
   9 our $VERSION = '1.05';
  10
  11 use Getopt::Long '2.33', qw( :config gnu_getopt );
  12 my %opt;
  13 GetOptions(\%opt,
  14         'color|c!',
  15         'C' => sub { $opt{color} = 0 },
  16         'field|f=s' => sub {
  17                 eval {
  18                         local $_ = $_[1];
  19                         $opt{anchor} = /^[0-9]+$/ ? qr/(?:\S*\h+){$_}\K/ : qr/$_/;
  20                 } or die $@ =~ s/(?: at .+)?$/ for option $_[0]/r;
  21         },
  22         'human-readable|H!',
  23         'interval|t:i',
  24         'trim|length|l=s' => sub {
  25                 my ($optname, $optval) = @_;
  26                 $optval =~ s/%$// and $opt{trimpct}++;
  27                 $optval =~ m/^-?[0-9]+$/ or die(
  28                         "Value \"$optval\" invalid for option $optname",
  29                         " (number or percentage expected)\n"
  30                 );
  31                 $opt{trim} = $optval;
  32         },
  33         'value-length=i',
  34         'hidemin=i',
  35         'hidemax=i',
  36         'limit|L=s' => sub {
  37                 my ($optname, $optval) = @_;
  38                 $optval ||= 0;
  39                 ($opt{hidemin}, $opt{hidemax}) =
  40                 $optval =~ m/\A (?: ([0-9]+)? - )? ([0-9]+)? \z/x or die(
  41                         "Value \"$optval\" invalid for option limit",
  42                         " (range expected)\n"
  43                 );
  44         },
  45         'markers|m=s',
  46         'spark:s' => sub {
  47                 $opt{spark} = [split //, $_[1] || '⎽▁▂▃▄▅▆▇█'];
  48         },
  49         'stat|s!',
  50         'unmodified|u!',
  51         'width|w=i',
  52         'usage|h' => sub {
  53                 local $/;
  54                 my $pod = readline *DATA;
  55                 $pod =~ s/^=over\K/ 22/m;  # indent options list
  56                 $pod =~ s/^=item \N*\n\n\N*\n\K(?:(?:^=over.*?^=back\n)?(?!=)\N*\n)*/\n/msg;
  57
  58                 require Pod::Usage;
  59                 my $parser = Pod::Usage->new;
  60                 $parser->select('SYNOPSIS', 'OPTIONS');
  61                 $parser->output_string(\my $contents);
  62                 $parser->parse_string_document($pod);
  63
  64                 $contents =~ s/\n(?=\n\h)//msg;  # strip space between items
  65                 print $contents;
  66                 exit;
  67         },
  68         'help|?'  => sub {
  69                 require Pod::Usage;
  70                 Pod::Usage::pod2usage(
  71                         -exitval => 0, -perldocopt => '-oman', -verbose => 2,
  72                 );
  73         },
  74 ) or exit 64;  # EX_USAGE
  75
  76 $opt{width} ||= $ENV{COLUMNS} || 80;
  77 $opt{color} //= -t *STDOUT;  # enable on tty
  78 $opt{trim}   *= $opt{width} / 100 if $opt{trimpct};
  79 $opt{units}   = [split //, ' kMGTPEZYyzafpnμm'] if $opt{'human-readable'};
  80 $opt{anchor} //= qr/\A/;
  81 $opt{'value-length'} = 6 if $opt{units};
  82 $opt{'value-length'} = 1 if $opt{unmodified};
  83
  84 my (@lines, @values, @order);
  85
  86 if (defined $opt{interval}) {
  87         $opt{interval} ||= 1;
  88         $SIG{ALRM} = sub {
  89                 show_lines();
  90                 alarm $opt{interval};
  91         };
  92         alarm $opt{interval};
  93
  94         eval {
  95                 require Tie::Array::Sorted;
  96                 tie @order, 'Tie::Array::Sorted', sub { $_[1] <=> $_[0] };
  97         } or warn $@, "Expect slowdown with large datasets!\n";
  98 }
  99
 100 $SIG{INT} = sub {
 101         $SIG{INT} = 'DEFAULT';  # reset for subsequent attempts
 102         'IGNORE' # continue after assumed eof
 103 };
 104
 105 my $valmatch = qr/$opt{anchor} ( \h* -? [0-9]* \.? [0-9]+ (?: e[+-]?[0-9]+ )? |)/x;
 106 while (readline) {
 107         s/\r?\n\z//;
 108         s/^\h*// unless $opt{unmodified};
 109         push @values, s/$valmatch/\n/ && $1;
 110         push @order, $1 if length $1;
 111         if (defined $opt{trim} and defined $1) {
 112                 my $trimpos = abs $opt{trim};
 113                 $trimpos -= length $1 if $opt{unmodified};
 114                 if ($trimpos <= 1) {
 115                         $_ = substr $_, 0, 2;
 116                 }
 117                 elsif (length > $trimpos) {
 118                         substr($_, $trimpos - 1) = '…';
 119                 }
 120         }
 121         push @lines, $_;
 122 }
 123
 124 $SIG{INT} = 'DEFAULT';
 125
 126 sub color {
 127         $opt{color} and defined $_[0] or return '';
 128         return "\e[$_[0]m" if defined wantarray;
 129         $_ = color(@_) . $_ . color(0) if defined;
 130 }
 131
 132 sub show_lines {
 133
 134 state $nr = $opt{hidemin} ? $opt{hidemin} - 1 : 0;
 135 @lines and @lines > $nr or return;
 136 @lines or return;
 137 @lines > $nr or return unless $opt{hidemin};
 138
 139 @order = sort { $b <=> $a } @order unless tied @order;
 140 my $maxval = ($opt{hidemax} ? max grep { length } @values[0 .. $opt{hidemax} - 1] : $order[0]) // 0;
 141 my $minval = min $order[-1] // (), 0;
 142 my $lenval = $opt{'value-length'} // max map { length } @order;
 143 my $len    = defined $opt{trim} && $opt{trim} <= 0 ? -$opt{trim} + 1 :
 144         max map { length $values[$_] && length $lines[$_] }
 145                 0 .. min $#lines, $opt{hidemax} || ();  # left padding
 146 my $size   = ($maxval - $minval) &&
 147         ($opt{width} - $lenval - $len) / ($maxval - $minval);  # bar multiplication
 148
 149 my @barmark;
 150 if ($opt{markers} // 1 and $size > 0) {
 151         my sub orderpos { (($order[$_[0]] + $order[$_[0] + .5]) / 2 - $minval) * $size }
 152         $barmark[ (sum(@order) / @order - $minval) * $size ] = '=';  # average
 153         $barmark[ orderpos($#order * .31731) ] = '>';
 154         $barmark[ orderpos($#order * .68269) ] = '<';
 155         $barmark[ orderpos($#order / 2) ] = '+';  # mean
 156         $barmark[ -$minval * $size ] = '|' if $minval < 0;  # zero
 157         color(36) for @barmark;
 158
 159         state $lastmax = $maxval;
 160         if ($maxval > $lastmax) {
 161                 print ' ' x ($lenval + $len);
 162                 printf color(90);
 163                 printf '%-*s',
 164                         ($lastmax - $minval) * $size + .5,
 165                         '-' x (($values[$nr - 1] - $minval) * $size);
 166                 print color(92);
 167                 say '+' x (($maxval - $lastmax - $minval) * $size + .5);
 168                 print color(0);
 169                 $lastmax = $maxval;
 170         }
 171 }
 172
 173 @lines > $nr or return if $opt{hidemin};
 174
 175 sub sival {
 176         my $unit = int(log(abs $_[0] || 1) / log(10) - 3*($_[0] < 1) + 1e-15);
 177         my $float = $_[0] !~ /^0*[-0-9]{1,3}$/;
 178         sprintf('%3.*f%1s',
 179                 $float && ($unit % 3) == ($unit < 0),  # tenths
 180                 $_[0] / 1000 ** int($unit/3),   # number
 181                 $#{$opt{units}} * 1.5 < abs $unit ? "e$unit" : $opt{units}->[$unit/3]
 182         );
 183 }
 184
 185 while ($nr <= $#lines) {
 186         $nr >= $opt{hidemax} and last if defined $opt{hidemax};
 187         my $val = $values[$nr];
 188
 189         if ($opt{spark}) {
 190                 print $opt{spark}->[ ($val - $minval) / $maxval * $#{$opt{spark}} ];
 191                 next;
 192         }
 193
 194         if (length $val) {
 195                 my $color = !$opt{color} ? undef :
 196                         $val == $order[0] ? 32 : # max
 197                         $val == $order[-1] ? 31 : # min
 198                         90;
 199                 $val = $opt{units} ? sival($val) : sprintf "%*s", $lenval, $val;
 200                 color($color) for $val;
 201         }
 202         my $line = $lines[$nr] =~ s/\n/$val/r;
 203         printf '%-*s', $len + length($val), $line;
 204         print $barmark[$_] // '-' for 1 .. $size && (($values[$nr] || 0) - $minval) * $size + .5;
 205         say '';
 206 }
 207 continue {
 208         $nr++;
 209 }
 210 say '' if $opt{spark};
 211
 212 }
 213 show_lines();
 214
 215 if ($opt{stat}) {
 216         if ($opt{hidemin} or $opt{hidemax}) {
 217                 $opt{hidemin} ||= 1;
 218                 $opt{hidemax} ||= @lines;
 219                 printf '%s of ', sum(@values[$opt{hidemin} - 1 .. $opt{hidemax} - 1]) // 0;
 220         }
 221         if (@order) {
 222                 my $total = sum @order;
 223                 printf '%s total', $total;
 224                 printf ' in %d values', scalar @values;
 225                 printf ' (%s min, %*.*f avg, %s max)',
 226                         $order[-1], 0, 2, $total / @order, $order[0];
 227         }
 228         say '';
 229 }
 230
 231 __END__
 232 =encoding utf8
 233
 234 =head1 NAME
 235
 236 barcat - graph to visualize input values
 237
 238 =head1 SYNOPSIS
 239
 240 B<barcat> [<options>] [<input>]
 241
 242 =head1 DESCRIPTION
 243
 244 Visualizes relative sizes of values read from input (file(s) or STDIN).
 245 Contents are concatenated similar to I<cat>,
 246 but numbers are reformatted and a bar graph is appended to each line.
 247
 248 Don't worry, barcat does not drink and divide.
 249 It can has various options for input and output (re)formatting,
 250 but remains limited to one-dimensional charts.
 251 For more complex graphing needs
 252 you'll need a larger animal like I<gnuplot>.
 253
 254 =head1 OPTIONS
 255
 256 =over
 257
 258 =item -c, --[no-]color
 259
 260 Force colored output of values and bar markers.
 261 Defaults on if output is a tty,
 262 disabled otherwise such as when piped or redirected.
 263
 264 =item -f, --field=(<number>|<regexp>)
 265
 266 Compare values after a given number of whitespace separators,
 267 or matching a regular expression.
 268
 269 Unspecified or I<-f0> means values are at the start of each line.
 270 With I<-f1> the second word is taken instead.
 271 A string can indicate the starting position of a value
 272 (such as I<-f:> if preceded by colons),
 273 or capture the numbers itself,
 274 for example I<-f'(\d+)'> for the first digits anywhere.
 275
 276 =item -H, --human-readable
 277
 278 Format values using SI unit prefixes,
 279 turning long numbers like I<12356789> into I<12.4M>.
 280 Also changes an exponent I<1.602176634e-19> to I<160.2z>.
 281 Short integers are aligned but kept without decimal point.
 282
 283 =item -t, --interval[=<seconds>]
 284
 285 Interval time to output partial progress.
 286
 287 =item -l, --length=[-]<size>[%]
 288
 289 Trim line contents (between number and bars)
 290 to a maximum number of characters.
 291 The exceeding part is replaced by an abbreviation sign,
 292 unless C<--length=0>.
 293
 294 Prepend a dash (i.e. make negative) to enforce padding
 295 regardless of encountered contents.
 296
 297 =item -L, --limit=(<count>|<start>-[<end>])
 298
 299 Stop output after a number of lines.
 300 All input is still counted and analyzed for statistics,
 301 but disregarded for padding and bar size.
 302
 303 =item -m, --markers=
 304
 305 Statistical positions to indicate on bars.
 306 Cannot be customized yet,
 307 only disabled by providing an empty argument.
 308
 309 Any value enables all marker characters:
 310
 311 =over 2
 312
 313 =item B<=>
 314
 315 Average:
 316 the sum of all values divided by the number of counted lines.
 317
 318 =item B<+>
 319
 320 Mean, median:
 321 the middle value or average between middle values.
 322
 323 =item B<<>
 324
 325 Standard deviation left of the mean.
 326 Only 16% of all values are lower.
 327
 328 =item B<< > >>
 329
 330 Standard deviation right of the mean.
 331 The part between B<< <--> >> encompass all I<normal> results,
 332 or 68% of all entries.
 333
 334 =back
 335
 336 =item -s, --stat
 337
 338 Total statistics after all data.
 339
 340 =item -u, --unmodified
 341
 342 Do not reformat values, keeping leading whitespace.
 343 Keep original value alignment, which may be significant in some programs.
 344
 345 =item --value-length=<size>
 346
 347 Reserved space for numbers.
 348
 349 =item -w, --width=<columns>
 350
 351 Override the maximum number of columns to use.
 352 Appended graphics will extend to fill up the entire screen.
 353
 354 =item -h, --usage
 355
 356 Overview of available options.
 357
 358 =item --help
 359
 360 Full documentation
 361 rendered by perldoc.
 362
 363 =item --version
 364
 365 Version information.
 366
 367 =back
 368
 369 =head1 EXAMPLES
 370
 371 Draw a sine wave:
 372
 373     seq 30 | awk '{print sin($1/10)}' | barcat
 374
 375 Compare file sizes (with human-readable numbers):
 376
 377     du -d0 -b * | barcat -H
 378
 379 Memory usage of user processes with long names truncated:
 380
 381     ps xo %mem,pid,cmd | barcat -l40
 382
 383 Monitor network latency from prefixed results:
 384
 385     ping google.com | barcat -f'time=\K' -t
 386
 387 Commonly used after counting, for example users on the current server:
 388
 389     users | sed 's/ /\n/g' | sort | uniq -c | barcat
 390
 391 Letter frequencies in text files:
 392
 393     cat /usr/share/games/fortunes/*.u8 |
 394     perl -CS -nE 'say for grep length, split /\PL*/, uc' |
 395     sort | uniq -c | barcat
 396
 397 Number of HTTP requests per day:
 398
 399     cat log/access.log | cut -d\  -f4 | cut -d: -f1 | uniq -c | barcat
 400
 401 Any kind of database query with counts, preserving returned alignment:
 402
 403     echo 'SELECT count(*),schemaname FROM pg_tables GROUP BY 2' |
 404     psql -t | barcat -u
 405
 406 Earthquakes worldwide magnitude 1+ in the last 24 hours:
 407
 408     https://earthquake.usgs.gov/earthquakes/feed/v1.0/summary/1.0_day.csv |
 409     column -tns, | graph -f4 -u -l80%
 410
 411 External datasets, like movies per year:
 412
 413     curl https://github.com/prust/wikipedia-movie-data/raw/master/movies.json |
 414     perl -054 -nlE 'say if s/^"year"://' | uniq -c | barcat
 415
 416 But please get I<jq> to process JSON
 417 and replace the manual selection by C<< jq '.[].year' >>.
 418
 419 Pokémon height comparison:
 420
 421     curl https://github.com/Biuni/PokemonGO-Pokedex/raw/master/pokedex.json |
 422     jq -r '.pokemon[] | [.height,.num,.name] | join(" ")' | barcat
 423
 424 USD/EUR exchange rate from CSV provided by the ECB:
 425
 426     curl https://sdw.ecb.europa.eu/export.do \
 427          -Gd 'node=SEARCHRESULTS&q=EXR.D.USD.EUR.SP00.A&exportType=csv' |
 428     grep '^[12]' | barcat -f',\K' --value-length=7
 429
 430 Total population history from the World Bank dataset (XML):
 431 External datasets, like total population in XML from the World Bank:
 432
 433     curl http://api.worldbank.org/v2/country/1W/indicator/SP.POP.TOTL |
 434     xmllint --xpath '//*[local-name()="date" or local-name()="value"]' - |
 435     sed -r 's,</wb:value>,\n,g; s,(<[^>]+>)+, ,g' | barcat -f1 -H
 436
 437 And of course various Git statistics, such commit count by year:
 438
 439     git log --pretty=%ci | cut -b-4 | uniq -c | barcat
 440
 441 Or the top 3 most frequent authors with statistics over all:
 442
 443     git shortlog -sn | barcat -L3 -s
 444
 445 Activity of the last days (substitute date C<-v-{}d> on BSD):
 446
 447     ( git log --pretty=%ci --since=30day | cut -b-10
 448       seq 0 30 | xargs -i date +%F -d-{}day ) |
 449     sort | uniq -c | awk '$1--' | graph --spark
 450
 451 =head1 AUTHOR
 452
 453 Mischa POSLAWSKY <perl@shiar.org>
 454
 455 =head1 LICENSE
 456
 457 GPL3+.