# Algorithmus für Kombinationen



## Roman Locher (25. November 2006)

Ich möchte für eine beliebige Anzahl von vorgegebenen Werten, alle möglichen Kombinationen ermitteln. Also z.B. für 4 Werte alle möglichen 1er,2er,3er und 4er Paare.

Ergebnis müsste dann ungefähr so aussehen:

1; 2; 3; 4
1_2; 1_3; 1_4; 2_3; 2_4; 3_4
1_2_3; 1_2_3; 1_3_4; 2_3_4
1_2_3_4

Für die 2er Paare bekomm ich's noch einfach hin - aber für alle Kombinationen hab ich grad keine Idee.


----------



## Roman Locher (25. November 2006)

Unter dem Stichwort Permutation findet ja man schon einiges. Aber es wird immer davon ausgegangen, dass ich bei 3 Werten auch immer 3er Kombinationen haben möchte. Ich brauche aber auch alle 1er, 2er Kombinationen.


----------



## Roman Locher (26. November 2006)

Bin etwas weiter gekommen, ist aber nicht 100%


```
Public Function Test()
    Dim wert(1 To 5), i As Integer, max As Integer, y As Integer, start As Integer, x As Integer, y_ As Integer, z As Integer, z_ As Integer, max_ As Integer
    
    wert(1) = 1
    wert(2) = 2
    wert(3) = 3
    wert(4) = 4
    wert(5) = 5
    max = 5
    
    For x = 1 To (max - 2)
        For i = 1 To (max - 1)
            max_ = max
            If (i + x) > max Then
                max_ = max + x - 1
            End If
            For y = (i + x) To (max_)
                y_ = y
                If y > max Then
                    y_ = y - max
                End If
                    For z = i To (i + x - 1)
                        z_ = z
                        If z > max Then
                            z_ = z - max
                        End If
                        Debug.Print wert(z_)
                    Next z
                Debug.Print wert(y_)
            Debug.Print "#"
            Next y
            Debug.Print "#"
        Next i
    Next x
    
    
    
End Function
```


----------



## WaGutSo (30. November 2006)

Hallo Roman,

Wenn die Menge der Elemente die gefunden werden soll immer gleich ist, ist das Verfahren einfach. Für 3 Elemente sieht es z. B. so aus:


```
Sub Kombinationen_3()
  'Beispiel für 3 Element aus der Menge 'Wert()'
  
  Dim iUG As Integer                    ' untere Array Grenze
  Dim iOG As Integer                    ' obere Array Grenze
  Dim iZahler_1 As Integer              ' Zähler
  Dim iZahler_2 As Integer              ' Zähler
  Dim iZahler_3 As Integer              ' Zähler
  
  Dim wert(1 To 5) As Integer
    wert(1) = 1
    wert(2) = 2
    wert(3) = 3
    wert(4) = 4
    wert(5) = 5
  
  iUG = LBound(wert())
  iOG = UBound(wert())
  For iZahler_1 = iUG To iOG
    For iZahler_2 = iZahler_1 + 1 To iOG
      For iZahler_3 = iZahler_2 + 1 To iOG
        Debug.Print wert(iZahler_1), wert(iZahler_2), wert(iZahler_3)
      Next iZahler_3
    Next iZahler_2
  Next iZahler_1
End Sub
```

Dieses Verfahren ist leider nicht flexibel. Für eine andere Anzahl Elemente muss die Prozedur geändert werden.
Ob ich einen allgemeingütigen Algorithmus (n Element aus einer Menge m) hinbekomme versuche ich noch.

Viel Erfolg
Walter Gutermann


----------



## WaGutSo (4. Dezember 2006)

Hallo Roman,

das war eine schöne Aufgabe. Hier nun meine Vorstellung von einem universellen Algorithmus:

Anzahl der Kombinationen non N Elementen aus einer Menge von M Elementen (ohne Wiederholung).

-	Initiiere Anfangspositionen
	(pos(1) = 1; pos(2) = 2; ….pos(N) = N)

-	Start der Schleife

		-	iStart = pos(N –  1), = vorletzte Position 

		-	Erhöhe Position letztes Element pos(N) = iStart +1 bis M
				pos(N) = iStart +1
				pos(N) = iStart + 2
					bis 
				pos(N) = M

				--> hier Ausgabe der Werte

		-	Stelle fest wie viel Elemente ihre Endposition erreicht haben 
			= iAnzEndPos

		-	erhöhe Element (N – iAnzEndPos) um 1

		- 	Aktualisiere die Positionen der nachfolgenden Elementen von 
			Element (N – iAnzEndPos). Jedes nachfolgende Element ist um 1 höher 			        als sein Vorgänger.
				pos(N – iAnzEndPos + 1) = pos(N – iAnzEndPos )  + 1
					bis
				pos(N) = pos(N – 1) + 1

- Tue das so lange, bis alle Elemente ihre Endposition erreicht haben
   (iAnzEndPos = N)


Bitte melde Dich wenn Du den Algorithmus umgesetzt hast.

Viel Erfolg
Walter Gutermann

NS: In meiner ersten Antwort habe ich noch einen Schönheitsfehler entdeckt. Die beiden äußere Schleifen machen einige Null - Durchgänge. Das Schleifenende kann um 2 bzw. 1 gekürzt werden.


----------



## Alfred_ (11. Dezember 2006)

Hi,
die schnellste Variante ist folgende:

```
Dim a As Integer, b As Integer, c As Integer, d As Integer, e As Integer, f As Integer
Dim  n As Long
n = 0

For a = 1 To 1
  For b = a + 1 To 2
    For c = b + 1 To 3
      For d = c + 1 To 4
        For e = d + 1 To 5
            n = n + 1
          Next e
        Next d
      Next c
    Next b
  Next a
```
Die 2er Kombination ergibt 10 Möglichkeiten ohne Wiederholung.
Welche Kombinationen o.W. Du auch immer suchst, in Excel kannst Du die Anzahl der Möglichkeiten relativ leicht ermitteln.
Grüße


----------



## WaGutSo (12. Dezember 2006)

Hallo Alfred,
getestet hast Du das aber nicht, oder? 

Grüße
Walter


----------



## Alfred_ (20. Dezember 2006)

Hi, natürlich. Seit einiger Zeit schon!
Grüße
PS.: Das ist nur das Grundgerüst. Das Schreiben in einer Datei etc. fehlt natürlich und es werden ALLE Kombinationen aus den Zahlen 1 - 5 generiert. Wenn Du allerdings die Auswahlzahlen selbst definieren möchtest, dann ist diese Variante nicht zutreffend.


----------



## WaGutSo (20. Dezember 2006)

Hallo Alfred,

in Deinem Beispiel wird jede Schleife genau 1mal durchlaufen (Schleife a von 1 nach 1, Schleife b von 2 nach 2, …). Das Ergebnis ist, dass n von 0 auf 1 erhöht wird. Mehr geschieht nicht.

Grüße
Walter Gutermann


----------



## Alfred_ (21. Dezember 2006)

Hi,
Deine Kritik zu *DIESEM* Beispiel ist richtig. Ich wollte Dir nur das Grundgerüst vermitteln.
Der Code 5aus2 muss lauten!

```
For a = 1 To 4
  For b = a + 1 To 5
   n = n + 1
  Next b
 Next a
```
Solltest Du 6aus49 mit 13,983.816 Kombinationen o.W.
generieren wollen, dann geht das so:

```
For a = 1 To 44
  For b = a + 1 To 45
    For c = b + 1 To 46
      For d = c + 1 To 47
        For e = d + 1 To 48
          For f = e + 1 To 49
            n = n + 1
            Next f
          Next e
        Next d
      Next c
    Next b
  Next a
```
Eine schnellere Routine ist mir nicht bekannt. Alles klar?
Grüße


----------



## Roman Locher (27. Dezember 2006)

Hallo zusammen,

danke für die Tipps. Die Lösung ist ein rekursiver Algorithmus, der aber auch nicht von mir persönlich kommt. Damit lassen sich alle Kombinationen mit einer beliebigen Anzahl an Zahlen ermitteln, ohne den Code ändern zu müssen.


```
startNr = 1
endNr = 10
maxNumberLength = 9
currentLength = 0
currentNr = 0

For currentLength = 2 To maxNumberLength

    For currentNr = startNr To endNr
    
        Call NextComb((currentNr), (currentLength - 1), resultString$ + CStr(values(currentNr)))
        
    Next currentNr

Next currentLength


End Function


Public Function NextComb(ByVal begin As Integer, ByVal rest As Integer, resultString As String)

Dim currentNr As Integer, query As String

currentNr = 0

If rest > 0 Then
    
    For currentNr = (begin + 1) To endNr
    
        Call NextComb((currentNr), (rest - 1), resultString$ + " OR APOS=" + CStr(values(currentNr)))
    
    Next currentNr
    
Else

    Debug.Print resultString$
    
End If

End Function
```


----------



## WaGutSo (28. Dezember 2006)

Hallo Roman,
so richtig funktioniert die Lösung mit dem‚ Rekursiven Algorithmus’ bei mir noch nicht. Insbesondere kann ich nichts mit der Funktion ‚*values*’ anfangen (ich arbeite mit VB6).
Zum Vergleich hier meine Programmversion zu dem ‚Verbalen Algorithmus’ den ich oben beschrieben habe: 


```
:
Dim i As Integer
Dim iAnzP As Integer
Dim iElement As Integer
' ** zum Beispiel Grundmenge 10 Werte
iAnzW = 10
ReDim Preserve Wert(1 To iAnzW)
For i = 1 To iAnzV
'      Wert(i) = Chr(96 + i)  ' als Buchstaben
  Wert(i) = i             ' als Zahl
Next i
' und 5 Elemente
iElement = 5
:
:
Call Kombintation(Wert(), iElement)
:
:


Sub Kombintation(mWert() As Variant, iZN As Integer)
  ' Ermittelt die möglichen Kombinationen, aus der Menge 'mWert()',
  ' 'iZN' Elementen ohne Wiederholung herauszugreifen."
  
      Dim sTmp As String  ' nur für Test
      Dim iTest As Long   ' nur für Test
      iTest = 0           ' nur für Test
      
  Dim n As Integer
  Dim p As Integer
  Dim iUG As Integer                    ' untere Array Grenze der Werte
  Dim iOG As Integer                    ' obere Array Grenze der Werte
  Dim iZM As Integer                    ' Anzahl Elemente in der Grundmenge (Array)
  Dim iPos() As Integer                 ' Positionen an denen sich die Elemente befinden
  Dim iZEndPos As Integer                ' Zähler wieviele Positionen die Endstellung erreicht haben
  Dim iStart As Integer                 ' Startposition des letzten Element (Schleife)
  
  iUG = LBound(mWert())
  iOG = UBound(mWert())
  iZM = iOG - iUG + 1
  
  ' ** Anfangspositionen initiieren
  ReDim iPos(iZN) As Integer
  For n = 1 To iZN
    iPos(n) = n
  Next n
  
  ' Start Schleife
  iZEndPos = 0
  Do While iZEndPos < iZN
    iStart = iPos(iZN - 1) + 1
    
    ' letzte Position erhöhen
    For n = iStart To iZM
      iPos(iZN) = n
                  ' Werte ausgeben, Test
                    sTmp = ""
                    For p = 1 To iZN
                      sTmp = sTmp & mWert(iPos(p)) & vbTab
                    Next p
                    iTest = iTest + 1
                    Debug.Print String(6 * (iZN - 1), "-") & ", lfd. Nr.: " & iTest
    Next n
    
    ' Anzahl Elemente in Endposition feststellen
    iZEndPos = 0
    For n = 0 To iZN - 1
      If iPos(iZN - n) = iZM - n Then
        iZEndPos = iZEndPos + 1
      End If
    Next n
    
    ' Positionen aktualisieren
    iPos(iZN - iZEndPos) = iPos(iZN - iZEndPos) + 1
    For n = iZN - iZEndPos + 1 To iZN
      iPos(n) = iPos(n - 1) + 1
    Next n
  Loop
End Sub
```

Beachte, dass es evtl. zu einer sehr große Anzahl von Kombinationen kommen kann! Bei der Weiterverarbeitung sind Meldungen wie 'nicht genügend Speicher' oder 'Überlauf' leicht möglich. Also vorher prüfen!

Viel Erfolg
Walter Gutermann


----------



## Roman Locher (28. Dezember 2006)

Sorry, habe nicht den ganzen Code geposted. Die Variable values ist ein Array, in dem ich die möglichen Werte abgelegt habe. Hier nochmal der vollständige Code:


```
Option Compare Database
Dim startNr As Integer, endNr As Integer, maxNumberLength As Integer, resultString As String, values(1 To 10) As Double, rs As New ADODB.Recordset, currentLength As Integer, db As DAO.Database, tabelle As String

Public Function Test()

Dim currentNr As Integer

startNr = 1
endNr = 10
maxNumberLength = 9
resultString$ = "APOS="
Set db = CurrentDb

'<-- Diese Variablen anpassen
values(1) = 91442540
values(2) = 91441900
values(3) = 3350000
values(4) = 91449590
values(5) = 91010000
values(6) = 91241900
values(7) = 91249590
values(8) = 3350003
values(9) = 3350050
values(10) = 91361900

tabelle$ = "987"
'-->

currentLength = 0
currentNr = 0

For currentLength = 2 To maxNumberLength

    For currentNr = startNr To endNr
    
        Call NextComb((currentNr), (currentLength - 1), resultString$ + CStr(values(currentNr)))
        
    Next currentNr

Next currentLength


End Function


Public Function NextComb(ByVal begin As Integer, ByVal rest As Integer, resultString As String)

Dim currentNr As Integer, query As String

currentNr = 0

If rest > 0 Then
    
    For currentNr = (begin + 1) To endNr
    
        Call NextComb((currentNr), (rest - 1), resultString$ + " OR APOS=" + CStr(values(currentNr)))
    
    Next currentNr
    
Else
    query$ = "SELECT Feld2 FROM " + tabelle$ + " WHERE " + resultString$ + " GROUP BY Feld2 HAVING COUNT(APOS) > " + CStr(currentLength - 1)
    rs.Open query$, CurrentProject.Connection, adOpenStatic
    Debug.Print resultString$ + ";" + CStr(rs.RecordCount)
    db.Execute "INSERT INTO Ergebnis VALUES ('" + resultString$ + "', " + CStr(rs.RecordCount) + ")"
    rs.Close
    
End If

End Function
```


----------

