Re: Distance between permutations

*To*: mathgroup at smc.vnet.net*Subject*: [mg21653] Re: [mg21547] Distance between permutations*From*: Ken Levasseur <Kenneth_Levasseur at uml.edu>*Date*: Fri, 21 Jan 2000 04:00:02 -0500 (EST)*Organization*: UMass Lowell Mathematical Sciences*References*: <200001150703.CAA06285@smc.vnet.net>*Sender*: owner-wri-mathgroup at wolfram.com

Mark: Here's a function that computes the distance between two permutations without requiring a "basis" Caution: I haven't included any testing of input. The function presumes that the two inputs are lists of the same distinct elements (see below). Ken Levasseur Math Sciences UMass Lowell In[1]:= dist[{a_}, {a_}] := 0 In[2]:= dist[p1_List, p2_List] := If[First[p1] === First[p2], dist[Rest[p1], Rest[p2]], 1 + dist[Rest[p1], q = Rest[p2]; i = First[Position[q, First[p1]]]; q[[i]] = First[p2]; q]] In[3]:= dist[{1, 2, 3}, {1, 2, 3}] Out[3]= 0 In[4]:= dist[{1, 2, 3}, RotateRight[{1, 2, 3}]] Out[4]= 2 In[5]:= dist[{F[t], a2, I, 5, 2 + Sqrt[6], "string"}, {I, "string", a2, 2 + Sqrt[6], 5, F[t]}] Out[5]= 4 In[6]:= Needs["DiscreteMath`Combinatorica`"] This is on a Macintosh 7200/90: In[7]:= dist[RandomPermutation[50], RandomPermutation[50]] // Timing Out[7]= {0.166667 Second, 44} The function works for all permutations whose distances are less than to the value of $RecursionLimit (which is 256 on my machine). In[8]:= dist[RandomPermutation[250], RandomPermutation[250]] // Timing Out[8]= {1.95 Second, 244} This will work sometimes, but not always. In[9]:= dist[RandomPermutation[259], RandomPermutation[259]] // Timing $RecursionLimit::"reclim": "Recursion depth of \!\(256\) exceeded." $RecursionLimit::"reclim": "Recursion depth of \!\(256\) exceeded." $RecursionLimit::"reclim": "Recursion depth of \!\(256\) exceeded." General::"stop": "Further output of \!\($RecursionLimit :: \"reclim\"\) will \ be suppressed during this calculation." Out[9]= {2.56667 Second, 253 + dist[{47, 63, 173}, Hold[{2, 173, 63, 47}]]} The permutations must be of distinct items, or the results are not always correct. In[10]:= dist[Characters["aaabaa"], Characters["baaaaa"]] Out[10]= 3 In[11]:= dist[Characters["baaaaa"], Characters["aaabaa"]] Out[11]= 1 DIAMOND Mark wrote: > > I'm looking for a way of determining the minimum number of transpositions > between two permutations. It is easy to determine the number of pairwise > transpositions needed to go from the identity permutation to another > permutation P as, say > > In[1]:= Needs["DiscreteMath`Combinatorica`"]; > In[2]:= p = {3, 2, 5, 1, 6, 4}; > In[3]:= c=ToCycles[p] > Out[3]:= {{3, 5, 6, 4, 1}, {2}} > In[4]:= 6-Length[c] > Out[4]:= 4 > > which is the number of transpositions needed to change {1,2,3,4,5,6} to > {3,2,5,1,6,4}. > > But I would like to know the "distance" between {'s','p','o','t'} and > {'t','o','p','s'}, or between {'a','g','h','p','n'} some other permutation > thereof. > > I can do it by using a Replace rule like {'s'->1,'p'->2,'o'->3,'t'->4} and > going from there, but I don't know how to generalise my little routine to > handle *any* length (rather than just, say, length-4). And I wondered if > there is a way of avoiding converting the first permutation into the "basis > permutation" with my use of the Replace rules (Please excuse the ad-hoc > terminology!)

**References**:**Distance between permutations***From:*"DIAMOND Mark" <noname@noname.com>