32 lines
1012 B
Plaintext
32 lines
1012 B
Plaintext
ClearAll[AllSublengths]
|
|
AllSublengths[l_List] := If[Length[l] > 2,
|
|
Catenate[Partition[l, #, 1] & /@ Range[2, Length[l]]]
|
|
,
|
|
{l}
|
|
]
|
|
primes = Prime[Range[PrimePi[1000035]]];
|
|
ps = Union[Intersection[primes + 6, primes] - 6, Intersection[primes - 6, primes] + 6];
|
|
a = Intersection[ps + 6, ps] - 6;
|
|
b = Intersection[ps - 6, ps] + 6;
|
|
g = Graph[DeleteDuplicates[Thread[a \[UndirectedEdge] (a + 6)]~Join~Thread[(b - 6) \[UndirectedEdge] b]]];
|
|
sp = Sort /@ ConnectedComponents[g];
|
|
sp //= SortBy[First];
|
|
sp //= Map[AllSublengths];
|
|
sp //= Catenate;
|
|
sp //= SortBy[First];
|
|
sp //= DeleteDuplicates;
|
|
sel = Select[sp, Length /* EqualTo[2]];
|
|
Length[sel]
|
|
sel[[-5 ;;]] // Column
|
|
sel = Select[sp, Length /* EqualTo[3]];
|
|
Length[sel]
|
|
sel[[-5 ;;]] // Column
|
|
sel = Select[sp, Length /* EqualTo[4]];
|
|
Length[sel]
|
|
sel[[-5 ;;]] // Column
|
|
sel = Select[sp, Length /* EqualTo[5]];
|
|
Length[sel]
|
|
sel // Column
|
|
|
|
Select[Complement[primes, DeleteDuplicates[Catenate@sp]][[-20 ;;]], ! (PrimeQ[# + 6] \[Or] PrimeQ[# - 6]) &][[-10 ;;]] // Column
|