Olisin myös kiinnostunut tietämään, onko vastaavia tekoälyjä jo tehty Coolbasicilla. Jos on, niitä voisi postailla tänne. Itselle voisi ainakin mahdollisesti tulla tarpeen hieman hienostuneempi tekoäly kuin omani. Omastanihan puuttuu tällä hetkellä täysin esim. useamman ratkaisun tuki.
Versio 1:
Code: Select all
//==============================//
// ******* FASTMAZE 1.0 ******* //
// ******* by MURSKAAJA ******* //
//==============================//
SCREEN 1024,768
Type CHECKPOINTS
Field obj
EndType
map = MakeMap(20,20,32,32)
tileset = LoadImage("media\tileset.bmp")
PaintObject map,tileset
// lähtö- ja maalipisteet
start_x = 2
start_y = 2
goal_x = MapWidth()-1
goal_y = MapHeight()-1
//=============================//
// ****** KARTTAEDITORI ****** //
//=============================//
// kartan alustus
For x = 1 To MapWidth()
For y = 1 To MapHeight()
If x = start_x And y = start_y Then
EditMap map,0,x,y,4
ElseIf x = goal_x And y = goal_y
EditMap map,0,x,y,5
ElseIf x = 1 or x = MapWidth() Or y = 1 Or y = MapHeight() Then
EditMap map,0,x,y,77
EditMap map,2,x,y,1
Else
EditMap map,0,x,y,129
EndIf
Next y
Next x
// varsinainen karttaeditori
Repeat
tx = RoundUp(MouseWX()/32.0)+MapWidth()/2
ty = MapHeight()-(RoundDown(MouseWY()/32.0)+MapHeight()/2)
If tx > 0 And tx <= MapWidth() And ty > 0 And ty <=MapHeight() Then
For x = 1 To MapWidth()
For y = 1 To MapHeight()
If MouseDown(1) Then
EditMap map,0,tx,ty,77
EditMap map,2,tx,ty,1
ElseIf MouseDown(2) Then
EditMap map,0,tx,ty,129
EditMap map,2,tx,ty,0
EndIf
Next y
Next x
EndIf
If GetMap2(2,start_x,start_y) Or GetMap2(0,start_x,start_y) = 129 Then
EditMap map,0,start_x,start_y,4
EditMap map,2,start_x,start_y,0
EndIf
If GetMap2(2,goal_x,goal_y) Or GetMap2(0,goal_x,goal_y) = 129 Then
EditMap map,0,goal_x,goal_y,5
EditMap map,2,goal_x,goal_y,0
EndIf
DrawGame
Text 0,0,"Left mouse button makes wall."
Text 0,15,"Right mouse button makes floor."
Text 0,30,"Press Return-key when ready."
Text 0,60,"X: "+tx
Text 0,75,"Y: "+ty
Box MouseX()-16,MouseY()-16,32,32,0
If KeyDown(cbkeyreturn) Then
Exit
EndIf
DrawScreen
Forever
//=============================//
// ********* TEKOÄLY ********* //
//=============================//
// tekoälyn tarvitsemat taulukot
Dim DirectionsCount(MapWidth(),MapHeight())
Dim Directions(MapWidth(),MapHeight(),3)
Dim CheckPointTable(1000,1)
SolvingTime = Timer()
// käydään kartta läpi ja tallennetaan taulukoihin tiedot ruuduista (=tilestä)
// DirectionsCount-taulukkoon tallennetaan tiedot, kuinka moneen suuntaan
// kustakin ruudusta voi liikkua
// Directions-taulukkoon tallennetaan suunnat
For x = 1 To MapWidth()
For y = 1 To MapHeight()
If GetMap2(2,x,y) = 0 Then
If x+1 <= MapWidth()
If GetMap2(2,x+1,y) = 0 Then
DirectionsCount(x,y) = DirectionsCount(x,y) + 1
DirectionsCount(x+1,y) = DirectionsCount(x+1,y) + 1
Directions(x,y,1) = True
Directions(x+1,y,3) = True
EndIf
EndIf
If y+1 <= MapHeight()
If GetMap2(2,x,y) = 0 Then
DirectionsCount(x,y) = DirectionsCount(x,y) + 1
DirectionsCount(x,y+1) = DirectionsCount(x,y+1) + 1
Directions(x,y,2) = True
Directions(x,y+1,0) = True
EndIf
EndIf
EndIf
Next y
Next x
x = start_x
y = start_y
// ensimmäisen reittimerkin sijainti
CheckPointTable(0,0) = x
CheckPointTable(0,1) = y
CPnr = 0
// Varsinainen sokkelon selvittäminen. Loopataan, kunnes ollaan maalissa.
// Tarkistaa joka kierros mihin suuntaan ruudusta voi siirtyä
// (järjestyksessä ylös,oikealle,alas,vasemmalle), liikkuu seuraavaan ruutuun ja merkitsee
// CheckPointTable-taulukkoon reittiä (muista taulukoista tuhotaan samalla suuntatietoja,
// jotta vääriä reittejä ei kuljeta useampaan kertaan). Jos ruudusta ei voi liikkua enää
// eteenpäin, palataan taaksepäin kunnes tulee vastaan edellinen ruutu, josta suuntia oli
// vielä käymättä läpi.
goal = False
While goal = False
If Directions(x,y,0) = True Then
Directions(x,y,0) = False
DirectionsCount(x,y) = DirectionsCount(x,y) - 1
If DirectionsCount(x,y-1) > 0 Then
Directions(x,y-1,2) = False
DirectionsCount(x,y-1) = DirectionsCount(x,y-1) - 1
y - 1
CPnr + 1
CheckPointTable(CPnr,0) = x
CheckPointTable(CPnr,1) = y
EndIf
ElseIf Directions(x,y,1) = True Then
Directions(x,y,1) = False
DirectionsCount(x,y) = DirectionsCount(x,y) - 1
If DirectionsCount(x+1,y) > 0 Then
Directions(x+1,y,3) = False
DirectionsCount(x+1,y) = DirectionsCount(x+1,y) - 1
x + 1
CPnr + 1
CheckPointTable(CPnr,0) = x
CheckPointTable(CPnr,1) = y
EndIf
ElseIf Directions(x,y,2) = True Then
Directions(x,y,2) = False
DirectionsCount(x,y) = DirectionsCount(x,y) - 1
If DirectionsCount(x,y+1) > 0 Then
Directions(x,y+1,0) = False
DirectionsCount(x,y+1) = DirectionsCount(x,y+1) - 1
y + 1
CPnr + 1
CheckPointTable(CPnr,0) = x
CheckPointTable(CPnr,1) = y
EndIf
ElseIf Directions(x,y,3) = True Then
Directions(x,y,3) = False
DirectionsCount(x,y) = DirectionsCount(x,y) - 1
If DirectionsCount(x-1,y) > 0 Then
Directions(x-1,y,1) = False
DirectionsCount(x-1,y) = DirectionsCount(x-1,y) - 1
x - 1
CPnr + 1
CheckPointTable(CPnr,0) = x
CheckPointTable(CPnr,1) = y
EndIf
Else
If CPnr > 0 Then CPnr - 1
x = CheckPointTable(CPnr,0)
y = CheckPointTable(CPnr,1)
EndIf
If x = goal_x And y = goal_y Then goal = True
Wend
SolvingTime = Timer()-SolvingTime
AddText "The maze was solved in "+SolvingTime+" milliseconds."
dotimage = MakeImage(5,5)
DrawToImage dotimage
Circle 0,0,5,1
DrawToScreen
// luodaan reittimerkit
For i = 0 To CPnr
x = CheckPointTable(i,0)
y = CheckPointTable(i,1)
wx = (x * 32 - 16) - ((MapWidth() * 32) / 2)
wy = ((y * 32 - 16) - ((MapHeight() * 32) / 2)) * -1
checkpoint.CHECKPOINTS = New(CHECKPOINTS)
checkpoint\obj = MakeObject()
PositionObject checkpoint\obj, wx,wy
PaintObject checkpoint\obj, -dotimage
Next i
// luodaan botti ja asetetaan se alkupisteeseen
bot = MakeObject()
PaintObject bot, -dotimage
PositionObject bot, (CheckPointTable(0,0) * 32 - 16) - ((MapWidth() * 32) / 2),((CheckPointTable(0,1) * 32 - 16) - ((MapHeight() * 32) / 2)) * -1
RotateObject bot, GetAngle(CheckPointTable(0,0),CheckPointTable(0,1),CheckPointTable(1,0),CheckPointTable(1,1))
GoThroughTimer = Timer()
Repeat
// minimap ratkaistusta reitistä
For i = 0 To CPnr
Box CheckPointTable(i,0)*4,CheckPointTable(i,1)*4+50,4,4
Next i
// reitin visuaalinen läpikäynti
MoveObject bot, 3
checkpoint.CHECKPOINTS = first(CHECKPOINTS)
If ObjectsOverlap(bot,checkpoint\obj) Then
checknr + 1
If checknr <= CPnr Then
checkpoint2.CHECKPOINTS = After(checkpoint)
RotateObject bot,GetAngle2(bot,checkpoint2\obj)
DeleteObject checkpoint\obj
Delete checkpoint
Else
DeleteObject checkpoint\obj
Delete checkpoint
DeleteObject bot
Text 0,15,"The maze was gone through in "+(Timer()-GoThroughTimer)/1000 + " seconds."
Text 0,30,"Press any key to quit."
Text ScreenWidth()-100,0,FPS()
DrawScreen
WaitKey
End
EndIf
EndIf
Text ScreenWidth()-100,0,FPS()
DrawScreen
Until EscapeKey()
Code: Select all
//==============================//
// ******* FASTMAZE 2.1 ******* //
// ******* by MURSKAAJA ******* //
//==============================//
SCREEN 1024,768
Type CHECKPOINTS
Field obj
EndType
map = MakeMap(20,20,32,32)
tileset = LoadImage("media\tileset.bmp")
PaintObject map,tileset
// lähtö- ja maalipisteet
start_x = 2
start_y = 2
goal_x = MapWidth()-1
goal_y = MapHeight()-1
//==============================//
// ******** PATHFINDER ******** //
//==============================//
// tekoälyn tarvitsemat taulukot
Dim Score(MapWidth(),MapHeight())
Dim StartDistance(MapWidth(),MapHeight())
Dim GoalDistance(MapWidth(),MapHeight())
Dim NextSquare(1000,2)
Global squares
Dim CheckPointTable(100,1000,1)
// Pathfinderiin annetaan 5 parametriä. 4 ensimmäistä lienevät selviöitä, eli lähtö- ja
// maalipisteiden koordinaatit kartalla. pathnr sen sijaan on käytettävän CheckPoint-taulukon
// järjestysnumero. Tämä siis mahdollistaa sen, että useita reittejä voi olla muistissa
// samaan aikaan.
Function PathFinder(start_x,start_y,goal_x,goal_y,pathnr)
// alustetaan taulukot
For x = 1 To MapWidth()
For y = 1 To MapHeight()
Score(x,y) = 0
StartDistance(x,y) = 0
GoalDistance(x,y) = 0
Next y
Next x
For i = 0 To 1000
NextSquare(i,0) = 0
NextSquare(i,1) = 0
NextSquare(i,2) = 0
Next i
squares = 0
// syötetään taulukoihin ja muistipaloihin aloituspisteen tiedot.
GoalDistance(start_x,start_y) = (Abs(goal_x-start_x)+Abs(goal_y-start_y))*10
StartDistance(start_x,start_y) = 1
Score(start_x,start_y) = GoalDistance(start_x,start_y)
AddSquare(Score(start_x,start_y),start_x,start_y)
x = start_x
y = start_y
// Looppia käydään läpi niin kauan, kunnes maali on saavutettu. Loopista
// rikkoudutaan ulos myös silloin, kun kaikki vapaat ruudut on käyty läpi.
goal = False
While goal = False
// Tarkistetaan pääseekö nykyisestä sijainnista eteenpäin
// Tarkistukset suoritetaan oikealle, vasemmalle, ylös ja alas.
// Jos tarkistetut ruudut ovat vapaita, eikä niihin ole jo tallennettu
// arvoja, lasketaan ja tallennetaan niihin seuraavat asiat:
// 1) Kuinka monta ruutua ollaan liikuttu aloituspisteestä.
// 2) Mikä on teoreettinen matka kyseisestä ruudusta maaliin.
// 3) Kahden edellisen yhteistulos. Tämä tieto tallennetaan taulukon
// lisäksi muistipaloihin.
//
If x+1 <= MapWidth() Then
If GetMap2(2,x+1,y) = 0 And StartDistance(x+1,y) = 0 Then
StartDistance(x+1,y) = StartDistance(x,y)+10
GoalDistance(x+1,y) = (Abs(goal_x-(x+1))+Abs(goal_y-y))*10
Score(x+1,y) = StartDistance(x+1,y) + GoalDistance(x+1,y)
AddSquare(Score(x+1,y),x+1,y)
EndIf
EndIf
If x-1 > 0 Then
If GetMap2(2,x-1,y) = 0 And StartDistance(x-1,y) = 0 Then
StartDistance(x-1,y) = StartDistance(x,y)+10
GoalDistance(x-1,y) = (Abs(goal_x-(x-1))+Abs(goal_y-y))*10
Score(x-1,y) = StartDistance(x-1,y) + GoalDistance(x-1,y)
AddSquare(Score(x-1,y),x-1,y)
EndIf
EndIf
If y+1 <= MapHeight() Then
If GetMap2(2,x,y+1) = 0 And StartDistance(x,y+1) = 0 Then
StartDistance(x,y+1) = StartDistance(x,y)+10
GoalDistance(x,y+1) = (Abs(goal_x-x)+Abs(goal_y-(y+1)))*10
Score(x,y+1) = StartDistance(x,y+1) + GoalDistance(x,y+1)
AddSquare(Score(x,y+1),x,y+1)
EndIf
EndIf
If y-1 > 0 Then
If GetMap2(2,x,y-1) = 0 And StartDistance(x,y-1) = 0 Then
StartDistance(x,y-1) = StartDistance(x,y)+10
GoalDistance(x,y-1) = (Abs(goal_x-x)+Abs(goal_y-(y-1)))*10
Score(x,y-1) = StartDistance(x,y-1) + GoalDistance(x,y-1)
AddSquare(Score(x,y-1),x,y-1)
EndIf
EndIf
// Jos vapaita ruutuja on jäljellä (eli muistipaloissa on vielä tietoa)
// tuhotaan nykyinen sijainti muistista, jotta sitä ei käytäisi läpi useampaan
// kertaan. Jos vapaita ruutuja ei ole enää jäljellä, funktio palauttaa nollan.
DelSquare(0)
If squares = 0 Then Return 0
// Haetaan uusi (parhaan pistearvon omaava) sijainti muistista
x = NextSquare(0,1)
y = NextSquare(0,2)
// tarkistetaan, voitaisiinko jo olla maalissa
If x = goal_x And y = goal_y Then goal = True
Wend
// Reitti on jo ratkottu, mutta vielä voi optimoida. Liikutaan tällä kertaa lopusta alkuun
// ja tallennetaan ne ruudut taulukkoon, joista on lyhin matka lähtöpisteeseen.
i = 0
CheckPointTable(pathnr,0,0) = x
CheckPointTable(pathnr,0,1) = y
start = False
While start = False
i+1
bestscore = 100000
best_x = 0
best_y = 0
If x+1 <= MapWidth()
If StartDistance(x+1,y) > 0 Then
If StartDistance(x+1,y) < bestscore Then
bestscore = StartDistance(x+1,y)
best_x = x+1
best_y = y
EndIf
EndIf
EndIf
If x-1 > 0
If StartDistance(x-1,y) > 0 Then
If StartDistance(x-1,y) < bestscore Then
bestscore = StartDistance(x-1,y)
best_x = x-1
best_y = y
EndIf
EndIf
EndIf
If y+1 <= MapHeight()
If StartDistance(x,y+1) > 0 Then
If StartDistance(x,y+1) < bestscore Then
bestscore = StartDistance(x,y+1)
best_x = x
best_y = y+1
EndIf
EndIf
EndIf
If y-1 > 0
If StartDistance(x,y-1) > 0 Then
If StartDistance(x,y-1) < bestscore Then
bestscore = StartDistance(x,y-1)
best_x = x
best_y = y-1
EndIf
EndIf
EndIf
x = best_x
y = best_y
CheckPointTable(pathnr,i,0) = x
CheckPointTable(pathnr,i,1) = y
// tarkistetaan, oltaisiinko jo aloituspisteessä
If x = start_x And y = start_y Then start = True
Wend
// Funktio palauttaa reittimerkkien määrän kun reitti on löydetty ja optimoitu.
Return i
EndFunction
// uuden ruudun lisääminen tarkistettavien ruutujen listaan
Function AddSquare(value,x,y)
For i = 0 To squares
If value < NextSquare(i,0) Then
For j = squares To i Step-1
NextSquare(j+1,0) = NextSquare(j,0)
NextSquare(j+1,1) = NextSquare(j,1)
NextSquare(j+1,2) = NextSquare(j,2)
Next j
NextSquare(i,0) = value
NextSquare(i,1) = x
NextSquare(i,2) = y
Exit
ElseIf i = squares Then
NextSquare(i,0) = value
NextSquare(i,1) = x
NextSquare(i,2) = y
EndIf
Next i
squares + 1
EndFunction
// jo tarkistetetun ruudun poistaminen tarkistettavien ruutujen listasta
Function DelSquare(nr)
For i = nr To squares-1
NextSquare(i,0) = NextSquare(i+1,0)
NextSquare(i,1) = NextSquare(i+1,1)
NextSquare(i,2) = NextSquare(i+1,2)
Next i
NextSquare(squares,0) = 0
NextSquare(squares,1) = 0
NextSquare(squares,2) = 0
squares - 1
EndFunction
// kartan alustus
Function ClearMap()
For x = 1 To MapWidth()
For y = 1 To MapHeight()
If x = start_x And y = start_y Then
EditMap map,0,x,y,4
ElseIf x = goal_x And y = goal_y
EditMap map,0,x,y,5
ElseIf x = 1 or x = MapWidth() Or y = 1 Or y = MapHeight() Then
EditMap map,0,x,y,77
EditMap map,2,x,y,1
Else
EditMap map,0,x,y,129
EditMap map,2,x,y,0
EndIf
Next y
Next x
EndFunction
//=============================//
// ******** PÄÄLOOPPI ******** //
//=============================//
// kartan alustus
ClearMap()
Repeat
tx = RoundUp(MouseWX()/32.0)+MapWidth()/2
ty = MapHeight()-(RoundDown(MouseWY()/32.0)+MapHeight()/2)
If tx > 0 And tx <= MapWidth() And ty > 0 And ty <=MapHeight() Then
For x = 1 To MapWidth()
For y = 1 To MapHeight()
If MouseDown(1) Then
EditMap map,0,tx,ty,77
EditMap map,2,tx,ty,1
ElseIf MouseDown(2) Then
EditMap map,0,tx,ty,129
EditMap map,2,tx,ty,0
EndIf
Next y
Next x
EndIf
If GetMap2(2,start_x,start_y) Or GetMap2(0,start_x,start_y) = 129 Then
EditMap map,0,start_x,start_y,4
EditMap map,2,start_x,start_y,0
EndIf
If GetMap2(2,goal_x,goal_y) Or GetMap2(0,goal_x,goal_y) = 129 Then
EditMap map,0,goal_x,goal_y,5
EditMap map,2,goal_x,goal_y,0
EndIf
DrawGame
Color 255,255,255
Text 0,0,"Left mouse button makes wall. Right mouse makes floor."
Text 0,15,"Press Space-key to clear the map."
Text 0,30,"Press Return-key to test the maze."
Text 0,60,"X: "+tx
Text 0,75,"Y: "+ty
Box MouseX()-16,MouseY()-16,32,32,0
// reitin piirtäminen
If drawboxes = True Then
Color 255,255,0
DrawToWorld ON
For i = 0 To CPnr
Circle CheckPointTable(0,i,0)*32-20-(MapWidth()*32)/2,(MapHeight()*32)/2-CheckPointTable(0,i,1)*32+20,8,1
Next i
DrawToWorld OFF
EndIf
// mikäli enteriä painetaan, alkaa reitin selvittäminen...
If KeyHit(cbkeyreturn) Then
Color 255,255,255
ClearText
SolvingTime = Timer()
CPnr = PathFinder(start_x,start_y,goal_x,goal_y,0)
SolvingTime = Timer() - SolvingTime
If CPnr > 0 Then
Locate 0, 45
AddText "The maze was solved in "+SolvingTime+" milliseconds."
drawboxes = True
Else
Locate 0, 45
AddText "The maze could not be solved."
drawboxes = False
EndIf
EndIf
// spacen painalluksesta alustetaan kartta
If KeyHit(cbkeyspace) Then
ClearMap()
drawboxes = False
EndIf
DrawScreen
Forever
EDIT: Lisäsin koodiin karttaeditorin, jotta sitä olisi mahdollisimman helppo testailla.
EDIT2: Nopeimman reitin löytävä versio lisätty.
EDIT3: Versio 2 muokattu uuteen uskoon.