[Date Index]
[Thread Index]
[Author Index]
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!)
Prev by Date:
**Re: Flat, OneIdentity Again**
Next by Date:
**Re: Flat, OneIdentity Again**
Previous by thread:
**Re: Distance between permutations**
Next by thread:
**ConstrainedMin and vector-notation**
| |