my @seqlen = (-1,1);    # Memoize sequence length
my $top    = 20;        # Report this many of the top sequences
my @top    = [ -1,-1 ]; # Top $top sequences
my $upper  = 1e6;       # Upper limit starting term
my $mintop = 0;         # Lowest value in @top

GetOptions('top=i' => \$top, 'upper=i' => \$upper);

##</code><code>##

for (my $start = 3; $start < $upper; $start += 2) {
    my ($n, $len) = ($start, 0);
    while (! defined $seqlen[$n]) {
        $len += 1 + $n % 2;
        $n = $n % 2 ? (3*$n + 1)/2 : $n / 2;
    }
    $len += $seqlen[$n];
    $seqlen[$start] = $len if $start < $upper * 2; # Cache
    top($start => $len)            if $len > $mintop  and     $start <= $upper;
    top($n * 2 => $seqlen[$n] + 1) if   $n < $upper/2 and $seqlen[$n] > $mintop;
}

##</code><code>##

sub top {
    my ($n, $len) = @_;

    my $idx = first { $top[$_][1] < $len } 0..$#top;
    splice @top, $idx, 0, [ $n, $len ];

    pop @top if @top > $top;
    $mintop = $top[-1][1];
}

##</code><code>##

real    0m0.848s
user    0m0.835s
sys     0m0.012s