{ my @stack = (); my @origin = (); my $n = 0; my $depth = 0; sub nexta { while (@stack < 10) { $n++; foreach my $p (1..length($n)) { my $d = substr($n, $p-1, 1); while ($#stack >= 1 && $stack[$#stack-1]%2 == $d%2) { pop @stack; pop @origin; } push @stack => $d; push @origin => $n; } } my $a = shift @stack; my $origin = shift @origin; $depth++; return ($a, $origin); } } my $current = 0; my $length = 0; my $n = 0; while ($n < 1_000) { my ($a, $origin) = nexta(); if ($current==$origin) { $length++; } else { if (length($current)==$length) { $n++; print "$n $current\n"; } $current = $origin; $length = 1; } }