#!/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 those 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 $seeds = []; GetOptions( 'debug' => \$debug, 'seed1=i' => \$s1, 'seed2=i' => \$s2, 'random' => \&randomize_seeds, 'unit-tests' => \&run_unit_tests, ); my $num = $ARGV[0] || 8; my ($seed1, $seed2); print color(83, "Seeding PRNG with: $s1 / $s2\n"); $seeds = [uint64($s1), uint64($s2)]; my @x = (); for (my $i = 0; $i < $num; $i++) { my $num = pcg32_math64($seeds); push(@x, $num); } print color('yellow', "Math::Int64: ") . join(", ", @x); print "\n"; ################################## $seeds = [$s1, $s2]; my @y = (); for (my $i = 0; $i < $num; $i++) { my $num = pcg32_native($seeds); push(@y, $num); } print color('yellow', "Native Perl: ") . join(", ", @y); print "\n"; ################################## print "\n"; $seeds = [$s1, $s2]; my @z = (); for (my $i = 0; $i < $num; $i++) { my $num = pcg64_native($seeds); push(@z, $num); } print color('yellow', "Native Perl 64bit: ") . join(", ", @z); print "\n"; ################################################################################ ################################################################################ ################################################################################ #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; } #my $seeds = [12, 34]; #my $rand = pcg32_native($seeds); sub pcg32_native { # state/inc are passed in by reference my ($s) = @_; my $oldstate = $s->[0]; # Save original state # We use interger math because Perl converts to floats any scalar # larger than 2^64. PCG *requires* 64bit uint64_t math, with overflow, # to calculate correctly. We have to unconvert the overflowed number # from an IV to UV after the big math use integer; $s->[0] = $oldstate * 6364136223846793005 + ($s->[1] | 1); $s->[0] = iv_2_uv($s->[0]); no integer; my $xorshifted = (($oldstate >> 18) ^ $oldstate) >> 27; $xorshifted = $xorshifted & 0xFFFFFFFF; # Convert to uint32_t my $rot = ($oldstate >> 59); # -$rot on a uint32_t is the same as (2^32 - $rot) my $invrot = 4294967296 - $rot; my $ret = ($xorshifted >> $rot) | ($xorshifted << ($invrot & 31)); # Convert to uint32_t $ret = $ret & 0xFFFFFFFF; 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; } # During large integer math when a UV overflows and wraps back around # Perl casts it as a IV value. For the purposes of PCG we need that # wraparound math to stay in place. We need uint64_t all the time. sub iv_2_uv { my $x = $_[0]; # Flip it from a IV (signed) to a UV (unsigned) # use Devel::Peek; Dump($var) # See the internal Perl type if ($x < 0) { no integer; $x += 18446744073709551615; $x += 1; } return $x; } # 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, 34]; #my $rand = pcg64_native($seeds); sub pcg64_native { my ($s) = @_; # Build a new object to send to each pcg32 instance my $inc = 1; # Can be any 64bit value my $one = [$s->[0], $inc]; my $two = [$s->[1], $inc]; # Get two 32bit ints my $high = pcg32_native($one); my $low = pcg32_native($two); # We copy the data back into the original object $s->[0] = $one->[0]; $s->[1] = $two->[0]; # Combine the two 32bits into one 64bit int my $ret = ($high << 32) | $low; 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\n"); $s1 = int(rand() * (2**64 - 1)); $s2 = int(rand() * (2**64 - 1)); } # 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_native($seed); push(@data, $num); } my $ret = join(", ", @data); return $ret; } sub quick_test64 { my $seed = $_[0]; my @data = (); for (my $i = 0; $i < 4; $i++) { my $num = pcg64_native($seed); push(@data, $num); } my $ret = join(", ", @data); return $ret; } sub run_unit_tests { # Seeds < 2**32 cmp_ok(quick_test32([11, 22]) , 'eq', '0, 1425092920, 3656087653, 1104107026'); cmp_ok(quick_test32([33, 44]) , 'eq', '0, 3850707138, 2930351490, 1110209703'); cmp_ok(quick_test32([55, 66]) , 'eq', '0, 1725101930, 224698313, 2870828486'); cmp_ok(quick_test32([12345, 67890]), 'eq', '0, 8251198, 44679150, 3046830521'); cmp_ok(quick_test32([9999, 9999]) , 'eq', '0, 521292032, 3698775557, 199399470'); cmp_ok(quick_test64([11, 22]) , 'eq', '0, 6120727489207695446, 7904312005358798897, 14733674221366828425'); cmp_ok(quick_test64([33, 44]) , 'eq', '0, 16538661225628040268, 5269891931295187491, 5495286771333204711'); cmp_ok(quick_test64([55, 66]) , 'eq', '0, 7409256372025208996, 8212781881022671801, 8831782971077082788'); cmp_ok(quick_test64([12345, 67890]), 'eq', '0, 35438628484449140, 42862460907032573, 519456495312580246'); cmp_ok(quick_test64([9999, 9999]) , 'eq', '0, 2238932229626677504, 14236525402126437484, 10387246122801752400'); # Seeds > 2**32 cmp_ok(quick_test32([42862460907032573, 519456495312580246]) , 'eq', '319349001, 562730850, 2229409754, 561058538'); cmp_ok(quick_test32([6120727489207695446, 7904312005358798897]) , 'eq', '635930912, 2099303707, 1638577555, 1426136496'); cmp_ok(quick_test32([4841811808465514507, 7141191103728083377]) , 'eq', '1986408540, 4264878569, 3066617590, 731859269'); cmp_ok(quick_test64([42862460907032573, 519456495312580246]) , 'eq', '1371593519175525487, 17623029558467823369, 17850014000156247978, 768534907509427587'); cmp_ok(quick_test64([6120727489207695446, 7904312005358798897]) , 'eq', '2731302471965979098, 3465889473135782122, 4841811808465514507, 7141191103728083377'); cmp_ok(quick_test64([4841811808465514507, 7141191103728083377]) , 'eq', '8531559717926221063, 6031125200978744796, 3704366926003160989, 5594521440717127703'); done_testing(); exit(0); } # vim: tabstop=4 shiftwidth=4 noexpandtab autoindent softtabstop=4