Search for very large prime (greater than $2^{57885161} − 1$) between Crystal Numbers

Question

Denote $p[i]$ as the $i$th prime. In my opinion, the following is true:

Prime Gap Axiom There are always distinct prime factors for $\{p[i],p[i]+1,p[i]+2, \dots , p[i+1]\}$.

Question 1 How to give some good algorithm to dispatch distinct prime factors?

Corollary 1

$p[i+1]-p[i]\le 1+\pi( p[i+1]/2 ) \le i$, for any integer $i\ge 1$; There exists at least one prime in the interval $( n,n+\pi(n)]$.

Corollary 2 Define Crystal Number Sequence, Crystal(2,3)={2^i* 3^j|i>=0,j>=0}, then the interval ( Crystal[n],Crystal[n+2]) contains at least one prime, for any $n\ge 1$.

Clearly, Crystal Numbers are very related with Mersenne numbers.

indexTop = 30;
Crystal[p1_, p2_] := 
 Sort@Flatten@Table[p1^i*p2^j, {i, 0, indexTop}, {j, 0, indexTop}]
 list = Take[Crystal[2, 3], indexTop]
Graphics[Point[{#, 0}] & /@ list,
 Epilog -> {Orange, Point[Table[{Prime[k], 0}, {k, 1, indexTop}]]}]

Question 2: Can we find (very large) three close numbers c1,c2,c3 which are alike $2^i*3^j$？ exclude composite numbers of the interval (c1, c3) , if there is only one survivor, it must be prime! Is this method feasible? will it be much greater than $2^{57885161} − 1$ ?

---

Link to Mathematica Notebook

Answer 1

Today, I had found an iterative algorithm to dispatch prime factors. Suppose we has the proper primeFactorsList for {1,2,3,...,n-1}, now considering n, n has PrimeNu(n) prime factors, we choose the one that is not dispatched most recently!

(*Dispatch Prime Factors for n<128 *)

reversePrimeFactorsList = {3, 2, 1};
n = 3;
i = 2;
PrimeFactors[x_] := FactorInteger[x][[All, 1]];

While[n < 128,
  n++; If[PrimeQ[n], i++; PrependTo [reversePrimeFactorsList, n],

   pos = Max[ 
            FirstPosition[reversePrimeFactorsList, #] & /@ PrimeFactors[n]
            ];
    PrependTo[reversePrimeFactorsList, reversePrimeFactorsList[[pos]]]
   (*choose the one that is not used most recently*)
   ]
  ];
{i, Prime[i], n}
reversePrimeFactorsList
ListPlot[{Range[n], Reverse@reversePrimeFactorsList}, Filling -> Axis]

Out34:= {31, 127, 128}

Out35:= {2, 127, 3, 5, 31, 41, 61, 11, 5, 17, 59, 13, 29, 23, 19, 113, 7, 37, \ 11, 109, 2, 107, 53, 3, 2, 103, 17, 101, 5, 11, 7, 97, 3, 19, 47, 31, \ 23, 13, 2, 89, 11, 29, 43, 17, 7, 83, 41, 3, 5, 79, 2, 11, 19, 5, 37, \ 73, 3, 71, 7, 23, 17, 67, 11, 13, 2, 3, 31, 61, 5, 59, 29, 19, 7, 11, \ 3, 53, 13, 17, 2, 7, 3, 47, 23, 5, 11, 43, 7, 41, 2, 13, 19, 37, 3, \ 5, 17, 11, 2, 31, 2, 29, 7, 3, 13, 5, 2, 23, 11, 7, 5, 19, 3, 17, 2, \ 3, 7, 13, 2, 11, 5, 3, 2, 7, 3, 5, 2, 3, 2, 1}