A394696 Number of social networks of n persons in which the statement "My friends have on average more friends than I have" is true for a majority of the persons.

0, 3, 16, 495, 12063, 1405369, 142923452, 52807371633, 21999944586015, 29307773982747623, 49973613363224584262

Offset

2,2

Comments

This refers to the "friendship paradox" which goes back to S. L. Feld's 1991 article claiming that persons have fewer friends than their friends have. In contrast to Feld's results, which are based on mean values for the number of friends in the networks, this sequence considers majorities. a(n) stands for a weaker criterion than A394695.

The total numbers of social networks as defined by Feld are given by A006129. The proportion a(n)/A006129(n) exceeds 0.5 and supports Feld's claims for n>6.

a(n) can be defined in graph theoretic terms: a "network" is a labeled simple graph with n>1 non-isolated nodes.

If d_m(i) = degree of node i in the m-th graph, i = 1,..., n, m = 1,..., A006129(n), d_m(i,j) = degree of j-th node connected with node i, j = 1,..., d_m(i), and n_m = #{ i | Sum_j d_m(i,j)/d_m(i) > d_m(i)}, then a(n) = #{ m | n_m > n/2}.

Links

Table of n, a(n) for n=2..12.

Scott L. Feld, Why Your Friends Have More Friends Than You Do, Am. J. Sociol. 96(6) (1991), p. 1464-1477.

Example

There are 41 networks with 4 nodes (=A006129(4)). 16 of them meet the requirement, making a(4)=16; the edges are:
  1-2, 1-3, 1-4;
  1-2, 1-3, 1-4, 2-3;
  1-2, 1-3, 1-4, 2-4;
  1-2, 1-3, 1-4, 3-4;
  2-1, 2-3, 2-4;
  2-1, 2-3, 2-4, 1-3;
  2-1, 2-3, 2-4, 1-4;
  2-1, 2-3, 2-4, 3-4;
  3-1, 3-2, 3-4;
  3-1, 3-2, 3-4, 1-2;
  3-1, 3-2, 3-4, 1-4;
  3-1, 3-2, 3-4, 2-4;
  4-1, 4-2, 4-3;
  4-1, 4-2, 4-3, 1-2;
  4-1, 4-2, 4-3, 1-3;
  4-1, 4-2, 4-3, 2-3.

Mathematica

nmax = 7; a = {};
Do[an = 0; t = Tuples[{0, 1}, n (n - 1)/2];
  Do[v = t[[j]]; m = {ConstantArray[0, n]};
    Do[la = Last[NestList[Append[#, 0] &, Take[v, i], n - i]];
      m = Join[m, {la}]; v = Drop[v, i], {i, n - 1}];
    m = m + Transpose[m]; pr = Product[Total[m[[i]]], {i, n}];
    If[pr != 0, di = Table[Total[m[[j]]], {j, n}];
  dij = Table[Sum[di[[i]] m[[j]][[i]], {i, n}], {j, n}]];
  diff = dij/di - di; s = Sign[diff];
  If[pr != 0 \[And] Count[s, 1] > n/2, an++], {j, 2^(n (n - 1)/2)}];
  a = Join[a, {an}], {n, 2, nmax}]; a

Crossrefs

Cf. A393153, A394695, A006129.

Sequence in context: A176299 A081780 A362382 * A385921 A297118 A391915

Adjacent sequences: A394693 A394694 A394695 * A394697 A394698 A394699

Keyword

nonn,more,hard,nice

Author

Manfred Boergens, Mar 29 2026

Extensions

a(8)-a(9) from Sean A. Irvine, Apr 05 2026

a(10) from Bert Dobbelaere, Apr 06 2026

a(11) from Bert Dobbelaere, Apr 08 2026

a(12) from Manfred Boergens, Apr 09 2026

Status

approved