Created
July 10, 2019 05:08
-
-
Save thebioengineer/01816be5b590b9d44e77abbb87eaf179 to your computer and use it in GitHub Desktop.
An implementation of the game "Snake" in an R refclass
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| snake<-setRefClass("snake", | |
| fields=list( | |
| # System variables | |
| body="matrix", | |
| food = "numeric", | |
| direction='character', | |
| length="numeric", | |
| dead="logical", | |
| #game info | |
| score_total="numeric", | |
| reward="numeric", | |
| height="numeric", | |
| width="numeric", | |
| board="matrix", | |
| log="character", | |
| fruit_locations="list", | |
| state_new="array" | |
| ), | |
| methods=list( | |
| init = function(height=20,width=20, | |
| seed=floor(runif(1)*100),fruit_locs){ | |
| set.seed(seed) | |
| body<<-matrix(c(floor(width/2), | |
| floor(height/2), | |
| floor(width/2), | |
| floor(height/2)-1), | |
| byrow = FALSE,ncol=2) | |
| direction<<-sample(c("up","left","right"),1) | |
| reward<<-0 | |
| score_total<<-0 | |
| length<<-2 | |
| height<<-height | |
| width<<-width | |
| dead<<-FALSE | |
| log<<-as.character(seed) | |
| if(!missing(fruit_locs)){ | |
| fruit_locations<<-fruit_locs | |
| } | |
| updatefood() | |
| updateboard() | |
| get_state() | |
| }, | |
| stepforward = function(){ | |
| reward<<-0 | |
| nextloc<-nextstep() | |
| dist_fruit_orig<-sqrt(((food[1]-body[1,1])^2) + | |
| (food[2]-body[1,2])^2) | |
| dist_fruit_next<-sqrt(((food[1]-nextloc[1])^2) + | |
| (food[2]-nextloc[2])^2) | |
| reward<<-ifelse(dist_fruit_orig>dist_fruit_next, | |
| 10,-10) | |
| #check if nextLoc is body or wall, if so, fail | |
| isbody<-any(do.call('c',lapply(1:nrow(body),function(x){ | |
| all(body[x,]==nextloc) | |
| }))) | |
| iswall<-any(nextloc%in%c(-1,height+1,width+1)) | |
| if(isbody || iswall){die()} | |
| #check if nextloc is food | |
| isfood=all(food==nextloc) | |
| if(isfood){ | |
| length<<-length+1 | |
| score_total <<- score_total + | |
| ((floor(log(length))+1) * 5) | |
| reward <<- 20 | |
| updatefood() | |
| } | |
| updatebody(nextloc) | |
| if(!dead){ | |
| updateboard() | |
| } | |
| }, | |
| nextstep = function(direct){ | |
| switch(direction, | |
| "up"=c(0,1), | |
| "down"=c(0,-1), | |
| "left"=c(-1,0), | |
| "right"=c(1,0))+body[1,] | |
| }, | |
| updatebody = function(nextloc){ | |
| bod<-as.numeric(body) | |
| if(length>nrow(body)){ | |
| body<<-matrix(c(nextloc[1], | |
| bod[1:nrow(body)], | |
| nextloc[2], | |
| bod[(nrow(body)+1):(2*nrow(body))]), | |
| byrow=FALSE,ncol=2) | |
| }else{ | |
| body<<-matrix(c(nextloc[1], | |
| bod[1:(nrow(body)-1)], | |
| nextloc[2], | |
| bod[(nrow(body)+1):((2*nrow(body))-1)]), | |
| byrow=FALSE,ncol=2) | |
| } | |
| }, | |
| updatefood = function(){ | |
| #figure out how to pre-specify food? | |
| if(length(fruit_locations)==0){ | |
| pos<-sample(1:(width*height),1) | |
| col<-ceiling(pos/height) | |
| row<-pos%%height | |
| isbody<-any( | |
| do.call('c', | |
| lapply(1:nrow(body), | |
| function(x){ | |
| all(body[x,]==c(col,row)) | |
| }))) | |
| if(isbody){ | |
| updatefood() | |
| }else{ | |
| food<<-c(col,row) | |
| }}else{ | |
| food<<-fruit_locations[[1]] | |
| fruit_locations<<-fruit_locations[-1] | |
| } | |
| }, | |
| updateboard = function(){ | |
| boardtemp<-matrix(rep(0,width*height),nrow=width) | |
| boardtemp[body[1,2],body[1,1]]<-2 | |
| for(snake_segment in seq(2,length)){ | |
| boardtemp[body[snake_segment,2], | |
| body[snake_segment,1]]<-1 | |
| } | |
| boardtemp[food[2],food[1]]<-3 | |
| board<<-boardtemp | |
| }, | |
| plotboard = function(){ | |
| par(mar=c(0, 0, 1, 0), xaxs='i', yaxs='i') | |
| plot(-1,-1,xlim=c(0,width+1),ylim=c(0,height+1), | |
| type='n',axes=FALSE, frame.plot=TRUE) | |
| Axis(side=1, labels=FALSE) | |
| Axis(side=2, labels=FALSE) | |
| points(body[,1],body[,2], | |
| col=c("blue",rep('black',length-1)),pch=15,cex=2) | |
| points(food[1],food[2],col="red",pch=16,cex=2) | |
| title(main = paste("SNAKE! score -",score_total)) | |
| }, | |
| returnstatus = function(){ | |
| state<-state_new | |
| get_state() | |
| list( | |
| state=state, | |
| reward=reward, | |
| action=array( | |
| as.numeric(c("up","down","left","right")%in% | |
| direction),dim = c(1,4)), | |
| done=dead, | |
| state_new=state_new) | |
| }, | |
| die = function(){ | |
| dead<<-TRUE | |
| reward<<-(-20) | |
| }, | |
| updatedirection = function(dir){ | |
| if(missing(dir)){ | |
| line<-readline("snakedir: a,w,s,d") | |
| print(line) | |
| dir<-switch(tolower(line), | |
| "a"="left", | |
| "w"="up", | |
| "s"="down", | |
| "d"="right", | |
| direction) | |
| } | |
| if(dir!=direction & okayDir(dir)){ | |
| direction<<-dir | |
| } | |
| }, | |
| updateLog = function(){ | |
| log<<-c(log,direction) | |
| }, | |
| okayDir=function(dir){ | |
| dir!=switch(direction, | |
| "right"="left", | |
| "down"="up", | |
| "up"="down", | |
| "left"="right") | |
| }, | |
| get_state=function(){ | |
| danger<-vector("numeric",4) | |
| i<-1 | |
| for(nextdir in c("up","down","left","right")){ | |
| nextpos<-switch(nextdir, | |
| "up"=c(0,1), | |
| "down"=c(0,-1), | |
| "left"=c(-1,0), | |
| "right"=c(1,0))+body[1,] | |
| danger_body<-as.numeric(any( | |
| do.call('c',lapply(1:nrow(body), | |
| function(x){ | |
| all(body[x,]==nextpos) | |
| })))) | |
| danger_wall<-as.numeric( | |
| any(nextpos%in%c(-1,nrow(board)+1,ncol(board)+1))) | |
| danger[i]<-sum(c(danger_body,danger_wall))>0 | |
| i<-i+1 | |
| } | |
| dirFruit<-as.numeric(c(body[1,1]<food[1], | |
| body[1,1]>food[1], | |
| body[1,2]<food[2], | |
| body[1,2]>food[2])) | |
| movement <- switch(direction, | |
| "up"=c(1,0,0,0), | |
| "down"=c(0,1,0,0), | |
| "left"=c(0,0,1,0), | |
| "right"=c(0,0,0,1)) | |
| state_new<<-array(c(danger,dirFruit,movement), | |
| dim = c(1,12)) | |
| }, | |
| run = function(return_info=TRUE,plot_board=FALSE,delay=.3){ | |
| init() | |
| if(plot_board){plotboard()} | |
| if(return_info){returnstatus()} | |
| updatedirection() | |
| while(!dead){ | |
| stepforward() | |
| plotboard() | |
| if(plot_board){plotboard()} | |
| if(return_info){returnstatus()} | |
| if(!dead){updatedirection()} | |
| } | |
| text(floor(width/2), | |
| floor(height/2), | |
| labels = "GAME OVER", | |
| col="red",cex=3) | |
| }, | |
| run_iter = function(dir,returnStatus=FALSE){ | |
| if(missing(dir)){ | |
| dir<-direction | |
| } | |
| if(!dead){ | |
| updatedirection(dir) | |
| stepforward() | |
| updateLog() | |
| }else{ | |
| return("DEAD") | |
| } | |
| if(returnStatus){ | |
| returnstatus() | |
| } | |
| }, | |
| replay = function(steps,x2,delay=.5){ | |
| if(is.numeric(x2)){ | |
| init(seed = x2) | |
| }else{ | |
| init(fruit_locs=x2) | |
| } | |
| plotboard() | |
| for(move in steps){ | |
| run_iter(move) | |
| plotboard() | |
| Sys.sleep(delay) | |
| } | |
| } | |
| ) | |
| ) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment