(* 							*)
(*  Computation of Seifert matrix of a braid		*)
(*							*)
(*	Author: S.Yu.Orevkov				*)
(*  							*)
(*  To use with Mathematica [Wolfram Research Inc.]	*)
(*  The users's guide to this program and a description	*)
(*  of the implemented algorithm see in the appendix to	*)
(*  the paper						*)
(*  	http://picard.ups-tlse.fr/~orevkov/m8.ps	*)
(*------------------------------------------------------*)

SeifertMatrix=Function[{m,brd}, Module[{n,e,V,X,q,c,i,j,h,a,b},
    a={{ 0,1,-1,0},{-1, 0,1,0},{0,0,0,0},{1,-1,0,0}};
    b={{-1,1, 0,0},{ 1,-1,0,0},{0,0,0,0},{0, 0,0,0}};
    n=Length[brd]; V=Table[0,{i,n},{j,n}]; X=Table[{n},{h,m-1}];
    Do[ h=Abs[brd[[q]]]; e=Sign[brd[[q]]];
        c[1]=X[[h,1]];          X[[h]]={c[2]=q}; 
        c[3]=If[h<m-1,X[[h+1,1]],n];    c[4]=If[h>1,X[[h-1,1]],n];
        Do[Do[ V[[ c[i],c[j] ]] += a[[i,j]]+e*b[[i,j]], {i,4}],{j,4}],
    {q,n}];
    Transpose[Delete[Transpose[Delete[V,X]],X]]/2
]];

ssmW=Function[{m,brd}, Module[{bq,n,d,e,V,X,p=1,q,r=1,c,i,j,h,a,b},
    a={{ 0, 0,-1, 1, 2},
       { 0, 0, 1,-1,-2},
       {-1, 1, 0, 0, 0},
       { 1,-1, 0, 0, 0},
       { 2,-2, 0, 0, 0}}; 
    b={{-2,2,0,0},{2,-2,0,0},{0,0,0,0},{0, 0,0,0}};
    d=n=Length[brd];  Do[If[Not[IntegerQ[brd[[q]]]],d++;p++],{q,n}];
    V=Table[0,{i,d},{j,d}]; X=Table[{d},{h,m-1}];
    Do[ bq=brd[[q]];
       If[ IntegerQ[bq],   h=Abs[bq]; e=Sign[bq],
          h=Abs[bq[[2]]]; V[[r,r]]=2*bq[[1]]*Sign[bq[[2]]]; c[5]=r++;
       ];
       c[1]=X[[h,1]];          X[[h]]={c[2]=p++};
       c[3]=If[h<m-1,X[[h+1,1]],d];    c[4]=If[h>1,X[[h-1,1]],d];
       If[ IntegerQ[bq],
          Do[Do[ V[[ c[i],c[j] ]] += a[[i,j]]+e*b[[i,j]], {i,4}],{j,4}],
          Do[Do[ V[[ c[i],c[j] ]] += a[[i,j]],            {i,5}],{j,5}]
       ],
    {q,n}];
    Transpose[Delete[Transpose[Delete[V,X]],X]]/2
]];