aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Data commit

Browse source
This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 7387c8f97b
commit cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

31
Task/Sexy-primes/Mathematica/sexy-primes.math Normal file
View file

@ -0,0 +1,31 @@
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