Showing mwc.pl (raw)

  1. #!/usr/bin/env perl
  2.  
  3. use strict;
  4. use warnings;
  5. use v5.16;
  6. use Getopt::Long;
  7.  
  8. ###############################################################################
  9. # Scott Baker - 2025-10-29 - https://www.perturb.org/
  10. ###############################################################################
  11. # Pure Perl versions of the mwc128, mwc192, and mwc256 PRNGs. The math for
  12. # these generators is done in the 128 bit space. Perl cannot natively handle
  13. # numbers that large so we `use bigint` to emulate uint128 variables and then
  14. # clamp back down to 64bit numbers.
  15. #
  16. # This is several orders of magnitude slower than the C version, but that's to
  17. # be expected because of the way we're forced to do the math.
  18. ###############################################################################
  19. # /* Borrowed from: https://prng.di.unimi.it/MWC128.c */
  20. #
  21. # #define MWC_A1 0xffebb71d94fcdaf9
  22. #
  23. # /* The state must be initialized so that 0 < c < MWC_A1 - 1.
  24. #    For simplicity, we suggest to set c = 1 and x to a 64-bit seed. */
  25. # uint64_t x, c;
  26. #
  27. # uint64_t inline mwc128_next() {
  28. #     const uint64_t result = x; // Or, result = x ^ (x << 32) (see above)
  29. #     const __uint128_t t = MWC_A1 * (__uint128_t)x + c;
  30. #     x = t;
  31. #     c = t >> 64;
  32. #     return result;
  33. # }
  34. ###############################################################################
  35.  
  36. my $random;
  37.  
  38. GetOptions(
  39.     'random' => \$random,
  40. );
  41.  
  42. my $iterations = $ARGV[0] || 20;
  43.  
  44. ###############################################################################
  45. ###############################################################################
  46.  
  47. my $_x = 16413207192273257406; # mwc128
  48. my $_y = 3426865068386098881;  # mwc128, mwc192
  49. my $_z = 10741635696922576250; # mwc128, mwc192, and mwc256
  50. my $_c = 1;
  51.  
  52. if ($random) {
  53.     $_x = perl_rand64();
  54.     $_y = perl_rand64();
  55.     $_z = perl_rand64();
  56.  
  57.     print color('yellow', "Using random seeds: $_c, $_x, $_y, $_z\n\n");
  58. }
  59.  
  60. print color('white');
  61. printf("%2s  %14s %21s %21s\n", "", "MWC128", "MWC192", "MWC256");
  62. print color('reset');
  63. for (1 .. $iterations) {
  64.     printf("%2d) %21u %21u %21u\n", $_, mwc128(), mwc192(), mwc256());
  65. }
  66.  
  67. ###############################################################################
  68. ###############################################################################
  69.  
  70. sub mwc128 {
  71.     use bigint;
  72.  
  73.     my $result = $_x;
  74.     # Math is done bigint and then clamped to 128 bits
  75.     my $t      = (18441034436880161529 * $_x + $_c) & 340282366920938463463374607431768211455;
  76.  
  77.     # Clamped to 64 bits
  78.     $_x = $t & 18446744073709551615;
  79.     $_c = $t >> 64;
  80.  
  81.     return $result;
  82. }
  83.  
  84. sub mwc192 {
  85.     use bigint;
  86.  
  87.     my $result = $_y;
  88.     # Math is done bigint and then clamped to 128 bits
  89.     my $t      = (18419808683250244998 * $_x + $_c) & 340282366920938463463374607431768211455;
  90.  
  91.     $_x = $_y;
  92.     # Clamped to 64 bits
  93.     $_y = $t & 18446744073709551615;
  94.     $_c = $t >> 64;
  95.  
  96.     return $result;
  97. }
  98.  
  99. sub mwc256 {
  100.     use bigint;
  101.  
  102.     my $result = $_z;
  103.     # Math is done bigint and then clamped to 128 bits
  104.     my $t      = (18443978745271340463 * $_x + $_c) & 340282366920938463463374607431768211455;
  105.  
  106.     $_x = $_y;
  107.     $_y = $_z;
  108.     # Clamped to 64 bits
  109.     $_z = $t & 18446744073709551615;
  110.     $_c = $t >> 64;
  111.  
  112.     return $result;
  113. }
  114.  
  115. ###############################################################################
  116. ###############################################################################
  117.  
  118. sub perl_rand64 {
  119.     my $high = int(rand() * 2**32 - 1);
  120.     my $low  = int(rand() * 2**32 - 1);
  121.  
  122.     my $ret = ($high << 32) | $low;
  123.  
  124.     return $ret;
  125. }
  126.  
  127. sub trim {
  128.     my ($s) = (@_, $_); # Passed in var, or default to $_
  129.     if (!defined($s) || length($s) == 0) { return ""; }
  130.     $s =~ s/^\s*//;
  131.     $s =~ s/\s*$//;
  132.  
  133.     return $s;
  134. }
  135.  
  136. # String format: '115', '165_bold', '10_on_140', 'reset', 'on_173', 'red', 'white_on_blue'
  137. sub color {
  138.     my ($str, $txt) = @_;
  139.  
  140.     # If we're NOT connected to a an interactive terminal don't do color
  141.     if (-t STDOUT == 0) { return $txt || ""; }
  142.  
  143.     # No string sent in, so we just reset
  144.     if (!length($str) || $str eq 'reset') { return "\e[0m"; }
  145.  
  146.     # Some predefined colors
  147.     my %color_map = qw(red 160 blue 27 green 34 yellow 226 orange 214 purple 93 white 15 black 0);
  148.     $str =~ s|([A-Za-z]+)|$color_map{$1} // $1|eg;
  149.  
  150.     # Get foreground/background and any commands
  151.     my ($fc,$cmd) = $str =~ /^(\d{1,3})?_?(\w+)?$/g;
  152.     my ($bc)      = $str =~ /on_(\d{1,3})$/g;
  153.  
  154.     if (defined($fc) && int($fc) > 255) { $fc = undef; } # above 255 is invalid
  155.  
  156.     # Some predefined commands
  157.     my %cmd_map = qw(bold 1 italic 3 underline 4 blink 5 inverse 7);
  158.     my $cmd_num = $cmd_map{$cmd // 0};
  159.  
  160.     my $ret = '';
  161.     if ($cmd_num)      { $ret .= "\e[${cmd_num}m"; }
  162.     if (defined($fc))  { $ret .= "\e[38;5;${fc}m"; }
  163.     if (defined($bc))  { $ret .= "\e[48;5;${bc}m"; }
  164.     if (defined($txt)) { $ret .= $txt . "\e[0m";   }
  165.  
  166.     return $ret;
  167. }
  168.  
  169. sub file_get_contents {
  170.     open(my $fh, "<", $_[0]) or return undef;
  171.     binmode($fh, ":encoding(UTF-8)");
  172.  
  173.     my $array_mode = ($_[1]) || (!defined($_[1]) && wantarray);
  174.  
  175.     if ($array_mode) { # Line mode
  176.         my @lines  = readline($fh);
  177.  
  178.         # Right trim all lines
  179.         foreach my $line (@lines) { $line =~ s/[\r\n]+$//; }
  180.  
  181.         return @lines;
  182.     } else { # String mode
  183.         local $/       = undef; # Input rec separator (slurp)
  184.         return my $ret = readline($fh);
  185.     }
  186. }
  187.  
  188. sub file_put_contents {
  189.     my ($file, $data) = @_;
  190.  
  191.     open(my $fh, ">", $file) or return undef;
  192.     binmode($fh, ":encoding(UTF-8)");
  193.     print $fh $data;
  194.     close($fh);
  195.  
  196.     return length($data);
  197. }
  198.  
  199. # Creates methods k() and kd() to print, and print & die respectively
  200. BEGIN {
  201.     if (eval { require Data::Dump::Color }) {
  202.         *k = sub { Data::Dump::Color::dd(@_) };
  203.     } else {
  204.         require Data::Dumper;
  205.         *k = sub { print Data::Dumper::Dumper(\@_) };
  206.     }
  207.  
  208.     sub kd {
  209.         k(@_);
  210.  
  211.         printf("Died at %2\$s line #%3\$s\n",caller());
  212.         exit(15);
  213.     }
  214. }
  215.  
  216. # vim: tabstop=4 shiftwidth=4 noexpandtab autoindent softtabstop=4