(************************************************************************)
(* *)
(* 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 *)