(************************************************************************)
(*                                                                      *)
(*  BraidGroup.m                                                        *)
(*  Various calculations in the braid group                             *)
(*                                                                      *)
(*  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.
 *)
(*
 * REVISION HISTORY
 *
 * version	1.0	4/11/90
 *
 * version	1.1	4/30/90
 *	added RandomBraid, Delta, Unbraid, ProductBraid, InverseBraid
 *	JPC
 *
 *)

(*
 *   TO DO
 *
 * Implement solutions of word and conjugacy problems
 *
 *)


BeginPackage["BraidGroup`",
	"SymmetricGroup`"]

Braid::usage =
	"Braids are represented in the form {cs, s}, where cs is a list
	of crossings and s is the number of strands. Individual crossings
	are represented by integers: -n when the nth strand crosses under
	the n+1st, n when the nth strand crosses over the n+1st."

BraidQ::usage =
	"BraidQ[b] yields True iff b is a legitimate Braid."

CrossingToPermutation::usage =
	"CrossingToPermutation[n] yields the permutation of the strands
	induced by a single crossing of the Abs[n]th and Abs[n]+1st strands."

BraidToPermutation::usage =
	"BraidToPermutation[b] yields the permutation of the strands
	induced by the braid b."

CrossingNumber::usage =
	"CrossingNumber[b] returns the number of crossings of the braid b."

Braid::bogus =
	"`` is not a legitimate braid!"

RandomBraid::usage =
	"RandomBraid[c,s] produces a random c-crossing braid on s strands."

Delta::usage =
	"Delta[n] returns a braid representing a positive half twist on n strands."

Unbraid::usage =
	"Unbraid[n] returns the trivial braid on n strands."

ProductBraid::usage =
	"ProductBraid[b1, b2] returns the product of b1 and b2 in the
	smallest braid group which contains them both."

InverseBraid::usage = 
	"InverseBraid[b] returns the inverse of b in the braid group."

Begin["`Private`"]    (* begin the private context *)

BraidQ[b_] :=
	Min[Abs[ b[[1]] ]]>0 && Max[Abs[ b[[1]] ]] < b[[2]] &&
		Map[IntegerQ, b[[1]] ] == Table[True,{Length[b[[1]] ]}]

(* This is the permutation of the strands induced by a single crossing. *)

CrossingToPermutation[n_,s_] :=
	Block[{nn=Abs[n]},
		Join[Range[1, nn-1],{nn+1, nn},Range[nn+2,s]]
	]

CrossingNumber[b_] :=
	Length[ b[[1]] ] /; BraidQ[b] || Message[Braid::bogus, b]

BraidToPermutation[b_] :=
	Block[{p = IdentityPermutation[ b[[2]] ],
		c = CrossingNumber[b]},
		For[cn = 1, cn <= c, cn++,
			p = ProductPermutation[p,
				CrossingToPermutation[ b[[1]][[cn]], b[[2]] ] ];
		];
		Return[p]
	] /; BraidQ[b] || Message[Braid::bogus, b]

Delta[n_Integer?Positive] :=
	{
		Flatten[Table[
			Table[i, {i, 1, n-j}],
			{j, 1, n-1}
		]],
		n
	}

Unbraid[n_Integer?Positive] := {{}, n}

RandomBraid[c_Integer?Positive, s_Integer?Positive] :=
	{Table[(2 Random[Integer] - 1) Random[Integer, {1, s-1}], {n,1,c}], s}

ProductBraid[b1_, b2_] :=
	{ Join[ b1[[1]], b2[[1]] ], Max[ b1[[2]], b2[[2]] ] } /;
		(BraidQ[b1] || Message[Braid::bogus, b1]) &&
			(BraidQ[b2]|| Message[Braid::bogus, b2])

ProductBraid[b1_, b2_, theRest__] :=
	Block[{pb=ProductBraid[b1,b2]},
		ProductBraid[ pb, theRest] 
	]/; (BraidQ[b1] || Message[Braid::bogus, b1]) &&
		(BraidQ[b2]|| Message[Braid::bogus, b2])

InverseBraid[b_] :=
	{ -1 * Reverse[ b[[1]] ], b[[2]]} /; BraidQ[b] || Message[Braid::bogus, b]

End[]         (* end the private context *)
EndPackage[]  (* end the package context *)