A362784 Least positive integer k with k primitive practical and k*n practical.

1, 1, 2, 1, 6, 1, 6, 1, 2, 2, 6, 1, 6, 2, 2, 1, 20, 1, 20, 1, 2, 6, 20, 1, 6, 6, 2, 1, 20, 1, 20, 1, 2, 6, 6, 1, 20, 6, 2, 1, 20, 1, 20, 2, 2, 6, 28, 1, 6, 2, 6, 2, 28, 1, 6, 1, 6, 6, 30, 1, 30, 20, 2, 1, 6, 1, 30, 6, 6, 2, 30, 1, 30, 20, 2, 6, 6, 1, 42, 1, 2, 20, 42, 1, 6, 20, 6, 1, 42, 1, 6, 6, 6, 20, 6, 1, 42, 2, 2, 1

Offset: 1

Author

Frank M Jackson, May 03 2023

Keywords

• nonn

Comments

For all integers n>0 there exists k such that k*n is practical and k is primitive practical. For example, n*prime(f)# is practical where k = prime(f)# = A002110(f) is a primorial number and f is the prime index of the largest prime number in the factorization of n. All primorials are primitive practical numbers. The sequence above gives least k.

Examples

			a(5)=6 since 6*5=30 is practical and 6 is primitive practical. Also 4*5=20 is practical but 4 is not primitive practical.
		

Crossrefs

Cf. A005153, A210445, A267124.

Programs

Mathematica

PracticalQ[n_] := Module[{f, p, e, prod=1, ok=True}, If[n<1||(n>1&&OddQ[n]), False, If[n==1, True, f=FactorInteger[n]; {p, e}=Transpose[f]; Do[If[p[[i]]>1+DivisorSigma[1, prod], ok=False; Break[]]; prod=prod*p[[i]]^e[[i]], {i, Length[p]}]; ok]]];
DivFreeQ[n_] := Module[{plst=First/@Select[FactorInteger[n], #[[2]]>1 &], m, ok=False}, Do[If[!PracticalQ[n/plst[[m]]], ok = True, ok = False; Break[]], {m, 1, Length@plst}]; ok];
PPracticalQ[n_] := PracticalQ[n]&&(SquareFreeQ[n]||DivFreeQ[n]);
lst = {}; Do[m=0; While[!PPracticalQ[m]||(!PracticalQ[m*n]&&m<10000), m++]; AppendTo[lst, m], {n, 1, 500}]; lst