Question

My goal is simple, I am trying to generate a list of all possible combinations for a product in a database.

So for example; the product options are as follows

  • Product Option: Color / Values: Red, Green, Blue
  • Product Option: Size/ Values: Small, Med, Large, XL
  • Product Option: Style / Values: Men, Women

I want to be able to auto generate every single combination of all 3:

Small, Red, Mens
Small, Green, Mens
Small, Blue, Mens
etc

I need the function to work whether I pass 2,3,4 or 5 arrays into it.

I've done quite a bit of research and came across the following articles but have been unable to accomplish my goal.

The articles I found are as follows:

Was it helpful?

Solution

Adapting code from Eric Lippert's blog on Cartesian products:

Private Function CartesianProduct(Of T)(ParamArray sequences As T()()) As T()()

    ' base case: 
    Dim result As IEnumerable(Of T()) = {New T() {}}
    For Each sequence As var In sequences
        Dim s = sequence
        ' don't close over the loop variable 
        ' recursive case: use SelectMany to build the new product out of the old one 
        result = From seq In result
                 From item In s
                 Select seq.Concat({item}).ToArray()
    Next
    Return result.ToArray()
End Function

Usage:

Dim s1 As String() = New String() {"small", "med", "large", "XL"}
Dim s2 As String() = New String() {"red", "green", "blue"}
Dim s3 As String() = New String() {"Men", "Women"}

Dim ss As String()() = CartesianProduct(s1, s2, s3)

OTHER TIPS

Three loops one inside the other should do the trick.

So pseudo code...

For each value in sex array
    For each value in size array
        For each value in colour array
          Output sex, size, colour values
        Next colour
    Next size
Next sex

Updated Psudo

Sub ouputOptions(array1, array2, array3, array4, array5)
    For each value in array1
        For each value in array2
            If array3 Not Nothing Then
                For each value in array3
                    If array4 Not Nothing Then
                        For each value in array4
                            If array5 Not Nothing Then
                                For each value in array5
                                    output array1, array2, array3, array4, array5 values
                                next array5
                            Else
                                Output array1, array2, array3, array4 values
                            End if
                        Next array4
                    Else
                        Output array1, array2, array3 values
                    End if
                next array3
            Else
                Output array1, array2 values
            End if
        Next array2
    Next array1
End Sub

You would need to specify array3 to 5 as Optional

You can achieve this with a bit of recursion.

The following ends up returning an array of arrays of strings.

Public class Permuter

    Public Function Permute(ParamArray toPermute As String()()) As String()()

        Return DoPermute(Nothing, toPermute)

    End Function

    ''' <summary>
    ''' Permute the first two arrays,then pass that, and the remainder recursively
    ''' </summary>
    Private Function DoPermute(working As String()(), toPermute As String()()) As String()()

        Dim nextWorking As String()()

        If working Is Nothing Then

            'Make a new working list
            nextWorking = (From a In toPermute(0)
                       Select {a}).ToArray

        Else

            'Combine from the next working list
            nextWorking = (From a In working, b In toPermute(0)
                          Select a.Concat({b}).ToArray).ToArray

        End If

        If toPermute.Length > 1 Then

            'Go Around again

            Dim nextPermute = toPermute.Skip(1).ToArray

            Return DoPermute(nextWorking, nextPermute)

        Else

            'We're done
            Return nextWorking

        End If

    End Function

End Class

Call the public method as:

Dim permuter = New Permuter
Dim permutations = permuter.Permute({"a", "b", "c"}, {"1", "2", "3"}, {"x", "y", "z"})

Update: Taking on @DStanley's Eric Lippert blog reference, the following is a conversion of the accumulator method mentioned on that post:

Public Function CartesianProduct(Of T)(ParamArray sequences As T()()) As IEnumerable(Of IEnumerable(Of T))

    Dim emptyProduct As IEnumerable(Of IEnumerable(Of T)) = {Enumerable.Empty(Of T)()}

    Return sequences.Aggregate(
            emptyProduct,
            Function(accumulator, sequence) _
                From accseq In accumulator, item In sequence
                Select accseq.Concat({item})
        )

End Function

Note that this returns lazy queries, rather than an expanded set of arrays.

Recursion is sometimes the wrong way to go.

If you don't want to use recursion (afraid of StackOverflow exceptions?), you can do it like this:

List<List<string>> Combine(List<List<string>> lists)
{
    List<List<string>> result = new List<List<string>>();
    var arrayIndexes = new int[lists.Count]; 
    result.Add(GetCurrentItem(lists, arrayIndexes));
    while (!AllIndexesAreLast(lists, arrayIndexes))
    {
        for (int i = arrayIndexes.Length - 1; i >= 0; i--)
        {
            arrayIndexes[i] = (arrayIndexes[i] + 1) % lists[i].Count;
            if (arrayIndexes[i] != 0)
            {
                break;
            }
        }
        result.Add(GetCurrentItem(lists, arrayIndexes));
    } 

    return result;
}

List<string> GetCurrentItem(List<List<string>> lists, int[] arrayIndexes)
{
    var item = new List<string>();
    for (int i = 0; i < lists.Count; i++)
    {
        item.Add(lists[i][arrayIndexes[i]]);
    }
    return item;
}

bool AllIndexesAreLast(List<List<string>> lists, int[] arrayIndexes)
{
    for (int i = 0; i < arrayIndexes.Length; i++)
    {
        if (lists[i].Count - 1 != arrayIndexes[i])
        {
            return false;
        }
    }
    return true;
}

And you can use it like this:

var shirts = new List<List<string>>()
{
    new List<string>() {"colour", "red", "blue", "green", "yellow"},
    new List<string>() {"cloth", "cotton", "poly", "silk"},
    new List<string>() {"type", "full", "half"}
};
var result = Combine(shirts);

(I think) I needed the exact same thing, but I couldn't quite find exactly what I needed amongst the answers (mainly because they were in languages I don't know, I guess).

I came with this (The function itself):

Public Function nChooseK(Of T)(ByVal Values As List(Of T), ByVal k As Integer, Optional ByRef Result As List(Of List(Of T)) = Nothing, Optional ByRef CurCombination As List(Of T) = Nothing, Optional ByVal Offset As Integer = 0) As List(Of List(Of T))
    Dim n = Values.Count
    If CurCombination Is Nothing Then CurCombination = New List(Of T)
    If Result Is Nothing Then Result = New List(Of List(Of T))

    If k <= 0 Then
        Result.Add(CurCombination.ToArray.ToList)
        Return Result
    Else
        For i = Offset To n - k
            CurCombination.Add(Values(i))
            nChooseK(Values, k - 1, Result, CurCombination, i + 1)
            CurCombination.RemoveAt(CurCombination.Count - 1)
        Next

        Return Result
    End If

End Function

All one needs to do is put it in a module (or just above/below the sub/function which calls it I guess) and call it with any kind of variable and a number

How to call it:

nChooseK(List, kInteger)

Small example:

Dim NumbersCombinations As List(Of List(Of Integer)) = nChooseK(lstNumbers, k)

Full example for use with Integers and Strings along with printing the result to the screen:

        Dim Numbers() As Integer = {1, 2, 3, 4, 5}
    Dim lstNumbers = New List(Of Integer)
    Dim k = 3
    lstNumbers.AddRange(Numbers)

    Dim NumbersCombinations As List(Of List(Of Integer)) = nChooseK(lstNumbers, k)

    Dim sbCombinations1 As New StringBuilder
    For i = 0 To NumbersCombinations.Count - 1
        sbCombinations1.AppendLine()
        For j = 0 To NumbersCombinations(i).Count - 1
            sbCombinations1.Append(NumbersCombinations(i)(j) & " ")
        Next
        sbCombinations1.Length = sbCombinations1.Length - 1
    Next
    MsgBox(sbCombinations1.ToString)



    Dim lstNoumera = New List(Of String)
    lstNoumera.AddRange({"ena", "dio", "tria", "tessera", "pente"})

    Dim Combinations As List(Of List(Of String)) = nChooseK(lstNoumera, k)

    Dim sbCombinations2 As New StringBuilder
    For i = 0 To Combinations.Count - 1
        sbCombinations2.AppendLine()
        For j = 0 To Combinations(i).Count - 1
            sbCombinations2.Append(Combinations(i)(j) & " ")
        Next
        sbCombinations2.Length = sbCombinations2.Length - 1
    Next
    MsgBox(sbCombinations2.ToString)
Licensed under: CC-BY-SA with attribution
Not affiliated with StackOverflow
scroll top