PenroseKiteDart 1.5 → 1.5.1

raw patch · 10 files changed

+398/−207 lines, 10 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +33/−0
• PenroseKiteDart.cabal +11/−11
• src/Tgraph/Compose.hs +19/−14
• src/Tgraph/Decompose.hs +1/−1
• src/Tgraph/Extras.hs +87/−52
• src/Tgraph/Force.hs +23/−12
• src/Tgraph/Prelude.hs +153/−91
• src/TgraphExamples.hs +6/−6
• src/TileLib.hs +27/−3
• src/TileLibP3.hs +38/−17

@@ -1,5 +1,38 @@ # Revision history for PenroseKiteDart +## version v1.5.1++possibly breaking:+    added boundaryVFMap to class HasFaces++generalised:+    boundaryJoinFaces+    drawBoundaryJoins+    drawJoinsFor+added:+    boundaryEFMap+    smartOn (replacing deprecated restrictSmart)+    restrictTo (replacing deprecated restrictVP)+    subFaces (replacing deprecated subVP)+    boundaryVFaces (replacing deprecated boundaryFaces)+    boundaryEdgeFaces+    removeFacesFromVP (replacing deprecated removeFacesVP)+    removeVerticesFromVP+    selectVerticesFromVP+deprecated:+    selectFacesVP+    restrictSmart+    restrictVP+    subVP+    boundaryFaces+    removeFacesVP++warning avoided for import of foldl'++joinDashing changed appearance (no longer ultraThin by default)+added: dashJOnly, drawJPiece, and drawJ +(alongside dashjOnly, drawjPiece, and drawj which still use ultraThin) + ## version v1.5 2025-8-9  Changes to composing.

@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.37.0.+-- This file has been generated from package.yaml by hpack version 0.38.1. -- -- see: https://github.com/sol/hpack  name:           PenroseKiteDart-version:        1.5+version:        1.5.1 synopsis:       Library to explore Penrose's Kite and Dart Tilings. description:    Library to explore Penrose's Kite and Dart Tilings using Haskell Diagrams. Please see README.md category:       Graphics@@ -46,9 +46,9 @@       src   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints   build-depends:-      base >=4.7 && <5-    , containers >=0.6.7 && <0.7-    , diagrams-lib >=1.4.6 && <1.5+      base >=4.9 && <4.22+    , containers >=0.6.7 && <0.8+    , diagrams-lib >=1.4.6 && <1.6   default-language: GHC2021  test-suite PenroseKiteDart-test@@ -61,9 +61,9 @@   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N   build-depends:       PenroseKiteDart-    , base >=4.7 && <5-    , containers >=0.6.7 && <0.7-    , diagrams-lib >=1.4.6 && <1.5+    , base >=4.9 && <4.22+    , containers >=0.6.7 && <0.8+    , diagrams-lib >=1.4.6 && <1.6     , hspec >=2.10.10 && <2.12   default-language: GHC2021 @@ -77,7 +77,7 @@   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N   build-depends:       PenroseKiteDart-    , base >=4.7 && <5-    , containers >=0.6.7 && <0.7-    , diagrams-lib >=1.4.6 && <1.5+    , base >=4.9 && <4.22+    , containers >=0.6.7 && <0.8+    , diagrams-lib >=1.4.6 && <1.6   default-language: GHC2021

@@ -7,10 +7,11 @@ Stability   : experimental  This module includes the main composition operations compose, partCompose,-tryPartCompose, composeF, and partComposeF but also exposes +tryPartCompose and the more efficient versions composeF, partComposeF (for explicitly forced Tgraphs).+It also exposes  auxiliary functions tryGetDartWingInfo, getDartWingInfoForced (and type DartWingInfo)-and partCompFacesFrom for debugging.+and partComposeFacesFrom for debugging. -} {-# LANGUAGE Strict             #-}  @@ -39,7 +40,9 @@   , oldPartCompose   ) where -import Data.List (find, foldl', (\\),partition, nub)+import Data.List (find,(\\),partition,nub)+import Prelude hiding (Foldable(..))+import Data.Foldable (Foldable(..)) import qualified Data.IntMap.Strict as VMap (IntMap,lookup,(!),alter,empty,elems) import Data.Maybe (mapMaybe) import qualified Data.IntSet as IntSet (empty,insert,toList,member)@@ -48,7 +51,7 @@ import Tgraph.Force ( Forced(), forgetF, labelAsForced, tryForceF ) {------------------------------------------------------------------------- ***************************************************************************              -COMPOSING compose, partCompose, tryPartCompose, uncheckedPartCompose+COMPOSING compose, partCompose, tryPartCompose, ... *************************************************************************** ---------------------------------------------------------------------------} @@ -114,7 +117,9 @@ -- |partComposeF fg - produces a pair consisting of remainder faces (faces from fg which will not compose)  -- and a composed (Forced) Tgraph. -- Since fg is a forced Tgraph it does not need a check for validity of the composed Tgraph.--- The fact that the result is also Forced relies on a theorem.+-- The fact that the function is total and the result is also Forced relies on theorems+-- established for composing.+-- The calculation of remainder faces is also more efficient with a known forced Tgraph. partComposeF:: Forced Tgraph -> ([TileFace], Forced Tgraph) partComposeF fg = (remainder, labelAsForced $ makeUncheckedTgraph newfaces) where   (~remainder,newfaces) = partCompFacesAssumeF True $ getDartWingInfoForced fg@@ -163,13 +168,6 @@     do fg <- onFail "tryGetDartWingInfo: incorrect Tgraph found.\n" $ tryForceF g        return $ getDWIassumeF False g fg --- | oldGetDartWingInfo g, classifies the dart wings in g and calculates a faceMap for each dart wing,--- returning as DartWingInfo. If only uses local information to classify each dart wing and can--- therefore sometimes classify a dart wing as unknown unnecessarily.--- In contrast tryGetDartWingInfo is accurate using information from forcing (so is not local)-oldGetDartWingInfo:: Tgraph -> DartWingInfo-oldGetDartWingInfo = oldGetDWIassumeF False- -- | getDartWingInfoForced fg (fg an explicitly Forced Tgraph) classifies the dart wings in fg -- and calculates a faceMap for each dart wing, returning as DartWingInfo. -- The classification is much simplified knowing that the Tgraph is forced.@@ -238,7 +236,7 @@                     -- wing is a half kite origin => largeDartBase                 if revLongE `elem` map longE (filter isDart ffcs) then (IntSet.insert w kcs,dbs,unks) else                      -- long edge drt shared with another dart => largeKiteCentre-                (kcs,dbs,IntSet.insert w unks) +                (kcs,dbs,IntSet.insert w unks) -- on the forced boundary so must be unknown   @@ -297,7 +295,7 @@                     return [ld,rk,lk]  --- |partCompose g is a partial function producing a pair consisting of remainder faces (faces from g which will not compose) +-- |oldPartCompose g is a partial function producing a pair consisting of remainder faces (faces from g which will not compose)  -- and a composed Tgraph.  -- It checks the composed Tgraph for connectedness and no crossing boundaries raising an error if this check fails. -- It does not assume the given Tgraph is forced.@@ -309,6 +307,13 @@      checked <- tryConnectedNoCross newFaces      return (remainder,checked) ++-- | oldGetDartWingInfo g, classifies the dart wings in g and calculates a faceMap for each dart wing,+-- returning as DartWingInfo. If only uses local information to classify each dart wing and can+-- therefore sometimes classify a dart wing as unknown unnecessarily.+-- In contrast tryGetDartWingInfo is accurate using information from forcing (so is not local)+oldGetDartWingInfo:: Tgraph -> DartWingInfo+oldGetDartWingInfo = oldGetDWIassumeF False  -- | oldGetDWIassumeF (not exported but used to define oldGetDartWingInfo). -- oldGetDWIassumeF isForced g, classifies the dart wings in g and calculates a faceMap for each dart wing,

@@ -61,7 +61,7 @@ -- |Decompose a face producing new faces.  -- This requires an edge to vertex map to get a unique new vertex assigned to each phi edge -- (as created by phiVMap).--- (Exported for use in TrackedTgraphs in Tgraphs module).+-- (Exported for use in TrackedTgraphs in Tgraph.Extras module). decompFace:: Map.Map Dedge Vertex -> TileFace -> [TileFace] decompFace newVFor fc = case fc of       RK(a,b,c) -> [RK(c,x,b), LK(c,y,x), RD(a,x,y)]

@@ -23,18 +23,21 @@  module Tgraph.Extras   ( smart-  , boundaryJoinFaces   , drawBoundaryJoins   , drawJoinsFor   , smartdraw+  , smartOn   , restrictSmart   , smartRotateBefore   , smartAlignBefore     -- * Overlaid drawing tools for Tgraphs   , drawPCompose   , drawForce+  , drawPCompose'+  , drawForce'   , drawSuperForce   , drawWithMax+  , drawWithMax'   , addBoundaryAfter   , drawCommonFaces   , emphasizeFaces@@ -100,11 +103,13 @@ import Tgraph.Force  import Diagrams.Prelude hiding (union)-import Data.List (intersect, union, (\\), find, foldl', transpose)+import Data.List (intersect, union, (\\), find, transpose)+import Prelude hiding (Foldable(..))+import Data.Foldable (Foldable(..)) import qualified Data.Set as Set  (Set,fromList,null,intersection,deleteFindMin)-- used for boundary covers import qualified Data.IntSet as IntSet (fromList,member,(\\)) -- for boundary vertex set import qualified Data.IntMap.Strict as VMap (delete, fromList, findMin, null, lookup, (!)) -- used for boundary loops, boundaryLoops-import qualified Data.Maybe (fromMaybe)+import Data.Maybe (fromMaybe)  -- |smart dr g - uses VPatch drawing function dr after converting g to a VPatch -- It will add boundary joins regardless of the drawing function.@@ -120,41 +125,47 @@ smart dr g = drawBoundaryJoins g vp <> dr vp   where vp = makeVP g --- |select the halftile faces of a Tgraph with a join edge on the boundary.--- Useful for drawing join edges only on the boundary.-boundaryJoinFaces :: Tgraph -> [TileFace]-boundaryJoinFaces g = map snd $ incompleteHalves bdry $ boundary bdry where-    bdry = makeBoundaryState g --- |draw boundary join edges of a Tgraph using a given VPatch+-- |drawBoundaryJoins a vp - draw boundary join edges of faces in a, using a given suitable VPatch+-- Will raise an error if any vertex in the faces does not have a location in the VPatch.+drawBoundaryJoins :: (HasFaces a, OKBackend b) => a -> VPatch -> Diagram b+drawBoundaryJoins = drawJoinsFor . boundaryJoinFaces+--drawWith dashJOnly $ restrictTo (boundaryJoinFaces a) vp+{- Old version used drawEdgesVP drawBoundaryJoins :: OKBackend b => Tgraph -> VPatch -> Diagram b drawBoundaryJoins g vp = drawEdgesVP vp (map joinE $ boundaryJoinFaces g) # joinDashing+-} --- |Given a list of faces and a VPatch with suitable locations, draw just the dashed joins for those faces.+-- |drawJoinsFor a vp - If vp is a VPatch with suitable locations, draw dashed joins for the faces in a. -- Will raise an error if any vertex in the faces does not have a location in the VPatch.-drawJoinsFor::  OKBackend b =>-                [TileFace] -> VPatch -> Diagram b-drawJoinsFor fcs vp = drawWith dashjOnly (restrictVP vp fcs)+drawJoinsFor::  (HasFaces a, OKBackend b) =>+                a -> VPatch -> Diagram b+drawJoinsFor a vp = drawWith dashJOnly (restrictTo a vp)  -- |same as draw except adding dashed lines on boundary join edges.  smartdraw :: OKBackend b => Tgraph -> Diagram b smartdraw = smart draw --- |restrictSmart g dr vp - assumes vp has locations for vertices in g.+-- |smartOn a dr vp - assumes vp has locations for vertices in faces of a. -- It uses the VPatch drawing function dr to draw g and adds dashed boundary joins. -- This can be used instead of smart when an appropriate vp is already available.-restrictSmart :: OKBackend b =>-                 Tgraph -> (VPatch -> Diagram b) -> VPatch -> Diagram b-restrictSmart g dr vp = drawBoundaryJoins g rvp <> dr rvp-                        where rvp = restrictVP vp $ faces g+smartOn :: (HasFaces a, OKBackend b) =>+           a -> (VPatch -> Diagram b) -> VPatch -> Diagram b+smartOn a dr vp = drawBoundaryJoins a rvp <> dr rvp where rvp = restrictTo a vp +{-# DEPRECATED restrictSmart "Use smartOn" #-}+-- | DEPRECATED restrictSmart: Use smartOn+restrictSmart :: (HasFaces a, OKBackend b) =>+                 a -> (VPatch -> Diagram b) -> VPatch -> Diagram b+restrictSmart = smartOn+ -- |smartRotateBefore vfun a g - a tricky combination of smart with rotateBefore. -- Uses vfun to produce a Diagram after converting g to a rotated VPatch but also adds the dashed boundary join edges of g. -- -- Example: smartRotateBefore (labelled draw) angle g smartRotateBefore :: OKBackend b =>                      (VPatch -> Diagram b) -> Angle Double -> Tgraph -> Diagram b-smartRotateBefore vfun angle g = rotateBefore (restrictSmart g vfun) angle g+smartRotateBefore vfun angle g = rotateBefore (smartOn g vfun) angle g  -- |smartAlignBefore vfun (a,b) g - a tricky combination of smart with alignBefore. -- Uses vfun to produce a Diagram after converting g to an aligned VPatch but also adds the dashed boundary join edges of g.@@ -162,29 +173,42 @@ -- Example: smartAlignBefore (labelled draw) (a,b) g smartAlignBefore :: OKBackend b =>                     (VPatch -> Diagram b) -> (Vertex,Vertex) -> Tgraph -> Diagram b-smartAlignBefore vfun (a,b) g = alignBefore (restrictSmart g vfun) (a,b) g+smartAlignBefore vfun (a,b) g = alignBefore (smartOn g vfun) (a,b) g --- |applies partCompose to a Tgraph g, then draws the composed graph along with the remainder faces (in lime).--- (Relies on the vertices of the composition and remainder being subsets of the vertices of g.)+-- |drawForce g is a diagram showing the argument g in red overlayed on force g.+-- It adds dashed join edges on the boundary of g.+-- It will raise an error if the force fails with an incorrect/stuck Tgraph.+-- (See also drawForce')+drawForce :: OKBackend b => +             Tgraph -> Diagram b+drawForce = drawForce' red++-- |a generalisation of drawForce which takes an additional colour argument+-- for drawing the edges of the original Tgraph (default colour is red in drawForce).+drawForce' :: OKBackend b => +              Colour Double -> Tgraph -> Diagram b+drawForce' c g =+    smartOn g draw vp # lc c <> draw vp+    where vp = makeVP $ force g++-- |applies partCompose to a Tgraph g, then draws the composed Tgraph+-- along with the remainder faces (drawn in lime). -- This will raise an error if the composed faces have a crossing boundary or are disconnected.+-- (See also drawPCompose') drawPCompose :: OKBackend b =>                 Tgraph -> Diagram b-drawPCompose g =-    restrictSmart g' draw vp-    <> drawj (subVP vp remainder) # lw medium # lc lime+drawPCompose = drawPCompose' lime++-- |a generalisation of drawPCompose which takes an additional colour argument+-- for drawing the edges of remainder faces (default colour is lime in drawPCompose).+drawPCompose' :: OKBackend b =>+                 Colour Double -> Tgraph -> Diagram b+drawPCompose' c g =+    smartOn g' draw vp+    <> drawJ (subFaces remainder vp) # lc c     where (remainder,g') = partCompose g           vp = makeVP g --- |drawForce g is a diagram showing the argument g in red overlayed on force g.--- It adds dashed join edges on the boundary of g.--- It will raise an error if the force fails with an incorrect/stuck Tgraph-drawForce :: OKBackend b =>-             Tgraph -> Diagram b-drawForce g =-    restrictSmart g draw vp # lc red # lw medium-    <> draw vp-    where vp = makeVP $ force g- -- |drawSuperForce g is a diagram showing the argument g in red overlayed on force g in black -- overlaid on superForce g in blue. -- It adds dashed join edges on the boundary of g.@@ -195,20 +219,28 @@     fg = force g     sfg = superForce fg     vp = makeVP sfg-    dfg = draw $ selectFacesVP vp (faces fg \\ faces g) -- restrictSmart (force g) draw vp-    dg = restrictSmart g draw vp-    dsfg = draw $ selectFacesVP vp (faces sfg \\ faces fg)+    dfg = draw $ restrictTo (faces fg \\ faces g) vp+    --selectFacesVP vp (faces fg \\ faces g) -- smartOn (force g) draw vp+    dg = smartOn g draw vp+    dsfg = draw $ restrictTo (faces sfg \\ faces fg) vp+    --selectFacesVP vp (faces sfg \\ faces fg)  -- | drawWithMax g - draws g and overlays the maximal composition of force g in red. -- This relies on g and all compositions of force g having vertices in force g. -- It will raise an error if forcing fails (g is an incorrect Tgraph). drawWithMax :: OKBackend b =>                Tgraph -> Diagram b-drawWithMax g =  (dmax # lc red # lw medium) <> dg where+drawWithMax =  drawWithMax' red++-- | generalisation of drawWithMax, taking an extra colour argument for drawing+-- the edges of the maximal composition (default is red in drawWithMax)+drawWithMax' :: OKBackend b =>+                Colour Double -> Tgraph -> Diagram b+drawWithMax' c g =  (dmax # lc c) <> dg where     vp = makeVP $ force g -- duplicates force to get the locations of vertices in the forced Tgraph-    dg = restrictSmart g draw vp+    dg = smartOn g draw vp     maxg = maxCompForce g-    dmax = draw $ subVP vp $ faces $ forgetF maxg+    dmax = draw $ subFaces maxg vp  -- |addBoundaryAfter f g - displaying the boundary of a Tgraph g in lime (overlaid on g drawn with f). addBoundaryAfter :: OKBackend b =>@@ -228,7 +260,7 @@                   [TileFace] -> Tgraph -> Diagram b emphasizeFaces fcs g =  (drawj emphvp # lw thin) <> (draw vp # lw ultraThin) where     vp = makeVP g-    emphvp = subVP vp (fcs `intersect` faces g)+    emphvp = subFaces (fcs `intersect` faces g) vp   -- | For illustrating an unsound version of composition which defaults to kites when there are unknown@@ -279,7 +311,7 @@ -- and just the emptyTgraph otherwise. -- It will raise an error if the initial force fails with an incorrect Tgraph. maxCompForce:: Tgraph -> Forced Tgraph-maxCompForce g | nullFaces g = labelAsForced g+maxCompForce g | nullFaces g = labelAsForced g -- forceF g                | otherwise = last $ allCompForce g  @@ -313,11 +345,13 @@ {-| boundaryECovering - for an explicitly Forced BoundaryState fbd, produces a list of all possible covers of the boundary directed edges in fbd. A cover is an explicitly Forced extension (of fbd) such that the original boundary directed edges of fbd are all internal edges.-Extensions are made by repeatedly adding a face to any edge on the original boundary that is still on the boundary-and forcing, repeating this until the orignal boundary is all internal edges.+Extensions are made by choosing any edge on the original boundary that is still on the boundary,+adding both possible legal faces, and forcing each result (keeping only successes - using+tryCheckCasesDKF) then +repeating this process until the orignal boundary is all internal edges. The resulting covers account for all possible ways the boundary can be extended.-This can raise an error if both choices on a boundary edge fail when forced (using atLeastOne). +This can raise an error if both choices on a boundary edge fail when forced (using tryCheckCasesDKF). In which case, fbd represents an important counter example to the hypothesis that successfully forced forcibles are correct. -}@@ -343,7 +377,7 @@  {-| boundaryVCovering fbd - similar to boundaryECovering, but produces a list of all possible covers of      the boundary vertices in fbd (rather than just boundary edges).-    This can raise an error if both choices on a boundary edge fail when forced (using atLeastOne).+    This can raise an error if both choices on a boundary edge fail when forced (using tryCheckCasesDKF).  -} boundaryVCovering:: Forced BoundaryState -> [Forced BoundaryState] boundaryVCovering fbd = covers [(fbd, startbds)] where@@ -583,14 +617,14 @@     reportCover bd des = map (tileLabel . getf) des where       efmap = dedgesFacesMap des (faces bd) -- more efficient than using graphEFMap? --      efmap = graphEFMap (recoverGraph bd)-      getf e = Data.Maybe.fromMaybe (error $ "singleChoiceEdges:reportCover: no face found with directed edge " ++ show e)+      getf e = fromMaybe (error $ "singleChoiceEdges:reportCover: no face found with directed edge " ++ show e)                                     (faceForEdge e efmap)  -- |Tries to create a new Tgraph from all faces with a boundary vertex in a Tgraph. -- The resulting faces could have a crossing boundary and also could be disconnected if there is a hole in the starting Tgraph -- so these conditions are checked for, producing a Try result. tryBoundaryFaceGraph :: Tgraph -> Try Tgraph-tryBoundaryFaceGraph = tryConnectedNoCross . boundaryFaces . makeBoundaryState+tryBoundaryFaceGraph = tryConnectedNoCross . boundaryVFaces    {- -- | Returns a list of (looping) vertex trails for the boundary of a Tgraph.@@ -697,6 +731,7 @@     faces  = faces . tgraph     boundary = boundary . faces . tgraph     maxV = maxV . faces . tgraph+    boundaryVFMap = boundaryVFMap . faces -- note need for nub  -- |addHalfDartTracked ttg e - add a half dart to the tgraph of ttg on the given edge e, -- and push the new singleton face list onto the tracked list.@@ -746,7 +781,7 @@ drawTrackedTgraph drawList ttg = mconcat $ reverse $ zipWith ($) drawList vpList where     vp = makeVP (tgraph ttg)     untracked = faces vp \\ concat (tracked ttg)-    vpList = map (restrictVP vp) (untracked:tracked ttg) ++ repeat vp+    vpList = map (`restrictTo` vp) (untracked:tracked ttg) ++ repeat vp  {-|     To draw a TrackedTgraph rotated.@@ -759,7 +794,7 @@ drawTrackedTgraphRotated drawList a ttg = mconcat $ reverse $ zipWith ($) drawList vpList where     vp = rotate a $ makeVP (tgraph ttg)     untracked = faces vp \\ concat (tracked ttg)-    vpList = map (restrictVP vp) (untracked:tracked ttg) ++ repeat vp+    vpList = map (`restrictTo` vp) (untracked:tracked ttg) ++ repeat vp  {-|     To draw a TrackedTgraph aligned.@@ -773,7 +808,7 @@ drawTrackedTgraphAligned drawList (a,b) ttg = mconcat $ reverse $ zipWith ($) drawList vpList where     vp = makeAlignedVP (a,b) (tgraph ttg)     untracked = faces vp \\ concat (tracked ttg)-    vpList = map (restrictVP vp) (untracked:tracked ttg) ++ repeat vp+    vpList = map (`restrictTo` vp) (untracked:tracked ttg) ++ repeat vp   

@@ -37,7 +37,7 @@   , forgetF   , tryForceF   , forceF-   , recoverGraphF+  , recoverGraphF   , boundaryStateF   , makeBoundaryStateF   , initFSF@@ -65,7 +65,8 @@   , recoverGraph --  , changeVFMap -- Now HIDDEN   , facesAtBV-  , boundaryFaces+  -- , boundaryVFacesBS  (removed)+  , boundaryFaces --deprecated     -- *  Auxiliary Functions for a force step   , affectedBoundary --  , mustFind@@ -146,7 +147,9 @@   -import Data.List ((\\), intersect, nub, find,foldl')+import Data.List ((\\), intersect, nub, find)+import Prelude hiding (Foldable(..))+import Data.Foldable (Foldable(..)) import qualified Data.Map as Map (Map, empty, delete, elems, insert, union, keys) -- used for UpdateMap import qualified Data.IntMap.Strict as VMap (elems, filterWithKey, alter, delete, lookup, (!))             -- used for BoundaryState locations AND faces at boundary vertices@@ -188,6 +191,7 @@     faces = allFaces     boundary = boundaryDedges     maxV bd = nextVertex bd - 1+    boundaryVFMap = bvFacesMap  -- |Calculates BoundaryState information from a Tgraph. makeBoundaryState:: Tgraph -> BoundaryState@@ -222,13 +226,17 @@   Just fcs -> fcs   Nothing -> error $ "facesAtBV: Not a boundary vertex? No result found for vertex " ++ show v ++ "\n" --- |return a list of faces which have a boundary vertex from a BoundaryState-boundaryFaces :: BoundaryState -> [TileFace]-boundaryFaces bd = nub $ concatMap (facesAtBV bd) bvs where+{- -- |return a list of faces which have a boundary vertex from a BoundaryState+boundaryVFacesBS :: BoundaryState -> [TileFace]+boundaryVFacesBS bd = nub $ concatMap (facesAtBV bd) bvs where     bvs = boundaryVs bd--- boundaryFaces = nub . concat . VMap.elems . bvFacesMap --- relies on the map containing no extra info for non boundary vertices+ -} +{-# DEPRECATED boundaryFaces "Use boundaryVFaces or boundaryEdgeFaces" #-}+-- | DEPRECATED boundaryFaces: Use boundaryVFaces or boundaryEdgeFaces+boundaryFaces :: BoundaryState -> [TileFace]+boundaryFaces = boundaryVFaces+ -- |An Update is either safe or unsafe. -- A safe update has a new face involving 3 existing vertices. -- An unsafe update has a makeFace function to create the new face when given a fresh third vertex.@@ -256,6 +264,7 @@     faces = faces . boundaryState     boundary = boundary . boundaryState     maxV = maxV . boundaryState+    boundaryVFMap = boundaryVFMap . boundaryState  {-|UpdateGenerator is a newtype for functions which capture one or more of the forcing rules. The functions can be applied using the unwrapper applyUG@@ -419,11 +428,13 @@     faces = faces . forgetF     boundary = boundary . forgetF     maxV = maxV . faces+    boundaryVFMap = boundaryVFMap . forgetF  -- | Constructs an explicitly Forced type. -- -- WARNING: this should only be used when the argument is known to be a fully forced Forcible. -- Consider using forceF or tryForceF instead for safety reasons.+-- Used in partComposeF and composeF labelAsForced :: a -> Forced a labelAsForced = Forced @@ -439,19 +450,19 @@  -- | recoverGraphF is an explicitly forced version of recoverGraph recoverGraphF :: Forced BoundaryState -> Forced Tgraph-recoverGraphF (Forced bs) = labelAsForced (recoverGraph bs)+recoverGraphF (Forced bs) = Forced (recoverGraph bs)  -- | boundaryStateF is an explicitly forced version of boundaryState boundaryStateF :: Forced ForceState -> Forced BoundaryState-boundaryStateF (Forced fs) = labelAsForced (boundaryState fs)+boundaryStateF (Forced fs) = Forced (boundaryState fs)  -- | makeBoundaryStateF is an explicitly forced version of makeBoundaryState makeBoundaryStateF :: Forced Tgraph -> Forced BoundaryState-makeBoundaryStateF (Forced g) = labelAsForced (makeBoundaryState g)+makeBoundaryStateF (Forced g) = Forced (makeBoundaryState g)  -- | initFSF is an explicitly forced version of initFS initFSF :: Forcible a => Forced a -> Forced ForceState-initFSF (Forced a) = labelAsForced (initFS a)+initFSF (Forced a) = Forced (initFS a)  -- |addHalfKite is for adding a single half kite on a chosen boundary Dedge of a Forcible. -- The Dedge must be a boundary edge but the direction is not important as

@@ -34,16 +34,13 @@   , Dedge   , EdgeType(..)   , Tgraph() -- not Data Constructor Tgraph+    -- * Making Tgraphs   , makeTgraph   , tryMakeTgraph   , checkedTgraph   , makeUncheckedTgraph-  , HasFaces(..) -- faces, boundary, maxV-  , dedges-  , vertexSet-  , vertices-  , boundaryVs-   -- * Property Checking for Tgraphs+  , emptyTgraph+   -- * Property Checks --  , renumberFaces --  , differing   , tryTgraphProps@@ -67,9 +64,15 @@   , crossingBoundaries   , connected --  , connectedBy-    -- * Basic Tgraph and HasFaces operations+   -- * Tgraph and HasFaces operations+  , HasFaces(..) -- faces, boundary, maxV, boundaryVFMap+  , dedges+  , vertexSet+  , vertices+  , boundaryVs+  , boundaryEFMap+  , boundaryVFaces --  , faces-  , emptyTgraph   , nullFaces   , evalFaces   , ldarts@@ -87,8 +90,16 @@   , removeVertices   , selectVertices   , vertexFacesMap-  --, dwFacesMap-    -- * Other Face/Vertex Operations+  , dedgesFacesMap+  , boundaryJoinFaces+  , boundaryEdgeFaces+  , buildEFMap+  , extractLowestJoin+  , lowestJoin+    -- * Other Face ops+  , faceForEdge+  , edgeNbs+  , edgeNb   , makeRD   , makeLD   , makeRK@@ -107,7 +118,7 @@   , prevV   , isAtV   , hasVIn-    -- * Other Edge Operations+    -- * Face and Edge ops   , faceDedges   , reverseD   , joinE@@ -126,24 +137,21 @@   , bothDir --   , bothDirOneWay   , missingRevs-    -- * Other Face Operations-  , edgeNb-  , dedgesFacesMap-  , buildEFMap-  , faceForEdge-  , edgeNbs-  , extractLowestJoin-  , lowestJoin     -- * VPatch and Conversions   , VPatch(..)   , VertexLocMap   , makeVP-  , subVP+  , subFaces+  , subVP --deprecated   , relevantVP-  , restrictVP+  , restrictTo+  , restrictVP --deprecated   , graphFromVP-  , removeFacesVP-  , selectFacesVP+  , removeFacesFromVP+  , removeVerticesFromVP+  , selectVerticesFromVP+  , removeFacesVP --deprecated+  , selectFacesVP --deprecated   , findLoc     -- * Drawing Tgraphs and Vpatches with Labels   , DrawableLabelled(..)@@ -158,7 +166,7 @@   , alignAll   , alignBefore   , makeAlignedVP-    -- *  Drawing Edges with a VPatch or a VertexLocationMap+    -- *  Drawing Edges   , drawEdgesVP   , drawEdgeVP   , drawLocatedEdges@@ -177,11 +185,12 @@   --, drawEdge   ) where -import Data.List ((\\), intersect, union, elemIndex,foldl',find,nub)--- import Data.Either(fromRight, lefts, rights, isLeft)-import qualified Data.IntMap.Strict as VMap (IntMap, alter, lookup, fromList, fromListWith, (!), map, filterWithKey,insert, empty, toList, assocs, keys, keysSet, findWithDefault)+import Data.List ((\\),intersect,union,elemIndex,find,nub)+import Prelude hiding (Foldable(..))+import Data.Foldable (Foldable(..))+import qualified Data.IntMap.Strict as VMap (IntMap, alter, lookup, fromList, fromListWith, (!), map, filterWithKey,insert, empty, toList, assocs, keys, keysSet, findWithDefault,elems) import qualified Data.IntSet as IntSet (IntSet,union,empty,singleton,insert,delete,fromList,toList,null,(\\),notMember,deleteMin,findMin,findMax,member,difference,elems)-import qualified Data.Map.Strict as Map (Map, fromList, lookup, fromListWith)+import qualified Data.Map.Strict as Map (Map, fromList, lookup, fromListWith, elems, filterWithKey) import Data.Maybe (mapMaybe) -- edgeNbrs import qualified Data.Set as Set  (fromList,member,null,delete,)-- used for locateVertices @@ -304,15 +313,10 @@  -- |force full evaluation of a list of faces. evalFaces :: HasFaces a => a -> a-evalFaces a = b where+evalFaces !a = b where     !b = find (ev . faceVs) (faces a) `seq` a     ev (x,y,z) = x `seq` y `seq` z `seq` False-{-     !b = find (notpos . faceVs) (faces a) `seq` a-    notpos (x,y,z) = x<1 || y<1 || z<1- -}{- evalFaces a = eval $ faces a where-    eval fcs = find (has0 . tileRep) fcs `seq` fcs-    has0 (x,y,z) = x==0 || y==0 || z==0- -}+   {-| Creates a Tgraph from a list of faces using tryTgraphProps to check required properties and producing an error if a check fails.@@ -536,14 +540,17 @@     boundary :: a -> [Dedge]     -- |get the maximum vertex in all faces (0 if there are no faces)     maxV :: a -> Int+    -- |create a map associating to each boundary vertex, a list of faces at the vertex+    boundaryVFMap :: a -> VertexMap [TileFace] + -- |An ascending list of the vertices occuring in faces (without duplicates) vertices :: HasFaces a => a -> [Vertex] vertices = IntSet.elems . vertexSet  -- |List of boundary vertices--- May have duplicates when applied to an arbitrary list of TileFace.--- but no duplicates for Tgraph, VPatch, BoundaryState, Forced, TrackedTgraph. +-- May have duplicates when applied to an arbitrary list of TileFace or VPatch.+-- but no duplicates for Tgraph, BoundaryState, Forced, TrackedTgraph.  boundaryVs :: HasFaces a => a -> [Vertex] boundaryVs = map fst . boundary @@ -555,18 +562,38 @@ vertexSet :: HasFaces a => a -> VertexSet vertexSet = mconcat . map faceVSet . faces +-- |create a directed edge to face map from the (reverse direction of the) boundary edges+boundaryEFMap :: HasFaces a => a -> Map.Map Dedge TileFace+boundaryEFMap fcs = Map.fromList (assocFaces des) where+       des = map reverseD $ boundary fcs+--       vs = boundaryVs a+       vfMap = boundaryVFMap fcs+       assocFaces [] = []+       assocFaces (d@(a,b):more) =+           case filter (liftA2 (&&) (isAtV a) (`hasDedge` d)) (vfMap VMap.! b) of+               [face] -> (d,face):assocFaces more+               []   -> assocFaces more+               _   -> error $ "boundaryEFMap: more than one Tileface has the same directed edge: "+                              ++ show d ++ "\n"++-- |find the faces which have at leat one boundary vertex.+boundaryVFaces :: HasFaces a => a -> [TileFace]+boundaryVFaces a = nub $ concat $ VMap.elems $ boundaryVFMap a + -- |A list of tilefaces is in class HasFaces instance HasFaces [TileFace] where     faces = id     boundary = missingRevs . dedges     maxV [] = 0     maxV fcs = IntSet.findMax $ vertexSet fcs+    boundaryVFMap fcs = vertexFacesMap (nub $ boundaryVs fcs) fcs -- need for nub  -- |Tgraph is in class HasFaces instance HasFaces Tgraph where     faces  = getFaces     boundary = boundary . faces     maxV = maxV . faces+    boundaryVFMap g = vertexFacesMap (boundaryVs g) (faces g) -- no need for nub  ldarts,rdarts,lkites,rkites, kites, darts :: HasFaces a => a -> [TileFace] -- | selecting left darts from @@ -735,7 +762,7 @@ -}  --- |directed edges (clockwise) round a face.+-- |produces a list of directed edges (clockwise) round a face. faceDedges::TileFace -> [Dedge] faceDedges (LD(a,b,c)) = [(a,b),(b,c),(c,a)] faceDedges (RD(a,b,c)) = [(a,b),(b,c),(c,a)]@@ -861,7 +888,6 @@       edges = map reverseD (faceDedges face)  - {-|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.@@ -873,32 +899,12 @@                       where addf Nothing = Nothing                             addf (Just fs) = Just (f:fs) -{-|dwFacesMap - a special case of vertexFacesMap applied to the dart wing vertices.-Create an IntMap from each dart wing vertex to a list of those faces that are at that vertex.-It makes use of the fact that only kite opps and kite origins and dart wings can-occur at a dart wing -dwFacesMap:: HasFaces a => a -> VertexMap [TileFace]-dwFacesMap g = foldl' insertf startVF (faces g) where-    vs = nub (wingV <$> darts g)-    startVF = VMap.fromList $ fmap (,[]) vs-    insertf vfmap f = foldl' (flip (VMap.alter addf)) vfmap (relevantVs f)-                      where addf Nothing = Nothing-                            addf (Just fs) = Just (f:fs)--    relevantVs  :: TileFace -> [Vertex]-    relevantVs (LK (a,_,c)) = [a,c]-    relevantVs (RK (a,b,_)) = [a,b]-    relevantVs (LD (_,_,c)) = [c]-    relevantVs (RD (_,b,_)) = [b]--}-- -- | 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.+-- If the edges are just the boundary edges, use boundaryEFMap instead. dedgesFacesMap:: HasFaces a => [Dedge] -> a -> Map.Map Dedge TileFace dedgesFacesMap des fcs =  Map.fromList (assocFaces des) where    vs = map fst des `union` map snd des@@ -910,20 +916,20 @@            []   -> assocFaces more            _   -> error $ "dedgesFacesMap: more than one Tileface has the same directed edge: "                           ++ show d ++ "\n"-{- dedgesFacesMap des fcs =  Map.fromList (assocFaces des) where-   vs = fmap fst des `union` fmap snd des-   vfMap = vertexFacesMap vs fcs-   assocFaces [] = []-   assocFaces (d@(a,b):more) = case (VMap.lookup a vfMap, VMap.lookup b vfMap) of-      (Just fcs1, Just fcs2) -> case filter (`hasDedge` d) $ fcs1 `intersect` fcs2 of-                                   [face] -> (d,face):assocFaces more-                                   []   -> assocFaces more-                                   _   -> error $ "dedgesFacesMap: more than one Tileface has the same directed edge: "-                                                  ++ show d ++ "\n"-      _ -> assocFaces more- -} --- |Build a Map from all directed edges to faces (the unique face containing the directed edge)+-- |select the faces with a join edge on the boundary.+-- Useful for drawing join edges only on the boundary.+boundaryJoinFaces :: HasFaces a => a -> [TileFace]+boundaryJoinFaces a = Map.elems $ Map.filterWithKey isJoin $ boundaryEFMap a where+    isJoin d f = joinE f == d++ +-- |find the faces with a at least one boundary edge.+boundaryEdgeFaces :: HasFaces a => a -> [TileFace]+boundaryEdgeFaces = nub . Map.elems . boundaryEFMap+++-- |Build a full Map from all directed edges to faces (the unique face containing the directed edge) buildEFMap:: HasFaces a  => a -> Map.Map Dedge TileFace buildEFMap = Map.fromList . concatMap assignFace . faces where   assignFace f = map (,f) (faceDedges f)@@ -997,6 +1003,7 @@     faces = vpFaces     boundary = boundary . faces     maxV = maxV . faces+    boundaryVFMap = boundaryVFMap . faces -- need for nub (from [TileFace] instance)   {-|Convert a Tgraph to a VPatch.@@ -1006,15 +1013,21 @@ makeVP::Tgraph -> VPatch makeVP g = VPatch {vLocs = locateVertices fcs, vpFaces  = fcs} where fcs = faces g --- |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.+-- |subFaces a vp, creates a new VPatch from faces in a, using the vertex location map from vp.+-- The vertices in the faces should have locations assigned in vp 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,+-- subFaces a vp 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).-subVP:: VPatch -> [TileFace] -> VPatch-subVP vp fcs = vp {vpFaces  = fcs}+-- The vertex location map is not changed (see also relevantVP and restrictTo).+subFaces:: HasFaces a => a -> VPatch -> VPatch+subFaces a vp = vp {vpFaces  = faces a} +{-# DEPRECATED subVP "Use (flip subFaces)" #-}+-- | DEPRECATED subVP: Use (flip subFaces)+subVP:: HasFaces a => VPatch -> a -> VPatch+subVP = flip subFaces++ -- | 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.@@ -1029,25 +1042,47 @@      diffList = IntSet.toList $ IntSet.difference vs source      locVs = VMap.filterWithKey (\ v _ -> v `IntSet.member` vs) $ vLocs vp --- | 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.+-- |A combination of subFaces and relevantVP. +-- restrictTo a vp - restricts vp to faces in a,+-- removing locations for vertices not in the faces.+-- (Useful when restricting which labels get drawn).+-- Will raise an error if any vertex in faces of a is not a key in the location map of vp.+restrictTo:: HasFaces a => a -> VPatch -> VPatch+restrictTo a vp = relevantVP (subFaces (faces a) vp)++{-# DEPRECATED restrictVP "Use (flip restrictTo)" #-}+-- | DEPRECATED restrictVP: Use (flip restrictTo) restrictVP:: VPatch -> [TileFace] -> VPatch-restrictVP vp fcs = relevantVP (subVP vp fcs)+restrictVP = flip restrictTo  -- |Recover a Tgraph from a VPatch by dropping the vertex positions and checking Tgraph properties. graphFromVP:: VPatch -> Tgraph graphFromVP = checkedTgraph . faces  -- |remove a list of faces from a VPatch+removeFacesFromVP :: [TileFace] -> VPatch -> VPatch+removeFacesFromVP fcs vp = restrictTo (faces vp \\ fcs) vp++{-# DEPRECATED removeFacesVP "Use (flip removeFacesFromVP)" #-}+-- |remove a list of faces from a VPatch removeFacesVP :: VPatch -> [TileFace] -> VPatch-removeFacesVP vp fcs = restrictVP vp (faces vp \\ fcs)+removeFacesVP vp fcs = restrictTo (faces vp \\ fcs) vp --- |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.+{-# DEPRECATED selectFacesVP "Use (flip restrictTo)" #-}+-- |DEPRECATED selectFacesVP: Use (flip restrictTo) selectFacesVP:: VPatch -> [TileFace] -> VPatch-selectFacesVP vp fcs = restrictVP vp (fcs `intersect` faces vp)+selectFacesVP vp fcs = restrictTo (fcs `intersect` faces vp) vp +-- |removeVerticesFromVP vs vp - removes any vertex in the list vs from vp+-- by removing all faces at those vertices.+removeVerticesFromVP :: [Vertex] -> VPatch -> VPatch+removeVerticesFromVP vs vp = removeFacesFromVP (filter (hasVIn vs) (faces vp)) vp++-- |selectVerticesFromVP vs vp - removes any face that does not have+-- at least one vertex in the list vs from vp.+selectVerticesFromVP :: [Vertex] -> VPatch -> VPatch+selectVerticesFromVP vs vp = restrictTo (filter (hasVIn vs) (faces vp)) vp+ -- |find the location of a single vertex in a VPatch findLoc :: Vertex -> VPatch -> Maybe (Point V2 Double) findLoc v = VMap.lookup v . vLocs@@ -1159,7 +1194,7 @@ makeAlignedVP = alignBefore id  --- |produce a diagram of a list of edges (given a VPatch)+-- |produce a diagram of a list of edges (given a suitable VPatch) -- Will raise an error if any vertex of the edges is not a key in the vertex to location mapping of the VPatch. drawEdgesVP :: OKBackend b =>                VPatch -> [Dedge] -> Diagram b@@ -1250,10 +1285,11 @@   VMap.insert (originV face) origin $ VMap.insert (oppV face) (p2 (x,0)) VMap.empty where     x = if isDart face then 1 else phi --- |lookup 3 vertex locations in a vertex to point map.+{- -- |lookup 3 vertex locations in a vertex to point map. find3Locs::(Vertex,Vertex,Vertex) -> VertexLocMap              -> (Maybe (Point V2 Double),Maybe (Point V2 Double),Maybe (Point V2 Double)) find3Locs (v1,v2,v3) vpMap = (VMap.lookup v1 vpMap, VMap.lookup v2 vpMap, VMap.lookup v3 vpMap)+ -}  {-| thirdVertexLoc face vpMap,  where face is a tileface and vpMap associates points with vertices (positions). It looks up all 3 vertices of face in vpMap hoping to find at least 2 of them, it then returns Just pr@@ -1265,7 +1301,34 @@ It now uses signorm to produce vectors of length 1 rather than rely on relative lengths. (Requires ttangle and phi from TileLib). -}+ thirdVertexLoc:: TileFace -> VertexLocMap -> Maybe (Vertex, Point V2 Double)+thirdVertexLoc face@(RD _ ) vpMap = -- LD and RD cases are the same using originV, wingV, oppV EXCEPT for angles+  case (VMap.lookup (originV face) vpMap, VMap.lookup (wingV face) vpMap, VMap.lookup (oppV face) vpMap) of+  (Just locOg, Just locW, Nothing)  -> Just (oppV face, locW .+^ v)     where v = signorm (rotate (ttangle 1) (locOg .-. locW))+  (Nothing, Just locW, Just locOp)  -> Just (originV face, locOp .+^ v) where v = signorm (rotate (ttangle 8) (locOp .-. locW))+  (Just locOg, Nothing, Just locOp) -> Just (wingV face, locOp .+^ v)   where v = signorm (rotate (ttangle 7) (locOg .-. locOp))+  (Just _ , Just _ , Just _)      -> Nothing+  _ -> error $ "thirdVertexLoc: face not tile-connected?: " ++ show face ++ "\n"++thirdVertexLoc face@(LD _ )  vpMap = -- LD and RD cases are the same using originV, wingV, oppV EXCEPT for angles+  case (VMap.lookup (originV face) vpMap, VMap.lookup (wingV face) vpMap, VMap.lookup (oppV face) vpMap) of+  (Just locOg, Just locW, Nothing)  -> Just (oppV face, locW .+^ v)     where v = signorm (rotate (ttangle 9) (locOg .-. locW))+  (Nothing, Just locW, Just locOp)  -> Just (originV face, locOp .+^ v) where v = signorm (rotate (ttangle 2) (locOp .-. locW))+  (Just locOg, Nothing, Just locOp) -> Just (wingV face, locOp .+^ v)   where v = signorm (rotate (ttangle 3) (locOg .-. locOp))+  (Just _ , Just _ , Just _)      -> Nothing+  _ -> error $ "thirdVertexLoc: face not tile-connected?: " ++ show face ++ "\n"++thirdVertexLoc face vpMap = -- LK and RK cases are the same using first,second,third+  case (VMap.lookup (firstV face) vpMap, VMap.lookup (secondV face) vpMap, VMap.lookup (thirdV face) vpMap) of +  (Just loc1, Just loc2, Nothing) -> Just (thirdV face, loc1 .+^ v)    where v = phi*^signorm (rotate (ttangle 4) (loc1 .-. loc2))+  (Nothing, Just loc2, Just loc3) -> Just (firstV face, loc3 .+^ v)    where v = phi*^signorm (rotate (ttangle 2) (loc2 .-. loc3))+  (Just loc1, Nothing, Just loc3) -> Just (secondV face, loc1 .+^ v)   where v = phi*^signorm (rotate (ttangle 1) (loc3 .-. loc1))+  (Just _ , Just _ , Just _)      -> Nothing+  _ -> error $ "thirdVertexLoc: face not tile-connected?: " ++ show face ++ "\n"++{- older version with 4 cases+thirdVertexLoc:: TileFace -> VertexLocMap -> Maybe (Vertex, Point V2 Double) thirdVertexLoc face@(LD _) vpMap = case find3Locs (faceVs face) vpMap of   (Just loc1, Just loc2, Nothing) -> Just (wingV face, loc1 .+^ v)   where v = phi*^signorm (rotate (ttangle 9) (loc2 .-. loc1))   (Nothing, Just loc2, Just loc3) -> Just (originV face, loc2 .+^ v) where v = signorm (rotate (ttangle 7) (loc3 .-. loc2))@@ -1293,8 +1356,7 @@   (Just loc1, Nothing, Just loc3) -> Just (oppV face, loc1 .+^ v)    where v = phi*^signorm (rotate (ttangle 1) (loc3 .-. loc1))   (Just _ , Just _ , Just _)      -> Nothing   _ -> error $ "thirdVertexLoc: face not tile-connected?: " ++ show face ++ "\n"--+ -}  -- *  Touching Vertices 

@@ -200,10 +200,10 @@  pCompFig1,pCompFig2,pCompFig :: OKBackend b => Diagram b -- |diagram showing partial composition of a forced 3 times decomposed dart (with remainder faces in pale green).-pCompFig1 = lw veryThin $ hsep 5 $ rotations [1,1] [draw fd3, drawPCompose fd3]+pCompFig1 = lw thin $ hsep 5 $ rotations [1,1] [draw fd3, drawPCompose fd3]             where fd3 = force $ dartDs!!3 -- |diagram showing partial composition of a forced 3 times decomposed kite (with remainder faces in pale green).-pCompFig2 = lw veryThin $ hsep 5 [draw fk3, drawPCompose fk3]+pCompFig2 = lw thin $ hsep 5 [draw fk3, drawPCompose fk3]             where fk3 = force $ kiteDs!!3 -- |diagram showing two partial compositions (with remainder faces in pale green). pCompFig = padBorder $ vsep 3 [center pCompFig1, center pCompFig2]@@ -252,8 +252,8 @@ badlyBrokenDartFig = padBorder $ lw thin $ hsep 1 $ fmap (labelled drawj) [vp, vpComp, vpFailed] where     vp = makeVP badlyBrokenDart     comp = compose badlyBrokenDart-    vpComp = restrictVP vp $ faces comp-    vpFailed  = restrictVP vp $ (snd . runTry . tryPartComposeFaces) comp+    vpComp = restrictTo (faces comp) vp+    vpFailed  = restrictTo ((snd . runTry . tryPartComposeFaces) comp) vp  -- |figure showing the result of removing incomplete tiles (those that do not have their matching halftile) -- to a 3 times decomposed sun.@@ -360,9 +360,9 @@  boundaryFDart4, boundaryFDart5 :: Tgraph -- |graph of the boundary faces only of a forced graph (dartDs!!4)-boundaryFDart4 = makeUncheckedTgraph $ boundaryFaces $ force $ makeBoundaryState dartD4+boundaryFDart4 = makeUncheckedTgraph $ boundaryVFaces $ force $ makeBoundaryState dartD4 -- |graph of the boundary faces only of a forced graph (dartDs!!5)-boundaryFDart5 = makeUncheckedTgraph $ boundaryFaces $ force $ makeBoundaryState (dartDs!!5)+boundaryFDart5 = makeUncheckedTgraph $ boundaryVFaces $ force $ makeBoundaryState (dartDs!!5)  boundaryFDart4Fig,boundaryFDart5Fig :: OKBackend b => Diagram b -- |figure of the boundary faces only of a forced graph (dartDs!!4).

@@ -36,9 +36,11 @@   -- $OKBackend   , drawPiece   , drawjPiece+  , drawJPiece   , dashjPiece   , joinDashing   , dashjOnly+  , dashJOnly   , drawRoundPiece   , drawJoin   , fillOnlyPiece@@ -52,6 +54,7 @@   , Drawable(..)   , draw   , drawj+  , drawJ   , fillDK   , fillKD   -- , fillMaybeDK@@ -166,10 +169,17 @@ drawPiece = strokeLine . fromOffsets . drawnEdges  -- |same as drawPiece but with join edge added as faint dashed line.+-- J for plain dashed Join, j for faint dashed join drawjPiece :: OKBackend b =>               Piece -> Diagram b drawjPiece = drawPiece <> dashjOnly +-- |same as drawPiece but with join edge added as dashed line.+-- J for plain dashed  Join, j for faint dashed join+drawJPiece :: OKBackend b =>+              Piece -> Diagram b+drawJPiece = drawPiece <> dashJOnly+ {-# DEPRECATED dashjPiece "Replaced by drawjPiece" #-} -- |renamed as drawjPiece dashjPiece :: OKBackend b =>@@ -177,13 +187,20 @@ dashjPiece = drawjPiece  -- |draw join edge only (as faint dashed line).+-- J for plain dashed Join, j for faint dashed join dashjOnly :: OKBackend b =>              Piece -> Diagram b-dashjOnly = joinDashing . drawJoin+dashjOnly = lw ultraThin . dashJOnly +-- |draw join edge only (as faint dashed line).+-- J for plain dashed  Join, j for faint dashed join+dashJOnly :: OKBackend b =>+             Piece -> Diagram b+dashJOnly = joinDashing . drawJoin+ -- |changes line style to ultraThin dashed lines (for drawing join edges) joinDashing :: (HasStyle c, N c ~ Double) => c -> c-joinDashing = dashing [dashmeasure,dashmeasure] 0 . lw ultraThin+joinDashing = dashing [dashmeasure,dashmeasure] 0                      where dashmeasure = normalized 0.003  `atLeast` output 0.5  -- |draw join edge only.@@ -278,10 +295,17 @@         a -> Diagram b draw = drawWith drawPiece --- | alternative default case for drawing, adding dashed lines for join edges.+-- | alternative default case for drawing, adding faint dashed lines for join edges.+-- J for plain dashed  Join, j for faint dashed join drawj :: (Drawable a, OKBackend b) =>          a -> Diagram b drawj = drawWith drawjPiece++-- | alternative default case for drawing, adding dashed lines for join edges.+-- J for plain dashed  Join, j for faint dashed join+drawJ :: (Drawable a, OKBackend b) =>+         a -> Diagram b+drawJ = drawWith drawJPiece  fillDK, fillKD :: (Drawable a, OKBackend b, Color c1, Color c2) =>                   c1 -> c2 -> a -> Diagram b

@@ -37,6 +37,7 @@   --, drawnEdgesP3   , drawPieceP3   , drawjPieceP3+  , drawJPieceP3   , fillOnlyPieceP3   , fillOnlyPieceWN   , fillPieceWN@@ -45,7 +46,8 @@   -- * Drawing functions producing P3 Rhombuses   , drawP3   , drawjP3-  , dashjP3+  , drawJP3+  , dashjP3 --deprecated   , fillWN   , fillNW   -- * P3_DrawableLabelled Class@@ -67,6 +69,7 @@ import qualified Data.Map.Strict as Map ((!)) import qualified Data.IntMap.Strict as VMap (fromList, toList, lookup) + -- | Penrose P3 Tiling uses wide and narrow rhombuses -- These are split into half tiles (triangles) as with kites and darts data P3_HalfTile a@@ -108,11 +111,14 @@  -- |Converting from P2 to P3 tilings. -- Half darts become half wide rhombuses (LD->RW,RD->LW).--- (The new origin is the dart wing, and --- the new join is the dart long edge.)--- Half kites are decomposed to a half wide and a half narrow rhombus.--- (For wide rhombuses, the new origin is the kite origin and the join is the kite long edge.)--- (For narrow rhombuses, the new origin is the kite opp and the join is toward the kite origin.)+-- The rhombus origin is the dart wing, the rhombus opp is the dart origin, so+-- the rhombus join is the dart long edge.+-- Half kites are decomposed to a half wide and a half narrow rhombus+-- (LK -> RW and RN, RK -> LW and LN).+-- For wide rhombuses, the origin is the kite origin and rhombus opp is the kite wing+-- (the join is the kite long edge).+-- For narrow rhombuses, the origin is the kite opp and the rhombus wing is the kite opp+-- (the join is toward the kite origin.) decompPieceP2toP3 :: Located Piece -> [Located P3_Piece] decompPieceP2toP3 lp = case viewLoc lp of     (p, LK v) -> [ RW z `at` p@@ -127,9 +133,12 @@                  where z = phi *^ rotate (ttangle 1) v  -- |Converting from P3 to P2 tilings.--- Half narrow rhombuses become half kites--- (but the origin vertex and join edge are changed).--- Half wide rhombuses are decomposed to a half dart and a half kite.+-- Half narrow rhombuses become half kites (LN->RK,RN->LK).+-- The rhombus wing becomes the kite origin and the rhombus origin becomes the kite wing.+-- Half wide rhombuses are decomposed to a half dart and a half kite+-- (RW -> LD and RK, LW -> RD and LK).+-- The wide rhombus origin becomes the dart origin, and the wide rhombus opp becomes the kite origin.+-- The wide rhombus wing becomes both the kite opp and dart wing. decompPieceP3toP2 :: Located P3_Piece -> [Located Piece] decompPieceP3toP2 lp = case viewLoc lp of     (p, LW v) -> -- decompPiece (RD (z^-^v) `at` p.+^v)@@ -173,15 +182,20 @@ drawPieceP3 :: OKBackend b => P3_Piece -> Diagram b drawPieceP3 = strokeLine . fromOffsets . drawnEdgesP3 --- |Draw dashed join only of a P3_Piece -dashjOnlyP3 :: OKBackend b => P3_Piece -> Diagram b-dashjOnlyP3 p = joinDashing (strokeLine $ fromOffsets [tileRepP3 p])-+-- |Draw dashed join only of a P3_Piece. +dashJOnlyP3 :: OKBackend b => P3_Piece -> Diagram b+dashJOnlyP3 p = joinDashing (strokeLine $ fromOffsets [tileRepP3 p])  -- |Draws all edges of a P3_Piece using a faint dashed line for the join edge+-- (J for plain dashed Join, j for faint dashed join) drawjPieceP3 :: OKBackend b => P3_Piece -> Diagram b-drawjPieceP3 = drawPieceP3 <> dashjOnlyP3+drawjPieceP3 = drawPieceP3 <> lw ultraThin . dashJOnlyP3 +-- |Draws all edges of a P3_Piece using a dashed line for the join edge+-- (J for plain dashed Join, j for faint dashed join)+drawJPieceP3 :: OKBackend b => P3_Piece -> Diagram b+drawJPieceP3 = drawPieceP3 <> dashJOnlyP3+ -- |Fills a P3_Piece with a colour (without drawn edges) fillOnlyPieceP3 :: (OKBackend b, Color c) =>                    c -> P3_Piece -> Diagram b@@ -246,13 +260,20 @@           a -> Diagram b drawP3 = drawP3With drawPieceP3 --- |An alternative drawing function for anything P3_Drawable adding dashed lines for join edges+-- |An alternative drawing function for anything P3_Drawable adding faint dashed lines for join edges+-- (J for plain dashed Join, j for faint dashed join) drawjP3 :: (OKBackend b, P3_Drawable a) =>            a -> Diagram b drawjP3 = drawP3With drawjPieceP3 -{-# DEPRECATED dashjP3 "Replaced by drawjP3" #-}--- |Deprecated (renamed as drawjP3)+-- |An alternative drawing function for anything P3_Drawable adding dashed lines for join edges+-- (J for plain dashed Join, j for faint dashed join)+drawJP3 :: (OKBackend b, P3_Drawable a) => +          a -> Diagram b+drawJP3 = drawP3With drawJPieceP3++{-# DEPRECATED dashjP3 "Use drawjP3" #-}+-- | DEPRECATED dashjP3: Use drawjP3 dashjP3 :: (OKBackend b, P3_Drawable a) =>            a -> Diagram b dashjP3 = drawjP3