19
\$\begingroup\$

On a recent episode of QI, the first 5 multiples of 142857 were described as anagrams of the original number. Of course, anyone with more than a passing knowledge of that number will know that those numbers are actually cyclic, not just anagrams. But that got me thinking.

Please write a program or function that outputs all numbers of six or fewer digits which have a proper factor that is an anagram of itself. The list should start with the following numbers:

3105    (divisible by 1035)
7128    (divisible by 1782)
7425    (divisible by 2475)
8316    (divisible by 1386)
8712    (divisible by 2178)
9513    (divisible by 1359)
9801    (divisible by 1089)

If you prefer, you can find numbers which have an anagram that is a proper factor of the number, but take care to exclude leading zeros from your anagrams.

This is code golf, so the shortest code in bytes that breaks no standard loopholes wins.

\$\endgroup\$
  • \$\begingroup\$ If given enough time, can our programs output numbers with more than 6 digits? \$\endgroup\$ – Blue Feb 13 '17 at 0:35
  • 1
    \$\begingroup\$ Could you please post the list? \$\endgroup\$ – xnor Feb 13 '17 at 0:43
  • \$\begingroup\$ @muddyfish Yes, that would be acceptable, as long as it doesn't omit any numbers or output incorrect numbers as it goes. \$\endgroup\$ – Neil Feb 13 '17 at 0:44
  • \$\begingroup\$ @xnor I haven't actually bothered calculating the whole list yet, although I'm not expecting any disputes over it. \$\endgroup\$ – Neil Feb 13 '17 at 0:45
  • 1
    \$\begingroup\$ I made a pastebin of my (hopefully correct) output. \$\endgroup\$ – Greg Martin Feb 13 '17 at 0:50

12 Answers 12

6
\$\begingroup\$

Mathematica (REPL environment), 75 74 bytes

Thanks to ngenisis for tightening this up by a byte!

Select[Range[10!],Most@#~MemberQ~Last@#&[Sort/@IntegerDigits@Divisors@#]&]

Sort/@IntegerDigits@Divisors@# produces a sorted list of digits for every divisor of its argument; the input number is itself a divisor, so its sorted list of digits is the last one. Most@#~MemberQ~Last detects whether that last sorted list of digits also appears in the list prior to the last element. And Select[Range[10!],...] retains only those integers up to 3,628,800 that pass this test (that bound chosen because it's one byte shorter than 106). It runs in about 5 minutes on my computer, yielding a list of 494 numbers, the largest of which is 3,427,191; there are 362 numbers up to 106, the larget of which is 989,901.

\$\endgroup\$
  • \$\begingroup\$ Well, it's not that curious: 857142 and 571428 are two numbers both with two obvious proper divisor anagrams. \$\endgroup\$ – Neil Feb 13 '17 at 0:55
  • \$\begingroup\$ In fact, 857142 has three proper divisor anagrams, does it not? \$\endgroup\$ – Neil Feb 13 '17 at 8:55
  • \$\begingroup\$ looks like you're right! \$\endgroup\$ – Greg Martin Feb 13 '17 at 17:49
  • \$\begingroup\$ You can save a byte by using IntegerDigits@Divisors@#. \$\endgroup\$ – ngenisis Feb 14 '17 at 4:17
3
\$\begingroup\$

Jelly, 12 bytes

ÆḌṢ€ċṢ
ȷ6ÇÐf

Try it online! (uses five or fewer digits because of TIO's time limit)

Verfication

$ time jelly eun 'ÆḌṢ€ċṢ¶ȷ6ÇÐf'
[3105, 7128, 7425, 8316, 8712, 9513, 9801, 30105, 31050, 37125, 42741, 44172, 67128, 70416, 71208, 71253, 71280, 71328, 71928, 72108, 72441, 74142, 74250, 74628, 74925, 78912, 79128, 80712, 81816, 82755, 83160, 83181, 83916, 84510, 85725, 86712, 87120, 87132, 87192, 87912, 89154, 90321, 90801, 91152, 91203, 93513, 94041, 94143, 95130, 95193, 95613, 95832, 98010, 98091, 98901, 251748, 257148, 285174, 285714, 300105, 301050, 307125, 310284, 310500, 321705, 341172, 342711, 370521, 371142, 371250, 371628, 371925, 372411, 384102, 403515, 405135, 410256, 411372, 411723, 415368, 415380, 415638, 419076, 419580, 420741, 421056, 423711, 425016, 427113, 427410, 427491, 428571, 430515, 431379, 431568, 435105, 436158, 441072, 441720, 449172, 451035, 451305, 458112, 461538, 463158, 471852, 475281, 501624, 502416, 504216, 512208, 512820, 517428, 517482, 517725, 525771, 527175, 561024, 562104, 568971, 571428, 571482, 581124, 589761, 615384, 619584, 620379, 620568, 623079, 625128, 641088, 667128, 670416, 671208, 671280, 671328, 671928, 672108, 678912, 679128, 681072, 691872, 692037, 692307, 704016, 704136, 704160, 704196, 705213, 705321, 706416, 711342, 711423, 712008, 712080, 712503, 712530, 712800, 713208, 713280, 713328, 713748, 714285, 716283, 717948, 719208, 719253, 719280, 719328, 719928, 720108, 720441, 721068, 721080, 721308, 721602, 723411, 724113, 724410, 724491, 728244, 730812, 731892, 732108, 741042, 741285, 741420, 742284, 742500, 744822, 746280, 746928, 749142, 749250, 749628, 749925, 753081, 754188, 755271, 760212, 761082, 761238, 761904, 771525, 772551, 779148, 783111, 786912, 789120, 789132, 789192, 789312, 790416, 791208, 791280, 791328, 791928, 792108, 798912, 799128, 800712, 806712, 807120, 807132, 807192, 807912, 814752, 816816, 818160, 818916, 820512, 822744, 823716, 824472, 825174, 825714, 827550, 827658, 827955, 829467, 830412, 831117, 831600, 831762, 831810, 831831, 839160, 839181, 839916, 840510, 841023, 841104, 843102, 845100, 845910, 847422, 851148, 851220, 851742, 852471, 857142, 857250, 857628, 857925, 862512, 862758, 862947, 865728, 866712, 867120, 867132, 867192, 867912, 871200, 871320, 871332, 871425, 871920, 871932, 871992, 874125, 879120, 879132, 879192, 879912, 888216, 891054, 891540, 891594, 891723, 892755, 894510, 895725, 899154, 900801, 901152, 903021, 903210, 903231, 904041, 908010, 908091, 908901, 909321, 910203, 911043, 911358, 911520, 911736, 911952, 912030, 912093, 912303, 916083, 920241, 920376, 923076, 923580, 925113, 925614, 930321, 931176, 931203, 933513, 934143, 935130, 935193, 935613, 935832, 940410, 940491, 941430, 941493, 941652, 943137, 943173, 951300, 951588, 951930, 951993, 952380, 956130, 956193, 956613, 958032, 958320, 958332, 958392, 958632, 958716, 959832, 960741, 962037, 962307, 970137, 971028, 980100, 980910, 980991, 989010, 989091, 989901]

real    2m10.819s
user    2m10.683s
sys     0m0.192s

How it works

ȷ6ÇÐf   Main link. No arguments.

ȷ6      Yield 1e6 = 1,000,000.
  ÇÐf   Filter; keep numbers in [1, ..., 1e6] for which the helper link returns
        a truthy value.


ÆḌṢ€ċṢ  Helper link. Argument: n

ÆḌ      Compute all proper divisors of n.
  Ṣ€    Sort each proper divisor's digits.
     Ṣ  Sort n's digits.
   ċ    Count the occurrences of the result to the right in the result to the left.
\$\endgroup\$
  • 1
    \$\begingroup\$ Due to this comment you can do the even slower ÆḌṢ€ċṢµȷ# for 10. Took ~27 mins to run on an i7 core (not on unix, no nice time); the largest result was 6671928. \$\endgroup\$ – Jonathan Allan Feb 13 '17 at 6:23
  • \$\begingroup\$ I'm starting to think you modify Jelly on a per question basis 😏 \$\endgroup\$ – Albert Renshaw Feb 15 '17 at 3:24
3
\$\begingroup\$

Brachylog, 12 bytes

ℕf{k∋p.!}?ẉ⊥

Try it online!

This might time out before printing anything though (and if it doesn't it will only get to print 3105).

Explanation

This prints those numbers indefinitely, as the author said it was acceptable that the program would print numbers bigger than 6 digits.

This is way too slow; you can use this program (and change 8300 by any N) to start printing from numbers stricly greater than N.

ℕ               Natural number: The Input is a natural number
 f              Factors: compute the factors of the Input
  {     }?      Call a predicate with the main Input as its output and the factors as Input
   k            Knife: remove the last factor(which is the Input itself)
    ∋           In: take one of those factors
     p.         Permute: the Output is a permutation of that factor
       !        Cut: ignore other possible permutations
         ?ẉ     Writeln: write the Input to STDOUT, followed by a line break
           ⊥    False: backtrack to try another value for the Input

As @ais523 pointed out, we need a cut to avoid printing a number multiple times if several of its factors are permutations of it.

\$\endgroup\$
  • \$\begingroup\$ I have a very it similar answer saved as a draft. Unfortunately, I don't think it works because it'll print numbers like 857142 more than once, and the author said that that's disallowed. I think the program needs a cut somewhere, likely adding three characters. \$\endgroup\$ – user62131 Feb 13 '17 at 9:39
  • \$\begingroup\$ Adding 4 characters in fact... thanks, forgot about that. \$\endgroup\$ – Fatalize Feb 13 '17 at 10:01
3
\$\begingroup\$

JavaScript (ES6), 10396 94 bytes

An anonymous function that returns the array of matching integers.

_=>[...Array(1e6).keys(F=i=>[...i+''].sort()+0)].filter(n=>n*(R=i=>F(n/i--)==F(n)||R(i)%i)(9))

Formatted and commented

_ =>                                // main function, takes no input
  [...Array(1e6).keys(              // define an array of 1,000,000 entries
    F = i => [...i + ''].sort() + 0 // define F: function used to normalize a string by
  )]                                // sorting its characters
  .filter(n =>                      // for each entry in the array:
    n * (                           // force falsy result for n = 0
      R = i =>                      // define R: recursive function used to test if
        F(n / i--) == F(n) ||       // n/i is an anagram of n, with i in [1 … 9]
        R(i) % i                    // F(n/1) == F(n) is always true, which allows to stop
    )                               // the recursion; but we need '%i' to ignore this result
    (9)                             // start recursion with i = 9
  )                                 //

Divisor statistics

For 6-digit integers, each ratio from 2 to 9 between a matching integer n and its anagram is encountered at least once. But some of them appear just a few times:

 divisor | occurrences | first occurrence
---------+-------------+---------------------
    2    |    12       | 251748 / 2 = 125874
    3    |    118      | 3105   / 3 = 1035
    4    |    120      | 7128   / 4 = 1782
    5    |    4        | 714285 / 5 = 142857
    6    |    34       | 8316   / 6 = 1386
    7    |    49       | 9513   / 7 = 1359
    8    |    2        | 911736 / 8 = 113967
    9    |    23       | 9801   / 9 = 1089

Test

The test below is limited to the range [1 ... 39999] so that it doesn't take too much time to complete.

let f =

_=>[...Array(4e4).keys(F=i=>[...i+''].sort()+0)].filter(n=>n*(R=i=>F(n/i--)==F(n)||R(i)%i)(9))

console.log(f())

\$\endgroup\$
  • \$\begingroup\$ Much faster version, but somewhat longer: _=>[...Array(1e6).keys()].filter(n=>n&&![...Array(9)].every(_=>n%++i||(F=i=>[...i+''].sort()+'')(n/i)!=F(n),i=1)). \$\endgroup\$ – Neil Feb 13 '17 at 16:48
  • \$\begingroup\$ @Neil Your suggestion inspired me the updated version which is much faster and 1 byte shorter. Sadly, all divisors from 2 to 9 are required (8 being used only twice for 911736 and 931176). \$\endgroup\$ – Arnauld Feb 13 '17 at 18:14
2
\$\begingroup\$

Pyke, 14 bytes

~1#`Sili-m`mS{

Try it here!

Should output all numbers like this but times out.

Test the algorithm here!

\$\endgroup\$
2
\$\begingroup\$

Perl 6, 59 bytes

{grep {grep .comb.Bag===*.comb.Bag,grep $_%%*,2..^$_}

Terribly slow brute-force solution.

It returns a lazy sequence, so I could check the first few results, but it won't reach all results in reasonable time. (Should I mark it as non-competing?)

\$\endgroup\$
2
\$\begingroup\$

Pure Bash, 128 126 122 121 120 bytes

for((;n<6**8;)){
c=0
for((j=++n;j;j/=10)){((c+=8**(j%10)));}
for k in ${a[c]};{((n%k))||{ echo $n;break;};}
a[c]+=\ $n
}

Try it online!

(This program is reasonably fast -- it took only 14 minutes to run through all the 6-digit numbers on my MacBook. Unfortunately TIO times out because it imposes a running-time limit of 1 minute, which is only enough time to get through the 5-digit numbers or so.)

Bash + Unix utilities, 117 bytes

for n in {1..999999}
{
c=$(bc<<<0`sed 's/\(.\)/+8^\1/g'<<<$n`)
for k in ${a[c]};{((n%k))||echo $n;}
a[c]+=\ $n
}|uniq

This is shorter than the pure bash version, but quite a bit slower, presumably due in good part to all the forking going on.

\$\endgroup\$
1
\$\begingroup\$

05AB1E, 15 bytes

[¼¾œJv¾Ñ¨Dyåi¾,

Explanation:

[               # Start of infinite loop
 ¼              # Increase counter_variable by 1
  ¾œJv          # Loop through all the permutations of counter_variable
      ¾Ñ¨Dyå    # Check if a divisor of counter_variable is a permutation of counter_variable
            i¾, # If so, print counter_variable

Try it online! (this won't work, it will time out)

\$\endgroup\$
1
\$\begingroup\$

Japt, 23 bytes

L³o f_ì á ¤fg mì f!vZ l

Try it online! Note that the linked code only calculates up to 1e4 because 1e6 times out on TIO.

\$\endgroup\$
0
\$\begingroup\$

Python 2, 98 bytes

s=sorted;print filter(None,[[x for i in range(x)if s(`x`)==s(`i`)and x%i<1]for x in range(10**6)])
\$\endgroup\$
  • \$\begingroup\$ Shouldn't that be 10**6? \$\endgroup\$ – Neil Feb 13 '17 at 19:35
  • \$\begingroup\$ Yes, thank you. \$\endgroup\$ – Trelzevir Feb 13 '17 at 19:37
  • 1
    \$\begingroup\$ I think x%i==0 can just be x%i<1. \$\endgroup\$ – Yytsi Feb 13 '17 at 19:46
0
\$\begingroup\$

05AB1E, 12 10 bytes

Times out on TIO due to infinite loop.
Saved 2 bytes as we could output more than 6-digit numbers according to OPs comment.

[NѨ€{N{å–

Try it online!

Explanation

[            # infinite loop with iteration index N
 NÑ          # get a list of all divisors of N
   ¨         # remove N from that list
    €{       # sort each entry in the list of divisors
      N{     # sort N
        å–   # output N if N is in the list
\$\endgroup\$
0
\$\begingroup\$

Batch, 263 bytes

@echo off
set e=exit/b
for /l %%n in (1,1,999999)do call:n %%n
%e%
:n
call:c %1 1 0
for /l %%f in (2,1,9)do call:c %1 %%f %c%&&echo %1&&%e%
%e%
:c
set/ar=%1%%%2,d=%1/%2,c=-%3
if %r% gtr 0 %e%1
:l
set/ac+=1^<^<d%%10*3,d/=10
if %d% gtr 0 goto l
%e%%c%

Slow. As in, takes over a day to finish on my PC. Explanation: the c subroutine divides its first two arguments. If the remainder is zero, it then calculates the hash of the result by calculating the sum of the nth powers of 8 for each digit. This hash function, stolen from the bash answer, only collides on anagrams. (It would work for seven digit numbers but I don't have all fortnight.) The third argument is subtracted, and the subroutine exits with a truthy result if this is zero. The n subroutine calls the c subroutine once to calculate the hash, then eight more times to compare the hash; if it finds a collision, it prints n and exits the subroutine early.

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.