Compare each element of a list to the mean of the remainder of the list

If I have a list

lst = {1, 2, 3, 4, 5};


Is there some way of taking the first element and then comparing it to the average of the other 4 elements? Then to take element 2 and compare it to the average of elements 1, 3, 4, 5? I can see how to do this with a For loop and a procedural style, but I am wondering if an easy functional style solution is possible.

Similar to this:

 1 == Mean[{2, 3, 4, 5}]
2 == Mean[{1, 3, 4, 5}]
3 == Mean[{1, 2, 4, 5}]


P.S. I plan on using a more elaborate comparison, but == seemed like an easy one for this example.

• If by "compare" you mean testing whether the values are equal, it'd be useful to notice that if a value is equal to the mean of the rest of the list, then the same value is equal to the mean of the entire list. So you only have to compute the mean once. Commented Jan 3, 2019 at 9:03
• If you are curious, the reason I am doing this is because I am a microscopist doing image alignment with tiny beads. I want to take the displacement of each bead an see if it falls within some arbitrary threshold compared to all the other beads. Any bead that drifts outside this threshold should be discarded because it was probably perturbed in some way different than the rest of the beads :). IE i want to take the displacement of one bead and compare to the average of all the rest of the beads. (for all the beads) Commented Jan 3, 2019 at 9:11
• olliepower, can lst have duplicate elements?
– kglr
Commented Jan 5, 2019 at 9:42
• Why not use something simple like MeanFilter[lst, 2] - lst? That way you can play with different smoothing filters, too (e.g. GaussianFilter, MedianFilter) Commented Jan 5, 2019 at 10:03
• Yes, @kglr lst can have duplicate elements Commented Jan 29, 2019 at 22:21

ClearAll[subMeans]
subMeans = (Total[#] - #)/(Length[#] - 1) &;


Examples:

lst = {a, b, c, d};
subMeans[lst]


{1/3 (b + c + d), 1/3 (a + c + d), 1/3 (a + b + d), 1/3 (a + b + c)}

subMeans[{a, b, b, b}]


{b, 1/3 (a + 2 b), 1/3 (a + 2 b), 1/3 (a + 2 b)}

MapThread[Equal, {#, subMeans @ #}]& @ lst


{a == 1/3 (b + c + d), b == 1/3 (a + c + d), c == 1/3 (a + b + d), d == 1/3 (a + b + c)}

MapThread[Equal, {#, subMeans @ #}]& @ Range[5]


{False, False, True, False, False}

Update: For checking equality, there is a simpler way (because $$x_i = \frac{\sum_{j \neq i}^{n} x_j}{n-1}$$ iff $$x_i =\frac{\sum_{j = 1 }^{n} x_j}{n}$$):

Thread[# == Mean[#]] &@Range[5]


{False, False, True, False, False}

• Changed my accepted answer to this one, as this is what I am now using in my implementation. This method does not fail when elements are repeated in a list. Commented Feb 2, 2019 at 1:41

if you want to choose a specific element use

F[x_] := Mean@Complement[lst, {x}]
1 == F[1]
2 == F[2]
3 == F[3]


False
False
True

Note

if you want to choose the first,second,nth element use

F[x_] := Mean@Complement[lst, {lst[[x]]}]
1 == F[1]
2 == F[2]
3 == F[3]


False
False
True

• This is the one I went with because the implementation is really easy to understand, its clear, and it is short :) Commented Jan 3, 2019 at 23:50
• I'm glad I helped! Commented Jan 4, 2019 at 23:34
lst = {1, 2, 3, 4, 5};
(Last@# == Mean@Most@# &) /@ (RotateLeft[lst, #] & /@ Range@Length@lst)


{False, False, True, False, False}

Ugly version.

(First@# - Mean@Last@# == {0} &) /@ (TakeDrop[lst, {#}] & /@ Range@Length@lst)


If one takes stock of the fact that for a list of numbers, the iterative procedure described in the Q amounts to using the excluded entry along with the average calculated in the previous step, then correcting for the current step exclusion in order to obtain the desired figures makes implementing a functional solution straightforward.

crawlingComparison[list_, comp_: Equal] := Module[{e0, rest = Rest[list], len = Length[list]-1},

e0 = {#[[1]], #[[-1]], comp[#[[1]], #[[-1]]]} &@{First[list], Mean[rest]};

FoldList[
With[{ej = #2, mj = #1[[2]] + #1[[1]]/len - #2/len},
{ej, mj, comp[ej, mj]}] &, e0, rest][[All, -1]]
]


(irrelevant note: I'm calling it crawlingComparison because it feels like the preceding entry crawls up to the calculated mean figure and forces it to update itself.)

An example

using the list provided in the Q:

crawlingComparison[list]

{False, False, True, False, False}


Another example

If the desired comparison operator is different from Equal that can be accommodated using the second argument of crawlingComparison:

Using as a comparison operator the function comp = (#1 - #2)^2 <= 1& (just an arbitrary choice):

crawlingComparison[list, comp]

{False, False, True, False, False}


Using TakeList:

lst = {1, 2, 3, 4, 5};

TakeList[lst, {{#}, All}] & /@ Range@Length@lst


{{{1}, {2, 3, 4, 5}}, {{2}, {1, 3, 4, 5}}, {{3}, {1, 2, 4, 5}}, {{4}, {1, 2, 3, 5}}, {{5}, {1, 2, 3, 4}}}

To apply the predicate:

TakeList[lst, {{#}, All}] & /@ Range@Length@lst //
Map[Equal[First@First@#, Mean@Last@#] &]


{False, False, True, False, False}

MapIndexed[{#1,Delete[lst,#2]}&,lst]

(* {
{1,{2,3,4,5}},
{2,{1,3,4,5}},
{3,{1,2,4,5}},
{4,{1,2,3,5}},
{5,{1,2,3,4}}} *)


To take the Mean

MapIndexed[{#1,Mean@Delete[lst,#2]}&,lst]

(* {{1,7/2},{2,13/4},{3,3},{4,11/4},{5,5/2}} *)


To compare

MapIndexed[#1==Mean@Delete[lst,#2]&,lst]

(* {False,False,True,False,False} *)

list = {1, 2, 3, 4, 5};

With[{rot = RotateLeft[list, #] & /@ Range[0, Length @ list - 1]},
KeyValueMap[Equal] @ GroupBy[rot, First -> Rest, First /* Mean]]


{False, False, True, False, False}