Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
This module contains helper functions for games that can be modeled as graphs.
It contains a few functions for creating graphs of different shapes and with
different properties. hexHexGraph
, paraHexGraph
, rectOctGraph
, and more.
It also contains a few functions that can automatically implement
PositionalGame
for most cases. These are named after the function
they implement, prefixed with coloredGraph
and the addition of how the
implement them. For example coloredGraphGetVertexPosition
and
coloredGraphSetBidirectedEdgePosition
.
Synopsis
- type ColoredGraph i a b = Map i (a, Map i b)
- class ColoredGraphTransformer i a b g | g -> i, g -> a, g -> b where
- toColoredGraph :: g -> ColoredGraph i a b
- fromColoredGraph :: g -> ColoredGraph i a b -> g
- hexHexGraph :: Int -> ColoredGraph (Int, Int) Position (Int, Int)
- paraHexGraph :: Int -> ColoredGraph (Int, Int) Position (Int, Int)
- rectOctGraph :: Int -> Int -> ColoredGraph (Int, Int) Position (Int, Int)
- triHexGraph :: Int -> ColoredGraph (Int, Int) Position (Int, Int)
- completeGraph :: Int -> ColoredGraph Int () ()
- mapValues :: Ord i => (a -> c) -> ColoredGraph i a b -> ColoredGraph i c b
- mapEdges :: Ord i => (b -> c) -> ColoredGraph i a b -> ColoredGraph i a c
- filterValues :: Ord i => (a -> Bool) -> ColoredGraph i a b -> ColoredGraph i a b
- filterEdges :: (b -> Bool) -> ColoredGraph i a b -> ColoredGraph i a b
- filterG :: Ord i => ((a, Map i b) -> Bool) -> ColoredGraph i a b -> ColoredGraph i a b
- components :: (Eq i, Ord i) => ColoredGraph i a b -> [[i]]
- anyConnections :: Ord i => (Int -> Bool) -> [[i]] -> ColoredGraph i a b -> Maybe [i]
- edgePath :: [a] -> [(a, a)]
- inARow :: (Ord i, Eq b) => (Int -> Bool) -> b -> ColoredGraph i a b -> Maybe [i]
- values :: ColoredGraph i a b -> [a]
- winningSetPaths :: Ord i => ColoredGraph i a b -> [i] -> [i] -> [[i]]
- winningSetPaths' :: Ord i => ColoredGraph i a b -> Map i Bool -> i -> Map i Bool -> Tree (Bool, i)
- coloredGraphVertexPositions :: (ColoredGraphTransformer i a b g, Ord i) => g -> [a]
- coloredGraphSetVertexPosition :: (ColoredGraphTransformer i a b g, Ord i) => g -> i -> a -> Maybe g
- coloredGraphGetVertexPosition :: (ColoredGraphTransformer i a b g, Ord i) => g -> i -> Maybe a
- coloredGraphEdgePositions :: (ColoredGraphTransformer i a b g, Ord i) => g -> [b]
- coloredGraphGetEdgePosition :: (ColoredGraphTransformer i a b g, Ord i) => g -> (i, i) -> Maybe b
- coloredGraphSetEdgePosition :: (ColoredGraphTransformer i a b g, Ord i) => g -> (i, i) -> b -> Maybe g
- coloredGraphSetBidirectedEdgePosition :: (ColoredGraphTransformer i a b g, Ord i) => g -> (i, i) -> b -> Maybe g
Documentation
type ColoredGraph i a b = Map i (a, Map i b) Source #
A Graph with colored vertices and edges. The key of the map is i
, the
"coordinates". The value of the map is a tuple of vertices color a
, and
a list of edges. The edges are tuples of edge color b
and
"target coordinate" i
.
class ColoredGraphTransformer i a b g | g -> i, g -> a, g -> b where Source #
A utility class for transforming to and from ColoredGraph
.
New-types of ColoredGraph
can derive this using the
GeneralizedNewtypeDeriving
language extension.
toColoredGraph :: g -> ColoredGraph i a b Source #
Extracts the ColoredGraph
from a container type.
fromColoredGraph :: g -> ColoredGraph i a b -> g Source #
Inserts the ColoredGraph
into an already existing container type.
Instances
ColoredGraphTransformer i a b (ColoredGraph i a b) Source # | |
Defined in Boardgame.ColoredGraph toColoredGraph :: ColoredGraph i a b -> ColoredGraph i a b Source # fromColoredGraph :: ColoredGraph i a b -> ColoredGraph i a b -> ColoredGraph i a b Source # |
hexHexGraph :: Int -> ColoredGraph (Int, Int) Position (Int, Int) Source #
Creates a hexagon shaped graph of hexagon vertices (each vertex has six outgoing edges) with the given radius.
The "coordinates" of the graph will be '(Int, Int)' where '(0, 0)' is at the center. The color of edges will also be a '(Int, Int)' tuple that shows the "direction" of the edge.
paraHexGraph :: Int -> ColoredGraph (Int, Int) Position (Int, Int) Source #
Creates a parallelogram shaped graph of hexagon vertices (each vertex has six outgoing edges) with the given side length.
The "coordinates" of the graph will be '(Int, Int)' where '(0, 0)' is at the center. The color of edges will also be a '(Int, Int)' tuple that shows the "direction" of the edge.
rectOctGraph :: Int -> Int -> ColoredGraph (Int, Int) Position (Int, Int) Source #
Creates a rectangular shaped graph of octagon vertices (each vertex has eight outgoing edges) with the given width and height.
The "coordinates" of the graph will be '(Int, Int)' where '(0, 0)' the top left vertex. The color of edges will also be a '(Int, Int)' tuple that shows the "direction" of the edge.
triHexGraph :: Int -> ColoredGraph (Int, Int) Position (Int, Int) Source #
Creates a triangular shaped graph of hexagon vertices (each vertex has six outgoing edges) with the given side length.
The "coordinates" of the graph will be '(Int, Int)' where '(1, n-1)', '(n-1, 1)' and '(n-1, n-1)' are the 3 corners. The color of edges will also be a '(Int, Int)' tuple that shows the "direction" of the edge.
completeGraph :: Int -> ColoredGraph Int () () Source #
Creates a complete graph with n vertices.
mapValues :: Ord i => (a -> c) -> ColoredGraph i a b -> ColoredGraph i c b Source #
Maps the values of vertices with the given function.
mapEdges :: Ord i => (b -> c) -> ColoredGraph i a b -> ColoredGraph i a c Source #
Maps the values of edges with the given function.
filterValues :: Ord i => (a -> Bool) -> ColoredGraph i a b -> ColoredGraph i a b Source #
Filters out any vertices whose value is not accepted by the predicate.
filterEdges :: (b -> Bool) -> ColoredGraph i a b -> ColoredGraph i a b Source #
Filters out any edges whose value is not accepted by the predicate.
filterG :: Ord i => ((a, Map i b) -> Bool) -> ColoredGraph i a b -> ColoredGraph i a b Source #
Filters out any vertices whose value, and their outgoing edges with values, is not accepted by the predicate.
components :: (Eq i, Ord i) => ColoredGraph i a b -> [[i]] Source #
A list of all vertices grouped by connected components.
anyConnections :: Ord i => (Int -> Bool) -> [[i]] -> ColoredGraph i a b -> Maybe [i] Source #
For every component of G, count how many groups of nodes they overlap with and check if the predicate holds on the count. If it matches on any component then return that component. We also try to return only the parts of the component that are necessary for our predicate to hold.
edgePath :: [a] -> [(a, a)] Source #
Takes a path of vertices and returns a path of edges. Where the edges are pairs of from and to vertices.
inARow :: (Ord i, Eq b) => (Int -> Bool) -> b -> ColoredGraph i a b -> Maybe [i] Source #
Is there a component along edges with value dir
that has a length
accepted by pred
? If there is we return a subset of that component that
matches the predicate
values :: ColoredGraph i a b -> [a] Source #
Returns a list of vertex values from the given graph.
winningSetPaths :: Ord i => ColoredGraph i a b -> [i] -> [i] -> [[i]] Source #
Returns the winning sets representing paths from one set of nodes to another on a graph.
winningSetPaths' :: Ord i => ColoredGraph i a b -> Map i Bool -> i -> Map i Bool -> Tree (Bool, i) Source #
Returns a tree representing all paths from a starting node too any node in the goal. The paths do not "touch" themselves and they only use a set of allowed nodes. That they don't touch means that we generate exactly the minimum set of winning sets that cover reaching from our starting node to the goal.
coloredGraphVertexPositions :: (ColoredGraphTransformer i a b g, Ord i) => g -> [a] Source #
A standard implementation of positions
for games
with an underlying ColoredGraph
played on the vertices.
For ColoredGraph
s, this is a synonym of values
.
coloredGraphSetVertexPosition :: (ColoredGraphTransformer i a b g, Ord i) => g -> i -> a -> Maybe g Source #
A standard implementation of setPosition
for games
with an underlying ColoredGraph
played on the vertices.
coloredGraphGetVertexPosition :: (ColoredGraphTransformer i a b g, Ord i) => g -> i -> Maybe a Source #
A standard implementation of getPosition
for games
with an underlying ColoredGraph
played on the vertices.
coloredGraphEdgePositions :: (ColoredGraphTransformer i a b g, Ord i) => g -> [b] Source #
A standard implementation of positions
for games
with an underlying ColoredGraph
played on the edges.
coloredGraphGetEdgePosition :: (ColoredGraphTransformer i a b g, Ord i) => g -> (i, i) -> Maybe b Source #
A standard implementation of getPosition
for games
with an underlying ColoredGraph
played on the edges.
coloredGraphSetEdgePosition :: (ColoredGraphTransformer i a b g, Ord i) => g -> (i, i) -> b -> Maybe g Source #
A standard implementation of setPosition
for games
with an underlying ColoredGraph
played on the vertices.
coloredGraphSetBidirectedEdgePosition :: (ColoredGraphTransformer i a b g, Ord i) => g -> (i, i) -> b -> Maybe g Source #
Like coloredGraphSetEdgePosition
but sets the value to the edges in both
directions.