Perl Weekly Challenge 195.

My solutions (task 1 and task 2 ) to the The Weekly Challenge - 195.

Task 1: Special Integers

Submitted by: Mohammad S Anwar
You are given a positive integer, $n > 0.

Write a script to print the count of all special integers between 1 and $n.

An integer is special when all of its digits are unique.

Example 1:
Input: $n = 15
Output: 14 as except 11 all other integers between 1 and 15 are special.
Example 2:
Input: $n = 35
Output: 32 as except 11, 22, 33 all others are special.

For small numbers n the solution is simple. I generate all numbers, discard non-specials using a regular expression and count the remaining ones. This yields a oneliner

perl -E 'say "$_->", 0+grep {!/^.*(\d).*\1.*$/} (1..$_) for(@ARGV);' 15 35 10000000

Results:

15->14
35->32
10000000->712890

For 10000000 it took about 7s in my laptop and it grows approximately linearly.

For larger inputs I’d rather compute than enumerate the special numbers. Take, for example, the case n=3748. I can divide the problem as follows:

  1. I first count special numbers from 1 to 9 (9),
  2. then 10 to 99 (9×9!/(9-1)!=9*9=81),
  3. from 100 to 999 (9×9!/(9-2)!=9×9×8=648), that is, 648+81+9=738.
  4. from 1000 to 1999 (9!/(9-3)!=9×8×7=504)
  5. from 2000 to 2999 (another 504, that is 2×504+738=1746),
  6. from 3000 to 3099 ((9-1)!/(9-3)!=8×7=56),
  7. from 3100 to 3199, from 3200 to 3299, 3400 to 3499… 3600 to 3699 (56 each, 6×56=336, that is 336+1746=2082)
  8. from 3700 to 3709 (7),
  9. from 3710 to 3719 (another 7),
  10. from 3720 to 3729 (another 7),
  11. skip from 3730 to 3739 (that is 3×7+2082=2103),
  12. from 3740 to 3748 (9-3=6, that is 6+2103=2109).

I can confirm the result with the simplist oneliner,

perl -E 'say "$_->", 0+grep {!/^.*(\d).*\1.*$/} (1..$_) for(@ARGV);' 3748

Results:

3748->2109

The corresponding full code follows:

 1  # Perl weekly challenge 195
 2  # Task 1:  Special Integers
 3  #
 4  # See https://wlmb.github.io/2022/12/12/PWC195/#task-1-special-integers
 5  use v5.36;
 6  use integer;
 7  use POSIX qw(lround);
 8  say(<<"FIN"), exit unless @ARGV;
 9  Usage: $0 N1 [N2...]
10  to get the number of special numbers between 1 and Ni
11  FIN
12  say "$_->", special($_) for @ARGV;
13  sub fact($n){ # factorial
14      my $r=1;
15      $r*=$_ for (1..$n);
16      $r
17  }
18  sub special($n){
19      my $k=0;
20      my $count=0;
21      while($k<=9 && 10**($k+1) < $n){
22          # Count from 1 to 9, then from 10 to 99, then from 100 to 999, etc.
23          $count += 9*fact(9)/fact(9-$k);
24          ++$k;
25      }
26      return $count if $k>9; # Nothing else to do eleven digit numbers or larger
27      #Count from 100.. to q00..-1
28      my $q=lround($n/10**$k);
29      $count += ($q-1)*fact(9)/fact(9-$k);
30      $count += final($q, $k-1, $n); # count from q00... upto $n=qxy...
31      return $count;
32  }
33  sub final($left, $power, $n){ # final approach from left 0 0 0 to n=x y z
34      my $count=0;
35      my $fixed=length $left; # leftward fixed digits
36      my %fixed;
37      ++$fixed{$_} for my @fixed=split '', $left; # actual fixed digits.
38      $_>1 && return 0 for(values %fixed); # nothing to add if fixed part is not special
39      return 1 if $power < 0; # Found last string
40      my $target=substr($n, $fixed, 1); # Next digit
41      for(0..$target-1){ # count upwards to target
42          next if $fixed{$_}; # skip seen digits
43          $count += fact(9-$fixed)/fact(9-$fixed-$power); # add rightwards contribution
44      }
45      $count += final($left.$target, $power-1, $n); # add digit to leftmost and recurse.
46      return $count;
47  }

Example:

./ch-1.pl 15 35 3748 10000000 1.0e9 1.0e10 1.0e11

Results:

15->14
35->32
3748->2109
10000000->712890

I got the expected results, but much faster. The run above took 0.018s in my laptop and the runtime is almost constant (repeating all the inputs only incremented it by 0.001s).

Task 2: Most Frequent Even

Submitted by: Mohammad S Anwar
You are given a list of numbers, @list.

Write a script to find most frequent even numbers in the list. In case you get more than
one even numbers then return the smallest even integer. For all other case, return -1.

Example 1
Input: @list = (1,1,2,6,2)
Output: 2 as there are only 2 even numbers 2 and 6 and of those 2 appears the most.
Example 2
Input: @list = (1,3,5,7)
Output: -1 since no even numbers found in the list
Example 3
Input: @list = (6,4,4,6,1)
Output: 4 since there are only two even numbers 4 and 6. They both appears the equal
number of times, so pick the smallest.

I can filter out even numbers, sort them and shift the most frequent or smaller in a single-liner

perl -E '$c{$_}++ for grep {!($_&1)} @ARGV; @e=sort {$c{$b} <=> $c{$a} || $a<=>$b} keys %c;
say join " ", @ARGV, " -> ", @e?shift @e:-1
' 1 1 2 6 2
perl -E '$c{$_}++ for grep {!($_&1)} @ARGV; @e=sort {$c{$b} <=> $c{$a} || $a<=>$b} keys %c;
say join " ", @ARGV, " -> ", @e?shift @e:-1
' 1 3 5 7
perl -E '$c{$_}++ for grep {!($_&1)} @ARGV; @e=sort {$c{$b} <=> $c{$a} || $a<=>$b} keys %c;
say join " ", @ARGV, " -> ", @e?shift @e:-1
' 6 4 4 6 1

Results:

1 1 2 6 2  ->  2
1 3 5 7  ->  -1
6 4 4 6 1  ->  4

The full code is almost identical

1  # Perl weekly challenge 195
2  # Task 2:  Most Frequent Even
3  #
4  # See https://wlmb.github.io/2022/12/12/PWC195/#task-2-most-frequent-even
5  use v5.36;
6  my %count;
7  $count{$_}++ for grep {!($_&1)} @ARGV; # Filter evens and count them
8  my @sorted=sort {$count{$b} <=> $count{$a} || $a<=>$b} keys %count;
9  say join " ", @ARGV, " -> ", @sorted?shift @sorted:-1

Example:

./ch-2.pl 1 1 2 6 2
./ch-2.pl 1 3 5 7
./ch-2.pl 6 4 4 6 1

Results:

1 1 2 6 2  ->  2
1 3 5 7  ->  -1
6 4 4 6 1  ->  4
Written on December 12, 2022