tvl-depot/test/Xanthous/Util/GraphSpec.hs
Griffin Smith e76567b9e7 Add dungeon level generation
Add a dungeon level generator, which:

1. generates an infinite sequence of rectangular rooms within the
   dimensions of the level
2. removes any duplicates from that sequence
3. Generates a graph from the delaunay triangulation of the centerpoints
   of those rooms
4. Generates the minimum-spanning-tree of that delaunay triangulation,
   with weights given by line length in points
5. Adds back a subset (default 10-15%) of edges from the delaunay
   triangulation to the graph
6. Uses the resulting graph to draw corridors between the rooms, using a
   random point on the near edge of each room to pick the points of the
   corridors
2019-12-30 11:31:56 -05:00

39 lines
1.5 KiB
Haskell

module Xanthous.Util.GraphSpec (main, test) where
--------------------------------------------------------------------------------
import Test.Prelude
--------------------------------------------------------------------------------
import Xanthous.Util.Graph
import Data.Graph.Inductive.Basic
import Data.Graph.Inductive.Graph (labNodes, size, order)
import Data.Graph.Inductive.PatriciaTree
import Data.Graph.Inductive.Arbitrary
--------------------------------------------------------------------------------
main :: IO ()
main = defaultMain test
test :: TestTree
test = testGroup "Xanthous.Util.Graph"
[ testGroup "mstSubGraph"
[ testProperty "always produces a subgraph"
$ \(CG _ (graph :: Gr Int Int)) ->
let msg = mstSubGraph $ undir graph
in counterexample (show msg)
$ msg `isSubGraphOf` undir graph
, testProperty "returns a graph with the same nodes"
$ \(CG _ (graph :: Gr Int Int)) ->
let msg = mstSubGraph graph
in counterexample (show msg)
$ labNodes msg === labNodes graph
, testProperty "has nodes - 1 edges"
$ \(CG _ (graph :: Gr Int Int)) ->
order graph > 1 ==>
let msg = mstSubGraph graph
in counterexample (show msg)
$ size msg === order graph - 1
, testProperty "always produces a simple graph"
$ \(CG _ (graph :: Gr Int Int)) ->
let msg = mstSubGraph graph
in counterexample (show msg) $ isSimple msg
]
]