亚洲乱码中文字幕综合,中国熟女仑乱hd,亚洲精品乱拍国产一区二区三区,一本大道卡一卡二卡三乱码全集资源,又粗又黄又硬又爽的免费视频

R語言寫2048游戲?qū)嵗v解

 更新時間：2021年03月16日 15:43:20   作者：返回主頁ywliao  
這篇文章主要介紹了R語言寫2048游戲?qū)嵗v解，文中將代碼列舉了出來，有感興趣的同學(xué)可以學(xué)習(xí)下

2048 是一款益智游戲，只需要用方向鍵讓兩兩相同的數(shù)字碰撞就會誕生一個翻倍的數(shù)字，初始數(shù)字由 2 或者 4 構(gòu)成，直到游戲界面全部被填滿，游戲結(jié)束。

編程時并未查看原作者代碼，不喜勿噴。

程序結(jié)構(gòu)如下：

R語言代碼：

#!/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)
    }
}
}
}
#初次運行游戲，生成隨機(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)
  }

#開始運行游戲
run<-function(){
  e<<-new.env()
  #X11(type="Xlib") #linux系統(tǒng)需添加此行代碼，不過字體受到限制，沒有windows下大
  stage0()
  getGraphicsEvent(prompt="2048",onKeybd=keydown)
}

run()

游戲畫面

到此這篇關(guān)于R語言寫2048游戲?qū)嵗v解的文章就介紹到這了,更多相關(guān)R語言寫2048游戲內(nèi)容請搜索腳本之家以前的文章或繼續(xù)瀏覽下面的相關(guān)文章希望大家以后多多支持腳本之家！

相關(guān)文章

  • R語言中因子相關(guān)知識點詳解

    R語言中因子相關(guān)知識點詳解

    在本篇內(nèi)容里小編給大家總結(jié)了關(guān)于R語言中因子的相關(guān)知識點以及相關(guān)實例內(nèi)容，有興趣的朋友們可以學(xué)習(xí)下。
    2021-04-04
  • R語言常用兩種并行方法之snowfall詳解

    R語言常用兩種并行方法之snowfall詳解

    這篇文章主要為大家介紹了R語言常用兩種并行方法之snowfall詳解，有需要的朋友可以借鑒參考下，希望能夠有所幫助，祝大家多多進(jìn)步，早日升職加薪
    2021-11-11
  • R語言數(shù)據(jù)框的合并實現(xiàn)示例

    R語言數(shù)據(jù)框的合并實現(xiàn)示例

    有時數(shù)據(jù)集來自多個地方,我們需要將兩個或多個數(shù)據(jù)集合并成一個數(shù)據(jù)集,本文主要介紹了R語言數(shù)據(jù)框的合并實現(xiàn)示例,具有一定的參考價值,感興趣的可以了解一下
    2024-02-02
  • R語言關(guān)于決策樹知識點總結(jié)

    R語言關(guān)于決策樹知識點總結(jié)

    在本篇文章里小編給大家整理的是一篇關(guān)于R語言關(guān)于決策樹知識點總結(jié)內(nèi)容，有興趣的朋友們可以學(xué)習(xí)下。
    2021-05-05
  • R語言運算符知識點總結(jié)

    R語言運算符知識點總結(jié)

    在本篇文章里小編給大家整理的是一篇關(guān)于R語言運算符知識點總結(jié)內(nèi)容，有興趣的朋友們可以學(xué)習(xí)參考下。
    2021-03-03
  • 用R語言繪制ROC曲線的實例講解

    用R語言繪制ROC曲線的實例講解

    這篇文章主要介紹了用R語言繪制ROC曲線的實例講解，具有很好的參考價值，希望對大家有所幫助。一起跟隨小編過來看看吧
    2021-04-04
  • R語言繪圖基礎(chǔ)教程(新手入門推薦!)

    R語言繪圖基礎(chǔ)教程(新手入門推薦!)

    數(shù)據(jù)作圖是數(shù)據(jù)分析的重要方法之一,R提供了豐富的作圖函,下面這篇文章主要給大家介紹了關(guān)于R語言繪圖基礎(chǔ)教程的相關(guān)資料,文中通過實例代碼以及圖文介紹的非常詳細(xì),需要的朋友可以參考下
    2022-11-11
  • R語言實現(xiàn)嶺回歸的示例代碼

    R語言實現(xiàn)嶺回歸的示例代碼

    本文主要介紹了R語言實現(xiàn)嶺回歸的示例代碼，文中通過示例代碼介紹的非常詳細(xì)，具有一定的參考價值，感興趣的小伙伴們可以參考一下
    2021-08-08
  • 詳解R語言中的多項式回歸、局部回歸、核平滑和平滑樣條回歸模型

    詳解R語言中的多項式回歸、局部回歸、核平滑和平滑樣條回歸模型

    這篇文章主要介紹了R語言中的多項式回歸、局部回歸、核平滑和平滑樣條回歸模型,本文給大家介紹的非常詳細(xì)，對大家的學(xué)習(xí)或工作具有一定的參考借鑒價值，需要的朋友可以參考下
    2021-03-03
  • R語言時間序列TAR閾值自回歸模型示例詳解

    R語言時間序列TAR閾值自回歸模型示例詳解

    這篇文章主要介紹了R語言時間序列TAR閾值自回歸模型,本文通過實例代碼給大家介紹的非常詳細(xì)，對大家的學(xué)習(xí)或工作具有一定的參考借鑒價值，需要的朋友可以參考下
    2021-03-03

最新評論