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%     --