barcat

   1 #!/usr/bin/perl -CA
   2 use 5.014;
   3 use warnings;
   4 use utf8;
   5 use List::Util qw( min max sum );
   6 use open qw( :std :utf8 );
   7 use re '/msx';
   8
   9 our $VERSION = '1.07';
  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} = /\A[0-9]+\z/ ? qr/(?:\S*\h+){$_}\K/ : qr/$_/;
  20                 } or die $@ =~ s/(?:\ at\ \N+)?\Z/ 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/\A-?[0-9]+\z/ 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         'minval=f',
  37         'maxval=f',
  38         'limit|L:s' => sub {
  39                 my ($optname, $optval) = @_;
  40                 $optval ||= 0;
  41                 ($opt{hidemin}, $opt{hidemax}) =
  42                 $optval =~ m/\A (?: ([0-9]+)? - )? ([0-9]+)? \z/ or die(
  43                         "Value \"$optval\" invalid for option limit",
  44                         " (range expected)\n"
  45                 );
  46         },
  47         'header!',
  48         'markers|m=s',
  49         'graph-format=s' => sub {
  50                 $opt{'graph-format'} = substr $_[1], 0, 1;
  51         },
  52         'spark:s' => sub {
  53                 $opt{spark} = [split //, $_[1] || ' ▁▂▃▄▅▆▇█'];
  54         },
  55         'palette=s' => sub {
  56                 $opt{palette} = {
  57                         fire   => [qw( 90 31 91 33 93 97 96 )],
  58                         fire88 => [map {"38;5;$_"} qw(
  59                                 80  32 48 64  68 72 76  77 78 79  47
  60                         )],
  61                         fire256=> [map {"38;5;$_"} qw(
  62                                 235  52 88 124 160 196
  63                                 202 208 214 220 226  227 228 229 230 231  159
  64                         )],
  65                         ramp88 => [map {"38;5;$_"} qw(
  66                                 64 65 66 67 51 35 39 23 22 26 25 28
  67                         )],
  68                         whites => [qw( 1;30 0;37 1;37 )],
  69                         greys  => [map {"38;5;$_"} 52, 235..255, 47],
  70                 }->{$_[1]} // [ split /[^0-9;]/, $_[1] ];
  71         },
  72         'stat|s!',
  73         'signal-stat=s',
  74         'unmodified|u!',
  75         'width|w=i',
  76         'version' => sub {
  77                 say "barcat version $VERSION";
  78                 exit;
  79         },
  80         'usage|h' => sub {
  81                 local $/ = undef;  # slurp
  82                 my $pod = readline *DATA;
  83                 $pod =~ s/^=over\K/ 25/;  # indent options list
  84                 $pod =~ s/^=item\ \N*\n\n\N*\n\K (?:(?:^=over.*?^=back\n)?(?!=)\N*\n)*/\n/g;
  85                 $pod =~ s/[.,](?=\n)//g;  # trailing punctuation
  86                 $pod =~ s/^=item\ \K(?=--)/____/g;  # align long options
  87                 # abbreviate <variable> indicators
  88                 $pod =~ s/\Q>.../s>/g;
  89                 $pod =~ s/<(?:number|count|seconds)>/N/g;
  90                 $pod =~ s/<character(s?)>/\Uchar$1/g;
  91                 $pod =~ s/\Q | /|/g;
  92                 $pod =~ s/(?<!\w)<([a-z]+)>/\U$1/g;  # uppercase
  93
  94                 require Pod::Usage;
  95                 my $parser = Pod::Usage->new(USAGE_OPTIONS => {
  96                         -indent => 2, -width => 78,
  97                 });
  98                 $parser->select('SYNOPSIS', 'OPTIONS');
  99                 $parser->output_string(\my $contents);
 100                 $parser->parse_string_document($pod);
 101
 102                 $contents =~ s/\n(?=\n\h)//msg;  # strip space between items
 103                 $contents =~ s/^\ \ \K____/    /g;  # nbsp substitute
 104                 print $contents;
 105                 exit;
 106         },
 107         'help|?'  => sub {
 108                 require Pod::Usage;
 109                 Pod::Usage::pod2usage(
 110                         -exitval => 0, -perldocopt => '-oman', -verbose => 2,
 111                 );
 112         },
 113 ) or exit 64;  # EX_USAGE
 114
 115 $opt{width} ||= $ENV{COLUMNS} || qx(tput cols) || 80 unless $opt{spark};
 116 $opt{color} //= -t *STDOUT;  # enable on tty
 117 $opt{'graph-format'} //= '-';
 118 $opt{trim}   *= $opt{width} / 100 if $opt{trimpct};
 119 $opt{units}   = [split //, ' kMGTPEZYyzafpnμm'] if $opt{'human-readable'};
 120 $opt{anchor} //= qr/\A/;
 121 $opt{'value-length'} = 6 if $opt{units};
 122 $opt{'value-length'} = 1 if $opt{unmodified};
 123 $opt{'signal-stat'} //= exists $SIG{INFO} ? 'INFO' : 'QUIT';
 124 $opt{markers} //= '=avg >31.73v <68.27v +50v |0';
 125 $opt{palette} //= $opt{color} && [31, 90, 32];
 126 $opt{hidemin} = ($opt{hidemin} || 1) - 1;
 127 $opt{input} = (@ARGV && $ARGV[0] =~ m/\A[-0-9]/) ? \@ARGV : undef
 128         and undef $opt{interval};
 129
 130 my (@lines, @values, @order);
 131
 132 $SIG{$_} = \&show_stat for $opt{'signal-stat'} || ();
 133 $SIG{ALRM} = sub {
 134         show_lines();
 135         alarm $opt{interval} if defined $opt{interval} and $opt{interval} > 0;
 136 };
 137 $SIG{INT} = \&show_exit;
 138
 139 if (defined $opt{interval}) {
 140         $opt{interval} ||= 1;
 141         alarm $opt{interval} if $opt{interval} > 0;
 142
 143         eval {
 144                 require Tie::Array::Sorted;
 145                 tie @order, 'Tie::Array::Sorted', sub { $_[1] <=> $_[0] };
 146         } or warn $@, "Expect slowdown with large datasets!\n";
 147 }
 148
 149 my $valmatch = qr<
 150         $opt{anchor} ( \h* -? [0-9]* [.]? [0-9]+ (?: e[+-]?[0-9]+ )? |)
 151 >x;
 152 while (defined ($_ = $opt{input} ? shift @{ $opt{input} } : readline)) {
 153         s/\r?\n\z//;
 154         s/\A\h*// unless $opt{unmodified};
 155         my $valnum = s/$valmatch/\n/ && $1;
 156         push @values, $valnum;
 157         push @order, $valnum if length $valnum;
 158         if (defined $opt{trim} and defined $valnum) {
 159                 my $trimpos = abs $opt{trim};
 160                 $trimpos -= length $valnum if $opt{unmodified};
 161                 if ($trimpos <= 1) {
 162                         $_ = substr $_, 0, 2;
 163                 }
 164                 elsif (length > $trimpos) {
 165                         # cut and replace (intentional lvalue for speed, contrary to PBP)
 166                         substr($_, $trimpos - 1) = '…';
 167                 }
 168         }
 169         push @lines, $_;
 170         show_lines() if defined $opt{interval} and $opt{interval} < 0
 171                 and $. % $opt{interval} == 0;
 172 }
 173
 174 if ($opt{'zero-missing'}) {
 175         push @values, (0) x 10;
 176 }
 177
 178 $SIG{INT} = 'DEFAULT';
 179
 180 sub color {
 181         $opt{color} and defined $_[0] or return '';
 182         return "\e[$_[0]m" if defined wantarray;
 183         $_ = color(@_) . $_ . color(0) if defined;
 184 }
 185
 186 sub sival {
 187         my $unit = int(log(abs $_[0] || 1) / log(10) - 3*($_[0] < 1) + 1e-15);
 188         my $float = $_[0] !~ /\A0*[-0-9]{1,3}\z/;
 189         return sprintf('%3.*f%1s',
 190                 $float && ($unit % 3) == ($unit < 0),  # tenths
 191                 $_[0] / 1000 ** int($unit/3),   # number
 192                 $#{$opt{units}} * 1.5 < abs $unit ? "e$unit" : $opt{units}->[$unit/3]
 193         );
 194 }
 195
 196 sub show_lines {
 197
 198 state $nr = $opt{hidemin};
 199 @lines or return;
 200 @lines > $nr or return;
 201
 202 @order = sort { $b <=> $a } @order unless tied @order;
 203 my $maxval = $opt{maxval} // (
 204         $opt{hidemax} ? max grep { length } @values[0 .. $opt{hidemax} - 1] :
 205         $order[0]
 206 ) // 0;
 207 my $minval = $opt{minval} // min $order[-1] // (), 0;
 208 my $range = $maxval - $minval;
 209 my $lenval = $opt{'value-length'} // max map { length } @order;
 210 my $len    = defined $opt{trim} && $opt{trim} <= 0 ? -$opt{trim} + 1 :
 211         max map { length $values[$_] && length $lines[$_] }
 212                 0 .. min $#lines, $opt{hidemax} || ();  # left padding
 213 my $size   = defined $opt{width} && $range &&
 214         ($opt{width} - $lenval - $len) / $range;  # bar multiplication
 215
 216 my @barmark;
 217 if ($opt{markers} and $size > 0) {
 218         for my $markspec (split /\h/, $opt{markers}) {
 219                 my ($char, $func) = split //, $markspec, 2;
 220                 my $pos = eval {
 221                         if ($func eq 'avg') {
 222                                 return sum(@order) / @order;
 223                         }
 224                         elsif ($func =~ /\A([0-9.]+)v\z/) {
 225                                 die "Invalid marker $char: percentile $1 out of bounds\n" if $1 > 100;
 226                                 my $index = $#order * $1 / 100;
 227                                 return ($order[$index] + $order[$index + .5]) / 2;
 228                         }
 229                         elsif ($func =~ /\A-?[0-9.]+\z/) {
 230                                 return $func;
 231                         }
 232                         else {
 233                                 die "Unknown marker $char: $func\n";
 234                         }
 235                 };
 236                 defined $pos or do {
 237                         warn $@ if $@;
 238                         next;
 239                 };
 240                 $pos -= $minval;
 241                 $pos >= 0 or next;
 242                 color(36) for $barmark[$pos * $size] = $char;
 243         }
 244
 245         state $lastmax = $maxval;
 246         if ($maxval > $lastmax) {
 247                 print ' ' x ($lenval + $len);
 248                 printf color(90);
 249                 printf '%-*s',
 250                         ($lastmax - $minval) * $size + .5,
 251                         '-' x (($values[$nr - 1] - $minval) * $size);
 252                 print color(92);
 253                 say '+' x (($range - $lastmax) * $size + .5);
 254                 print color(0);
 255                 $lastmax = $maxval;
 256         }
 257 }
 258
 259 say(
 260         color(31), sprintf('%*s', $lenval, $minval),
 261         color(90), '-', color(36), '+',
 262         color(32), sprintf('%*s', $size * $range - 3, $maxval),
 263         color(90), '-', color(36), '+',
 264         color(0),
 265 ) if $opt{header};
 266
 267 while ($nr <= $#lines) {
 268         $nr >= $opt{hidemax} and last if defined $opt{hidemax};
 269         my $val = $values[$nr];
 270         my $rel = length $val && $range && ($val - $minval) / $range;
 271         my $color = !length $val || !$opt{palette} ? undef :
 272                 $val == $order[0] ? $opt{palette}->[-1] : # max
 273                 $val == $order[-1] ? $opt{palette}->[0] : # min
 274                 $opt{palette}->[ $rel * ($#{$opt{palette}} - 1) + 1 ];
 275
 276         if ($opt{spark}) {
 277                 say '' if $opt{width} and $nr and $nr % $opt{width} == 0;
 278                 print color($color), $opt{spark}->[
 279                         !$val || !$#{$opt{spark}} ? 0 : # blank
 280                         $val == $order[0] ? -1 : # max
 281                         $val == $order[-1] ? 1 : # min
 282                         $#{$opt{spark}} < 3 ? 1 :
 283                         $rel * ($#{$opt{spark}} - 3) + 2.5
 284                 ];
 285                 next;
 286         }
 287
 288         if (length $val) {
 289                 $val = $opt{units} ? sival($val) : sprintf "%*s", $lenval, $val;
 290                 color($color) for $val;
 291         }
 292         my $line = $lines[$nr] =~ s/\n/$val/r;
 293         printf '%-*s', $len + length($val), $line;
 294         print $barmark[$_] // $opt{'graph-format'}
 295                 for 1 .. $size && (($values[$nr] || 0) - $minval) * $size + .5;
 296         say '';
 297 }
 298 continue {
 299         $nr++;
 300 }
 301 say $opt{palette} ? color(0) : '' if $opt{spark};
 302
 303         return $nr;
 304 }
 305
 306 sub show_stat {
 307         if ($opt{hidemin} or $opt{hidemax}) {
 308                 printf '%s of ', sum(grep { length }
 309                         @values[$opt{hidemin} .. ($opt{hidemax} || @lines) - 1]
 310                 ) // 0;
 311         }
 312         if (@order) {
 313                 my $total = sum @order;
 314                 printf '%s total', color(1) . sprintf('%.8g', $total) . color(0);
 315                 printf ' in %d values', scalar @order;
 316                 printf ' over %d lines', scalar @lines if @order != @lines;
 317                 printf(' (%s min, %s avg, %s max)',
 318                         color(31) . $order[-1] . color(0),
 319                         color(36) . (sprintf '%*.*f', 0, 2, $total / @order) . color(0),
 320                         color(32) . $order[0] . color(0),
 321                 );
 322         }
 323         say '';
 324         return 1;
 325 }
 326
 327 sub show_exit {
 328         show_lines();
 329         show_stat() if $opt{stat};
 330         exit 130 if @_;  # 0x80+signo
 331         exit;
 332 }
 333
 334 show_exit();
 335
 336 __END__
 337 =encoding utf8
 338
 339 =head1 NAME
 340
 341 barcat - graph to visualize input values
 342
 343 =head1 SYNOPSIS
 344
 345 B<barcat> [<options>] [<file>... | <numbers>]
 346
 347 =head1 DESCRIPTION
 348
 349 Visualizes relative sizes of values read from input
 350 (parameters, file(s) or STDIN).
 351 Contents are concatenated similar to I<cat>,
 352 but numbers are reformatted and a bar graph is appended to each line.
 353
 354 Don't worry, barcat does not drink and divide.
 355 It can has various options for input and output (re)formatting,
 356 but remains limited to one-dimensional charts.
 357 For more complex graphing needs
 358 you'll need a larger animal like I<gnuplot>.
 359
 360 =head1 OPTIONS
 361
 362 =over
 363
 364 =item -c, --[no-]color
 365
 366 Force colored output of values and bar markers.
 367 Defaults on if output is a tty,
 368 disabled otherwise such as when piped or redirected.
 369
 370 =item -f, --field=(<number> | <regexp>)
 371
 372 Compare values after a given number of whitespace separators,
 373 or matching a regular expression.
 374
 375 Unspecified or I<-f0> means values are at the start of each line.
 376 With I<-f1> the second word is taken instead.
 377 A string can indicate the starting position of a value
 378 (such as I<-f:> if preceded by colons),
 379 or capture the numbers itself,
 380 for example I<-f'(\d+)'> for the first digits anywhere.
 381
 382 =item --header
 383
 384 Prepend a chart axis with minimum and maximum values labeled.
 385
 386 =item -H, --human-readable
 387
 388 Format values using SI unit prefixes,
 389 turning long numbers like I<12356789> into I<12.4M>.
 390 Also changes an exponent I<1.602176634e-19> to I<160.2z>.
 391 Short integers are aligned but kept without decimal point.
 392
 393 =item -t, --interval[=(<seconds> | -<lines>)]
 394
 395 Output partial progress every given number of seconds or input lines.
 396 An update can also be forced by sending a I<SIGALRM> alarm signal.
 397
 398 =item -l, --length=[-]<size>[%]
 399
 400 Trim line contents (between number and bars)
 401 to a maximum number of characters.
 402 The exceeding part is replaced by an abbreviation sign,
 403 unless C<--length=0>.
 404
 405 Prepend a dash (i.e. make negative) to enforce padding
 406 regardless of encountered contents.
 407
 408 =item -L, --limit[=(<count> | <start>-[<end>])]
 409
 410 Stop output after a number of lines.
 411 All input is still counted and analyzed for statistics,
 412 but disregarded for padding and bar size.
 413
 414 =item --graph-format=<character>
 415
 416 Glyph to repeat for the graph line.
 417 Defaults to a dash C<->.
 418
 419 =item -m, --markers=<format>
 420
 421 Statistical positions to indicate on bars.
 422 A single indicator glyph precedes each position:
 423
 424 =over 2
 425
 426 =item <number>
 427
 428 Exact value to match on the axis.
 429 A vertical bar at the zero crossing is displayed by I<|0>
 430 for negative values.
 431 For example I<:3.14> would show a colon at pi.
 432
 433 =item <percentage>I<v>
 434
 435 Ranked value at the given percentile.
 436 The default shows I<+> at I<50v> for the mean or median;
 437 the middle value or average between middle values.
 438 One standard deviation right of the mean is at about I<68.3v>.
 439 The default includes I<< >31.73v <68.27v >>
 440 to encompass all I<normal> results, or 68% of all entries, by B<< <--> >>.
 441
 442 =item I<avg>
 443
 444 Matches the average;
 445 the sum of all values divided by the number of counted lines.
 446 Indicated by default as I<=>.
 447
 448 =back
 449
 450 =item --min=<number>, --max=<number>
 451
 452 Bars extend from 0 or the minimum value if lower,
 453 to the largest value encountered.
 454 These options can be set to customize this range.
 455
 456 =item --palette=(<preset> | <color>...)
 457
 458 Override colors of parsed numbers.
 459 Can be any CSI escape, such as I<90> for default dark grey,
 460 or alternatively I<1;30> for bright black.
 461
 462 In case of additional colors,
 463 the last is used for values equal to the maximum, the first for minima.
 464 If unspecified, these are green and red respectively (I<31 90 32>).
 465 Multiple intermediate colors will be distributed
 466 relative to the size of values.
 467
 468 Predefined color schemes are named I<whites> and I<fire>,
 469 or I<greys> and I<fire256> for 256-color variants.
 470
 471 =item --spark[=<characters>]
 472
 473 Replace lines by I<sparklines>,
 474 single characters corresponding to input values.
 475 A specified sequence of unicode characters will be used for
 476 Of a specified sequence of unicode characters,
 477 the first one will be used for non-values,
 478 the last one for the maximum,
 479 the second (if any) for the minimum,
 480 and any remaining will be distributed over the range of values.
 481 Unspecified, block fill glyphs U+2581-2588 will be used.
 482
 483 =item -s, --stat
 484
 485 Total statistics after all data.
 486
 487 =item -u, --unmodified
 488
 489 Do not reformat values, keeping leading whitespace.
 490 Keep original value alignment, which may be significant in some programs.
 491
 492 =item --value-length=<size>
 493
 494 Reserved space for numbers.
 495
 496 =item -w, --width=<columns>
 497
 498 Override the maximum number of columns to use.
 499 Appended graphics will extend to fill up the entire screen.
 500
 501 =item -h, --usage
 502
 503 Overview of available options.
 504
 505 =item --help
 506
 507 Full documentation
 508 rendered by perldoc.
 509
 510 =item --version
 511
 512 Version information.
 513
 514 =back
 515
 516 =head1 EXAMPLES
 517
 518 Draw a sine wave:
 519
 520     seq 30 | awk '{print sin($1/10)}' | barcat
 521
 522 Compare file sizes (with human-readable numbers):
 523
 524     du -d0 -b * | barcat -H
 525
 526 Memory usage of user processes with long names truncated:
 527
 528     ps xo %mem,pid,cmd | barcat -l40
 529
 530 Monitor network latency from prefixed results:
 531
 532     ping google.com | barcat -f'time=\K' -t
 533
 534 Commonly used after counting, for example users on the current server:
 535
 536     users | tr ' ' '\n' | sort | uniq -c | barcat
 537
 538 Letter frequencies in text files:
 539
 540     cat /usr/share/games/fortunes/*.u8 |
 541     perl -CS -nE 'say for grep length, split /\PL*/, uc' |
 542     sort | uniq -c | barcat
 543
 544 Number of HTTP requests per day:
 545
 546     cat log/access.log | cut -d\  -f4 | cut -d: -f1 | uniq -c | barcat
 547
 548 Any kind of database query with counts, preserving returned alignment:
 549
 550     echo 'SELECT count(*),schemaname FROM pg_tables GROUP BY 2' |
 551     psql -t | barcat -u
 552
 553 In PostgreSQL from within the client:
 554
 555         postgres=> SELECT sin(generate_series(0, 3, .1)) \g |barcat
 556
 557 Earthquakes worldwide magnitude 1+ in the last 24 hours:
 558
 559     curl https://earthquake.usgs.gov/earthquakes/feed/v1.0/summary/1.0_day.csv |
 560     column -tns, | barcat -f4 -u -l80%
 561
 562 External datasets, like movies per year:
 563
 564     curl https://github.com/prust/wikipedia-movie-data/raw/master/movies.json -L |
 565     perl -054 -nlE 'say if s/^"year"://' | uniq -c | barcat
 566
 567 But please get I<jq> to process JSON
 568 and replace the manual selection by C<< jq '.[].year' >>.
 569
 570 Pokémon height comparison:
 571
 572     curl https://github.com/Biuni/PokemonGO-Pokedex/raw/master/pokedex.json -L |
 573     jq -r '.pokemon[] | [.height,.num,.name] | join(" ")' | barcat
 574
 575 USD/EUR exchange rate from CSV provided by the ECB:
 576
 577     curl https://sdw.ecb.europa.eu/export.do \
 578          -Gd 'node=SEARCHRESULTS&q=EXR.D.USD.EUR.SP00.A&exportType=csv' |
 579     grep '^[12]' | barcat -f',\K' --value-length=7
 580
 581 Total population history in XML from the World Bank:
 582
 583     curl http://api.worldbank.org/v2/country/1W/indicator/SP.POP.TOTL -L |
 584     xmllint --xpath '//*[local-name()="date" or local-name()="value"]' - |
 585     sed -r 's,</wb:value>,\n,g; s,(<[^>]+>)+, ,g' | barcat -f1 -H
 586
 587 And of course various Git statistics, such commit count by year:
 588
 589     git log --pretty=%ci | cut -b-4 | uniq -c | barcat
 590
 591 Or the top 3 most frequent authors with statistics over all:
 592
 593     git shortlog -sn | barcat -L3 -s
 594
 595 Sparkline graphics of simple input given as inline parameters:
 596
 597         barcat --spark= 3 1 4 1 5 0 9 2 4
 598
 599 Activity graph of the last days (substitute date C<-v-{}d> on BSD):
 600
 601     ( git log --pretty=%ci --since=30day | cut -b-10
 602       seq 0 30 | xargs -i date +%F -d-{}day ) |
 603     sort | uniq -c | awk '$1--' | barcat --spark
 604
 605 =head1 AUTHOR
 606
 607 Mischa POSLAWSKY <perl@shiar.org>
 608
 609 =head1 LICENSE
 610
 611 GPL3+.