Data commit

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

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