13
$\begingroup$

At the moment I use Length[ DeleteDuplicates[ array ] ] == 1 to check whether an array is constant, but I'm not sure whether this is optimal.

What would be the quickest way to test whether an array consists of equal elements?

What if the elements would be integers?

What if they are floats?

Improve this question
$\endgroup$
7
  • 5
    $\begingroup$ Equal@@MinMax[array] might be a bit faster... $\endgroup$
    – Henrik Schumacher
    Commented Sep 29, 2020 at 13:54
  • $\begingroup$ Your Length[ DeleteDuplicates[ array ] ] == 1 does not test whether array is constant but rather whether its rows are equal. This is equivalent to Equal @@ array. To test whether array is constant you could use Equal @@ Flatten[array] $\endgroup$
    – Bob Hanlon
    Commented Sep 29, 2020 at 14:00
  • 1
    $\begingroup$ @Henrik has a good idea but "duplicate" and "equal" mean different things in Mathematica, especially for floating-point numbers and expressions like array = {1 + Sqrt[3], Sqrt[4 + 2 Sqrt[3]]}. An alternative to check duplicates is 0 == Subtract @@ MinMax[array]. $\endgroup$
    – Michael E2
    Commented Sep 29, 2020 at 14:29
  • 1
    $\begingroup$ @HenrikSchumacher I suspect the OP neglected the point because of the use of DeleteDuplicates and the question about "equal elements." I raised it, so that OP might clarify which criterion is desired. (One might want to use Chop or Threshold on max - min in the case of floats depending on how array is calculated.) $\endgroup$
    – Michael E2
    Commented Sep 29, 2020 at 15:13
  • 2
    $\begingroup$ @HenrikSchumacher You should add the MinMax approach as an answer, it is faster than the other answers. $\endgroup$
    – Carl Woll
    Commented Sep 29, 2020 at 15:41

3 Answers 3

Reset to default
9
$\begingroup$

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} *)
Improve this answer
$\endgroup$
1
  • 3
    $\begingroup$ Unexpectedly, MatchQ doesn't check the last bit on machine floats: MatchQ[Table[1. + k*$MachineEpsilon, {k, 2}], {Repeated[x_]}]. Timings? $\endgroup$
    – Michael E2
    Commented Sep 29, 2020 at 14:30
9
$\begingroup$

Statistics`Library`ConstantVectorQ is quite fast.

Using Sjoerd's input examples:

const = ConstantArray[1, 100000];
nonconst = Append[const, 2];
nonconst2 = Prepend[const, 2];


t11 = Statistics`Library`ConstantVectorQ@const // RepeatedTiming;
t21 = CountDistinct[const] == 1 // RepeatedTiming;
t31 = MatchQ[const, {Repeated[x_]}] // RepeatedTiming;
t41 = Length[DeleteDuplicates@const] == 1 // RepeatedTiming;
t51 = Equal @@ MinMax[const] // RepeatedTiming;
t61 = Equal @@ const // RepeatedTiming;

t12 = Statistics`Library`ConstantVectorQ@nonconst // RepeatedTiming
t22 = CountDistinct[nonconst] == 1 // RepeatedTiming;
t32 = MatchQ[nonconst, {Repeated[x_]}] // RepeatedTiming;
t42 = Length[DeleteDuplicates@nonconst] == 1 // RepeatedTiming;
t52 = Equal @@ MinMax[nonconst] // RepeatedTiming;
t62 = Equal @@ nonconst // RepeatedTiming;

t13 = Statistics`Library`ConstantVectorQ@nonconst2 // RepeatedTiming
t23 = CountDistinct[nonconst2] == 1 // RepeatedTiming;
t33 = MatchQ[nonconst2, {Repeated[x_]}] // RepeatedTiming;
t43 = Length[DeleteDuplicates@nonconst2] == 1 // RepeatedTiming;
t53 = Equal @@ MinMax[nonconst2] // RepeatedTiming;
t63 = Equal @@ nonconst2 // RepeatedTiming;


TableForm[{{t11, t12, t13}, {t21, t22, t23}, {t31, t32, t33}, {t41, 
   t42, t43}, {t51, t52, t53}, {t61, t62, t63}}, 
 TableHeadings -> {{"ConstantVectorQ", "CountDistinct", "MatchQ", 
    "Length+DeleteDuplicates", "Equal + MinMax", "Apply[Equal]"}, 
    {"const", "nonconst", "nonconst2"}}]

enter image description here

Improve this answer
$\endgroup$
9
  • 3
    $\begingroup$ I don't know who wrote Statistics`Library but it's full of good stuff. (+1) $\endgroup$
    – Michael E2
    Commented Sep 29, 2020 at 15:18
  • 2
    $\begingroup$ @Alan It's because the array is "unpacked". Start with const = Developer`FromPackedArray@ConstantArray[1, 100000]; and rerun the timings; then Equal @@ const is only about twice as slow. See What is a packed array? $\endgroup$
    – Michael E2
    Commented Sep 29, 2020 at 17:11
  • 2
    $\begingroup$ @kglr This still seems odd to me. DeleteDuplicates should require comparison and deletion, while SameQ should only require comparison. Perhaps SameQ is doing all pairwise comparisons in order not to assume transitivity of the comparisons? $\endgroup$
    – Alan
    Commented Sep 29, 2020 at 18:21
  • 3
    $\begingroup$ @Alan SameQ @@ array is a little faster than DeleteDuplicates[array] on array = Sqrt@ConstantArray[2, {100000}];. The reason DeleteDuplicates is faster on array = ConstantArray[2, {100000}]; is that in effect it computes DeleteDuplicates[Developer`ToPackedArray@array] and SameQ @@ array cannot take advantage of packed arrays. Numbers have certain optimizations available that general expressions do not. Data functions such as DeleteDuplicates are programmed to take advantage of them. $\endgroup$
    – Michael E2
    Commented Sep 30, 2020 at 2:44
  • 1
    $\begingroup$ @Alan The Q&A I linked is probably the best discussion available. The closest to official documentation is this Wolfram Library notebook and article by one of the lead kernel developers, library.wolfram.com/infocenter/Demos/391, which is also linked in a comment to that Q&A. $\endgroup$
    – Michael E2
    Commented Sep 30, 2020 at 18:35
6
$\begingroup$

Equal@@MinMax[array] might be quite fast if array is a packed list of integers. But it cannot short-circuit like Statistics`Library`ConstantVectorQ does. And it is also not very robust with regard to (machine) floating point numbers: Equal and SameQ both use a certain tolerance for their equality checks (I forgot which precise one they use; I just recall that the tolerance of SameQ should be the lower one). This may or may not be the desired behavior in a particular application.

Improve this answer
$\endgroup$
1
  • 1
    $\begingroup$ The tolerances are Internal`$EqualTolerance and Internal`$SameQTolerance for those who wish to change them. For example, Block[{Internal`$EqualTolerance = 0}, Equal @@ MinMax[array]]. $\endgroup$
    – Michael E2
    Commented Sep 29, 2020 at 17:07

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.