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', color(1) . $total . color(0);
 224                 printf ' in %d values', scalar @values;
 225                 printf(' (%s min, %s avg, %s max)',
 226                         color(31) . $order[-1] . color(0),
 227                         color(36) . (sprintf '%*.*f', 0, 2, $total / @order) . color(0),
 228                         color(32) . $order[0] . color(0),
 229                 );
 230         }
 231         say '';
 232 }
 233
 234 __END__
 235 =encoding utf8
 236
 237 =head1 NAME
 238
 239 barcat - graph to visualize input values
 240
 241 =head1 SYNOPSIS
 242
 243 B<barcat> [<options>] [<input>]
 244
 245 =head1 DESCRIPTION
 246
 247 Visualizes relative sizes of values read from input (file(s) or STDIN).
 248 Contents are concatenated similar to I<cat>,
 249 but numbers are reformatted and a bar graph is appended to each line.
 250
 251 Don't worry, barcat does not drink and divide.
 252 It can has various options for input and output (re)formatting,
 253 but remains limited to one-dimensional charts.
 254 For more complex graphing needs
 255 you'll need a larger animal like I<gnuplot>.
 256
 257 =head1 OPTIONS
 258
 259 =over
 260
 261 =item -c, --[no-]color
 262
 263 Force colored output of values and bar markers.
 264 Defaults on if output is a tty,
 265 disabled otherwise such as when piped or redirected.
 266
 267 =item -f, --field=(<number>|<regexp>)
 268
 269 Compare values after a given number of whitespace separators,
 270 or matching a regular expression.
 271
 272 Unspecified or I<-f0> means values are at the start of each line.
 273 With I<-f1> the second word is taken instead.
 274 A string can indicate the starting position of a value
 275 (such as I<-f:> if preceded by colons),
 276 or capture the numbers itself,
 277 for example I<-f'(\d+)'> for the first digits anywhere.
 278
 279 =item -H, --human-readable
 280
 281 Format values using SI unit prefixes,
 282 turning long numbers like I<12356789> into I<12.4M>.
 283 Also changes an exponent I<1.602176634e-19> to I<160.2z>.
 284 Short integers are aligned but kept without decimal point.
 285
 286 =item -t, --interval[=<seconds>]
 287
 288 Interval time to output partial progress.
 289
 290 =item -l, --length=[-]<size>[%]
 291
 292 Trim line contents (between number and bars)
 293 to a maximum number of characters.
 294 The exceeding part is replaced by an abbreviation sign,
 295 unless C<--length=0>.
 296
 297 Prepend a dash (i.e. make negative) to enforce padding
 298 regardless of encountered contents.
 299
 300 =item -L, --limit=(<count>|<start>-[<end>])
 301
 302 Stop output after a number of lines.
 303 All input is still counted and analyzed for statistics,
 304 but disregarded for padding and bar size.
 305
 306 =item -m, --markers=
 307
 308 Statistical positions to indicate on bars.
 309 Cannot be customized yet,
 310 only disabled by providing an empty argument.
 311
 312 Any value enables all marker characters:
 313
 314 =over 2
 315
 316 =item B<=>
 317
 318 Average:
 319 the sum of all values divided by the number of counted lines.
 320
 321 =item B<+>
 322
 323 Mean, median:
 324 the middle value or average between middle values.
 325
 326 =item B<<>
 327
 328 Standard deviation left of the mean.
 329 Only 16% of all values are lower.
 330
 331 =item B<< > >>
 332
 333 Standard deviation right of the mean.
 334 The part between B<< <--> >> encompass all I<normal> results,
 335 or 68% of all entries.
 336
 337 =back
 338
 339 =item -s, --stat
 340
 341 Total statistics after all data.
 342
 343 =item -u, --unmodified
 344
 345 Do not reformat values, keeping leading whitespace.
 346 Keep original value alignment, which may be significant in some programs.
 347
 348 =item --value-length=<size>
 349
 350 Reserved space for numbers.
 351
 352 =item -w, --width=<columns>
 353
 354 Override the maximum number of columns to use.
 355 Appended graphics will extend to fill up the entire screen.
 356
 357 =item -h, --usage
 358
 359 Overview of available options.
 360
 361 =item --help
 362
 363 Full documentation
 364 rendered by perldoc.
 365
 366 =item --version
 367
 368 Version information.
 369
 370 =back
 371
 372 =head1 EXAMPLES
 373
 374 Draw a sine wave:
 375
 376     seq 30 | awk '{print sin($1/10)}' | barcat
 377
 378 Compare file sizes (with human-readable numbers):
 379
 380     du -d0 -b * | barcat -H
 381
 382 Memory usage of user processes with long names truncated:
 383
 384     ps xo %mem,pid,cmd | barcat -l40
 385
 386 Monitor network latency from prefixed results:
 387
 388     ping google.com | barcat -f'time=\K' -t
 389
 390 Commonly used after counting, for example users on the current server:
 391
 392     users | sed 's/ /\n/g' | sort | uniq -c | barcat
 393
 394 Letter frequencies in text files:
 395
 396     cat /usr/share/games/fortunes/*.u8 |
 397     perl -CS -nE 'say for grep length, split /\PL*/, uc' |
 398     sort | uniq -c | barcat
 399
 400 Number of HTTP requests per day:
 401
 402     cat log/access.log | cut -d\  -f4 | cut -d: -f1 | uniq -c | barcat
 403
 404 Any kind of database query with counts, preserving returned alignment:
 405
 406     echo 'SELECT count(*),schemaname FROM pg_tables GROUP BY 2' |
 407     psql -t | barcat -u
 408
 409 Earthquakes worldwide magnitude 1+ in the last 24 hours:
 410
 411     https://earthquake.usgs.gov/earthquakes/feed/v1.0/summary/1.0_day.csv |
 412     column -tns, | graph -f4 -u -l80%
 413
 414 External datasets, like movies per year:
 415
 416     curl https://github.com/prust/wikipedia-movie-data/raw/master/movies.json |
 417     perl -054 -nlE 'say if s/^"year"://' | uniq -c | barcat
 418
 419 But please get I<jq> to process JSON
 420 and replace the manual selection by C<< jq '.[].year' >>.
 421
 422 Pokémon height comparison:
 423
 424     curl https://github.com/Biuni/PokemonGO-Pokedex/raw/master/pokedex.json |
 425     jq -r '.pokemon[] | [.height,.num,.name] | join(" ")' | barcat
 426
 427 USD/EUR exchange rate from CSV provided by the ECB:
 428
 429     curl https://sdw.ecb.europa.eu/export.do \
 430          -Gd 'node=SEARCHRESULTS&q=EXR.D.USD.EUR.SP00.A&exportType=csv' |
 431     grep '^[12]' | barcat -f',\K' --value-length=7
 432
 433 Total population history from the World Bank dataset (XML):
 434 External datasets, like total population in XML from the World Bank:
 435
 436     curl http://api.worldbank.org/v2/country/1W/indicator/SP.POP.TOTL |
 437     xmllint --xpath '//*[local-name()="date" or local-name()="value"]' - |
 438     sed -r 's,</wb:value>,\n,g; s,(<[^>]+>)+, ,g' | barcat -f1 -H
 439
 440 And of course various Git statistics, such commit count by year:
 441
 442     git log --pretty=%ci | cut -b-4 | uniq -c | barcat
 443
 444 Or the top 3 most frequent authors with statistics over all:
 445
 446     git shortlog -sn | barcat -L3 -s
 447
 448 Activity of the last days (substitute date C<-v-{}d> on BSD):
 449
 450     ( git log --pretty=%ci --since=30day | cut -b-10
 451       seq 0 30 | xargs -i date +%F -d-{}day ) |
 452     sort | uniq -c | awk '$1--' | graph --spark
 453
 454 =head1 AUTHOR
 455
 456 Mischa POSLAWSKY <perl@shiar.org>
 457
 458 =head1 LICENSE
 459
 460 GPL3+.