前段时间，知乎网举办了世界杯比分预测大赛。
在两轮竞猜之中，我一个完全不懂球的人都稳定在前200名，在好友圈内一直保持第一，虽然最后没有拿到奖，但我构建的数学模型总还是有一些参考价值的。
首先，普及一个定理：
「多样性预测定理」（Diversity Prediction Theorem）
看论文点这里（复制到浏览器中）：
http://www.cscs.umich.edu/~spage/ONLINECOURSE/prediction.pdf
写成数学公式，就是这样：（这是一个恒等式）
多样性预测定理
其中，Real，就是实际值，x的平均值作为预测值，我们可以看到，其意义就是：
误差之平方 = 每一项误差的平方平均值 - 方差
（按照其原话，便是：Collective Error = Average Individual Error − Prediction Diversity）
大家可以用下面的 Mathematica 代码，或者 Wolfram Language 检验：
D\[Sigma]2[list_, R_] :=
With[{Alist = Total[list]/Length[list], n = Length[list]}, 1/n \!\(
\*UnderoverscriptBox[\(\[Sum]\), \(i = 1\), \(n\)]
\*SuperscriptBox[\((list[[i]] - R)\), \(2\)]\) - 1/n \!\(
\*UnderoverscriptBox[\(\[Sum]\), \(i = 1\), \(n\)]
\*SuperscriptBox[\((list[[i]] - Alist)\), \(2\)]\)]
上面的式子虽然是一个可以严格证明的恒等式，统计学家亦做过一个实验，他们让一群人猜测一头牛的质量，每个人都可以自由猜测，猜测出来的结果，很多人预测结果非常离谱（这以为着），然而其预测值的平均值却非常接近牛的质量（误差小于0.5％）。
较为不严格的说，减小预测最终误差的方法在于增大方差。
知乎公开了所有的投票数据，我们可以利用它，一个简单的想法便是：取所有用户投票的平均值。
这样就获得了最初的算法：
这样的算法，成功预测了第一轮前半部分 70% 的比赛结果。对，只要获得大量知友的投票数据即可。
当然，如果想让结果看起来更加舒服，可以写成这样：
比如这是刚开始巴西对阵克罗地亚的比赛：
In[5]:= data001 = {176, 701, 1240, 917, 160, 82, 25, 18, 14};
In[6]:= GoAuto[data001]
Out[6]= -2
模型表现不错。
当然，我们要注意已有的投票数对于知友投票的影响。
多样性预测定理的另一个表述便是：不同的人，对某一事物进行预测，他们使用不同的模型，而最终加权平均的结果，会更加接近真实值。
但是一些知友使用的无用的模型，比如随机投票、从众、求异，这样没有营养的模型对预测结果是没有帮助的，我们要将之剔除。所以我们要获得不同时段的投票数据。
比如这一场巴西 VS 智利的比赛，两次获得的投票数据为：
data6271 = {36, 398, 2033, 1813, 125, 110, 25, 10, 34};
data627x = {129, 1172, 5572, 4931, 367, 364, 80, 40, 164};
data627y = {199, 1658, 7604, 6775, 622, 562, 133, 79, 252};
我们将新的数据，除以旧的数据，得到这样有趣的图像：
大家似乎并不愿意从众，反而是愿意求异，我们将这样的「无用」的模型剔除。获得了这样的结果：
代码部分
「多样性预测定理」的思想非常简单，但结果还是相对比较好的（至少我这个不懂球的能两次都保持在前200），下面是一些代码（Mathematica/Wolfram Language）
基本预测：
GoBasic[list_] := {-4, -3, -2, -1, 0, 1, 2, 3, 4}.list/Total[list]
Aver[list_] := Total[list]/Length[list]
Si2[list_] := With[{aver = Aver[list], n = Length[list]}, \!\(
\*UnderoverscriptBox[\(\[Sum]\), \(i = 1\), \(n\)]
\*SuperscriptBox[\((list[\([\)\(i\)\(]\)] - aver)\), \(2\)]\)/n]
GoAuto[list_] := Round[GoBasic[list]]
剔除无用模型：
Show[ListLinePlot[N[data627x/data6271], PlotRange -> {{0, 9}, {0, 5}},
Mesh -> All],
Plot[a (x - b)^2 + c /. root1, {x, 0, 9}, PlotStyle -> Red]]
正态分布拟合：
Gauss[list_, p_] :=
With[{fit =
FindFit[list/Total[list],
1/(Sqrt[2 \[Pi]] \[Sigma]) E^(-(p - \[Mu])^2/(
2 \[Sigma]^2)), {\[Sigma], \[Mu]}, p]},
Show[ListPlot[list/Total[list], PlotStyle -> Red],
Plot[E^(-((p - \[Mu])^2/(2 \[Sigma]^2)))/(
Sqrt[2 \[Pi]] \[Sigma]) /. fit, {p, 0, 10}, Filling -> Bottom],
PlotRange -> All]]
多重正态分布拟合：
Fitcomplex[list_, prelist_] :=
FindFit[list/
Total[list], {u*1/(Sqrt[2 \[Pi]] \[Sigma]) E^(-(p - \[Mu])^2/(
2 \[Sigma]^2)) + (1 - u)*1/(Sqrt[2 \[Pi]] \[Sigma]2)
E^(-(p - \[Mu]2)^2/(2 \[Sigma]2^2)), 0 < u < 1, 0 < \[Mu] < 9,
0 < \[Mu]2 < 9}, {{\[Mu], prelist[[1]]}, {\[Mu]2,
prelist[[2]]}, \[Sigma], \[Sigma]2, u}, p]
Plotcomplex[list_, getlist_] :=
Show[Plot[(u E^(-((p - \[Mu])^2/(2 \[Sigma]^2))))/(
Sqrt[2 \[Pi]] \[Sigma]) + ((1 - u) E^(-((p - \[Mu]2)^2/(
2 \[Sigma]2^2))))/(Sqrt[2 \[Pi]] \[Sigma]2) /. getlist, {p, 0,
10}, Filling -> Bottom],
ListPlot[list/Total[list], PlotStyle -> Red],
Plot[((1 - u) E^(-((p - \[Mu]2)^2/(2 \[Sigma]2^2))))/(
Sqrt[2 \[Pi]] \[Sigma]2) /. getlist, {p, 0, 9}, Filling -> Bottom,
PlotRange -> All],
Plot[(u E^(-((p - \[Mu])^2/(2 \[Sigma]^2))))/(
Sqrt[2 \[Pi]] \[Sigma]) /. getlist, {p, 0, 9}, Filling -> Bottom,
PlotRange -> All]]
拟合的结果就是这样的，但结果与一开始的模型差别不大，就没有怎么用：
