A254317 a(n) is the least number k such that the number of distinct digits in the prime factorization of k is n (counting terms of the form p^1 as p).
1, 6, 26, 102, 510, 3210, 22890, 153690, 1507290, 15618090
Offset: 1
Examples
a(1) = 1; a(2) = 6 = 2*3 and A254315(6) = 2; a(3) = 26 = 2*13 and A254315(26) = 3; a(4) = 102 = 2*3*17 and A254315(102) = 4; a(5) = 510 = 2*3*5*17 and A254315(510) = 5; a(6) = 3210 = 2*3*5*107 and A254315(3210) = 6; a(7) = 22890 = 2*3*5*7*109 and A254315(22890) = 7; a(8) = 153690 = 2*3*5*47*109 and A254315(153690) = 8; a(9) = 1507290 = 2*3*5*47*1069 and A254315(1507290) = 9; a(10) = 15618090 = 2*3*5*487*1069 and A254315(15618090) = 10.
Programs
-
Maple
with(ListTools): for n from 2 to 10 do: ii:=0: for k from 2 to 10^9 while(ii=0)do: n0:=length(k):lst:={}:x0:=ifactors(k): y:=Flatten(x0[2]):z:=convert(y,set): z1:=z minus {1}:nn0:=nops(z1): for m from 1 to nn0 do : t1:=convert(z1[m],base,10):z2:=convert(t1,set): lst:=lst union z2: od: nn1:=nops(lst): if nn1=n then ii:=1:printf ( "%d %d \n",n,k): else fi: od : od:
-
Mathematica
f[n_] := Block[{pf = FactorInteger@ n, i}, Length@ DeleteDuplicates@ Flatten@ IntegerDigits@ Rest@ Flatten@ Reap@ Do[If[Last[pf[[i]]] == 1, Sow@ First@ pf[[i]], Sow@ FromDigits@ Flatten[IntegerDigits /@ pf[[i]]]], {i, Length@ pf}]]; b = -1; Flatten@ Last@ Reap@ Do[a = f[n]; If[a > b, Sow[n]; b = a], {n, 10^6}] (* Michael De Vlieger, Jan 29 2015 *) With[{s = Array[CountDistinct@ Flatten@ IntegerDigits[FactorInteger[#] /. {p_, e_} /; e == 1 :> {p}] &, 10^6]}, Map[FirstPosition[s, #][[1]] &, Range@ Max@ s]] (* Michael De Vlieger, Nov 03 2017 *)
-
PARI
a(n)=for(k=1,10^5,s=[];F=factor(k);for(i=1,#F[,1],s=concat(s,digits(F[i,1]));if(F[i,2]>1,s=concat(s,digits(F[i,2]))));if(#vecsort(s,,8)==n,return(k))) print1(1,", ");for(n=2,7,print1(a(n),", ")) \\ Derek Orr, Jan 30 2015
Extensions
a(10) corrected by Giovanni Resta, Nov 03 2017
Comments