RosettaCodeData/Task/Cyclops-numbers/Mathematica/cyclops-numbers.math

49 lines
1.8 KiB
Plaintext

a = Flatten[Table[FromDigits[{i, 0, j}], {i, 9}, {j, 9}], 1];
b = Flatten@Table[FromDigits@{i, j}, {i, 9}, {j, 9}];
c = Flatten@Table[FromDigits@{i, j, k}, {i, 9}, {j, 9}, {k, 9}];
blindPrimeQ[n_] :=
Block[{digits = IntegerDigits@n, m},
m = Floor[Length[digits]/2];
PrimeQ[FromDigits@Join[digits[[;; m]], digits[[-m ;;]]]]]
palindromeQ[n_] :=
Block[{digits = IntegerDigits@n}, digits === Reverse[digits]]
cyclopsQ[n_] :=
Block[{digits = IntegerDigits@n, len, ctr},
len = Length[digits];
ctr = Ceiling[len/2];
And @@ {Mod[len, 2] == 1, ctr > 0, digits[[ctr]] == 0,
FreeQ[Drop[digits, {ctr}], 0]}]
cyclops = (* all Cyclops numbers with 3, 5 or 7 digits *)
Flatten@{a,
Outer[
FromDigits@Flatten@{IntegerDigits@#1, 0, IntegerDigits@#2} &, b,
b],
Outer[
FromDigits@Flatten@{IntegerDigits@#1, 0, IntegerDigits@#2} &, c,
c]};
x = NestWhile[NextPrime, 10^8, ! (cyclopsQ@# && PrimeQ@#) &];
Labeled[Partition[Flatten[{0, a}][[;; 50]], 10] //
TableForm, "First 50 Cyclop numbers", Top]
Labeled[Partition[(primeCyclops = Cases[cyclops, _?PrimeQ])[[;; 50]],
10] // TableForm, "First 50 prime cyclops numbers", Top]
Labeled[Partition[(blind = Cases[primeCyclops, _?blindPrimeQ])[[;;
50]], 10] //
TableForm, "First 50 blind prime cyclops numbers", Top]
Labeled[Partition[(p = Cases[primeCyclops, _?palindromeQ])[[;; 50]],
10] // TableForm, "First 50 palindromic prime Cyclops Numbers", Top]
Labeled[TableForm[{{x,
Length@primeCyclops}, {NestWhile[NextPrime,
x + 1, ! (cyclopsQ@# && PrimeQ@# && blindPrimeQ@#) &],
Length@blind}, {NestWhile[NextPrime,
x + 1, ! (cyclopsQ@# && PrimeQ@# && palindromeQ@#) &],
Length@p}},
TableHeadings -> {{"Prime", "Blind Prime",
"Palindromic Prime"}, {"Value",
"Index"}}], "First Cyclops numeber > 10,000,000", Top]