PenroseKiteDart-1.0.0: Library to explore Penrose's Kite and Dart Tilings.
Copyright(c) Chris Reade 2021
LicenseBSD-style
Maintainerchrisreade@mac.com
Stabilityexperimental
Safe HaskellSafe-Inferred
LanguageHaskell2010

Tgraph.Prelude

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 Tgraph.Try.

Synopsis

Documentation

module HalfTile

module Tgraph.Try

Types for Tgraphs, Faces, Vertices, Directed Edges

data Tgraph Source #

A Tgraph is a list of faces. 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).

Instances

Instances details
Forcible Tgraph Source #

Tgraphs are Forcible

Instance details

Defined in Tgraph.Force

DrawableLabelled Tgraph Source #

Tgraphs can be drawn with labels

Instance details

Defined in Tgraph.Prelude

Drawable Tgraph Source #

Tgraphs are Drawable

Instance details

Defined in Tgraph.Prelude

Show Tgraph Source # 
Instance details

Defined in Tgraph.Prelude

type TileFace = HalfTile (Vertex, Vertex, Vertex) Source #

Tgraph faces (vertices clockwise starting with tile origin vertex) a specialisation of HalfTile

type Vertex = Int Source #

Tgraph vertices (must be positive)

type VertexSet = IntSet Source #

Vertex Sets

type VertexMap a = IntMap a Source #

Abbreviation for Mapping from Vertex keys (also used for Boundaries)

Edges: (a,b) is regarded as a directed edge from a to b. 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.

type Dedge = (Vertex, Vertex) Source #

directed edge

data EdgeType Source #

type used to classify edges of faces

Constructors

Short 
Long 
Join 

Instances

Instances details
Show EdgeType Source # 
Instance details

Defined in Tgraph.Prelude

Eq EdgeType Source # 
Instance details

Defined in Tgraph.Prelude

Property Checking for Tgraphs

makeUncheckedTgraph :: [TileFace] -> Tgraph Source #

Creates a (possibly invalid) Tgraph from a list of faces. It does not perform checks on the faces. Use makeTgraph (defined in Tgraphs module) or checkedTgraph to perform checks. This is intended for use only when checks are known to be redundant (the data constructor Tgraph is hidden).

checkedTgraph :: [TileFace] -> Tgraph Source #

Creates a Tgraph from a list of faces AND checks for edge loops, edge conflicts and crossing boundaries and connectedness and legal tiling with tryTgraphProps. (No crossing boundaries and connected implies tile-connected). Produces 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 (defined in Tgraphs module) which also calls tryTgraphProps.

tryTgraphProps :: [TileFace] -> Try Tgraph Source #

Checks a list of faces to avoid: edge loops, edge conflicts (same directed edge on two or more faces), illegal tilings (breaking legal rules for tiling), vertices not all >0 , crossing boundaries, and non-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)

hasEdgeLoops :: [TileFace] -> Bool Source #

Checks if there are repeated vertices within a tileface for a list of tilefaces. Returns True if there are any.

duplicates :: Eq a => [a] -> [a] Source #

duplicates finds duplicated items in a list (reverses order but 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

crossingVertices :: [Dedge] -> [Vertex] Source #

Given a list of directed boundary edges, crossingVertices returns a list of vertices occurring more than once at the start of the directed edges in the list. Used for finding crossing boundary vertices when the boundary is already calculated.

crossingBoundaries :: [TileFace] -> Bool Source #

There are crossing boundaries if vertices occur more than once at the start of all boundary directed edges (or more than once at the end of all boundary directed edges).

connected :: [TileFace] -> Bool Source #

Predicate to check a Tgraph is a connected graph.

Basic Tgraph operations

faces :: Tgraph -> [TileFace] Source #

Retrieve the faces of a Tgraph

emptyTgraph :: Tgraph Source #

The empty Tgraph

nullGraph :: Tgraph -> Bool Source #

is the Tgraph empty?

maxV :: Tgraph -> Int Source #

find the maximum vertex number in a Tgraph, returning 0 for an empty Tgraph.

ldarts :: Tgraph -> [TileFace] Source #

selecting left darts from a Tgraph

rdarts :: Tgraph -> [TileFace] Source #

selecting right darts from a Tgraph

lkites :: Tgraph -> [TileFace] Source #

selecting left kites from a Tgraph

rkites :: Tgraph -> [TileFace] Source #

selecting right kites from a Tgraph

kites :: Tgraph -> [TileFace] Source #

selecting half kites from a Tgraph

darts :: Tgraph -> [TileFace] Source #

selecting half darts from a Tgraph

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. Resulting Tgraph is checked for required properties e.g. connectedness and no crossing boundaries.

selectVertices :: [Vertex] -> Tgraph -> Tgraph Source #

selectVertices vs g - removes any face that does not have a vertex in the list vs from g. Resulting Tgraph is checked for required properties e.g. connectedness and no crossing boundaries.

vertexSet :: Tgraph -> VertexSet Source #

the set of vertices of a Tgraph

graphDedges :: Tgraph -> [Dedge] Source #

A list of all the directed edges of a Tgraph (going clockwise round faces)

graphEdges :: Tgraph -> [Dedge] Source #

graphEdges returns a list of all the edges of a Tgraph (both directions of each edge).

internalEdges :: Tgraph -> [Dedge] Source #

internal edges are shared by two faces = all edges except boundary edges

graphBoundary :: Tgraph -> [Dedge] Source #

graphBoundary g are missing reverse directed edges in graphDedges g (the result contains single directions only) Direction is such that a face is on LHS and exterior is on RHS of each boundary directed edge.

phiEdges :: Tgraph -> [Dedge] Source #

phiEdges returns a list of the longer (phi-length) edges of a Tgraph (including kite joins). This includes both directions of each edge.

nonPhiEdges :: Tgraph -> [Dedge] Source #

nonPhiEdges returns a list of the shorter edges of a Tgraph (including dart joins). This includes both directions of each edge.

graphEFMap :: Tgraph -> Map Dedge TileFace Source #

graphEFMap g - is a mapping associating with each directed edge of g, the unique TileFace with that directed edge. This is more efficient than using dedgesFacesMap for the complete mapping.

defaultAlignment :: Tgraph -> (Vertex, Vertex) Source #

the default alignment of a non-empty Tgraph 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 of g. An error will be raised if the Tgraph is empty.

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

faceVSet :: TileFace -> VertexSet Source #

the set of vertices of a face

facesVSet :: [TileFace] -> VertexSet Source #

the set of vertices of a list of faces

facesMaxV :: [TileFace] -> Vertex Source #

find the maximum vertex for a list of faces (0 for an empty list).

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

originV :: TileFace -> Vertex Source #

the origin vertex of a face (firstV)

wingV :: TileFace -> Vertex Source #

wingV returns the vertex not on the join edge of a face

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

isAtV :: Vertex -> TileFace -> Bool Source #

isAtV v f asks if a face f has v as a vertex

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.

facesDedges :: [TileFace] -> [Dedge] Source #

Returns the list of all directed edges (clockwise round each) of a list of tile faces.

reverseD :: Dedge -> Dedge Source #

opposite directed edge.

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.

facesEdges :: [TileFace] -> [Dedge] Source #

facesEdges returns a list of all the edges of a list of TileFaces (both directions of each edge).

facesBoundary :: [TileFace] -> [Dedge] Source #

facesBoundary fcs are missing reverse directed edges in facesDedges fcs (the result contains single directions only) Direction is such that a face is on LHS and exterior is on RHS of each boundary directed edge.

Other Face Operations

edgeNb :: TileFace -> TileFace -> Bool Source #

two tile faces are edge neighbours

vertexFacesMap :: [Vertex] -> [TileFace] -> VertexMap [TileFace] Source #

vertexFacesMap vs fcs - For list of vertices vs and list of faces fcs, create an IntMap from each vertex in vs to a list of those faces in fcs that are at that vertex.

dedgesFacesMap :: [Dedge] -> [TileFace] -> Map Dedge TileFace Source #

dedgesFacesMap des fcs - Produces an edge-face map. Each directed edge in des is associated with a unique TileFace in fcs that has that directed edge (if there is one). It will report an error if more than one TileFace in fcs has the same directed edge in des. If the directed edges and faces are all those from a Tgraph, graphEFMap will be more efficient. dedgesFacesMap is intended for a relatively small subset of directed edges in a Tgraph.

buildEFMap :: [TileFace] -> Map Dedge TileFace Source #

Build a Map from 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 :: [TileFace] -> 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

data VPatch Source #

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 

Instances

Instances details
DrawableLabelled VPatch Source #

VPatches can be drawn with labels

Instance details

Defined in Tgraph.Prelude

Drawable VPatch Source #

VPatches are drawable

Instance details

Defined in Tgraph.Prelude

Show VPatch Source # 
Instance details

Defined in Tgraph.Prelude

Transformable VPatch Source #

Make VPatch Transformable.

Instance details

Defined in Tgraph.Prelude

type N VPatch Source #

needed for making VPatch transformable

Instance details

Defined in Tgraph.Prelude

type N VPatch = Double
type V VPatch Source #

needed for making VPatch transformable

Instance details

Defined in Tgraph.Prelude

type V VPatch = V2

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.

removeFacesVP :: VPatch -> [TileFace] -> VPatch Source #

remove a list of faces from a VPatch

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.

Instances

Instances details
DrawableLabelled Tgraph Source #

Tgraphs can be drawn with labels

Instance details

Defined in Tgraph.Prelude

DrawableLabelled VPatch Source #

VPatches can be drawn with labels

Instance details

Defined in Tgraph.Prelude

labelSize :: (Renderable (Path V2 Double) b, Renderable (Text Double) b, DrawableLabelled a) => Measure Double -> (Patch -> Diagram2D b) -> a -> Diagram2D b Source #

Default Version of labelColourSize with colour red. Example usage: labelSize tiny draw a , labelSize normal drawj a

When a specific Backend B is in scope, labelSize :: DrawableLabelled a => Measure Double -> (Patch -> Diagram B) -> a -> Diagram B

labelled :: (Renderable (Path V2 Double) b, Renderable (Text Double) b, DrawableLabelled a) => (Patch -> Diagram2D b) -> a -> Diagram2D b Source #

Default Version of labelColourSize using red and small (rather than normal label size). Example usage: labelled draw a , labelled drawj a

When a specific Backend B is in scope, labelled :: DrawableLabelled a => (Patch -> Diagram B) -> a -> Diagram B

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 alignmants 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 :: Renderable (Path V2 Double) b => VPatch -> [Dedge] -> Diagram2D 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.

When a specific Backend B is in scope, drawEdgesVP :: VPatch -> [Dedge] -> Diagram B

drawEdgeVP :: Renderable (Path V2 Double) b => VPatch -> Dedge -> Diagram2D 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.

When a specific Backend B is in scope, drawEdgeVP :: VPatch -> Dedge -> Diagram B

drawEdges :: Renderable (Path V2 Double) b => VertexLocMap -> [Dedge] -> Diagram2D 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.

When a specific Backend B is in scope, drawEdges :: VertexLocMap -> [Dedge] -> Diagram B

drawEdge :: Renderable (Path V2 Double) b => VertexLocMap -> Dedge -> Diagram2D 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.

When a specific Backend B is in scope, drawEdge :: VertexLocMap -> Dedge -> Diagram B

Vertex Location and Touching Vertices

locateVertices :: [TileFace] -> VertexLocMap Source #

locateVertices: processes a list of faces to associate points for each vertex. 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 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.

axisJoin :: TileFace -> VertexLocMap Source #

axisJoin face initialises a vertex to point mapping with locations for the join edge vertices of face with originV face at the origin and aligned along the x axis with unit length for a half dart and length phi for a half kite. (Used to initialise locateVertices)

touchingVertices :: [TileFace] -> [(Vertex, Vertex)] Source #

touchingVertices checks that no vertices are too close to each other using locateVertices. If vertices are too close that indicates we may have different vertex numbers at the same location (the touching vertex problem). It returns pairs of vertices that are too close (higher number first in each pair) 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).

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 :: [TileFace] -> 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)