Permutacije!?
Permutacije!?
Iščem idejo, kako bi iz določene besede - " miza" program (Excel) izdelal vse možne zamenjave znakov- miza, miaz,maiz,mazi, ....- vseh 24.
Seveda, bi želel, da ne deluje samo za besedo miza in za dolžino 4.
Hvala Alan
Seveda, bi želel, da ne deluje samo za besedo miza in za dolžino 4.
Hvala Alan
Re: Permutacije!?
Nimate kaj veliko razmišljati... Potrebno je napisati VBA funkcijo, ki bo to naredila:alan07 napisal/-a:Iščem idejo, kako bi iz določene besede - " miza" program (Excel) izdelal vse možne zamenjave znakov- miza, miaz,maiz,mazi, ....- vseh 24.
Koda: Izberi vse
Option Explicit
Sub Zazeni()
Dim Vhod As String: Vhod = InputBox("Vhodna beseda:")
Premutiraj "", Vhod, 1
End Sub
Sub Premutiraj(levo As String, desno As String, ByRef vrstica As Long)
Dim i As Long, j As Long
j = Len(desno)
If j < 2 Then
Cells(vrstica, 1) = levo & desno
vrstica = vrstica + 1
Else
For i = 1 To j
Premutiraj levo + Mid(desno, i, 1), Left(desno, i - 1) + Right(desno, j - i), vrstica
Next
End If
End Sub
lp,
Matjaž Prtenjak
Administrator
Matjaž Prtenjak
Administrator
Re: Permutacije!?
si bom kar tole temo sposodil, ker se mi zdi, da moja težava spada sem.
iščem makro, ki bi (čim hitreje) našel vse binarne nize določene dožnine.
torej, če mu damo vhoden podatek 10, bo izračunal vseh 1024 binarnih nizov dolžine 10.
hvala za pomoč,
andrej
iščem makro, ki bi (čim hitreje) našel vse binarne nize določene dožnine.
torej, če mu damo vhoden podatek 10, bo izračunal vseh 1024 binarnih nizov dolžine 10.
hvala za pomoč,
andrej
Re: Permutacije!?
Saj pri binarnih številih je pa algoritem zares trivialen, pač začnete s samimi ničlami in prištevate po 1 dokler ne pridete do samih enic.
Spodaj imate to zapisano v VBA kodi:
Za vaš primer pač poženite makro s parametrom 10:
Spodaj imate to zapisano v VBA kodi:
Koda: Izberi vse
'
' www.matazev.net
' junij 2010
'
Sub Izpisi(biti)
Dim i
For i = UBound(biti) To LBound(biti) Step -1
Debug.Print biti(i);
Next
Debug.Print
End Sub
Sub IzpisiBinarnaStevila(stBitov As Integer)
Dim biti() As Integer
ReDim biti(stBitov - 1)
Dim stevec As Integer
For stevec = 0 To stBitov - 1
biti(stevec) = 0
Next
Do
Izpisi biti
stevec = 0
While (stevec < stBitov) And (biti(stevec) = 1)
biti(stevec) = 0
stevec = stevec + 1
If (stevec = stBitov) Then Exit Do
Wend
biti(stevec) = 1
Loop While True
End Sub
Koda: Izberi vse
IzpisiBinarnaStevila 10
lp,
Matjaž Prtenjak
Administrator
Matjaž Prtenjak
Administrator
Re: Permutacije!?
Ker sem popolnoma brez znanja VBA bi prosil za kodo, ki bi imela še en parameter in sicer število znakov v nizu. Se pravi en vnos za niz možnih znakov in dolžino permutiranega niza.
Npr:
Niz znakov: 12345
Dolžina niza: 2
Rezultati:
12
13
14
15
21
23
24
.
.
.
56
Hvala in lep pozdrav
Npr:
Niz znakov: 12345
Dolžina niza: 2
Rezultati:
12
13
14
15
21
23
24
.
.
.
56
Hvala in lep pozdrav
Re: Permutacije!?
Pozdravljeni,
To o čemer govorite vi, niso permutacije, temveč varaicije. Iščete torej algoritem za generiranje variacij. Vprašanje, ki se mi zastavlja pa je, zakaj ga potrebujete? Ali je to domača naloga?
To o čemer govorite vi, niso permutacije, temveč varaicije. Iščete torej algoritem za generiranje variacij. Vprašanje, ki se mi zastavlja pa je, zakaj ga potrebujete? Ali je to domača naloga?
lp,
Matjaž Prtenjak
Administrator
Matjaž Prtenjak
Administrator
Re: Permutacije!?
Že lep čas ne hodim v šolo. V službi delam neke analize in bi si rad sestavil določene variacije.admin napisal/-a:Pozdravljeni,
To o čemer govorite vi, niso permutacije, temveč varaicije. Iščete torej algoritem za generiranje variacij. Vprašanje, ki se mi zastavlja pa je, zakaj ga potrebujete? Ali je to domača naloga?
Re: Permutacije!?
Aha, to pa je malce več programske kode, vendar zdajle nimam časa. Bom prilepil tudi ustrezno funkcijo
lp,
Matjaž Prtenjak
Administrator
Matjaž Prtenjak
Administrator
Re: Permutacije!?
Pozdravljeni,
Kot obljubljeno, vam pripenjam kodo za variacije.
Kot obljubljeno, vam pripenjam kodo za variacije.
Koda: Izberi vse
Option Explicit
Public znaki As String
Public znakiLen As Integer
Public varLen As Integer
Public idx() As Integer
Public maxIdx() As Integer
'Sub test()
' Variiraj "1234567", 3
'End Sub
Sub Zazeni()
Dim Vhod As String: Vhod = InputBox("Vhodna beseda:")
Dim dolzina As String: dolzina = InputBox("Dolzina variacij:")
Variiraj Vhod, CInt(dolzina)
End Sub
Sub Variiraj(beseda As String, dolzina As Integer)
znaki = beseda
znakiLen = Len(beseda)
varLen = dolzina
If (varLen >= znakiLen) Then
MsgBox "Dolžina besede je prekratka!"
Exit Sub
End If
ReDim idx(varLen)
ReDim maxIdx(varLen)
Dim i As Integer
For i = 1 To varLen
maxIdx(i) = znakiLen - varLen + i
Next
Columns("A:A").ClearContents
init 1, 1
Dim r As Integer: r = 1
Do
izpisi r
r = r + 1
Loop While naslednja
End Sub
Sub init(pos As Integer, start As Integer)
Dim i As Integer
For i = pos To varLen
idx(i) = start + i - pos
Next
End Sub
Sub izpisi(r As Integer)
Dim rezultat As String: rezultat = ""
Dim i
For i = 1 To varLen
rezultat = rezultat & Mid(znaki, idx(i), 1)
Next
Cells(r, 1) = rezultat
End Sub
Function naslednja() As Boolean
naslednja = False
Dim i As Integer
For i = varLen To 1 Step -1
If (idx(i) < maxIdx(i)) Then
init i, idx(i) + 1
naslednja = True
Exit Function
End If
Next
End Function
lp,
Matjaž Prtenjak
Administrator
Matjaž Prtenjak
Administrator
Re: Permutacije!?
Hvala za vaš trud in kodo, ki načeloma deluje ampak izpusti kar nekaj možnih rezultatov kot npr.:admin napisal/-a:Pozdravljeni,
Kot obljubljeno, vam pripenjam kodo za variacije.
Koda: Izberi vse
Option Explicit Public znaki As String Public znakiLen As Integer Public varLen As Integer Public idx() As Integer Public maxIdx() As Integer 'Sub test() ' Variiraj "1234567", 3 'End Sub Sub Zazeni() Dim Vhod As String: Vhod = InputBox("Vhodna beseda:") Dim dolzina As String: dolzina = InputBox("Dolzina variacij:") Variiraj Vhod, CInt(dolzina) End Sub Sub Variiraj(beseda As String, dolzina As Integer) znaki = beseda znakiLen = Len(beseda) varLen = dolzina If (varLen >= znakiLen) Then MsgBox "Dolžina besede je prekratka!" Exit Sub End If ReDim idx(varLen) ReDim maxIdx(varLen) Dim i As Integer For i = 1 To varLen maxIdx(i) = znakiLen - varLen + i Next Columns("A:A").ClearContents init 1, 1 Dim r As Integer: r = 1 Do izpisi r r = r + 1 Loop While naslednja End Sub Sub init(pos As Integer, start As Integer) Dim i As Integer For i = pos To varLen idx(i) = start + i - pos Next End Sub Sub izpisi(r As Integer) Dim rezultat As String: rezultat = "" Dim i For i = 1 To varLen rezultat = rezultat & Mid(znaki, idx(i), 1) Next Cells(r, 1) = rezultat End Sub Function naslednja() As Boolean naslednja = False Dim i As Integer For i = varLen To 1 Step -1 If (idx(i) < maxIdx(i)) Then init i, idx(i) + 1 naslednja = True Exit Function End If Next End Function
Niz znakov: 12345
Dolžina niza: 2
Rezultat:
12
13
14
15
23
24
25
34
35
45
Manjkajo:
21, 31, 32, 41, 42, 43, 51. 52, 53, 54
Re: Permutacije!?
Ah, sem spregledal, da želite variacije s ponavljanjem.
Kodo sem popravil tako, da podate še zadni parameter (1 ali 0), če želite oz. ne želite ponavljanja:
Kodo sem popravil tako, da podate še zadni parameter (1 ali 0), če želite oz. ne želite ponavljanja:
Koda: Izberi vse
Option Explicit
Public znaki As String
Public znakiLen As Integer
Public varLen As Integer
Public sPonavljanjem As Boolean
Public idx() As Integer
Public maxIdx() As Integer
'Sub test()
' Variiraj "1234567", 3
'End Sub
Sub Zazeni()
Dim Vhod As String: Vhod = InputBox("Vhodna beseda:")
Dim dolzina As String: dolzina = InputBox("Dolzina variacij:")
Dim ponavljaj As String: ponavljaj = UCase(InputBox("Variacije s ponavljanjem?:"))
Variiraj Vhod, CInt(dolzina), (ponavljaj = "DA") Or (ponavljaj = "1")
End Sub
Sub Variiraj(beseda As String, dolzina As Integer, ponavljaj As Boolean)
znaki = beseda
znakiLen = Len(beseda)
varLen = dolzina
sPonavljanjem = ponavljaj
If (varLen >= znakiLen) Then
MsgBox "Dolžina besede je prekratka!"
Exit Sub
End If
ReDim idx(varLen)
ReDim maxIdx(varLen)
Dim i As Integer
For i = 1 To varLen
maxIdx(i) = znakiLen - varLen + i
Next
Columns("A:A").ClearContents
init 1, 1
Dim r As Long: r = 1
Do
izpisi r
Loop While naslednja
End Sub
Sub Premutiraj(levo As String, desno As String, ByRef vrstica As Long)
Dim i As Long, j As Long
j = Len(desno)
If j < 2 Then
Cells(vrstica, 1) = levo & desno
vrstica = vrstica + 1
Else
For i = 1 To j
Premutiraj levo + Mid(desno, i, 1), Left(desno, i - 1) + Right(desno, j - i), vrstica
Next
End If
End Sub
Sub init(pos As Integer, start As Integer)
Dim i As Integer
For i = pos To varLen
idx(i) = start + i - pos
Next
End Sub
Sub izpisi(ByRef r As Long)
Dim rezultat As String: rezultat = ""
Dim i
For i = 1 To varLen
rezultat = rezultat & Mid(znaki, idx(i), 1)
Next
If (sPonavljanjem) Then
Premutiraj "", rezultat, r
Else
Cells(r, 1) = rezultat
r = r + 1
End If
End Sub
Function naslednja() As Boolean
naslednja = False
Dim i As Integer
For i = varLen To 1 Step -1
If (idx(i) < maxIdx(i)) Then
init i, idx(i) + 1
naslednja = True
Exit Function
End If
Next
End Function
lp,
Matjaž Prtenjak
Administrator
Matjaž Prtenjak
Administrator
Re: Permutacije!?
Deluje, najlepša hvalaadmin napisal/-a:Ah, sem spregledal, da želite variacije s ponavljanjem.
Kodo sem popravil tako, da podate še zadni parameter (1 ali 0), če želite oz. ne želite ponavljanja:Koda: Izberi vse
Option Explicit Public znaki As String Public znakiLen As Integer Public varLen As Integer Public sPonavljanjem As Boolean Public idx() As Integer Public maxIdx() As Integer 'Sub test() ' Variiraj "1234567", 3 'End Sub Sub Zazeni() Dim Vhod As String: Vhod = InputBox("Vhodna beseda:") Dim dolzina As String: dolzina = InputBox("Dolzina variacij:") Dim ponavljaj As String: ponavljaj = UCase(InputBox("Variacije s ponavljanjem?:")) Variiraj Vhod, CInt(dolzina), (ponavljaj = "DA") Or (ponavljaj = "1") End Sub Sub Variiraj(beseda As String, dolzina As Integer, ponavljaj As Boolean) znaki = beseda znakiLen = Len(beseda) varLen = dolzina sPonavljanjem = ponavljaj If (varLen >= znakiLen) Then MsgBox "Dolžina besede je prekratka!" Exit Sub End If ReDim idx(varLen) ReDim maxIdx(varLen) Dim i As Integer For i = 1 To varLen maxIdx(i) = znakiLen - varLen + i Next Columns("A:A").ClearContents init 1, 1 Dim r As Long: r = 1 Do izpisi r Loop While naslednja End Sub Sub Premutiraj(levo As String, desno As String, ByRef vrstica As Long) Dim i As Long, j As Long j = Len(desno) If j < 2 Then Cells(vrstica, 1) = levo & desno vrstica = vrstica + 1 Else For i = 1 To j Premutiraj levo + Mid(desno, i, 1), Left(desno, i - 1) + Right(desno, j - i), vrstica Next End If End Sub Sub init(pos As Integer, start As Integer) Dim i As Integer For i = pos To varLen idx(i) = start + i - pos Next End Sub Sub izpisi(ByRef r As Long) Dim rezultat As String: rezultat = "" Dim i For i = 1 To varLen rezultat = rezultat & Mid(znaki, idx(i), 1) Next If (sPonavljanjem) Then Premutiraj "", rezultat, r Else Cells(r, 1) = rezultat r = r + 1 End If End Sub Function naslednja() As Boolean naslednja = False Dim i As Integer For i = varLen To 1 Step -1 If (idx(i) < maxIdx(i)) Then init i, idx(i) + 1 naslednja = True Exit Function End If Next End Function