kikuchiyo has asked for the wisdom of the Perl Monks concerning the following question:
The fraction 6952 / 1738 has a curious property: each nonzero decimal digit appears exactly once in the expression, and the result of the divison happens to be the missing digit, 4.
Are there, by any chance, other fractions that share this property? It is fairly simple to devise a semibrute force solution to answer this question:
restate the problem as abcd = efgh * i, generate all 5element variations (kpermutations) of the set of digits 1..9, perform the multiplication and check that the result consists only of digits not in the sequence.
Here is a somewhat optimized implementation:
For base 10 this runs quickly enough to find that there is one additional solution.
But for the obvious and straightforward generalization to higher bases this brute force solution is not going to cut it.
Tinkering with the innards of the loop or using a different permutation engine might give us a speedup factor of two, while rewriting the whole thing in C might give us two orders of magnitudes. But we'd be still generating all permutations, and the number of those grows relentlessly as the base increases ((b  1)! / (b/2  1)!):
6 60
8 840
10 15120
12 332640
14 8648640
16 259459200
18 8821612800
20 335221286400
On my machine the program above needed 6 seconds to find all base14 solutions, more than 3 minutes for base16, and I dared not run it with higher bases.
However, the number of actual solutions is much smaller:
6 1
8 2
10 2
12 18
14 136
16 188
which suggests that there may be better, more efficient approaches that don't have to trudge through a lot of useless permutations to find the solutions. However, so far I haven't been able to find one.
Any thoughts?
Re: Efficient enumeration of pandigital fractions
by LanX (Cardinal) on Jul 21, 2018 at 01:12 UTC

I'd try a branch and bound, starting with i and trying out values for the digits of the other multiplicand from right to left.
Each digit to the right determines another one to the left.
Whenever a digit gets repeated you bound.
Taking your decimal case:
> abcd = efgh * i
 Starting with i=1 and h=1 is obviously impossible.
 i * efgh = abcd
 2 * efg3 = abc6
 2 * ef13 = ab26 2 repeated bound °
 2 * ef43 = ab86
 2 * e543 = (1)086 0 forbidden bound! ²
 2 * e743 = (1)486 4 repeated bound!
 2 * e943 = (1)886 8 repeated bound!
 2 * ef53 = a(1)06 0 forbidden bound! ²
 2 * ef73 = a(1)46
 2 * e173 = a346 3 repeated bound
 2 * e573 = (1)146
 2 * 8573 = (1)6146 too many digits bound ³
 2 * 9573 = (1)8146 too many digits bound ³
 2 * ef83 = a(1)66 6 repeated bound!
 2 * ef93 = a(1)86
 and so on
°) obviously you can only use 1 when the last multiplication had a carry digit (denoted in brackets)
²) multiplying an even number with 5 will always lead to 0 and multiplying an even number with 6 will always repeat that number
³) the last multiplication in a system with even numbered digits can't have a carry digit
I did this by hand to find some rules to effectively cut down the possibilities of a branch and bound.
Rule 2 means you'll can eliminate all n * (n1) possibilities where the product repeats one of the factors or lead to 0. For instance in a decimal system i can't possibly ever be 5 or 6.
(just prepare a multiplication table for an nsystem to eliminate these cases)
Footnote °) is just a special case of rule 2
Rule 3 means anything i must be < n/2 for n even like the decimal with n=10) and i >= n/2 for n odd.
That is in the decimal case i can only be 2, 3 or 4
These are massive reductions of all possibilities, far more efficient than calculating all kpermutations.
I'm only wondering if it's more efficient to start trying from right to left starting with h or even from left to right starting with e or even combining both possibilities.
for instance these are the only possible combinations of i and e for n=10
DB<4> for $i (2,3,4) { for $e (1..9) { next if $e == $i or $e*$i >9
+; print "$i * $e = ", $i *$e,"\n" }}
2 * 1 = 2 #
2 * 3 = 6
2 * 4 = 8
3 * 1 = 3 #
3 * 2 = 6
4 * 1 = 4 #
4 * 2 = 8
And the cases I marked with a # mean that the value for f must lead to a carry digit to alter a.
This seems to reduce possible branches very quickly!!!
I hope I gave you some good ideas for the case n=10 which can be generalized for bigger n.
Cheers Rolf
_{(addicted to the Perl Programming Language :)
Wikisyntax for the Monastery
FootballPerl is like chess, only without the dice
}
 [reply] [d/l] [select] 

DB<14> $i=4; for $x (1..9) { next if $x==$i; $p = $i*$x; $C=int($p/1
+0); $S=$p%10; print "$i * $x = $p \t$C $S\n" }
4 * 1 = 4 0 4
4 * 2 = 8 0 8
4 * 3 = 12 1 2
4 * 5 = 20 2 0
4 * 6 = 24 2 4
4 * 7 = 28 2 8
4 * 8 = 32 3 2
4 * 9 = 36 3 6
# 987654321
@carry0 = (1,2) , $carry0 = vec(11)
@carry1 = (3) , $carry1 = vec(0100)
@carry2 = (5,6,7) , $carry2 = vec(1110000)
@carry3 = (8,9) , $carry3 = vec(110000000)
( update when going from left to right you have to also put 7 into @carry3, because 28 could add to a former carry. going from right to left is indeed easier ...)
==== after trying $e=1 you know that
@remaing=(2,3,5,6,7,8,9) => $remaining = vec(111110110)
$a = $i*$e + carry(4*f) = 4*1 + range(0..3)
the carry range filter for 0..3 is vec(1111) shifted accordingly for 4 is $carryrange=vec(1111000)
$remaining & $carryrange = vec(1110000) => possible $a are in (5,6,7)
=> carry=0 is (obviously) forbidden
$remaining & ($carry1  $carry2  $carry3) = vec(111110100)
=> possible $f are in (9,8,7,6,5,3)
using this approach has several advantages
 set operations cut down possible branches before they happen (NB: sub calls are expensive in Perl)
 set operations as bit string operations are very fast
 after preparing the multiplication table, you'll practically never need to add or multiply any more, all operations happen as "shifts", "ands" and "ors" on bitstrings
 these operations happen in "parallel", they sieve on all setmembers
 this scales well for higher bases, you can still handle a 33base in a 32bit integer (I doubt you want to go higher)
 you can generalize this approach for similar problems (integer fraction puzzles)
this approach will lead to a very efficient branch and bound already, I'm confident you can find even more "filter rules" to bound more efficiently.
Cheers Rolf
_{(addicted to the Perl Programming Language :)
Wikisyntax for the Monastery
FootballPerl is like chess, only without the dice
}
 [reply] [d/l] [select] 

Thanks!
Nice ideas here and elsewhere!
One nitpick: your rule 3 (that the last multiplication can't have a carry so that the numerator is base/2  1 digits long) doesn't mean that i < n/2, it's e (the first digit of the denominator) that has to be < n/2. i can't be 1, base/2, base2 and base1 (and possibly others are excluded for certain bases).
 [reply] [d/l] [select] 

> doesn't mean that i < n/2, it's e
yeah I noticed. :)
> i can't be 1, base/2, base2 and base1
Why not base2 ... could you elaborate?
8 * 12.. = 96.. base10 ?
Cheers Rolf
_{(addicted to the Perl Programming Language :)
Wikisyntax for the Monastery
FootballPerl is like chess, only without the dice
}
 [reply] [d/l] 

Re: Efficient enumeration of pandigital fractions
by tybalt89 (Prior) on Jul 20, 2018 at 23:20 UTC

Here's a first pass at it.
It does partial math (same number of digits on both sides) to
cut off further consideration because of duplicates or 0.
It does base 18 in under 3 minutes.
#!/usr/bin/perl l
# https://perlmonks.org/?node_id=1218964
use strict;
use warnings;
use POSIX;
my $base = shift // 10;
my @numbers = (0..9, 'a'..'z')[0..$base1];
my $numberlength = $base  1 >> 1;
my $pattern = '' x $numberlength . '=' . '' x $numberlength . '*';
sub inbase
{
my ($n, $b) = @_;
my $ans = '';
while($n > 0)
{
$ans = $numbers[$n % $b] . $ans;
$n = int $n / $base;
}
$ans  0;
}
# dddd=dddd*d # for base 10
my $solutions = my $count = 0;
my @queue = map "$pattern$_", @numbers[2..$#numbers];
while( @queue )
{
$count++;
$_ = shift @queue;
/(\w).*\1/ and next;
if( !/.*=.*\K/ )
{
print;
$solutions++;
next;
}
my ($before, $after) = ($`, $');
my $mul = POSIX::strtol( substr( $after, 1 ), $base );
for my $d ( @numbers[1..$#numbers] )
{
$_ =~ $d and next;
my $new = "$before$d$after";
$new =~ /=*(\w+)/ or next;;
my $len = length $1;
my $prod = POSIX::strtol( $1, $base ) * $mul;
my $baseprod = inbase( $prod, $base );
length $baseprod > $numberlength and next;
substr $new, $numberlength  $len, $len, substr $baseprod, $len;
$new =~ /0(\w).*\1/ and next;
push @queue, $new;
}
}
print "\nsteps $count solutions $solutions";
 [reply] [d/l] 

Thanks, nice, perlish solution! I didn't really know about \K, and I guess I have a blind spot about $', $`, perhaps because the documentation makes (made?) a good job of dissuading anyone from using them.
 [reply] [d/l] [select] 
Re: Efficient enumeration of pandigital fractions
by bliako (Prior) on Jul 21, 2018 at 02:15 UTC

... restate the problem as abcd = efgh * i
this can go a bit further:
abcd = efgh * i
a * 10^3 + b * 10^2 + c * 10^1 + d * 10^0 =
(e * 10^3 + f * 10^2 + g * 10^1 + h * 10^0) * i
=> (e*ia)*10^3 + (f*ib)*10^2 + (g*ic)*10^1 + (h*id)*10^0 = 0
for the above to have a chance to be zero:
1)
((h*id) * 10^0) % 10^1 = 0 (e.g. must end in 0)
2)
The cumulative sum of the above at position J,
(i.e. from right to left, J=0 for the term (h*id) * 10^0 )
must also end in zeros as follows:
cumsum at pos J=1 must end in 00
cumsum at pos J=2 must end in 000
etc.
3)
The cumulative sum of the above at position J,
from right to left must also not be less than:
cumsum at pos J+1 >= 100
cumsum at pos J+2 >= 1000
etc.
As an example, for the fraction: 6952 / 1738 = 4 it is true that:
(8*42)*10^0=30
... (ends in 0),
((8*42)*10^0+(3*45)*10^1)=100
... (ends in 00 and is not less than 10^2)
((8*42)*10^0+(3*45)*10^1+(7*49)*10^2)=2000
... (ends in 00 and is not less than 10^3)
etc.
For base10 the first rule skips 90% of the cases. And each subsequent rule 90% of the remaining. E.g. 362880 total cases > 25920 > 2880 (I used permutations and took the pivot as the missing digit. That can perhaps get better).
 [reply] [d/l] [select] 
Re: Efficient enumeration of pandigital fractions
by LanX (Cardinal) on Jul 21, 2018 at 19:27 UTC

====== Calculating base 12
*** Results 18
took: 0 sec
====== Calculating base 14
*** Results 136
took: 0 sec
====== Calculating base 16
*** Results 188
took: 1 sec
====== Calculating base 18
*** Results 7478
took: 5 sec
====== Calculating base 20
*** Results 41984
took: 49 sec
use strict;
use warnings;
use Data::Dump qw/pp dd/;
use feature 'say';
my $base= 16;
my $verbose = 0 ;
my @digits = 0 .. $base1;
my %allowed;
@allowed{@digits} = (1)x@digits;
delete $allowed{0};
#pp \%allowed;
our $i;
our $carry;
our $level;
our @factor;
our @product;
our @result;
warn "====== Calculating base $base\n";
my $start =time;
for $i ( reverse 2 .. $base 1 ) {
delete $allowed{$i} ;
warn "=== \$i = $i\n" if $verbose;
$carry = 0;
$level=0;
branch();
$allowed{$i}=1;
}
say "*** Results ", scalar @result;
say "took: ", time$start , " sec";
sub branch {
#say pp \%allowed unless $level;
local $level = $level+1;
for my $f ( sort keys %allowed ) {
my $p = $i *$f + $carry;
my $digit = $p % $base;
local $carry = int ($p / $base);
next if $digit == $f;
next unless $allowed{$digit};
unshift @factor,$f;
unshift @product,$digit
;
warn " " x $level,
"Level$level <$f>: $i * @factor = @product with <$carry $d
+igit> remain ", (sort keys %allowed) ,
"\n" if $verbose > 2;
delete $allowed{$f};
delete $allowed{$digit};
if (keys %allowed) {
branch()
} elsif (! $carry) {
warn "" x $level, "RESULT Level$level: $i * @factor = @
+product with <$carry $digit> remain ", (sort keys %allowed) , "\n" i
+f $verbose >1;
push @result, [ $i, [@factor], [@product]];
}
$allowed{$f} = 1 ;
$allowed{$digit} = 1 ;
shift @factor;
shift @product;
}
}
Update: code reformat.
Cheers Rolf
_{(addicted to the Perl Programming Language :)
Wikisyntax for the Monastery
FootballPerl is like chess, only without the dice
}
 [reply] [d/l] [select] 
Re: Efficient enumeration of pandigital fractions
by LanX (Cardinal) on Jul 21, 2018 at 17:25 UTC

DB<34> sub dig { my @res= reverse split //,$_[0]; return @res,(0) x
+4}
DB<35> sub repeat { my %h; @h{@_}=(); return 1 if @_ > keys %h }
DB<36> $d=4; $c=0; for $i (2..4) { for $x (1..10**$d) { $p = $i*$x+$
+c ; @x = dig($x); @p = dig($p); next if repeat($i,@x[0..$d1], @p[0..
+$d]); next if $p[4]; print "($i * $x) + $c = $p \t $i \t @x[3,2,1,0]
+\t@p[4,3,2,1,0]\n" }}
(4 * 1738) + 0 = 6952 4 1 7 3 8 0 6 9 5 2
(4 * 1963) + 0 = 7852 4 1 9 6 3 0 7 8 5 2
Cheers Rolf
_{(addicted to the Perl Programming Language :)
Wikisyntax for the Monastery
FootballPerl is like chess, only without the dice
}
 [reply] [d/l] 
Re: Efficient enumeration of pandigital fractions
by QM (Parson) on Jul 23, 2018 at 13:58 UTC

Just wondering if generating the candidate factors by digital sums is helpful?
QM

Quantum Mechanics: The dreams stuff is made of
 [reply] 
Re: Efficient enumeration of pandigital fractions
by LanX (Cardinal) on Jul 22, 2018 at 19:15 UTC

> Any thoughts?
Do you need more? :)
Cheers Rolf
_{(addicted to the Perl Programming Language :)
Wikisyntax for the Monastery
FootballPerl is like chess, only without the dice
}
 [reply] 

No, I'm satisfied for the time being :)
(I see that I've nerd sniped (xkcd://356) you quite effectively with this problem, so my work is done here :)
 [reply] 

> I see that I've nerd sniped you quite effectively
he, he ... you earned 3 points.
And actually I'm clever enough to resist implementing an algorithm which solves base20 in way under 1 sec ...*
Cheers Rolf
_{(addicted to the Perl Programming Language :)
Wikisyntax for the Monastery
FootballPerl is like chess, only without the dice
}
*) definitely .. I won't ... I swear ... never ...
 [reply] 



