use strict;
use warnings;
use v5.24;

use Storable qw/dclone/;
use Data::Dumper;

use constant wheelsize => 9;

use constant print_progress_messages => 0;
sub print_progress {
    print_progress_messages or return;
    print @_, "\n";
}

sub queueptr_to_queuenum {
    my $queueptr = shift;
    return 0 unless $queueptr;
    my $queuenum = 1;
    while (($queueptr % 2) == 0) {
        ++$queuenum;
        $queueptr >>= 1;
    }
    $queuenum
}

sub find_command_sequence {
    # always kept in order of length($_->{commands})
    my $goals = dclone shift;
    for my $goal (@$goals) {
        $goal->{cur_wheelpos} //= 0;
        $goal->{target_wheelpos} //= 0;
        $goal->{cur_queueptr} //= 1;
        $goal->{target_queueptr} //= 1;
    }

    my $target = { goals => $goals, commands => "" };
    my @targets = ($target);
    my %seen;

    my $nth = 0;
    TARGET: while (@targets) {
        my $ct = shift @targets;
        ++$nth;
        print_progress $ct->{commands}, " ", length($ct->{commands}) unless $nth % 1000;

        # is this a valid command sequence?
        # while we're here, check that it isn't a duplicate
        my $valid = 1;
        my $pattern = "";
        for my $goal ($ct->{goals}->@*) {
            scalar $goal->{trace}->@* and $valid = 0;
            $goal->{cur_wheelpos} eq $goal->{target_wheelpos} or $valid = 0;
            $goal->{cur_queueptr} eq $goal->{target_queueptr} or $valid = 0;
            $pattern .= $goal->{cur_wheelpos} . "p" . $goal->{cur_queueptr} . "q" . scalar($goal->{trace}->@*) . "t";
        }
        exists $seen{$pattern} and next;
        $seen{$pattern} = undef;

        if ($valid) {
            my $l = length $ct->{commands};
            print_progress "Solution found (length $l, after $nth iterations)!";
            return $ct->{commands};
        }

        # consider $ct but with the wheel advanced using a 0 command
        my $nt = dclone $ct;
        $_->{cur_wheelpos} = ($_->{cur_wheelpos} + 1) % wheelsize
            for $nt->{goals}->@*;
        $nt->{commands} .= '0';
        push @targets, $nt;

        # can we run a 1 command here?
        for my $goal ($ct->{goals}->@*) {
            if ($goal->{cur_wheelpos} == 0) { # dequeue
                my $queuenum = queueptr_to_queuenum($goal->{cur_queueptr});
                scalar $goal->{trace}->@* or next TARGET;
                my $tracel = shift $goal->{trace}->@*;
                if ($tracel eq "shift 0 from $queuenum") {
                    # this is one of the two valid possibilities; nothing else happens
                } elsif ($tracel eq "shift 1 from $queuenum") {
                    # this is the other valid possibility; the wheel advances
                    $goal->{cur_wheelpos}++;
                    $goal->{cur_wheelpos} %= wheelsize;
                } else {
                    # the command is incompatible with the trace
                    next TARGET;
                }
            } elsif ($goal->{cur_wheelpos} == 2) { # decrement queue pointer
                $goal->{cur_queueptr}--;
            } elsif ($goal->{cur_wheelpos} == 3) { # enqueue 0
                my $queuenum = queueptr_to_queuenum($goal->{cur_queueptr});
                scalar $goal->{trace}->@* or next TARGET;
                my $tracel = shift $goal->{trace}->@*;
                next TARGET unless $tracel eq "push 0 to $queuenum";
            } elsif ($goal->{cur_wheelpos} == 4) { # enqueue 1
                my $queuenum = queueptr_to_queuenum($goal->{cur_queueptr});
                scalar $goal->{trace}->@* or next TARGET;
                my $tracel = shift $goal->{trace}->@*;
                next TARGET unless $tracel eq "push 1 to $queuenum";
            } elsif ($goal->{cur_wheelpos} == 6) { # advance the wheel
                $goal->{cur_wheelpos}++;
                $goal->{cur_wheelpos} %= wheelsize;
            } elsif ($goal->{cur_wheelpos} == 8) { # increment queue pointer
                $goal->{cur_queueptr}++;
            } elsif ($goal->{cur_wheelpos} =~ /^[157]$/) { # nop
                # do nothing
            } else {
                die("Wheel position was " . $goal->{cur_wheelpos} . ", should be 0..=8");
            }

            # the wheel advances unconditionally after each command, even if it advanced during the command
            $goal->{cur_wheelpos}++;
            $goal->{cur_wheelpos} %= wheelsize;
        }

        $ct->{commands} .= '1';
        push @targets, $ct;
    }
}

sub analyze_command_sequence {
    my $commands = dclone shift;
    $commands->{cur_wheelpos} //= 0;
    $commands->{cur_queueptr} //= 1;
    $commands->{wheelcommands} = "";
    $commands->{trace} = [];
    my @traces = ($commands);
    my @wheelcommand_names = qw/A B C D E F G H I/;
    while ($traces[0]->{commands} ne "") {
        my $trace = shift @traces;

        # we advance the wheel unconditionally; normally that happens after the
        # command, but we may need to copy it, so it's simpler to do it now and
        # remember the old position
        my $wheelpos = $trace->{cur_wheelpos};
        $trace->{cur_wheelpos}++;
        $trace->{cur_wheelpos} %= wheelsize;

        $trace->{commands} =~ s/^(.)//;
        if ($1 eq '0') {
            # not executing the command; nothing changes but the wheelpos
            push @traces, $trace;
            next;
        }

        $trace->{wheelcommands} .= $wheelcommand_names[$wheelpos];

        if ($wheelpos == 0) { # dequeue
            my $queuenum = queueptr_to_queuenum($trace->{cur_queueptr});
            my $trace1 = dclone $trace;

            push $trace->{trace}->@*, "shift 0 from $queuenum";
            push @traces, $trace;

            push $trace1->{trace}->@*, "shift 1 from $queuenum";
            $trace1->{cur_wheelpos}++;
            $trace1->{cur_wheelpos} %= wheelsize;
            push @traces, $trace1;
        } elsif ($wheelpos == 2) { # decrement queue pointer
            $trace->{cur_queueptr}--;
            push @traces, $trace;
        } elsif ($wheelpos == 3) { # enqueue 0
            my $queuenum = queueptr_to_queuenum($trace->{cur_queueptr});            
            push $trace->{trace}->@*, "push 0 to $queuenum";
            push @traces, $trace;
        } elsif ($wheelpos == 4) { # enqueue 1
            my $queuenum = queueptr_to_queuenum($trace->{cur_queueptr});            
            push $trace->{trace}->@*, "push 1 to $queuenum";
            push @traces, $trace;
        } elsif ($wheelpos == 6) { # advance the wheel
            $trace->{cur_wheelpos}++;
            $trace->{cur_wheelpos} %= wheelsize;
            push @traces, $trace;
        } elsif ($wheelpos == 8) { # increment queue pointer
            $trace->{cur_queueptr}++;
            push @traces, $trace;
        } elsif ($wheelpos =~ /^[157]$/) { # nop
            push @traces, $trace;
        } else {
            die("Wheel position was $wheelpos, should be 0..=8");
        }
    }

    \@traces
}

# interpreters for the wheel entries
my $interpreters = {
    AB_dequeue_nop => [{ trace => ["shift 0 from 1", "push 0 to 1", "shift 0 from 1", "push 0 to 1"],
                         cur_queueptr => 1, target_queueptr => 3 },
                       { trace => ["shift 0 from 1", "push 0 to 1", "shift 1 from 1", "push 1 to 1"],
                         cur_queueptr => 1, target_queueptr => 3 },
                       { trace => ["shift 1 from 1", "push 1 to 1", "shift 0 from 2", "shift 0 from 1", "push 0 to 1"],
                         cur_queueptr => 1, target_queueptr => 3 },
                       { trace => ["shift 1 from 1", "push 1 to 1", "shift 0 from 2", "shift 1 from 1", "push 1 to 1"],
                         cur_queueptr => 1, target_queueptr => 3 },
                       { trace => ["shift 1 from 1", "push 1 to 1", "shift 1 from 2"],
                         cur_queueptr => 1, target_queueptr => 3 }],
    C_decrement => [{ trace => ["shift 0 from 1", "push 0 to 1"],
                      cur_queueptr => 3, target_queueptr => 3 },
                    { trace => ["shift 1 from 1", "push 1 to 1"],
                      cur_queueptr => 3, target_queueptr => 1 }],
    D_enqueue_0 => [{ trace => ["shift 0 from 1", "push 0 to 1"],
                      cur_queueptr => 3, target_queueptr => 3 },
                    { trace => ["shift 1 from 1", "push 1 to 1", "push 0 to 2"],
                      cur_queueptr => 3, target_queueptr => 3 }],
    E_enqueue_1 => [{ trace => ["shift 0 from 1", "push 0 to 1"],
                      cur_queueptr => 3, target_queueptr => 1 },
                    { trace => ["shift 1 from 1", "push 1 to 1", "push 1 to 2"],
                      cur_queueptr => 3, target_queueptr => 1 }],
    F_no_operation => [{ trace => ["shift 0 from 1", "push 0 to 1"]},
                       { trace => ["shift 1 from 1", "push 1 to 1"]}],
    GH_advance_nop => [{ trace => ["shift 0 from 1", "push 0 to 1", "shift 0 from 1", "push 0 to 1"]},
                       { trace => ["shift 0 from 1", "push 0 to 1", "shift 1 from 1", "push 1 to 1"]},
                       { trace => ["shift 1 from 1", "push 1 to 1"]}],
    I_increment => [{ trace => ["shift 0 from 1", "push 0 to 1"]},
                    { trace => ["shift 1 from 1", "push 1 to 1"],
                      cur_queueptr => 1, target_queueptr => 3 }],
};

my $command_seqs = {};
my $total_bits;
for my $command (sort keys %$interpreters) {
    my $goal = $interpreters->{$command};
    my $seq = find_command_sequence($goal);
    $total_bits += length($seq);
    print "$command:\t", $seq, " (", length($seq), ")\n";
    $command_seqs->{$command} = $seq;
}
print "Total bits: $total_bits\n\n";

for my $command (sort keys %$command_seqs) {
    my $seq = $command_seqs->{$command};
    print " Behaviour for $command ($seq):\n";
    my $start_queueptr = $command =~ /^[FGHIA]/ ? 1 : 3;
    my $traces = analyze_command_sequence({ commands => $seq, cur_queueptr => $start_queueptr });
    for my $trace (@$traces) {
        printf " %-12s", $trace->{wheelcommands};
        print "  [qptr: $start_queueptr -> ", $trace->{cur_queueptr}, "]  ",
            join "; ", $trace->{trace}->@*;
        print "\n";
    }
    print "\n";
}