G := FreeGroup(2);
gens := GeneratorsOfGroup(G);
a := gens[1];
b := gens[2];

OppCoord := function(v)
local z;
if v[1] = 1 then
z := [2, v[2]];
fi;
if v[1] = 2 then
z := [1, v[2]];
fi;
if v[1] = 3 then
z := [4, v[2]];
fi;
if v[1] = 4 then
z := [3, v[2]];
fi;
return z;
end;


#Add element x to list L at position m

MyAddList := function(L, m, x)
local i,z;
z := [1 .. Length(L)+1];
if m > 1 then
for i in [1 .. m-1] do
z[i] := L[i];
od;
fi; 
if m < Length(L)+1 then
for i in [m+1 .. Length(L)+1] do
z[i] := L[i-1];
od;
fi;
z[m] := x;
return z;
end;

MyRemove := function(L, m)
local M, i;
M := [1 .. Length(L)-1];
if m > 1 then
for i in [1 .. m-1] do
M[i] := L[i];
od;
fi;
for i in [m .. Length(L)-1] do
M[i] := L[i+1];
od;
return M;
end;


#Permute list L so that it starts with element x

CyclicShuffle := function(L, x)
local i,k, z;
z := [1 .. Length(L)];
for i in [1 .. Length(L)] do
if L[i] = x then
k := i;
fi;
od;
for i in [1 .. Length(L)] do
z[((i-k) mod Length(L))+1] := L[i];
od;
return z;
end;



LetterToNumber := function(x)
local z;
if x = a then
z := 1;
fi;
if x = a^-1 then
z := 2;
fi;
if x = b then
z := 3;
fi;
if x = b^-1 then
z := 4;
fi;
return z;
end;


#Cyclically permutes w so that it does not start with proper power

NormalWord := function(w)
local i,k,z;
for i in [1 .. Length(w)-1] do
if (Subword(w,i,i) = a or Subword(w,i,i) = a^-1) and
(Subword(w,i+1, i+1) = b or Subword(w,i+1,i+1) = b^-1) then
k := i;
fi;
od;
z := Subword(w, 1, k-1)^-1 * w *Subword(w, 1, k-1);
return z;
end;



# Given a choice vector and a word z(a,b), function
# tries to make a Heegaard diagram which realizes the word.
# Any choices which arise in the construction are made according to the vector.

MakePath := function(currentchoice, z)
local cc, comps, V, i, newcoord, prevcoord, k, comp,v1, v2, j1, j2, options,
i1, i2, newcomp1, newcomp2,s,t,w,testcomps,u, opt;

testcomps := [];

cc := ShallowCopy(currentchoice);
w := NormalWord(z);

# Start with Heegaard diagram consisting of four "big vertices" (or disks
# in the plane),
# labeled -3 (corr. to a), -2 (a^-1), -1(b), and 0 (b^{-1}).
# The set of these is labeled V.
# The points which have been already added to each component of $\partial V$
# are kept in a list, with cyclic order.
# Note the order on identified disks must be consistent.

V := [[-3],[-2],[-1],[0]];
comps := [[[-3],[-2],[-1],[0]]];

# The Heeagaard diagram separates the plane into connected regions
# and "comps" is the set of these.

# When placing a new edge on the diagram:
# the initial vertex, is labeled [n,0],
# and the terminal vertex is labeled [n+1,1].
# These are added to the desired disks in the desired spots,
# which means inserting them into the corresponding
# list in the correct place.
# We also need to keep track of the midpoint of each
# segment of \partial V;  these are labeled by integers.
# So, to the immediate right of [n,0] (resp. [n+1,1])
# we add the label n (resp. n+1). 

# j1 will be the V-coordinate of the initial vertex of an edge
# and j2 is the V-coordinate of the terminal vertex.





#  We begin by putting in the final vertex of the whole loop,
# which should correspond to the inverse of the first letter
# of the given word.

j2 := LetterToNumber(Subword(w,1,1)^-1);
Add(V[j2], [1, 1]);
Add(V[j2], 2*Length(w));


# Update comps.  This must be done to respect the orientation
# from R^2, which agrees with the labeling on V[1] and V[3],
# and disagrees on V[2] and V[4].

comp := comps[1];

if j2 = 1 or j2 = 3 then

Add(comp[j2], [1,1]);
Add(comp[j2], 2*Length(w));
fi;

if j2 = 2 or j2 = 4 then
comp[j2] := MyAddList(comp[j2], 1,  2*Length(w));
comp[j2] := MyAddList(comp[j2], 2,[1,1]);
fi;



#  Start adding edges

for i in [1 .. Length(w)-1] do

#Adding an edge [i,0], [i+1,1]
# First get coordinates of initial vertex.  These have form:
# [j1, n], where j1 is V-coord. (corr. to ith letter of w)
# and n is position on vertex V where edge is to be added.
# Note this position is determined by the
# the terminal vertex of the previous edge.

if i > 1 then
newcoord := OppCoord(prevcoord);
fi;
if i = 1 then
newcoord := [LetterToNumber(Subword(w,1,1)), 2];
fi;

j1 := newcoord[1];


#insert [i,0] in appropriate place on V[j1]

V[j1] := MyAddList(V[j1],newcoord[2],[i,0]);
V[j1] := MyAddList(V[j1],newcoord[2]+1,2*i-1);

v1 := V[j1][newcoord[2]-1]; 
j2 := LetterToNumber(Subword(w,i+1,i+1)^-1);


# determine which component [i,0] is in.  Call it comp.

for k in [1 .. Length(comps)] do
for s in [1 .. Length(comps[k])] do
if V[j1][newcoord[2]-1] in comps[k][s] then
comp := comps[k];
t := k;
fi;
od;
od;


# Record options for the location of [i+1,1] on V[j2].
# Get one option for each (integer) vertex of V[j2] in comp.  

options := [];
for k in [1 .. Length(comp)] do
for s in [1 .. Length(comp[k])] do
if IsInt(comp[k][s]) and comp[k][s] in V[j2] then
Add(options,comp[k][s]);
fi;
od;
od;

# Extra option in special case: if there are two total components, and both
# endpoints of new edge are in same one, then can place the new
# edge on either side of the other comp.
# record this "option integer" is special by adding 4*Length(w).

for k in [1 .. Length(comp)] do
if v1 in comp[k] then
i1 := k;
fi;
if options <> [] and options[1] in comp[k] then
i2 := k;
fi;
od;

if Length(comps[t]) = 2 and i1 = i2 then
for k in [1 .. Length(options)] do
Add(options, options[k]+4*Length(w));
od;
fi;


# if no options, or if choice vector corresponds to
# unavailable option, then return vector for next choice, or
# if no more choices, return failure.


if cc[i] = Length(options)+1 then

if i = 1 then
return [cc,0,1];
fi;

if i > 1 then
for k in [i .. Length(w)] do
cc[i] := 1;
od;
cc[i-1] := cc[i-1]+1;
fi;

return [cc,0,0];
fi;


# if current choice still an option, insert [i+1,1] at corresponding
# position (have to take mod 4*L(w), to account for possible
# "special case option" above).

if cc[i] < Length(options) + 1 then

opt := options[cc[i]] mod (4*Length(w));
if opt > 4*Length(w) -4 then
opt := opt - 4*Length(w);
fi;

V[j2] := MyAddList(V[j2], Position(V[j2],opt)+1, [i+1,1]);
V[j2] := MyAddList(V[j2], Position(V[j2],opt)+2, 2*i);
 
v2 := V[j2][Position(V[j2],opt)];

fi;


# Add new vertices to comps
# Note that orientation of comp agrees with orietation on V[j]
# for two values of j, and disagrees for the other two

if j1 = 1 or j1 = 3 then
comp[i1] := MyAddList(comp[i1], Position(comp[i1], v1)+1, [i,0]);
comp[i1] := MyAddList(comp[i1], Position(comp[i1], v1)+2, 2*i-1);
fi;

if j1 = 2 or j1 = 4 then
comp[i1] := MyAddList(comp[i1], Position(comp[i1], v1), [i,0]);
comp[i1] := MyAddList(comp[i1], Position(comp[i1], [i,0]), 2*i-1);
fi;


if j2 = 1 or j2 = 3 then

comp[i2] := MyAddList(comp[i2], Position(comp[i2], v2)+1, [i+1,1]);
comp[i2] := MyAddList(comp[i2], Position(comp[i2], v2)+2, 2*i);
fi;


if j2 = 2 or j2 = 4 then
comp[i2] := MyAddList(comp[i2], Position(comp[i2], v2), [i+1,1]);
comp[i2] := MyAddList(comp[i2], Position(comp[i2], [i+1,1]), 2*i);
fi;

# combine comps
# if connecting distinct subcomps of comp then

if i1 <> i2 then


comp[i1] := CyclicShuffle(comp[i1],[i,0]);
comp[i2] := CyclicShuffle(comp[i2],[i+1,1]);


Add(comp[i1], [i,0]);
Add(comp[i2], [i+1,1]);

Append(comp[i1], comp[i2]);


comp := MyRemove(comp,i2);
comps[t] := comp;

fi;


# if connecting same subcomp then

if i1 = i2 then

comp[i1] := CyclicShuffle(comp[i1], [i,0]);

newcomp1 := comp[i1]{[1 .. Position(comp[i1], [i+1,1])]};
newcomp2 := comp[i1]{[Position(comp[i1],[i+1,1]) .. Length(comp[i1])]};
Add(newcomp2, [i,0]);
newcomp1 := [newcomp1];
newcomp2 := [newcomp2];

# In special case of two total components A and B, and edge
# connecting A, there is choice of which
# newly created component to put B in.   
# Caution:  we have not dealt with all options in case
# word starts with proper power.  This is why we need to initialize with
# normal form of word.

if Length(comp) > 1 then
u := (i1 mod 2) + 1;
if options[cc[i]] < (2*Length(w)+1) then
Add(newcomp1, comp[u]);
fi;
if options[cc[i]] > 2*Length(w) then
Add(newcomp2, comp[u]);
fi;
fi;


comps := MyRemove(comps,t);
Add(comps, newcomp1);
Add(comps, newcomp2);
fi;

# record coordinate of endpoint

prevcoord := [j2, Position(V[j2], [i+1,1])];
od;


# check if you can close up the loop
# if so, return success,
# if not, return updated choice vector

newcoord := OppCoord(prevcoord);
j1 := newcoord[1];
for k in [1 .. Length(comps)] do
for s in [1 .. Length(comps[k])] do
if V[j1][newcoord[2]-1] in comps[k][s] then
i1 := k;
fi;
od;
od;
for k in [1 .. Length(comps)] do
for s in [1 .. Length(comps[k])] do
if 2*Length(w) in comps[k][s] then
i2 := k;
fi;
od;
od;


if i1 = i2 then
return [cc,1,0];
fi;

if i1 <> i2 then
for k in [i .. Length(w)] do
cc[i] := 1;
od;
cc[i-1] := cc[i-1]+1;
fi;
return [cc,0,0];
end;



IsGeom := function(w)
local v, i, currentchoice,
 exhaust;

exhaust := 0;

currentchoice := [1 .. Length(w)];
for i in [1 .. Length(w)] do
currentchoice[i] := 1;
od;
while exhaust = 0 do
v := MakePath(currentchoice, w);
currentchoice := v[1];
if v[2] = 1 then
return 1;
fi;
if v[3] = 1 then
return 0;
fi;
od;
end;

IsGeomplus := function(w)
local i,z,t;
t := 0;
for i in [1 .. Length(w)] do
z := Subword(w,1,i)^-1*w*Subword(w,1,i);
if IsGeom(z) = 1 then t := 1;
fi;
od;
return t;
end;