用数据模拟你的人生,一人给你一块钱实操版

浏览: 1586

昨天转载了一篇文章引起了巨大的反响,大家的评论非常积极,阅读数也创了最近本博的新高,毕竟分钱的事情是大事啊!我也立了个flag说今天公布Excel的实现过程。现在就兑现给大家。

image.png

没有看昨天文章的朋友建议先预习一下,以免后面看不懂(戳下面的链接)。

一人给你一块钱你就会富有了吗?我算给你看!

很有意思吧,人生竟然这样残酷,我们屌丝完全没有活路了。别忙,如果将文中的100块初始资金换成1000块或5000块,文中的结论就完全不靠谱了,此时几乎接近平均分配。所以预设结论很重要啊!大家是不是又看到了一丝希望?

往下看,我让你自己来决定自己的人生!模拟人生游戏开始。

有很多数据分析软件可以这个算法过程,今天我用excel来玩。当然必须要用vba代码实现整个循环过程。昨晚看见一个朋友@EXCELers 在我微博留言,其实他已经将代码写出来了(我的朋友圈excel高手就是多),索性就利用他的代码修改修改来分享给大家。

他的原始代码如下(懂的朋友可以直接复制,不懂的朋友文后有福利)

Option Explicit

Sub kjxg()
    Dim arr, i&, j&, x&
    ReDim arr(1 To 100, 1 To 1)
    For i = 1 To 100
        arr(i, 1) = 100 '每人初始化100元
    Next
    For i = 1 To 17000 '分配17000次
        For j = 1 To 100 '每个人开始发钱啦
            If arr(j, 1) > 0 Then '如果这人还有钱,则开始随机发钱
                x = j
                Do While x = j '自己不能给自己钱,随机值不能等于自己
                    x = Application.RandBetween(1, 100) '随机取人
                Loop
                arr(j, 1) = arr(j, 1) - 1 '自己减1元
                arr(x, 1) = arr(x, 1) + 1 '别人加1元
            End If
        Next
    Next
    [a2].Resize(100, 1) = arr
    Range("a1").Sort [a1], xlAscending, Header:=xlYes
    MsgBox "模拟结算结束!"

End Sub

这段代码实现了100人,每人初始100元玩游戏的模拟运算过程。程序中的中文是解释该段代码的作用。

没有VBA基础的朋友看这段,高手们请忽略:

1、新建一个文件,按快捷键Alt+F11调出vba后台(如果没反应请按Fn+Alt+F11)。就是如下图这个样子。

image.png

2、把上面这段代码直接复制到上图中的空白区域(有可能需要双击一下左边的sheet1)。如下图:

image.png

3、回到工作簿,找到菜单中的开发工具。然后依次点击下面三个红框,开发工具-插入-按钮。ps:如果你的电脑没有开发工具的选项,请自行百度“excel如何调出开发工具”,需要注意的是excel版本不同方法会略有不同。

image.png

4、在空白处画一个按钮出来,其实就是画一个方形,此时会自动弹出一个对话框,先选中kjxg这个宏,然后点确定即可,如下图。

image.png

5、大功告成,你的页面会出现一个下图的框框(按钮1)。

image.png

这样这个宏的过程就搞定了,接下来就可以运行程序了。不过运行前建议在A1单元格输入“资金”两字,不然运行结果会有一个小瑕疵。点击上图中的“按钮1”,等待片刻就出来下图的分配结果了(结果是按升序排列的,最后一个值就是拿到最多钱的那个土豪,数字相当于每个人手中最后的现金额)。注意此图我只是截了部分数据,并且一般情况下你的运行结果和我的肯定不一样。

image.png

用生成的数据做一个柱状图就不累赘了,再次点击“按钮1”运行宏就会生成第二次的模拟结果,其实结果是差不多的了。

当然如果人生只有这一个结果还有什么意思呢?有没有办法模拟更多的场景?当然可以,改代码中的参数而已。上面的代码有四个参数可以修改:初始资金、参与人数、游戏次数、每次游戏的筹码金额。下面的模拟过程也按此顺序排,如100-100-17000-1。代表每人初始资金100元,共100人参与游戏,玩1.7万次,每次筹码1元。

修改不同的参数,你会发现人生大不同:

1、原始资金越大,比如每人初始资金1000元,分配越平均。原始资金越小贫富分化越严重(可以从最大资金除以初始资金倍数来看)。初始资金10元(10-100-10000-1)时,人生赢家的资金可以增长6-7倍,当初始资金1000元(1000-100-10000-1)人生赢家资金只能增长1.2-1.3倍左右,呈现平均分配态势。所以原文中的论述初始资金100决定了后面的所有人生大道理。

2、游戏人数和最后的分配结果其实没有太多关系,100人玩(100-100-10000-1)时人生赢家资金增长3.4倍,1000人玩(100-1000-10000-1)时是3.8倍,差不多。再次提醒,你的模拟结果和我的结果会略有不同。

3、游戏次数和人生赢家的资金成正比,但是非线性关系。就是不停的消灭小散户后大户的资金就更加集中。我的模拟结果:100-100-5000-1时人生赢家资金增长2.4倍。100-100-10000-1时资金增长4.3倍,100-100-17000-1是3.8倍,100-100-30000-1是4.5倍 。

4、还可以改变每次的筹码,100-100-10000-1时人生赢家增长3.4倍,100-100-10000-2时时5.8倍(即每人每次掏两元)。

整个模拟其实很有趣,不过如果每次都去改上面代码中的参数其实很麻烦的,我增加了几个自定义的单元格,同时修改了一下代码。只要在对应单元格中修改参数就可以了。

image.png

Option Explicit
Sub kjxg()    
    Range("A5").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents '清除上次运行的数据       
    Dim arr, i&, j&, x&
    ReDim arr(1 To Range("d2"), 1 To 1)
    For i = 1 To Range("d2")
        arr(i, 1) = Range("C2") '每人原始资金
    Next
    For i = 1 To Range("E2") '分配游戏次数
        Range("M2") = i
        For j = 1 To Range("d2") '每个人开始发钱啦
            If arr(j, 1) > 0 Then '如果这人还有钱,则开始随机发钱
                x = j
                Do While x = j '自己不能给自己钱,随机值不能等于自己
                    x = Application.RandBetween(1, Range("D2")) '随机取人
                Loop
                arr(j, 1) = arr(j, 1) - 1 '自己减1元
                arr(x, 1) = arr(x, 1) + 1 '别人加1元
            End If
        Next j        
        [a2].Resize(Range("d2"), 1) = arr '给A列赋值                        
    Next i    
    Range("a1").Sort [a1], xlAscending, Header:=xlYes '排序    
    MsgBox "模拟计算结束!"

End Sub

大家可以直接把这段代码按前面的方式复制到vba后台就行,注意自定义区域参数不要忘了填。更多条件你们可以通过修改代码来实现。需要注意的是参与人数和分配次数的数字大小直接影响程序运行的时间,越大运行时间越长。我测试100人1.7万次游戏的数据一般42秒可以运行完,如果你的电脑本来就很卡的那种,建议慎重测试大数字,如果非要测试最好选空闲时间,让机器慢慢跑,当然跑死了我也不管。

福利来了,在本公众号私信回复(注意不是评论)关键字“人生赢家”就可以获得这个模板的下载地址,下载下来直接运行就可以了。产品界面如下。


image.png

这种循环方式模拟不同场景其实挺有意思的,数据分析有时候就是玩,玩出兴趣,玩出高度。最后给大家出一个题:如何用上面的方法制定21点游戏的最佳策略?

本文阅读量超过1万我就公布模板。

推荐 0
本文由 黄成明 创作,采用 知识共享署名-相同方式共享 3.0 中国大陆许可协议 进行许可。
转载、引用前需联系作者,并署名作者且注明文章出处。
本站文章版权归原作者及原出处所有 。内容为作者个人观点, 并不代表本站赞同其观点和对其真实性负责。本站是一个个人学习交流的平台,并不用于任何商业目的,如果有任何问题,请及时联系我们,我们将根据著作权人的要求,立即更正或者删除有关内容。本站拥有对此声明的最终解释权。

0 个评论

要回复文章请先登录注册