Как рассчитать двоичную статистику в Perl?

Question

Я, по сути, стремлюсь сделать то, что может сделать типичный / хороший шестнадцатеричный редактор:

https://www.hhdsoftware.com/doc/hex-editor/statistics-statistics-tool-window.html

Я хочу иметь возможность подсчитать вхождение каждого байта и поместить его в таблицу, чтобы я мог определить%, скажем, '00' по сравнению с 'FF'.

Мне удалось получить энтропию, и другие статистические данные, такие как среднее значение, медиана и мода, отчасти избыточны, как только я завершу вышеупомянутое.

Существует также проблема, связанная с тем, что двоичные файлы, по которым я собираю статистику, достаточно велики - 32 МБ +.

Есть предложения?

Answer 1

Вот еще один способ сделать это:

use strict;
use warnings;
use Time::HiRes qw( time );

$/ = \1;

open my $file, '<', shift;
binmode $file;

my %seen;

my $start = time();
my $n;

while (<$file>) {
    $seen{$_} ++;
    $n++;
}
my $end = time();

for ( sort keys %seen ) {
    printf( "%s%s%.2f%s\n", uc( unpack( 'H*', $_ ) ), " seen $seen{$_} times - ", $seen{$_} / $n * 100, "%" );
}

printf( "took %.3f seconds!\n", $end - $start );

выход:

...
...
F8 seen 46475 times - 0.28%
F9 seen 46611 times - 0.28%
FA seen 46703 times - 0.28%
FB seen 48902 times - 0.29%
FC seen 46829 times - 0.28%
FD seen 47707 times - 0.28%
FE seen 47276 times - 0.28%
FF seen 1752333 times - 10.44%
took 2.374 seconds!

Это (WSL в Windows) Perl 5.22.1, созданный для x86_64-linux-gnu-thread-multi (с 69 зарегистрированными патчами)

То же самое в C - https://github.com/james28909/count/blob/master/count.c

EDIT:

На самом деле, вот еще один, ЛУЧШИЙ, пример, данный BrowserUK в perlmonks - https://www.perlmonks.org/?node_id=1159266 - Кажется, он работает быстрее, чем оба приведенных примера / ответа.

use strict;
use Time::HiRes qw[ time ];

my $start = time;

open I, '<:raw', $ARGV[ 0 ];

my @seen;

while( read( I, my $buf, 16384  ) ) {
    ++$seen[$_] for unpack 'C*', $buf;
}
printf "Took %f secs\n", time() - $start;

Answer 2

use List::Util qw( sum );

use constant BLOCK_SIZE => 4*1024*1024;

open(my $fh, '<:raw', $qfn)
   or die("Can't open \"$qfn\": $!\n");

my @counts = (0) x 256;
while (1) {
   my $rv = sysread($fh, my $buf, BLOCK_SIZE);
   die($!) if !defined($rv);
   last if !$rv;

   ++$counts[$_] for unpack 'C*', $buf;
}

my $N = sum @counts;