 No such thing as a small change PerlMonks

### Efficient enumeration of pandigital fractions

by kikuchiyo (Friar)
 on Jul 20, 2018 at 20:51 UTC Need Help??

kikuchiyo has asked for the wisdom of the Perl Monks concerning the following question:

The fraction 6952 / 1738 has a curious property: each non-zero 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 semi-brute force solution to answer this question:

restate the problem as abcd = efgh * i, generate all 5-element variations (k-permutations) 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 base-14 solutions, more than 3 minutes for base-16, 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?

Replies are listed 'Best First'.
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 * (n-1) 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 n-system 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 k-permutations.

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
[download]```

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

in hindsight, in an implementation I'd

• prepare multiplication tables of the chosen i with all remaining digits
• use sieves to find remaining digits, multiplication and summing results
• realize these different sieves as bit strings. like \$remaining = vec(100100100) would represent only 3,6 and 9 as remaining possibilities
• obviously you must bound if \$remaining is 0
• sieves as bit strings allow effective filtering of sets by and operations.
• applying a sieve to a carry would just mean shifting the string

==== for instance if you decide to go from left to right left with \$i=4

i * efgh = abcd

the multiplication table would look like

```  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
[download]```

```#                                 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)
[download]```

( 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 bit-strings
• these operations happen in "parallel", they sieve on all set-members
• this scales well for higher bases, you can still handle a 33-base in a 32-bit 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

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, base-2 and base-1 (and possibly others are excluded for certain bases).

> doesn't mean that i < n/2, it's e

yeah I noticed. :)

> i can't be 1, base/2, base-2 and base-1

Why not base-2 ... could you elaborate?

8 * 12.. = 96.. base-10 ?

Cheers Rolf
(addicted to the Perl Programming Language :)
Wikisyntax for the Monastery FootballPerl is like chess, only without the dice

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..\$base-1];
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";
[download]```
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.
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*i-a)*10^3 + (f*i-b)*10^2 + (g*i-c)*10^1 + (h*i-d)*10^0 = 0

for the above to have a chance to be zero:
1)
((h*i-d) * 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*i-d) * 10^0 )
must also end in zeros as follows:
cum-sum at pos J=1 must end in 00
cum-sum 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:
cum-sum at pos J+1 >= 100
cum-sum at pos J+2 >= 1000
etc.
[download]```

As an example, for the fraction: 6952 / 1738 = 4 it is true that:

```   (8*4-2)*10^0=30
...     (ends in 0),

((8*4-2)*10^0+(3*4-5)*10^1)=100
...     (ends in 00 and is not less than 10^2)

((8*4-2)*10^0+(3*4-5)*10^1+(7*4-9)*10^2)=2000
...     (ends in 00 and is not less than 10^3)

etc.
[download]```

For base-10 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).

Re: Efficient enumeration of pandigital fractions
by LanX (Cardinal) on Jul 21, 2018 at 19:27 UTC
The following is an example of a branch and bound approach.

NB: Just a hack as a proof of concept, without taking advantage of the optimization ideas I've already described.

Nevertheless it calculates:

```
====== 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
[download]```

```use strict;
use warnings;
use Data::Dump qw/pp dd/;
use feature 'say';

my \$base= 16;
my \$verbose = 0 ;

my @digits = 0 .. \$base-1;

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;
}
}
[download]```

Update: code reformat.

Cheers Rolf
(addicted to the Perl Programming Language :)
Wikisyntax for the Monastery FootballPerl is like chess, only without the dice

Re: Efficient enumeration of pandigital fractions
by LanX (Cardinal) on Jul 21, 2018 at 17:25 UTC
FWIW

a brute force for the decimal case

```  DB<34> sub dig { my @res= reverse split //,\$_; 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..\$d-1], @p[0..
+\$d]); next if \$p; 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
[download]```

Cheers Rolf
(addicted to the Perl Programming Language :)
Wikisyntax for the Monastery FootballPerl is like chess, only without the dice

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

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

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 :)

> 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 base-20 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 ...

Log In?
 Username: Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://1218964]
Approved by marto
Front-paged by marto
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others perusing the Monastery: (5)
As of 2021-04-19 22:55 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?

No recent polls found

Notices?