#!/usr/bin/env perl

###############################################################################
# Scott Baker - 2025-02-27 - https://www.perturb.org/
# Script to check the quality of an integer for use as a seed in a PRNG.
#
# There is some confusion about what makes a number a good candidate to be
# used as a seed for a PRNG. Seeds should be a *large* number with no big
# sections of repeating 1s or 0s. A good seed is a decimal number with 18 or
# 19 digits.
#
# https://www.perturb.org/display/1421_What_kind_of_number_makes_a_good_seed_for_a_PRNG.html
###############################################################################

use strict;
use warnings;
use v5.16;
use Getopt::Long;

my $random = 0;
my $bits   = 64;
my $bit32  = 0;
GetOptions(
	'random' => \$random,
	'32bit'  => \$bit32,
);

if ($bit32) {
	$bits = 32;
}

###############################################################################
###############################################################################

my $num = int($ARGV[0] || 0);

if ($random) {
	$num = perl_rand64_best();

	if ($bits == 32) {
		$num = $num & 0xFFFFFFFF;
	}
}

if (!$num) {
	die("Usage: $0 [123456789] [--random]\n");
}

my $x = seed_info($num, $bits);

my $qual_per   = $x->{quality} * 100;
my $qual_color = "";

if    ($qual_per < 25) { $qual_color = color('red');    }
elsif ($qual_per < 50) { $qual_color = color('orange'); }
elsif ($qual_per < 75) { $qual_color = color('yellow'); }
else                   { $qual_color = color('green');  }

printf("Random seed quality checker\n");
printf("===========================\n");
printf("Decimal  : %u\n"         , $x->{decimal});
printf("Bits     : %s\n"         , colorize_bit_string($x->{bits}));
printf("Hex      : %s\n"         , $x->{hex});
printf("Zero/One : %d/%d\n"      , $x->{zeros}, $x->{ones});
printf("Quality  : %s%0.2f%%%s\n", $qual_color, $x->{quality} * 100, color('reset'));

###############################################################################
###############################################################################

sub colorize_bit_string {
	my $str = shift();

	my $white = color(252);
	my $other = color(230);
	my $reset = color('reset');

	# Colorize leading zeros
	$str =~ s/^(0{4,})/$other$1$reset/;
	# Colorize trailing zeros
	$str =~ s/(0{4,})$/$other$1$reset/;

	return $str;
}

sub seed_info {
	my $seed = int(shift());
	my $bits = shift() || 64;
	my $half = int($bits / 2);

	my $ret = {};
	my $str = sprintf("%0" . $bits . "b", $num);

	$str =~ m/^(0+)/;
	my $lead_zero_count = length($1) || 0;

	$ret->{'leading_zero'} = $lead_zero_count;
	$ret->{'bits'}         = $str;
	$ret->{'zeros'}        = char_count("0", $str);
	$ret->{'ones'}         = char_count("1", $str);
	$ret->{'decimal'}      = $seed + 0;
	$ret->{'hex'}          = sprintf("0x%0" . ($half / 2) . "x", $seed);
	$ret->{'diff'}         = abs($ret->{zeros} - $ret->{ones});
	$ret->{'bits_req'}     = bits_required($seed);

	# Percentage out of the bit difference between one and zero
	my $diff_per = -1;
	if ($ret->{'diff'} > $half) {
		$diff_per = 0;
	} else {
		$diff_per = abs($half - $ret->{'diff'}) / $half;
	}

	# Bits required to store the number out of 64
	my $bits_per = $ret->{'bits_req'} / $bits;

	# "Quality" is a combination of how many bits are required
	# to store the number, and the difference between the ones/zeros
	$ret->{quality} = ($diff_per + $bits_per) / 2;

	return $ret;
}

sub char_count {
	my ($needle,$str) = @_;
	my $len = length($str);
	my $ret = 0;

	for (my $i = 0; $i < $len; $i++) {
		my $found = substr($str,$i,1);

		if ($needle eq $found) { $ret++; }
	}

	return $ret;
}

sub bits_required {
	my ($n) = @_;

	# Handle special case for 0
	return 0 if $n == 0;

	# Use logarithm to calculate the number of bits
	my $bits = int(log($n) / log(2)) + 1;
	return $bits;
}

sub trim {
	my ($s) = (@_, $_); # Passed in var, or default to $_
	if (!defined($s) || length($s) == 0) { return ""; }
	$s =~ s/^\s*//;
	$s =~ s/\s*$//;

	return $s;
}

# String format: '115', '165_bold', '10_on_140', 'reset', 'on_173', 'red', 'white_on_blue'
sub color {
    my ($str, $txt) = @_;

    # If we're NOT connected to a an interactive terminal don't do color
    if (-t STDOUT == 0) { return $txt || ""; }

    # No string sent in, so we just reset
    if (!length($str) || $str eq 'reset') { return "\e[0m"; }

    # Some predefined colors
    my %color_map = qw(red 160 blue 27 green 34 yellow 226 orange 214 purple 93 white 15 black 0);
    $str =~ s|([A-Za-z]+)|$color_map{$1} // $1|eg;

    # Get foreground/background and any commands
    my ($fc,$cmd) = $str =~ /^(\d{1,3})?_?(\w+)?$/g;
    my ($bc)      = $str =~ /on_(\d{1,3})$/g;

    if (defined($fc) && int($fc) > 255) { $fc = undef; } # above 255 is invalid

    # Some predefined commands
    my %cmd_map = qw(bold 1 italic 3 underline 4 blink 5 inverse 7);
    my $cmd_num = $cmd_map{$cmd // 0};

    my $ret = '';
    if ($cmd_num)      { $ret .= "\e[${cmd_num}m"; }
    if (defined($fc))  { $ret .= "\e[38;5;${fc}m"; }
    if (defined($bc))  { $ret .= "\e[48;5;${bc}m"; }
    if (defined($txt)) { $ret .= $txt . "\e[0m";   }

    return $ret;
}

# Creates methods k() and kd() to print, and print & die respectively
BEGIN {
	if (eval { require Data::Dump::Color }) {
		*k = sub { Data::Dump::Color::dd(@_) };
	} else {
		require Data::Dumper;
		*k = sub { print Data::Dumper::Dumper(\@_) };
	}

	sub kd {
		k(@_);

		printf("Died at %2\$s line #%3\$s\n",caller());
		exit(15);
	}
}

sub perl_rand64_bad {
	# Perl uses drand48 so there are only 2^48 - 1 possible values
	# This means that we can't map into 64bit space, because we will
	# end up with a lot of trailing zeros
	my $ret = rand() * (2**64 - 1);

	return $ret;
}

sub perl_rand64_ok {
	my $low  = int(rand() * (2**32 -1));
	my $high = int(rand() * (2**32 -1));

	my $ret = ($high << 32) | $low;

	return $ret;
}

sub perl_rand64_best {
	open(my $FH, "<", "/dev/urandom");

	# Read 8 bytes and convert it to an unsigned long (uint64_t)
	my $bytes = '';
	my $ok    = sysread($FH, $bytes, 8);
	my $ret   = unpack("Q", $bytes);

	return $ret;
}

# vim: tabstop=4 shiftwidth=4 noexpandtab autoindent softtabstop=4