How to create m-permutations of n as sequences without repetition on VBScript, using the Johnson-Trotter algorithm The Johnson–Trotter algorithm was used to create m-permutations of n. The source of n numbers is the XML file (NumberSetting.xml). The number m, the name of the source file, the name of the output file, the names of the elements in the XML files are defined in the code as constants. The result is pre-output in a CSV file, then the output XML is generated. NumberSetting.xml <?xml version="1.0" encoding="UTF-8"?> <Numbers> <number>01</number> <number>02</number> <number>03</number> <number>04</number> <number>05</number> <number>06</number> <number>07</number> <number>08</number> <number>09</number> <number>10</number> <number>11</number> <number>12</number> <number>13</number> <number>14</number> <number>15</number> <number>16</number> <number>17</number> <number>18</number> <number>19</number> <number>20</number> </Numbers> NumbersCombination.vbs Option Explicit ' ----------------------------------------------------------- ' m-permutations of n ' ----------------------------------------------------------- Const m = 3 Dim n ' items count config file ' ' Version of the script Const version = "2017.07.23 18-00 UTC" ' ----------------------------------------------------------- ' CONFIG ' ----------------------------------------------------------- Const CONFIG_FILENAME = "NumberSetting.xml" Const CONFIG_XML_ROOT = "Numbers" Const CONFIG_XML_ELEMENT = "number" ' ----------------------------------------------------------- ' RESULT GENERAL ' ----------------------------------------------------------- Const RESULT_FILENAME = "NumberOutput.xml" Const RESULT_XML_ROOT = "NumbersOutput" Const RESULT_XML_ELEMENT = "number" ' ----------------------------------------------------------- ' TEMP FILE ' ----------------------------------------------------------- Const FILE_CSV = "data.csv" ' ----------------------------------------------------------- Dim PathThisScript, csv_file_name Dim fso, objCsvFile Dim objXMLDocConfig, RootConfig Dim xmlDoc, objRoot Dim ConfigFile, ResultFile Dim arrConfig_Number(), a() Dim i, ElemConfig, objIntro, sLine Dim ExistsObject Set fso = CreateObject("Scripting.FileSystemObject") PathThisScript = fso.GetParentFolderName(fso.GetFile(Wscript.ScriptFullName)) PathThisScript = PathThisScript & "\" ' =================================== ' file name is the FULL NAME ConfigFile = PathThisScript & CONFIG_FILENAME ResultFile = PathThisScript & RESULT_FILENAME ' =================================== ' temp file CSV csv_file_name = PathThisScript & "\" & FILE_CSV ' =================================== If fso.FileExists(ConfigFile) Then ' ' Get congig data Set objXMLDocConfig = CreateObject("Microsoft.XMLDOM") objXMLDocConfig.async = False objXMLDocConfig.Load (ConfigFile) ' get config date, set primary node xml file Set RootConfig = objXMLDocConfig.DocumentElement If RootConfig.nodeName = CONFIG_XML_ROOT Then ' --------------------------------- ' [NUMBER] for each element in the configuration file are added to the elements in an array n = 0 For Each ElemConfig In RootConfig.ChildNodes If ElemConfig.BaseName = CONFIG_XML_ELEMENT Then n = n + 1 ' get date from the element xml file ReDim Preserve arrConfig_Number(n) arrConfig_Number(n) = ElemConfig.Text End If Next If n >= m Then CreateCsvFile arrConfig_Number, n, m MsgBoxUser "Temporary csv file created" ' --------------------------------- ' [CREATE RESULT FILE] Set xmlDoc = CreateObject("Microsoft.XMLDOM") xmlDoc.async = False ' create element [ROOT] Set objRoot = xmlDoc.createElement(RESULT_XML_ROOT) xmlDoc.appendChild objRoot ' ForReading = 1 : Open a file for reading only. You can't write to this file. Set objCsvFile = fso.OpenTextFile(csv_file_name, 1) Do Until objCsvFile.AtEndOfStream sLine = objCsvFile.ReadLine If Not Len(Trim(sLine)) = 0 Then InsertItems xmlDoc, objRoot, sLine End If Loop objCsvFile.Close fso.DeleteFile csv_file_name, True Set objIntro = xmlDoc.createProcessingInstruction("xml", "version='1.0' encoding='UTF-8' standalone='yes'") xmlDoc.InsertBefore objIntro, xmlDoc.ChildNodes(0) xmlDoc.Save ResultFile MsgBoxUser "Finish" Else MsgBoxUser "m (=" & m & ") > numbers count (=" & n & ")" End If Else MsgBoxUser "Invalid configuration file. Node " & CONFIG_XML_ROOT & " not found" End If Else MsgBoxUser "Configuration file '" & ConfigFile & "' doesn't exist" End If Sub InsertItems(xmlDoc, objRoot, ElementText) Dim objItem Set objItem = xmlDoc.createElement(RESULT_XML_ELEMENT) objRoot.appendChild objItem objItem.Text = ElementText End Sub Sub MsgBoxUser(m) wscript.echo m End Sub ' m-permutations of n ' Sub CreateCsvFile(aInData, n, m) Dim objFile, lineCheck Dim a(), i, j, p, JT() Dim mFactorial ' Factorial mFactorial = Factorial(m) ' TEST n,m. If not correct to do EXIT If n < m Or m < 1 Then Exit Sub ' set variable p If m = n Then p = 1 Else p = m ReDim a(m) ' -------------------- ' To create the array used "Johnson-Trotter" ' -------------------- ReDim JT(mFactorial, m) ' execute "Johnson-Trotter" GenPermutations m, JT ' init the array For i = 1 To m: a(i) = i: Next Set objFile = fso.CreateTextFile(csv_file_name, True) Do For i = 1 To mFactorial lineCheck = aInData(a(JT(i, 1))): For j = 2 To m Step 1: lineCheck = lineCheck & "," & aInData(a(JT(i, j))): Next objFile.WriteLine lineCheck Next If a(m) = n Then p = p - 1 Else p = m If p Then For i = m To p Step -1 a(i) = a(p) + i - p + 1 Next End If Loop While p objFile.Close End Sub Function Factorial(m) Dim i Factorial = 1: For i = 1 To m: Factorial = Factorial * i: Next End Function Sub GenPermutations(n, JT) ' ' "Johnson-Trotter" VB6 implementation by MathImagics (Dec 2004) ' Each permutation is obtained from the previous by ' swapping just ONE pair of adjacent items. ' Dim Item() ' items to permute Dim Link() ' 0 = link left, 1 = right Dim k, kSpot ' largest mobile K and its position Dim p, pSpot ' iterator value P, its position Dim mobile ' "mobility" test flag Dim kLink Dim NumberOfLines Dim i ' ' 0. Setup initial state ' ReDim Item(n) ReDim Link(n) For i = 1 To n: Item(i) = i: Next Do ' 1. to result array ' NumberOfLines = NumberOfLines + 1 For i = 1 To n: JT(NumberOfLines, i) = Item(i): Next ' 2. select "mobile" position with highest value ' k = 0 pSpot = 0 Do While pSpot < n pSpot = pSpot + 1 p = Item(pSpot) mobile = False If Link(pSpot) = 0 Then If pSpot > 1 Then If Item(pSpot - 1) < p Then mobile = True End If ElseIf pSpot < n Then If Item(pSpot + 1) < p Then mobile = True End If If mobile Then If p > k Then k = p kSpot = pSpot If k = n Then Exit Do ' look no further End If End If Loop If k = 0 Then Exit Do ' all done! ' ' 3. Swap item kSpot with "neighbour" ' kLink = Link(kSpot) If kLink Then Item(kSpot) = Item(kSpot + 1): Link(kSpot) = Link(kSpot + 1) Item(kSpot + 1) = k: Link(kSpot + 1) = 1 Else Item(kSpot) = Item(kSpot - 1): Link(kSpot) = Link(kSpot - 1) Item(kSpot - 1) = k: Link(kSpot - 1) = 0 End If ' ' 4. Toggle Links for any items > K ' For pSpot = 1 To n If Item(pSpot) > k Then Link(pSpot) = 1 - Link(pSpot) Next Loop End Sub Used: The Johnson-Trotter algorithm in VB6 (Lotto Algorithms - Permutations, Combinations). en/m_permutations_of_n_using_johnson_trotter_algorithm_on_vbscript.txt Last modified: 2018/06/27 22:23by 2SRTVF