WIP: Word problem solver

gap/place.gd

@@ -29,6 +29,7 @@ DeclareAttribute("Location", IsPregroupPlace);
 DeclareAttribute("Letter", IsPregroupPlace);
 DeclareAttribute("Colour", IsPregroupPlace);
 DeclareAttribute("NextPlaces", IsPregroupPlace);
+DeclareAttribute("IsTerminal", IsPregroupPlace);
 DeclareAttribute("OneStepReachablePlaces", IsPregroupPlace);
 DeclareAttribute("__ID", IsPregroupPlace);
 

gap/place.gi

@@ -4,9 +4,16 @@
 
 ## Places
 InstallGlobalFunction(NewPlace,
-function(loc, c, colour)
+function(loc, props...)
     local p;
-    p := Objectify(PregroupPlaceType, [loc,c,colour]);
+    if Length(props) = 1 and props[1] = "terminal" then
+        p := Objectify(PregroupPlaceType, [loc,,,true]);
+    elif Length(props) = 2 then
+        # FIXME: better argument testing
+        p := Objectify(PregroupPlaceType, [loc,props[1],props[2],false]);
+    else
+        Error("usage: NewPlace(location, \"terminal\") or NewPlace(location, letter, colour)");
+    fi;
     Add(loc![3], p);
     return p;
 end);
@@ -41,6 +48,11 @@ function(p)
     return p![6];
 end);
 
+InstallMethod(IsTerminal
+             , "for a pregroup place"
+             , [IsPregroupPlaceRep],
+             p -> p![4] );
+
 AddOrUpdate := function(map, key, val)
     local tmp;
 
@@ -128,7 +140,7 @@ function(P)
 
             for P2T in P2s do
                 P2 := P2T[1];  # Place reachable on R1 by consolidated edge
-                
+
                 P2_loc := Location(P2);
                 P2_inletter := InLetter(P2_loc);
                 P2_outletter := OutLetter(P2_loc);
@@ -144,7 +156,7 @@ function(P)
                        P2_letter = DigraphVertexLabel(vg, v2)[1][2] then
 
                         xi1 := Vertex(pres, v1, v, v2);
-                        if Colour(P2) = "green" then
+                        if IsTerminal(P2) or Colour(P2) = "green" then
                             AddOrUpdate(res, [ __ID(P2), len ], xi1);
 
                         elif Colour(P2) = "red" then
@@ -172,7 +184,9 @@ InstallMethod(OneStepReachablePlaces
              , [IsPregroupPlaceRep],
 function(p)
     if not IsBound(p![7]) then
-        if Colour(p) = "red" then
+        if IsTerminal(p) then
+            p![7] := [];
+        elif Colour(p) = "red" then
             p![7] := OneStepRedCase(p);
         elif Colour(p) = "green" then
             p![7] := OneStepGreenCase(p);

gap/presentation.gd

@@ -87,6 +87,11 @@ DeclareOperation("RSymTestOp", [IsPregroupPresentation, IsRat]);
 #! IsPregroupPresentation, IsRat" /> on that input.
 DeclareGlobalFunction("RSymTest");
 
+#! @Arguments place
+#! @Description
+#!
+DeclareGlobalFunction("VerifySolverAtPlace");
+
 #! @BeginGroup
 #! @Description Tests a given presentation for hyperbolicity using the RSym test procedure.
 #! @Arguments presentation

gap/walrus.gi

@@ -30,6 +30,13 @@
 #  - Make a reasonably standard format (and exporter/importer) to exchange
 #    pregroup presentations so we can move them between GAP/other
 #    implementations for cross-checking
+#  - some names are unfortunate:
+#
+#    PregroupPlace should be PregroupPresentationPlace
+#    PregroupRelator should be PregroupPresentationRelator
+#    generally I would like to implement proper pregroup presentations, defining
+#    the "unive rsal group over a pregroup"
+#    and then quotients of that, in the same way as quotients of free groups are implemented
 
 #
 # TODO (mathematical/functional)
@@ -484,3 +491,62 @@ InstallMethod(IsHyperbolic, "for a pregroup presentation, and a rational number"
               [IsPregroupPresentation, IsRat],
               {pres, eps} -> RSymTest(pres,eps));
 
+
+InstallGlobalFunction("VerifySolverAtPlace",
+function(place)
+    local n, L, places, psip, osrp, pp, i, pq, P, Q, Pq, np, chi;
+
+    places := Places(PregroupPresentationOf(place));
+
+    if not IsPregroupPlace(place) then
+        Error("<place> has to be a PregroupPlace");
+    fi;
+
+    n := Length(Relator(place));
+
+    if IsTerminal(place) then
+        Error("Terminal place in VerifySolverAtPlace");
+    elif Colour(place) = "green" then
+        L := [(place, 0, 1, 3/4)];
+    elif Colour(place) = "red" then
+        L := [(place, 0, 0, 1)];
+        for np in NextPlaces(place) do
+            Add(L, [np, 1, 1, 1 + chi]);
+        od;
+    fi;
+
+    for i in [1..3] do
+        for pq in L do
+
+            if pq[3] = i then
+                P := pq[1];
+                osrp := OneStepReachablePlaces(P);
+                for Q in Keys(osrp) do
+                    psip := pq[4] + Q[2];
+
+                    if pq[2] + Q[2] < n/2 and
+                       not IsTerminal(places[Q[1]]) and
+                       psip > 0 then
+                        pp := PositionProperty(L, x -> (x[1] = osrp[1])
+                                                  and (x[2] = Pq[2] + osrp[2]));
+                        if pp = fail then
+                            Add(L, Immutable([osrp[1], pq[2] + Q[2], i + 1, psip]) );
+                        else
+                            if L[pp][4] < psip then
+                                L[pp] := Immutable([osrp[1], Pq[2] + Q[2], i + 1, psip]);
+                            fi;
+                        fi;
+                    fi;
+
+                    if pq[2] + Q[2] >= n/2 and
+                       IsTerminal(places[Q[1]]) and
+                       psip > 0 then
+                        return [fail, L];
+                    fi;
+                od;
+            fi;
+        od;
+    od;
+    return true;
+end);
+