#!/usr/bin/env perl

###############################################################################
# Two implementations of PCG32. One in native Perl with no dependencies, and
# one that uses Math::Int64. Surprisingly the native version is significantly
# faster.
#
# A lot of work was done here to mimic how C handles overflow multiplication
# on large uint64_t numbers. Perl converts scalars that are larger than 2^64-1
# to floating point on the backend. We do *NOT* want that for PCG, because
# PCG (and more PRNGs) rely on overflow math to do their magic. We utilize
# 'use integer' to force Perl to do all math with regular 64bit values. When
# overflow occurs Perl likes to convert large values to negative numbers. In
# the original C all math is done with uint64_t, so we have to convert the
# IV/negative numbers back into UV/unsigned (positive) values. PCG also uses
# some uint32_t variables internally, so we mimic that by doing the math in
# 64bit and then masking down to only the 32bit number.
#
###############################################################################
#
# Original C code from: https://www.pcg-random.org/download.html
#
# typedef struct { uint64_t state;  uint64_t inc; } pcg32_random_t;
#
# uint32_t pcg32_random_r(pcg32_random_t* rng) {
#     uint64_t oldstate = rng->state;
#     // Advance internal state
#     rng->state = oldstate * 6364136223846793005ULL + (rng->inc|1);
#     // Calculate output function (XSH RR), uses old state for max ILP
#     uint32_t xorshifted = ((oldstate >> 18u) ^ oldstate) >> 27u;
#     uint32_t rot = oldstate >> 59u;
#     return (xorshifted >> rot) | (xorshifted << ((-rot) & 31));
# }
#
###############################################################################

use strict;
use warnings;
use v5.16;
use Math::Int64 qw(uint64 uint64_to_number);
use Getopt::Long;
use Test::More;

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

my $debug = 0;
my $s1    = 15939250660798104135; # Default 64bit seed1
my $s2    = 3988331200502121509;  # Default 64bit seed2
my $s3    = 15939250660798104135; # Default 64bit seed1
my $s4    = 3988331200502121509;  # Default 64bit seed2

GetOptions(
	'debug'      => \$debug,
	'seed1=i'    => \$s1,
	'seed2=i'    => \$s2,
	'random'     => \&randomize_seeds,
	'unit-tests' => \&run_unit_tests,
);

my $seeds32 = [$s1, $s2];
my $seeds64 = [$s1, $s2];

my $num = $ARGV[0] || 8;

print color('yellow', "Seeding PRNG with: $s1 / $s2\n\n");

for (my $i = 1; $i <= $num; $i++) {
	my $num32 = pcg32_perl($seeds32);
	my $num64 = pcg64_perl($seeds64);
	printf("%2d) %10u / %20u\n", $i, $num32, $num64);
}

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

#my $seeds = [12, 34];
#my $rand  = pcg32_perl($seeds);
sub pcg32_perl {
	# state/inc are passed in by reference
	my ($seeds)  = @_;
	my $oldstate = $seeds->[0]; # Save original state

	# We use interger math because Perl converts to floats any scalar
	# larger than 2^64 - 1. PCG *requires* 64bit uint64_t math, with overflow,
	# to calculate correctly. We have to unconvert the overflowed signed integer (IV)
	# to an unsigned integer (UV) using bitwise or against zero. (weird hack)
	use integer;
	$seeds->[0]  = ($oldstate * 6364136223846793005 + ($seeds->[1] | 1));
	no integer;
	#$seeds->[0] |= 0; # Only needed if you look at the seeds cuz they might be negative

	my $xorshifted = ((($oldstate >> 18) ^ $oldstate) >> 27) & 0xFFFFFFFF;

	# -$rot on a uint32_t is the same as (2^32 - $rot)
	my $rot    = ($oldstate >> 59);
	my $invrot = 4294967296 - $rot;
	my $ret    = (($xorshifted >> $rot) | ($xorshifted << ($invrot & 31))) & 0xFFFFFFFF;

	if (defined($debug) && $debug > 0) {
        # $oldstate is the state at the start of the function and $inc
        # doesn't change so we can print out the initial values here
        print color('orange', "State : " . ($oldstate | 0) . "/" . ($seeds->[1] | 0) . "\n");
        print color('orange', "State2: " . ($seeds->[0] | 0) . "\n");
        print color('orange', "Xor   : $xorshifted\n");
        print color('orange', "Rot   : $rot\n");
    }

	return $ret;
}

# Based on the C algorithm: https://chatgpt.com/share/693cc99c-8068-800d-858e-be16ec1d7521
#my $seeds = [12, 34];
#my $rand  = pcg64_perl($seeds);
sub pcg64_perl {
    my $seeds = $_[0];
    my $ret   = (($seeds->[0] >> (($seeds->[0] >> 59) + 5)) ^ $seeds->[0]);

    use integer;
    $ret *= 12605985483714917081;
    $seeds->[0] = $seeds->[0] * 6364136223846793005 + $seeds->[1];
    no integer;
	#$seeds->[0] |= 0; # Only needed if you look at the seeds cuz they might be negative

    $ret = ($ret >> 43) ^ $ret;

    return $ret;
}

# To get a 64bit number from PCG32 you create two different generators
# and combine the results into a single 64bit value. All the examples
# online show 1 for the inc/seed2 value. I'm not sure why that is, but
# I copied it for my implementation.
#
#my $seeds = [[12, 1], [34,1]];
#my $rand  = pcg64_perl_chained($seeds);
sub pcg64_perl_chained {
	my ($seeds) = @_;

	# Get two 32bit ints
	my $high = pcg32_perl($seeds->[0]);
	my $low  = pcg32_perl($seeds->[1]);

	# Combine the two 32bits into one 64bit int
	my $ret = ($high << 32) | $low;

	return $ret;
}

#my $seeds = [uint64(12), uint64(34)];
#my $rand  = pcg32_math64($seeds);
sub pcg32_math64 {
	# state/inc are passed in by reference
	my ($s) = @_;

	my $oldstate = $s->[0];
	$s->[0]      = $oldstate * 6364136223846793005 + ($s->[1] | 1);

	my $xorshifted = (($oldstate >> 18) ^ $oldstate) >> 27;
	$xorshifted    = $xorshifted & 0xFFFFFFFF; # Convert to uint32_t

	my $rot    = $oldstate >> 59;
	my $invrot = 4294967296 - $rot;

	my $ret = ($xorshifted >> $rot) | ($xorshifted << ($invrot & 31));
	$ret    = $ret & 0xFFFFFFFF; # Convert to uint32_t

	$ret = uint64_to_number($ret);

	if ($debug) {
		# $oldstate is the state at the start of the function and $inc
		# doesn't change so we can print out the initial values here
		print color('orange', "State : $oldstate/$s->[1]\n");
		print color('orange', "State2: $s->[0]\n");
		print color('orange', "Xor   : $xorshifted\n");
		print color('orange', "Rot   : $rot\n");
	}

	return $ret;
}

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

# 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;
}

sub randomize_seeds {
	print color(51, "Using random seeds\n");

	$s1 = perl_rand64();
	$s2 = perl_rand64();
}

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

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

	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);
	}
}

# Run a test with a given seed and return a string of the results
sub quick_test32 {
	my $seed = $_[0];

	my @data = ();
	for (my $i = 0; $i < 4; $i++) {
		my $num = pcg32_perl($seed);
		push(@data, $num);
	}

	my $ret = join(", ", @data);
	return $ret;
}

sub quick_test64 {
	my ($seed) = @_;

	my @data = ();
	for (my $i = 0; $i < 4; $i++) {
		my $num = pcg64_perl($seed);
		push(@data, $num);
	}

	my $ret = join(", ", @data);
	return $ret;
}

sub run_unit_tests {
	# Seeds < 2**32
	is(quick_test32([11   , 22])   , '0, 1425092920, 3656087653, 1104107026');
	is(quick_test32([33   , 44])   , '0, 3850707138, 2930351490, 1110209703');
	is(quick_test32([55   , 66])   , '0, 1725101930, 224698313, 2870828486');
	is(quick_test32([12345, 67890]), '0, 8251198, 44679150, 3046830521');
	is(quick_test32([9999 , 9999]) , '0, 521292032, 3698775557, 199399470');

	is(quick_test64([11   , 22])   , '9538631804898304851, 16158778725070734108, 11691277237799343826, 3387200422953703275');
	is(quick_test64([33   , 44])   , '16009909930975141620, 326681257729406768, 10608485012141334170, 3059691087832193363');
	is(quick_test64([55   , 66])   , '16640429467063018515, 10892804362730022438, 297264128773379188, 844739387753726856');
	is(quick_test64([12345, 67890]), '17650027671492790999, 1218468377349889116, 7481073335483023155, 18104476594962223303');
	is(quick_test64([9999 , 9999]) , '7871854434682127697, 8791668826882079131, 4042756844426893633, 14361836536518626214');

	# Seeds > 2**32
	is(quick_test32([42862460907032573  , 519456495312580246])  , '319349001, 562730850, 2229409754, 561058538');
	is(quick_test32([6120727489207695446, 7904312005358798897]) , '635930912, 2099303707, 1638577555, 1426136496');
	is(quick_test32([4841811808465514507, 7141191103728083377]) , '1986408540, 4264878569, 3066617590, 731859269');

	is(quick_test64([42862460907032573  , 519456495312580246])  , '15573818271454563608, 11676002511341419670, 2091042206243276651, 3904012745602952106');
	is(quick_test64([6120727489207695446, 7904312005358798897]) , '408103921297353512, 3309375775245630061, 17384267947741920157, 2626915900692044254');
	is(quick_test64([4841811808465514507, 7141191103728083377]) , '9460770724321175617, 12493231060469799668, 934078138728949589, 16830977504107995527');

	done_testing();
	exit(0);
}

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