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
}