Permut

[Tony Harris]

Hi,

I want to use PERMUT to do a permutation of characters ABCDE for the
traveling salesman problem and then get Excel to list all of the distances
for the output of each. My distances are as follows:

AB 10
BC 8
AC 11.48
BE 14.39
BD 12.68
EA 5.6
AD 11.87
CE 12.72
CD 5.5
DE 10.49



Whatever advice I can get would be greatly appreciated.

Thanks,

tdh1967

 

[Bernie Deitrick]

Below is Myrna Larsen' code and instruction for how to use it to get the 120 permutations - also
listed below the code in case you can't get the code to work.

To get the distances, you would need to parse out the four sub-trips, and use those to lookup the
distances from your distance table, and sum that: for a string in A1

=VLOOKUP(MID(A1,1,2),Table,2,False) + VLOOKUP(MID(A1,2,2),Table,2,False) +
VLOOKUP(MID(A1,3,2),Table,2,False) + VLOOKUP(MID(A1,4,2),Table,2,False)

Where Table is the 2 col range with your 20 distances enter it in $-$ form, like $D$1:$E$20 - you
need to have it both forward and backwards

AB
AC
AD
AE
BC
BD
BE
CD
CE
DE
EA
EB
EC
ED
DC
DB
DA
CB
CA
BA



HTH,
Bernie
MS Excel MVP


'>Maybe, Myrna will post the entire functioning code module
'
'Since you asked, here it is. It is generic, i.e. it isn't written specifically
'for a given population and set size, as yours it. It will do permutations or
'combinations. It uses a recursive routine to generate the subsets, one routine
'for combinations, a different one for permutations.
'
'To use it, you put the letter C or P (for combinations or permutations) in a
'cell. The cell below that contains the number of items in a subset. The cells
'below are a list of the items that make up the population. They could be
'numbers, letters and symbols, or words, etc.
'
'You select the top cell, or the entire range and run the sub. The subsets are
'written to a new sheet in the workbook.

Option Explicit

Dim vAllItems As Variant
Dim Buffer() As String
Dim BufferPtr As Long
Dim Results As Worksheet

Sub ListPermutations()
Dim Rng As Range
Dim PopSize As Integer
Dim SetSize As Integer
Dim Which As String
Dim N As Double
Const BufferSize As Long = 4096

Set Rng = Selection.Columns(1).Cells
If Rng.Cells.Count = 1 Then
Set Rng = Range(Rng, Rng.End(xlDown))
End If

PopSize = Rng.Cells.Count - 2
If PopSize < 2 Then GoTo DataError

SetSize = Rng.Cells(2).Value
If SetSize > PopSize Then GoTo DataError

Which = UCase$(Rng.Cells(1).Value)
Select Case Which
Case "C"
N = Application.WorksheetFunction.Combin(PopSize, SetSize)
Case "P"
N = Application.WorksheetFunction.Permut(PopSize, SetSize)
Case Else
GoTo DataError
End Select
If N > Cells.Count Then GoTo DataError

Application.ScreenUpdating = False

Set Results = Worksheets.Add

vAllItems = Rng.Offset(2, 0).Resize(PopSize).Value
ReDim Buffer(1 To BufferSize) As String
BufferPtr = 0

If Which = "C" Then
AddCombination PopSize, SetSize
Else
AddPermutation PopSize, SetSize
End If
vAllItems = 0

Application.ScreenUpdating = True
Exit Sub

DataError:
If N = 0 Then
Which = "Enter your data in a vertical range of at least 4 cells. " _
& String$(2, 10) _
& "Top cell must contain the letter C or P, 2nd cell is the number " _
& "of items in a subset, the cells below are the values from which " _
& "the subset is to be chosen."

Else
Which = "This requires " & Format$(N, "#,##0") & _
" cells, more than are available on the worksheet!"
End If
MsgBox Which, vbOKOnly, "DATA ERROR"
Exit Sub
End Sub

Private Sub AddPermutation(Optional PopSize As Integer = 0, _
Optional SetSize As Integer = 0, _
Optional NextMember As Integer = 0)

Static iPopSize As Integer
Static iSetSize As Integer
Static SetMembers() As Integer
Static Used() As Integer
Dim i As Integer

If PopSize <> 0 Then
iPopSize = PopSize
iSetSize = SetSize
ReDim SetMembers(1 To iSetSize) As Integer
ReDim Used(1 To iPopSize) As Integer
NextMember = 1
End If

For i = 1 To iPopSize
If Used(i) = 0 Then
SetMembers(NextMember) = i
If NextMember <> iSetSize Then
Used(i) = True
AddPermutation , , NextMember + 1
Used(i) = False
Else
SavePermutation SetMembers()
End If
End If
Next i

If NextMember = 1 Then
SavePermutation SetMembers(), True
Erase SetMembers
Erase Used
End If

End Sub 'AddPermutation

Private Sub AddCombination(Optional PopSize As Integer = 0, _
Optional SetSize As Integer = 0, _
Optional NextMember As Integer = 0, _
Optional NextItem As Integer = 0)

Static iPopSize As Integer
Static iSetSize As Integer
Static SetMembers() As Integer
Dim i As Integer

If PopSize <> 0 Then
iPopSize = PopSize
iSetSize = SetSize
ReDim SetMembers(1 To iSetSize) As Integer
NextMember = 1
NextItem = 1
End If

For i = NextItem To iPopSize
SetMembers(NextMember) = i
If NextMember <> iSetSize Then
AddCombination , , NextMember + 1, i + 1
Else
SavePermutation SetMembers()
End If
Next i

If NextMember = 1 Then
SavePermutation SetMembers(), True
Erase SetMembers
End If

End Sub 'AddCombination

Private Sub SavePermutation(ItemsChosen() As Integer, _
Optional FlushBuffer As Boolean = False)

Dim i As Integer, sValue As String
Static RowNum As Long, ColNum As Long

If RowNum = 0 Then RowNum = 1
If ColNum = 0 Then ColNum = 1

If FlushBuffer = True Or BufferPtr = UBound(Buffer()) Then
If BufferPtr > 0 Then
If (RowNum + BufferPtr - 1) > Rows.Count Then
RowNum = 1
ColNum = ColNum + 1
If ColNum > 256 Then Exit Sub
End If

Results.Cells(RowNum, ColNum).Resize(BufferPtr, 1).Value _
= Application.WorksheetFunction.Transpose(Buffer())
RowNum = RowNum + BufferPtr
End If

BufferPtr = 0
If FlushBuffer = True Then
Erase Buffer
RowNum = 0
ColNum = 0
Exit Sub
Else
ReDim Buffer(1 To UBound(Buffer))
End If

End If

'construct the next set
For i = 1 To UBound(ItemsChosen)
sValue = sValue & ", " & vAllItems(ItemsChosen(i), 1)
Next i

'and save it in the buffer
BufferPtr = BufferPtr + 1
Buffer(BufferPtr) = Mid$(sValue, 3)
End Sub 'SavePermutation



'Here's the list of permutations

ABCDE
ABCED
ABDCE
ABDEC
ABECD
ABEDC
ACBDE
ACBED
ACDBE
ACDEB
ACEBD
ACEDB
ADBCE
ADBEC
ADCBE
ADCEB
ADEBC
ADECB
AEBCD
AEBDC
AECBD
AECDB
AEDBC
AEDCB
BACDE
BACED
BADCE
BADEC
BAECD
BAEDC
BCADE
BCAED
BCDAE
BCDEA
BCEAD
BCEDA
BDACE
BDAEC
BDCAE
BDCEA
BDEAC
BDECA
BEACD
BEADC
BECAD
BECDA
BEDAC
BEDCA
CABDE
CABED
CADBE
CADEB
CAEBD
CAEDB
CBADE
CBAED
CBDAE
CBDEA
CBEAD
CBEDA
CDABE
CDAEB
CDBAE
CDBEA
CDEAB
CDEBA
CEABD
CEADB
CEBAD
CEBDA
CEDAB
CEDBA
DABCE
DABEC
DACBE
DACEB
DAEBC
DAECB
DBACE
DBAEC
DBCAE
DBCEA
DBEAC
DBECA
DCABE
DCAEB
DCBAE
DCBEA
DCEAB
DCEBA
DEABC
DEACB
DEBAC
DEBCA
DECAB
DECBA
EABCD
EABDC
EACBD
EACDB
EADBC
EADCB
EBACD
EBADC
EBCAD
EBCDA
EBDAC
EBDCA
ECABD
ECADB
ECBAD
ECBDA
ECDAB
ECDBA
EDABC
EDACB
EDBAC
EDBCA
EDCAB
EDCBA

 

[ShaneDevenshire]

Hi,

The PERMUT function does not give you the permutations, it tells you how
many there are. In other words you can't use it for what you want, other
than to verfiy that you have come up with the correct number of permutations.

If you enter a,b,c,d,e in cells B1:F1 and in A2:A6 and then in B2 enter the
formula
=B$1&$A2
If you copy this formula down and to the right Excel will produce all the
permutations of 5 numbers taken 2 at a time. But you must exclude the
diagonal aa, bb,...

If this helps, please click the Yes button

 

[Harald Staff]

Hi

J-Walk has great code for this:

http://spreadsheetpage.com/index.php/tip/generating_permutations/

HTH. Best wishes Harald

 

[Dana DeLouis]

I want to use PERMUT to do a permutation of characters ABCDE for the

traveling salesman problem...

Hi Just for fun...
You could print out all 120 permutations.

If we had only 3 points {1,2,3}, we could list out all 6 permutations
also. However, no matter how you draw it on paper, all 6 form the same
cycle. The total distances of each path is the same also.
(ie 1-2-3-1 is the same cycle as 3-1-2-3, ect...)

From Graph Theory, with 5 points, we note that there are only 24
"Hamiltonian Cycles." But for this problem, we can eliminate half by
removing the reverse path. Hence, only 12 paths.

I would list the 12 cycles/paths as the following.
Any other "paths" can be made by rotation and/or reversing.


{39.59, {1, 2, 3, 4, 5, 1}},
{45.36, {1, 4, 3, 2, 5, 1}},
{46.50, {1, 2, 4, 3, 5, 1}},
{48.25, {1, 3, 2, 4, 5, 1}},
{49.65, {1, 3, 4, 2, 5, 1}},
{50.87, {1, 4, 2, 3, 5, 1}},
{51.86, {1, 2, 5, 4, 3, 1}},
{53.08, {1, 2, 3, 5, 4, 1}},
{54.48, {1, 2, 5, 3, 4, 1}},
{56.23, {1, 3, 2, 5, 4, 1}},
{57.37, {1, 2, 4, 5, 3, 1}},
{63.14, {1, 3, 5, 2, 4, 1}}


HTH
Dana DeLouis