Optimization: merge SMoves on the same axis (#6)

Author: Minoru

src/Optimizations.hs

@@ -20,3 +20,13 @@ splitLMove [] = []
 splitLMove ((LMove a b):Wait:cmds) =
   (SMove (fromShortLinDiff a)) : (SMove (fromShortLinDiff b)) : cmds
 splitLMove (cmd:cmds) = cmd : (splitLMove cmds)
+
+-- | Turns [SMove a, SMove b] into [SMove x] if a and b are on the same axis
+-- and can be combined.
+mergeSMoves :: [Command] -> [Command]
+mergeSMoves [] = []
+mergeSMoves (m1@(SMove (LongLinDiff a1 d1)):m2@(SMove (LongLinDiff a2 d2)):cmds)
+  | (a1 /= a2) || (d1 + d2 < -15) || (d1 + d2 > 15)
+      = m1 : (mergeSMoves (m2:cmds))
+  | otherwise = (SMove (LongLinDiff a1 (d1 + d2))) : cmds
+mergeSMoves (cmd:cmds) = cmd : (mergeSMoves cmds)

test/TestOptimizations.hs

@@ -7,7 +7,10 @@ import Optimizations
 import Trace
 
 optimizations :: TestTree
-optimizations = testGroup "Optimizations" [testSplitLMove]
+optimizations = testGroup "Optimizations"
+  [ testSplitLMove
+  , testMergeSMoves
+  ]
 
 testSplitLMove :: TestTree
 testSplitLMove = testGroup "splitLMove"
@@ -32,3 +35,40 @@ testSplitLMove = testGroup "splitLMove"
         splitLMove [LMove a b, Wait, LMove a b, Wait]
         @?= [SMove a', SMove b', LMove a b, Wait]
   ]
+
+testMergeSMoves :: TestTree
+testMergeSMoves = testGroup "mergeSMoves"
+  [ testCase "Empty input" $ mergeSMoves [] @?= []
+
+  , testCase "SMoves on different axis" $
+      let
+        m1 = SMove (LongLinDiff X 13)
+        m2 = SMove (LongLinDiff Y (-11))
+      in mergeSMoves [m1, m2] @?= [m1, m2]
+
+  , testCase "Long SMoves can't be combined" $
+      let
+        m1 = SMove (LongLinDiff X 13)
+        m2 = SMove (LongLinDiff X 11)
+      in mergeSMoves [m1, m2] @?= [m1, m2]
+
+  , testCase "Unoptimal input.1" $
+      let
+        m1 = SMove (LongLinDiff X 4)
+        m2 = SMove (LongLinDiff X 3)
+        result = SMove (LongLinDiff X 7)
+      in mergeSMoves [m1, m2] @?= [result]
+  , testCase "Unoptimal input.2" $
+      let
+        m1 = SMove (LongLinDiff Z (-11))
+        m2 = SMove (LongLinDiff Z (-4))
+        result = SMove (LongLinDiff Z (-15))
+      in mergeSMoves [m1, m2] @?= [result]
+
+  , testCase "Only first occurrence is optimized" $
+      let
+        m1 = SMove (LongLinDiff X 4)
+        m2 = SMove (LongLinDiff X 3)
+        combined = SMove (LongLinDiff X 7)
+      in mergeSMoves [m1, m2, m1, m2] @?= [combined, m1, m2]
+  ]