Showing splitmix64.pl (raw)

  1. #!/usr/bin/env perl
  2.  
  3. use strict;
  4. use warnings;
  5. use v5.16;
  6.  
  7. use Test::More;
  8.  
  9. ################################################################################
  10. # 2025-10-23: Pure Perl implementation of PRNG splitmix64 PRNG
  11. # Scott Baker / https://www.perturb.org/
  12. ################################################################################
  13. # A lot of work was done here to mimic how C handles overflow multiplication
  14. # on large uint64_t numbers. Perl converts scalars that are larger than 2^64 - 1
  15. # to floating point on the backend. We do *NOT* want that, because splitmix
  16. # (and most PRNGs) rely on overflow math to do their magic. We utilize
  17. # 'use integer' to force Perl to do all math with integer 64bit values. When
  18. # overflow occurs Perl likes to convert those values to signed numbers. In
  19. # the original C all math is done with uint64_t, so we have to convert the
  20. # IV/signed numbers back into UV/unsigned (positive) values.
  21. ################################################################################
  22. #uint64_t x = 123456789; # Seed
  23. #
  24. #uint64_t splitmix64() {
  25. #    uint64_t z;
  26. #
  27. #    z = (x += 0x9e3779b97f4a7c15);
  28. #    z = (z ^ (z >> 30)) * 0xbf58476d1ce4e5b9;
  29. #    z = (z ^ (z >> 27)) * 0x94d049bb133111eb;
  30. #
  31. #    return z ^ (z >> 31);
  32. #}
  33. ################################################################################
  34.  
  35. use Getopt::Long;
  36.  
  37. my $seed        = [11]; # Default 64bit seed
  38. my $random_seed = 0;
  39.  
  40. GetOptions(
  41.     'seed=i'       => \$seed->[0],
  42.     'random_seed'  => \$random_seed,
  43.     'unit-tests'   => \&run_unit_tests,
  44. );
  45.  
  46. my $iters = int($ARGV[0] || 8);
  47.  
  48. if ($random_seed) {
  49.     print color('yellow', "Using random seed\n");
  50.     $seed->[0] = perl_rand64();
  51. }
  52.  
  53. print color(123, "Using seed: $seed->[0]\n\n");
  54.  
  55. for my $x (1 .. $iters) {
  56.     my $num1  = splitmix64_perl($seed);
  57.  
  58.     printf("%2d: %20u\n", $x, $num1);
  59. }
  60.  
  61. ###############################################################################
  62.  
  63. #my $seed = [10293820198];
  64. #my $num  = splitmix_64_perl($seed);
  65. sub splitmix64_perl {
  66.     # Seed must be passed as a array reference so we can update it
  67.     my $seed = $_[0];
  68.  
  69.     use integer;
  70.     # We bitwise or with zero to convert a signed int (IV) to an unsigned int (UV)
  71.     # This is a weird hack that mauke taught me. It works so *shrug*
  72.     my $z       = ($seed->[0] += 11400714819323198485) | 0;
  73.     $seed->[0] |= 0;
  74.     no integer;
  75.  
  76.     $z = shift_xor_multiply($z, 30, 13787848793156543929);
  77.     $z = shift_xor_multiply($z, 27, 10723151780598845931);
  78.     $z = ($z ^ ($z >> 31));
  79.  
  80.     return $z;
  81. }
  82.  
  83. # Splitmix does a lot of bitshifting, xoring, and multiplying so we
  84. # create one function to simplify that. We utilize `use integer` to
  85. # make sure all math is done using integers and preserve the rollover
  86. sub shift_xor_multiply {
  87.     my ($x, $shift, $mult) = @_;
  88.  
  89.     # This needs to be done with `no integer`
  90.     $x = ($x ^ ($x >> $shift));
  91.  
  92.     # Use integer math for the overflow
  93.     use integer;
  94.     $x = ($x * $mult) | 0;
  95.     no integer;
  96.  
  97.     return $x;
  98. }
  99.  
  100. #################################################################################
  101. ## Alternate single function for copy and paste (no other function dependencies #
  102. #################################################################################
  103.  
  104. #my $seed = [10293820198];
  105. #my $num  = splitmix_64_perl_single($seed);
  106. sub splitmix64_perl_single {
  107.     # Seed must be passed as a array reference so we can update it
  108.     my $seed = $_[0];
  109.  
  110.     use integer;
  111.     # We bitwise or with zero to convert a signed int (IV) to an unsigned int (UV)
  112.     # This is a weird hack that mauke taught me. It works so *shrug*
  113.     my $z       = ($seed->[0] += 11400714819323198485) | 0;
  114.     $seed->[0] |= 0;
  115.     no integer;
  116.  
  117.     $z = ($z ^ ($z >> 30));
  118.     use integer;
  119.     $z = ($z * 13787848793156543929) | 0;
  120.     no integer;
  121.  
  122.     $z = ($z ^ ($z >> 27));
  123.     use integer;
  124.     $z = ($z * 10723151780598845931) | 0;
  125.     no integer;
  126.  
  127.     $z = ($z ^ ($z >> 31));
  128.  
  129.     return $z;
  130. }
  131.  
  132. ###############################################################################
  133. ###############################################################################
  134.  
  135. # String format: '115', '165_bold', '10_on_140', 'reset', 'on_173', 'red', 'white_on_blue'
  136. sub color {
  137.     my ($str, $txt) = @_;
  138.  
  139.     # If we're NOT connected to a an interactive terminal don't do color
  140.     if (-t STDOUT == 0) { return $txt || ""; }
  141.  
  142.     # No string sent in, so we just reset
  143.     if (!length($str) || $str eq 'reset') { return "\e[0m"; }
  144.  
  145.     # Some predefined colors
  146.     my %color_map = qw(red 160 blue 27 green 34 yellow 226 orange 214 purple 93 white 15 black 0);
  147.     $str =~ s|([A-Za-z]+)|$color_map{$1} // $1|eg;
  148.  
  149.     # Get foreground/background and any commands
  150.     my ($fc,$cmd) = $str =~ /^(\d{1,3})?_?(\w+)?$/g;
  151.     my ($bc)      = $str =~ /on_(\d{1,3})$/g;
  152.  
  153.     if (defined($fc) && int($fc) > 255) { $fc = undef; } # above 255 is invalid
  154.  
  155.     # Some predefined commands
  156.     my %cmd_map = qw(bold 1 italic 3 underline 4 blink 5 inverse 7);
  157.     my $cmd_num = $cmd_map{$cmd // 0};
  158.  
  159.     my $ret = '';
  160.     if ($cmd_num)      { $ret .= "\e[${cmd_num}m"; }
  161.     if (defined($fc))  { $ret .= "\e[38;5;${fc}m"; }
  162.     if (defined($bc))  { $ret .= "\e[48;5;${bc}m"; }
  163.     if (defined($txt)) { $ret .= $txt . "\e[0m";   }
  164.  
  165.     return $ret;
  166. }
  167.  
  168. # Run a test with a given seed and return a string of the results
  169. sub quick_test {
  170.     my $seed = [$_[0]];
  171.  
  172.     my @data = ();
  173.     for (my $i = 0; $i < 4; $i++) {
  174.         my $num = splitmix64_perl($seed);
  175.         push(@data, $num);
  176.     }
  177.  
  178.     my $ret = join(", ", @data);
  179.     return $ret;
  180. }
  181.  
  182. sub run_unit_tests {
  183.     # Seeds < 2**32
  184.     cmp_ok(quick_test(11)       , 'eq', '5833679380957638813, 4839782808629744545, 11769803791402734189, 9308485889748266480');
  185.     cmp_ok(quick_test(22)       , 'eq', '14415425345905102346, 17264975761475716686, 1412077619021228083, 12404402112097020482');
  186.     cmp_ok(quick_test(100)      , 'eq', '2532601429470541124, 269152572843532260, 4491231873834608077, 4673566422923057776');
  187.     cmp_ok(quick_test(123456789), 'eq', '2466975172287755897, 8832083440362974766, 3534771765162737125, 9592110948284743397');
  188.     cmp_ok(quick_test(9999)     , 'eq', '6117204470161645077, 15966700211956150513, 15034308290212886683, 7774926710803868520');
  189.  
  190.     # Seeds > 2**32
  191.     cmp_ok(quick_test(7774926710803868520)  , 'eq', '9605346004387840742, 17435495358832388828, 12684084655726398219, 9795402745067826113');
  192.     cmp_ok(quick_test(9795402745067826113)  , 'eq', '13110559830617540027, 13626988459271143897, 846014752197971904, 13956522239222304255');
  193.     cmp_ok(quick_test(846014752197971904)   , 'eq', '17051223190671778754, 12943043929365758946, 17796463379074244041, 16028253299916138813');
  194.     cmp_ok(quick_test(12943043929365758946) , 'eq', '13152169664619309884, 10188724118650338133, 13259243310153093243, 12185650234802439251');
  195.     cmp_ok(quick_test(16028253299916138813) , 'eq', '17201533047954400773, 3347092783829409799, 2118253649191891459, 15494166571380546778');
  196.  
  197.     done_testing();
  198.     exit(0);
  199. }
  200.  
  201. sub perl_rand64 {
  202.     my $low  = int(rand() * (2**32-1));
  203.     my $high = int(rand() * (2**32-1));
  204.  
  205.     my $ret = ($high << 32) | $low;
  206.  
  207.     return $ret;
  208. }
  209.  
  210. sub get_64bit_seed {
  211.     open my $urandom, '<:raw', '/dev/urandom' or croak("Couldn't open /dev/urandom: $!");
  212.     sysread($urandom, my $buf, 8) or croak("Couldn't read from csprng: $!");
  213.  
  214.     return unpack("Q*", $buf);
  215. }
  216.  
  217. # Creates methods k() and kd() to print, and print & die respectively
  218. BEGIN {
  219.     if (eval { require Data::Dump::Color }) {
  220.         *k = sub { Data::Dump::Color::dd(@_) };
  221.     } else {
  222.         require Data::Dumper;
  223.         *k = sub { print Data::Dumper::Dumper(\@_) };
  224.     }
  225.  
  226.     sub kd {
  227.         k(@_);
  228.  
  229.         printf("Died at %2\$s line #%3\$s\n",caller());
  230.         exit(15);
  231.     }
  232. }
  233.  
  234. # vim: tabstop=4 shiftwidth=4 noexpandtab autoindent softtabstop=4