mirror of
https://github.com/swarm-game/swarm.git
synced 2024-09-11 14:46:33 +03:00
Add wave program to benchmarks (#1576)
* add wave program and parametrise it to compare inlined/generic version * use [`tasty-bench`](https://hackage.haskell.org/package/tasty-bench) library to show comparison * move benchmarks to test folder as they can now share tasty code * closes #1574 Using the recursive definition with ifs leads to a 3x slowdown: ``` wavesInlined 10: OK 361 ms ± 29 ms 20: OK 718 ms ± 35 ms 30: OK 1.066 s ± 28 ms 40: OK 1.437 s ± 37 ms wavesWithDef 10: OK 1.052 s ± 51 ms, 2.92x 20: OK 2.117 s ± 34 ms, 2.95x 30: OK 3.144 s ± 80 ms, 2.95x 40: OK 4.191 s ± 91 ms, 2.92x ``` But if we just inline and simplify the code, we can remove the runtime overhead completely.
This commit is contained in:
parent
4e886e0c3c
commit
2c3fc525c9
@ -3,4 +3,4 @@
|
||||
SCRIPT_DIR=$( cd -- "$( dirname -- "${BASH_SOURCE[0]}" )" &> /dev/null && pwd )
|
||||
cd $SCRIPT_DIR/..
|
||||
|
||||
fourmolu --mode=inplace src app test bench
|
||||
fourmolu --mode=inplace src app test
|
@ -396,10 +396,9 @@ test-suite swarm-integration
|
||||
benchmark benchmark
|
||||
import: stan-config, common, ghc2021-extensions
|
||||
main-is: Benchmark.hs
|
||||
hs-source-dirs: bench
|
||||
hs-source-dirs: test/bench
|
||||
type: exitcode-stdio-1.0
|
||||
build-depends: criterion >= 1.6.0.0 && < 1.7,
|
||||
-- Import shared with the library don't need bounds
|
||||
build-depends: tasty-bench >= 0.3.1 && < 0.4,
|
||||
base,
|
||||
lens,
|
||||
linear,
|
||||
@ -407,6 +406,6 @@ benchmark benchmark
|
||||
random,
|
||||
swarm,
|
||||
text,
|
||||
containers
|
||||
containers,
|
||||
default-language: Haskell2010
|
||||
ghc-options: -threaded
|
||||
|
@ -9,8 +9,6 @@ import Control.Lens ((&), (.~), (^.))
|
||||
import Control.Monad (replicateM_)
|
||||
import Control.Monad.Except (runExceptT)
|
||||
import Control.Monad.State (evalStateT, execStateT)
|
||||
import Criterion.Main (Benchmark, bench, bgroup, defaultConfig, defaultMainWith, whnfAppIO)
|
||||
import Criterion.Types (Config (timeLimit))
|
||||
import Data.Map qualified as M
|
||||
import Swarm.Game.CESK (emptyStore, initMachine)
|
||||
import Swarm.Game.Display (defaultRobotDisplay)
|
||||
@ -24,9 +22,11 @@ import Swarm.Game.World (WorldFun (..), newWorld)
|
||||
import Swarm.Language.Context qualified as Context
|
||||
import Swarm.Language.Pipeline (ProcessedTerm)
|
||||
import Swarm.Language.Pipeline.QQ (tmQ)
|
||||
import Swarm.Language.Syntax
|
||||
import Swarm.TUI.Model (gameState)
|
||||
import Swarm.TUI.Model.StateUpdate (classicGame0)
|
||||
import Swarm.Util.Erasable
|
||||
import Test.Tasty.Bench (Benchmark, bcompare, bench, bgroup, defaultMain, whnfAppIO)
|
||||
|
||||
-- | The program of a robot that does nothing.
|
||||
idleProgram :: ProcessedTerm
|
||||
@ -74,6 +74,40 @@ circlerProgram =
|
||||
)
|
||||
|]
|
||||
|
||||
-- | The program of a robot that moves back and forth.
|
||||
--
|
||||
-- Each robot in a line starts a tick later, forming a wave.
|
||||
-- See data/scenarios/Challenges/wave.yaml
|
||||
--
|
||||
-- This is used to compare the performance degradation caused
|
||||
-- by using definitions and chains of ifs. Ideally there should
|
||||
-- not be cost if the code is inlined and simplified. TODO: #1557
|
||||
waveProgram :: Bool -> ProcessedTerm
|
||||
waveProgram manualInline =
|
||||
let inlineDef = if manualInline then (1 :: Integer) else 0
|
||||
in [tmQ|
|
||||
def doN = \n. \f. if (n > 0) {f; doN (n - 1) f} {}; end;
|
||||
def crossPath =
|
||||
if ($int:inlineDef == 0) {
|
||||
doN 6 move;
|
||||
} {
|
||||
move; move; move; move; move; move;
|
||||
};
|
||||
turn back;
|
||||
wait 5;
|
||||
end;
|
||||
def go =
|
||||
crossPath;
|
||||
go;
|
||||
end;
|
||||
def start =
|
||||
pos <- whereami;
|
||||
wait $ fst pos;
|
||||
go;
|
||||
end;
|
||||
start;
|
||||
|]
|
||||
|
||||
-- | Initializes a robot with program prog at location loc facing north.
|
||||
initRobot :: ProcessedTerm -> Location -> TRobot
|
||||
initRobot prog loc = mkRobot () Nothing "" mempty (Just $ Cosmic DefaultRootSubworld loc) north defaultRobotDisplay (initMachine prog Context.empty emptyStore) [] [] False False mempty 0
|
||||
@ -97,26 +131,35 @@ runGame numGameTicks = evalStateT (replicateM_ numGameTicks gameTick)
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
idlers <- mkGameStates idleProgram [10, 20 .. 40]
|
||||
trees <- mkGameStates treeProgram [10, 20 .. 40]
|
||||
circlers <- mkGameStates circlerProgram [10, 20 .. 40]
|
||||
movers <- mkGameStates moverProgram [10, 20 .. 40]
|
||||
idlers <- mkGameStates idleProgram
|
||||
trees <- mkGameStates treeProgram
|
||||
circlers <- mkGameStates circlerProgram
|
||||
movers <- mkGameStates moverProgram
|
||||
wavesInlined <- mkGameStates (waveProgram True)
|
||||
wavesWithDef <- mkGameStates (waveProgram False)
|
||||
-- In theory we should force the evaluation of these game states to normal
|
||||
-- form before running the benchmarks. In practice, the first of the many
|
||||
-- criterion runs for each of these benchmarks doesn't look like an outlier.
|
||||
defaultMainWith
|
||||
(defaultConfig {timeLimit = 10})
|
||||
defaultMain
|
||||
[ bgroup
|
||||
"run 1000 game ticks"
|
||||
[ bgroup "idlers" (toBenchmarks idlers)
|
||||
, bgroup "trees" (toBenchmarks trees)
|
||||
, bgroup "circlers" (toBenchmarks circlers)
|
||||
, bgroup "movers" (toBenchmarks movers)
|
||||
, bgroup "wavesInlined" (toBenchmarks wavesInlined)
|
||||
, bgroup
|
||||
"wavesWithDef"
|
||||
( zipWith (\i -> bcompare ("wavesInlined." <> show i)) robotNumbers $
|
||||
toBenchmarks wavesWithDef
|
||||
)
|
||||
]
|
||||
]
|
||||
where
|
||||
mkGameStates :: ProcessedTerm -> [Int] -> IO [(Int, GameState)]
|
||||
mkGameStates prog sizes = zip sizes <$> mapM (mkGameState (initRobot prog)) sizes
|
||||
robotNumbers = [10, 20 .. 40]
|
||||
|
||||
mkGameStates :: ProcessedTerm -> IO [(Int, GameState)]
|
||||
mkGameStates prog = zip robotNumbers <$> mapM (mkGameState (initRobot prog)) robotNumbers
|
||||
|
||||
toBenchmarks :: [(Int, GameState)] -> [Benchmark]
|
||||
toBenchmarks gameStates =
|
Loading…
Reference in New Issue
Block a user