[Solved] Combinations items

angel_

angel_

Well-Known Member
Licensed User
Longtime User
I have a problem that I think must be solved with recursion since I can't solve it with for loops

I have a array a = [a1,..., an], each element of the matrix can have the values of the matrix b = [m,...,p].

Example:

a = [a1, a2, a3] 3 dimensions
b = [0, 1, 2]

B4X: 
000
100
200
010
110
210
020
120
220
001
101
201
011
111
211
021
121
221
002
102
202
012
112
212
022
122
222
 
Last edited:
Sorry, I know the question is probably hard to explain, but I cannot see a question.
Are you trying to print the array of arrays?
Are you trying to calculate the product of the arrays?
 
Yes, the result would be all possible arrays a
B4X: 
(0,0,0)
(1,0,0)
(2,0,0)
(0,1,0)...
 
angel_ said:
I have a problem that I think must be solved with recursion since I can't solve it with for loops
Click to expand...
Actually it was Tony Hoare (I think - https://en.wikipedia.org/wiki/Tony_Hoare) who showed that the result of any recursive code can be achieved without the need for recursion and the programming language Occam (for the ill-fated Transputer processor) was designed to disallow recursion as there is always the risk of recursion running out of stack space and causing a system failure.

I can vaguely see a non-recursive solution to your problem but my mind is now too old and feeble to realise it as actual code ?
 
Last edited:
Try this ( I enjoyed coding this lol)

Code: 
    Dim inArray() As Int = Array As Int(0,1,2,3)
    Dim arLength As Int = inArray.length - 1
    Dim outText As String = ""
    Dim c(inArray.Length) As Int
    For Each thing In c
        thing = 0
    Next

    Do While c(0) <> inArray.Length
  
        outText = ""
        For Each thingy In c
            outText = outText & inArray(thingy)
        Next
        Log(outText)
        c(arLength) = c(arLength) + 1
        For t = arLength To 0 Step - 1
            If c(t) > arLength  And t > 0 Then
                c(t) = 0
                c(t - 1) = c(t - 1) + 1
            Else
                Exit
            End If
            Next
        Loop

If you change
Dim inArray() As Int = Array As Int(0,1,2,3)
to
Dim inArray() As Object = Array As Object("A","B","C","D","E")

it will work with any object :)
 
Last edited:
Thank you very much, now it's time to adapt the code (let's see if I get it)
 
The code works very well, but it may happen that the matrices have different dimensions, i.e. a = [a1, a2, a3, a4] with b = [7, 8, 9] (possible values of a), could the code be adapted?
 
Not 100% sure I understand.

So in your example in post #7
you give it 3 numbers to go into a 4 number result.
- you give it 7,8,9 but could get 7,7,8,9 as a result or 7,8,9,9 is that what you mean?
 
I think this does what you wanted ( If I guessed right )

Code: 
Sub AppStart (Args() As String)
    ' data for combinations
    Dim inArray() As Object = Array As Object (7,8,9)
    ' get combinations - the second value is how long each array will be so below will return a,b,c,d etc
    Dim result As List = CalculateCombinationsX(inArray,4)
    ' print them
    printCombinations(result)
End Sub

Sub CalculateCombinationsX(inputArray() As Object,resultSize As Int) As List
    Dim resSize As Int = resultSize - 1
    Dim c(resultSize) As Int
    Dim arLength As Int = inputArray.Length - 1

    Dim outputList As List
    outputList.Initialize

    ' initialize the counters  **ignore the unused 'thing' message in logs
    For Each thing As Object In c
        thing = 0
    Next

    ' calculate the combinations
    Do While c(0) <> inputArray.Length
        Dim cCounter As Int = 0
        Dim tempForItem(resultSize) As Object

        For Each thingy In c
            tempForItem(cCounter) = inputArray(thingy)
            cCounter = cCounter + 1
        Next

        ' add to outputList
        outputList.Add(tempForItem)
        ' update & check bounds
        c(resSize) = c(resSize) + 1

        For t = resSize To 0 Step - 1
            If c(t) > arLength  And t > 0 Then
                c(t) = 0
                c(t - 1) = c(t - 1) + 1
            Else
                Exit
            End If
        Next
    Loop
    Return outputList
End Sub



Sub printCombinations(theList As List)
    For Each item In theList
        Dim dummy() As Object = item  ' item is an array so move it to one
        Dim outText As String = ""
        For Each littleItem In dummy
            outText = outText & ", " & littleItem
        Next
        ' pretty output  (x, y, z, ...)
        Log("(" & outText.SubString(2) & ")")   ' substring to jump the ", " added at start
    Next
End Sub
 
Just FYI the output can also be smaller than the input array

in (7,8,9) and you tell it you want length 2 and you get 77,78,79,87,88,89,97,98,99 output.
 
For recursion I also recommend this thread:

[Solved] Combinations items

I have a problem that I think must be solved with recursion since I can't solve it with for loops I have a array a = [a1,..., an], each element of the matrix can have the values of the matrix b = [m,...,p]. Example: a = [a1, a2, a3] 3 dimensions b = [0, 1, 2] 000 100 200 010 110 210 020 120...
www.b4x.com www.b4x.com
 
angel_ said:
I have a problem that I think must be solved with recursion since I can't solve it with for loops

I have a array a = [a1,..., an], each element of the matrix can have the values of the matrix b = [m,...,p].
Click to expand...

You're looking for combinations and/or permutations. Search for those terms and you should get good results.
 
(ChatGPT say this. Sorry for spanish. )

Chat GPT :


dada una lista de 'n' elementos, hazme un programa en BASIC, que mueste todas las combinaciones posibles de 3 elementos.




Aquí tienes un programa en BASIC que muestra todas las combinaciones posibles de 3 elementos dados una lista de 'n' elementos:
basicCopiar código
B4X: 
10 PRINT "Ingrese la cantidad de elementos en la lista: ";
20 ENTRADA norte
30 PRINT "Ingrese los elementos de la lista separados por comas:"
40 INPUT lista$
50 DIM elementos$(n)
60 LET elementos$() = SPLIT(lista$, ",")
70 PARA i = 1 HASTA n - 2
80 PARA j = i + 1 A n - 1
90 PARA k = j + 1 PARA n
100 IMPRIMIR elementos$(i) + ", " + elementos$(j) + ", " + elementos$(k)
110 SIGUIENTE k
120 SIGUIENTE j
130 SIGUIENTE i
140 IMPRIMIR "Fin del programa."
Este programa solicitará la cantidad de elementos en la lista y luego pedirá al usuario que ingrese los elementos separados por comas. Luego, generará todas las combinaciones posibles de 3 elementos e imprimirá cada combinación en la pantalla.
Recuerda que BASIC no es sensible a mayúsculas, por lo que debes escribir el código en minúsculas o mayúsculas indistintamente.
Ten en cuenta que este programa asume que los elementos en la lista son únicos, es decir, no hay duplicados.
 
I wonder what it would try for 'n' elements and 'm' length combinations. ( I gave up on ChatGP - too many fairy-tale answers. Even Bing-Bot is going the same way).
 
The above solutions are nice and succinct. Here is a completely different approach, at the cost of simplicity.
But if you love math, this is a fast way to do permutations, without recursion and without checking for duplicates.

B4X: 
    Dim results As List
    results.Initialize
    Dim marker As Long = DateTime.Now
    Dim positions As Int = 4
    Dim b() As String = Array As String("man", "dog", "cat")
    Dim n As Int = Power(b.length, positions) - 1
    Dim d(positions) As Int
    For j = 0 To positions - 1
        d(j) = Power(b.length, positions - j - 1)
    Next
    For i = 0 To n
        Dim v As Int = i
        Dim a(positions) As Int
        For j = 0 To d.Length - 1
            a(j) = v / d(j)
            v = v - a(j) * d(j)
        Next
        results.Add(a)
    Next
    Log(DateTime.Now - marker)    '<1 msec
    For Each a() As Int In results
        Log(b(a(0)) & TAB & b(a(1)) & TAB & b(a(2)) & TAB & b(a(3)))
    Next
    '0
    'man    man    man    man
    'man    man    man    dog
    'man    man    man    cat
    'man    man    dog    man
    'man    man    dog    dog
    'man    man    dog    cat
    'man    man    cat    man
    'man    man    cat    dog
    'man    man    cat    cat
    'man    dog    man    man
    'etc
 
To be honest I don't know how I arrived at my solution code.

I commented that I couldn't see a question. Then I played some games - then I knew the solution.
That has happened so many times, if I get stuck on some code, I do something else, then I get the solution.

I think my inner me worked out it's just counting in base(length of input array), so no need for duplicate checks.
 
William Lancee said:
The above solutions are nice and succinct. Here is a completely different approach, at the cost of simplicity.
But if you love math, this is a fast way to do permutations, without recursion and without checking for duplicates.

B4X: 
    Dim results As List
    results.Initialize
    Dim marker As Long = DateTime.Now
    Dim positions As Int = 4
    Dim b() As String = Array As String("man", "dog", "cat")
    Dim n As Int = Power(b.length, positions) - 1
    Dim d(positions) As Int
    For j = 0 To positions - 1
        d(j) = Power(b.length, positions - j - 1)
    Next
    For i = 0 To n
        Dim v As Int = i
        Dim a(positions) As Int
        For j = 0 To d.Length - 1
            a(j) = v / d(j)
            v = v - a(j) * d(j)
        Next
        results.Add(a)
    Next
    Log(DateTime.Now - marker)    '<1 msec
    For Each a() As Int In results
        Log(b(a(0)) & TAB & b(a(1)) & TAB & b(a(2)) & TAB & b(a(3)))
    Next
    '0
    'man    man    man    man
    'man    man    man    dog
    'man    man    man    cat
    'man    man    dog    man
    'man    man    dog    dog
    'man    man    dog    cat
    'man    man    cat    man
    'man    man    cat    dog
    'man    man    cat    cat
    'man    dog    man    man
    'etc
Click to expand...
The code looks amazing I'm still studying it, if the outputs have 3 positions, it returns an error and if more than 4 positions are chosen, it only returns 4 positions.
 
That is just because I took a short cut in the display of the results part.
Replace code after Log(DateTime.Now - marker) '<1 msec with following.

B4X: 
   Dim sb As StringBuilder
   For Each a() As Int In results
        sb.Initialize
        For j = 0 To d.Length -1
            sb.Append(b(a(j))).Append(TAB)
        Next
        Log(sb.ToString)
    Next
 
You must log in or register to reply here.
Back
Top