use strict;
use warnings;
use feature 'say';
use Data::Dump 'dd';
use Time::HiRes 'time';

my $N = 1000;

srand 123;
my @tokens = map { int rand 1_000_000 } 1 .. $N;

sub build_regex { 

#    return qr/\d+/;    # line A

    my $s = shift;
    my $d = substr $s, 0, 1;
    qr/[0-9]$d\d{0,9}?$d/ 
}

{                       # case 1
my $t = time;

my %result;
foreach my $token (@tokens)
{
    my $regex = build_regex($token);
    my @line_results = grep {$_ ne $token and /$regex/ }@tokens;
    $result{$token} = [@line_results];
}
say time - $t;
}

{                       # case 2
my $t = time;
my $count = 0;

my $sep = '~';
my $sep_len = length $sep;
my @idx;
for ( 0 .. $#tokens ) {
    my $L = length $tokens[ $_ ];
    @idx[ map{ $sep_len + @idx + $_ } 0 .. $L - 1 ] = ( $_ ) x $L
}
my $concat = join $sep, '', @tokens, '';

my %result;
for my $i ( 0 .. $#tokens ) {
    my $token = $tokens[ $i ];
    my $regex = build_regex( $token );
    
    $result{ $token } = [];

    my $prev = -1;
    while ( $concat =~ /$regex/g ) {    # block B
        my $j = $idx[ $-[ 0 ]];
        push @{ $result{ $token }}, $tokens[ $j ] 
            if $j != $i and $j != $prev;
        $prev = $j;
        $count ++;
    }
}

say time - $t;
say $count;
}


__END__

# Output with "A" line un-commented
0.978141069412231
1.23276996612549
1000000

# Output with "A" line commented-out
0.648768901824951
0.150562047958374
78176