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

Question

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.

Answer 1

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}

Answer 2

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

Answer 3

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)

Answer 4

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}

Answer 5

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}

Answer 6

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} *) 

Answer 7

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}