A378022 Let operator D(n) be the number formed by concatenation of the products of the decimal digits of n by their respective multiplicities. This sequence records the smallest number requiring n iterations of D to reach a stationary number; see Comment and Example.

1, 11, 112, 166, 688, 4468, 22468, 112468, 124699, 1678999, 111367788889, 11112222333445666777778899

Offset

0,2

Comments

If n has no repeated digits D(n) = n, else if n has at least one repeated decimal digit D(n), the concatenation of the multiples of respective digits by their corresponding multiplicity in n, gives a different (smaller) number. For example D(112) = 22, and D(22) = 4. a(n) gives the smallest number k such that n iterations of D on k are required to reach a number D^n(k) which has no repeated digits, where for all j < n, D^j(k) has as least one digit repeat.

This sequence was discussed on the Seqfans forum in December 2019, resulting in a proof (see links) showing that the sequence is infinite.

Comment from David Seal, (Seqfans 21/12/2019): "a(12) has at least 152 digits.... and a very crude estimate suggests that a(13) has of the rough order of 10^16 digits or more. a(12) is in practice the only unknown value of the sequence that has any hope of appearing in the OEIS, but I have no reasonable idea how to find it.." The arguments supporting these estimates were lost in the Seqfans crash of October 2024.

Links

Table of n, a(n) for n=0..11.

David Seal, Proof that the sequence is infinite, SeqFans, 2019.

Example

a(2) = 112 since this is the smallest number requiring two iterations of the D operator to reach a number with distinct digits: 112 --> 22 --> 4.
a(10) = 111367788889->33614329->961429->186142->28642->4864->886->166->112->22->4 (10 iterations to become stationary; smallest number having this property).

Mathematica

f[x_] := FromDigits /@ NestWhileList[
  Join @@ IntegerDigits[Map[Times @@ # &, Tally[#] ] ] &,
  DeleteCases[IntegerDigits[x], 0], CountDistinct[#] != Length[#] &];
c[_] := 0; r = 0; nn = 10; a[0] = 1;
s = Table[Map[Position[#, 1][[All, 1]] &,
    Permutations@ Join[ConstantArray[1, r], ConstantArray[0, 9 - r] ] ],
  {r, Min[9, nn]}];
t = Union@ Flatten@ Table[
    w = Apply[Join, Permutations /@ IntegerPartitions[n, Min[9, n - 1]]];
    Reap[Do[Sow[Table[FromDigits[
      Flatten@ MapIndexed[ConstantArray[m[[First[#2]]], #1] &, w[[i]] ] ],
  {m, s[[Length[w[[i]] ] ]] }] ], {i, Length[w]} ] ][[-1, 1]], {n, 2, nn}];
Print[Length[t]];
u = Monitor[Reap[Do[
    If[c[#] == 0, Sow[{#, Set[c[#], t[[n]] ] } ];
      If[# > r, r = #]] &[-1 + Length@ f[t[[n]] ] ],
  {n, Length[t]}] ][[-1, 1]], n];
Map[Set[a[#1], #2] & @@ # &, u];
Array[a, r + 1, 0]

Prog

(Python)
def D(s):
   # D(s) returns the result of the contraction of s
   # eg. s='1244'
   contraction=False;
   mult=[0, 0, 0, 0, 0, 0, 0, 0, 0, 0];
   for i in range(10):
      mult[i]=s.count(str(i));
      if mult[i]>1:contraction=True;
   if contraction==False:return '';
   r='';
   for i in range(len(s)):
      c=s[i];
      j=int(c);
      if mult[j]>1:
         r=r+str(j*mult[j]);
         mult[j]=0;
      elif mult[j]==1:r=r+c;
   return r;
# Charles Kinniburgh and Trevor Marshall, Dec 21 2019.

Crossrefs

Cf. A351868, A377948.

Sequence in context: A030175 A263805 A058949 * A119742 A075842 A037535

Adjacent sequences: A378019 A378020 A378021 * A378023 A378024 A378025

Keyword

nonn,base,more

Author

David James Sycamore, Nov 14 2024

Status

approved