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

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

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