Microsoft Excel

Herbers Excel/VBA-Archiv

Kombinationen 16 aus 40

Betrifft: Kombinationen 16 aus 40 von: alifa
Geschrieben am: 06.07.2013 00:02:08

Hallo,
aus 40 Zahlen sollen Kombinationen ohne Zurücklegen gebildet werden. Theoretisch wären das 62852101650 Gruppen a 16 verschiedene Zahlen. Es sollen aber nur die Kombinationen in die Tabelle eingetragen werden, die es ermöglichen 4 Gruppen von verschiedenen Zahlen zu bilden, deren Summe jeweils 490 ist. Die 40 Zahlen:1,2,3,5,10,15,17,21,25,29,34,42,46,51,55,59,63,65,85,105,125,130,150,170,190,195,215,235,255,257,273,289,305,325,341,357,373,393,409.
Das soll mittels VBA gelöst werden. Es ist Freizeitbeschäftigung, ein 4x4 magisches Quadrat soll ermittelt werden. Vielleicht kann mir jemand helfen?!
Gruß, Alifa

  

Betrifft: AW: Kombinationen 16 aus 40 von: Jack
Geschrieben am: 06.07.2013 01:16:43

Und täglich grüßt das Murmeltier ;-)

https://www.herber.de/forum/archiv/1204to1208/1204534_Programm_fuer_magisches_Quadrat.html


  

Betrifft: AW: Kombinationen 16 aus 40 von: alifa
Geschrieben am: 06.07.2013 10:40:54

du verwechselst wohl Murmeln mit Sprechen oder so...Das hier ist ein ganz anderes Problem. Eigentlich einfacher, da nur 4x4, nicht 6x6, wie gehabt


  

Betrifft: AW: Kombinationen 16 aus 40 von: Jack
Geschrieben am: 06.07.2013 15:14:43

Hallo Alifa

Vielleicht verwechsel ich das. ... -.^

Jedoch ist das Prinzip das zu grunde liegt ist das gleiche.

Und meiner Meinung nach auch eher ein mathematisches Problem.
Wenn du den Algorithmus zur Verfügung stellst sind sicher mehr Leute bereit an einer Lösung zu arbeiten.
Grüße


  

Betrifft: AW: Kombinationen 16 aus 40 von: Christian
Geschrieben am: 07.07.2013 14:00:58

hallo Alifa,
wenn ich dich richtig verstanden habe, sucht du nicht die Kombinationen ohne Wiederholung von 16 aus 40 sondern die Variationen ohne Wiederholung. Bei Variationen ist auch die Reihenfolge relevant. Bsp: 1-2-3-4 und 1-2-4-3 sind unterschiedliche Variationen. Bei Kombinationen zB. Lotto spielt die Reihenfolge keine Rolle.

Die Anzahl der Kombinationen ist 62,8 Milliarden, da hast du recht. Aber Variationen von 16 aus 40 gibt es ca. 1024.

Ansatz 1:
Durchlaufe alle Variationen und prüfe die Teilsummen der ersten 4 Zahlen, sowie der 5. bis 8 Zahl, etc.
Um mit Brute-Force alle Variationen zu berechnen brauchst du etwas Geduld - nähmlich mehrere Milliarden Jahre.

Ansatz 2:
ermittle die Variationen von 4 aus 40. Das sind nur 2.193.360.
Diese prüfst du auf die gewünschte Zeilen-Summe. Je nach Randbedingung verbleiben dann vielleicht noch ein paar tausend Einträge. Der ganze Spaß sollte in 1 bis 2 Sekunden erledigt sein.

siehe hierzu deinen Thread vom 03.01.2011:
https://www.herber.de/forum/archiv/1192to1196/1193756_Makro_anpassen.html

Für diese verbleibenden Einträge könnte man wieder alle Variationen möglicher 4er-Gruppen ermitteln und deren Spalten-Summen prüfen. Das könnte allerdings wieder etwas dauern - bei 4 aus 1000 ca 5 Tage, bei 4 aus 5000 ca. 10 Jahre. Immerhin, wie sind nicht mehr bei Milliarden Jahren.

Ansatz 3:
entwickle einen Algorithmus, der das Durchlaufen aller Variationen / Kombinationen überflüssig macht. Beispiele für java, etc. findest du sicher im Netz.

Tipp: für solche Aufgaben ist c bestimmt besser geeignet als vb/vba, java u.ä.
Gruß
Christian


  

Betrifft: AW: Kombinationen 16 aus 40 von: alifa
Geschrieben am: 07.07.2013 20:25:22

Hallo,
danke für die zunächst 2 Beiträge. Ich suche KOMBINATIONEN, nicht Variationen. Eine von diesen Milliarden von 16 aus 40 Kombinationen beinhaltet ganz sicher die Lösung! Mein Makro(Brute-Force),welches diese Kombinationen auf deren Mag. Quadrat Tauglichkeit prüft, braucht dafür etwa 30 Sek. Bei den etwa 17 Milliarden, die noch verbleiben, nach den mir bis jetzt bekannten Einschränkungen, dauert das ...auf alle Fälle, viel zu lange. 2011 hatte ich das doch noch lösen können. Dein Beitrag, Christian, hat mir damals geholfen.


  

Betrifft: Bestimmte Kombinationen 4 aus 40 von: Erich G.
Geschrieben am: 08.07.2013 01:40:17

Hi Erhard,
die folgende Prozedur gibt über 1,25 Mio. Lösungen aus:

Option Explicit

Sub aVierMalVier()
   Dim arA, arE(), tSum As Integer, zz As Long, nn As Long, cc As Long, gg As Long
   Dim ii As Byte, jj As Byte, kk As Byte, mm As Byte, tt As Byte, pp As Byte

   Const xAnz As Byte = 40
   Const xSum As Integer = 490
   
   arA = Application.Transpose(Cells(1, 1).Resize(xAnz))
   ReDim arE(1 To 4, 1 To 100)
   For ii = 1 To xAnz
      For jj = ii + 1 To xAnz
         If ii <> jj Then
            If arA(ii) + arA(jj) >= xSum - 2 Then Exit For
            For kk = jj + 1 To xAnz
               If ii <> kk And jj <> kk Then
                  If arA(ii) + arA(jj) + arA(kk) >= xSum - 1 Then Exit For
                  For mm = kk + 1 To xAnz
                     If ii <> mm And jj <> mm And kk <> mm Then
                        tSum = arA(ii) + arA(jj) + arA(kk) + arA(mm)
                        If tSum = xSum Then        ' Treffer
                           zz = zz + 1
                           If zz > UBound(arE, 2) Then ReDim Preserve _
                              arE(1 To UBound(arE), 1 To 2 * UBound(arE, 2))
                           arE(1, zz) = arA(ii)
                           arE(2, zz) = arA(jj)
                           arE(3, zz) = arA(kk)
                           arE(4, zz) = arA(mm)
                           DoEvents
                        ElseIf tSum > xSum Then
                           Exit For
                        End If
                     End If
                  Next mm
               End If
            Next kk
         End If
      Next jj
   Next ii
   Cells(1, 3).Resize(UBound(arE, 2), UBound(arE)) = Application.Transpose(arE)

   arA = Cells(1, 3).Resize(zz, 4)
   ReDim arE(1 To 100000, 1 To 16)
   cc = 8
   For ii = 1 To zz - 3
      For jj = ii + 1 To zz - 2
         For tt = 1 To 4
            For pp = 1 To 4
               If arA(jj, tt) = arA(ii, pp) Then Exit For
            Next pp
            If pp < 5 Then Exit For
         Next tt
         If tt > 4 Then
            For kk = jj + 1 To zz - 1
               For tt = 1 To 4
                  For pp = 1 To 4
                     If arA(kk, tt) = arA(ii, pp) Then Exit For
                     If arA(kk, tt) = arA(jj, pp) Then Exit For
                  Next pp
                  If pp < 5 Then Exit For
               Next tt
               If tt > 4 Then
                  For mm = kk + 1 To zz
                     For tt = 1 To 4
                        For pp = 1 To 4
                           If arA(mm, tt) = arA(ii, pp) Then Exit For
                           If arA(mm, tt) = arA(jj, pp) Then Exit For
                           If arA(mm, tt) = arA(kk, pp) Then Exit For
                        Next pp
                        If pp < 5 Then Exit For
                     Next tt
                     If tt > 4 Then             ' Treffer
                        If nn >= 100000 Then
                           Cells(gg * 100000 + 1, cc).Resize( _
                              UBound(arE), UBound(arE, 2)) = arE
                           ReDim arE(1 To 100000, 1 To 16)
                           If gg > 8 Then
                              gg = 0
                              cc = cc + 17
                           Else
                              gg = gg + 1
                           End If
                           nn = 0
                        End If
                        nn = nn + 1
                        For tt = 1 To 4
                           arE(nn, tt) = arA(ii, tt)
                           arE(nn, 4 + tt) = arA(jj, tt)
                           arE(nn, 8 + tt) = arA(kk, tt)
                           arE(nn, 12 + tt) = arA(mm, tt)
                        Next tt
                     End If
                  Next mm
               End If
            Next kk
         End If
         DoEvents
      Next jj
      Application.StatusBar = CStr(ii) & "  " & _
         CStr(nn + gg * 100000 + Int(cc / 17) * 1000000)
   Next ii
   If nn > 0 Then Cells(gg * 100000 + 1, cc).Resize(UBound(arE), UBound(arE, 2)) = arE
   Application.StatusBar = False
End Sub
Die Idee:
Zunächst werden aus den 40 Zahlen alle Vierer-Gruppen ermittelt, deren Summe 490 ist.
Das sind im Beispiel (39 Zahlen wie von dir vorgegeben und als 40. die 425 von mir dazugelogen)
185 Kombinationen (1+2+130+357 bis 85+125+130+150).

Im zweiten Schritt werden dann aus diesen 185 jeweils vier Vierer-Gruppen ausgewählt.
Treffer sind die Kombinationen, bei denen insgesamt keine Zahl doppelt vorkommt.

Die Ausgabe erfolgt etappenweise alle 100.000 Treffer, jeweils max. 1 Mio. untereinander.

Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich


  

Betrifft: AW: Bestimmte Kombinationen 4 aus 40 von: alifa
Geschrieben am: 08.07.2013 07:54:50

Hallo Erich,
die Zahl, die ich verschlampt hatte, ist die 38. Ich habe diese 40 Zahlen in die Tabelle, Zeile 1 eingetragen. Oder werden sie anders eingetragen? Die Prozedur funktioniert bei mir nicht, werde wohl etwas falsch verstanden haben. Die Zeile mit arA=Cells(1,3).Resize(zz,4) wird beanstandet. Das Problem bestand darin, die kleinste magische Summe zu finden. Wenn deine Prozedur relativ schnell ist, könnte man versuchen, die 490 kleiner zu setzen, mit weniger als 40 Zahlen. Wobei die größten gestrichen würden. Doch zunächst wäre es wunderbar, wenn mindestens eine gültige Lösung zustande kommt.
Gruß, Erhard


  

Betrifft: Bestimmte Kombinationen von: Erich G.
Geschrieben am: 08.07.2013 08:35:07

Guten Morgen, Erhard,
ja, die 40 Ausgangszahlen müssen in Spalte A (A1:A40) stehen, sonst kann's nicht klappen.

In C1:F168 schreibt die Prozedur (jetzt mit 38 statt 425) 168 Vierergruppen mit Summe 490.

In H1:W1000000 kommt die 1. Mio. Lösungen, in Y1:AN738428 kommen die restlichen 738.428.

Viel Spaß und Grüße aus Kamp-Lintfort von Erich


  

Betrifft: AW: Bestimmte Kombinationen von: alifa
Geschrieben am: 08.07.2013 11:15:05

Hallo Erich,
Du hast die Aufgabe meisterlich gelöst! Jetzt sind gute 1,7 Millionen Gruppen a 16 Zahlen auf die Tauglichkeit für das magische Quadrat 4x4 zu prüfen. Mein Makro braucht für eine Gruppe etwa 5 Sekunden. Das sind immer noch gute 100 Tage! Ich hatte fälschlicher Weise angenommen, dass es bedeutend weniger 16-er Gruppen gibt, die 4 Vierer-Gruppen mit der angegebenen Summe, ermöglichen. So viel ich weiß, gibt es keinen Algorithmus für magische Quadrate. Anscheinend muss die Anzahl der ungeraden Zahlen(der 16-er Gruppe) durch 4 restlos teilbar sein. Vielleicht lässt sich die Anzahl der 16-er Gruppen noch reduziereren...
Gruß, Erhard


 

Beiträge aus den Excel-Beispielen zum Thema "Kombinationen 16 aus 40"