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,3

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.

Links

Table of n, a(n) for n=1..100.

Example

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.

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	

Crossrefs

Cf. A005153, A210445, A267124.

Sequence in context: A205959 A318503 A328580 * A088123 A050932 A366573

Adjacent sequences: A362781 A362782 A362783 * A362785 A362786 A362787

Keyword

nonn

Author

Frank M Jackson, May 03 2023

Status

approved