A394696 - OEIS

%I #39 May 14 2026 15:17:03

%S 0,3,16,495,12063,1405369,142923452,52807371633,21999944586015,

%T 29307773982747623,49973613363224584262

%N 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.

%C 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.

%C 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.

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

%C 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}.

%H Scott L. Feld, <a href="https://www.jstor.org/stable/2781907">Why Your Friends Have More Friends Than You Do</a>, Am. J. Sociol. 96(6) (1991), p. 1464-1477.

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

%e   1-2, 1-3, 1-4;

%e   1-2, 1-3, 1-4, 2-3;

%e   1-2, 1-3, 1-4, 2-4;

%e   1-2, 1-3, 1-4, 3-4;

%e   2-1, 2-3, 2-4;

%e   2-1, 2-3, 2-4, 1-3;

%e   2-1, 2-3, 2-4, 1-4;

%e   2-1, 2-3, 2-4, 3-4;

%e   3-1, 3-2, 3-4;

%e   3-1, 3-2, 3-4, 1-2;

%e   3-1, 3-2, 3-4, 1-4;

%e   3-1, 3-2, 3-4, 2-4;

%e   4-1, 4-2, 4-3;

%e   4-1, 4-2, 4-3, 1-2;

%e   4-1, 4-2, 4-3, 1-3;

%e   4-1, 4-2, 4-3, 2-3.

%t nmax = 7; a = {};

%t Do[an = 0; t = Tuples[{0, 1}, n (n - 1)/2];

%t   Do[v = t[[j]]; m = {ConstantArray[0, n]};

%t     Do[la = Last[NestList[Append[#, 0] &, Take[v, i], n - i]];

%t       m = Join[m, {la}]; v = Drop[v, i], {i, n - 1}];

%t     m = m + Transpose[m]; pr = Product[Total[m[[i]]], {i, n}];

%t     If[pr != 0, di = Table[Total[m[[j]]], {j, n}];

%t   dij = Table[Sum[di[[i]] m[[j]][[i]], {i, n}], {j, n}]];

%t   diff = dij/di - di; s = Sign[diff];

%t   If[pr != 0 \[And] Count[s, 1] > n/2, an++], {j, 2^(n (n - 1)/2)}];

%t   a = Join[a, {an}], {n, 2, nmax}]; a

%Y Cf. A393153, A394695, A006129.

%K nonn,more,hard,nice

%O 2,2

%A _Manfred Boergens_, Mar 29 2026

%E a(8)-a(9) from _Sean A. Irvine_, Apr 05 2026

%E a(10) from _Bert Dobbelaere_, Apr 06 2026

%E a(11) from _Bert Dobbelaere_, Apr 08 2026

%E a(12) from _Manfred Boergens_, Apr 09 2026