Tekoäly labyrinttiin

[Murskaaja]

Teinpä tässä yksinkertaisen tekoälyn, joka ratkoo reitin paikasta A paikkaan B. En muista mistä idea päähäni putkahti, mutta nyt pari tuntia myöhemmin olen kohtalaisen tyytyväinen työni tulokseen. Koodi ei ole mitenkään ihmeellinen, mutta tekoälyn pitäisi olla täysin toimiva (kunhan sokkelolle on ratkaisu ;D). Tekoälyn toiminnassa on kolme erillistä vaihetta: Ensin käydään kartta läpi ja selvitetään kuinka moneen ruutuun (=tileen) kustakin vapaasta (ei törmäysalueen) ruudusta voi liikkua. Toisessa vaiheessa ratkotaan saatujen tietojen perusteella reitti. Lopuksi sitten heitetään reittimerkit ratkaistulle reitille ja käydään se visuaalisesti läpi. Toivottavasti tästä on jollekin hyötyä, vaikkapa aloittelijalle opetusmielessä.

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()

Versio 2:

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.

[Jonez]

Vaikuttaa ihan pätevältä, jos halutaankin todella vain löytää joku reitti.

Vanhoilla foorumeilla taisi olla Zeron vastaavanlainen esimerkki, A* (astar) pathfinder, joka löysi tilemapissa _lyhimmän_ reitin pisteestä a pisteeseen b. Tän lyhimmän reitin etsiminenhän on erittäin hyödyllistä jos koodaa jotain strategiapelin tyyppistä peliä, jossa hiirellä ohjataan ukkeleita kartalla.

Se Zeron esimerkki taitaa olla kadonnut bittiavaruuteen, en ainakaan pikaisella haulla löytänyt. Mutta ehkä sä voisit tehdä vastaavanlaisen?

Googlesta voi ettiä tietoja että miten se A*-pathfinder oikeastaan toimii.

[Murskaaja]

Voi ollakin, että parin viikon sisällä minulta tulee kehittyneempi versio, joka ratkoo kaikki mahdolliset reitit kahden pisteen välillä ja kertoo niistä esim. kolme nopeinta reittiä (ellei joku ehdi ensin). Toteutustapoja ainakin pyörii mielessä jo useita. Pitää vaan löytää tarpeeksi aikaa ja intoa niiden toteuttamiseen Jos ei onnistu, sitten viimesenä vaihtoehtona tuo googlettaminen

[elmo123]

Aijaijai,hyvää koodia muuten, mutta kyllä tuo pikkasen bugaa:

[-Z-]

Nyt kävi näin. Hiukanhan tuo reitinhaku kusee vielä.

[Murskaaja]

Juu. No, tuohan oli tiedossa ja jopa oletettavaa, sillä tekoälyn logiikka ei tosiaan ole kummoinen. Se siis vain tarkistaa onko vapaita suuntia. Jos on, osoitin liikkuu ensimmäiseen havaitsemaansa vapaaseen suuntaan (järjestyksessä ylös,oikealla,alas,vasemmalle). Jos ei, liikutaan taaksepäin. Mutta, mutta... en minä sitä turhaan yksinkertaiseksi kutsunutkaan Tuon avoimissa tiloissa siksakkaamisen takia tekoäly soveltuu juurikin ahtaiden labyrinttien/sokkeloiden ratkomiseen, eikä esim. strategiapelien kulkureittien selvittämiseen.

[Harakka]

Haa. Arvatkaas kenellä on Zeron esimerkki edelleen tallessa.

[Guest]

Ikävän vähän selityksiä tuossa zeron systeemissä

[Murskaaja]

Hienoa, että löytyi tuo Zeronkin versio!

Sainpa juuri myös uuden oman versioni valmiiksi. Hiukan vähemmän aikaa meni kuin se ounastelemani pari viikkoa. Tämä uusi versio löytää nyt nopeimman reitin kahden pisteen välillä ja reittejä on mahdollista tallentaa muistiin useita.

Yritin pitää koodin mahdollisimman yksinkertaisena, jonka takia nopeus kärsi hiukan. Onneksi se ei kuitenkaan pahemmin ala tuntumaan kuin vasta isoilla aavoilla kartoilla. Uusi versio eroaa edellisestä käytännössä siten, että nyt ruutuja edetään niille annetuiden pisteiden mukaan, eikä pelkästään liikuta ensimmäiseen vapaaseen ruutuun. Koodillisesti uutena asiana edelliseen versioon tulee muistipalojen käyttö. Vaikka muistipalat voivat kuullostaa pelottavilta (minulle se oli iso mörkö), toivon että tästä on aloittelijoillekin hyötyä. Itselle tämä projekti oli ainakin varsin hyödyllinen. Tuli juuri tuota muistipalojen käyttöä opeteltua tätä tehdessä Koodia olen taas kommentoinut jotenkuten pääpiirteittäin.

Uuden versioni löytää ensimmäisestä viestistä.

[Jonez]

Näyttäähän se toimivan, tosin mavitti melkein aina ihan lopussa. Lisäks ohjelmassa oli sellainen ärsyttävä piirre, että se sammu kun oli testannut. Piti siis aina tehdä koko labyrintti alusta, joten en jaksanut testailla mahdollisten bugien / optimointivirheiden varalta enempää.

[Murskaaja]

Noniin. Kiitokset Jonezille kritiikistä Muutinpa tuota jälkimmäistä versiotani hieman käyttäjä-ystävällisemmäksi. Ohjelman lopettamisen yhteydessä tulleiden MAVien takia myös itse reitinselvittäjää on muokattu (itse en MAVeja huomannut kuin vasta toisella koneellani testattua Jonezin kommenttien jälkeen. Kannettavallani homma pelasi täysin ongelmitta o_O). Nyt kuitenkin systeemi on muutettu taulukolla toimivaksi ja ohjelma tuntuisi pelittävän.

[Drath]

Vanhoilta foorumeilta löytyy Astigman tekemä labyrintinratkaisukisa. http://www.coolbasic.com/oldforums/inde ... =1900&st=0 Harmillisesti se voittajan tekemä esimerkki(eli minun ) ei ole saatavissa koska liitetiedostot eivät enää toimi siellä.

[Astigma]

Itsellänihän tuo Drathin tekemä koodi on tallessa. Kyseessä oli siis pienimuotoinen tekoälykilpailu, jossa piti selvitä ulos labyrintistä mahdollisimman nopeasti. Kilpailija sai koodata oman reitinetsintäalgoritmin ja suorittaa ohjauslogiikan sen algoritmin pohjalta. Muut osat koodista olivat ennaltamäärättyjä. Koodi löytyy alta ja liitetiedostosta löytyvät koodin tarvitsemat tilemap- ja tileset-tiedostot.

Code: Select all

// ASETETAAN NÄYTTÖTILA
SCREEN 640 , 480 , 16

// ASETETAAN FRAMELIMIT
FrameLimit 30

// LADATAAN TILEMAP
tilemap = LoadMap( "tilemap.til" , "tileset.png" )

// LUODAAN OBJEKTI
IMGobjekti = MakeImage( 5 , 5 )

DrawToImage IMGobjekti
    
    Color 255 , 0 , 0
    Box 0 , 0 , 5 , 5

DrawToScreen
Color 255 , 255 , 255

objekti = MakeObject()
PaintObject objekti , -IMGobjekti
'ObjectRange objekti , 5 , 5

// ASETETAAN OBJEKTI ALKUPISTEESEEN
PositionObject objekti , -(ObjectSizeX( tilemap ) / 2) + 24 , ( ObjectSizeY( tilemap ) / 2 ) - 24



// ASETETAAN MAKSIMINOPEUS
Const MAXnopeus = 3

// ********************************
// TÄSTÄ ALKAA OMIEN MUUTTUJIEN MÄÄRITTELY JOS TARVETTA
// ********************************
suunta = 0

Dim taulukko(MapWidth(), MapHeight()) 
For y = 0 To MapHeight()
    For x = 0 To MapWidth()
        If GetMap2(2, x, y) = 1 Then
            taulukko(x,y) = -10
            
        EndIf
        If GetMap2(2,x,y) = 0 Then
            If x = 0 Then taulukko(x,y) = -1
            If x = MapWidth() Then taulukko(x,y) = -2
            If y = 0 Then taulukko(x,y) = -3
            If y = MapHeight() Then taulukko(x,y) = -4 
        EndIf
    Next x
Next y
For i = 0 To 99 
For y = 0 To MapHeight()
    For x = 0 To MapWidth()
        If taulukko(x,y) = 0 Then
            If taulukko(x+1,y) > 0 Then
                taulukko(x,y) = taulukko(x+1,y)+1
            EndIf
            If taulukko(x-1,y) > 0 Then
                taulukko(x,y) = taulukko(x-1,y)+1
            EndIf
            If taulukko(x,y+1) > 0 Then
                taulukko(x,y) = taulukko(x,y+1)+1
            EndIf
            If taulukko(x,y-1) > 0 Then
                taulukko(x,y) = taulukko(x,y-1)+1
            EndIf
            If taulukko(x-1,y) = -1 Then
                taulukko(x,y) = 1
            EndIf
            If taulukko(x+1,y) = -2 Then
                taulukko(x,y) = 1
            EndIf
            If taulukko(x,y-1) = -3 Then
                taulukko(x,y) = 1
            EndIf
            If taulukko(x,y+1) = -4 Then
                taulukko(x,y) = 1
            EndIf
            
        EndIf
    
    Next x
Next y
Next i
ox = 2
oy = 2
OBJnopeus = 3
RotateObject objekti, 270



// ********************************
// TÄHÄN PÄÄTTYY OMIEN MUUTTUJIEN MÄÄRITTELY
// ********************************

// ASETETAAN TÖRMÄYKSENTUNNISTUS KARTAN JA OBJEKTIN VÄLILLE
SetupCollision objekti , tilemap , 2 , 4 , 2

// ASETTAAN KELLO
a# = TIMER()

// PÄÄSILMUKKA
Repeat
    
    
    // ********************************
    // OMAN KOODIN TILA ALKAA TÄSTÄ
    // ********************************
    
    'lasketaan missä kohdin objekti on
    ox = Int((ObjectX(objekti)+MapWidth()/2*16)/16)
    oy = Int(-(ObjectY(objekti)-MapHeight()/2*16)/16)
    If Sqrt(Abs (ox - (ObjectX(objekti)+MapWidth()/2*16+10)/16)^2 + Abs(oy +(ObjectY(objekti)-MapHeight()/2*16-10)/16)^2) < 0.5 Then uusisuunta = 1
    
    'nyt pitäis jo liikuttaa sitä
    
    If uusisuunta = 1
        pluku = taulukko(ox,oy)
        If pluku > taulukko(ox-1, oy)  And taulukko(ox-1, oy) <> -10 Then
            pluku = taulukko(ox-1, oy)
            suunta = 1
        ElseIf pluku > taulukko(ox+1, oy) And taulukko(ox+1, oy) <> -10 Then
            pluku = taulukko(ox+1,oy)
            suunta = 2
        ElseIf pluku > taulukko(ox, oy-1) And taulukko(ox, oy-1) <> -10 Then
            pluku = taulukko(ox,oy-1)
            suunta = 3
        ElseIf pluku > taulukko(ox,oy+1) And taulukko(ox,oy+1) <> -10 Then
            pluku = taulukko(ox, oy+1)
            suunta = 4
        EndIf   
        uusisuunta = 0
    EndIf
    
    If suunta = 1 Then
        RotateObject objekti, 180
    ElseIf suunta = 2 Then
        RotateObject objekti, 0
    ElseIf suunta = 3 Then
        RotateObject objekti, 90
    ElseIf suunta = 4 Then 
        RotateObject objekti, 270
    EndIf
    
    
    

    // ********************************
    // OMAN KOODIN TILA LOPPUU TÄHÄN
    // ********************************
    
    // VARMISTETAAN ETTEI OBJEKTIA LIIKUTETA YLINOPEUTTA
    If OBJnopeus > MAXnopeus Then OBJnopeus = MAXnopeus
    If OBJnopeus < -MAXnopeus Then OBJnopeus = -MAXnopeus
    
    // TARKISTETAAN ONKO OBJEKTI MAALISSA
    If ObjectY( objekti ) < -( ObjectSizeY( tilemap ) / 2 ) Then
        
        // TALLENNETAAN ENNÄTYS
        t = OpenToWrite("ennatys.txt")
        WriteLine t , "Ennätys: " + ( ( TIMER() - a# ) / 1000 ) + " sekuntia."
        CloseFile t
                
        // KERROTAAN ENNÄTYS KÄYTTÄJÄLLE JA LOPETETAAN OHJELMA SAMALLA        
        MakeError "Lopullinen aika on " + ( ( TIMER() - a# ) / 1000 ) + " sekuntia. Ennätys tallennettiin ennatys.txt-tiedostoon."
        
    EndIf
    
    // LIIKUTETAAN OBJEKTIA
    MoveObject objekti , OBJnopeus

    // TULOSTETAAN KULUNUT AIKA
    Text 10 , 10 , "Aikaa kulunut: " + Left( Str( ( ( TIMER() - a# ) / 1000 ) ) , 5 ) + " sekuntia"
    Text 10 , 20 , "Objektin nopeus: " + OBJnopeus
    
    // PÄIVITETÄÄN NÄYTTÖ
    DrawScreen

Forever

// ********************************
// TÄNNE SAA LUODA OMIA FUNKTIOITA, JOS ON TARVETTA
// ********************************