Not an answer, but maybe a start:
It is fairly clear why trivial cases like $n=18,$ power$=2$ don't work, after all of the sum-pairs $\neq$ a power of $2$ that are $\leq2n$ are stripped away:
Complete cycles are much easier to search for: cycleP[33, 2] (for $n=33,$ power$=2$, code below) produces
whereas cyclePall[23, 2] produces
and it is clear why nothing below $300$ish will work for power $3$ by just looking at dangling nodes of $n=200,$ power$=3$:
cycleP[n_, pow_] :=
With[{graph = Graph[DeleteDuplicates[Flatten[Thread[#[[1]] -> #[[2]]] & /@
Transpose[{Range@n, Table[If[#[[1]] == hh, #[[2]], #[[1]]] & /@
Select[Flatten[DeleteCases[Table[With[{aa = Transpose@{(ConstantArray[#, #]
&@nn - Range@nn), Reverse@(ConstantArray[#, #] &@nn - Range@nn)}},
Select[Rest@ Take[aa, Floor[Length@aa/2]], #[[1]] <= n && #[[2]] <= n &]],
{nn, Range[2, Floor[(2 n)^(1/pow)]]^pow + 1}], {}], 1], #[[1]] == hh \[Or] #[[2]]
== hh &], {hh, n}]}]], Sort[#1] == Sort[#2] &], DirectedEdges -> False,
VertexLabels -> "Name"]}, Column[{Show[#, ImageSize -> 400] &@
HighlightGraph[graph, Style[FindCycle[graph, {n}], {Darker@Red, Thick}]],
Flatten@(#[[All, 1]] & /@ FindCycle[graph, {n}])}]]
cyclePall[n_, pow_] :=
With[{cc = DeleteDuplicates[Flatten[Thread[#[[1]] -> #[[2]]] & /@
Transpose[{Range@n, Table[If[#[[1]] == hh, #[[2]], #[[1]]] & /@
Select[Flatten[DeleteCases[Table[With[{aa = Transpose@{(ConstantArray[#, #] &@nn -
Range@nn), Reverse@(ConstantArray[#, #] &@nn - Range@nn)}},
Select[Rest@ Take[aa, Floor[Length@aa/2]], #[[1]] <= n && #[[2]] <=
n &]], {nn, Range[2, Floor[(2 n)^(1/pow)]]^pow + 1}], {}], 1], #[[1]] == hh \[Or]
#[[2]] == hh &], {hh, n}]}]], Sort[#1] == Sort[#2] &]}, With[{dd =
Split@Sort@Join[cc[[All, 1]], cc[[All, 2]]]},
With[{jj = DeleteCases[Flatten@(If[Length@# == First@Sort[Length@# & /@ dd], #, 0]
& /@ dd), 0]}, With[{ll = Flatten@Table[Thread[#[[1]] -> #[[2]]] & /@
Transpose@{ConstantArray[jj[[kk]], n], Range@n}, {kk, Length@jj}]},
With[{zz = Table[Join[{ll[[vv]]}, cc], {vv, Length@ll}]}, With[{zzz =
DeleteCases[Table[FindCycle[Graph[zz[[ww]], DirectedEdges -> False,
VertexLabels -> "Name"], {n}], {ww, Length@zz}], {}]}, With[{graphs =
(HighlightGraph[Graph[cc, DirectedEdges -> False, VertexLabels -> "Name"],
Style[#, {Darker@Red, Thick}]] & /@ zzz)},Column[{If[Length@graphs == 0,
Show[Graph[cc, DirectedEdges -> False, VertexLabels -> "Name"], ImageSize -> 400],
Show[#, ImageSize -> 400] & /@ graphs],#[[All, 1]] & /@ (Rest@# & /@
Flatten[zzz, 1])}]]]]]]]]
(Mathematica 10 only)
Best Answer
As Jan Grabowski notes, all the primes that you mention have been discovered by GIMPS. GIMPS draws a distinction between testing and double-checking. When a Lucas–Lehmer test is performed on a Mersenne number and delivers a verdict that the number is prime, the computation is immediately verified. Only after the verification checks out is it announced that a new prime has been discovered. However, if the verdict of the LL test is that the number is composite, the double-checking may not be performed immediately. There is a rather complicated set of assignment rules that determines what computations are to be done next on which computers.
Almost all the Mersenne numbers up to the current largest known Mersenne prime have been tested at least once (the small number of exceptions is due to the nature of distributed computing). However, not all the composites have been double-checked. GIMPS does not declare a range to be prime-free until all the composites in that range have been double-checked.