more efficient solution checker

data/scenarios/Challenges/_word-search/solution.sw

@@ -1,5 +1,14 @@
 def doN = \n. \f. if (n > 0) {f; doN (n - 1) f} {}; end;
 
+def intersperse = \n. \f2. \f1. if (n > 0) {
+        f1;
+        if (n > 1) {
+            f2;
+        } {};
+        intersperse (n - 1) f2 f1;
+    } {};
+    end;
+
 def waitUntilUnblocked =
     x <- blocked;
     if x {
@@ -49,7 +58,8 @@ def traverseRow = \progress. \n.
 
         if (newProgress == 3) {
             turn back;
-            doN 3 (highlightLetter; move;);
+
+            intersperse 3 move highlightLetter;
         } {
             move;
             traverseRow newProgress (n - 1);

data/scenarios/Challenges/_word-search/verify-solution.sw

@@ -1,63 +1,9 @@
-// Traverse all rows, left-to-right, to see if the highlighted letters
-// exist in the proper order.
-// Fails if more than 3 letters are highlighted.
-
-
-def doN = \n. \f. if (n > 0) {f; doN (n - 1) f} {}; end;
-
-def boolToNum = \b.
-    if b {return 1} {return 0};
-    end;
-
-def resetBits =
-    countOnes <- count "bit (1)";
-    doN countOnes $ make "bit (0)";
-    end;
-
-// Counts how many times a predicate was true in a loop.
-// NOT USED
-def countInRow = \act. \pred. \n.
-    if (n > 0) {
-        isTrue <- pred;
-        if isTrue {
-            make "bit (1)";
-        } {};
-
-        act;
-        countInRow act pred $ n - 1;
-    } {};
-    end;
-
-
-def chooseLetter = \i.
-    if (i == 0) {
-        return "lowercase c";
-    } {
-        if (i == 1) {
-            return "lowercase o";
-        } {
-            return "lowercase w";
-        }
-    };
-    end;
-
-
-// NOT USED
-def isHighlighted =
-    isC <- ishere "lowercase c";
-    if (isC) {
-        return true;
-    } {
-        isO <- ishere "lowercase o";
-        if (isO) {
-            return true;
-        } {
-            isW <- ishere "lowercase w";
-            return isW;
-        }
-    }
-    end;
 
+// Algorithm:
+// We only need to check the base's
+// current position: if we find three contiguous highlights,
+// then we know that the player has just completed their
+// third highlight.
 
 def whichOrdinal =
     isC <- ishere "lowercase c";
@@ -77,114 +23,61 @@ def whichOrdinal =
         }
     }
     end;
+
 
+def countConsecutive = \expectedOrdinal. \n.
 
-// NOT USED
-def countHighlighted = \n.
-    countInRow move isHighlighted n;
-    hCount <- count "bit (1)";
-    return hCount;
-    end;
-
-def moveToRowBeginning = \r.
-    currentPos <- as r {whereami};
-    teleport r (0, snd currentPos);
-    end;
-
-
-/** Returns a tuple:
-* (didFindWord, isSolutionInvalid)
-*
-* The necessary condition to win the scenario is
-* [didFindWord == true] for ANY row,
-* and
-* [isSolutionInvalid == false] for ALL rows.
-*
-* We may need to check all of the rows, though
-* we can abort early with failure if any row has
-* [isSolutionInvalid == false]
-*/
-def traverseRow = \isWordFound. \highlightCount. \expectedOrdinal. \n.
-
-    if (n > 0) {
+    thisOrdinal <- whichOrdinal;
 
-        observedOrdinal <- whichOrdinal;
-
-        let isHighlighted = observedOrdinal >= 0 in
+    nextOrdinal <- if (thisOrdinal == expectedOrdinal) {
+        return $ expectedOrdinal + 1;
+    } {
+        return 0;
+    };
 
-        newHighlightCount <- if isHighlighted {
-            return $ highlightCount + 1;
-        } {
-            return highlightCount;
-        };
+    if (nextOrdinal == 3) {
+        return true;
+    } {
 
-        nextExpectedOrdinal <- if (observedOrdinal == expectedOrdinal) {
-            return $ expectedOrdinal + 1;
+        if (n > 0) {
+            move;
+            countConsecutive nextOrdinal (n - 1);
         } {
-            // Zero progress.
-
-            // TODO: we have the potential to short-circuit here,
-            // if (expectedOrdinal > 0). Resetting after having
-            // made some progress implies overall failure,
-            // because a valid solution has no discontinuities.
-
-            // Note that examining the vertical direction (columns)
-            // could still yield a win.
-            return 0;
+            return false;
         };
+    };
 
-        // This boolean function argument is a latch.
-        let newIsWordFound = isWordFound || (nextExpectedOrdinal == 3) in
+    end;
+
 
-        move;
-        traverseRow newIsWordFound newHighlightCount nextExpectedOrdinal (n - 1);
+def checkBackAndForth =
 
+    foundBackward <- countConsecutive 0 3;
+    if (foundBackward) {
+        return true;
     } {
-        // Done recursing, have exhausted the row.
-        return (isWordFound, highlightCount);
-    };
+        turn back;
+        countConsecutive 0 3;
+    }
     end;
 
-def traverseAllRows = \r. \didFindWord. \highlightCount. \n.
 
+def checkDirections = \n.
     if (n > 0) {
-
-        foundWordAndHighlightCount <- traverseRow didFindWord highlightCount 0 25;
-        // first element: found word
-        // second element: highlight count
-
-        let newDidFindWord = fst foundWordAndHighlightCount in
-        let newHighlightCount = snd foundWordAndHighlightCount in
-
-        if (newHighlightCount > 3) {
-            return false;
+        wasFound <- checkBackAndForth;
+        if (wasFound) {
+            return true;
         } {
-            moveToRowBeginning r;
-            resetBits;
-            traverseAllRows r newDidFindWord newHighlightCount $ n - 1;
-        };
+            turn left;
+            checkDirections $ n - 1;
+        }
     } {
-        return didFindWord;
+        return false;
     }
     end;
 
 def checkSoln =
-
-    r <- robotnamed "lettersetter";
-
-    as r {
-        finishedPlacing <- has "boulder";
-
-        if (finishedPlacing) {
-
-            teleport r (0, 0);
-
-            traverseAllRows r false 0 15;
-
-        } {
-            return false;
-        };
-    };
+    checkDirections 4;
     end;
 
-checkSoln;
+as base {checkSoln};