In which count only what we must.

In Raku, Perl, and C {via Perl's Inline::C} .

(Still editing!)

TWC Task #1 - Special Integers

Task:

Count the integers that have no repeating digits, between 1 and $n.

Observations:

• This is the more time-consuming of the two tasks, in both CPU and programmer time.

• Since the largest number with all-unique digits is 9876543_210, any requested $n higher than that will have the same answer.

• Scanning every integer in the range will scale linearly, and since the largest input in in the 9 billions, we should look for a faster algorithm. The problem relates to combinations of individual digits, irrespective of their order, so something from combinatorics might be fruitful.

Perl

Using simple one-at-a-time iteration:

use v5.36;
use List::Util qw<uniq>;
sub task1 ( $n ) {
    return 0 + grep { length == uniq split '' } 1..$n;
}

I also could have said:

return 0 + grep !/(.).*\1/, 1..$n;

, which would have been faster, but less clear.

Also, for large $n, I observe that about 25% of the total time for perl to return control to my terminal happens after perl outputs the answer. I expect this is due to Perl not optimizing the scalar grep into a "count-only" version of itself, and so a huge list really is allocated and built by grep, which must be DESTROYed at END time. Recoding as something like /(.).*\1/ or $c++ for 1..$n recovered all that cleanup time.

C

This code takes 2m42s to calculate task1(9_876_543_210)==8_877_690 using one-at-a-time iteration. That is nearly 3 minutes, at full C speed; no bouncing between Perl and C is done except at start and end of a calculation.

use v5.36;
use Inline 'C';
# ... Testing code omitted here
__END__
__C__
int is_special(long x) {
    int ds[10];
    memset(ds, 0, 10*sizeof(int));
    while (x) {
        if (ds[x % 10]++)
            return 0;
        x /= 10;
    }
    return 1;
}
int count_special(long in) {
    long x = in > 9876543210 ? 9876543210 : in;
    int  r = 0;
    for ( ; x ; x-- ) {
        if ( is_special(x) )
            r++;
    }
    return r;
}

Raku

I have two versions that use combinatorics to solve the task. The first rips into the problem in two phases

(Ack! Must finish this explanation soon, but cannot right now.)

# https://oeis.org/A073531  Number of n-digit positive integers with all digits distinct.
constant @n-digits-distinct     = 0, 9, |( 9 X* [\*] (9...1) );
constant @n-digits-distinct-sum = [\+] @n-digits-distinct;

sub task1 ( UInt $n --> UInt ) {
    constant MAX = 9_876_543_210;
    return &?ROUTINE(MAX) if $n > MAX;

    # Knuth's "falling powers"; kfp(9,3) == 9*8*7
    sub kfp ($n, $k) { [*] ( ($n-$k) ^.. $n ) }

    my $nc = $n.chars;
    my @totals;

    push @totals, @n-digits-distinct-sum[$nc - 1];

    my SetHash $used;
    for $n.comb».Numeric.kv -> UInt $k, UInt $digit {

        my UInt $combinations_in_rightward_places
            = kfp(9 - $k, $nc - $k - 1);

        my Range $space_below_digit = (     0 + (1 if $k == 0   ))
                                   .. ($digit - (1 if $k < $nc-1));

        my Set $using_for_this_digit = $space_below_digit (-) $used;

        push @totals, $using_for_this_digit.elems
                    * $combinations_in_rightward_places;

        $used{$digit}++;
    }

    return @totals.sum;
}

This version is simpler to understand, but does not perform as well. It does the initial optimization to skip over about .log10 places, then generates all the combinations with the correct leading digit, filtering on which ones are less than $n.

sub task1_one_big_skip ( UInt $n --> UInt ) {
    constant MAX = 9_876_543_210;
    return &?ROUTINE(MAX) if $n > MAX;

    my @totals;
    my $lead  = $n.substr(0, 1);
    my $core  = $n.chars - 1;

    push @totals, @n-digits-distinct-sum[$core];

    push @totals, +combinations(9,$core) * ([*] 1..$core)
                                         * ($lead - 1);

    my $L3 = 0;
    for (0..9).grep(* != $lead).combinations($core) -> @comb {
        $L3 += +@comb.permutations.grep: { ($lead ~ .join) <= $n };
    }
    push @totals, $L3;

    return @totals.sum;
}

TWC Task #2 - Most Frequent Even

Task:

Given a @list of integers, find the most frequent even numbers in the list, with smallest of those most frequent as a tie-breaker. return -1 if no even numbers are in the list.

Raku

@ns.grep( * %% 2 ).Bag.max({ .value, -.key }).?key // -1 ;

Yes, the solution can be expressed in a single, um, expression.

The Bag counts the even numbers, giving a hash of key=originalnumber => value=countoftimesseen.

The .max method will receive Pair objects from the Bag, and find the maximum of each Pair's .value (the count), with negative (because we want the lowest in a .max) .key (original number) as tie-breaker.

Now we just need to return the .key of the Pair that .max found, or -1 if grep found no even numbers. But wait! .max returns -Inf when given a empty list; we cannot call .key on -Inf.

The .? methodop is the "Safe call operator". It works as ., but if the left-hand side lacks the requested method, it returns Nil, which is just what we need for // to trigger the -1 return.

Perl

use v5.36;
use List::Util    qw<min>;
use List::UtilsBy qw<max_by>;

sub task2 (@ns) {
    my %bag;
    $bag{$_}++ for grep { $_ % 2 == 0 } @ns;
    return -1 if not %bag;

    return min max_by { $bag{$_} } keys %bag;
}

Compared to the Raku code, having %bag as a separate variable does prevent a single-expression solution, but we gain clarity; returning -1 happens much sooner in the dataflow, and in a place that is simpler to read.

Also, because we can refer to the count via (less efficient) hash-lookup, and because Perl's max_by does return all the participants in a tie, we can feed in only the keys, so min is operating only on the keys.

With great pleasure, we announce Bruce Gray
as the next Champion of The Weekly Challenge.
-- TWC 194 Mohammad S Anwar

The thing about me that's so impressive
is how infrequently I mention all of my successes
-- Video "I'm So Humble" {The only song by The Lonely Island that is Safe For Work}.