current community

your communities

more stack exchange communities

company blog
Stack Exchange Inbox Reputation and Badges
tour help
Code Review Stack Exchange is a question and answer site for peer programmer code reviews. Join them; it only takes a minute:

Sign up
Here's how it works:
  1. Anybody can ask a question
  2. Anybody can answer
  3. The best answers are voted up and rise to the top
up vote 3 down vote favorite

I'm trying to make a VBA code to arrange k-element subset of an n-set into some sequence. In other word, I'm trying to list all of k-permutations of n member set. For example, let's try to list all of 2-permutations of set {A,B,C} where each characters are located in the cells of Range("A1:C1"). Here are all the permutations: 

{A,B}       {A,C}       {B,A}       {B,C}       {C,A}       {C,B}

The following code to implement the above task works fine if there's no duplicate in each of characters of data input:

Sub Permutation()
Dim Data_Input As Variant, Permutation_Output As Variant
Dim Output_Row As Long, Last_Column As Long

Rows("2:" & Rows.Count).Clear
Last_Column = Cells(1, Columns.Count).End(xlToLeft).Column
Data_Input = Application.Transpose(Application.Transpose(Range("A1", Cells(1, Last_Column))))

k = InputBox("Input the value of k for P(" _
    & UBound(Data_Input) & " , k) where k is an integer between 2 and " _
    & UBound(Data_Input) & " inclusive.", "Permutation", 1)

If k >= 2 And k <= UBound(Data_Input) Then
    Output_Row = 2
    ReDim Permutation_Output(1 To k)
    Call Permutation_Generator(Data_Input, Permutation_Output, Output_Row, 1)
Else
    MsgBox "The input [" & k & "] is invalid. The input must be an integer between 2 and " _
    & UBound(Data_Input) & " inclusive."
End If

End Sub

Function Permutation_Generator(Data_Input As Variant, Permutation_Output As Variant, _
                               Output_Row As Long, Output_Index As Integer)
Dim i As Long, j As Long, P As Boolean

For i = 1 To UBound(Data_Input)
    P = True
    For j = 1 To Output_Index - 1
        If Permutation_Output(j) = Data_Input(i) Then
            P = False
            Exit For
        End If
    Next j
    If P Then
        Permutation_Output(Output_Index) = Data_Input(i)
        If Output_Index = k Then
            Output_Row = Output_Row + 1
            Range("A" & Output_Row).Resize(, k) = Permutation_Output
        Else
            Call Permutation_Generator(Data_Input, Permutation_Output, Output_Row, Output_Index + 1)
        End If
    End If
Next i
End Function

I am hoping I can get some help to improve its performance and to better its algorithm in order to make a good partial anagram generator, i.e. it must be able to work if there are the duplicate characters. For example, let's test to list all of characters in my name: ANA. The output should be ANA, AAN, and NAA, but my code returns nothing. For 2-permutations of my name should be AN, AA, and NA yet my code returns AN, NA, AN, and NA. I have a feeling the culprit is the following statements:

        If Permutation_Output(j) = Data_Input(i) Then
            P = False
            Exit For
        End If

though I'm not so sure. I'd be eternally grateful if someone here could help me.

share|improve this question
2  
If you're looking for a review of your original, working code, then you've found the right place. However, as the site is aimed at working code, a review of your second attempt (including what's wrong with it) is off topic and may be more suited to stackoverflow. Please edit your question to make it clear if you are just after a review of the first snippet. – forsvarir Jul 27 '16 at 11:05
    
@pacmaninbw That's weird since users there suggested me to post it here. – Anastasiya-Romanova 秀 Jul 27 '16 at 11:08
    
@forsvarir Could you help me to edit it? Sorry, I'm new here. You may omit the second code. I'm OK with only the first method to be reviewed. Thanks. – Anastasiya-Romanova 秀 Jul 27 '16 at 11:10
    
@pacmaninbw No, I didn't. You may also edit my question so that can fit this site. Thank you. – Anastasiya-Romanova 秀 Jul 27 '16 at 11:30
    
@Anastasiya-Romanova秀 There are some SO users who understand CR very well and are great at directing good questions over here with guidance where appropriate. There are far more who see the words "Code Review" and assume it's some kind of dumping ground for "general review of some piece of code". Sounds like you got one of the latter. – Kaz Jul 27 '16 at 14:17
up vote 1 down vote

The following code works fine and faster than the previous one to obtain all of k-permutations provided there's no duplicate data in the input. I use an array as the output in the loop instead of the range of cells. It's usually considered to be faster than working on the range of cells. This code also gives two different choices of output. See the comment for the clarity.

Dim k As Long, Permutation_Table
Sub Permutation()
Dim Data_Input, Permutation_Output
Dim Output_Row As Long, Last_Column As Long, Array_Row As Long

Rows("2:" & Rows.Count).Clear
Last_Column = Cells(1, Columns.Count).End(xlToLeft).Column
Data_Input = Application.Transpose(Application.Transpose(Range("A1", Cells(1, Last_Column))))

k = InputBox("Input the value of k for P(" _
    & UBound(Data_Input) & " , k) where k is an integer between 2 and " _
    & UBound(Data_Input) & " inclusive.", "Permutation", 1)

Array_Row = WorksheetFunction.Fact(k) * WorksheetFunction.Combin(UBound(Data_Input), k)

ReDim Permutation_Table(1 To Array_Row, 1 To k)

If k >= 2 And k <= UBound(Data_Input) Then
    ReDim Permutation_Output(1 To k)
    Call Permutation_Generator(Data_Input, Permutation_Output, Output_Row, 1)
Else
    MsgBox "The input [" & k & "] is invalid. The input must be an integer between 2 and " _
    & UBound(Data_Input) & " inclusive."
End If
Range("A3").Resize(Array_Row, k) = Permutation_Table    'Use this line if UBound(Data_Input) < 10
End Sub

Function Permutation_Generator(Data_Input As Variant, Permutation_Output As Variant, _
                               Output_Row As Long, Output_Index As Integer)
Dim i As Long, j As Long, P As Boolean

For i = 1 To UBound(Data_Input)
    P = True
    For j = 1 To Output_Index - 1
        If Permutation_Output(j) = Data_Input(i) Then
            P = False
            Exit For
        End If
    Next j
    If P Then
        Permutation_Output(Output_Index) = Data_Input(i)
        If Output_Index = k Then
            Output_Row = Output_Row + 1
            For n = 1 To k
                Permutation_Table(Output_Row, n) = Permutation_Output(n)
            Next n
            Debug.Print Join(Permutation_Output, ",")    'Optional, use this line as the output if UBound(Data_Input) > 9
        Else
            Call Permutation_Generator(Data_Input, Permutation_Output, Output_Row, Output_Index + 1)
        End If
    End If
Next i
End Function
share|improve this answer

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.