(* ::Package:: *)

(************************************************************************)\012(* This file was generated automatically by the Mathematica front end.  *)\012(* It contains Initialization cells from a Notebook file, which         *)\012(* typically will have the same name as this file except ending in      *)\012(* ".nb" instead of ".m".                                               *)\012(*                                                                      *)\012(* This file is intended to be loaded into the Mathematica kernel using *)\012(* the package loading commands Get or Needs.  Doing so is equivalent   *)\012(* to using the Evaluate Initialization Cells menu command in the front *)\012(* end.                                                                 *)\012(*                                                                      *)\012(* DO NOT EDIT THIS FILE.  This entire file is regenerated              *)\012(* automatically each time the parent Notebook file is saved in the     *)\012(* Mathematica front end.  Any changes you make to this file will be    *)\012(* overwritten.                                                         *)\012(************************************************************************)\012\012

(* ::Input::Initialization:: *)
SetDirectory["C:\\drorbn\\AcademicPensieve\\Projects\\Theta"];
<<Theta.m


(* ::Input::Initialization:: *)
(*m,n, even, by default all xings positive.  The list negxs flips the sign of those crossings.*)
Weave[m_,n_,negxs_:{}]:=Module[{pd},pd=(Flatten@Table[
Switch[
{EvenQ[x],EvenQ[y]},
{True,True},
X[m n+y m+m-x-1,n x+y+1,m n+y m+m-x,n x+y],
{True,False},
X[n x +y,m n+y m+x+1,n x+y+1,m n+y m+x],
{False,True},
X[n x+n-y-1,m n+y m+m-x,n x+n-y,m n+y m+m-x-1],
{False,False},
X[m n+y m+x,n x+n-y,m n+y m+x+1,n x+n-y-1]
]
,{x,0,m-1},{y,0,n-1}]
)/.{X[a_,b_,c_,d_]:>X[a+1,b+1,c+1,d+1]};
Do[pd[[i]]=(pd[[i]]/.{X[a_,b_,c_,d_]:>X[d,a,b,c]}),{i,negxs}];
PD@@pd
]
(*Randomly assign signs to all crossings*)
RandWeave[m_,n_]:=Weave[m,n,RandomSample[Range[m n],RandomInteger[{0,m n}]]]



(* ::Input::Initialization:: *)
DrawXing[x_,y_,cut_]:=If[cut==="v",{Line[{{x,y-1/2},{x,y-1/4}}],Line[{{x,y+1/4},{x,y+1/2}}],Line[{{x-1/2,y},{x+1/2,y}}]},{Line[{{x,y-1/2},{x,y+1/2}}],Line[{{x-1/2,y},{x-1/4,y}}],Line[{{x+1/4,y},{x+1/2,y}}]}]


(* ::Input::Initialization:: *)
DrawWeave[m_,n_,negxs_:{}]:=Graphics[{Thickness[0.1/Max[m,n]],
Table[
Switch[
{EvenQ[x],EvenQ[y]},
{True,True},
DrawXing[x,y,If[MemberQ[negxs,y m+x+1],"v","h"]],
{True,False},
DrawXing[x,y,If[MemberQ[negxs,y m+x+1],"h","v"]],
{False,True},
DrawXing[x,y,If[MemberQ[negxs,y m+x+1],"h","v"]],
{False,False},
DrawXing[x,y,If[MemberQ[negxs,y m+x+1],"v","h"]]
]
,{x,0,m-1},{y,0,n-1}],
Table[{Arrowheads[{{0,.7}}],Arrow[BezierCurve[{{x,-1/2},{x,-1},{x+1,-1},{x+1,-1/2}}]]},{x,1,m-3,2}],
Table[{Arrowheads[{{0,.7}}],Arrow[BezierCurve[{{x,n-1/2},{x,n},{x+1,n},{x+1,n-1/2}}]]},{x,0,m-2,2}],
Table[{Arrowheads[{{0,.7}}],Arrow[BezierCurve[{{-1/2,y},{-1,y},{-1,y+1},{-1/2,y+1}}]]},{y,0,n-2,2}],
Table[{Arrowheads[{{0,.7}}],Arrow[BezierCurve[{{m+-1/2,y},{m,y},{m,y+1},{m+-1/2,y+1}}]]},{y,1,n-3,2}],
BezierCurve[{{m-1,-1/2},{m-1,-1},{m,0},{m-1/2,0}}],
{Arrowheads[{{0,1}}],Arrow[{{m-1/2,n-1},{m,n-1}}]},
{Arrowheads[{{0,0.5}}],Arrow[{{0,-1},{0,-1/2}}]}

}]
DrawRandWeave[m_,n_]:=DrawWeave[m,n,RandomSample[Range[m n],RandomInteger[m n]]]


(* ::Input::Initialization:: *)
RandWeavePair[m_,n_]:=Module[{nxs=RandomSample[Range[m n],RandomInteger[m n]]},{DrawWeave[m,n,nxs],PolyPlot@\[CapitalTheta]@Weave[m,n,nxs]}]



