Bubble sort
Bubble sort, po slovenský bublinkové triedenie, patrí medzi najmenej efektívne algoritmy na triedenie. Čiže jeho použiteľnosť v podnikových aplikáciach je silne otázne. I napriek tomu je to často prvý komplexnejší algoritmus, ktorý naučí začiatočných programátorov vnorené cykly a swapovaniu (vzájomnej výmeny). Preto si ukážeme algoritmus i my.
A najlepšie použitie triediaceho algoritmu mi pripadá v našej aplikácii LOTO, ktorá sa snaží aspoň trocha tváriť reálne a ako vidíte na stránke Tipos, skutočne sú tam vyžrebované čísla podľa poradia. Takže niečo podobné urobíme i my. Poďme najprv k princípu bubble sortu.
Majme 5 čísel:
5 10 2 48 7
A chceme ich utriediť bublinkovým triedením.
1. iterácia
5 10 2 48 7 // 5 nie je väčšie ako 10, nič sa neudeje
5 10 2 48 7 //10 je väčšie ako 2, preto dôjde k výmene
5 2 10 48 7 //10 nie je väčšie ako 48, nič sa neudeje
5 2 10 48 7 //48 je väčšie ako 7, preto dôjde k výmene
2. iterácia
5 2 10 7 48 //5 je väčšie ako 2, preto dôjde k výmene
2 5 10 7 48 //5 je menšie ako 10, nič sa neudeje
2 5 10 7 48 //10 je väčšie ako 7, preto dôjde k výmene
2 5 7 10 48 //10 je menšie ako 48, nič sa neudeje
3. iterácia doplnková iterácia, algoritmus by si mal byť istý, že je utriedené
2 5 7 10 48
2 5 7 10 48
2 5 7 10 48
2 5 7 10 48
Poďme si ukázať implementáciu bublinkového triedenia už zakomponovaného do hry LOTO. Okrem toho som optimalizoval kód hry LOTO a snáď sa vám zmeny budú páčiť.
1. program: Tipovacia hra LOTO s prídavkom bublinkového triedenia
Sub LOTO REM začiatok procedúry Dim tipPole(1 To 6) As Integer REM deklarácie premenných Dim lotoPole1(1 To 6) As Integer Dim lotoDodatkoveCislo1 As Integer Dim lotoPole2(1 To 6) As Integer Dim lotoDodatkoveCislo2 As Integer Dim vstup As String For i = 1 To 6 REM užívateľ zadal svoj tip vstup = InputBox("Zadajte váš " & i & " tip!") If IsNull(vstup) Then MsgBox "Nič si nezadal!" Exit Sub End If If Len(Trim(vstup)) = 0 Then MsgBox "Nič si nezadal!" Exit Sub End If If Int(Trim(vstup)) <= 0 OR Int(Trim(vstup)) >= 50 Then REM prvá zmena MsgBox "Zadal si mimo interval lotérie!" Exit Sub End If tipPole(i) = Int(vstup) For j = 1 To 6 REM druha zmena If tipPole(i) = tipPole(j) Then If i <> j Then MsgBox "Tipy majú byť rozdielné!" Exit Sub End If End If Next vstup = "" Next Dim boolPremenna As Boolean Dim pocitadlo As Integer For i = 1 To 6 REM tretia zmena lotoPole1(i) = Int((49-1+1)*Rnd+1) Do pocitadlo = 0 For j = 1 To 6 If lotoPole1(i) = lotoPole1(j) Then If i <> j Then lotoPole1(i) = Int((49-1+1)*Rnd+1) pocitadlo = pocitadlo + 1 Exit For End If End If Next Loop While pocitadlo = 1 Next For i = 1 To 6 lotoPole2(i) = Int((49-1+1)*Rnd+1) Do pocitadlo = 0 For j = 1 To 6 If lotoPole2(i) = lotoPole2(j) Then If i <> j Then lotoPole2(i) = Int((49-1+1)*Rnd+1) pocitadlo = pocitadlo + 1 Exit For End If End If Next Loop While pocitadlo = 1 Next boolPremenna = True Do pocitadlo = 0 lotoDodatkoveCislo1 = Int((49-1+1)*Rnd+1) REM prvy ťah dodatkového čísla For i = 1 To 6 REM testujeme či sú čísla rozdielne If lotoPole1(i) = lotoDodatkoveCislo1 Then pocitadlo = pocitadlo + 1 End If Next If pocitadlo = 0 Then boolPremenna = False End If Loop While boolPremenna = True boolPremenna = True Do pocitadlo = 0 lotoDodatkoveCislo2 = Int((49-1+1)*Rnd+1) REM druhý ťah dodatkového čísla For i = 1 To 6 REM testujeme či sú čísla rozdielne If lotoPole2(i) = lotoDodatkoveCislo2 Then pocitadlo = pocitadlo + 1 End If Next If pocitadlo = 0 Then boolPremenna = False End If Loop While boolPremenna = True Dim pocitadlo1 As Integer pocitadlo1 = 0 For i = 1 To 6 REM konečne sme sa dostali k vyhodnocovaniu For j = 1 To 6 If tipPole(i) = lotoPole1(j) Then pocitadlo1 = pocitadlo1 + 1 End If Next Next Dim pocitadlo2 As Integer pocitadlo2 = 0 For i = 1 To 6 For j = 1 To 6 If tipPole(i) = lotoPole2(j) Then pocitadlo2 = pocitadlo2 + 1 End If Next Next Dim pocitadloDod1 As Integer pocitadloDod1 = 0 For i = 1 To 6 If tipPole(i) = lotoDodatkoveCislo1 Then pocitadloDod1 = pocitadloDod1 + 1 End If Next Dim pocitadloDod2 As Integer pocitadloDod2 = 0 For i = 1 To 6 If tipPole(i) = lotoDodatkoveCislo2 Then pocitadloDod2 = pocitadloDod2 + 1 End If Next Dim retazec1 As String retazec1 = "p" If pocitadlo1 = 6 Then If pocitadloDod1 = 0 Then retazec1 = "500 000 €" End If End If If pocitadlo1 = 6 Then If pocitadloDod1 = 1 Then retazec1 = "500 000 €" End If End If If pocitadlo1 = 5 Then If pocitadloDod1 = 1 Then retazec1 = "10 000 €" End If End If If pocitadlo1 = 5 Then If pocitadloDod1 = 0 Then retazec1 = "2770,60 €" End If End If If pocitadlo1 = 4 Then If pocitadloDod1 = 0 Then retazec1 = "29,10 €" End If End If If pocitadlo1 = 4 Then If pocitadloDod1 = 1 Then retazec1 = "29,10 €" End If End If If pocitadlo1 = 3 Then If pocitadloDod1 = 1 Then retazec1 = "17,60 €" End If End If If pocitadlo1 = 2 Then If pocitadloDod1 = 1 Then retazec1 = "5,50 €" End If End If If pocitadlo1 = 3 Then If pocitadloDod1 = 0 Then retazec1 = "4,40 €" End If End If If pocitadlo1 = 2 Then If pocitadloDod1 = 0 Then retazec1 = "0 €" End If End If If pocitadlo1 = 1 Then If pocitadloDod1 = 1 Then retazec1 = "0 €" End If End If If pocitadlo1 = 1 Then If pocitadloDod1 = 0 Then retazec1 = "0 €" End If End If If pocitadlo1 = 0 Then If pocitadloDod1 = 1 Then retazec1 = "0 €" End If End If If pocitadlo1 = 0 Then If pocitadloDod1 = 0 Then retazec1 = "0 €" End If End If Dim retazec2 As String retazec2 = "k" If pocitadlo2 = 6 Then If pocitadloDod2 = 0 Then retazec2 = "500 000 €" End If End If If pocitadlo2 = 6 Then If pocitadloDod2 = 1 Then retazec2 = "500 000 €" End If End If If pocitadlo2 = 5 Then If pocitadloDod2 = 1 Then retazec2 = "5 000 €" End If End If If pocitadlo2 = 5 Then If pocitadloDod2 = 0 Then retazec2 = "250 €" End If End If If pocitadlo2 = 4 Then If pocitadloDod2 = 0 Then retazec2 = "25 €" End If End If If pocitadlo2 = 4 Then If pocitadloDod2 = 1 Then retazec2 = "25 €" End If End If If pocitadlo2 = 3 Then If pocitadloDod2 = 1 Then retazec2 = "10 €" End If End If If pocitadlo2 = 2 Then If pocitadloDod2 = 1 Then retazec2 = "5 €" End If End If If pocitadlo2 = 3 Then If pocitadloDod2 = 0 Then retazec2 = "3 €" End If End If If pocitadlo2 = 2 Then If pocitadloDod2 = 0 Then retazec2 = "0 €" End If End If If pocitadlo2 = 1 Then If pocitadloDod2 = 1 Then retazec2 = "0 €" End If End If If pocitadlo2 = 1 Then If pocitadloDod2 = 0 Then retazec2 = "0 €" End If End If If pocitadlo2 = 0 Then If pocitadloDod2 = 1 Then retazec2 = "0 €" End If End If If pocitadlo2 = 0 Then If pocitadloDod2 = 0 Then retazec2 = "0 €" End If End If Dim vytriedenePole1(1 To 6) As Integer Dim vytriedenePole2(1 To 6) As Integer Dim pomocnaPremenna As Integer For i = 1 To 6 vytriedenePole1(i) = lotoPole1(i) Next For i = 1 To 6 vytriedenePole2(i) = lotoPole2(i) Next For i = 1 To 5 REM štvrtá zmena je bubble sort For j = 1 To 5 If vytriedenePole1(j) > vytriedenePole1(j+1) Then pomocnaPremenna = 0 pomocnaPremenna = vytriedenePole1(j+1) vytriedenePole1(j+1) = vytriedenePole1(j) vytriedenePole1(j) = pomocnaPremenna End If Next Next For i = 1 To 5 REM bubble sort For j = 1 To 5 If vytriedenePole2(j) > vytriedenePole2(j+1) Then pomocnaPremenna = 0 pomocnaPremenna = vytriedenePole2(j+1) vytriedenePole2(j+1) = vytriedenePole2(j) vytriedenePole2(j) = pomocnaPremenna End If Next Next REM a nakoniec vyvrcholenie programu MsgBox "Deň žrebovania: 27.08.2017" & Chr(10) & "Váš tip: " & tipPole(1) & " " & tipPole(2) & " " & tipPole(3) & " " & tipPole(4) & " " & tipPole(5) & " " & tipPole(6) & " " & Chr(10) & "1. ťah: " & lotoPole1(1) & " " & lotoPole1(2) & " " & lotoPole1(3) & " " & lotoPole1(4) & " " & lotoPole1(5) & " " & lotoPole1(6) & Chr(10) & "Podľa poradia: " & vytriedenePole1(1) & " " & vytriedenePole1(2) & " " & vytriedenePole1(3) & " " & vytriedenePole1(4) & " " & vytriedenePole1(5) & " " & vytriedenePole1(6) & " " & Chr(10) & "A dodatkové číslo k 1. ťahu: " & lotoDodatkoveCislo1 & Chr(10) & "2. ťah: " & lotoPole2(1) & " " & lotoPole2(2) & " " & lotoPole2(3) & " " & lotoPole2(4) & " " & lotoPole2(5) & " " & lotoPole2(6) & Chr(10) & "Podľa poradia: " & vytriedenePole2(1) & " " & vytriedenePole2(2) & " " & vytriedenePole2(3) & " " & vytriedenePole2(4) & " " & vytriedenePole2(5) & " " & vytriedenePole2(6) & Chr(10) & "A dodatkové číslo k 2. ťahu: " & lotoDodatkoveCislo2 & Chr(10) & Chr(10) & "V 1. ťahu ste uhadli " & pocitadlo1 & " čísla a " & pocitadloDod1 & " dodatkových čísel a vyhrávate " & retazec1 & "!" & Chr(10) & "V 2. ťahu ste uhadli " & pocitadlo2 & " čísla a " & pocitadloDod2 & " dodatkových čísel a vyhrávate " & retazec2 & "!" End Sub REM koniec procedúry
Výsledok aj s vyžrebovanými číslami podľa poradia
Rozbor makra:
Zmeny v programe oproti minulej implementácie hry LOTO sú niekoľko. Rozpíšeme si ich v bodoch.
1. zmena: optimalizácia vstupu s pomocou pridania logického súčtu OR
2. zmena: ak zadá užívateľ vstup mimo definovaný interval, tak skončí makro hneď a nie až po skončení zadávania intervalu šiestich čísel
3. zmena: vylepšený algoritmus produkcie náhodných čísel pre hru LOTO. Algoritmus už nemusí generovať 6 nových čísel pri objavení chyby, ale vygeneruje len jedno číslo práve tam, kde nastala chyba (rozumejte, že sa vyskytlo rovnaké číslo aké už bolo vyžrebované).
4. zmena: pridané bublinkové triedenie
Okrem bublinkového triedenia existuje nespočetne veľa triediacich algoritmov. Môžeme sa im venovať, ale až v záverečnej etape seriálu. Zatiaľ máme za sebou začiatky a ešte nás čaká jedno alebo dve články k začiatočnej fázy seriálu a potom naskočíme k náročnejším veciam.