[Date Index]
[Thread Index]
[Author Index]
Re: Product of transpositions
*To*: mathgroup at smc.vnet.net
*Subject*: [mg17416] Re: [mg17318] Product of transpositions
*From*: Daniel Lichtblau <danl>
*Date*: Thu, 6 May 1999 02:44:23 -0400
*References*: <199905010322.XAA25737@smc.vnet.net.>
*Sender*: owner-wri-mathgroup at wolfram.com
Carl Woll wrote:
>
> Hi group,
>
> I have a question/challenge.
>
> Given a list of transpositions
>
> {{a,b},{c,d},{e,f},...}
>
> where a,b,c... are all positive integers less than or equal to n,
> produce the permutation, or cyclic decomposition of the product of the
> transpositions. I don't care if you choose to multiply transpositions
> left to right or right to left. As an example, the following list of
> transpositions
>
> {{a,b},{b,c}}
>
> using right to left multiplication, will produce
>
> a->a->b
> b->c->c
> c->b->a
>
> or the cycle {a,b,c}. That is, using the usual notation, (ab)(bc)=(abc).
> I hope this is clear.
>
> If this functionality is built into a standard package, then tell me the
> package. Otherwise, what is the fastest implementation that anyone can
> come up with. I'm interested in repeatedly converting a random product
> of 120 transpositions into the corresponding permutation.
>
> Here is one idea.
>
> toRule[{a_Integer,b_Integer}]:={a->b,b->a}
>
> toPerm[t:{{_Integer,_Integer}..}]:=Fold[ReplaceAll,Range[Max[t]],torule/@t]
>
> Can anyone come up with a better idea?
>
> --
> Carl Woll
> Dept of Physics
> U of Washington
If speed is important then you may want to change this. If you have n
elements and m cycles then the above method has O(n*m) complexity (I
think) whereas a cycle-by-cycle alteration of Range[n] can be done in
O(max(n,m)).
I wrote some code that is equivalent to yours above. These do not give
the common form where {a,b,c,...} means {1->a,2->b,3->c,...} but rather
the reverse {a->1,b->2,...}. Here is the code.
toPermutation[cycles_List, n_Integer] := Module[
{len=Length[cycles],perm=Range[n]},
Do[
perm[[cycles[[len+1-j]]]] = perm[[Reverse[cycles[[len+1-j]]]]],
{j,Length[cycles]}];
perm
]
In[62]:= toPermutation[{{1,2},{2,3},{3,5}}, 6]
Out[62]= {5, 1, 2, 4, 3, 6}
Some good news is it appears to be alot faster than using replacements
once you hit maybe a few hundred cycles. Bad news is for large examples
it can crash a kernel (but 120 cycles should pose no trouble in that
respect). Good news is this problem is fixed in our upcoming release.
Better still, it gets ALOT faster there. For example:
In[63]:= randomcycles[max_,len_] := Table[Random[Integer,{1,max}],
{len}, {2}]
In[64]:= cycles = randomcycles[8000,4000];
In[65]:= Timing[perm1 = toPermutation[cycles,8000];]
Out[65]= {0.42 Second, Null}
An example with parameters {4000,2000} took about 24 seconds on the same
machine, same version, using the rule based method (slightly modified as
below).
torule[{a_Integer,b_Integer}]:={b->a,a->b}
toPerm[t:{{_Integer,_Integer}..},n_] :=
Fold[ReplaceAll,Range[n],torule/@t]
If you want to obtain the more standard permutation form, you can do
toPermutation[cycles_List, n_Integer] := Module[
{len=Length[cycles],perm=Range[n]},
Do[
perm[[perm[[cycles[[len+1-j]]]]]] =
perm[[perm[[Reverse[cycles[[len+1-j]]]]]]],
{j,Length[cycles]}];
perm
]
If you want left-to-right multiplication, just use cycles[[j]] instead
of cycles[[len+1-j]] in the loop.
In the upcoming version this really has the correct complexity. Not sure
about version 3, but if not then I think one can get it with judicious
use of Hold to prevent needless reevaluation of the permutation under
construction after every swap. Also it is quite likely one can get a
significant speed boost using Compile but I am a bit short on time and
will leave that for others who might be interested.
I imagine this can be coded more functionally using, say, FoldList but
it was beyond my meager capabilities to do so.
Daniel Lichtblau
Wolfram Research
Prev by Date:
**Re: Date in header**
Next by Date:
**Determine curves drawn ( please help ! )**
Previous by thread:
**Re: Product of transpositions**
Next by thread:
**Re: Product of transpositions**
| |