R語言遊戲之旅遊戲2048

01-27

前言

150行代碼寫出遊戲2048，哪種語言能實現？答案是R語言。雖然R語言並不適合做遊戲開發，但是R語言中的向量計算，能極大地簡化矩陣演算法代碼實現的複雜度，可以高效的完成計算任務。如果我們把遊戲問題變成數學問題，那麼R就是絕佳的工具。

1. 2048遊戲介紹

2048是一款單人在線和移動端遊戲，由19歲的義大利人Gabriele Cirulli於2014年3月開發。遊戲任務是在一個網格上滑動小方塊來進行組合，直到形成一個帶有有數字2048的方塊，它是滑塊類遊戲的一種電腦變體。作者開發這個遊戲是為了測試自己是否有能力從零開始創造一款遊戲，但遊戲飆升的人氣（不到1周內有400萬訪客）完全出乎他的預料。事實上，它已被稱為網路上「最上癮的東西」，華爾街日報將其評價為「屬於數學極客的 Candy Crush」。

該遊戲為開源軟體，這導致它衍生出許多改進版和變種，包括積分排行榜和提升的觸屏可玩性等。2048是基於HTML5的Javascript應用，源代碼的地址：gabrielecirulli/2048，免費的在線版本：2048。當然本文中R語言的程序現實，完全是我的想法，與遊戲作者的JS源代碼無關。

遊戲玩法

該遊戲使用方向鍵讓方塊上下左右移動。如果兩個帶有相同數字的方塊在移動中碰撞，則它們會合併為一個數字，為兩者之和。每次移動時，會有一個值為2或者4的新方塊出現。當值為2048的方塊出現時，遊戲即勝利，該遊戲因此得名。

2. 場景設計

接下來，就回了遊戲設計環節，如同上篇文章 R語言遊戲之旅貪食蛇入門一樣。要開發這款遊戲，我們應該如何動手呢？我們需要從軟體開發的角度，對這款遊戲進行需求分析，列出遊戲的規則，並設計業務流程，給出遊戲的原型，驗證是否可行。

2.1 需求分析

2048遊戲，應該有3個場景：開機場景，遊戲場景，結束場景。

開機場景：運行程序，在遊戲前，給用戶做準備，並提示如何操作遊戲。
遊戲場景：遊戲運行中的場景。
結束場景：當用戶勝利、失敗或退出時的場景，並提示用戶在遊戲中的得分。

開機場景和結束場景比較簡單，不再解釋。遊戲場景，包括一塊4*4的畫布，畫面中每個格子對應一個數字，數字大於0的格子有背景顏色填充。

2.2 遊戲規則

遊戲進行時的規則：

1. 開始遊戲後，用戶可以通過上(up)下(down)左(left)右(right)鍵，來控制數字的移動。
2. 如果兩個相同的數字在移動中碰撞，則它們會合併為一個方塊，且所帶數字變為兩者之和。
3. 每次移動時，會有一個值為2或者4的新數字出現。
4. 當用戶按鍵操作，數字的順序未發生變化時，則不會生成新數字，視為無效的按鍵操作。
5. 當畫布格子被數字填滿時，而在上下左邊方向，無可合併的數字時，則遊戲失敗。

2.3 業務流程

場景切換的流程：

打開程序時，用戶首先看到開機場景，按任意鍵後進入遊戲場景。
在遊戲場景，當遊戲失敗，進入結束場景；按q鍵，則直接遊戲失敗。
在結束場景，按空格回到開機場景；按q鍵，則直接能出軟體。

業務流程，同貪食蛇遊戲的業務流程。

2.4 遊戲原型

我們畫出3個場景的界面。左邊為開機場景，中間是遊戲場景，右邊是結束場景。

我們根據遊戲原型的圖，用程序畫出遊戲的場景。

3. 程序設計

通過上面的功能需求分析，我們已經非常清楚地了解 2048遊戲的各種規則和功能。接下來，我們要把需求分析中的業務語言，通過技術語言重新描述，並考慮非功能需求，以及R語言相關的技術細節。

3.1 遊戲場景

我們讓每個場景對應於一塊畫布，及每個場景對應一個內存結構。

開機場景，是靜態的，我們可以提前生成好這塊畫布存儲起來，也可以當用戶切換時再臨時生成，性能開銷不大。
遊戲場景，是動態的，每進行一次用戶的交互行為或按時間刷新時，都需要求重新繪製畫布，讓遊戲場景通過綁定事件來生成畫布。
結束場景，是動態的，在結束場景會顯示當次遊戲的得分，需要在切換時臨時生成。

3.2 遊戲對象

在遊戲進行中，會產生很多的對象，如上文中提到的。這些對象都需要在內存中進行定義，匹配到對應程序語言的數據類型。

比起貪食蛇遊戲，2048遊戲要簡單的多，我只需要定義一個畫布對象就行了。

畫布對象：用矩陣來描述。
畫布中的數字：用矩陣中的數字值來表示。
畫布的背景色：用矩陣中的數字值來表示。

通過矩陣來描述遊戲畫布和對象：

矩陣結構：

[,1] [,2] [,3] [,4]n[1,] 4 32 4 32n[2,] 32 16 2 4n[3,] 4 2 8 2n[4,] 2 8 2 0n

對應該的遊戲畫布：

3.3 遊戲事件

遊戲過程中，會有2種事件，鍵盤事件和碰撞事件。

鍵盤事件：全局事件，用戶通過鍵盤輸入，而觸發的事件，比如，上下左右控制蛇的移動方向。
碰撞事件：如果兩個相同的數字在移動中碰撞，則它們會合併為一個數字。

全局監聽鍵盤事件，用鍵盤事件觸發碰撞事件，檢查遊戲狀態。

3.4 遊戲控制

在遊戲進行中，每個狀態我們都需要進行控制的。比如，什麼生成新的數字，什麼合併相同的數字，什麼時候遊戲結束等。通過定義控制函數，可以方便我們管理遊戲運行中的各種遊戲狀態。

上圖中每個方塊代表一個R語言函數定義：

run():啟動程序。
keydown():監聽鍵盤事件，鎖定線程。
stage0():創建開機場景，可視化輸出。
stage1():創建遊戲場景，可視化輸出。
stage2():創建結束場景，可視化輸出。
init():打開遊戲場景時，初始化遊戲變數。
create():判斷並生成數字。
move():移動數字。
lose():失敗查詢，判斷當畫布格子是否被被數字填滿時，且不能合併的數字時，進行結束場景。
drawTable():繪製遊戲背景。
drawMatrix():繪製遊戲矩陣。

通過程序設計過程，我們就把需求分析中的業務語言描述，變成了程序開發中的技術語言描述。經過完整的設計後，最後就剩下寫代碼了。

4. R語言實現

按照上面的函數定義，我們把代碼像填空一樣地寫進去就行了。由於我們之前已經做好了一個遊戲框架，場景函數及功能函數定義已在框架中現實了一部分，就可以更方便地填入遊戲代碼了。關於R語言遊戲框架介紹，請參考文章：R語言遊戲框架設計

4.1 數字移動函數 move()

2048遊戲演算法上最複雜的操作，就是數字移動。在4*4的矩陣中，數字會按上下左右四個方向移動，相同的數字在移動中碰撞時會進行合併。這個演算法是2048遊戲的核心演算法，我們的程序要保證數字合併正確性。

我們先把這個函數從框架中抽出來，單獨進行實現和單元測試。

構建函數moveFun()，這裡簡化移動過程，只考慮左右移動，再通過倒序的演算法，讓左右移動的核心演算法共用一套代碼。

> moveFun<-function(x,dir){n+ if(dir == right) x<-rev(x)n+ n+ len0<-length(which(x==0)) # 0長度n+ x1<-x[which(x>0)] #去掉0n+ pos1<-which(diff(x1)==0) # 找到挨著相等的元素的位置n+ n+ if(length(pos1)==3){ #3個索引n+ pos1<-pos1[c(1,3)]n+ }else if(length(pos1)==2 && diff(pos1)==1){ #2個索引n+ pos1<-pos1[1]n+ }n+ n+ x1[pos1]<-x1[pos1]*2n+ x1[pos1+1]<-0n+ n+ x1<-x1[which(x1>0)] #去掉0n+ x1<-c(x1,rep(0,4))[1:4] #補0，取4個n+ n+ if(dir == right) x1<-rev(x1)n+ return(x1)n+ }n

接下來，為了檢驗函數moveFun()的正確性，我們使用單元測試工具包testthat，來檢驗演算法是否正確。關於testthat包的介紹，請參考文章在巨人的肩膀前行催化R包開發。

按遊戲規則我們模擬數字左右移動，驗證計算結果是否與我們給出的目標值相同。

單元測試的代碼

> library(testthat)n> x<-c(4,2,2,2)n> expect_that(moveFun(x,left), equals(c(4,4,2,0)))n> expect_that(moveFun(x,right), equals(c(0,4,2,4)))nn> x<-c(4,4,2,4)n> expect_that(moveFun(x,left), equals(c(8,2,4,0)))n> expect_that(moveFun(x,right), equals(c(0,8,2,4)))nn> x<-c(2,2,0,2)n> expect_that(moveFun(x,left), equals(c(4,2,0,0)))n> expect_that(moveFun(x,right), equals(c(0,0,2,4)))nn> x<-c(2,4,2,4)n> expect_that(moveFun(x,left), equals(c(2,4,2,4)))n> expect_that(moveFun(x,right), equals(c(2,4,2,4)))nn> x<-c(4,4,2,2)n> expect_that(moveFun(x,left), equals(c(8,4,0,0)))n> expect_that(moveFun(x,right), equals(c(0,0,8,4)))nn> x<-c(2,2,4,4)n> expect_that(moveFun(x,left), equals(c(4,8,0,0)))n> expect_that(moveFun(x,right), equals(c(0,0,4,8)))nn> x<-c(4,4,0,4)n> expect_that(moveFun(x,left), equals(c(8,4,0,0)))n> expect_that(moveFun(x,right), equals(c(0,0,4,8)))nn> x<-c(4,0,4,4)n> expect_that(moveFun(x,left), equals(c(8,4,0,0)))n> expect_that(moveFun(x,right), equals(c(0,0,4,8)))nn> x<-c(4,0,4,2)n> expect_that(moveFun(x,left), equals(c(8,2,0,0)))n> expect_that(moveFun(x,right), equals(c(0,0,8,2)))nn> x<-c(2,2,2,2)n> expect_that(moveFun(x,left), equals(c(4,4,0,0)))n> expect_that(moveFun(x,right), equals(c(0,0,4,4)))nn> x<-c(2,2,2,0)n> expect_that(moveFun(x,left), equals(c(4,2,0,0)))n> expect_that(moveFun(x,right), equals(c(0,0,2,4)))n

當然，我們還可以寫更多的測試用例，來檢驗函數的正確性。這樣就實現了，數字移動的核心演算法了。

4.2 其他函數實現

開機場景函數stage0()

# 開機畫圖n stage0=function(){n callSuper()n plot(0,0,xlim=c(0,1),ylim=c(0,1),type=n,xaxs="i", yaxs="i")n text(0.5,0.7,label=name,cex=5)n text(0.5,0.4,label="Any keyboard to start",cex=2,col=4)n text(0.5,0.3,label="Up,Down,Left,Rigth to control direction",cex=2,col=2)n text(0.2,0.05,label="Author:DanZhang",cex=1)n text(0.5,0.05,label="http://blog.fens.me",cex=1)n }n

結束場景函數stage2()

# 結束畫圖n stage2=function(){n callSuper()n info<-paste("Congratulations! You have max number",max(m),"!")n print(info)nn plot(0,0,xlim=c(0,1),ylim=c(0,1),type=n,xaxs="i", yaxs="i")n text(0.5,0.7,label="Game Over",cex=5)n text(0.5,0.4,label="Space to restart, q to quit.",cex=2,col=4)n text(0.5,0.3,label=info,cex=2,col=2)n text(0.2,0.05,label="Author:DanZhang",cex=1)n text(0.5,0.05,label="http://blog.fens.me",cex=1)n }n

鍵盤事件，控制場景切換

# 鍵盤事件，控制場景切換n keydown=function(K){n callSuper(K)nnif(stage==1){ #遊戲中nif(K == "q") stage2()nelse {nif(tolower(K) %in% c("up","down","left","right")){ntt e$dir<<-tolower(K)nprint(e$dir)ntt stage1() nt }nt }nreturn(NULL)n }nreturn(NULL)n }n

遊戲場景初始化函數init()

# 初始化變數n init = function(){n callSuper() # 調父類nn e$max<<-4 # 最大數字n e$step<<-1/width #步長n e$dir<<-upn e$colors<<-rainbow(14) #顏色n e$stop<<-FALSE #不滿足移動條件nn create()n }n

隨機產生一個新數字函數create()

# 隨機產生一個新數字ncreate=function(){nif(length(index(0))>0 & !e$stop){ne$stop<<-TRUEt nt one<-sample(c(2,4),1)nt idx<-ifelse(length(index(0))==1,index(0),sample(index(0),1))nm[idx]<<-onen }n }n

失敗條件函數lose()

#失敗條件n lose=function(){nn# 判斷是否有相鄰的有重複值n near<-function(x){nt length(which(diff(x)==0))n }nn# 無空格子nif(length(index(0))==0){nt h<-apply(m,1,near) # 水平方向nt v<-apply(m,2,near) # 垂直方向nnif(length(which(h>0))==0 & length(which(v>0))==0){nt fail("No free grid.")nreturn(NULL)nt }n }n }n

遊戲畫布函數drawTable()

# 畫布背景n drawTable=function(){nif(isFail) return(NULL)n plot(0,0,xlim=c(0,1),ylim=c(0,1),type=n,xaxs="i", yaxs="i")n abline(h=seq(0,1,e$step),col="gray60") # 水平線n abline(v=seq(0,1,e$step),col="gray60") # 垂直線n }n

遊戲矩陣函數drawMatrix()

# 根據矩陣畫數據n drawMatrix=function(){nif(isFail) return(NULL)n a<-c(t(m))n lab<-c(a[13:16],a[9:12],a[5:8],a[1:4])nn d<-data.frame(x=rep(seq(0,0.95,e$step),width),y=rep(seq(0,0.95,e$step),each=height),lab=lab)n df<-d[which(d$lab>0),]n points(df$x+e$step/2,df$y+e$step/2,col=e$colors[log(df$lab,2)],pch=15,cex=23)n text(df$x+e$step/2,df$y+e$step/2,label=df$lab,cex=2)n }n

遊戲場景函數stage1()

# 遊戲場景n stage1=function(){n callSuper()nn move()n lose()n create()nn drawTable()n drawMatrix() n }n

完整的程序代碼

source(file="game.r") #載入遊戲框架nn# Snake類，繼承Game類nG2048<-setRefClass("G2048",contains="Game",nn methods=list(nn# 構造函數n initialize = function(name,debug) {n callSuper(name,debug) # 調父類nn name<<-"2048 Game"n width<<-height<<-4n },nn# 初始化變數n init = function(){n callSuper() # 調父類nn e$max<<-4 # 最大數字n e$step<<-1/width #步長n e$dir<<-upn e$colors<<-rainbow(14) #顏色n e$stop<<-FALSE #不滿足移動條件nn create()n },nn# 隨機產生一個新數字n create=function(){nif(length(index(0))>0 & !e$stop){n e$stop<<-TRUE n one<-sample(c(2,4),1)n idx<-ifelse(length(index(0))==1,index(0),sample(index(0),1))n m[idx]<<-onen } n },nn#失敗條件n lose=function(){nn# 判斷是否有相鄰的有重複值n near<-function(x){n length(which(diff(x)==0))n }nn# 無空格子nif(length(index(0))==0){n h<-apply(m,1,near) # 水平方向n v<-apply(m,2,near) # 垂直方向nnif(length(which(h>0))==0 & length(which(v>0))==0){n fail("No free grid.")nreturn(NULL)n }n }n },nn# 方向移動n move=function(){nn# 方向移動函數n moveFun=function(x){nif(e$dir %in% c(right,down)) x<-rev(x)nn len0<-length(which(x==0)) # 0長度n x1<-x[which(x>0)] #去掉0n pos1<-which(diff(x1)==0) # 找到挨著相等的元素的位置nnif(length(pos1)==3){ #3個索引n pos1<-pos1[c(1,3)]n }else if(length(pos1)==2 && diff(pos1)==1){ #2個索引n pos1<-pos1[1]n }nn x1[pos1]<-x1[pos1]*2n x1[pos1+1]<-0nn x1<-x1[which(x1>0)] #去掉0n x1<-c(x1,rep(0,4))[1:4] #補0，取4個nnif(e$dir %in% c(right,down)) x1<-rev(x1)nreturn(x1)n }nn last_m<-mnif(e$dir==left) m<<-t(apply(m,1,moveFun))nif(e$dir==right) m<<-t(apply(m,1,moveFun))nif(e$dir==up) m<<-apply(m,2,moveFun)nif(e$dir==down) m<<-apply(m,2,moveFun)nn e$stop<<-ifelse(length(which(m != last_m))==0,TRUE,FALSE)n },nn# 畫布背景n drawTable=function(){nif(isFail) return(NULL)n plot(0,0,xlim=c(0,1),ylim=c(0,1),type=n,xaxs="i", yaxs="i")n abline(h=seq(0,1,e$step),col="gray60") # 水平線n abline(v=seq(0,1,e$step),col="gray60") # 垂直線n },nn# 根據矩陣畫數據n drawMatrix=function(){nif(isFail) return(NULL)n a<-c(t(m))n lab<-c(a[13:16],a[9:12],a[5:8],a[1:4])nn d<-data.frame(x=rep(seq(0,0.95,e$step),width),y=rep(seq(0,0.95,e$step),each=height),lab=lab)n df<-d[which(d$lab>0),]n points(df$x+e$step/2,df$y+e$step/2,col=e$colors[log(df$lab,2)],pch=15,cex=23)n text(df$x+e$step/2,df$y+e$step/2,label=df$lab,cex=2)n },nn# 遊戲場景n stage1=function(){n callSuper()nn move()n lose()n create()nn drawTable()n drawMatrix() n },nn# 開機畫圖n stage0=function(){n callSuper()n plot(0,0,xlim=c(0,1),ylim=c(0,1),type=n,xaxs="i", yaxs="i")n text(0.5,0.7,label=name,cex=5)n text(0.5,0.4,label="Any keyboard to start",cex=2,col=4)n text(0.5,0.3,label="Up,Down,Left,Rigth to control direction",cex=2,col=2)n text(0.2,0.05,label="Author:DanZhang",cex=1)n text(0.5,0.05,label="http://blog.fens.me",cex=1)n },nn# 結束畫圖n stage2=function(){n callSuper()n info<-paste("Congratulations! You have max number",max(m),"!")nprint(info)nn plot(0,0,xlim=c(0,1),ylim=c(0,1),type=n,xaxs="i", yaxs="i")n text(0.5,0.7,label="Game Over",cex=5)n text(0.5,0.4,label="Space to restart, q to quit.",cex=2,col=4)n text(0.5,0.3,label=info,cex=2,col=2)n text(0.2,0.05,label="Author:DanZhang",cex=1)n text(0.5,0.05,label="http://blog.fens.me",cex=1)n },nn# 鍵盤事件，控制場景切換n keydown=function(K){n callSuper(K)nnif(stage==1){ #遊戲中nif(K == "q") stage2()nelse {nif(tolower(K) %in% c("up","down","left","right")){n e$dir<<-tolower(K)n stage1() n }n }nreturn(NULL)n }nreturn(NULL)n }nn )n)nn# 封裝啟動函數ng2048<-function(){n game<-G2048$new()n game$initFields(debug=TRUE)n game$run()n}nn# 啟動遊戲ng2048()n

遊戲截圖：

全部代碼僅僅190行，有效代碼行只有150行左右，我們就實現了2048遊戲。用R語言處理矩陣的向量計算，還是很方便的，另外我們又用面向對象的方法，對遊戲程序進行了統一的封裝，標準化了函數定義和介面，讓我們能更專註於遊戲演算法本身，提高開發的效率。下一步，就可以把遊戲這個框架項目打包發布到CRAN了

作者介紹：

張丹，R語言中文社區專欄特邀作者，《R的極客理想》系列圖書作者，民生銀行大數據中心數據分析師，前況客創始人兼CTO。

10年IT編程背景，精通R ,Java, Nodejs 編程，獲得10項SUN及IBM技術認證。豐富的互聯網應用開發架構經驗，金融大數據專家。個人博客粉絲日誌， Alexa全球排名70k。

著有《R的極客理想-工具篇》、《R的極客理想-高級開發篇》，合著《數據實踐之美》，新書《R的極客理想-量化投資篇》(即將出版)。

《R的極客理想-工具篇》京東購買快速通道：《數據分析技術叢書：R的極客理想·工具篇》(張丹 )【摘要書評試讀】- 京東圖書

《R的極客理想-高級開發篇》京東購買快速通道：《R的極客理想高級開發篇》(張丹)【摘要書評試讀】- 京東圖書

《數據實踐之美》京東購買快速通道：《數據實踐之美：31位大數據專家的方法、技術與思想》(天善智能)【摘要書評試讀】- 京東圖書

大家也可以加小編微信：tswenqu(備註：知乎)，進R語言中文社區交流群，可以跟各位老師互相交流

官方公眾號：R語言中文社區 (ID：R_shequ) 歡迎關注，持續連載。

R語言遊戲之旅 遊戲2048

前言

目錄