R語(yǔ)言寫2048游戲?qū)嵗v解
2048 是一款益智游戲,只需要用方向鍵讓兩兩相同的數(shù)字碰撞就會(huì)誕生一個(gè)翻倍的數(shù)字,初始數(shù)字由 2 或者 4 構(gòu)成,直到游戲界面全部被填滿,游戲結(jié)束。
編程時(shí)并未查看原作者代碼,不喜勿噴。
程序結(jié)構(gòu)如下:

R語(yǔ)言代碼:
#!/usr/bin/Rscript
#畫背景
draw_bg <- function(){
plot(0,0,xlim=c(0,0.8),ylim=c(0,0.8),type='n',xaxs="i", yaxs="i")
for (i in c(1:4)){
for (j in c(1:4)){
points(0.1+0.2*(i-1),0.9-0.2*(j),col="gray",pch=15,cex=16)}}
}
#畫數(shù)字矩陣
draw_num <- function(){
for (i in c(1:4)){
for (j in c(1:4)){
if (e$m[i,j] != 0){
text(0.1+(j-1)*0.2,0.7-(i-1)*0.2,font=2,family="Arial",label=e$m[i,j],cex=2)
}
}
}
}
#初次運(yùn)行游戲,生成隨機(jī)矩陣
init <- function(){
e$stage=1
mt <- matrix(c(sample(c(2,4),1),rep(0,15)),nrow=4)
e$m <- mt[sample(4),sample(4)]
draw_bg()
draw_num()
}
#移除矩陣數(shù)字間的0
rm_zero <- function(){
if (e$x==0){
if (e$dir=="up"){
for (c in 1:4) e$m[,c] <- c(e$m[,c][which(e$m[,c]!=0)],rep(0,4-length(e$m[,c][which(e$m[,c]!=0)])))
}
if (e$dir=="down"){
for (c in 1:4) e$m[,c] <- c(rep(0,4-length(e$m[,c][which(e$m[,c]!=0)])),e$m[,c][which(e$m[,c]!=0)])
}
if (e$dir=="left"){
for (r in 1:4) e$m[r,] <- c(e$m[r,][which(e$m[r,]!=0)],rep(0,4-length(e$m[r,][which(e$m[r,]!=0)])))
}
if (e$dir=="right"){
for (r in 1:4) e$m[r,] <- c(rep(0,4-length(e$m[r,][which(e$m[r,]!=0)])),e$m[r,][which(e$m[r,]!=0)])
}
}
else{
if (e$dir=="up"){
c <- e$x
e$m[,c] <- c(e$m[,c][which(e$m[,c]!=0)],rep(0,4-length(e$m[,c][which(e$m[,c]!=0)])))
}
if (e$dir=="down"){
c <- e$x
e$m[,c] <- c(rep(0,4-length(e$m[,c][which(e$m[,c]!=0)])),e$m[,c][which(e$m[,c]!=0)])
}
if (e$dir=="left"){
r <- e$x
e$m[r,] <- c(e$m[r,][which(e$m[r,]!=0)],rep(0,4-length(e$m[r,][which(e$m[r,]!=0)])))
}
if (e$dir=="right"){
r <- e$x
e$m[r,] <- c(rep(0,4-length(e$m[r,][which(e$m[r,]!=0)])),e$m[r,][which(e$m[r,]!=0)])
}
}
}
#在空白處添加隨機(jī)數(shù)字
new_mt <- function(){
e$m[sample(which(e$m==0),1)] <- sample(c(2,4),1)
}
#檢查是否游戲失敗
fail <- function(){
if (length(e$m[which(e$m==0)])==0){
e$x=0
for (r in 1:3){
for (c in 1:3){
if (e$m[r,c] == e$m[r,c+1] | e$m[r,c] == e$m[r+1,c]){
e$x=1
}
}
}
if (e$x==0){
stage2()
}
}
}
#游戲中
stage1 <- function(){
e$stage <- 1
e$x <- 0
rm_zero()
if (e$dir=="left"){
i=1
while (i<=4){
if (e$m[i,1] != 0 & e$m[i,1]==e$m[i,2] & e$m[i,1]==e$m[i,3] & e$m[i,1]==e$m[i,4]){
e$m[i,]=rep(c(2*e$m[i,1],0),each=2)
e$x=1
}
else if (e$m[i,2]!=0 & e$m[i,3] != 0 & e$m[i,2]==e$m[i,1] & e$m[i,3]==e$m[i,4]){
e$m[i,]=c(2*e$m[i,1],0,2*e$m[i,3],0)
e$x=1
}
else if (e$m[i,2] != 0 & e$m[i,2]==e$m[i,1]){
e$m[i,]=c(2*e$m[i,1],0,e$m[i,3],e$m[i,4])
e$x=1
}
else if (e$m[i,3] != 0 & e$m[i,3]==e$m[i,4]){
e$m[i,]=c(e$m[i,1],e$m[i,2],2*e$m[i,3],0)
e$x=1
}
else if (e$m[i,2] != 0 & e$m[i,2]==e$m[i,3]){
e$m[i,]=c(e$m[i,1],2*e$m[i,2],0,e$m[i,4])
e$x=1
}
i=i+1
}
rm_zero()
new_mt()
draw_bg()
draw_num()
fail()
}
if (e$dir=="right"){
i=1
while (i<=4){
if (e$m[i,1] != 0 & e$m[i,1]==e$m[i,2] & e$m[i,1]==e$m[i,3] & e$m[i,1]==e$m[i,4]){
e$m[i,]=rep(c(0,2*e$m[i,1]),each=2)
e$x=1
}
else if (e$m[i,2] != 0 & e$m[i,3] != 0 & e$m[i,2]==e$m[i,1] & e$m[i,3]==e$m[i,4]){
e$m[i,]=c(0,2*e$m[i,1],0,2*e$m[i,3])
e$x=1
}
else if (e$m[i,2] != 0 & e$m[i,2]==e$m[i,1]){
e$m[i,]=c(0,2*e$m[i,1],e$m[i,3],e$m[i,4])
e$x=1
}
else if (e$m[i,3] != 0 & e$m[i,3]==e$m[i,4]){
e$m[i,]=c(e$m[i,1],e$m[i,2],0,2*e$m[i,3])
e$x=1
}
else if (e$m[i,2] != 0 & e$m[i,2]==e$m[i,3]){
e$m[i,]=c(e$m[i,1],0,2*e$m[i,2],e$m[i,4])
e$x=1
}
i=i+1
}
rm_zero()
new_mt()
draw_bg()
draw_num()
fail()
}
if (e$dir=="up"){
j=1
while (j<=4){
if (e$m[1,j] != 0 & e$m[1,j]==e$m[2,j] & e$m[1,j]==e$m[3,j] & e$m[1,j]==e$m[4,j]){
e$m[,j]=rep(c(2*e$m[1,j],0),each=2)
e$x=1
}
else if (e$m[2,j] != 0 & e$m[3,j] != 0 & e$m[2,j]==e$m[1,j] & e$m[3,j]==e$m[4,j]){
e$m[,j]=c(2*e$m[1,j],0,2*e$m[3,j],0)
e$x=1
}
else if (e$m[2,j] != 0 & e$m[2,j]==e$m[1,j]){
e$m[,j]=c(2*e$m[1,j],0,e$m[3,j],e$m[4,j])
e$x=1
}
else if (e$m[3,j] != 0 & e$m[3,j]==e$m[4,j]){
e$m[,j]=c(e$m[1,j],e$m[2,j],2*e$m[3,j],0)
e$x=1
}
else if (e$m[2,j] != 0 & e$m[2,j]==e$m[3,j]){
e$m[,j]=c(e$m[1,j],2*e$m[2,j],0,e$m[4,j])
e$x=1
}
j=j+1
}
rm_zero()
new_mt()
draw_bg()
draw_num()
fail()
}
if (e$dir=="down"){
j=1
while (j<=4){
if (e$m[1,j] != 0 & e$m[1,j]==e$m[2,j] & e$m[1,j]==e$m[3,j] & e$m[1,j]==e$m[4,j]){
e$m[,j]=rep(c(0,2*e$m[1,j]),each=2)
e$x=1
}
else if (e$m[2,j] != 0 & e$m[3,j] != 0 & e$m[2,j]==e$m[1,j] & e$m[3,j]==e$m[4,j]){
e$m[,j]=c(0,2*e$m[1,j],0,2*e$m[3,j])
e$x=1
}
else if (e$m[2,j] != 0 & e$m[2,j]==e$m[1,j]){
e$m[,j]=c(0,2*e$m[1,j],e$m[3,j],e$m[4,j])
e$x=1
}
else if (e$m[3,j] != 0 & e$m[3,j]==e$m[4,j]){
e$m[,j]=c(e$m[1,j],e$m[2,j],0,2*e$m[3,j])
e$x=1
}
else if (e$m[2,j] != 0 & e$m[2,j]==e$m[3,j]){
e$m[,j]=c(e$m[1,j],0,2*e$m[2,j],e$m[4,j])
e$x=1
}
j=j+1
}
rm_zero()
new_mt()
draw_bg()
draw_num()
fail()
}
}
stage2<-function(){
e$stage<-2
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=2)
text(0.5,0.4,label="Space to restart, q to quit.",cex=2,col=4)
text(0.2,0.05,label="Author:YwLiao",cex=1)
}
# 開機(jī)畫圖
stage0<-function(){
e$stage<-0
plot(0,0,xlim=c(0,1),ylim=c(0,1),type='n',xaxs="i", yaxs="i")
text(0.5,0.7,label="2048",cex=2)
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:YwLiao",cex=1)
}
#鍵盤事件
keydown<-function(K){
print(paste("keydown:",K,",stage:",e$stage));
if(e$stage==0){
#開機(jī)畫面
init()
return(NULL)
}
if(e$stage==2){ #結(jié)束畫面
if(K=="q") q()
else if(K==' ') stage0()
return(NULL)
}
if(e$stage==1){ #游戲中
if(K == "q") {
stage2()
}else {
if(tolower(K) %in% c("up","down","left","right")){
e$dir<-tolower(K)
stage1()
}
}
}
return(NULL)
}
#開始運(yùn)行游戲
run<-function(){
e<<-new.env()
#X11(type="Xlib") #linux系統(tǒng)需添加此行代碼,不過字體受到限制,沒有windows下大
stage0()
getGraphicsEvent(prompt="2048",onKeybd=keydown)
}
run()
游戲畫面

到此這篇關(guān)于R語(yǔ)言寫2048游戲?qū)嵗v解的文章就介紹到這了,更多相關(guān)R語(yǔ)言寫2048游戲內(nèi)容請(qǐng)搜索腳本之家以前的文章或繼續(xù)瀏覽下面的相關(guān)文章希望大家以后多多支持腳本之家!
相關(guān)文章
R語(yǔ)言數(shù)據(jù)可視化繪圖bar chart條形圖實(shí)現(xiàn)示例
這篇文章主要為大家介紹了R語(yǔ)言數(shù)據(jù)可視化繪圖bar chart條形圖的實(shí)現(xiàn)示例,有需要的朋友可以借鑒參考下,希望能夠有所幫助,祝大家多多進(jìn)步2022-02-02
R語(yǔ)言glmnet包lasso回歸中分類變量的處理圖文詳解
Lasso回歸又稱為套索回歸,是Robert?Tibshirani于1996年提出的一種新的變量選擇技術(shù),下面這篇文章主要給大家介紹了關(guān)于R語(yǔ)言glmnet包lasso回歸中分類變量的處理的相關(guān)資料,需要的朋友可以參考下2022-11-11
R語(yǔ)言繪圖數(shù)據(jù)可視化pie?chart餅圖
這篇文章主要介紹了R語(yǔ)言繪圖數(shù)據(jù)可視化pie?chart餅圖,教大家如何用R語(yǔ)言來畫大餅,有需要的朋友可以借鑒參考下,希望能夠有所幫助,祝大家多多進(jìn)步2022-02-02
R語(yǔ)言apply系列函數(shù)實(shí)例詳解
apply()函數(shù)是一種很強(qiáng)大的機(jī)制,下面這篇文章主要給大家介紹了關(guān)于R語(yǔ)言apply系列函數(shù)的相關(guān)資料,文中通過實(shí)例代碼介紹的非常詳細(xì),需要的朋友可以參考下2022-12-12
R語(yǔ)言ggplot2實(shí)現(xiàn)將多個(gè)照片拼接到一起
本文主要介紹了R語(yǔ)言ggplot2實(shí)現(xiàn)將多個(gè)照片拼接到一起,文中通過示例代碼介紹的非常詳細(xì),需要的朋友們下面隨著小編來一起學(xué)習(xí)學(xué)習(xí)吧2021-07-07
R 安裝包安裝(install.packages)時(shí)報(bào)錯(cuò)的解決方案
這篇文章主要介紹了R 安裝包安裝(install.packages)時(shí)報(bào)錯(cuò)的解決方案,具有很好的參考價(jià)值,希望對(duì)大家有所幫助。一起跟隨小編過來看看吧2021-04-04
使用R語(yǔ)言實(shí)現(xiàn)自動(dòng)文摘的方法
本文介紹了如何使用R語(yǔ)言實(shí)現(xiàn)自動(dòng)文摘,我們首先介紹了基于詞頻-逆文檔頻率(TF-IDF)的自動(dòng)文摘方法,包括創(chuàng)建詞項(xiàng)文檔矩陣,計(jì)算TF-IDF值,提取關(guān)鍵詞,以及根據(jù)關(guān)鍵詞生成摘要,需要的朋友一起學(xué)習(xí)下吧2023-05-05

