Hejsan, jag skulle behöva hjälp med en algoritm som tar ut enkel-rader ur ett garderat stryktips-system.
Det garderade systemet ligger i en (string) matris (allaTecken(3,13)), d.v.s. 3 kolumner och 13 rader.
Om man t.ex. garderar match 1 med 1,X så innebär detta att det ligger en 1:a i allaTecken(1,1), ett X i allaTecken(2,1) och ingenting i allaTecken(3,1) o.s.v...
Om användaren fyller i 1,X,2 på samtliga matcher skulle detta bli ca 1,500,000 rader vilket man så klart aldrig gör men algoritmen måste ändå hantera detta.
Algoritmen ska alltså loppa igenom allaTecken(3,13) och lägga in enkelraderna i en ny array(eller nåt).

Tacksam för hjälp / Johan

Lämpligare med en boolean-matris i så fall. Hur vill du få ut själva datat, vill du spara det? Då är det lämpligt med en trädstruktur av något slag.

Om du inte bryr dig om att kunna välja enskilda permutationer, och bara skriva ut alla så är det bara att göra något i den här stilen (pseudo, du måste rätta till grejer):

<code>
dim matris(3, 13) as boolean
dim current as string

current=string(13, " ")

Public Sub PrintRows(Match as Long)
if Match=14 then 'Vi har gått igenom hela listan
Print Current
else
'Vi står mitt i den, så vi går igenom alla val
for i=1 to 3
if matris(i, match) then
mid$(current, match, 1)=cstr(i)
PrintRows Match+1
end if
next i
End if
End Sub
</code>

Fråga om du inte förstår hur den funkar.

Tack för svaret!!
Jag förstår inte riktigt hur den funkar, du får hemskt gärna förklara vad de olika sakerna gör.
Jag har gjort om den till boolean och vill på nåt sätt också spara raderna men det kanske jag
kan lösa sen om jag får igång denna..

Det är en rekursiv algoritm (en funktion som anropar sig själv), och tanken är följande:

1. Vi har tidigare fixat en del av matcherna (upp till match nummer "n"), och skrivit in dem i strängen "current". Vi tar nu emot ett matchnummer (1-13). För detta nummer ska vi sen gå igenom för att se vlka alternativ vi väljer.
2. Om matchnumret är 14 så har vi gått igenom hela raden. Då skriver vi ut den (dvs skriver ut current).
3. Om matchnumret är mindre än 14 testar vi först med 1, sen 2 och sen 3 (1=1, 2=X, 3=2). För dem som är true kollar vi resten av raden, och lägger till siffran till "current".


Det kanske är enklare med ett exempel. Om vi tar 3 rader istället, och vi har garderat så här:
1X
X
X2

Vi börjar med första matchen. Först en check så att matchen inte är den sista (=4). Sen går vi igenom matrisen på motsvarande rad. Först kollar vi 1 (1), sen X (2), sen 2 (3).

Alltså hamnar vi på att matris(1,1)=true. Då ändrar vi strängen till "1", och letar vidare, på nästa match.
Där hittar vi bara "X", skriver dit det i strängen (nu är den "12"). Går vidare till nästa match, hittar "X", skriver det i strängen ("122").
Sen testar vi ytterligare ett steg till, med match 4. I nästa steg står det "if match=4 then print ...", alltså skriv ut strängen, "122".

Vi går upp ett steg, och får "123", skriver ut.

Upp två steg, får "2", följt av "22", "222", skriver ut. Går upp ett steg, får "223", skriver ut, och sen är det klart.

Alltså
122
123
222
223

eller översatt till 1X2:
1XX
1X2
XXX
XX2

Ingen jättebra förklaring, men det kanske blir lite lättare.

Ja nu är jag med, tack så mycket för det.
Inte alls en dålig förklaring:-)

Du kan det vara nåt strul med raden (Mid$(current, Match, 1) = CStr(i)) eftersom utskrifterna hela
tiden blir tomma?

Om man lägger in en MsgBox mitt i rekursionen ser man att den rekurserar riktigt men när man skriver ut current efter varje rad är den tom. Ex:

For i = 1 To 3
If matris(i, Match) Then
Mid$(current, Match, 1) = CStr(i)
MsgBox (current)
PrintRows (Match + 1)
End If
Next i

Man ser här att den skriver ut rätt, t.ex: 2 2 2 1 3...(i olika msgboxar)

Sen när man kommer till:

If Match = 14 Then 'Vi har gått igenom hela listan
MsgBox current

Då blir utskriften tom av någon anledning

Vad kan det bero på?

// Johan

Det är säkert bara någon liten skitsak som strular med Niklas kod, men oftast är det snabbare att skriva sin egen kod än att sätta sig in i någon annans lösning och tankesätt, så jag gör det på mitt vis (inklusive spara till fil). Samma princip dock, med rekursivt anrop men jag valde att utgå ifrån 13 textsträngar som innehåller något av värdena : "1" , "x" , "2" , "1x" , "12" , "x2" , "1x2". Koden gör dock inga valideringar utan förutsätter detta.
<code>
Option Explicit

Private mSystem(1 To 13) As String
Private mFileNumber As Integer

Private Sub Command1_Click()
mSystem(1) = "1"
mSystem(2) = "x"
mSystem(3) = "2"
mSystem(4) = "x2"
mSystem(5) = "1x"
mSystem(6) = "1"
mSystem(7) = "2"
mSystem(8) = "2"
mSystem(9) = "x"
mSystem(10) = "1x"
mSystem(11) = "2"
mSystem(12) = "2"
mSystem(13) = "1"

mFileNumber = FreeFile
Open "c:\system.txt" For Output As mFileNumber
PrintSystem "", 1
Close mFileNumber
Shell "notepad.exe c:\system.txt", vbNormalFocus
End Sub

Private Sub PrintSystem(ByVal row As String, ByVal level As Integer)
If level = 14 Then
Print #mFileNumber, row
Else
Dim i As Integer
For i = 1 To Len(mSystem(level))
PrintSystem row & Mid(mSystem(level), i, 1), level + 1
Next i
End If
End Sub
</code>
Av detta genereras filen c:\system.txt som innehåller följande :
<info>
1x2x1122x1221
1x2x1122xx221
1x2xx122x1221
1x2xx122xx221
1x221122x1221
1x221122xx221
1x22x122x1221
1x22x122xx221
</info>

Väldigt tacksam för svaret, den sista varianten får jag att fungera men det andra lilla skitfelet har jag
inte löst än. Ska kolla mer på det senare, tack ska ni ha // Johan

Det var som sagt pseudokod, så egentligen kan det vara vad som helst som är fel. Sannolikt har du inte initierat current till en radda mellanrum?

För övrigt är Per Hultqvists metod nog lämpligare på alla sätt och vis. Det är exakt samma algoritm, men utförd på ett vettigare sätt. Min var bara ett exempel på hur det kunde gå till.

Dessutom kan det vara bra att säga att det är näst intill omöjligt att göra den mer effektiv än den redan är, även om det känns som att det skulle gå. Det enda man skulle kunna tjäna in är rekursionen genom att göra den iterativ.

När jag dammade av gamla projekt så upptäckte jag att koden i inlägget ovan inte funkar fullt ut med de nyare versionerna av Visual Basic. Finns det någon som kan hjälpa mig att uppdatera Pers kodsnutt?

Vad är det som inte fungerar då?
Förstår du koden?

Behåll det gamla gooooooooooa som funkar.

Djä... trams att att ju nyare det är ju bättre är det.

Bullshit ! Kör gamla VB6 så länge det funkar .

Kära VB6 alstrar snabba kanonbra .exe

VB4 och Millenium Windows + VB.net är det sämsta djä... shit MS har lurat på oss.
Ohhhhhhhhhhhhhhhhh detta djä... Vista som dom lurat på Er. Har Ni Vista "Puckos"

Skriv inte om nån djä... "snutt" i VB.net , bevara det som funkar.

Fö är det ju tur att det finns dumma djä... därute
som lägger pengar på "shit"som MS kränger
Nåt bra kommer det ut då o då :-) Era dumma djä... Ginny Pigs
This is your wake up call. Love you :-o

DIXI

Det mesta av koden är inget problem.

Men..dels så accepterar inte VB att jag deklarerar mSystem 1-13 utan jag blir tvunget att definera 0-12, dels så köper inte VB #mFileNumber.
Jag får alltså fel dels i uppräkningen, dels i radbrytningarna.

Vad är det som är dåligt med Vista och vad är det som är så mycket bättre i Windows 7?


Thomas

Peter: strunta i den biten som skriver till fil. Satsa på att få upp det i någon listbox eller liknande i första hand.

Peter: Det är bara att deklarera den så du får 0-13, och sen skita i att använda position 0.

Äh, va fan. Är det VB.NET?

Typ:

Public Function GetAllPerturbations(ByVal l As IEnumerable(Of String)) As IEnumerable(Of String)
Return GetAllPerturbations(l, "")
End Function

Private Function GetAllPerturbations(ByVal l As IEnumerable(Of String), ByVal Prev As String) As IEnumerable(Of String)
If l.Count = 0 Then Return New List(Of String) From {Prev}
Dim chars = l.First.ToCharArray
Dim rest = l.Skip(1)
Dim t = (From c In chars Select p = GetAllPerturbations(rest, Prev & c)).SelectMany(Function(p) p)
Return t
End Function

Anropas med en ienumarable of string. Hade varit bättre att ha en ienum of ienum of string istället.
Denna gör djupet först, och skulle ev. kunna lösas på något annat sätt, men jag är tveksam till om man skulle tjäna något på det. I och med att det är IEnumerable så tror jag att den är lazy dessutom.

Det här kanske är lite snyggare förresten:


<Runtime.CompilerServices.Extension()> _
Public Function GetAllPerturbations(ByVal l As IEnumerable(Of String)) As IEnumerable(Of String)
If l.Count = 0 Then Return New List(Of String) From {""}

Dim chars = l.First.ToCharArray
Dim rest = l.Skip(1)
Dim t = (From c In chars Select ch = c, p = rest.GetAllPerturbations()
From pp In p Select ch & pp)
Return t
End Function


Och anropas t ex med:
Dim ls = {"1x", "x2", "1"}
For Each s In ls.GetAllPerturbations()
MessageBox.Show(s)
Next


Linq-satsen ser fortfarande lite off ut. Det borde gå att göra lire snyggare där.

Hur skulle detta se ut i asp classic?
Det behöver inte skrivas ut till en textfil, det kan skrivas ut direkt på sidan.

<code>
Option Explicit

Private mSystem(1 To 13) As String
Private mFileNumber As Integer

Private Sub Command1_Click()
mSystem(1) = "1"
mSystem(2) = "x"
mSystem(3) = "2"
mSystem(4) = "x2"
mSystem(5) = "1x"
mSystem(6) = "1"
mSystem(7) = "2"
mSystem(8) = "2"
mSystem(9) = "x"
mSystem(10) = "1x"
mSystem(11) = "2"
mSystem(12) = "2"
mSystem(13) = "1"

mFileNumber = FreeFile
Open "c:\system.txt" For Output As mFileNumber
PrintSystem "", 1
Close mFileNumber
Shell "notepad.exe c:\system.txt", vbNormalFocus
End Sub

Private Sub PrintSystem(ByVal row As String, ByVal level As Integer)
If level = 14 Then
Print #mFileNumber, row
Else
Dim i As Integer
For i = 1 To Len(mSystem(level))
PrintSystem row & Mid(mSystem(level), i, 1), level + 1
Next i
End If
End Sub
</code>
Av detta genereras filen c:\system.txt som innehåller följande :
<info>
1x2x1122x1221
1x2x1122xx221
1x2xx122x1221
1x2xx122xx221
1x221122x1221
1x221122xx221
1x22x122x1221
1x22x122xx221
</info>

Hur skulle detta se ut i asp classic?
Det behöver inte skrivas ut till en textfil, det kan skrivas ut direkt på sidan.