Как создать m-перестановок из n без повторений на VBScipt, используя алгоритм Джонсона-Троттера При создании m-перестановок из n использовался алгоритм Джонсона-Троттера. Источником n чисел является xml файл (NumberSetting.xml). Число m, наименование файла-источника, наименование выходного файла, наименование элементов в xml файлах определяется в коде как константы. Предварительно вывод результата происходит в csv файл, далее, используя csv файл, формируется выходной xml. 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 Использовалось: The Johnson-Trotter algorithm in VB6 (Lotto Algorithms - Permutations, Combinations). ru/m_permutations_of_n_using_johnson_trotter_algorithm_on_vbscript.txt Последние изменения: 2018/06/27 22:09 — 2SRTVF