前言:
接續2018年農曆過年時期, 在家裡發現一本古老的遊戲程式設計書籍 「BASIC 遊戲程式集」 事件,
之後翻到這本書的第二冊, 「BASIC 遊戲程式集(二) (1984年1月出版」, 郭飛龍 編譯, 慈恩書局總經銷), 第六章, 生命遊戲, 所以來練習一下吧! 來用 FORTH 撰寫一次這個電腦科學歷史上非常有名的遊戲吧!
威康生命遊戲:
這個有名的遊戲, 透過 wiki 百科全書, 其實正式的名字叫做 威康生命遊戲 (Conway's Game of Life). 這裡泛科學也有詳細的介紹.
為什麼這麼有名呢? 應該要歸功於美國著名的科學雜誌, 科學美國人 (Scientific American), 中有個有名的數學專欄, 作者馬丁葛登能的的介紹. 這使得這個由英國劍橋大學的數學系教授約翰康威(John Horton Conway) 在1970年所設計生命遊戲一砲而紅, 並廣為人知!
用 FORTH 語言來描述生命規則:
來展現 FORTH 語言的強大威力了! 來回想一下, 語言是用來做什麼的?? 是用來描述問題的!! 特別是高階語言, 是給人類來描述問題, 傳遞思想的! 大部分的程式語言, 雖然說是高階語言, 但是還是得遵循一定所謂電腦科學的語法, 讓編譯器可以看得懂, 這樣就限制住語意的打造跟傳遞.
唯獨只有 FORTH, 因為是透過堆疊來傳遞參數的, 整個傳遞的過程可以變成是自然地, 隱含地, 隱藏地發生. 加上可以任意的打造所需的指令, 使得語意的呈現更為自然跟簡潔, 這是其他語言很難企及的!
所以 FORTH 語言可以非常非常高階的, 高階到它可以跳脫電腦程式的範疇, 用來寫詩, 它可以像數學語言一樣很漂亮簡潔描述事情. 就像我們使用其他高階的人類語言如英文, 西班牙文, 中文... 般!
下面就來展現 FORTH 這方面高階語言的威力吧!
因為我們程式碼是英文的, 所以我們來看看 wiki 百科英文版對這個威康生命遊戲對於生命規則的描述吧! 來把這段英文描述, 一字不差的轉成 FORTH 語言的描述. (或是俗稱的虛擬語言)
Every cell interacts with its eight neighbours, which are the cells that are horizontally, vertically, or diagonally adjacent. At each step in time, the following transitions occur:
1. Any live cell with fewer than two live neighbours dies, as if caused by underpopulation.
2. Any live cell with two or three live neighbours lives on to the next generation.
3. Any live cell with more than three live neighbours dies, as if by overpopulation.
4. Any dead cell with exactly three live neighbours becomes a live cell, as if by reproduction.
上面那四條生命遊戲的規則, 從英文轉成 FORTH, 就變成下面這樣.
: Judgement_From_The_God ( --)
#neighbors@ 四周鄰居的生命數目
liveCell? 這是個 live cell 嗎?
if ( liveCell) 是 live cell!
dup 0 2 within if die then 四周鄰居介於 0-1 之間(包含)則凋亡
dup 2 4 within if survive then 四周鄰居介於 2-3 之間(包含)則生存下來
3 > if die then 四周鄰居大於 3 則 死亡
else ( deadCell) 不是 live cell, 是 dead cell
3 = if born then 四周鄰居剛好 3 個 則誕生新生命
then
;
轉成中文, 整個規則的中文描述如下
生命遊戲中，對於任意細胞，規則如下：
每個細胞有兩種狀態-存活或死亡，每個細胞與以自身為中心的周圍八格細胞產生互動。（如圖，黑色為存活，白色為死亡）
1. 當前細胞為存活狀態時，當周圍低於2個（不包含2個）存活細胞時， 該細胞變成死亡狀態。（模擬生命數量稀少）
2. 當前細胞為存活狀態時，當周圍有2個或3個存活細胞時， 該細胞保持原樣。
3. 當前細胞為存活狀態時，當周圍有3個以上的存活細胞時，該細胞變成死亡狀態。（模擬生命數量過多）
4. 當前細胞為死亡狀態時，當周圍有3個存活細胞時，該細胞變成存活狀態。 （模擬繁殖）
有沒有覺得 FORTH 很威啊! 簡潔漂亮的把戎長英文規則的描述, 轉變成簡簡單單的幾個字. 寫程式, 偶而我們會用虛擬語言來描述問題, 整理思緒. FORTH 很威的地方是, 虛擬語言一描述出來, 就可以是最終的程式碼了!
熟悉的會知道, 這是 Top-Down 由上往下的程式發展方法. FORTH 是兩種不管是由上往下 Top-Down, 或是由下往上 Down-Top 的程式發展方法, 兩個都支援的! (FORTH 比較喜歡 Down-Top, 由下面往上來發展!)
生命遊戲的世界
在建構這個生命遊戲程式, 因為整個生命遊戲的世界, 是在一個巨大的二維陣列之中. 所以這個程式中, 不可避免的, 最適合的資料結構來建構這整個生命的世界還是個二維陣列啦!
對於描述一個二維陣列而言, 最習慣的是利用 X, Y 笛卡爾座標來描述位置, 陣列是有限的, 所以有邊界的問題. 例如, X = 0 .. Xmax, Y = 0 .. Ymax. 總共有四個邊界! 但這個生命遊戲, 我們希望它的世界是連續的, 沒有邊界的. 也就是說, 我們要把 [X=0, Y=任意] 跟 [X=Xmax, Y=任意] 的這兩個個邊界給縫起來, 及 [X=任意, Y=0] 跟 [X=任意, Y=Ymax] 這兩個邊界給縫起來. 這樣這個世界是個沒邊界的連續世界. (X, Y 可以是任意值, 最終還是會落在 X=0..Xmax, Y=0..Ymax 之間)
怎麼做呢, 透過下面取餘數的數學式就可以囉!
X' = X mod Xmax, Y' = Y mod Ymax
這樣跑出去 X = 0 .. Xmax, Y = 0 .. Ymax 的座標數值, 透過取餘數, 就可以無誤地落回範圍內, 邊界不見了!
加上二維陣列位址的計算後, 整個位址計算公式如下
給一個座標 (X,Y) 這個這陣列元素的真實記憶位址為 (假定元素大小為一單整數的大小: cell)
addr = addr0 +(mod(X, Xmax) + mod(Y, Ymax)* Xmax) cells
FORTH 的陣列
之前前一篇的剪刀石頭布的 FORTH 程式中有提到! FORTH 語言的標準裡, 沒有陣列的定義. 因為 FORTH 覺得, 語言裡面對陣列的使用, 如果固定下來是非常沒有效率的事, 將會限制住使用者以非常沒有效率的方法來寫程式. 所以語言裡面, 只提供最基本的工具, 如真的需要使用陣列, 須由使用者自行決定.
這裡就是個明顯的例子囉! 這裡的陣列, 因爲生命遊戲對世界無邊界的需求, 我們需要把這個取餘數的程式碼實做進來, 且不需做任何範圍檢查.
對於 FORTH 陣列的定義, FORTH 教科書的標準做法就是用 create - does> 這個具有物件繼承特性的軟體技術來執行. 筆者自己的原則是, 強用 create-does> 反而容易造成可讀性降低. 所以是看情況來使用. 假如程式裡只有一個陣列, 為了可讀性跟簡潔, 筆者會選擇使用定義一特定詞來計算陣列位址, 除非有用到兩個以上的相同陣列, 這時候才會選擇使用 create-dose>
給 FORTH 初學者,
create - does> 是用來定義一些具有相同軟體動作的不同軟體元件, 是一種類似目前大家很熟悉的物件技術啦! 例如我們要定義兩個二維陣列, 它們其實在計算位址的計算方式都是一樣的, 只是元件不一樣, 這時候就很適合用這個方式來定義. create-does> 就是來定義跟大量複製這種有相同軟體動作但不同元件的一個軟體模板. 透過這個模板, 就可以大量製造出一堆以相同的動作在運作的不同軟體元件.
FORTH 的 create does> 語法如下,
: 軟體模板名字
create 從輸入緩衝區取出一個新字串, 在字典裡創造一個新詞, 這個詞執行的時候會把詞的位址丟出來
程式碼, 定義在翻譯時要做什麼事.
(例如: 在字典裡面為新定義的新詞預留空間)
does> 編譯一個指令, 讓這個新詞執行時可以跳到這裡之後的程式碼.
程式碼, 定義執行時要做什麼事.
(例如: 計算陣列元素的起始位址)
;
所以生命遊戲, 沒有邊界限制的二維陣列定義如下, 這裡會大量用到 FORTH 的堆疊操作, 可讀性會變得很低. 這是 create - does> 這樣架構下必然的問題, 記憶位址的計算, 本來就別奢望太高的可讀性. 但是也沒那麼糟, 筆者的習慣, 只要右邊詳細加註前後堆疊變化的狀況, 其實可讀性也不差啦! 一點問題也沒有的咩!
: array
create ( xlim ylim --) 造個詞,執行的時候會把它的位址給丟出來.
2dup , , * cells allot 把ylim xlim存入字典 xlim*ylim cells 的空間預留出來.
does> ( x y -- addr )
( x y addr ) 新詞執行的時候會先丟個它的位址
dup @ swap ( x y ylim addr) 位址的第一個值會是 ylim, 取出後交換
cell+ >r ( x y ylim | addr+1cell)位址加一, 暫存到返回堆疊
mod ( x y' | addr+1cell) 算一下 mod(y,ylim)
r@ @ tuck * ( x xlim y'*xlim | addr+1cell) 位址加一裡的值就是 xlim
-rot mod + cells 計算 mod(x,xlim) + xlim*mod(y,ylim) cells
r> cell+ + 加上起始位址addr=addr0+(mod(x,xlim)+xlim*mod(y,ylim)+2) cells
;
給 FORTH 初學者, 使用方式
定義
16 19 array OhiYooo 利用 array 軟體模板指令, 定義一個 OhiYooo 軟體元件(在FORTH裡面, 仍然是字典裡的詞)
這個 OhiYooo 元件, 19 跟 16 這兩個X, Y上限值會被存放在元件裡面, 接續下來會預留出 19*16 = 304 個 cells 單整數的空間
55 14 array World 利用 array 軟體模板指令, 定義一個 World 軟體元件
這個 World 元件, 55 跟 14 這兩個值會被存放在元件裡面, 接續下來會預留出 55*14 = 770 個 cells 單整數的空間
執行
5 10 OhiYooo @
OhiYooo 軟體元件會先將它的位址(假設為 567261) 放上堆疊, 所以推疊上有 5 10 567261 三個數字, 然後跳去執行定義 OhiYooo 軟體元件的軟體樣板 array 裡 dose> 後面所描述的程式碼. 軟體樣板 array 的這段程式碼, 會用堆疊上的三個數字 5 10 567261 (x=5, y=10, addr0=567261) 計算出 x=5, y=10 的這個陣列元素的真實記憶位址. 提供給後面的 @指令 對這個陣列元素做進一步的陣列取值動作.
31416 32 3 World !
World 軟體元件會先將它的位址(假設為 676621) 放上堆疊, 所以推疊上有 31416 32 3 376621 四個數字, 然後跳去執行定義 World 軟體元件的軟體樣板 array 裡 does> 後面所描述的程式碼. 軟體樣板 array 的這段程式碼, 會用堆疊上的三個數字 32 3 676621 (x=32, y=3, addr0=676621) 計算出 x=32, y=3 的這個陣列元素的真實記憶位址. 提供給後面的 !指令 對這個陣列元素做進一步的陣列存入 31416 數值的動作.
資料結構
來建構我們生命遊戲的世界吧, 一個生命遊戲世界的主陣列 world, 跟一個暫存的世界 world' ; 程式在對主世界 world 在做計算跟更新時, 因為會改變主世界的資料, 所以需要暫存世界 world' 的原始資料, 否則會計算錯誤.
20 constant sizeX
20 constant sizeY
sizeX sizeY array world \ main world for life
sizeX sizeY array world' \ temporary world for calculation
再來, 定義一下對這兩個世界存取更新的指令.
我們希望資料是可以穿透在不同指令的, 所以定義兩個變數 CurrentX, CurrentY 來指定目前正在計算操作的位置.
variable CurrentX
variable CurrentY
所以存取更新世界的指令以這兩個指定目前正在計算操作的位置的變數為基礎
取出目前正在計算的位置
: CurrentPosition@ ( -- x y) CurrentX @ CurrentY @ ;
資料: 0 = empty 空空如也, 1 = aLife 有生命在這裡
0 constant empty
1 constant aLife
判斷目前正在計算的位置有沒有生命存在啊?? 有的話送個 true 旗號出來. 剛剛有說過, 主 world 會不斷被計算更新, 所以必須要參考暫存的世界 world' 否則會計算錯誤.
: liveCell? ( -- f)
CurrentPosition@ world' @ aLife =
;
剛剛出生嗎?? 有的話送個 true 旗號出來. 這個指令是用來看看剛剛是不是有生命出生. 主world 是主要被計算更新的場所, 所以當然這個指令是檢查主 world
: JustBorn? ( -- f)
CurrentPosition@ world @ aLife =
;
接下來兩個是動詞, die 把目前這個位置的生命宰掉, 生命總數減一! born 從目前這個位置誕生一個新生命, 生命總數加一! 有了這幾個詞, 就可以抽象化底層的運作, 以很高階的方式開始給上層的指令操作囉.
: die ( --)
empty CurrentPosition@ world !
-1 #Life +!
;
: born ( --)
aLife CurrentPosition@ world !
1 #Life +!
;
FORTH 本身不是物件導向的語言, 但是這裡我們來展現一下 FORTH 的高階性. FORTH 可以非常非常高階的, 最上面那層, 可以非常的抽象, 可以跟底層抽離, 完全不需要知道底層是如何運作的. 所以底層可以被抽換, 絲毫不會影響所有的運作.
所以這裡會提供生命遊戲的兩個版本. 第一個版本是典型的版本, 第二個版本是透過底層資料結構跟計算的改變, 是個加速的版本. 這兩個版本, 最上面那層的 FORTH 程式碼是一模一樣的, 只是抽換下層的資料結構跟演算法, 立刻得到數倍執行速度的加速.
生命遊戲的正常版本.
繼續來, 已知位置 CurrentX, CurrentY 我們會需要計算這個位置周圍上下左右及四個對角落鄰居的生命總數 #neighbors@
這算法很直接啦, 就用兩個 do-loop 上下左右對角的掃描, 得到四週鄰居的位置後, 檢查統計一下生命的總數囉!
給個 X, Y 的偏移向量(就是鄰居的方向啊!) 給 NeighborCell, 它會傳回這個方向鄰居的座標.
: NeighborCell ( x-offset y-offset -- x2 y2)
swap CurrentX @ +
swap CurrentY @ +
;
所以 #neighbors@ 計算周圍鄰居生命總數的程式碼如下,
兩個 do-loop 會產生 9 組偏移量向量 i = -1, 0, 1 ; j = -1, 0, 1 指向不同方向的鄰居, NeighborCell 會把這個方向鄰居的座標傳出來. 當然 i=0, j=0 這個向量偏移量等於自己, 所以用個 if-then 來捨棄.
: #neighbors@ ( — #life) \ check no. of life in the neighborhood
0 ( #life) 鄰居生命總數目,一開始為零
2 -1
do 2 -1
do i 0= j 0= and invert i=0, j=0 這個條件必須捨去不計算
if i j NeighborCell world' @ aLife = 有生命在這裡嗎?
if 1+ then 有就把生命總數加一
then
loop
loop
;
選擇目前計算的位置 SelectCell
\ select this position as the current cell for calculation
: SelectCell ( x y --)
CurrentY ! CurrentX !
;
指令更新世界的資料 UpdateWorld: 陣列 world 裡面資料全部計算完畢的時候, 拷貝一份給陣列 world'
作法很簡單, 先用 0 0 world 跟 0 0 world' 取得兩個陣列的起始位置, 再用 move 指令, 把 world 陣列裡的資料複製一份給 world'
: UpdateWorld \ make a backup to world'
0 0 world 0 0 world' [ SizeX SizeY * cells ] literal move
;
整個生命演化一次的歷程 1LifeCycle
利用兩個 do-loop, 掃描整個世界. 透過上帝所訂下來的規則來決定這個位置是生? 是死? 還是新生命的誕生? 全部決定完之後, UpdateWorld 更新整個世界給一份 copy 給 world'
: 1LifeCycle
SizeX 0
do SizeY 0
do i j SelectCell
JudgementFromTheGod
loop
loop
UpdateWorld
;
給 FORTH 的初學者,
因為我們有兩個陣列, 為了方便列印陣列內容 .world 採用了延遲定義的技巧. defer 是 FORTH 延遲定義的指令, 它可以先定義一個魁儡 dummy 指令, 最後可以透過 is 指令將真實所要執行的指令指派過去. 這樣可以很方便的改來改去.
例如這裡計算陣列的位址是用 worldForPrint, 用 defer 所定義的一個魁儡 dummy 指令(陣列), .world 先利用這個魁儡指令(陣列)來編譯. 最後我們要用的時候, 鍵入 ' world is worldForPrint 這時候 .world 就是列印 world 陣列 ; 而鍵入 ' world' is worldForPrint 這時候 .world 變成列印 world' 陣列. 這時候真實的指令才被指派進來. 如此很彈性的一魚兩吃, 很方便的.
defer worldForPrint
' world is worldForPrint
: .world ( --)
cr
SizeX 0
do SizeY 0
do i j worldForPrint @ .status
loop
cr
loop
;
遊戲一開始前要先設定整個世界, SetupWorld, 這裡為了方便, 是用亂數來設定整個初始的世界
作法很簡單, 用個 do-loop 逐一產生所需數目的生命, 先用亂數取個隨機位置, 用 JustBorn? 來檢查一下這個位置剛剛是不是已經有新鮮的生命誕生了? 假如沒有就在這個位置誕生個新生命, 假如已經有生命了就亂數再重取重來, 直到沒有為止.
150 value #ofLife
: SetupWorld
#ofLife 0
do begin
sizeX Choose sizeY Choose SelectCell
JustBorn? invert
until
Born
loop
UpdateWorld
1 #cycle !
;
主程式, 很高階的 先 InitAll 初始一下所有變數跟陣列, 然後 SetupWorld 來建造一開始的生命世界. 全部準備完畢後跳到主遊戲迴圈, 先列印一下 world, 讓大家看看這世界生命的狀況. 然後 1LifeCycle 讓上帝決定這個世界誰生, 誰死, 誰誕生. 最後停一下等待使用者按鍵, 不是'q' 的任何按鍵就繼續整個演化的過程囉.
: go
InitAll
SetupWorld
begin
.world
." # of Life:" #Life @ 4 .r ." , #cycle: " #cycle @ 4 .r cr
." Any Keys to Continue... ('q' to quit..)" cr
1LifeCycle
key [char] q =
until
;
執行的情況囉!
一開始隨機產生 150個生命, 讓它們去捉對廝殺!
執行到 cycle 11 跟 cycle 12, 有些地方因為太過於壅擠, 擠死了一大塊!
到了第 cycle 211 跟 212 盤面, 某種規則出現了. 看著盤面變來變去的, 其實還蠻療癒的啦! (小編考慮也用 Arduino 配上點矩陣 LED 來做個這樣的玩具好囉... XD)
到了第 cycle 268, 終於所有的生命固定下來了, 不再變化!
完整程式列表.
\
\ Life Game
\
\ Frank Lin 2018/3/9
\
\ random number
variable seed
: RND ( --- n) seed @ 31421 * 6927 + dup seed ! ;
: Randomize ( seed --- ) seed ! ;
here Randomize
: Choose ( limit --- n ) RND um* nip ;
\ array
\ addr = addr0 + ( mod(x,xlim) + mod(y,ylim) * xlim ) cells
\ with clipping if x and y are out-range
: array
create ( xlim ylim --)
2dup , , * cells allot
does> ( x y -- addr )
( x y addr )
dup @ swap ( x y ylim addr)
cell+ >r ( x y ylim | addr+1cell)
mod ( x y' | addr+1cell)
r@ @ tuck * ( x xlim y'*xlim | addr+1cell)
-rot mod + cells
r> cell+ +
;
0 constant empty
1 constant aLife
20 constant sizeX
20 constant sizeY
variable CurrentX
variable CurrentY
variable #life
variable #cycle
sizeX sizeY array world \ main world for life
sizeX sizeY array world' \ temporary world for calculation
: CurrentPosition@ ( -- x y) CurrentX @ CurrentY @ ;
: liveCell? ( -- f)
CurrentPosition@ world' @ aLife =
;
: JustBorn? ( -- f)
CurrentPosition@ world @ aLife =
;
: die ( --)
empty CurrentPosition@ world !
-1 #Life +!
;
: born ( --)
aLife CurrentPosition@ world !
1 #Life +!
;
: NeighborCell ( x-offset y-offset -- x2 y2) \ direction offset -> position of neighbor
swap CurrentX @ +
swap CurrentY @ +
;
: #neighbors@ ( — #life) \ check no. of life in the neighborhood
0 ( #life)
2 -1
do 2 -1
do i 0= j 0= and invert ( edge of cell? neighbor?)
if i j NeighborCell world' @ aLife = ( a life there?)
if 1+ then
then
loop
loop
;
: JudgementFromTheGod ( --)
#neighbors@
liveCell?
if ( liveCell)
dup 0 2 within if die then
\ dup 2 4 within if survive then
3 > if die then
else ( deadCell)
3 = if born then
then
;
: UpdateWorld \ make a backup to world'
0 0 world 0 0 world' [ SizeX SizeY * cells ] literal move
;
: SelectCell ( x y --) \ select this position as the current cell for calculation
CurrentY ! CurrentX !
;
: 1LifeCycle
SizeX 0
do SizeY 0
do i j SelectCell
JudgementFromTheGod
loop
loop
UpdateWorld
1 #cycle +!
;
: .status ( s --)
case
empty of ." ." endof
aLife of ." *" endof
endcase
;
defer worldForPrint
' world is worldForPrint
: .world ( --)
cr
SizeX 0
do SizeY 0
do i j worldForPrint @ .status
loop
cr
loop
;
150 value #ofLife
: SetupWorld
#ofLife 0
do begin
sizeX Choose sizeY Choose SelectCell
JustBorn? invert
until
Born
loop
UpdateWorld
1 #cycle !
;
: InitAll
['] world is worldForPrint
0 0 world [ SizeX SizeY * cells ] literal erase
0 0 world' [ SizeX SizeY * cells ] literal erase
0 #life !
;
: go
InitAll
SetupWorld
begin
.world
." # of Life:" #Life @ 4 .r ." , #cycle: " #cycle @ 4 .r cr
." Any Keys to Continue... ('q' to quit..)" cr
1LifeCycle
key [char] q =
until
;
加速版本的生命遊戲
上面這個生命遊戲是個最平書直述版本的生命遊戲, 但是這個版本有個問題, 那個就是速度! 仔細檢視程式碼, 整個世界的大小是個 20 x 20 = 400 個元素的陣列. 為了決定誰生誰死, 利用兩個迴圈逐步掃描檢查這 400 個陣列位置是不可獲缺的!
但問題來了, 每個陣列位置又必須逐步檢查它的上下左右對角總共8個元素. 所以一次的生命輪迴就得要檢查 400 x 8 = 3200 次陣列內容才能完成. ( 總數: SizeX * SizeY * 8 ), 當陣列愈大, 這個情況就會進一步大幅惡化! 速度就會嚴重變得很慢! 當然啦, 拜科技進步之賜, 現在大家桌上電腦的速度, 隨隨便便都是20年前工作站等級的啦! 所以筆者這台的 iMac 2012 late 上跑, 看不出來有很慢的問題. 但是還記得以前唸大學的時候, 這個程式跑起來可是慢如蝸牛呢.
無論如何, 讓我們來精進我們的程式功力吧! 只要透過演算法的改變, 這個程式可是可以進一步大幅的改進執行演算的速度喲!
來思考一下, 如何改進呢?
有沒有注意到, 每次都要重頭重新計算四周周圍鄰居的生命總數, 這是不是有點蠢啊?? 什麼時候才需要改變四周周圍鄰居的生命總數呢?? 好像是只有當生命誕生跟死亡的時候才會改變四周周圍鄰居的生命總數! 所以我們可以不用一直重算呀! 就用個陣列把每個位置四周周圍鄰居的生命總數給記錄下來呀! 這樣就不用一直在那邊檢查四周鄰居囉! 直接從陣列取值就是四周鄰居的生命總數囉!
所以, 定義兩個鄰居生命總數的陣列,
sizeX sizeY array #neighbors \ array stored # of neighbor at X,Y
sizeX sizeY array #neighbors' \ temporary array stored # of neighbor at X,Y
現在不用檢查了, 直接從陣列取值就可以得到四周鄰居生命總數.
: #neighbors@ ( — #life) \ check no. of life in the neighborhood
CurrentPosition@ #neighbors' @
;
什麼時候才需要改變四周周圍鄰居的生命總數呢?? 好像是只有當生命誕生跟死亡的時候才會改變四周周圍鄰居的生命總數喲! 所以只需要在這兩個狀況下, 計算改變四周鄰居生命總數陣列的值! 當一個生命誕生, 四周八個鄰居都會看到, 所以這八個鄰居的鄰居生命總數都必須要加一. 一樣, 當一個生命死亡, 四周八個鄰居都會看到, 所以這八個鄰居的鄰居生命總數都必須要減一.
四周八個鄰居的鄰居生命總數加減 n 的指令
: #neighbors+! ( n --)
2 -1
do 2 -1
do i 0= j 0= and invert ( not center?)
if dup i j NeighborPos #neighbors +!
then
loop
loop drop
;
生命誕生, 四周八個鄰居的鄰居生命總數加一
: born ( --)
aLife CurrentPosition@ world !
1 #Life +!
1 #neighbors+!
;
生命死亡, 四周八個鄰居的鄰居生命總數減一
: die ( --)
empty CurrentPosition@ world !
-1 #Life +!
-1 #neighbors+!
;
就這樣, 就可以減少大量無效的檢查, 大幅的提高執行的速度! 現在計算量只跟生命的誕生和死亡有關. 當程式執行到中後期, 盤面生命改變的量是很少的, 可能整個世界陣列元素數量的十分之一或百分之一不到, 這時候速度就是原來的10倍到100倍之譜, 驚人的速度改變.
然後 FORTH 威的地方在這裡, 這個演算法的改變是在底層的, 上層的 FORTH 程式碼只是交付任務給下層去執行, 並不清楚真確了解下層是如何完成的任務的(物件技術裡的資訊隱藏), 所以上層的高階程式碼一行都不用動! 只要下層稍微修改一下, done! 加速 10倍 - 100倍的進階加速版就完成囉!
執行情況,
第 cycle 3, cycle 4
第 cycle 31, cycle 32, 開始有些特定的圖案出現囉.
第 cycle 72, 73, 很有趣的圖樣
到 cycle 152, 整個圖案的變化終於穩定下來囉.
把鄰居生命數陣列的內容列印一下, 給大家參考一下. 也就是說, 現在不用逐步計算了, 陣列裡直接就是四周鄰居的生命值. 因此整體執行的速度加速 10 - 100 倍!
完整程式列表.
\
\ Life Game
\ faster version
\
\ Frank Lin 2018/3/17
\
\ random number
variable seed
: RND ( --- n) seed @ 31421 * 6927 + dup seed ! ;
: Randomize ( seed --- ) seed ! ;
here Randomize
: Choose ( limit --- n ) RND um* nip ;
\ array
\ addr = addr0 + ( mod(x,xlim) + mod(y,ylim) * xlim ) cells
\ with clipping if x and y are out-range
: array
create ( xlim ylim --)
2dup , , * cells allot
does> ( x y -- addr )
( x y addr )
dup @ swap ( x y ylim addr)
cell+ >r ( x y ylim | addr+1cell)
mod ( x y' | addr+1cell)
r@ @ tuck * ( x xlim y'*xlim | addr+1cell)
-rot mod + cells
r> cell+ +
;
0 constant empty
1 constant aLife
20 constant sizeX
20 constant sizeY
variable CurrentX
variable CurrentY
variable #life
variable #cycle
sizeX sizeY array world \ main world
sizeX sizeY array world' \ temporary world for calculation
sizeX sizeY array #neighbors \ array stored # of neighbor at X,Y
sizeX sizeY array #neighbors' \ temporary array stored # of neighbor at X,Y
: CurrentPosition@ ( -- x y) CurrentX @ CurrentY @ ;
: NeighborPos ( x-offset y-offset -- x2 y2) \ direction offset -> position of neighbor
swap CurrentX @ +
swap CurrentY @ +
;
: #neighbors+! ( n --)
2 -1
do 2 -1
do i 0= j 0= and invert ( not center?)
if dup i j NeighborPos #neighbors +!
then
loop
loop drop
;
: liveCell? ( -- f)
CurrentPosition@ world' @ aLife =
;
: JustBorn? ( -- f)
CurrentPosition@ world @ aLife =
;
: #neighbors@ ( — #life) \ check no. of life in the neighborhood
CurrentPosition@ #neighbors' @
;
: die ( --)
empty CurrentPosition@ world !
-1 #Life +!
-1 #neighbors+!
;
: born ( --)
aLife CurrentPosition@ world !
1 #Life +!
1 #neighbors+!
;
: JudgementFromTheGod ( --)
#neighbors@
liveCell?
if ( liveCell)
dup 0 2 within if die then
\ dup 2 4 within if survive then
3 > if die then
else ( deadCell)
3 = if born then
then
;
: UpdateWorld
0 0 world 0 0 world' [ SizeX SizeY * cells ] literal move
0 0 #neighbors 0 0 #neighbors' [ SizeX SizeY * cells ] literal move
;
: SelectCell ( x y --) \ select this position as the current cell for calculation
CurrentY ! CurrentX !
;
: 1LifeCycle
SizeX 0
do SizeY 0
do i j SelectCell
JudgementFromTheGod
loop
loop
UpdateWorld
1 #cycle +!
;
: .status ( s --)
case
empty of ." ." endof
aLife of ." *" endof
endcase
;
defer worldForPrint
' world is worldForPrint
: .world ( --)
cr
SizeX 0
do SizeY 0
do i j worldForPrint @ .status
loop
cr
loop
;
150 value #ofLife
: SetupWorld
#ofLife 0
do begin
sizeX Choose sizeY Choose SelectCell
JustBorn? invert
until
Born
loop
UpdateWorld
1 #cycle !
;
: InitAll
['] world is worldForPrint
0 0 world [ SizeX SizeY * cells ] literal erase
0 0 world' [ SizeX SizeY * cells ] literal erase
0 0 #neighbors [ SizeX SizeY * cells ] literal erase
0 0 #neighbors' [ SizeX SizeY * cells ] literal erase
0 #life !
;
: go
InitAll
SetupWorld
begin
.world
." # of Life:" #Life @ 4 .r ." , #cycle: " #cycle @ 4 .r cr
." Any Keys to Continue... ('q' to quit..)" cr
1LifeCycle
key [char] q =
until
;
\
\ for debug
\
: .#neighbors ( --)
cr
SizeX 0
do SizeY 0
do i j #neighbors @ 3 .r
loop
cr
loop
;
xxx
留言列表
