Efficiently checking whether a number is a perfect power
I offer the following as a fast way of testing cubic and higher powers
primes = Select[Range[59], PrimeQ]
Get a list of all the relevant powers up to a specified limit
list[nmax_] := Sort[Flatten[Table[Range[2, Floor[nmax^(1/p)]]^p, {p, Drop[primes, 1]}]]];
For example
list[1000]
(* {8, 27, 32, 64, 125, 128, 216, 243, 343, 512, 729, 1000} *)
Define an AssociationMap and Lookup function
asc = AssociationMap[True&, list[10^19]];
exactpower1 = Lookup[asc, #, False] &;
Test it on a million random integers in under a second
AbsoluteTiming[Tally[exactpower1 /@ RandomInteger[{10^18, 2*10^18}, {10^6}]]]
(* {0.678293, {{False, 1000000}}} *)
ADDED
In combination with a check for higher order powers, the following can rapidly test for possible squares. It uses the logic described in https://gmplib.org/manual/Perfect-Square-Algorithm.html to make tests modulo various numbers before falling back to a full test involving a square root.
exactsquarefull[n_] := IntegerQ[Sqrt[n]]
maketest[n_] := Module[{list, asc},
list = Union[Mod[Range[n]^2, n]];
asc = AssociationMap[True &, list];
possiblesquare[n] = Lookup[asc, Mod[#, n], False] &]
maketest /@ {256, 9, 5, 7, 13, 17, 97};
exactsquare[n_] :=
possiblesquare[256][n] && possiblesquare[9][n] &&
possiblesquare[5][n] && possiblesquare[7][n] &&
possiblesquare[13][n] && possiblesquare[17][n] &&
possiblesquare[97][n] && exactsquarefull[n]
This matches the expected result on all numbers up to 10^6
{exactsquare[#] == exactsquarefull[#]} & /@ Range[1000000] // Union
(* {{True}} *)
and checks 10^6 large numbers in under 3 seconds
AbsoluteTiming[Tally[exactsquare /@ RandomInteger[{10^18, 2*10^18}, {1000000}]]]
(* {2.76558, {{False, 1000000}}} *)
There is this way:
SetAttributes[test, Listable]
test[n_] := FirstPosition[Reverse[#[[2 ;; Ceiling[Length[#]/2]]] &[
Divisors[n]]], _?(IntegerQ[Log[#, n]] &), 0] =!= 0
Pick[#, test[#]] &[Range[1000]]