Merge branch 'feature/optimizations'

Author: Minoru

package.yaml

@@ -47,7 +47,7 @@ executables:
 
 tests:
   icfpc2018-test:
-    main:                Spec.hs
+    main:                Test.hs
     source-dirs:         test
     ghc-options:
     - -threaded

src/Optimizations.hs

@@ -0,0 +1,58 @@
+-- | Optimizations for sequences of commands.
+--
+-- Each optimizations replaces first occurrence of a pattern with an optimized
+-- version.  It's up to you to figure out if the result is better than the
+-- input, and if you should re-run optimizations to find new occurrences of
+-- patterns.
+--
+-- WARNING: For now, these functions assume that there is only one nanobot!
+module Optimizations where
+
+import Control.Monad (forM)
+
+import Trace
+
+import Debug.Trace
+
+-- | Returns all possible optimizations of a given command sequence.
+optimize :: [Command] -> [[Command]]
+optimize [] = []
+optimize cmds = go [cmds] [cmds]
+  where
+  go :: [[Command]] -> [[Command]] -> [[Command]]
+  go [] optimized = optimized
+  go (t:stack) optimized =
+    let
+      new = map (\f -> f t) optimizers
+      new' = filter (/= t) new
+    in go (new' ++ stack) (new' ++ optimized)
+
+  optimizers :: [[Command] -> [Command]]
+  optimizers = [splitLMove, mergeSMoves]
+
+-- | Turns [LMove a b, Wait] into [SMove a, SMove b]
+--
+-- The latter consumes 4 less energy points than the former.
+--
+-- Note: it doesn't make sense to split [LMove a b] into two SMoves because the
+-- extra step will consume 3 R³ energy points, which is detrimental for any
+-- R greater than one.
+splitLMove :: [Command] -> [Command]
+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 =
+      let d = d1 + d2
+      in if d == 0
+        then cmds
+        else (SMove (LongLinDiff a1 d)) : cmds
+mergeSMoves (cmd:cmds) = cmd : (mergeSMoves cmds)

src/Trace.hs

@@ -167,6 +167,12 @@ instance Coded Command where
 
         | otherwise = error "Command.decode: invalid input"
 
+-- | Converts short linear difference into a long linear difference.
+--
+-- This conversion is valid since any short linear difference satisfies
+-- mlen(ld) ≤ 5, which also satisfies LongLinDiff's predicate of mlen(ld) ≤ 15.
+fromShortLinDiff :: ShortLinDiff -> LongLinDiff
+fromShortLinDiff (ShortLinDiff axis diff) = LongLinDiff axis diff
 
 encodeL :: Coded a => a -> L.ByteString
 encodeL x = runPutL . runEncode $ encode x >> flush

test/Test.hs

@@ -0,0 +1,10 @@
+import Test.Tasty
+
+import TestSpec
+import TestOptimizations
+
+main :: IO ()
+main = defaultMain tests
+
+tests :: TestTree
+tests = testGroup "Tests" [specExamples, codec, optimizations]

test/TestOptimizations.hs

@@ -0,0 +1,79 @@
+module TestOptimizations where
+
+import Test.Tasty
+import Test.Tasty.HUnit
+
+import Optimizations
+import Trace
+
+optimizations :: TestTree
+optimizations = testGroup "Optimizations"
+  [ testSplitLMove
+  , testMergeSMoves
+  ]
+
+testSplitLMove :: TestTree
+testSplitLMove = testGroup "splitLMove"
+  [
+    testCase "Empty input" $ splitLMove [] @?= []
+
+  , testCase "Unoptimal input" $
+      let
+        a = ShortLinDiff X 3
+        a' = fromShortLinDiff a
+        b = ShortLinDiff Z (-1)
+        b' = fromShortLinDiff b
+      in splitLMove [LMove a b, Wait] @?= [SMove a', SMove b']
+
+  , testCase "Only first occurrence is optimized" $
+      let
+        a = ShortLinDiff X 3
+        a' = fromShortLinDiff a
+        b = ShortLinDiff Z (-1)
+        b' = fromShortLinDiff b
+      in
+        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 "Unoptimal input.3" $
+      let
+        m1 = SMove (LongLinDiff Y (-3))
+        m2 = SMove (LongLinDiff Y 3)
+      in mergeSMoves [m1, m2] @?= []
+
+  , 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]
+  ]

test/Spec.hs test/TestSpec.hstest/Spec.hs renamed to test/TestSpec.hs

@@ -1,5 +1,10 @@
 {-# LANGUAGE BinaryLiterals #-}
 
+module TestSpec (
+  specExamples,
+  codec
+) where
+
 import Test.Tasty
 import Test.Tasty.HUnit
 
@@ -15,12 +20,6 @@ assert :: String -> Bool -> IO ()
 assert _ True = return ()
 assert message False = fail message
 
-main :: IO ()
-main = defaultMain tests
-
-tests :: TestTree
-tests = testGroup "Tests" [specExamples, codec]
-
 specExamples :: TestTree
 specExamples = testGroup "Specification examples"
   [