2019/44.pl

   1 #!/usr/bin/perl -w
   2 use v5.38;
   3 use bigint;
   4 # use Math::BigInt lib => 'GMP';
   5 # Math::BigInt->precision(64);
   6 # say Math::BigInt->precision();
   7
   8 my ($pos, $ncards, $iters) = # @ARGV;
   9         # (2020, 119315717514047, 0);
  10         (2020, 119315717514047, 101741582076661);
  11         # (10, 11, 4);
  12         # (28, 29, 1);
  13         # (7975, 10007, 0);
  14         # (42, 2147483647, 0);
  15         # (42, 8589935681, 0);
  16
  17 $ncards = Math::BigInt->new($ncards);
  18
  19 chomp(my @cmds = <STDIN>);
  20
  21 sub simplify {
  22         my @cmds = @_;
  23
  24         RETRY:
  25         for my $i (0 .. $#cmds-1) {
  26                 my $r = $cmds[$i].";".$cmds[$i+1];
  27                 if ($r =~ /new stack.*new stack/) {
  28                         splice @cmds, $i, 2;
  29                         goto RETRY;
  30                 }
  31                 if ($r =~ /cut (-?\d+);cut (-?\d+)/) {
  32                         my $n1 = +(0+$1);
  33                         my $n2 = +(0+$2);
  34                         splice @cmds, $i, 2,
  35                                 'cut ' . (($ncards+$n1+$n2) % $ncards);
  36                         goto RETRY;
  37                 }
  38                 if ($r =~ /increment (\d+);.*increment (\d+)\z/) {
  39                         my $n1 = +(0+$1);
  40                         my $n2 = +(0+$2);
  41                         splice @cmds, $i, 2,
  42                                 'deal with increment ' . (($n1*$n2) % $ncards);
  43                         goto RETRY;
  44                 }
  45                 # Try to move "cut" down and possibly merge it
  46                 if ($r =~ /cut (-?\d+);.*new stack/) {
  47                         my $n1 = +(0+$1);
  48                         splice @cmds, $i, 2,
  49                                 'deal into new stack',
  50                                 'cut ' . (-$n1);
  51                         goto RETRY;
  52                 }
  53                 if ($r =~ /cut (-?\d+);.*increment (\d+)\z/) {
  54                         my $n1 = +(0+$1);
  55                         my $n2 = +(0+$2);
  56                         splice @cmds, $i, 2,
  57                                 'deal with increment ' . ($n2),
  58                                 'cut ' . (($n1*$n2) % $ncards);
  59                         goto RETRY;
  60                 }
  61                 if ($r =~ /new stack;.*increment (\d+)\z/) {
  62                         my $n1 = +(0+$1);
  63                         splice @cmds, $i, 2,
  64                                 'deal with increment ' . ($ncards-$n1),
  65                                 'cut ' . $n1;
  66                         goto RETRY;
  67                 }
  68         }
  69         # say "=====\nReturning:\n", join("\n", @cmds);
  70         return @cmds;
  71 }
  72
  73 my $loops = $ncards-1;
  74 my $n = 0;
  75 my @repeated_cmds;
  76 while ((1 << $n) <= $loops) {
  77         @cmds = simplify(@cmds);
  78         $repeated_cmds[$n] = [ @cmds ];
  79         $n++;
  80         @cmds = (@cmds, @cmds);
  81 }
  82
  83 sub apply {
  84         my ($cmds, $pos) = @_;
  85
  86         # say "apply $pos:";
  87         for (@$cmds) {
  88                 if (/new stack/) {
  89                         $pos = $ncards-1-$pos;
  90                 } elsif (/increment (\d+)/) {
  91                         $pos *= $1;
  92                         $pos %= $ncards;
  93                 } elsif (/cut (\d+)/) {
  94                         $pos -= $1;
  95                         $pos %= $ncards;
  96                 } elsif (/cut (-\d+)/) {
  97                         $pos -= $1;
  98                         $pos %= $ncards;
  99                 }
 100         }
 101         return $pos;
 102 }
 103
 104 my $l = $ncards - 1 - $iters;
 105 my @r;
 106 while ($n--) {
 107         my $two = 1 << $n;
 108         # say "1 << $n == $two, rem $l";
 109         if ($l >= $two) {
 110                 push @r, @{ $repeated_cmds[$n] };
 111                 $l -= $two;
 112         }
 113 }
 114 @r = simplify(@r);
 115 say "Rules\n", join("\n", @r);
 116 say apply(\@r, $pos);
 117