Binäärikeko CoolBasicille

Oletko tehnyt jotain, mistä muut voisivat hyötyä. Postita vinkit tänne.
Post Reply
Sami345
Advanced Member
Posts: 349
Joined: Fri Aug 31, 2007 4:52 pm
Contact:

Binäärikeko CoolBasicille

Post by Sami345 »

En ole nähnyt ainuttakaan keon toteutusta CoolBasicilla, joten päätin tehdä sellaisen. Keko on tehokas tapa pitää prioriteettijonoa, sillä sen ensimmäisen alkion haku on hyvin nopeaa. Esimerkin kaltaisessa pienessä tilanteessa optimointi on kyllä melko triviaalia, mutta suurilla määrille tietoa keko suoriutuu hyvin. Lisää keoista voitte lukea täältä: http://en.wikipedia.org/wiki/Binary_heap

Esimerkki & kirjasto:

Code: Select all

Type Potilas
    Field nimi As String
    Field tauti As String
EndType

rekisteri = makeHeap()

alku:
    koko = heapSize(rekisteri)
    AddText "Potilaita rekisterissä: " + koko
    AddText ""
    AddText "1. Lisää potilas"
    If koko > 0 Then AddText "2. Hae kiireellisin potilas"
    
    Repeat
        If KeyHit(cbKey1) Or KeyHit(79) Then
            ClearText
            ClearKeys
            Goto syota
        EndIf
        
        If koko > 0 And (KeyHit(cbKey2) Or KeyHit(80)) Then
            ClearText
            ClearKeys
            Goto hae
        EndIf
        
        DrawScreen
    Forever

syota:
    Repeat
        nimi$ = Input("Syötä nimi: ")
        DrawScreen
    Until KeyHit(cbKeyReturn)
    CloseInput
    AddText "Syötä nimi: " + nimi
    
    Repeat
        tauti$ = Input("Syötä tauti: ")
        DrawScreen
    Until KeyHit(cbKeyReturn)
    CloseInput
    AddText "Syötä tauti: " + tauti
    
    Repeat
        kiire = Input("Syötä kiireellisyys (kokonaisluku): ")
        DrawScreen
    Until KeyHit(cbKeyReturn)
    CloseInput
    AddText "Syötä kiireellisyys (kokonaisluku): " + kiire
    
    pot.Potilas = New(Potilas)
    pot\nimi  = nimi
    pot\tauti = tauti
    
    heapAdd(rekisteri, kiire, ConvertToInteger(pot))
    
    AddText "Potilas lisätty! Paina enter poistuaksesi..."
    Repeat
        DrawScreen
    Until KeyHit(cbKeyReturn)
    
    ClearText
Goto alku

hae:
    kiire = heapGetFirstKey(rekisteri)
    pot.Potilas = ConvertToType(heapGetFirst(rekisteri))
    heapPopFirst(rekisteri)
    
    AddText "Potilas "        + pot\nimi
    AddText "Tauti: "         + pot\tauti
    AddText "Kiireellisyys: " + kiire
    
    Repeat
        DrawScreen
    Until KeyHit(cbKeyReturn)
    
    ClearText
Goto alku



//////////////
// Kirjasto //
//////////////

Function makeHeap(reserved = 0)
    // Luodaan muistapala keolle
    heap = MakeMEMBlock(reserved * 8 + 8)
    
    PokeInt heap, 0, reserved // Varattu koko
    PokeInt heap, 0, 0 // Keon oikea koko
    
    Return heap
EndFunction

Function heapAdd(heap, key, value)
    reserved = PeekInt(heap, 0)
    size     = PeekInt(heap, 4)
    
    // Jos keossa ei ole vapaata tilaa
    If reserved <= size Then
        // Tuplataan varattu tila
        reserved = reserved * 2

        If reserved = 0 Then reserved = 1
        
        ResizeMEMBlock heap, reserved * 8 + 8
        PokeInt heap, 0, reserved
    EndIf
    
    // Kokoa on kasvatettu yhdellä
    size = size + 1
    PokeInt heap, 4, size
    
    // Asetetaan viimeiselle paikalle
    PokeInt heap, 8 * size,     key
    PokeInt heap, 8 * size + 4, value
    
    // Nostetaan keossa ylöspäin paikalleen
    heapShiftUp(heap, size)
EndFunction

Function heapGetFirst(heap)
    If PeekInt(heap, 4) = 0 Then MakeError "Et voi ottaa tyhjästä keosta!"

    Return PeekInt(heap, 12)
EndFunction

Function heapGetFirstKey(heap)
    If PeekInt(heap, 4) = 0 Then MakeError "Et voi ottaa tyhjästä keosta!"

    Return PeekInt(heap, 8)
EndFunction

Function heapPopFirst(heap)
    size = PeekInt(heap, 4)
    
    If size = 0 Then MakeError "Et voi poistaa tyhjästä keosta!"

    PokeInt heap, 4, size - 1
    // Vaihdetaan viimeinen poistetun tilalle ja järjestetään keko
    heapSwap(heap, 1, size)
    heapHeapify(heap, 1)
EndFunction

Function heapSize(heap)
    Return PeekInt(heap, 4)
EndFunction

// Under the hood (jos koodin sisäinen toiminta ei kiinnosta, älä katso tänne)

// HEAP Muistipalan rakenne
// 0    Keon varattu koko n
// 4    Keon käytetty koko
// 8    Indeksi 1
// 12   Arvo 1
// 16   Indeksi 2
// 24   Arvo 2
// ...  ...
// 8n   Indeksi n
// 8n+4 Arvo n
// KOKO 8n + 8

Function heapHeapify(heap, i)
    size = PeekInt(heap, 4)
    l = i * 2
    r = i * 2 + 1
    j = i
    
    If l <= size Then
        If PeekInt(heap, l * 8) < PeekInt(heap, i * 8) Then
            j = l
        EndIf
    EndIf
    
    If r <= size Then
        If PeekInt(heap, r * 8) < PeekInt(heap, j * 8) Then
            j = r
        EndIf
    EndIf
    
    If Not i = j Then
        heapSwap(heap, i, j)
        heapHeapify(heap, j)
    EndIf
EndFunction

Function heapShiftUp(heap, i)
    l = i / 2

    If l > 0 Then
        If PeekInt(heap, l * 8) > PeekInt(heap, i * 8) Then
            heapSwap(heap, i, l)
            heapShiftUp(heap, l)
        EndIf
    EndIf
EndFunction

Function heapSwap(heap, i, l)
    // Otetaan talteen i
    tempKey   = PeekInt(heap, i * 8)
    tempValue = PeekInt(heap, i * 8 + 4)
    
    // Tallennetaan i tilalle l
    PokeInt heap, i * 8,     PeekInt(heap, l * 8)
    PokeInt heap, i * 8 + 4, PeekInt(heap, l * 8 + 4)
    
    // Tallennetaan l tilalle i
    PokeInt heap, l * 8,     tempKey
    PokeInt heap, l * 8 + 4, tempValue
EndFunction
Projektit: Fiperus - Jäädytetty pidemmäksi aikaa.
Voitot: Viikkokisa XIII, Pikapelikisa 3, Pikapelikisa 13
http://www.sami345.tk/
Post Reply