生命游戏有意思的文章

生命游戏与整理房间

2015-06-12  本文已影响882人  章彦博

引论

我自己的房间一直很混乱,偶尔清理整洁,不过几天,便又回归混乱。想来当似热力学中的「熵增原理」。

然而耗散系统却可以自然的形成某种「形式」,赫尔曼·哈肯在《协同学》中介绍了一个现象:用适当的方式加热液体,液体会形成稳定的、周期性的形状。即它自发的形成了某种秩序。

但整理房间、整理物件,最要紧的便是「简单」,复杂的方法总难坚持。而基于启发式策略的「生命游戏」则足够简单,也可以形成某种秩序,可以试着用它来整理房间。

Game of Life

所谓「生命游戏」(Game of Life),就如下图所示,是在一个棋盘之中,有黑色的点,有白色的点。黑色代表这里有一个点,通过简单的规则,产生丰富的图样。

代码

这段代码是用来初始化和建立地图的,其中:

randM = map*
   Table[RandomChoice[{1, 1, 3} -> {1, 2, 0}], {i, 1, 40}, {j, 1, 
     40}];

map矩阵数乘随机产生的矩阵,用来使其符合地图之要求。

随机选取点进行处理,并依照一定规则移动细胞:

PRandom[m_, mx_] :=(*根据mx矩阵的高斯卷积产生加权随机数,决定与之交换的点*)
 Module[{pm = GaussianFilter[m, 2], wlist = {}, elist = {}},
  pm = Table[
    If[mx[[i]][[j]] == 0 && map[[i]][[j]] == 1, pm[[i]][[j]], 0], {i, 
     1, Length[m]}, {j, 1, Length[m[[1]]]}];
  wlist = Flatten[pm];
  elist = 
   Flatten[Table[{x, y}, {x, 1, Length[m]}, {y, 1, Length[m[[1]]]}], 
    1];
  RandomChoice[wlist*wlist -> elist]
  ]

m是某颜色物体的矩阵,mx是各个颜色物体的矩阵,其中pm是对m的高斯核卷积,以此算出随机座标的权值。PRandom[]函数本身就是依照mmx矩阵给出一个随机座标,从而决定当前点移动到哪一点。

PRandomN[m_, n_] :=
 (*对颜色为n的点进行操作*)
 Module[{m2 = 
    Table[If[m[[i]][[j]] == n, 1, 0], {i, 1, Length[m]}, {j, 1, 
      Length[m[[1]]]}]}, PRandom[m2, m]]

PRandom则是依照颜色n给出随机座标。

选取一点周围的八个点:

TakeAroundList[list_, p_] := Module[{len = Length[list]},
  Which[
   1 < p < len, list[[p - 1 ;; p + 1]],
   p == 1, {list[[len]]}~Join~list[[1 ;; 2]],
   p == len, list[[len - 1 ;; len]]~Join~{list[[1]]}
   ]
  ]

TakeAround[m_, {x_, y_}] := 
 Transpose@TakeAroundList[Transpose@TakeAroundList[m, x], y]

这两段代码比较简单,不做详细叙述,功能就是给出某一座标x,y周围的八个点(考虑了边缘部分的问题)。

随机增减物体:

PutInAndDelet[m_, {p1_, p2_}] := 
 Module[{m2 = m, pm = (1 - Sign /@ m)*map, wlist = {}, elist = {}, 
   x = 1, y = 1, maxColor = Max[m], pm2 = {}, xd = 1, yd = 1},
  pm2 = (1 - pm)*map;
  wlist = Flatten[pm];
  elist = 
   Flatten[Table[{x, y}, {x, 1, Length[m]}, {y, 1, Length[m[[1]]]}], 
    1];
  {x, y} = RandomChoice[wlist -> elist];
  {xd, yd} = RandomChoice[Flatten[pm2] -> elist];
  If[RandomReal[] < p1, m2[[x]][[y]] = RandomInteger[{1, maxColor}]];
  If[RandomReal[] < p1, m2[[xd]][[yd]] = 0];
  m2
  ]

随机向内撒入物体,随机模式依照先前的PRandom[]思想。

迭代一次:

ChangeOne[m_] := 
 Module[{m2 = m, a = Length[m], b = Length[m[[1]]], 
   x = RandomInteger[{1, Length[m]}], 
   y = RandomInteger[{1, Length[m[[1]]]}], MRound = {}, MRound01 = {},
    n1 = 0, n2 = 0, p = 4, px = 0, py = 0},(*x,y随机生成,作为迭代对象的座标*)
  
  If[m[[x]][[y]] != 0,(*某点是物体的时候,执行下述操作*)
   MRound = TakeAround[m, {x, y}];
   MRound[[2]][[2]] = 0;
   MRound01 = Sign /@ MRound;
   n1 = Total[Flatten[MRound01]];(*以上操作给出其周围邻居数量*)
   {px, py} = PRandomN[m, m[[x]][[y]]];(*随机给出移动方位*)
   
   
   If[
    n1 != p, m2[[px]][[py]] = m[[x]][[y]]; m2[[x]][[y]] = 0(*若不符合宜居条件,则移动*)
    ]; m2,
   ChangeOne[m](*若此点为空,则递归直到此点非空*)
   ]
  
  ]

ChangeOne[]代表迭代一次,输入为一矩阵,输出亦为一矩阵。为了效率,地图数据使用全局变量。注释见代码。

有了ChangeOne[]函数之后,便可以使用Nest[]NestList[]函数对其进行迭代。

实际迭代实验:

mxList = NestList[Nest[ChangeOne, #, 1000] &, randM, 5];

Table[ArrayPlot[mxList[[i]], ColorFunction -> "Rainbow", 
  Epilog -> {Polygon[{{0, 40}, {11, 40}, {11, 29}, {0, 29}}], 
    Polygon[{{18, 0}, {18, 12}, {40, 12}, {40, 0}}]}], {i, 1, 6}]

给出如下图像:

迭代过程

可以看到其由随机、混乱的状态渐渐的变得有序。

我们还可以考察它的聚合度,聚合度定义为Count[Flatten[mr], mr[[2]][[2]]]/8,其越接近于1则越密集。下面是随着系统演化,聚合度变化的过程:

聚合度

可以明显的看到,其聚合度很快便上升到了约0.7左右(多次实验都稳定在这个值)。并且这个图是考虑了随机增减物品后的图像,其对随机增加的物品的承受力比较强。

当然,我自己也要在实际生活中实践这个启发式策略,看看是否能产生效用。

上一篇下一篇

猜你喜欢

热点阅读