生命遊戲與整理房間

引論

我自己的房間一直很混亂，偶爾清理整潔，不過幾天，便又迴歸混亂。想來當似熱力學中的「熵增原理」。

然而耗散系統卻可以自然的形成某種「形式」，赫爾曼·哈肯在《協同學》中介紹了一個現象：用適當的方式加熱液體，液體會形成穩定的、週期性的形狀。即它自發的形成了某種秩序。

但整理房間、整理物件，最要緊的便是「簡單」，複雜的方法總難堅持。而基於啓發式策略的「生命遊戲」則足夠簡單，也可以形成某種秩序，可以試着用它來整理房間。

Game of Life

所謂「生命遊戲」（Game of Life），就如下圖所示，是在一個棋盤之中，有黑色的點，有白色的點。黑色代表這裏有一個點，通過簡單的規則，產生豐富的圖樣。

Game of Life

它的基本規則是：

1. 當一個點周圍的點的數量高於某數時，它將因爲太擁擠而死亡；
2. 當小於某數時，將因爲太孤獨而死亡。
3. 當某空白點周圍的黑子數目符合某條件時，將會產生出一個新的點。

Game of Life

通過這種簡單的過程，可以形成非常非常複雜而有序的結構，比如上圖，是一個週期結構，穩定的放在那裏。

這與我們收拾房間在某些方面是相似的。

1. 房間內的物體不可以太過擁擠，太擁擠則難以取用；
2. 房間內的物體不可太過零散，太零散則雜亂無章；

基於上邊兩條「基本法」，可以構建一個自動機模型。不過這裏與生命遊戲有一點差別：

房間裏的東西不會無故丟失，也不會無故產生

也就是說，過於擁擠、零散的點上的物體，要改換位置，這個變換的方式當有所講究，即優先放到與自己類型相同的物體旁邊。

注意到這個時候，我們所有的規則都是基於單個點的，這是這種策略的一個優勢：即我們在收拾房間的時候，只需要考慮有限的物體。

代碼模擬

我們使用Mathematica建模模擬，下面是對代碼的一些解釋：

建立隨機初始值：

代碼

這段代碼是用來初始化和建立地圖的，其中：

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[]函數本身就是依照m與mx矩陣給出一個隨機座標，從而決定當前點移動到哪一點。

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左右（多次實驗都穩定在這個值）。並且這個圖是考慮了隨機增減物品後的圖像，其對隨機增加的物品的承受力比較強。

當然，我自己也要在實際生活中實踐這個啓發式策略，看看是否能產生效用。