Permutation of an array
in [Visual Basic]
|
From: Gary Pollard on 1 Jul 2010 07:15 I am looking for information on the permutation of an array. I have searched this website and have not found what I am looking for. There are many articles that will figure out all possible combinations of a string but they all return strings in which characters are repeated. EG: 1234 will return 1224 etc. I am looking for information on how to only list combinations that use the characters in the string the same number of times that they are in the original string. I did find an article at (http://www.vbi.org/Items/article.asp?id=133) that sounds promising but the link to download the source code (http://www.vbi.org/Items/link.asp?id=355) comes back with an error saying unable to connect. All messages and emails to the various links on the vbi.org site have been returned as undeliverable. Any help with the logic on how to code the above or any information on the vbi.org code sample is greatly appreciated
From: Larry Serflaten on 1 Jul 2010 08:06 "Gary Pollard" <GaryPollard(a)discussions.microsoft.com> wrote > I am looking for information on the permutation of an array. I have searched > this website and have not found what I am looking for. There are many > articles that will figure out all possible combinations of a string but they > all return strings in which characters are repeated. > EG: 1234 will return 1224 etc. We had someone here at the start of last month looking for something very similar. You can view the whole thread if you want to see how it progressed (from what you state above) to something of a scrabble shuffler. (Which is about what you are asking for....) One solution can be found here: http://groups.google.com/group/microsoft.public.vb.general.discussion/msg/de54b7c3ed172019?hl=en HTH LFS
From: Steve on 1 Jul 2010 08:57 "Gary Pollard" <GaryPollard(a)discussions.microsoft.com> wrote in message news:2F6C43D1-6648-45FA-9FB2-3EF71143DE4F(a)microsoft.com... > I am looking for information on the permutation of an array. I have > searched > this website and have not found what I am looking for. There are many > articles that will figure out all possible combinations of a string but > they > all return strings in which characters are repeated. > EG: 1234 will return 1224 etc. > > I am looking for information on how to only list combinations that use the > characters in the string the same number of times that they are in the > original string. > > I did find an article at (http://www.vbi.org/Items/article.asp?id=133) > that > sounds promising but the link to download the source code > (http://www.vbi.org/Items/link.asp?id=355) comes back with an error saying > unable to connect. > All messages and emails to the various links on the vbi.org site have been > returned as undeliverable. > > Any help with the logic on how to code the above or any information on the > vbi.org code sample is greatly appreciated > Not really sure what you want...the code for the example on the article you mention is listed directly in the article. All that is required is to call the code. Assuming that your issue was in not understanding how to implement the functions presented in the article, I went ahead and threw together a quick example. Simply start up VB, start a new standard exe project and place the following code in the form that is created by default...then run the app. Option Explicit Private lblCaption As VB.Label Private txtNumElements As VB.TextBox Private lstPermutations As VB.ListBox Private WithEvents cmdChars As VB.CommandButton Private WithEvents cmdNums As VB.CommandButton Private Sub Form_Load() Me.Visible = False Set lblCaption = Me.Controls.Add("VB.Label", "lblCaption", Me) Set txtNumElements = Me.Controls.Add("VB.TextBox", "txtNumElements", Me) Set lstPermutations = Me.Controls.Add("VB.ListBox", "lstPermutations", Me) Set cmdChars = Me.Controls.Add("VB.CommandButton", "cmdChars", Me) Set cmdNums = Me.Controls.Add("VB.CommandButton", "cmdNums", Me) lblCaption.Move 120, 180, 2115, 255 lblCaption.Caption = "Number of elements:" lblCaption.Visible = True txtNumElements.Move 2400, 180, 3255, 315 txtNumElements.Text = "0" txtNumElements.Visible = True lstPermutations.Move 120, 660, 5535, 6300 lstPermutations.Clear lstPermutations.Visible = True cmdChars.Move 5880, 180, 1215, 495 cmdChars.Caption = "Permutate characters" cmdChars.Visible = True cmdNums.Move 5880, 840, 1215, 495 cmdNums.Caption = "Permutate numbers" cmdNums.Visible = True Me.Width = 7530 Me.Height = 7815 Me.Visible = True End Sub Private Sub cmdNums_Click() DoPermutations False End Sub Private Sub cmdChars_Click() DoPermutations True End Sub Private Sub DoPermutations(Optional blnAsChars As Boolean = False) Dim i As Long Dim lngNumElems As Long Dim Elems() As Long Dim Order() As Long Dim Orders As New Collection Dim Item As Variant Dim strTemp As String lstPermutations.Clear lngNumElems = Val(txtNumElements.Text) ReDim Elems(1 To lngNumElems) ReDim Order(1 To lngNumElems) For i = 1 To lngNumElems If blnAsChars Then Elems(i) = 96 + i Else Elems(i) = i End If Next Permutate lngNumElems, Elems(), Order(), Orders For Each Item In Orders strTemp = vbNullString For i = LBound(Item) To UBound(Item) If blnAsChars Then strTemp = strTemp & Chr(Item(i)) Else strTemp = strTemp & Item(i) End If Next lstPermutations.AddItem strTemp Next End Sub Public Sub Permutate( _ ByVal ArrayCount As Long, _ ByRef Elements() As Long, _ ByRef Order() As Long, _ ByRef Orders As Collection) Dim Position As Long Dim Element As Long Dim i As Long Dim ArrayLen As Long ' The length of the Elements array. We need this ' for our calculations later on. ArrayLen = (UBound(Elements) - LBound(Elements) + 1) ' Position in the Order array of the first element in ' the permutated arrays. ' ' Example: Given the array(a,b,c,d), where we want to permutate ' (b,c,d), the position in the new array for the first element ' will be 2 (since (a) will take up the first position). ' Likewise, when we permutate (c,d), the position of the first ' element will be 3, since the first two spots are taken by ' (a,b). Position = ArrayCount - ArrayLen + 1 If ArrayLen = 1 Then ' The most primitive array we will permutate. ' The result is the array itself, and the result ' is inserted in the last position of the Order array. Order(Position) = Elements(LBound(Elements)) ' This Order is now complete, since the final element has ' been filled in. Orders.Add Order Else ' The permutation of Elements is each distinct Element ' + all permutations of the remaining elements. For i = LBound(Elements) To UBound(Elements) Element = Elements(i) Order(Position) = Element Permutate ArrayCount, RemoveFromArray(Elements, Element), Order, Orders Next i End If End Sub Public Function RemoveFromArray(ByRef Elements() As Long, ByVal Element As Long) As Long() Dim NewArray() As Long Dim i As Long Dim newi As Long ' Will create a new array where Element has been left out. ReDim NewArray(LBound(Elements) To UBound(Elements) - 1) For i = LBound(Elements) To UBound(Elements) If Elements(i) <> Element Then newi = newi + 1 NewArray(newi) = Elements(i) End If Next RemoveFromArray = NewArray End Function
From: Gary Pollard on 1 Jul 2010 11:18 This works well if the number of character in the sting is 8 or less, processed a 8 character sting in about 1.5 minutes. If I go to a 9 character string the project window goes blank and it appears that it is some kind of endless loop. I stopped it after 15 minutes. I am about to try Steve's solution. Thanks for your input. Gary "Larry Serflaten" wrote: > > "Gary Pollard" <GaryPollard(a)discussions.microsoft.com> wrote > > I am looking for information on the permutation of an array. I have searched > > this website and have not found what I am looking for. There are many > > articles that will figure out all possible combinations of a string but they > > all return strings in which characters are repeated. > > EG: 1234 will return 1224 etc. > > We had someone here at the start of last month looking for something > very similar. You can view the whole thread if you want to see how it > progressed (from what you state above) to something of a scrabble > shuffler. (Which is about what you are asking for....) > > One solution can be found here: > http://groups.google.com/group/microsoft.public.vb.general.discussion/msg/de54b7c3ed172019?hl=en > > HTH > LFS > > > . >
From: Jason Keats on 1 Jul 2010 12:05 Gary Pollard wrote: > This works well if the number of character in the sting is 8 or less, > processed a 8 character sting in about 1.5 minutes. > If I go to a 9 character string the project window goes blank and it appears > that it is some kind of endless loop. I stopped it after 15 minutes. The following class only takes a few seconds (on an old computer) to write all permutations of a 9 character string to a file... HTH VERSION 1.0 CLASS BEGIN MultiUse = -1 'True Persistable = 0 'NotPersistable DataBindingBehavior = 0 'vbNone DataSourceBehavior = 0 'vbNone MTSTransactionMode = 0 'NotAnMTSObject END Attribute VB_Name = "CPermutations" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = True Attribute VB_PredeclaredId = False Attribute VB_Exposed = False Option Explicit Option Base 0 Private mnFF As Integer Private msFileOut As String Private msData As String Private mnPositionArrayPointer As Integer Private manPositionArray() As Integer Private msPermutation As String Public Sub Init(ByVal sData As String, ByVal sFileOut As String) msData = sData msFileOut = sFileOut End Sub Private Sub Permutations(ByVal nElement As Integer) Dim i As Integer mnPositionArrayPointer = mnPositionArrayPointer + 1 manPositionArray(nElement) = mnPositionArrayPointer If mnPositionArrayPointer = Len(msData) Then msPermutation = "" For i = 0 To UBound(manPositionArray) msPermutation = msPermutation & Mid$(msData, manPositionArray(i), 1) Next i If Len(msPermutation) Then Print #mnFF, msPermutation End If Else For i = 0 To Len(msData) - 1 If manPositionArray(i) = 0 Then Call Permutations(i) Next i End If mnPositionArrayPointer = mnPositionArrayPointer - 1 manPositionArray(nElement) = 0 End Sub Public Sub RecursivePermutations() mnPositionArrayPointer = -1 ReDim manPositionArray(Len(msData) - 1) mnFF = FreeFile Open msFileOut For Output As #mnFF 'Print #mnFF, "* Recursive Permutations for... " & msData Call Permutations(0) 'Print #mnFF, "* Finished!" Close #mnFF End Sub
|
Next
|
Last
Pages: 1 2 3 Prev: Saving decision tree Next: what to do with an old IIS webclass application |