sub pwc {
    my ( $from, $to, $target ) = @_;
    
    use integer;
    my @witnesses = ([ 4, 7 ], [ 2 .. 9 ]);

    my ( %pairs, $j );
    for ( my $i = ( $from + 2 ) / 3 * 3; $i <= $to; $i += 3 ) {
        my $i_key = join '', sort split '', $i;
        my $k = $i % 9 ? 0 : 1;
        
        for ( @{ $witnesses[ $k ]}) {
            last if length( $j = $i * $_ ) != length( $i );
            $pairs{ $i }{ $j } = $_
                unless $i_key ne join '', sort split '', $j
        }
        for ( @{ $witnesses[ $k ]}) {
            last if length( $j = $i / $_ ) != length( $i );
            $pairs{ $i }{ $j } = -$_
                unless $i % $_
                    || exists $pairs{ $j } && 
                       exists $pairs{ $j }{ $i }
                    || $i_key ne join '', sort split '', $j
        }
    }
    return scalar grep { %$_ >= $target } values %pairs
}


##</code><code>##

use Sort::Packed 'sort_packed';

sub pwc_p {
    my ( $from, $to, $target ) = @_;
    
    use integer;
    my @witnesses = ([ 4, 7 ], [ 2 .. 9 ]);
    
    my ( %pairs, $j );
    for ( my $i = ( $from + 2 ) / 3 * 3; $i <= $to; $i += 3 ) {
        sort_packed C => my $i_key = $i;
        my $k = $i % 9 ? 0 : 1;
        
        for ( @{ $witnesses[ $k ]}) {
            last if length( $j = $i * $_ ) != length( $i );
            sort_packed C => my $j_key = $j;
            $pairs{ $i }{ $j } = $_
                unless $i_key ne $j_key
        }
        for ( @{ $witnesses[ $k ]}) {
            last if length( $j = $i / $_ ) != length( $i );
            next if $i % $_;
            sort_packed C => my $j_key = $j;
            $pairs{ $i }{ $j } = -$_
                unless exists $pairs{ $j } && 
                       exists $pairs{ $j }{ $i }
                    || $i_key ne $j_key
        }
    }
    return scalar grep { %$_ >= $target } values %pairs
}


##</code><code>##

sub ugly {
    my ( $from, $to, $target ) = @_;
    
    use integer;
    my @witnesses = ([ 4, 7 ], [ 2 .. 9 ]);
    
    my ( %pairs, $j );
    for ( my $i = ( $from + 2 ) / 3 * 3; $i <= $to; $i += 3 ) {
        my $k = $i % 9 ? 0 : 1;
        
        for ( @{ $witnesses[ $k ]}) {
            last if length( $j = $i * $_ ) != length( $i );
            $pairs{ $i }{ $j } = $_
                unless $i =~ tr/12// != $j =~ tr/12//
                    || $i =~ tr/34// != $j =~ tr/34//
                    || $i =~ tr/56// != $j =~ tr/56//
                    || $i =~ tr/78// != $j =~ tr/78//
                    || $i =~ tr/9//  != $j =~ tr/9// 
                    || $i =~ tr/2//  != $j =~ tr/2// 
                    || $i =~ tr/4//  != $j =~ tr/4// 
                    || $i =~ tr/6//  != $j =~ tr/6// 
                    || $i =~ tr/8//  != $j =~ tr/8//
        }
        for ( @{ $witnesses[ $k ]}) {
            last if length( $j = $i / $_ ) != length( $i );
            $pairs{ $i }{ $j } = -$_
                unless $i % $_ 
                    || exists $pairs{ $j } && 
                       exists $pairs{ $j }{ $i }
                    || $i =~ tr/12// != $j =~ tr/12//
                    || $i =~ tr/34// != $j =~ tr/34//
                    || $i =~ tr/56// != $j =~ tr/56//
                    || $i =~ tr/78// != $j =~ tr/78//
                    || $i =~ tr/9//  != $j =~ tr/9// 
                    || $i =~ tr/2//  != $j =~ tr/2// 
                    || $i =~ tr/4//  != $j =~ tr/4// 
                    || $i =~ tr/6//  != $j =~ tr/6// 
                    || $i =~ tr/8//  != $j =~ tr/8//
        }
    }
    return scalar grep { %$_ >= $target } values %pairs
}


##</code><code>##

say "$^V / $Config{ archname } / $Config{ gccversion }";

cmpthese -3, {
    pwc   => sub { pwc( 1500, 2500, 1 )},
    pwc_p => sub { pwc_p( 1500, 2500, 1 )},
    ugly  => sub { ugly( 1500, 2500, 1 )},
};

# v5.32.1 / MSWin32-x64-multi-thread / 8.3.0
#         Rate   pwc pwc_p  ugly
# pwc    737/s    --  -48%  -77%
# pwc_p 1424/s   93%    --  -56%
# ugly  3251/s  341%  128%    --


##</code><code>##

  "2490" => { 4920 => 2, 9240 => 4 },
  "3b10" => { "13b0" => -3, "b130" => 3 },


##</code><code>##

sub pwc_px {
    my ( $from, $to, $target ) = @_;
    
    use integer;
#                     0  1  2  3  4  5  6  7  8  9 10 11 12 13 14
    my @adjust  = qw/ 0  2  1  0  1  0  0  2  1  0  0  1  0  2  1 /;
    $from += $adjust[ $from % 15 ];

    my @witnesses = ([ 6, 11 ], [ 4, 7, 10, 13 ], [ 2 .. 15 ]);

    my ( %pairs, $jx );
    for my $i ( $from .. $to ) {
        next if $i % 3 and $i % 5;

        my $k = $i % 15 ? $i % 5 ? 0 : 1 : 2;
        
        my $ix = sprintf '%x', $i;
        sort_packed C => my $i_key = $ix;
        for ( @{ $witnesses[ $k ]}) {
            $jx = sprintf '%x', $i * $_;
            last if length( $jx ) != length( $ix );
            sort_packed C => my $j_key = $jx;
            $pairs{ $ix }{ $jx } = $_ 
                unless $i_key ne $j_key
        }
        for ( @{ $witnesses[ $k ]}) {
            $jx = sprintf '%x', $i / $_;
            last if length( $jx ) != length( $ix );
            next if $i % $_;
            sort_packed C => my $j_key = $jx;
            $pairs{ $ix }{ $jx } = -$_
                unless exists $pairs{ $jx } && 
                       exists $pairs{ $jx }{ $ix }
                    || $i_key ne $j_key
        }
    }
    return scalar grep { %$_ >= $target } values %pairs
}

sub ugly_x {
    my ( $from, $to, $target ) = @_;
    
    use integer;
#                     0  1  2  3  4  5  6  7  8  9 10 11 12 13 14
    my @adjust  = qw/ 0  2  1  0  1  0  0  2  1  0  0  1  0  2  1 /;
    $from += $adjust[ $from % 15 ];

    my @witnesses = ([ 6, 11 ], [ 4, 7, 10, 13 ], [ 2 .. 15 ]);

    my ( %pairs, $jx );
    for my $i ( $from .. $to ) {
        next if $i % 3 and $i % 5;
        
        my $k = $i % 15 ? $i % 5 ? 0 : 1 : 2;
        
        my $ix = sprintf '%x', $i;
        for ( @{ $witnesses[ $k ]}) {
            $jx = sprintf '%x', $i * $_;
            last if length( $jx ) != length( $ix );
            $pairs{ $ix }{ $jx } = $_
                unless $ix =~ tr/1// != $jx =~ tr/1//
                    || $ix =~ tr/2// != $jx =~ tr/2//
                    || $ix =~ tr/3// != $jx =~ tr/3//
                    || $ix =~ tr/4// != $jx =~ tr/4//
                    || $ix =~ tr/5// != $jx =~ tr/5//
                    || $ix =~ tr/6// != $jx =~ tr/6//
                    || $ix =~ tr/7// != $jx =~ tr/7//
                    || $ix =~ tr/8// != $jx =~ tr/8//
                    || $ix =~ tr/9// != $jx =~ tr/9//
                    || $ix =~ tr/a// != $jx =~ tr/a//
                    || $ix =~ tr/b// != $jx =~ tr/b//
                    || $ix =~ tr/c// != $jx =~ tr/c//
                    || $ix =~ tr/d// != $jx =~ tr/d//
                    || $ix =~ tr/e// != $jx =~ tr/e//
                    || $ix =~ tr/f// != $jx =~ tr/f//
        }
        for ( @{ $witnesses[ $k ]}) {
            $jx = sprintf '%x', $i / $_;
            last if length( $jx ) != length( $ix );
            $pairs{ $ix }{ $jx } = -$_
                unless $i % $_ 
                    || exists $pairs{ $jx } && 
                       exists $pairs{ $jx }{ $ix }
                    || $ix =~ tr/1// != $jx =~ tr/1//
                    || $ix =~ tr/2// != $jx =~ tr/2//
                    || $ix =~ tr/3// != $jx =~ tr/3//
                    || $ix =~ tr/4// != $jx =~ tr/4//
                    || $ix =~ tr/5// != $jx =~ tr/5//
                    || $ix =~ tr/6// != $jx =~ tr/6//
                    || $ix =~ tr/7// != $jx =~ tr/7//
                    || $ix =~ tr/8// != $jx =~ tr/8//
                    || $ix =~ tr/9// != $jx =~ tr/9//
                    || $ix =~ tr/a// != $jx =~ tr/a//
                    || $ix =~ tr/b// != $jx =~ tr/b//
                    || $ix =~ tr/c// != $jx =~ tr/c//
                    || $ix =~ tr/d// != $jx =~ tr/d//
                    || $ix =~ tr/e// != $jx =~ tr/e//
                    || $ix =~ tr/f// != $jx =~ tr/f//
        }
    }
    return scalar grep { %$_ >= $target } values %pairs
}


cmpthese -3, {
    pwc_px => sub { pwc_px( 0x1DEA, 0xC0DE, 2 )},
    ugly_x => sub { ugly_x( 0x1DEA, 0xC0DE, 2 )},
};

#          Rate pwc_px ugly_x
# pwc_px 23.1/s     --   -38%
# ugly_x 37.2/s    61%     --


##</code><code>##

@witnesses = ([ 8, 15, 22, 29 ], [ 6, 11, 16, 21, 26, 31 ], [ 2 .. 35 ]);

##</code><code>##

{
  j376 => { "36j7" => -6 },
  j736 => { "376j" => -6 },
  k03c => { "3c0k" => -6 },
  k12c => { "1c2k" => -15 },
  k3c0 => { "3ck0" => -6 },
  lm3o => { "3lom" => -6 },
  m3lo => { "3olm" => -6 },
  n174 => { "17n4" => -19 },
  n840 => { "4n80" => -5 },
  nbco => { bnoc => -2 },
  o029 => { "2o09" => -9 },
  o290 => { "2o90" => -9 },
  o4dt => { "4tod" => -5 },
  onbc => { cbno => -2 },
  p046 => { "460p" => -6 },
  p460 => { "46p0" => -6 },
  pb6s => { "6bsp" => -4 },
}

***
          Rate pwc_p36 ugly_36
pwc_p36 2.02/s      --    -14%
ugly_36 2.36/s     17%      --