(************************************************************************)
(*                                                                      *)
(*  SymmetricGroup.m                                                    *)
(*  An extended permutation package                                     *)
(*                                                                      *)
(*  version 1.1                                                         *)
(*  Joe Christy               4/30/90                                   *)
(*                                                                      *)
(************************************************************************)
(*
 * Copyright (c) 1990, Joe Christy
 *                     Department of Mathematics and Computer Science 
 *                     Emory University
 *                     Atlanta, GA 30322
 *
 * email address: joe@mathcs.emory.edu
 *
 * This software is copyrighted as noted above.  It may be freely copied,
 * modified, and redistributed, provided that the copyright notice is
 * preserved on all copies.
 *
 * There is no warranty or other guarantee of fitness for this software,
 * it is provided solely "as is".  Bug reports or fixes may be sent
 * to the authors, who may or may not act on them as they desire.
 *
 * You may not include this software in a program or other software product
 * without supplying the source, or without informing the end-user that the
 * source is available for no extra charge.
 *
 * If you modify this software, you should include a notice giving the
 * name of the person performing the modification, the date of modification,
 * and the reason for such modification.
 *)
(* parts from the package Permutations.m *)
(* i.e. PermutationQ, ToCycles,          *)
(*   FromCycles, and RandomPermutation   *)
(* Copyright 1988 Wolfram Research Inc.  *)
(*
 * REVISION HISTORY
 *
 * version	1.0	4/10/90
 *
 * version	1.1
 *	added CycleLength, CycleLengths
 *
 *	JPC	4/29/90
 *
 *)

		(** Elementary operations on permutations **)

BeginPackage["SymmetricGroup`"]

PermutationQ::usage =
	"PermutationQ[e] yields True if e is a list representing a permutation."

ToCycles::usage =
	"ToCycles[p] writes the permutation p as a list of cyclic
	permutations."

FromCycles::usage =
	"FromCycles[{p1,p2,..}] gives the permutation that corresponds to
	a list of cycles."

RandomPermutation::usage =
	"RandomPermutation[n] gives a random permutation of n elements."

InversePermutation::usage =
	"InversePermutation[p] gives the inverse permutation of p."
	
Extend::usage =
	"Extend[p,n] embeds a permutation p in the symmetric group on n letters."

ProductPermutation::usage =
	"ProductPermutation[p1, p2] gives the permutation gotten
	by applying first p1 then p2. This is the product in the
	smallest symmetric group containing p1 and p2."

Tensor::usage =
	"Tensor[p1, p2] gives the tensor product of p1 and p2."
	
IdentityPermutation::usage =
	"IdentityPermutation[n] gives the identical permutation of n elements."

CycleLength::usage =
	"CycleLength[p] gives the number of cycles in the ToCycles decomposition
	of the permutation p."
	
CycleLengths::usage =
	"CycleLengths[p] gives the a list of the lengths of the cycles in the
	ToCycles decomposition of the permutation p."

Begin["`private`"]

PermutationQ[e_] := TrueQ[ Sort[e] == Range[Length[e]] ]


ToCycles[perm_?PermutationQ] :=
	Block[{a, t, n, l, i, len},
		len = Length[perm];
		a = {} ;
		t = Table[True, {len}];
		For[i=1, i<=len, i++,
			If[t[[i]], 
				For[n = perm[[i]]; l = {}, 
					t[[n]], 
					n = perm[[n]],
					t[[n]] = False; AppendTo[l, n]
				   ];
			AppendTo[a, l]
			]
		] ;
		Return[a]
	]


FromCycles[cyc_List] :=
	Block[{list},
	Scan[ FromCycles0[list, #] &, cyc, 1] ;
	Array[list, Length[Flatten[cyc]]] 
	]

FromCycles0[list_, c_] :=
	Block[{c1},
		c1 = RotateRight[c,1];
		Table[ list[ c1[[i]] ] = c[[i]], {i, 1, Length[c]} ]
	]

RandomPermutation[n_Integer?Positive] :=
	Block[{t},
		t = Array[{Random[], #} &, n];
		t = Sort[t];
		Map[ #[[2]] &, t ]
	]

InversePermutation[p_List] :=
	Transpose[Sort[ Transpose[{p,Range[Length[p]]}] ]] [[2]]/;
		PermutationQ[p]

Extend::badSize =
	"`` is a permutation on more than `` letters!"

Extend[p_List,n_Integer] :=
	Join[p,Range[Length[p]+1,n]] /; PermutationQ[p] && n > Length[p]
		
Extend[p_List,n_Integer] :=
	p /; PermutationQ[p] && n == Length[p]

Extend[p_List,n_Integer] :=
	Message[Extend::badSize, p, n] /; PermutationQ[p] && n < Length[p]

ProductPermutation[p1_,p2_] :=
	Transpose[ Sort[Transpose[{InversePermutation[p1],p2}]] ] [[2]]/;
	PermutationQ[p1] && PermutationQ[p2] && Length[p1] == Length[p2]

ProductPermutation[p1_,p2_] :=
	Block[{n=Max[Length[p1], Length[p2]]},
		ProductPermutation[Extend[p1,n], Extend[p2,n]]
	]/; PermutationQ[p1] && PermutationQ[p2]

ProductPermutation[p1_, p2_, theRest__] :=
	Block[{pp=ProductPermutation[p1,p2]},
		ProductPermutation[ pp, theRest] 
	]/; PermutationQ[p1] && PermutationQ[p2]

Tensor[p1_,p2_] :=
	Join[p1,p2+Length[p1]] /; PermutationQ[p1] && PermutationQ[p2]

IdentityPermutation[n_Integer?Positive] := Range[n]

CycleLength[perm_] := Length[ToCycles[perm]]

CycleLengths[perm_] := Map[Length,ToCycles[perm]]

End[]
EndPackage[ ]

Null