Copyright | (c) Chris Reade 2021 |
---|---|
License | BSD-style |
Maintainer | chrisreade@mac.com |
Stability | experimental |
Safe Haskell | None |
Language | GHC2021 |
Tgraph.Prelude
Contents
- Types for Tgraphs, Faces, Vertices, Directed Edges
- Property Checking for Tgraphs
- Basic Tgraph and HasFaces operations
- Other Face/Vertex Operations
- Other Edge Operations
- Other Face Operations
- VPatch and Conversions
- Drawing Tgraphs and Vpatches with Labels
- VPatch alignment with vertices
- Drawing Edges with a VPatch or a VertexLocationMap
- Vertex Location and Touching Vertices
Description
Introduces Tgraphs and includes operations on vertices, edges and faces as well as Tgraphs. Plus VPatch (Vertex Patch) as intermediary between Tgraph and Diagram. Conversion and drawing operations to produce Diagrams. The module also includes functions to calculate (relative) locations of vertices (locateVertices, addVPoint), touching vertex checks (touchingVertices, touchingVerticesGen), and edge drawing functions.
This module re-exports module HalfTile and module Try.
Synopsis
- module HalfTile
- module Try
- type TileFace = HalfTile (Vertex, Vertex, Vertex)
- type Vertex = Int
- type VertexSet = IntSet
- type VertexMap a = IntMap a
- type Dedge = (Vertex, Vertex)
- data EdgeType
- data Tgraph
- makeTgraph :: [TileFace] -> Tgraph
- tryMakeTgraph :: [TileFace] -> Try Tgraph
- checkedTgraph :: [TileFace] -> Tgraph
- makeUncheckedTgraph :: [TileFace] -> Tgraph
- class HasFaces a where
- dedges :: HasFaces a => a -> [Dedge]
- vertexSet :: HasFaces a => a -> VertexSet
- vertices :: HasFaces a => a -> [Vertex]
- boundaryVs :: HasFaces a => a -> [Vertex]
- tryTgraphProps :: [TileFace] -> Try Tgraph
- tryConnectedNoCross :: [TileFace] -> Try Tgraph
- tryCorrectTouchingVs :: [TileFace] -> Try Tgraph
- hasEdgeLoops :: HasFaces a => a -> Bool
- duplicates :: Eq a => [a] -> [a]
- edgeType :: Dedge -> TileFace -> EdgeType
- noNewConflict :: TileFace -> [TileFace] -> Bool
- illegalTiling :: [TileFace] -> Bool
- crossingBVs :: HasFaces a => a -> [Vertex]
- crossingBoundaries :: HasFaces a => a -> Bool
- connected :: HasFaces a => a -> Bool
- emptyTgraph :: Tgraph
- nullFaces :: HasFaces a => a -> Bool
- evalFaces :: HasFaces a => a -> a
- ldarts :: HasFaces a => a -> [TileFace]
- rdarts :: HasFaces a => a -> [TileFace]
- lkites :: HasFaces a => a -> [TileFace]
- rkites :: HasFaces a => a -> [TileFace]
- kites :: HasFaces a => a -> [TileFace]
- darts :: HasFaces a => a -> [TileFace]
- internalEdges :: HasFaces a => a -> [Dedge]
- phiEdges :: HasFaces a => a -> [Dedge]
- nonPhiEdges :: HasFaces a => a -> [Dedge]
- defaultAlignment :: HasFaces a => a -> (Vertex, Vertex)
- selectFaces :: [TileFace] -> Tgraph -> Tgraph
- removeFaces :: [TileFace] -> Tgraph -> Tgraph
- removeVertices :: [Vertex] -> Tgraph -> Tgraph
- selectVertices :: [Vertex] -> Tgraph -> Tgraph
- vertexFacesMap :: HasFaces a => [Vertex] -> a -> VertexMap [TileFace]
- makeRD :: Vertex -> Vertex -> Vertex -> TileFace
- makeLD :: Vertex -> Vertex -> Vertex -> TileFace
- makeRK :: Vertex -> Vertex -> Vertex -> TileFace
- makeLK :: Vertex -> Vertex -> Vertex -> TileFace
- faceVs :: TileFace -> (Vertex, Vertex, Vertex)
- faceVList :: TileFace -> [Vertex]
- faceVSet :: TileFace -> VertexSet
- firstV :: TileFace -> Vertex
- secondV :: TileFace -> Vertex
- thirdV :: TileFace -> Vertex
- originV :: TileFace -> Vertex
- wingV :: TileFace -> Vertex
- oppV :: TileFace -> Vertex
- indexV :: Vertex -> TileFace -> Int
- nextV :: Vertex -> TileFace -> Vertex
- prevV :: Vertex -> TileFace -> Vertex
- isAtV :: Vertex -> TileFace -> Bool
- hasVIn :: [Vertex] -> TileFace -> Bool
- faceDedges :: TileFace -> [Dedge]
- reverseD :: Dedge -> Dedge
- joinE :: TileFace -> Dedge
- shortE :: TileFace -> Dedge
- longE :: TileFace -> Dedge
- joinOfTile :: TileFace -> Dedge
- facePhiEdges :: TileFace -> [Dedge]
- faceNonPhiEdges :: TileFace -> [Dedge]
- matchingLongE :: TileFace -> TileFace -> Bool
- matchingShortE :: TileFace -> TileFace -> Bool
- matchingJoinE :: TileFace -> TileFace -> Bool
- hasDedge :: TileFace -> Dedge -> Bool
- hasDedgeIn :: TileFace -> [Dedge] -> Bool
- completeEdges :: HasFaces a => a -> [Dedge]
- edgeNb :: TileFace -> TileFace -> Bool
- dedgesFacesMap :: HasFaces a => [Dedge] -> a -> Map Dedge TileFace
- buildEFMap :: HasFaces a => a -> Map Dedge TileFace
- faceForEdge :: Dedge -> Map Dedge TileFace -> Maybe TileFace
- edgeNbs :: TileFace -> Map Dedge TileFace -> [TileFace]
- lowestJoin :: HasFaces a => a -> Dedge
- data VPatch = VPatch {
- vLocs :: VertexLocMap
- vpFaces :: [TileFace]
- type VertexLocMap = IntMap (Point V2 Double)
- makeVP :: Tgraph -> VPatch
- subVP :: VPatch -> [TileFace] -> VPatch
- relevantVP :: VPatch -> VPatch
- restrictVP :: VPatch -> [TileFace] -> VPatch
- graphFromVP :: VPatch -> Tgraph
- removeFacesVP :: VPatch -> [TileFace] -> VPatch
- selectFacesVP :: VPatch -> [TileFace] -> VPatch
- findLoc :: Vertex -> VPatch -> Maybe (Point V2 Double)
- class DrawableLabelled a where
- labelSize :: (OKBackend b, DrawableLabelled a) => Measure Double -> (Patch -> Diagram b) -> a -> Diagram b
- labelled :: (OKBackend b, DrawableLabelled a) => (Patch -> Diagram b) -> a -> Diagram b
- rotateBefore :: (VPatch -> a) -> Angle Double -> Tgraph -> a
- dropLabels :: VPatch -> Patch
- centerOn :: Vertex -> VPatch -> VPatch
- alignXaxis :: (Vertex, Vertex) -> VPatch -> VPatch
- alignments :: [(Vertex, Vertex)] -> [VPatch] -> [VPatch]
- alignAll :: (Vertex, Vertex) -> [VPatch] -> [VPatch]
- alignBefore :: (VPatch -> a) -> (Vertex, Vertex) -> Tgraph -> a
- makeAlignedVP :: (Vertex, Vertex) -> Tgraph -> VPatch
- drawEdgesVP :: OKBackend b => VPatch -> [Dedge] -> Diagram b
- drawEdgeVP :: OKBackend b => VPatch -> Dedge -> Diagram b
- drawLocatedEdges :: OKBackend b => VertexLocMap -> [Dedge] -> Diagram b
- drawLocatedEdge :: OKBackend b => VertexLocMap -> Dedge -> Diagram b
- locateVertices :: HasFaces a => a -> VertexLocMap
- addVPoint :: TileFace -> VertexLocMap -> VertexLocMap
- touchingVertices :: HasFaces a => a -> [(Vertex, Vertex)]
- touching :: Point V2 Double -> Point V2 Double -> Bool
- touchingVerticesGen :: [TileFace] -> [(Vertex, Vertex)]
- locateVerticesGen :: HasFaces a => a -> VertexLocMap
Documentation
module HalfTile
module Try
Types for Tgraphs, Faces, Vertices, Directed Edges
type TileFace = HalfTile (Vertex, Vertex, Vertex) Source #
A TileFace is a HalfTile with 3 vertex labels (clockwise starting with the origin vertex). Usually referred to simply as a face.
For example a right dart: RD(1,2,3) or a left kite: LK(1,5,6)
Vertex labels are integers. They must be positive for a Tgraph (Checked by makeTgraph).
type VertexMap a = IntMap a Source #
Abbreviation for Mapping from Vertex keys (also used for Boundaries)
Representing Edges:
For vertices a and b, (a,b) is regarded as a directed edge from a to b (a Dedge).
A list of such pairs will usually be regarded as a list of directed edges. In the special case that the list is symmetrically closed [(b,a) is in the list whenever (a,b) is in the list] we will refer to this as an edge list rather than a directed edge list.
A type used to classify edges of faces. Each (halftile) face has a long edge, a short edge and a join edge.
A Tgraph is a newtype for a list of faces (that is [TileFace]). All vertex labels should be positive, so 0 is not used as a vertex label. Tgraphs should be constructed with makeTgraph or checkedTgraph to check required properties. The data constructor Tgraph is not exported (but see also makeUncheckedTgraph).
Use faces to retrieve the list of faces of a Tgraph.
Instances
Forcible Tgraph Source # | Tgraphs are Forcible |
Defined in Tgraph.Force Methods tryFSOpWith :: UpdateGenerator -> (ForceState -> Try ForceState) -> Tgraph -> Try Tgraph Source # tryInitFSWith :: UpdateGenerator -> Tgraph -> Try ForceState Source # tryChangeBoundaryWith :: UpdateGenerator -> (BoundaryState -> Try BoundaryChange) -> Tgraph -> Try Tgraph Source # | |
DrawableLabelled Tgraph Source # | Tgraphs can be drawn with labels |
HasFaces Tgraph Source # | Tgraph is in class HasFaces |
Drawable Tgraph Source # | Tgraphs are Drawable |
Show Tgraph Source # | |
makeTgraph :: [TileFace] -> Tgraph Source #
makeTgraph performs a no touching vertex check as well as using tryTgraphProps for other required properties. It produces an error if either check fails. Note that the other Tgraph properties are checked first, to ensure that calculation of vertex locations can be done for a touching vertex check.
tryMakeTgraph :: [TileFace] -> Try Tgraph Source #
tryMakeTgraph performs the same checks for Tgraph properties as tryTgraphProps but in addition it also checks that there are no touching vertices (distinct labels for the same vertex) using touchingVertices (which calculates vertex locations). It produces Left ... if either check fails and Right g otherwise where g is the Tgraph. Note that the other Tgraph properties are checked first, to ensure that calculation of vertex locations can be done.
checkedTgraph :: [TileFace] -> Tgraph Source #
Creates a Tgraph from a list of faces using tryTgraphProps to check required properties and producing an error if a check fails.
Note: This does not check for touching vertices (distinct labels for the same vertex). To perform this additional check use makeTgraph which also uses tryTgraphProps.
makeUncheckedTgraph :: [TileFace] -> Tgraph Source #
Creates a (possibly invalid) Tgraph from a list of faces. It does not perform checks on the faces.
WARNING: This is intended for use only when checks are known to be redundant. Consider using makeTgraph, tryMakeTgraph or checkedTgraph instead to perform checks.
class HasFaces a where Source #
Class HasFaces for operations using (a list of) TileFaces.
Used to define common functions on [TileFace], Tgraph, VPatch, BoundaryState, Forced, TrackedTgraph
Methods
faces :: a -> [TileFace] Source #
get the tileface list
boundary :: a -> [Dedge] Source #
get the directed edges of the boundary (direction with a tileface on the left and exterior on right).
get the maximum vertex in all faces (0 if there are no faces)
Instances
HasFaces TrackedTgraph Source # | TrackedTgraph is in class HasFaces |
Defined in Tgraph.Extras Methods faces :: TrackedTgraph -> [TileFace] Source # boundary :: TrackedTgraph -> [Dedge] Source # maxV :: TrackedTgraph -> Int Source # | |
HasFaces BoundaryState Source # | BoundaryState is in class HasFaces |
Defined in Tgraph.Force Methods faces :: BoundaryState -> [TileFace] Source # boundary :: BoundaryState -> [Dedge] Source # maxV :: BoundaryState -> Int Source # | |
HasFaces ForceState Source # | ForceState is in class HasFaces |
Defined in Tgraph.Force Methods faces :: ForceState -> [TileFace] Source # boundary :: ForceState -> [Dedge] Source # maxV :: ForceState -> Int Source # | |
HasFaces Tgraph Source # | Tgraph is in class HasFaces |
HasFaces VPatch Source # | VPatch is in class HasFace |
HasFaces a => HasFaces (Forced a) Source # | Extend HasFaces ops from a to Forced a |
HasFaces [TileFace] Source # | A list of tilefaces is in class HasFaces |
dedges :: HasFaces a => a -> [Dedge] Source #
get all the directed edges (directed clockwise round each face)
vertices :: HasFaces a => a -> [Vertex] Source #
An ascending list of the vertices occuring in faces (without duplicates)
boundaryVs :: HasFaces a => a -> [Vertex] Source #
List of boundary vertices May have duplicates when applied to an arbitrary list of TileFace. but no duplicates for Tgraph, VPatch, BoundaryState, Forced, TrackedTgraph.
Property Checking for Tgraphs
tryTgraphProps :: [TileFace] -> Try Tgraph Source #
Checks a list of faces to ensure: no edge loops, no edge conflicts (same directed edge on two or more faces), legal tiling (obeys rules for legal tiling), all vertex labels >0 , no crossing boundaries, and connectedness.
Returns Right g where g is a Tgraph on passing checks. Returns Left lines if a test fails, where lines describes the problem found.
tryConnectedNoCross :: [TileFace] -> Try Tgraph Source #
Checks a list of faces for no crossing boundaries and connectedness. (No crossing boundaries and connected implies tile-connected). Returns Right g where g is a Tgraph on passing checks. Returns Left lines if a test fails, where lines describes the problem found. This is used by tryTgraphProps after other checks have been made, but can be used alone when other properties are known to hold (e.g. in tryPartCompose)
tryCorrectTouchingVs :: [TileFace] -> Try Tgraph Source #
tryCorrectTouchingVs fcs finds touching vertices by calculating locations for vertices in the faces fcs, then renumbers to remove touching vertices (renumbers higher to lower numbers), then checks for Tgraph properties of the resulting faces to produce a Tgraph. NB fcs needs to be tile-connected before the renumbering and the renumbering need not be 1-1 (hence Relabelling is not used)
hasEdgeLoops :: HasFaces a => a -> Bool Source #
Checks if there are repeated vertices within any TileFace for a list of TileFaces. Returns True if there are any.
duplicates :: Eq a => [a] -> [a] Source #
duplicates finds any duplicated items in a list (unique results).
edgeType :: Dedge -> TileFace -> EdgeType Source #
edgeType d f - classifies the directed edge d which must be one of the three directed edges of face f. An error is raised if it is not a directed edge of the face
noNewConflict :: TileFace -> [TileFace] -> Bool Source #
noNewConflict face fcs returns True if face has an illegal shared edge with fcs. It does not check for illegal cases within the fcs.
illegalTiling :: [TileFace] -> Bool Source #
Returns True if there are conflicting directed edges or if there are illegal shared edges in the list of tile faces
crossingBVs :: HasFaces a => a -> [Vertex] Source #
crossingBVs fcs returns a list of vertices where there are crossing boundaries (which should be null for Tgraphs, VPatches, BoundaryStates, Forced, TrackedTgraph).
crossingBoundaries :: HasFaces a => a -> Bool Source #
There are crossing boundaries if vertices occur more than once in the boundary vertices.
connected :: HasFaces a => a -> Bool Source #
Predicate to check if the faces are connected (in graph theory sense).
Basic Tgraph and HasFaces operations
emptyTgraph :: Tgraph Source #
The empty Tgraph
internalEdges :: HasFaces a => a -> [Dedge] Source #
internal edges are shared by two faces. That is, all edges except those at the boundary. Both directions of each internal directed edge will appear in the result.
phiEdges :: HasFaces a => a -> [Dedge] Source #
phiEdges returns a list of the longer (phi-length) edges in the faces (including kite joins). The result includes both directions of each edge.
nonPhiEdges :: HasFaces a => a -> [Dedge] Source #
nonPhiEdges returns a list of the shorter edges in the faces (including dart joins). The result includes both directions of each edge.
defaultAlignment :: HasFaces a => a -> (Vertex, Vertex) Source #
the default alignment of non-empty faces is (v1,v2) where v1 is the lowest numbered face origin, and v2 is the lowest numbered opp vertex of faces with origin at v1. This is the lowest join edge. An error will be raised if the Tgraph is empty.
selectFaces :: [TileFace] -> Tgraph -> Tgraph Source #
selects faces from a Tgraph (removing any not in the list), but checks resulting Tgraph for connectedness and no crossing boundaries.
removeFaces :: [TileFace] -> Tgraph -> Tgraph Source #
removes faces from a Tgraph, but checks resulting Tgraph for connectedness and no crossing boundaries.
removeVertices :: [Vertex] -> Tgraph -> Tgraph Source #
removeVertices vs g - removes any vertex in the list vs from g by removing all faces at those vertices. The resulting Tgraph is checked for required properties e.g. connectedness and no crossing boundaries and will raise an error if these fail.
selectVertices :: [Vertex] -> Tgraph -> Tgraph Source #
selectVertices vs g - removes any face that does not have at least one vertex in the list vs from g. Resulting Tgraph is checked for required properties e.g. connectedness and no crossing boundaries and will raise an error if these fail.
vertexFacesMap :: HasFaces a => [Vertex] -> a -> VertexMap [TileFace] Source #
vertexFacesMap vs a - For list of vertices vs and faces from a, create an IntMap from each vertex in vs to a list of those faces in a that are at that vertex.
Other Face/Vertex Operations
faceVs :: TileFace -> (Vertex, Vertex, Vertex) Source #
triple of face vertices in order clockwise starting with origin - tileRep specialised to TileFace
faceVList :: TileFace -> [Vertex] Source #
list of (three) face vertices in order clockwise starting with origin
firstV :: TileFace -> Vertex Source #
firstV, secondV and thirdV vertices of a face are counted clockwise starting with the origin
secondV :: TileFace -> Vertex Source #
firstV, secondV and thirdV vertices of a face are counted clockwise starting with the origin
thirdV :: TileFace -> Vertex Source #
firstV, secondV and thirdV vertices of a face are counted clockwise starting with the origin
oppV :: TileFace -> Vertex Source #
oppV returns the vertex at the opposite end of the join edge from the origin of a face
indexV :: Vertex -> TileFace -> Int Source #
indexV finds the index of a vertex in a face (firstV -> 0, secondV -> 1, thirdV -> 2)
nextV :: Vertex -> TileFace -> Vertex Source #
nextV returns the next vertex in a face going clockwise from v where v must be a vertex of the face
prevV :: Vertex -> TileFace -> Vertex Source #
prevV returns the previous vertex in a face (i.e. next going anti-clockwise) from v where v must be a vertex of the face
hasVIn :: [Vertex] -> TileFace -> Bool Source #
hasVIn vs f - asks if face f has an element of vs as a vertex
Other Edge Operations
faceDedges :: TileFace -> [Dedge] Source #
directed edges (clockwise) round a face.
joinE :: TileFace -> Dedge Source #
the join directed edge of a face in the clockwise direction going round the face (see also joinOfTile).
shortE :: TileFace -> Dedge Source #
The short directed edge of a face in the clockwise direction going round the face. This is the non-join short edge for darts.
longE :: TileFace -> Dedge Source #
The long directed edge of a face in the clockwise direction going round the face. This is the non-join long edge for kites.
joinOfTile :: TileFace -> Dedge Source #
The join edge of a face directed from the origin (not clockwise for RD and LK)
facePhiEdges :: TileFace -> [Dedge] Source #
The phi edges of a face (both directions) which is long edges for darts, and join and long edges for kites
faceNonPhiEdges :: TileFace -> [Dedge] Source #
The non-phi edges of a face (both directions) which is short edges for kites, and join and short edges for darts.
matchingLongE :: TileFace -> TileFace -> Bool Source #
check if two TileFaces have opposite directions for their long edge.
matchingShortE :: TileFace -> TileFace -> Bool Source #
check if two TileFaces have opposite directions for their short edge.
matchingJoinE :: TileFace -> TileFace -> Bool Source #
check if two TileFaces have opposite directions for their join edge.
hasDedge :: TileFace -> Dedge -> Bool Source #
hasDedge f e returns True if directed edge e is one of the directed edges of face f
hasDedgeIn :: TileFace -> [Dedge] -> Bool Source #
hasDedgeIn f es - is True if face f has a directed edge in the list of directed edges es.
completeEdges :: HasFaces a => a -> [Dedge] Source #
completeEdges returns a list of all the edges of the faces (both directions of each edge).
Other Face Operations
dedgesFacesMap :: HasFaces a => [Dedge] -> a -> Map Dedge TileFace Source #
dedgesFacesMap des a - Produces an edge-face map. Each directed edge in des is associated with a unique face in a that has that directed edge (if there is one). It will report an error if more than one face in a has the same directed edge in des. If the directed edges are all the ones in a, buildEFMap will be more efficient. dedgesFacesMap is intended for a relatively small subset of directed edges in a Tgraph.
buildEFMap :: HasFaces a => a -> Map Dedge TileFace Source #
Build a Map from all directed edges to faces (the unique face containing the directed edge)
faceForEdge :: Dedge -> Map Dedge TileFace -> Maybe TileFace Source #
look up a face for an edge in an edge-face map
edgeNbs :: TileFace -> Map Dedge TileFace -> [TileFace] Source #
Given a tileface (face) and a map from each directed edge to the tileface containing it (efMap) return the list of edge neighbours of face.
lowestJoin :: HasFaces a => a -> Dedge Source #
Return the join edge with lowest origin vertex (and lowest oppV vertex if there is more than one). The resulting edge is always directed from the origin to the opp vertex, i.e (orig,opp).
VPatch and Conversions
A VPatch has a map from vertices to points along with a list of tile faces. It is an intermediate form between Tgraphs and Diagrams
Constructors
VPatch | |
Fields
|
Instances
DrawableLabelled VPatch Source # | VPatches can be drawn with labels |
HasFaces VPatch Source # | VPatch is in class HasFace |
Drawable VPatch Source # | VPatches are drawable |
Show VPatch Source # | |
Transformable VPatch Source # | Make VPatch Transformable. |
Defined in Tgraph.Prelude | |
type N VPatch Source # | needed for making VPatch transformable |
Defined in Tgraph.Prelude | |
type V VPatch Source # | needed for making VPatch transformable |
Defined in Tgraph.Prelude |
type VertexLocMap = IntMap (Point V2 Double) Source #
Abbreviation for finite mappings from Vertex to Location (i.e Point)
makeVP :: Tgraph -> VPatch Source #
Convert a Tgraph to a VPatch. This uses locateVertices to form an intermediate VertexLocMap (mapping of vertices to positions). This makes the join of the face with lowest origin and lowest oppV align on the positive x axis.
subVP :: VPatch -> [TileFace] -> VPatch Source #
Creates a VPatch from a list of tile faces, using the vertex location map from the given VPatch. The vertices in the tile faces should have locations assigned in the given VPatch vertex locations. However THIS IS NOT CHECKED so missing locations for vertices will raise an error when drawing. subVP vp fcs can be used for both subsets of tile faces of vp, and also for larger scale faces which use the same vertex to point assignment (e.g in compositions). The vertex location map is not changed (see also relevantVP and restrictVP).
relevantVP :: VPatch -> VPatch Source #
removes locations for vertices not used in the faces of a VPatch. (Useful when restricting which labels get drawn). relevantVP vp will raise an error if any vertex in the faces of vp is not a key in the location map of vp.
restrictVP :: VPatch -> [TileFace] -> VPatch Source #
A combination of subVP and relevantVP. Restricts a vp to a list of faces, removing locations for vertices not in the faces. (Useful when restricting which labels get drawn) restrictVP vp fcs will raise an error if any vertex in fcs is not a key in the location map of vp.
graphFromVP :: VPatch -> Tgraph Source #
Recover a Tgraph from a VPatch by dropping the vertex positions and checking Tgraph properties.
selectFacesVP :: VPatch -> [TileFace] -> VPatch Source #
make a new VPatch with a list of selected faces from a VPatch. This will ignore any faces that are not in the given VPatch.
findLoc :: Vertex -> VPatch -> Maybe (Point V2 Double) Source #
find the location of a single vertex in a VPatch
Drawing Tgraphs and Vpatches with Labels
class DrawableLabelled a where Source #
A class for things that can be drawn with labels when given a colour and a measure (size) for the label and a a draw function (for Patches). So labelColourSize c m modifies a Patch drawing function to add labels (of colour c and size measure m). Measures are defined in Diagrams. In particular: tiny, verySmall, small, normal, large, veryLarge, huge.
Methods
labelColourSize :: OKBackend b => Colour Double -> Measure Double -> (Patch -> Diagram b) -> a -> Diagram b Source #
Instances
DrawableLabelled Tgraph Source # | Tgraphs can be drawn with labels |
DrawableLabelled VPatch Source # | VPatches can be drawn with labels |
labelSize :: (OKBackend b, DrawableLabelled a) => Measure Double -> (Patch -> Diagram b) -> a -> Diagram b Source #
Default Version of labelColourSize with colour red. Example usage: labelSize tiny draw a , labelSize normal drawj a
labelled :: (OKBackend b, DrawableLabelled a) => (Patch -> Diagram b) -> a -> Diagram b Source #
Default Version of labelColourSize using red and small (rather than normal label size). Example usage: labelled draw a , labelled drawj a
rotateBefore :: (VPatch -> a) -> Angle Double -> Tgraph -> a Source #
rotateBefore vfun a g - makes a VPatch from g then rotates by angle a before applying the VPatch function vfun. Tgraphs need to be rotated after a VPatch is calculated but before any labelled drawing. E.g. rotateBefore (labelled draw) angle graph.
dropLabels :: VPatch -> Patch Source #
converts a VPatch to a Patch, removing vertex information and converting faces to Located Pieces. (Usage can be confined to Drawable VPatch instance and DrawableLabelled VPatch instance.)
VPatch alignment with vertices
centerOn :: Vertex -> VPatch -> VPatch Source #
center a VPatch on a particular vertex. (Raises an error if the vertex is not in the VPatch vertices)
alignXaxis :: (Vertex, Vertex) -> VPatch -> VPatch Source #
alignXaxis takes a vertex pair (a,b) and a VPatch vp for centering vp on a and rotating the result so that b is on the positive X axis. (Raises an error if either a or b are not in the VPatch vertices)
alignments :: [(Vertex, Vertex)] -> [VPatch] -> [VPatch] Source #
alignments takes a list of vertex pairs for respective alignments of VPatches in the second list. For a pair (a,b) the corresponding VPatch is centered on a then b is aligned along the positive x axis. The vertex pair list can be shorter than the list of VPatch - the remaining VPatch are left as they are. (Raises an error if either vertex in a pair is not in the corresponding VPatch vertices)
alignAll :: (Vertex, Vertex) -> [VPatch] -> [VPatch] Source #
alignAll (a,b) vpList provided both vertices a and b exist in each VPatch in vpList, the VPatch are all aligned centred on a, with b on the positive x axis. An error is raised if any VPatch does not contain both a and b vertices.
alignBefore :: (VPatch -> a) -> (Vertex, Vertex) -> Tgraph -> a Source #
alignBefore vfun (a,b) g - makes a VPatch from g oriented with centre on a and b aligned on the x-axis before applying the VPatch function vfun Will raise an error if either a or b is not a vertex in g. Tgraphs need to be aligned after a VPatch is calculated but before any labelled drawing. E.g. alignBefore (labelled draw) (a,b) g
makeAlignedVP :: (Vertex, Vertex) -> Tgraph -> VPatch Source #
makeAlignedVP (a,b) g - make a VPatch from g oriented with centre on a and b aligned on the x-axis. Will raise an error if either a or b is not a vertex in g.
Drawing Edges with a VPatch or a VertexLocationMap
drawEdgesVP :: OKBackend b => VPatch -> [Dedge] -> Diagram b Source #
produce a diagram of a list of edges (given a VPatch) Will raise an error if any vertex of the edges is not a key in the vertex to location mapping of the VPatch.
drawEdgeVP :: OKBackend b => VPatch -> Dedge -> Diagram b Source #
produce a diagram of a single edge (given a VPatch) Will raise an error if either vertex of the edge is not a key in the vertex to location mapping of the VPatch.
drawLocatedEdges :: OKBackend b => VertexLocMap -> [Dedge] -> Diagram b Source #
produce a diagram of a list of edges (given a mapping of vertices to locations) Will raise an error if any vertex of the edges is not a key in the mapping.
drawLocatedEdge :: OKBackend b => VertexLocMap -> Dedge -> Diagram b Source #
produce a diagram of a single edge (given a mapping of vertices to locations). Will raise an error if either vertex of the edge is not a key in the mapping.
Vertex Location and Touching Vertices
locateVertices :: HasFaces a => a -> VertexLocMap Source #
locateVertices: processes a list of faces to associate points for each vertex using a default scale and orientation. The default scale is 1 unit for short edges (phi units for long edges). It aligns the lowest numbered join of the faces on the x-axis, and returns a vertex-to-point Map. It will raise an error if faces are not connected. If faces have crossing boundaries (i.e not locally tile-connected), this could raise an error or a result with touching vertices (i.e. more than one vertex label with the same location).
addVPoint :: TileFace -> VertexLocMap -> VertexLocMap Source #
Given a tileface and a vertex to location map which gives locations for at least 2 of the tileface vertices this returns a new map by adding a location for the third vertex (when missing) or the same map when not missing. It will raise an error if there are fewer than 2 tileface vertices with a location in the map (indicating a non tile-connected face). It is possible that a newly added location is already in the range of the map (creating a touching vertices), so this needs to be checked for.
touchingVertices :: HasFaces a => a -> [(Vertex, Vertex)] Source #
touchingVertices finds if any vertices are too close to each other using locateVertices. If vertices are too close that indicates we may have different vertex labels at the same location (the touching vertex problem). It returns pairs of vertices that are too close with higher number first in each pair, and no repeated first numbers. An empty list is returned if there are no touching vertices. Complexity has order of the square of the number of vertices.
This is used in makeTgraph and fullUnion (via correctTouchingVertices).
touching :: Point V2 Double -> Point V2 Double -> Bool Source #
touching checks if two points are considered close. Close means the square of the distance between them is less than a certain number (currently 0.1) so they cannot be vertex locations for 2 different vertices in a VPatch using unit scale for short edges. It is used in touchingVertices and touchingVerticesGen and Force.touchCheck).
touchingVerticesGen :: [TileFace] -> [(Vertex, Vertex)] Source #
touchingVerticesGen generalises touchingVertices to allow for multiple faces sharing a directed edge. This can arise when applied to the union of faces from 2 Tgraphs which might clash in places. It is used in the calculation of commonFaces.
locateVerticesGen :: HasFaces a => a -> VertexLocMap Source #
locateVerticesGen generalises locateVertices to allow for multiple faces sharing an edge. This can arise when applied to the union of faces from 2 Tgraphs (e.g. in commonFaces)