Permuted multiples

Permuted multiples is a draft programming task. It is not yet considered ready to be promoted as a complete task, for reasons that should be found in its talk page.

Attribution

The following task is taken from Project Euler.

Task

Find the smallest positive integer n such that, when expressed in decimal, 2*n, 3*n, 4*n, 5*n, and 6*n contain exactly the same digits but in a different order.

Factor

Library: Factor-numspec

Works with: Factor version 0.99 2021-06-02

<lang factor>USING: formatting io kernel lists lists.lazy math math.ranges math.vectors numspec present prettyprint sequences sets ;

multiples ( n -- seq )

   [ 2 * ] [ 6 * ] [ ] tri <range> [ present ] map ;

all-set-eq? ( seq -- ? )

   dup ?first [ set= ] curry all? ;

! Ordered lazy list of numbers that start with a '1' digit NUMSPEC: starting-with-one 1 1_ ... ;

smallest-permuted-multiple ( -- n )

   starting-with-one [ multiples all-set-eq? ] lfilter car ;

{ 2 3 4 5 6 } " n: " write smallest-permuted-multiple dup . over n*v [ "×%d: %d\n" printf ] 2each</lang>

Output:

 n: 142857
×2: 285714
×3: 428571
×4: 571428
×5: 714285
×6: 857142

Go

Translation of: Wren

Library: Go-rcu

<lang go>package main

import (

   "fmt"
   "rcu"
   "sort"

)

// assumes l1 is sorted but l2 is not func areSame(l1, l2 []int) bool {

   if len(l1) != len(l2) {
       return false
   }
   sort.Ints(l2)
   for i := 0; i < len(l1); i++ {
       if l1[i] != l2[i] {
           return false
       }
   }
   return true

}

func main() {

   i := 100 // clearly a 1 or 2 digit number is impossible
   nextPow := 1000
   for {
       digits := rcu.Digits(i, 10)
       if digits[0] != 1 {
           i = nextPow
           nextPow *= 10
           continue
       }
       sort.Ints(digits)
       allSame := true
       for j := 2; j <= 6; j++ {
           digits2 := rcu.Digits(i*j, 10)
           if !areSame(digits, digits2) {
               allSame = false
               break
           }
       }
       if allSame {
           fmt.Println("The smallest positive integer n for which the following")
           fmt.Println("multiples contain exactly the same digits is:")
           fmt.Println("    n =", i)
           for k := 2; k <= 6; k++ {
               fmt.Printf("%d x n = %d\n", k, k*i)
           }
           return
       }
       i = i + 1
   }

}</lang>

Output:

The smallest positive integer n for which the following
multiples contain exactly the same digits is:
    n = 142857
2 x n = 285714
3 x n = 428571
4 x n = 571428
5 x n = 714285
6 x n = 857142

Julia

<lang julia>n = minimum([n for n in 1:500000 if sort(digits(2n)) == sort(digits(3n)) == sort(digits(4n)) == sort(digits(5n))]) println("n: $n, 2n: $(2n), 3n: $(3n), 4n: $(4n), 5n: $(5n)")

</lang>

Output:

n: 142857, 2n: 285714, 3n: 428571, 4n: 571428, 5n: 714285

Nim

Searching among multiples of 3 between 102 and 1_000 div 6, 1_002 and 10_000 div 6, 10_002 and 100_000 div 6, etc. (see discussion).

<lang Nim>from algorithm import sorted

func search(): int =

 var start = 100
 while true:
   for i in countup(start + 2, 10 * start div 6, 3):
     let digits = sorted($i)
     block check:
       for j in 2..6:
         if sorted($(i * j)) != digits:
           break check
       # Found.
       return i
   start *= 10

let n = search() echo " n = ", n for k in 2..6:

 echo k, "n = ", k * n</lang>

Output:

 n = 142857
2n = 285714
3n = 428571
4n = 571428
5n = 714285
6n = 857142

Pascal

Create an array of the digits fixed 1 as first digit and 0 "1023456789"
Don't use the fact, that second digit must be < 6.Runtime negligible. <lang pascal>program euler52; {$IFDEF FPC}

 {$MOde DElphi} {$Optimization On}

{$else}

 {$Apptype console}

{$ENDIF} uses

 sysutils;

const

 Base = 10;

type

 TUsedDigits = array[0..Base-1] of byte;
 tDigitsInUse =   set of 0..Base-1;

var

 UsedDigits :tUsedDigits;
 gblMaxDepth : NativeInt;

procedure InitUsed; Var

i : NativeInt;

Begin

 For i := 2 to Base-1 do 
   UsedDigits[i] := i;
 UsedDigits[0] := 1;
 UsedDigits[1] := 0;  

end;

function GetUsedSet(const UsedDigits: tUsedDigits):tDigitsInUse; var

 i : NativeInt;

begin

 result := [];
 For i := 0 to gblMaxDepth do
   include(result,UsedDigits[i]);

end;

function CheckMultiples(const UsedDigits: tUsedDigits;OrgInUse:tDigitsInUse):NativeInt; var

 SumDigits :tUsedDigits;
 i,c,s,j : integer;

begin

 result := 0;  
 SumDigits := UsedDigits;    

 j := 2;// first doubled
 repeat
   c := 0;
   For i := gblMaxdepth downto 0 do  
   Begin
     s := UsedDigits[i]+SumDigits[i]+c;
     c := ord(s >= base);
     SumDigits[i] := s-c*base;
   end;
   IF (c > 0) then
     break;
   if GetUsedSet(SumDigits) <> OrgInUse then
     break;
   inc(j);  
 until j > 6;

 IF j > 6 then
 Begin
   result := 0;  
   //Output in Base 10
   For i := 0 to gblMaxdepth do 
     result := result * Base +UsedDigits[i];
   For i := 1 to 6 do       
     writeln(i*result);
   writeln;  
 end;    

end;

procedure Check; Begin

 CheckMultiples(UsedDigits,GetUsedSet(UsedDigits))

end;

procedure GetNextUsedDigit(StartIdx:NativeInt); var

 i : NativeInt;
 DigitTaken: Byte;

Begin

 For i := StartIDx to Base-1 do
 Begin
   //swap i with Startidx
   DigitTaken := UsedDigits[i]; 
   UsedDigits[i]:= UsedDigits[StartIdx];
   UsedDigits[StartIdx] := DigitTaken;      

// write(StartIdx:3,i:3,DigitTaken:3,' ');

   IF StartIdx <gblMaxDepth then
     GetNextUsedDigit(StartIdx+1)
   else
     check;
   //undo swap i with Startidx      
   UsedDigits[StartIdx] := UsedDigits[i]; 
   UsedDigits[i]:= DigitTaken;
 end;  

end; var

 T : INt64;

Begin

 T := GetTickCount64;
 For gblMaxDepth := 2 to Base-1 do
 Begin
   InitUsed;
   writeln('With ',gblMaxdepth+1,' digits');    
   GetNextUsedDigit(1);
 end;  
 T := GetTickCount64-T;
 write('Done in ',T/1000:0:3);
 {$IFDEF WINdows}
   readln;
 {$ENDIF}  

end.</lang>

Output:

With 3 digits
With 4 digits
With 5 digits
With 6 digits
142857
285714
428571
571428
714285
857142

With 7 digits
1428570
2857140
4285710
5714280
7142850
8571420

1429857
2859714
4289571
5719428
7149285
8579142

With 8 digits
14298570
28597140
42895710
57194280
71492850
85791420

With 9 digits
With 10 digits
Done in 0.054

Phix

Maintain a limit (n10) and bump the iteration whenever *6 increases the number of digits, which (as [was] shown) cuts the number of iterations by a factor of nearly thirteen and a half times (as in eg [as was] 67 iterations instead of 900 to find nothing in 100..1,000). Also as noted on the talk page, since sum(digits(3n)) is a multiple of 3 and it uses the same digits as n, then sum(digits(n)) will also be the very same multiple of 3 and hence n must (also) be divisible by 3, so we can start each longer-digits iteration on 10^k+2 (since remainder(10^k,3) is always 1) and employ a step of 3, and enjoy a better than 40-fold overall reduction in iterations.

with javascript_semantics
integer n = 3, n10 = 10, steps = 0
while true do
    if n*6>=n10 then
        printf(1,"Nothing less than %,d (%,d steps)\n",{n10,steps})
        n = n10+2
        n10 *= 10
        steps = 0
    else
        string ns = sort(sprintf("%d",n))
        integer i -- (to test after loop)
        for i=2 to 6 do
            string ins = sort(sprintf("%d",n*i))
            if ins!=ns then exit end if
        end for
        if i=7 then exit end if
        n += 3
        steps += 1
    end if
end while
constant fmt="""
Smallest positive integer n for which (2..6)*n contain the same digits:
    n = %d
2 x n = %d
3 x n = %d
4 x n = %d
5 x n = %d
6 x n = %d
"""
printf(1,fmt,sq_mul(n,tagset(6)))

Output:

Nothing less than 10 (0 steps)
Nothing less than 100 (2 steps)
Nothing less than 1,000 (22 steps)
Nothing less than 10,000 (222 steps)
Nothing less than 100,000 (2,222 steps)
Smallest positive integer n for which (2..6)*n contain the same digits:
    n = 142857
2 x n = 285714
3 x n = 428571
4 x n = 571428
5 x n = 714285
6 x n = 857142

Raku

<lang perl6>put display (^∞).map(1 ~ *).race.map( -> \n { next unless [eq] (2,3,4,5,6).map: { (n × $_).comb.sort.join }; n } ).first;

sub display ($n) { join "\n", " n: $n", (2..6).map: { "×$_: {$n×$_}" } }</lang>

Output:

 n: 142857
×2: 285714
×3: 428571
×4: 571428
×5: 714285
×6: 857142

REXX

<lang rexx>/*REXX program finds and displays the smallest positive integer n such that ··· */ /*───────────────────────── 2*n, 3*n, 4*5, 5*6, and 6*n contain the same decimal digits.*/

                       do n=1                                /*increment N from unity. */
                       b= 2*n                                /*calculate product of 2*n*/
                       t= 3*n                                /*    "        "     " 3*n*/
                              if verify(t,b)>0  then iterate /*product have req. digs ?*/
                       q= 4*n                                /*calculate product of 4*n*/
                              if verify(q,b)>0  then iterate /*product have req. digs ?*/
                              if verify(q,t)>0  then iterate /*   "      "   "     "  "*/
                       v= 5*n                                /*calculate product of 5*n*/
                              if verify(v,b)<0  then iterate /*product have req. digs ?*/
                              if verify(v,t)>0  then iteratr /*   "      "   "     "  "*/
                              if verify(v,q)>0  then iteratr /*   "      "   "     "  "*/
                       s= 6*n                                /*calculate product of 6*n*/
                              if verify(s,b)>0  then iterate /*product have req. digs ?*/
                              if verify(s,t)>0  then iterate /*   "      "   "     "  "*/
                              if verify(s,q)>0  then iterate /*   "      "   "     "  "*/
                              if verify(s,v)>0  then iterate /*   "      "   "     "  "*/
                       leave                                 /*found the numbers, show.*/
                       end   /*n*/

_= left(, 9) /*used for indentation. */ say _ ' n =' commas(n) /*display value of n. */ say _ '2*n =' commas(b) /* " " " 2*n. */ say _ '3*n =' commas(t) /* " " " 3*n. */ say _ '4*n =' commas(q) /* " " " 4*n. */ say _ '5*n =' commas(v) /* " " " 5*n. */ say _ '6*n =' commas(s) /* " " " 6*n. */ exit 0 /*stick a fork in it, we're all done. */ /*──────────────────────────────────────────────────────────────────────────────────────*/ commas: parse arg ?; do jc=length(?)-3 to 1 by -3; ?=insert(',', ?, jc); end; return ?</lang>

output   when using the internal default input:

            n = 142,857
          2*n = 285,714
          3*n = 428,571
          4*n = 571,428
          5*n = 714,285
          6*n = 857,142

Ring

<lang ring> load "stdlib.ring"

see "working..." + nl see "Permuted multiples are:" + nl per = list(6) perm = list(6)

for n = 1 to 1000000

   for x = 2 to 6
       perm[x] = []
   next
   perStr = list(6)
   for z = 2 to 6
       per[z] = n*z
       perStr[z] = string(per[z])
       for m = 1 to len(perStr[z])
           add(perm[z],perStr[z][m])
       next
   next
   for y = 2 to 6
       perm[y] = sort(perm[y])
       perStr[y] = list2str(perm[y])
       perStr[y] = substr(perStr[y],nl,"")
   next
   
   if perStr[2] = perStr[3] and perStr[2] = perStr[4] and perStr[2] = perStr[5] and perStr[2] = perStr[6]
      see "n   = " + n + nl
      see "2*n = " + (n*2) + nl
      see "3*n = " + (n*3) + nl
      see "4*n = " + (n*4) + nl
      see "5*n = " + (n*5) + nl
      see "6*n = " + (n*6) + nl
      exit
   ok

next

see "done..." + nl </lang>

Output:

working...
Permuted multiples are:
n   = 142857
2*n = 285714
3*n = 428571
4*n = 571428
5*n = 714285
6*n = 857142
done...

Wren

Library: Wren-math

One thing that's immediately clear is that the number must begin with '1' otherwise the higher multiples will have more digits than it has. <lang ecmascript>import "/math" for Int

// assumes l1 is sorted but l2 is not var areSame = Fn.new { |l1, l2|

   if (l1.count != l2.count) return false
   l2.sort()
   for (i in 0...l1.count) {
       if (l1[i] != l2[i]) return false
   }
   return true

}

var i = 100 // clearly a 1 or 2 digit number is impossible var nextPow = 1000 while (true) {

   var digits = Int.digits(i)
   if (digits[0] != 1) {
       i = nextPow
       nextPow = nextPow * 10
       continue
   }
   digits.sort()
   var allSame = true
   for (j in 2..6) {
       var digits2 = Int.digits(i * j)
       if (!areSame.call(digits, digits2)) {
           allSame = false
           break
       }
   }
   if (allSame) {
       System.print("The smallest positive integer n for which the following")
       System.print("multiples contain exactly the same digits is:")
       System.print("    n = %(i)")
       for (k in 2..6) System.print("%(k) x n = %(k * i)")
       return
   }
   i = i + 1

}</lang>

Output:

The smallest positive integer n for which the following
multiples contain exactly the same digits is:
    n = 142857
2 x n = 285714
3 x n = 428571
4 x n = 571428
5 x n = 714285
6 x n = 857142