login
Numbers m whose distinct prime factors are exactly the same as the distinct prime factors of each of the numbers obtained by deleting any single digit in the decimal expansion of m.
0

%I #25 Jul 30 2019 05:44:18

%S 2500,3600,9600,25000,36000,96000,250000,360000,960000,2500000,

%T 3600000,9600000,25000000,36000000,96000000,250000000,360000000,

%U 960000000,2500000000,3600000000,9600000000,25000000000,36000000000,96000000000,250000000000,360000000000

%N Numbers m whose distinct prime factors are exactly the same as the distinct prime factors of each of the numbers obtained by deleting any single digit in the decimal expansion of m.

%C Conjecture: a(3n-2) = 25*10^(n+1), a(3n-1) = 36*10^(n+1) and a(3n) = 96*10^(n+1).

%e 3600 is in the sequence because 3600, 360, 600 and 300 contain all the same prime factors 2, 3 and 5.

%p with(numtheory):nn:=10^10:

%p for n from 100 to nn do:

%p it:=0:x:=convert(n,base,10):n0:=nops(x):d:=factorset(n):

%p W:=array(1..n0-1):

%p for i from 1 to n0 do :

%p k:=0:

%p for j from n0 by -1 to 1 do:

%p if j<>i

%p then

%p k:=k+1: W[k]:=x[j]:

%p else

%p fi:

%p od:

%p s:=sum(ā€˜W[i]*10^(n0-i-1)ā€™, ā€˜iā€™=1..n0-1):d1:=factorset(s):

%p if d=d1

%p then

%p it:=it+1:

%p else

%p fi:

%p od:

%p if it=n0

%p then

%p printf(`%d, `,n):

%p else

%p fi:

%p od:

%t rad[0] = 0; rad[n_] := Times @@ (First@# & /@ FactorInteger[n]); Select[Range[ 10^6], {rad[#]} == Union[rad /@ (FromDigits/@Subsets[(d = IntegerDigits[#]), {Length[d] - 1}])] &] (* _Amiram Eldar_, Jul 26 2019 *)

%Y Cf. A027748.

%K nonn,base

%O 1,1

%A _Michel Lagneau_, Jul 24 2019