SpaceChem Loop Calculator

#!/usr/bin/perl -w

use strict;

my $MAXF = $ARGV[0] ? int $ARGV[0] : 7;
$MAXF = 7 unless $MAXF;

package Loop;

sub new {
    my $class = shift;
    $class = ref $class if ref $class;
    my @t = @_;

    for my $i (0..$#t) {
        die sprintf "Invalid index: %d at %d\n", $t[$i], $i + 1
            unless $t[$i] <= $i;
    }

    my $obj = \@t;
    bless $obj, $class
}

sub str {
    my $obj = shift;
    sprintf '[%s]', (join ', ', @$obj)
}

sub len {
    my $obj = shift;
    @$obj
}

sub period {
    my $obj = shift;
    my @t = @$obj;
    my @s = map { 0 } 0..$#t;
    my $n = 1;
    my $c = 0;

    while (1) {
        if ($s[$c]) {
            $s[$c] = 0;
            last if ++$c == @t;
        } else {
            $s[$c] = 1;
            my $v = $t[$c];
            if ($v) {
                $c = $v - 1;
            } else {
                $n++;
                $c = 0;
            }
        }
    }

    $n
}

package main;

sub expls(@) {
    my @pls = @_;
    return ([0]) unless @pls;
    my $cf = @{$pls[$#pls]};
    my @els = grep { @$_ == $cf } @pls;

    for my $l (@els) {
        for my $n (0..$cf) {
            push @pls, [ @$l, $n ]
        }
    }

    @pls
}

sub mkls($) {
    my $maxf = shift;
    my @ls;

    @ls = expls @ls for 1..$maxf;

    map { Loop->new(@$_) } @ls
}

my @ls = mkls $MAXF;

my %mloop;

my $len = 1;
for my $l (@ls) {
    $len = $l->len, print "\n" if $l->len != $len;
    my $p = $l->period;
    printf "%s = %d\n", $l->str, $p;
    $mloop{$p} = $l->str unless exists $mloop{$p};
}

print "\n\n";

printf "%d = %s\n", $_, $mloop{$_} for sort {$a <=> $b} keys %mloop;

1;