Here are two methods that are quite fast for flat lists (you can flatten arrays to test at deeper levels):
const = ConstantArray[1, 100000];
nonconst = Append[const, 2];
Using CountDistinct (or CountDistinctBy):
CountDistinct[const] === 1
CountDistinct[nonconst] === 1
True
False
Based on pattern matching:
MatchQ[const, {Repeated[x_]}]
MatchQ[nonconst , {Repeated[x_]}]
True
False
The MatchQ approach can be generalized for deeper arrays using Level without having to Flatten everything:
constTensor = ConstantArray[1, {5, 5, 5}];
MatchQ[Level[constTensor, {ArrayDepth[constTensor]}], {Repeated[x_]}]
True
Level doesn't always perform better than Flatten, though. Flatten seems very efficient for packed arrays.
Timings
CountDistinct[const] // RepeatedTiming
MatchQ[const, {Repeated[x_]}] // RepeatedTiming
{0.00021, 1}
{0.0051, True}
MatchQ has the advantage that it short-circuits when a list doesn't match:
nonconst2 = Prepend[const, 2];
MatchQ[nonconst2, {Repeated[x_]}] // RepeatedTiming
{6.*10^-7, False}
Edit
Here's another method I just came up with. It avoids messing around with the array (flattening etc.):
constantArrayQ[arr_] := Block[{
depth = ArrayDepth[arr],
fst
},
fst = Extract[arr, ConstantArray[1, depth]];
FreeQ[arr, Except[fst], {depth}, Heads -> False]
];
It seems like this one is quite fast for unpacked arrays:
constTensor = ConstantArray[1, 400*{1, 1, 1}];
constTensor[[1, 1, 1]] = 2.;
<< Developer`
PackedArrayQ @ constTensor
(* False *)
MatchQ[Level[constTensor, {ArrayDepth[constTensor]}], {Repeated[x_]}] // AbsoluteTiming
MatchQ[Flatten[constTensor], {Repeated[x_]}] // AbsoluteTiming
constantArrayQ[constTensor] // AbsoluteTiming
(* {2.54311, False} *)
(* {2.20663, False} *)
(* {0.0236709, False} *)
For packed arrays, it looks like MatchQ[Flatten[constTensor], {Repeated[x_]}] is actually the fastest:
constTensor = ConstantArray[1, 400*{1, 1, 1}];
constTensor[[1, 1, 1]] = 2;
<< Developer`
PackedArrayQ @ constTensor
(* True *)
MatchQ[Level[constTensor, {ArrayDepth[constTensor]}], {Repeated[x_]}] // AbsoluteTiming
MatchQ[Flatten[constTensor], {Repeated[x_]}] // AbsoluteTiming
constantArrayQ[constTensor] // AbsoluteTiming
(* {2.76109, False} *)
(* {0.19088, False} *)
(* {1.17001, False} *)