Komentáře Programovanie makier v LibreOffice: Bubble sort (bublinkové triedenie)

user avatar neutr
Odpovědět
Programovanie makier v LibreOffice: Bubble sort (bublinkové triedenie)
27. 09. 2017, 19:05:53
Tenhle příspěvek se mi už moc nelíbí přestože je z pohledu pochopení postupů správně. 350 řádků je moc. Mimo toho sice řeší chybu při zápisu duplicity, ale řeší to tak že proces ukončí.

Vlastní volba čísel (tip) musí být zabezpečena z uživatelského hlediska lépe. Věřím, že tyto nedostatky autor zná a chtěl s nimi něco udělat - možná postupně v rámci seriálu. Ve skutečnosti by na to mělo stačit maximálně 100 řádků kódu. Uvádím ukázku která řeší dvěma různými způsoby zadávání tipů. je to jednak zřízení návratových cyklů při chybě tak aby se dalo opravit volbu a pokračovat. Dále zápis dříve vybraných do záhlaví. Tam si zadávající může prohlednout co tam už má a chybě se vyhnout - a pak by systém podle článku postačoval.

I v následujícím kódu je dost zbytečných řádků a není tam generátor náhorných čísel - ale i na dva tahy je to jen o něco více nežli na vlastní BubleSort


Sub Main
Dim tipPole(1 To 6)
Dim SortPole(1 To 6)
Dim sVar, sVal, sInfo as string
Dim vstup, rep, A, B, swap As integer
For i = 1 To 6
HopStart:
vstup = Val(InputBox("Zadajte váš " & i & " tip!", "Dosud vybráno : " & sInfo))
Select Case vstup
Case < 1 'Test pro storno, respektive 0, nebo záporná čísla
rep = MsgBox(" Chyba nebylo zadáno žádné číslo. Postup opakujte," & _
" nebo zadávání ukončete." + Chr(13) + Chr (13) & _
"ANO - nová volba" + Chr(13) & _
"NE - ukončit volbu.",4,"CHYBA ZADÁNÍ")
IF rep = 7 Then
Exit Sub
Else
GoTo HopStart 'skok pro opakování volby
End If
Case > 49 'Test na čísla větší nežli 49
rep = MsgBox(" Chyba bylo zadáno číslo mimo hrací pole. Postup opakujte," & _
" nebo zadávání ukončete." + Chr(13) + Chr (13) & _
"ANO - nová volba" + Chr(13) & _
"NE - ukončit volbu.",4,"CHYBA ZADÁNÍ")
IF rep = 7 Then
Exit Sub
Else
GoTo HopStart 'skok pro opakování volby
End If
Case Else 'Test na duplicitní zadání
IF i > 1 Then
For j = i-1 To 1 Step - 1
IF vstup = tipPole(j) Then
rep = MsgBox(" Chyba bylo zadáno již dříve vybrané číslo. Postup opakujte," & _
" nebo zadávání ukončete." + Chr(13) + Chr (13) & _
"ANO - nová volba" + Chr(13) & _
"NE - ukončit volbu.",4,"CHYBA ZADÁNÍ")
IF rep = 7 Then
Exit Sub
Else
GoTo HopStart 'skok pro opakování volby
End If
End If
next j
End If
tipPole(i) = vstup 'Vlastní uložení tipovaného čísla
sInfo = sInfo & vstup & " + "
End Select
Next i

For i = 1 To 6
SortPole(i) = tipPole(i) 'děláme pracovní kopii pole pro třídění
sVar = svar & tipPole(i) & ", " 'text hlášení ZVOLENÁ ČÍSLA
next i
'------------------------Buble sort - plný cyklus bez kontroly konce
For i = 6 To 2 Step - 1
For j = 1 To i-1
A = SortPole(j)
B = SortPole(j+1)
IF A > B Then
swap = B
B = A
A = swap
SortPole(j) = A
SortPole(j+1) = B
End If
next j
Next i

For i = 1 To 6 'text hlášení PŘETŘÍDĚNÁ ČÍSLA
sVal = sVal & SortPole(i) & ", "
Next i

MsgBox("Váš tip 6 čísel bez přetřídění" + Chr(13) & _
" " & svar + Chr(13) + Chr(13) & _
"Váš tip 6 čísel po přetřídění" + Chr(13) & _
" " & sval ,64, "ZVOLENÁ ČÍSLA")
End Sub
user avatar lp.
Odpovědět
Programovanie makier v LibreOffice: Bubble sort (bublinkové triedenie)
28. 09. 2017, 01:06:30
Musím se připojit k neutr. Ukázka s použitím procedur. I tak je řádků dost.

Sub LOTO2 REM začiatok procedúry
Dim tipPole(1 To 6) As Integer REM deklarácie premenných
Dim lotoPole1(1 To 7) As Integer ' Posledni cislo je dodatkova
Dim lotoDodatkoveCislo1 As Integer
Dim lotoPole2(1 To 7) As Integer ' Posledni cislo je dodatkova
Dim lotoDodatkoveCislo2 As Integer
Dim vstup
Dim bVsazeno As Boolean

For i = 1 To 6 REM užívateľ zadal svoj tip
Do
bVsazeno = False
vstup = InputBox("Zadajte váš " & i & " tip!")
If IsNull(vstup) or (Len(Trim(vstup)) = 0) Then
MsgBox "Nič si nezadal!"
Exit Sub ' OK nějak ukončíme
End If

tipPole(i) = Int(vstup)

If tipPole(i) < 1 OR tipPole(i) > 50 Then
MsgBox "Zadal si mimo interval lotérie!"
elseif not PosledniJeUnikatni(tipPole, 1, i) Then
MsgBox "Tipy majú byť rozdielné!"
else
bVsazeno = true
end if
vstup = ""
Loop Until bVsazeno
Next


Tah(lotoPole1, 1, 50) ' Prvni tah
Tah(lotoPole2, 1, 50) ' Druhy tah

' Rozebereme tazena cisla
lotoDodatkoveCislo1 = lotoPole1(7)
lotoDodatkoveCislo2 = lotoPole2(7)


' Odebereme z tahu dodatkové číslo
ReDim Preserve lotoPole1(1 to 6)
ReDim Preserve lotoPole2(1 to 6)

' Setřídíme cisla
BubbleSort(tipPole)
BubbleSort(lotoPole1)
BubbleSort(lotoPole2)


' Vyhodnocení
' 1. tah
Dim Vyhry(0 to 6)
Dim VyhryDod(0 to 6)
Dim retazec1 as string
Dim retazec2 as string

' Vyhry v prvnim tahu
VyhryDod = Array(500000, 10000, 29.10, 17.60, 5.5, 0, 0 )
Vyhry = Array(500000, 2770.60, 29.10, 4.4, 0, 0, 0 )

retazec1 = VyhoceniTahu(1, tipPole, lotoPole1, lotoDodatkoveCislo1, VyhryDod, Vyhry)

' 2. tah
' Vyhry ve druhem tahu
VyhryDod = Array(500000, 5000, 25, 10, 5, 0, 0 )
Vyhry = Array(500000, 250, 25, 3, 0, 0, 0 )

retazec2 = VyhoceniTahu(2, tipPole, lotoPole2, lotoDodatkoveCislo2, VyhryDod, Vyhry)

REM a nakoniec vyvrcholenie programu

MsgBox "Deň žrebovania: 27.08.2017" & Chr(10) & _
"Váš tip: " & Join(tipPole, " ") & " " & Chr(10) & _
"1. ťah: " & Join(lotoPole1, " ") & Chr(10) & _
"A dodatkové číslo k 1. ťahu: " & lotoDodatkoveCislo1 & Chr(10) & _
"2. ťah: " & Join(lotoPole2, " ") & Chr(10) & _
"A dodatkové číslo k 2. ťahu: " & lotoDodatkoveCislo2 & Chr(10) & Chr(10) & _
retazec1 & Chr(10) & _
retazec2

End Sub REM koniec procedúry


' Procedura naplní Cisla unikátními čísly od Prvni do Posledni
Sub Tah(ByRef Cisla, prvni as integer, posledni as integer)
' Prvni nemusime testovat
Cisla(1) = VybratCislo(prvni,posledni)
For i = lbound(Cisla,1) + 1 To ubound(Cisla,1)
Do
Cisla(i) = VybratCislo(prvni,posledni)
Loop Until PosledniJeUnikatni(Cisla, 1, i)
Next
end sub


function VybratCislo(prvni as integer, posledni as integer) as integer
VybratCislo = Int((posledni-1+prvni)*Rnd+1)
end function

' Funkce testuje jestli je posledni cislo unikatni
' Nevim, který prvek je posledni, dám to jako parametr
function PosledniJeUnikatni(Cisla, prvni, posledni) as boolean
PosledniJeUnikatni = false

For j = prvni To posledni-1
If Cisla(j) = Cisla(posledni) Then exit function
next
PosledniJeUnikatni = true
end function


Sub BubbleSort(ByRef Cisla)
Dim pom as Integer
Dim t as integer
Dim N as integer

N = UBound(Cisla, 1)

Do
t = 0
For j = LBound(Cisla, 1) To N - 1
If Cisla(j) > Cisla(j+1) then
pom = Cisla(j)
Do
Cisla(j) = Cisla(j+1)
j = j + 1
If j = N Then Exit Do
Loop While pom > Cisla(j + 1)
Cisla(j) = pom
t = j
End If
Next
N = t - 1
Loop Until t = 0
End Sub

' Funkce porovná dvě číselná pole a zjistí počet shod
' Predpokládá, že polej sou setříděná
Function PocetShod(Tip As Variant, Tah As Variant) As Integer
Dim i As Integer, j As Integer
PocetShod = 0

j = 1
For i = 1 To 6 REM konečne sme sa dostali k vyhodnocovaniu
Do While Tip(i) >= Tah(j)
If Tip(i) = Tah(j) Then
PocetShod = PocetShod + 1
end if
j = j + 1
if j > 6 then exit for
Loop
Next
End Function

' Opět, 2x stejné operace, dáme do procedury
Function VyhoceniTahu(CisloTahu, tipPole, lotoPole1, DodatkoveCislo, VyhryDod, Vyhry) As String
Dim Shody as Integer
Dim Dodatek as Integer

Shody = PocetShod(tipPole, lotoPole1)

Dodatek = 0
For i = 1 To 6
If tipPole(i) = lotoDodatkoveCislo1 Then
Dodatek = 1
Exit For
End If
Next
VyhoceniTahu = "V " & CisloTahu & ". ťahu ste uhadli " & Shody & " čísla a " & Dodatek & " dodatkových čísel a vyhrávate "

If Dodatek = 1 Then
VyhoceniTahu = VyhoceniTahu & Format(VyhryDod(6 - Shody), "#,##0.00 ""€""") & "!"
Else
VyhoceniTahu = VyhoceniTahu & Format(VyhryDod(6 - Shody), "#,##0.00 ""€""") & "!"
End If

End Function
user avatar Eduard Boldižár
Odpovědět
Programovanie makier v LibreOffice: Bubble sort (bublinkové triedenie)
28. 09. 2017, 02:06:50
Fakt pekné a efektívnejšie riešenia :) vďaka za váš čas
 
 
woo jaw demo hz