R的极客理想系列文章，涵盖了R的思想，使用，工具，创新等的一系列要点，以我个人的学习和体验去诠释R的强大。
R语言作为统计学一门语言，一直在小众领域闪耀着光芒。直到大数据的爆发，R语言变成了一门炙手可热的数据分析的利器。随着越来越多的工程背景的人的加入，R语言的社区在迅速扩大成长。现在已不仅仅是统计领域，教育，银行，电商，互联网….都在使用R语言。
要成为有理想的极客，我们不能停留在语法上，要掌握牢固的数学，概率，统计知识，同时还要有创新精神，把R语言发挥到各个领域。让我们一起动起来吧，开始R的极客理想。
关于作者：
- 张丹(Conan), 程序员Java,R,PHP,Javascript
- weibo：@Conan_Z
- blog: http://blog.fens.me
- email: bsspirit@gmail.com
转载请注明出处：
http://blog.fens.me/r-game-2048/
前言
150行代码写出游戏2048，哪种语言能实现？答案是R语言。虽然R语言并不适合做游戏开发，但是R语言中的向量计算，能极大地简化矩阵算法代码实现的复杂度，可以高效的完成计算任务。如果我们把游戏问题变成数学问题，那么R就是绝佳的工具。
目录
- 2048游戏介绍
- 场景设计
- 程序设计
- R语言实现
1. 2048游戏介绍
2048是一款单人在线和移动端游戏，由19岁的意大利人Gabriele Cirulli于2014年3月开发。游戏任务是在一个网格上滑动小方块来进行组合，直到形成一个带有有数字2048的方块，它是滑块类游戏的一种电脑变体。作者开发这个游戏是为了测试自己是否有能力从零开始创造一款游戏，但游戏飙升的人气（不到1周内有400万访客）完全出乎他的预料。事实上，它已被称为网络上「最上瘾的东西」，华尔街日报将其评价为「属于数学极客的 Candy Crush」。
该游戏为开源软件，这导致它衍生出许多改进版和变种，包括积分排行榜和提升的触屏可玩性等。2048是基于HTML5的Javascript应用，源代码的地址：https://github.com/gabrielecirulli/2048，免费的在线版本：http://gabrielecirulli.github.io/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]
[1,] 4 32 4 32
[2,] 32 16 2 4
[3,] 4 2 8 2
[4,] 2 8 2 0
对应该的游戏画布：
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){
+ if(dir == 'right') x<-rev(x)
+
+ len0<-length(which(x==0)) # 0长度
+ x1<-x[which(x>0)] #去掉0
+ pos1<-which(diff(x1)==0) # 找到挨着相等的元素的位置
+
+ if(length(pos1)==3){ #3个索引
+ pos1<-pos1[c(1,3)]
+ }else if(length(pos1)==2 && diff(pos1)==1){ #2个索引
+ pos1<-pos1[1]
+ }
+
+ x1[pos1]<-x1[pos1]*2
+ x1[pos1+1]<-0
+
+ x1<-x1[which(x1>0)] #去掉0
+ x1<-c(x1,rep(0,4))[1:4] #补0，取4个
+
+ if(dir == 'right') x1<-rev(x1)
+ return(x1)
+ }
接下来，为了检验函数moveFun()的正确性，我们使用单元测试工具包testthat，来检验算法是否正确。关于testthat包的介绍，请参考文章 在巨人的肩膀前行 催化R包开发。
按游戏规则我们模拟数字左右移动，验证计算结果是否与我们给出的目标值相同。
单元测试的代码
> library(testthat)
> x<-c(4,2,2,2)
> expect_that(moveFun(x,'left'), equals(c(4,4,2,0)))
> expect_that(moveFun(x,'right'), equals(c(0,4,2,4)))
> x<-c(4,4,2,4)
> expect_that(moveFun(x,'left'), equals(c(8,2,4,0)))
> expect_that(moveFun(x,'right'), equals(c(0,8,2,4)))
> x<-c(2,2,0,2)
> expect_that(moveFun(x,'left'), equals(c(4,2,0,0)))
> expect_that(moveFun(x,'right'), equals(c(0,0,2,4)))
> x<-c(2,4,2,4)
> expect_that(moveFun(x,'left'), equals(c(2,4,2,4)))
> expect_that(moveFun(x,'right'), equals(c(2,4,2,4)))
> x<-c(4,4,2,2)
> expect_that(moveFun(x,'left'), equals(c(8,4,0,0)))
> expect_that(moveFun(x,'right'), equals(c(0,0,8,4)))
> x<-c(2,2,4,4)
> expect_that(moveFun(x,'left'), equals(c(4,8,0,0)))
> expect_that(moveFun(x,'right'), equals(c(0,0,4,8)))
> x<-c(4,4,0,4)
> expect_that(moveFun(x,'left'), equals(c(8,4,0,0)))
> expect_that(moveFun(x,'right'), equals(c(0,0,4,8)))
> x<-c(4,0,4,4)
> expect_that(moveFun(x,'left'), equals(c(8,4,0,0)))
> expect_that(moveFun(x,'right'), equals(c(0,0,4,8)))
> x<-c(4,0,4,2)
> expect_that(moveFun(x,'left'), equals(c(8,2,0,0)))
> expect_that(moveFun(x,'right'), equals(c(0,0,8,2)))
> x<-c(2,2,2,2)
> expect_that(moveFun(x,'left'), equals(c(4,4,0,0)))
> expect_that(moveFun(x,'right'), equals(c(0,0,4,4)))
> x<-c(2,2,2,0)
> expect_that(moveFun(x,'left'), equals(c(4,2,0,0)))
> expect_that(moveFun(x,'right'), equals(c(0,0,2,4)))
当然，我们还可以写更多的测试用例，来检验函数的正确性。这样就实现了，数字移动的核心算法了。
4.2 其他函数实现
开机场景函数stage0()
# 开机画图
stage0=function(){
callSuper()
plot(0,0,xlim=c(0,1),ylim=c(0,1),type='n',xaxs="i", yaxs="i")
text(0.5,0.7,label=name,cex=5)
text(0.5,0.4,label="Any keyboard to start",cex=2,col=4)
text(0.5,0.3,label="Up,Down,Left,Rigth to control direction",cex=2,col=2)
text(0.2,0.05,label="Author:DanZhang",cex=1)
text(0.5,0.05,label="http://blog.fens.me",cex=1)
}
结束场景函数stage2()
# 结束画图
stage2=function(){
callSuper()
info<-paste("Congratulations! You have max number",max(m),"!")
print(info)
plot(0,0,xlim=c(0,1),ylim=c(0,1),type='n',xaxs="i", yaxs="i")
text(0.5,0.7,label="Game Over",cex=5)
text(0.5,0.4,label="Space to restart, q to quit.",cex=2,col=4)
text(0.5,0.3,label=info,cex=2,col=2)
text(0.2,0.05,label="Author:DanZhang",cex=1)
text(0.5,0.05,label="http://blog.fens.me",cex=1)
}
键盘事件，控制场景切换
# 键盘事件，控制场景切换
keydown=function(K){
callSuper(K)
if(stage==1){ #游戏中
if(K == "q") stage2()
else {
if(tolower(K) %in% c("up","down","left","right")){
e$dir<<-tolower(K)
print(e$dir)
stage1()
}
}
return(NULL)
}
return(NULL)
}
游戏场景初始化函数init()
# 初始化变量
init = function(){
callSuper() # 调父类
e$max<<-4 # 最大数字
e$step<<-1/width #步长
e$dir<<-'up'
e$colors<<-rainbow(14) #颜色
e$stop<<-FALSE #不满足移动条件
create()
}
随机产生一个新数字函数create()
# 随机产生一个新数字
create=function(){
if(length(index(0))>0 & !e$stop){
e$stop<<-TRUE
one<-sample(c(2,4),1)
idx<-ifelse(length(index(0))==1,index(0),sample(index(0),1))
m[idx]<<-one
}
}
失败条件函数lose()
#失败条件
lose=function(){
# 判断是否有相邻的有重复值
near<-function(x){
length(which(diff(x)==0))
}
# 无空格子
if(length(index(0))==0){
h<-apply(m,1,near) # 水平方向
v<-apply(m,2,near) # 垂直方向
if(length(which(h>0))==0 & length(which(v>0))==0){
fail("No free grid.")
return(NULL)
}
}
}
游戏画布函数drawTable()
# 画布背景
drawTable=function(){
if(isFail) return(NULL)
plot(0,0,xlim=c(0,1),ylim=c(0,1),type='n',xaxs="i", yaxs="i")
abline(h=seq(0,1,e$step),col="gray60") # 水平线
abline(v=seq(0,1,e$step),col="gray60") # 垂直线
}
游戏矩阵函数drawMatrix()
# 根据矩阵画数据
drawMatrix=function(){
if(isFail) return(NULL)
a<-c(t(m))
lab<-c(a[13:16],a[9:12],a[5:8],a[1:4])
d<-data.frame(x=rep(seq(0,0.95,e$step),width),y=rep(seq(0,0.95,e$step),each=height),lab=lab)
df<-d[which(d$lab>0),]
points(df$x+e$step/2,df$y+e$step/2,col=e$colors[log(df$lab,2)],pch=15,cex=23)
text(df$x+e$step/2,df$y+e$step/2,label=df$lab,cex=2)
}
游戏场景函数stage1()
# 游戏场景
stage1=function(){
callSuper()
move()
lose()
create()
drawTable()
drawMatrix()
}
完整的程序代码
source(file="game.r") #加载游戏框架
# Snake类，继承Game类
G2048<-setRefClass("G2048",contains="Game",
methods=list(
# 构造函数
initialize = function(name,debug) {
callSuper(name,debug) # 调父类
name<<-"2048 Game"
width<<-height<<-4
},
# 初始化变量
init = function(){
callSuper() # 调父类
e$max<<-4 # 最大数字
e$step<<-1/width #步长
e$dir<<-'up'
e$colors<<-rainbow(14) #颜色
e$stop<<-FALSE #不满足移动条件
create()
},
# 随机产生一个新数字
create=function(){
if(length(index(0))>0 & !e$stop){
e$stop<<-TRUE
one<-sample(c(2,4),1)
idx<-ifelse(length(index(0))==1,index(0),sample(index(0),1))
m[idx]<<-one
}
},
#失败条件
lose=function(){
# 判断是否有相邻的有重复值
near<-function(x){
length(which(diff(x)==0))
}
# 无空格子
if(length(index(0))==0){
h<-apply(m,1,near) # 水平方向
v<-apply(m,2,near) # 垂直方向
if(length(which(h>0))==0 & length(which(v>0))==0){
fail("No free grid.")
return(NULL)
}
}
},
# 方向移动
move=function(){
# 方向移动函数
moveFun=function(x){
if(e$dir %in% c('right','down')) x<-rev(x)
len0<-length(which(x==0)) # 0长度
x1<-x[which(x>0)] #去掉0
pos1<-which(diff(x1)==0) # 找到挨着相等的元素的位置
if(length(pos1)==3){ #3个索引
pos1<-pos1[c(1,3)]
}else if(length(pos1)==2 && diff(pos1)==1){ #2个索引
pos1<-pos1[1]
}
x1[pos1]<-x1[pos1]*2
x1[pos1+1]<-0
x1<-x1[which(x1>0)] #去掉0
x1<-c(x1,rep(0,4))[1:4] #补0，取4个
if(e$dir %in% c('right','down')) x1<-rev(x1)
return(x1)
}
last_m<-m
if(e$dir=='left') m<<-t(apply(m,1,moveFun))
if(e$dir=='right') m<<-t(apply(m,1,moveFun))
if(e$dir=='up') m<<-apply(m,2,moveFun)
if(e$dir=='down') m<<-apply(m,2,moveFun)
e$stop<<-ifelse(length(which(m != last_m))==0,TRUE,FALSE)
},
# 画布背景
drawTable=function(){
if(isFail) return(NULL)
plot(0,0,xlim=c(0,1),ylim=c(0,1),type='n',xaxs="i", yaxs="i")
abline(h=seq(0,1,e$step),col="gray60") # 水平线
abline(v=seq(0,1,e$step),col="gray60") # 垂直线
},
# 根据矩阵画数据
drawMatrix=function(){
if(isFail) return(NULL)
a<-c(t(m))
lab<-c(a[13:16],a[9:12],a[5:8],a[1:4])
d<-data.frame(x=rep(seq(0,0.95,e$step),width),y=rep(seq(0,0.95,e$step),each=height),lab=lab)
df<-d[which(d$lab>0),]
points(df$x+e$step/2,df$y+e$step/2,col=e$colors[log(df$lab,2)],pch=15,cex=23)
text(df$x+e$step/2,df$y+e$step/2,label=df$lab,cex=2)
},
# 游戏场景
stage1=function(){
callSuper()
move()
lose()
create()
drawTable()
drawMatrix()
},
# 开机画图
stage0=function(){
callSuper()
plot(0,0,xlim=c(0,1),ylim=c(0,1),type='n',xaxs="i", yaxs="i")
text(0.5,0.7,label=name,cex=5)
text(0.5,0.4,label="Any keyboard to start",cex=2,col=4)
text(0.5,0.3,label="Up,Down,Left,Rigth to control direction",cex=2,col=2)
text(0.2,0.05,label="Author:DanZhang",cex=1)
text(0.5,0.05,label="http://blog.fens.me",cex=1)
},
# 结束画图
stage2=function(){
callSuper()
info<-paste("Congratulations! You have max number",max(m),"!")
print(info)
plot(0,0,xlim=c(0,1),ylim=c(0,1),type='n',xaxs="i", yaxs="i")
text(0.5,0.7,label="Game Over",cex=5)
text(0.5,0.4,label="Space to restart, q to quit.",cex=2,col=4)
text(0.5,0.3,label=info,cex=2,col=2)
text(0.2,0.05,label="Author:DanZhang",cex=1)
text(0.5,0.05,label="http://blog.fens.me",cex=1)
},
# 键盘事件，控制场景切换
keydown=function(K){
callSuper(K)
if(stage==1){ #游戏中
if(K == "q") stage2()
else {
if(tolower(K) %in% c("up","down","left","right")){
e$dir<<-tolower(K)
stage1()
}
}
return(NULL)
}
return(NULL)
}
)
)
# 封装启动函数
g2048<-function(){
game<-G2048$new()
game$initFields(debug=TRUE)
game$run()
}
# 启动游戏
g2048()
游戏截图：
全部代码仅仅190行，有效代码行只有150行左右，我们就实现了2048游戏。用R语言处理矩阵的向量计算，还是很方便的，另外我们又用面向对象的方法，对游戏程序进行了统一的封装，标准化了函数定义和接口，让我们能更专注于游戏算法本身，提高开发的效率。下一步，就可以把游戏这个框架项目打包发布到CRAN了。
转载请注明出处：
http://blog.fens.me/r-game-2048/
最近正在学习R语言，看到你的文章之后让我瞬间成为你的粉丝。谢谢博主好文，受益匪浅。
🙂
耳目一新啊，赞！
其实，我是为了总结一套 R软件编程 的方法，综合运用了很多的技术。
惊呆了~
嘿嘿
[…] R语言游戏编程：R语言键盘和鼠标事件, R语言游戏之旅 贪食蛇入门, R语言游戏框架设计, R语言游戏之旅 游戏2048 […]
赞啊！
🙂
惊呆了！！！！
打一盘试试哈
楼主做我师父可好啊，太崇拜了
过奖，过奖！本文将作为新书《R的极客理想-高级开发篇》的一篇核心文章。
请问楼主，文章里面的流程图是用什么软件做的？
visio