Et spørgsmål om matematik

Jeg glemte at nævne at det IKKE nødvendigvis er tallene 1-Y.
Y er en talrække jeg har i et array.

Tja, det viste sig at være et interessant lille problem. :-)

Den kode jeg nåede frem til kommer her:

Sub testKombi3()
    Dim numre(5) As Integer
    Dim Arr As Variant

    'Definer indholdet af array med tal...
    numre(0) = 1
    numre(1) = 7
    numre(2) = 32
    numre(3) = 41
    numre(4) = 57
    numre(5) = 64
   
    Arr = KombinationsSæt(4, numre)
    PrintArr (Arr)
End Sub


Når jeg kører de fire testscenarier jeg har lavet, fremkommer følgende:

testkombi1
(1,2,3)(1,2,4)(1,2,5)(1,2,6)(1,3,4)(1,3,5)(1,3,6)(1,4,5)(1,4,6)(1,5,6)(2,3,4)(2,3,5)(2,3,6)(2,4,5)(2,4,6)(2,5,6)(3,4,5)(3,4,6)(3,5,6)(4,5,6)
testkombi2
(1,7,32)(1,7,41)(1,7,57)(1,7,64)(1,32,41)(1,32,57)(1,32,64)(1,41,57)(1,41,64)(1,57,64)(7,32,41)(7,32,57)(7,32,64)(7,41,57)(7,41,64)(7,57,64)(32,41,57)(32,41,64)(32,57,64)(41,57,64)
testkombi3
(1,7,32,41)(1,7,32,57)(1,7,32,64)(1,7,41,57)(1,7,41,64)(1,7,57,64)(1,32,41,57)(1,32,41,64)(1,32,57,64)(1,41,57,64)(7,32,41,57)(7,32,41,64)(7,32,57,64)(7,41,57,64)(32,41,57,64)
testkombi4
(1,7,32,41)(1,7,32,57)(1,7,32,64)(1,7,32,71)(1,7,32,89)(1,7,41,57)(1,7,41,64)(1,7,41,71)(1,7,41,89)(1,7,57,64)(1,7,57,71)(1,7,57,89)(1,7,64,71)(1,7,64,89)(1,7,71,89)(1,32,41,57)(1,32,41,64)(1,32,41,71)(1,32,41,89)(1,32,57,64)(1,32,57,71)(1,32,57,89)(1,32,64,71)(1,32,64,89)(1,32,71,89)(1,41,57,64)(1,41,57,71)(1,41,57,89)(1,41,64,71)(1,41,64,89)(1,41,71,89)(1,57,64,71)(1,57,64,89)(1,57,71,89)(1,64,71,89)(7,32,41,57)(7,32,41,64)(7,32,41,71)(7,32,41,89)(7,32,57,64)(7,32,57,71)(7,32,57,89)(7,32,64,71)(7,32,64,89)(7,32,71,89)(7,41,57,64)(7,41,57,71)(7,41,57,89)(7,41,64,71)(7,41,64,89)(7,41,71,89)(7,57,64,71)(7,57,64,89)(7,57,71,89)(7,64,71,89)(32,41,57,64)(32,41,57,71)(32,41,57,89)(32,41,64,71)(32,41,64,89)(32,41,71,89)(32,57,64,71)(32,57,64,89)(32,57,71,89)(32,64,71,89)(41,57,64,71)(41,57,64,89)(41,57,71,89)(41,64,71,89)(57,64,71,89)

Jeg synes det ser rigtigt ud, men det er jo ikke mig der skal bedømme det...

Hov, koden blev ikke kopieret ind. Her kommer den....

Option Compare Database
Option Explicit

Function KombinationsSæt(SætAntal As Integer, KombinationsElementer As Variant) As Variant
    Dim AntalKombinationer As Integer
    Dim AntalKombinationsElementer As Integer
    Dim x As Integer, y As Integer, y1 As Integer, z As Integer
    Dim Ændret As Boolean
    If IsArray(KombinationsElementer) Then
        AntalKombinationer = 1
        AntalKombinationsElementer = UBound(KombinationsElementer) + 1
        For x = 1 To SætAntal
            y = AntalKombinationsElementer - x + 1
            AntalKombinationer = AntalKombinationer * y / x
        Next x
        ReDim KombiSæt(AntalKombinationer - 1, SætAntal - 1) As Integer
        ReDim kombital(AntalKombinationer - 1, SætAntal - 1) As Integer
       
        For x = 0 To (AntalKombinationer - 1)
            For y = (SætAntal - 1) To 0 Step -1
                Ændret = False
                If x = 0 Then
                    z = y
                    Ændret = True
                ElseIf kombital(x - 1, y) < UBound(KombinationsElementer) Then
                    z = kombital(x - 1, y) + 1
                    Ændret = True
                ElseIf y > 0 Then
                    'Søg efter det ciffer der kan inkrementeres...
                    For y1 = y To 0 Step -1
                        If kombital(x - 1, y1) < (UBound(KombinationsElementer) - (SætAntal - 1 - y1)) Then
                            y = y1
                            z = kombital(x - 1, y) + 1
                            Ændret = True
                            Exit For
                        End If
                    Next y1
                End If
                If Ændret = True Then
                    KombiSæt(x, y) = KombinationsElementer(z)
                    kombital(x, y) = z
                    If x > 0 Then
                        For y1 = 0 To (SætAntal - 1)
                            If y1 < y Then
                                'Kopier elementet fra foregående samling...
                                z = kombital(x - 1, y1)
                            ElseIf y1 = y Then
                                'Rør ikke ved elentet...
                                z = kombital(x, y1)
                            ElseIf y1 > y Then
                                'Elementet skal være 1 større end foregående element i samme samling...
                                z = kombital(x, y1 - 1) + 1
                            End If
                            kombital(x, y1) = z
                            KombiSæt(x, y1) = KombinationsElementer(z)
                        Next y1
                        Exit For
                    End If
                End If
            Next y
        Next x
    End If
    KombinationsSæt = KombiSæt()
End Function
Sub PrintArr(Arr As Variant)
    Dim x As Integer, y As Integer
    Dim prt As String
    For x = 0 To UBound(Arr, 1)
        For y = 0 To UBound(Arr, 2)
            prt = prt & IIf(y > 0, ",", "(") & CStr(Arr(x, y))
        Next y
        prt = prt & ")"
    Next x
    Debug.Print prt
End Sub
Sub testKombi1()
    Dim numre(5) As Integer
    Dim Arr As Variant

    'Definer indholdet af array med tal...
    numre(0) = 1
    numre(1) = 2
    numre(2) = 3
    numre(3) = 4
    numre(4) = 5
    numre(5) = 6
   
    Arr = KombinationsSæt(3, numre)
    PrintArr (Arr)
End Sub
Sub testKombi2()
    Dim numre(5) As Integer
    Dim Arr As Variant

    'Definer indholdet af array med tal...
    numre(0) = 1
    numre(1) = 7
    numre(2) = 32
    numre(3) = 41
    numre(4) = 57
    numre(5) = 64
   
    Arr = KombinationsSæt(3, numre)
    PrintArr (Arr)
End Sub
Sub testKombi3()
    Dim numre(5) As Integer
    Dim Arr As Variant

    'Definer indholdet af array med tal...
    numre(0) = 1
    numre(1) = 7
    numre(2) = 32
    numre(3) = 41
    numre(4) = 57
    numre(5) = 64
   
    Arr = KombinationsSæt(4, numre)
    PrintArr (Arr)
End Sub
Sub testKombi4()
    Dim numre(7) As Integer
    Dim Arr As Variant

    'Definer indholdet af array med tal...
    numre(0) = 1
    numre(1) = 7
    numre(2) = 32
    numre(3) = 41
    numre(4) = 57
    numre(5) = 64
    numre(6) = 71
    numre(7) = 89
   
    Arr = KombinationsSæt(4, numre)
    PrintArr (Arr)
End Sub

Et alternativt approach:

Function CombiHelp(prefix As String, posleft As Integer, maxno As Integer, start As Integer) As String
    Dim res As String
    Dim i As Integer
    res = ""
    For i = start To maxno - posleft + 1
        If posleft > 1 Then
            res = res & CombiHelp(prefix & i & ",", posleft - 1, maxno, i + 1)
        Else
            res = res & prefix & i & ")"
        End If
    Next
    CombiHelp = res
End Function

Function Combi(x As Integer, y As Integer) As String
    Combi = CombiHelp("(", x, y, 1)
End Function

Det er testet i VBA,

Kombinationer og permutationer løses næsten altid bedst rekursivt.

Jeg lod den bare returnere String, men den rekursive metode kan naturligvis også bruges
til at returnere et array.

Hej kjulius og Arne

I skal have tak for svarene.
Jeg skriver dette fra en vens PC, som ikke har VB installeret (selvom han godtnok har officepakken). Jeg vender tilbage i aften, når jeg har fået testet jeres svar.

>> Arne:  Jeg havde selv en mistanke om, at det skulle være rekursivt, hvilket er grunden til at jeg i det hele taget stillede spørgsmålet, da rekursive funktioner og jeg aldrig rigtig er blevet venner..... ;)

/tjacob

Mig faldt den rekursive metode slet ikke ind, men den har jeg nu også altid haft det lidt svært med. Jeg arbejder normalt ikke med noget, hvor jeg kan bruge den metode. Men det gik jo også uden! - selv om koden blev lidt længere. Men vi har jo heller ikke læst opgaven på helt samme måde.

Hej igen

>>Kjulius:    Jeg har ikke testet din metode, da Arnes er noget kortere, og mere elegant.
Din funktion giver imidlertid det korrekte svar, og jeg er sikker på at den virker efter hensigten, så du får de 10 point for besværet.

>>Arne:        Som du kan se nedenfor har jeg modificeret din funktion, så man kan inputte et Integer array, og så  funktionen outputter et 2-dim Integer array, hvilket netop er hvad jeg har brug for.

Tak for hjælpen begge to!!! Vil i lægge nogle svar.

Her er min modifikation af Arnes funktion(er):
Det er vigtigt at det array man inputter er i base 1!

Function Combi(x As Integer, y() As Integer) As Integer()
    Dim i As Integer, j As Integer, iOutArr() As Integer
    Dim sIn As String, sNumCombi() As String, sTmpArr() As String

    sIn = CombiHelp("", x, y, 1)
    sNumCombi = Split(sIn, "/")
    ReDim iOutArr(1 To UBound(sNumCombi), 1 To x)
    For i = 0 To (UBound(sNumCombi) - 1)
        sTmpArr = Split(sNumCombi(i), ",")
        For j = 0 To (x - 1)
            iOutArr(i + 1, j + 1) = CInt(sTmpArr(j))
        Next j
    Next i
    Combi = iOutArr

End Function

Function CombiHelp(prefix As String, posleft As Integer, maxno() As Integer, start As Integer) As String
    Dim res As String, i As Integer

    res = ""
    For i = start To UBound(maxno) - posleft + 1
        If posleft > 1 Then
            res = res & CombiHelp(prefix & maxno(i) & ",", posleft - 1, maxno, i + 1)
        Else
            res = res & prefix & maxno(i) & "/"
        End If
    Next
    CombiHelp = res

End Function

Okay... :-)

Nu vil jeg undgå String->Integer hvis muligt.

Derfor:

Function Fac(n As Integer) As Long
    If n > 1 Then
        Fac = n * Fac(n - 1)
    Else
        Fac = 1
    End If
End Function

Sub Combi2Help(posleft As Integer, y() As Integer, start As Integer, res() As Integer, ix As Integer, tmp() As Integer)
    Dim i, j As Integer
    For i = start To UBound(y) - posleft
        tmp(UBound(tmp) - posleft) = y(i)
        If posleft > 1 Then
            Call Combi2Help(posleft - 1, y, i + 1, res, ix, tmp)
        Else
            For j = LBound(tmp) To UBound(tmp)
                res(ix, j) = tmp(j)
            Next
            ix = ix + 1
        End If
    Next
End Sub

Function Combi2(x As Integer, y() As Integer) As Integer()
    Dim res() As Integer
    Dim tmp() As Integer
    ReDim res(Fac(UBound(y) - LBound(y) + 1) \ (Fac(UBound(y) - LBound(y) + 1 - x) * Fac(x)), x)
    ReDim tmp(x)
    Call Combi2Help(x, y, LBound(y), res, 0, tmp)
    Combi2 = res
End Function

Og et svar.

Excellent......

Hej igen Arne:

Dine sidste funktioner kan jeg ikke rigtig få til at virke:

1. Der bliver outputtet et ekstra 0 i hver kombination -det kan jeg godt selv rette.

2. Det er kun den første iteration der er korrekt, altså den hvor kombinationerne starter med det første tal i y(). Resten bliver bare 0. Da jeg som nævnt ikke er nogen ørn til rekursive funktioner, kan jeg ikke lige overskue hvor problemet er.
Gider du kigge på dem igen.

Hej igen,igen Arne - jeg fandt selv fejlen:

i Combi2Help skal denne linie:

For i = start To UBound(y) - posleft  rettes til:

For i = start To UBound(y) - posleft + 1