R-ohjelmointi.org

Tilastotieteellistä ohjelmointia R-kielellä

Lisää pelejä: labyrinttitehtävän puitteet

Tutustuin mielenkiinnosta uuteen peruskoulun opetussuunnitelmaan, johon sisältyy ohjelmointiopetusta, ja ajauduin sitä kautta (jälleen!) Koodaustunnin sivustolle. Sivustolla on muun muassa linkkejä harjoitustehtäviin, joita koodaustunnilla voidaan tehdä. Harjoitukset ovat melko yksinkertaisia Scratch:llä toteutettavia labyrintin läpi kulkevan reitin muodostamiseen tähtääviä tehtäviä.

Muistan miten minulla oli yli 30 vuotta sitten ohjelmointia aloittaessani hankaluuksia ymmärtää muun muassa, mikä on silmukka, ja mitä hyötyä siitä on. Voin kuvitella että nuorempi minäni olisi varmasti hyötynyt Koodaustunnin harjoituksista. Koska siitä on jo noin 25 vuotta aikaa, kun olen viimeksi ohjelmoinut mitään samantyyppistä (olenpa fakkiutunut!), ajattelin testata miten R taipuu samankaltaisen harjoitteen toteuttamiseen.

R ei ole varsinaisesti tunnettu siitä, että sillä toteutetaan interaktiivisia, grafiikkaan nojaavia pelejä. R kuitenkin taipuu ihan mainiosti esimerkiksi lautapelien toteuttamiseen, ja lähestyinkin haastetta samalla idealla. Toteutuksen grafiikka on karua, mutta funktiot toimivat. Labyrintissä voi liikkua, pyöriä ympäri ja saapua uloskäynnille. Lisäksi ei-sallittuihin ruutuihin liikkuminen on estetty.

Labyrinttipelissä on toistaiseksi vain yksi taso, joka näyttää tältä:

aluasetelma

Pelihahmo on sininen nuoli, jonka terävä klyyvari osoittaa kulkusuuntaan. Tavoitteena on päästä labyrintistä ulos siitä ruudusta, jonka päässä on asteriski (*).

Peli alustetaan komennolla map<-initiateGame(). Tämän jälkeen labyrintissä voi liikkua eteenpäin komennolla map<-moveForward(map) ja kääntyä oikeaan (map<-turnRight(map)) tai vasempaan (map<-turnLeft(map)).

Myönnän, että pelin kooditason toteutus jättää vähän toivomisen varaa, mutta se toimii, vaikkei olekaan erityisen elegantti. Mainittakoon, että testiryhmä piti tätäkin tekelettäni väsyneenä. Olen kyllä sitä mieltä, että yksi kaikkien aikojen hienoimpia pelejä on Nethack, joka ei varsinaisesti loista grafiikallaan, mutta testiryhmän tyynnyttämiseksi pitää varmaankin alkaa opetella Pygamea tai Stencyliä.

Pelin funktioiden koodi löytyy alta, ja pelin testaamiseksi se pitää kopioida ja liittää R:n konsoliin.

initiateGame<-function(level=1) {
   require(shape)
   windows(7,7)
   par(mar=c(5,5,5,5))
   map<-initiateMap(level)
   plotCharacter(map)
   return(map)
}
 
 
initiateMap<-function(level=1) {
   if(level==1) {
      mat<-matrix(ncol=5, nrow=5, data=0)
      rownames(mat)<-1:5
      colnames(mat)<-1:5
      mat[,5]<-1
      mat[1,]<-1
 
      pos<-c(1,1)
      dir<-c(1,2)
 
      goal<-c(6,5)
 
      map<-list(mat=mat, pos=pos, dir=dir, level=level, goal=goal)
 
      plotLevel(map)
 
      return(map)
   }
}
 
 
plotLevel<-function(map=map) {
   if(map$level==1) {
      plot(0, 0, col=0, xlab="", ylab="", xlim=c(0,5), ylim=c(0,5), xaxs="i", yaxs="i")
 
      eg<-expand.grid(x=1:ncol(map$mat), y=1:nrow(map$mat), col="white", stringsAsFactors=FALSE)
      eg$col[which(map$mat==0)]<-"black"
      points(eg$x-0.5, eg$y-0.5, pch=15, cex=10.5, col=eg$col)
 
      abline(v=0:5, col="grey75", lwd=2)
      abline(h=0:5, col="grey75", lwd=2)
 
      box()
 
      mtext(side=1, line=3, at=0.5, text=" ^ ", cex=2)
      mtext(side=4, line=2, at=4.5, text=" * ", cex=2)
   }
}
 
 
plotCharacter<-function(map) {
   res<-(map$pos-map$dir)
   if(res[1]==0 & res[2]==-1) {
      angle<-90
   }
 
   if(res[1]==-1 & res[2]==0) {
      angle<-0
   }
 
   if(res[1]==0 & res[2]==1) {
      angle<- -90
   }
 
   if(res[1]==1 & res[2]==0) {
      angle<-180
   }
 
   Arrowhead(x0=map$pos[1]-0.5, y0=map$pos[2]-0.5, angle=angle, arr.length=0.5, arr.type="triangle", lcol="#0000CC")
}
 
 
moveForward<-function(map) {
   checkGoal(map)
   move<-checkMove(map)
   if(move) {
      map.old<-map
      map$pos<-map$dir
      map<-updateDirection1(map, map.old)
      plotLevel(map)
      plotCharacter(map)
   } else {
      stop("Can't go there!")
   }     
   return(map)
}
 
 
turnRight<-function(map) {
   move<-TRUE
   if(move) {
      map.old<-map
      map<-updateDirection2(map, map.old)
      plotLevel(map)
      plotCharacter(map)
   }     
   return(map)   
}
 
 
turnLeft<-function(map) {
   move<-TRUE
   if(move) {
      map.old<-map
      map<-updateDirection3(map, map.old)
      plotLevel(map)
      plotCharacter(map)
   }     
   return(map)   
}
 
 
checkMove<-function(map) {
   if(map$dir[1] < min(as.numeric(rownames(map$mat))) | map$dir[1] > max(as.numeric(rownames(map$mat))) | map$dir[2] < min(as.numeric(colnames(map$mat))) | map$dir[2] > max(as.numeric(colnames(map$mat)))) {
      move<-FALSE
   } 
   if(map$dir[1] >= min(as.numeric(rownames(map$mat))) & map$dir[1] <= max(as.numeric(rownames(map$mat))) & map$dir[2] >= min(as.numeric(colnames(map$mat))) & map$dir[2] <= max(as.numeric(colnames(map$mat)))) {
      if(map$mat[map$dir[1], map$dir[2]]==0) {
         move<-FALSE
      }
   }
   if(map$dir[1] >= min(as.numeric(rownames(map$mat))) & map$dir[1] <= max(as.numeric(rownames(map$mat))) & map$dir[2] >= min(as.numeric(colnames(map$mat))) & map$dir[2] <= max(as.numeric(colnames(map$mat)))) {
      if(map$mat[map$dir[1], map$dir[2]]==1) {
         move<-TRUE
      }
   }
   return(move)
}
 
 
updateDirection1<-function(map, map.old) {
   tmp<-map.old$pos-map.old$dir
   if(tmp[1]==0 & tmp[2]==-1) {
      map$dir[2]<-map$dir[2]+1
   }
   if(tmp[1]==-1 & tmp[2]==0) {
      map$dir[1]<-map$dir[1]+1
   }
   if(tmp[1]==0 & tmp[2]==1) {
      map$dir[2]<-map$dir[2]-1
   }
   if(tmp[1]==1 & tmp[2]==0) {
      map$dir[1]<-map$dir[1]-1
   }
   return(map)
}
 
 
updateDirection2<-function(map, map.old) {
   tmp<-map.old$pos-map.old$dir   
   if(tmp[1]==0 & tmp[2]==-1) {
      map.old$dir<-c(map.old$dir[1]+1, map.old$dir[2]-1)
   }
   if(tmp[1]==-1 & tmp[2]==0) {
      map.old$dir<-c(map.old$dir[1]-1, map.old$dir[2]-1)
   }
   if(tmp[1]==0 & tmp[2]==1) {
      map.old$dir<-c(map.old$dir[1]-1, map.old$dir[2]+1)
   }
   if(tmp[1]==1 & tmp[2]==0) {
      map.old$dir<-c(map.old$dir[1]+1, map.old$dir[2]+1)
   }
   return(map.old)
}
 
 
updateDirection3<-function(map, map.old) {
   tmp<-map.old$pos-map.old$dir   
   if(tmp[1]==0 & tmp[2]==-1) {
      map.old$dir<-c(map.old$dir[1]-1, map.old$dir[2]-1)
   }
   if(tmp[1]==1 & tmp[2]==0) {
      map.old$dir<-c(map.old$dir[1]+1, map.old$dir[2]-1)
   }
   if(tmp[1]==0 & tmp[2]==1) {
      map.old$dir<-c(map.old$dir[1]+1, map.old$dir[2]+1)
   }
   if(tmp[1]==-1 & tmp[2]==0) {
      map.old$dir<-c(map.old$dir[1]-1, map.old$dir[2]+1)
   }
   return(map.old)
}
 
 
checkGoal<-function(map) {
   if(all(map$goal==map$dir)) {
      stop("You reached the exit!")
   }
}