#! /usr/bin/perl -w

# This is described on the whole page and, the huge optimisation implemented here, specifically in the section
# https://perl1liner.sourceforge.io/Collatz/#Prediction

use v5.30;
use strict;

# Hard wiring 8 steps is arbitrary, aligned to writing numbers in hex.  For each Bad tail we start with, we already have its
# result after $l steps.  But for the same tail with a 1-bit prefixed, we must calculate it fully.  Then for all (except Good)
# tails we must calculate this many steps to lengthen them.  This constant tries to balance the one full calculation against
# MAX times STEPS steps OTOH, and the huge effort to compress the output, which is ~10x as much for "xz -9e" and ~100x for
# "brotli -Z", which gives a few % smaller files.
sub STEPS() { 8 }
sub MAX() { 2**STEPS-1 }

# Collect all numbers of STEPS bits, ordered from low bits, so as to kinda have them in tree of growing length order.  Later
# insert the same, shifted left by $l bits, so as to be an or-able prefix.  Also add for all possible lengths where Good tails
# are found, how many next prefixes to skip, as they share the same low bits.  These are added from the end, so as to coincide
# with the negative number returned by tail, which can directly index these arrays.
my @prefix;
{
    my @tmp = map eval( '0b' . reverse ),
      sort map scalar( reverse sprintf '%0*b', STEPS, $_ ),
      0..MAX;
    while( @tmp ) {
	my $p = shift @tmp;
	my @elt = $p;
	for( 1..STEPS-1 ) {
	    my $mask = (1 << $_) - 1;
	    my $filter = $mask & $p;
	    my $n = grep $filter == ($_ & $mask), @tmp;
	    $elt[$_] = $n;
	}
	push @prefix, \@elt;
    }
}


# Todo: convert number creation, printf to BigInt and remove die.  Otherwise somewhere after 40 bits sequences will start to
# overflow.
#BEGIN { unshift @INC, '/usr/share/perl/5.32' } # Devuan currently has a problem where incompatible sub-packages are installed
#use Math::BigInt try => 'GMP,Pari';
no warnings 'portable'; # Hex > 0xffffffff Todo BigInt remove


# Adapted Collatz function, which can start at a precalculated intermediate result, but still needs the original number for
# checking whether we reach smaller.  Return the result ater $steps or, for a Good tail, the negative number of unused steps,
# which can index its array in @prefix to know how many more Good tails to skip.
sub tail($$$) {
    my( $steps, $n, $orig ) = @_;
    while( $steps-- ) {
	if( $n & 1 ) {
	    if( $steps && $n & 2 ) {
		--$steps;
		$n = ($n << 1) + ($n >> 2) + 2;
	    } else {
		++($n += $n >> 1);
	    }
	    die "$steps $n\n" if $n > 0xffff_ffff_ffff_ffff; # Todo BigInt remove
	} else {
	    $n >>= 1;
	    return -$steps if $n < $orig;
	}#
    }
    $n;
}
my( $l, $b, $nb, $form );
# Wrapper to tail, which initialises and tries every prefix, except those found to be Good.
sub tails {
    my( $tail, $r0 ) = map hex, split ' ', $_[0]; # Todo BigInt->from_hex
    unless( defined $nb ) { # late INIT
	$b = index $_[0], ' '; # For this program they must all have the same length!
	$nb = $b + 2;
	$form = "%0${nb}x %x\n";
	$b /= 2;
	$nb /= 2;
	$l = $b * 8;
	unshift @$_, $_->[0] << $l
	  for @prefix;
    }
    my $n1 = (1 << $l) | $tail; # Todo BigInt->new
    my $r1 = tail $l, $n1, $n1;
    my $r1_r0 = $r1 - $r0;
    my @prefix = @prefix; # modifiable copy
    while( @prefix ) {
	my $p = shift @prefix;
	my $orig = $p->[0] | $tail;
	if( 0 < (my $rp = tail STEPS, $r0 + $p->[1] * $r1_r0, $orig) ) {
	    printf $form, $orig, $rp; # Todo %0${nb}s, BigInt->to_hex
	} elsif( $rp ) {
	    splice @prefix, 0, $p->[$rp]; # skip Good ones with same sub-tail
	}
    }
}

# RUN

if( @ARGV && -f $ARGV[0] ) {
#    open STDIN, '-|', qw(brotli -dc) => shift
#      if $ARGV[0] =~ /\.br$/;
    open STDIN, '-|', xzcat => shift
      if $ARGV[0] =~ /\.xz$/;
} elsif( @ARGV ) {
    tails @ARGV;
    exit;
} else {
    open STDIN, '<&DATA'
}
while( <> ) {
    chop;
    tails $_;
}

# all 8 bit Bad tails with their result after STEPS steps:
__DATA__
1b f2
9b 1bd
5b 107
fb 2cf
47 ce
a7 1df
67 37a
e7 295
cf 251
2f 89
6f 13f
ef 803
1f 5b
9f 557
df 27e
3f b6
bf 668
7f 445
ff 19a0
