|
|
EXAMPLE
|
Let o = {}. The sequence of transitive finitary sets begins:
1 o
2 {o}
6 {o,{o}}
30 {o,{o},{{o}}}
78 {o,{o},{o,{o}}}
330 {o,{o},{{o}},{{{o}}}}
390 {o,{o},{{o}},{o,{o}}}
870 {o,{o},{{o}},{o,{{o}}}}
1410 {o,{o},{{o}},{{o},{{o}}}}
3198 {o,{o},{o,{o}},{{o,{o}}}}
3390 {o,{o},{{o}},{o,{o},{{o}}}}
4290 {o,{o},{{o}},{{{o}}},{o,{o}}}
7878 {o,{o},{o,{o}},{o,{o,{o}}}}
9570 {o,{o},{{o}},{{{o}}},{o,{{o}}}}
10230 {o,{o},{{o}},{{{o}}},{{{{o}}}}}
11310 {o,{o},{{o}},{o,{o}},{o,{{o}}}}
13026 {o,{o},{o,{o}},{{o},{o,{o}}}}
15510 {o,{o},{{o}},{{{o}}},{{o},{{o}}}}
15990 {o,{o},{{o}},{o,{o}},{{o,{o}}}}
18330 {o,{o},{{o}},{o,{o}},{{o},{{o}}}}
|
|
|
MATHEMATICA
|
primeMS[n_]:=If[n===1, {}, Flatten[Cases[FactorInteger[n], {p_, k_}:>Table[PrimePi[p], {k}]]]];
finitaryQ[n_]:=finitaryQ[n]=Or[n===1, With[{m=primeMS[n]}, {UnsameQ@@m, finitaryQ/@m}]/.List->And];
subprimes[n_]:=If[n===1, {}, Union@@Cases[FactorInteger[n], {p_, _}:>FactorInteger[PrimePi[p]][[All, 1]]]];
transitaryQ[n_]:=Divisible[n, Times@@subprimes[n]];
nn=100000; Fold[Select, Range[nn], {finitaryQ, transitaryQ}]
|
