PenroseKiteDart 1.4.3 → 1.4.4

raw patch · 9 files changed

+283/−15 lines, 9 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +10/−3
• PenroseKiteDart.cabal +2/−1
• README.md +4/−1
• src/HalfTile.hs +5/−5
• src/PKD.hs +3/−0
• src/Tgraph/Compose.hs +2/−3
• src/TgraphExamples.hs +17/−2
• src/TileLibP3.hs +234/−0
• test/Spec.hs +6/−0

@@ -1,12 +1,19 @@ # Revision history for PenroseKiteDart +## version 1.4.4  -- 2025-8-9 +Fixed bug in remainder faces for new partComposeF++Added new module `TileLibP3` for drawing P3 tilings.+This is now included in `PKD` export list+with example `testRhombus` in module `TgraphExamples`.+ ## version 1.4.3  -- 2025-7-1 -Correction in composing+Fixed bug in `partComposing`. (partCompFacesFrom was assuming forced to get remainders.)-A correction is now incorporated in partComposeFaces and partComposeFacesF-but partCompFacesFrom is now removed.+This is now incorporated in partComposeFaces and partComposeFacesF+and partCompFacesFrom is now removed.  ## version 1.4.2  -- 2025-7-1 

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           PenroseKiteDart-version:        1.4.3+version:        1.4.4 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@@ -31,6 +31,7 @@       CheckBackend       HalfTile       TileLib+      TileLibP3       Try       Tgraph.Prelude       Tgraph.Decompose

@@ -75,7 +75,7 @@ ## Modules  Module `PKD` is the main module which imports and re-exports everything.-That is, module `TileLib` and the Tgraph modules+That is, module `TileLib` and `TileLibP3` and the Tgraph modules `Tgraph.Compose`, `Tgraph.Decompose`, `Tgraph.Force`, `Tgraph.Relabelling`, `Tgraph.Prelude`, `Tgraph.Extras`.  `Try` is imported and re-exported by `Tgraph.Prelude` (used for results of partial functions).@@ -86,6 +86,9 @@ (The constraint `OKBackend b =>` is used extensively in the library to abstract types from any particular Backend).  `TgraphExamples` contains example Tgraphs and Diagrams.++New in version 1.4.4 `TileLibP3` is for converting to and drawing+Penrose\'s P3 tilings (rhombuses)  ## Further Information 

@@ -9,7 +9,7 @@ -} {-# LANGUAGE TypeFamilies              #-} -- needed for Transformable Instance {-# LANGUAGE FlexibleInstances         #-} -- needed for Transformable Instance-{-# LANGUAGE Strict               #-}+{-# LANGUAGE Strict                    #-}  module HalfTile   ( HalfTile(..)@@ -34,10 +34,10 @@ For Pieces - rep is V2 Double For TileFaces (in Tgraphs) rep is (Vertex,Vertex,Vertex) -}-data HalfTile rep = LD !rep -- ^ Left Dart-                  | RD !rep -- ^ Right Dart-                  | LK !rep -- ^ Left Kite-                  | RK !rep -- ^ Right Kite+data HalfTile rep = LD rep -- ^ Left Dart+                  | RD rep -- ^ Right Dart+                  | LK rep -- ^ Left Kite+                  | RK rep -- ^ Right Kite                   deriving (Show,Eq)  -- | Note this ignores the tileLabels when comparing.

@@ -35,6 +35,8 @@   , module Tgraph.Relabelling     -- * Smart drawing of Tgraphs and other extras    , module Tgraph.Extras+    -- * Converting to P3 (rhombus) tilings and drawing+  , module TileLibP3    ) where @@ -45,4 +47,5 @@ import Tgraph.Relabelling import Tgraph.Force import Tgraph.Extras+import TileLibP3 

@@ -200,12 +200,11 @@     let         fcs = dwFMap VMap.! w -- faces at w     in-        if length fcs ==1 then (kcs, dbs, IntSet.insert w unks) else -- lone dart wing => unknown         if w `elem` map originV (filter isKite fcs) then (kcs,IntSet.insert w dbs,unks) else                    -- wing is a half kite origin => nodeDB-        if (w,orig) `elem` map longE (filter isRD fcs) then (IntSet.insert w kcs,dbs,unks) else+        if (orig,w) `elem` map longE (filter isRD fcs) then (IntSet.insert w kcs,dbs,unks) else                    -- long edge ld shared with an rd => nodeKC-        if isForced then (kcs, dbs, IntSet.insert w unks) else+        if isForced || length fcs == 1 then (kcs, dbs, IntSet.insert w unks) else         case findFarK ld fcs of           Nothing -> (kcs,dbs,IntSet.insert w unks) -- unknown if incomplete kite attached to short edge of ld           Just lk@(LK _)  ->  

@@ -89,12 +89,15 @@     -- *  Emplace Choices  , emplaceChoices  , emplaceChoicesFig+     -- * Example showing a P3 tiling+ , testRhombus    ) where  import Diagrams.Prelude import PKD import Tgraph.Prelude as NoWarn (makeUncheckedTgraph)+ import Data.List (intersect,find)      -- for emplaceChoices  @@ -346,6 +349,7 @@ superForceFig :: OKBackend b => Diagram b superForceFig = padBorder $ lw thin $ rotate (ttangle 1) $ drawSuperForce g where     g = addHalfDart (220,221) $ force $ decompositions fool !!3+-- (Used in testing)  -- |Diagram showing 4 rockets formed by applying superForce to successive decompositions -- of sun3Dart. The decompositions are in red with normal force additions in black and superforce additions in blue.@@ -369,10 +373,11 @@ boundaryGapFDart4, boundaryGapFDart5 :: Tgraph -- |graph of the boundary faces only of a forced graph - with extra faces removed to make a gap boundaryGapFDart4 = removeVertices [354] boundaryFDart4-    -- checkedTgraph $ filter ((/=354).originV)  (faces boundaryFDart4)+ -- (Used in testing)+ -- |graph of the boundary faces only of a forced graph - with extra faces removed to make a gap boundaryGapFDart5 = removeVertices [1467] boundaryFDart5-    -- checkedTgraph $ filter ((/=1467).originV) (faces boundaryFDart5)+ -- (Used in testing)  boundaryGap4Fig, boundaryGap5Fig  :: OKBackend b => Diagram b -- |figure for the boundary gap graph boundaryGapFDart4.@@ -450,4 +455,14 @@     where g = foolD           overlayg g' = smartAlignBefore draw algmnt g # lc red <> alignBefore draw algmnt g'           algmnt = defaultAlignment g++-- | An example to illustrate drawing P3 tiling (rhombuses).+-- The top part (filled) is a 5 times decomposed sunGraph converted to rhombuses (P3) when drawn.+-- The bottom part is the 5 times decomposed sunGraph reflected about its x-axis.+testRhombus :: OKBackend b => Diagram b+testRhombus = padBorder $+              fillWN darkmagenta indigo g # lw veryThin # lc gold +              ===+              draw g # reflectY # lw veryThin+      where g = decompositions sunGraph !! 5 

@@ -0,0 +1,234 @@+{-|+Module      : TileLibP3+Description : Converting between Kites and Darts (P2 tiles) to Rhombuses (P3 tiles) and drawing+Copyright   : (c) Chris Reade, 2021+License     : BSD-style+Maintainer  : chrisreade@mac.com+Stability   : experimental++This module introduces Penrose\'s P3 tilings (narrow and wide rhombuses).+It includes P3_HalfTiles, P3_Pieces and P3_Patches to represent and draw+rhombuses plus conversion to and from Darts and Kites (the P2 tiles).+A class P3_Drawable is introduced with instance P3_Patch, Patch, VPatch, Tgraph+and generalised drawing functions for drawing P3 tilings.+-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE FlexibleContexts          #-}+{-# LANGUAGE TypeFamilies              #-}+{-# LANGUAGE FlexibleInstances         #-} -- needed for P3_Drawable P3_Patch+{-# LANGUAGE Strict                    #-}+-- {-# LANGUAGE TypeOperators             #-} -- needed for type equality constraints ~++module TileLibP3 +  ( +  -- * P3_HalfTiles+    P3_HalfTile(..)+  , tileRepP3+  -- * P3_Pieces+  , P3_Piece+  -- * Converting (located) Pieces+  , decompPieceP2toP3+  , decompPieceP3toP2+  -- * Converting Patches+  , decompP2toP3+  , decompP3toP2+  -- * Drawing P3_Pieces+  --, drawnedgesP3+  , drawPieceP3+  , dashjPieceP3+  , fillOnlyPieceP3+  , fillPieceWN+   -- * P3_Drawable Class+  , P3_Drawable(..)+  -- * Drawing functions producing P3 Rhombuses+  , drawP3+  , dashjP3+  , fillWN+  , fillNW+  ) where++import Diagrams.Prelude+--import Diagrams.TwoD.Text (Text) -- now in CheckBackend++import CheckBackend+import HalfTile+import TileLib+import Tgraph.Prelude++-- | Penrose P3 Tiling uses wide and narrow rhombuses+-- These are split into half tiles (triangles) as with kites and darts+data P3_HalfTile a+   = LW a -- ^ Left Wide Rhombus+   | RW a -- ^ Right Wide Rhombus+   | LN a -- ^ Left Narrow Rhombus+   | RN a -- ^ Right Narrow Rhombus+   deriving (Show,Eq)++{-# INLINE tileRepP3 #-}+-- | tileRepP3 produces the representation without the label (LW,RW,LN,RN)+tileRepP3 :: P3_HalfTile a -> a+tileRepP3 (LW a) = a+tileRepP3 (RW a) = a+tileRepP3 (LN a) = a+tileRepP3 (RN a) = a++-- |Needed for Transformable instance of P3_HalfTile - requires TypeFamilies+type instance N (P3_HalfTile a) = N a+-- |Needed for Transformable instance of P3_HalfTile - requires TypeFamilies+type instance V (P3_HalfTile a) = V a+-- |P3_HalfTile inherits Transformable  - Requires FlexibleInstances+instance Transformable a => Transformable (P3_HalfTile a) where+    transform t = fmap (transform t)++-- |A P3_Piece is a P3_Halftile with a vector along its join edge.+-- The vector for a wide rhombus is on the long diagonal,+-- and the vector for a narrow rhombus is along the short diagonal.+-- The choice of which vertex is the origin is derived from conversions+-- from Darts and Kites (P2 tilings) +type P3_Piece = P3_HalfTile (V2 Double)++-- |Make P3_Halftile a Functor+instance Functor P3_HalfTile where+    fmap f (LW rep) = LW (f rep)+    fmap f (RW rep) = RW (f rep)+    fmap f (LN rep) = LN (f rep)+    fmap f (RN rep) = RN (f rep)++-- |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.)+decompPieceP2toP3 :: Located Piece -> [Located P3_Piece]+decompPieceP2toP3 lp = case viewLoc lp of+    (p, LK v) -> [ RW z `at` p+                 , RN ((2-phi)*^ negate v) `at` p.+^v+                 ] where z = rotate (ttangle 1) v+    (p, RK v) -> [ LW z `at` p+                 , LN ((2-phi)*^ negate v) `at` p.+^v+                 ]  where z = rotate (ttangle 9) v+    (p, LD v) -> [ RW (negate z) `at` p.+^ z]+                 where z = phi *^ rotate (ttangle 9) v+    (p, RD v) -> [ LW (negate z) `at` p.+^ z]+                 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.+decompPieceP3toP2 :: Located P3_Piece -> [Located Piece]+decompPieceP3toP2 lp = case viewLoc lp of+    (p, LW v) -> -- decompPiece (RD (z^-^v) `at` p.+^v)+                 -- where z = (phi-1)*^rotate (ttangle 1) v+                 [ RD ((2-phi)*^v) `at` p+                 , LK (z^-^v) `at` (p.+^v)+                 ] where z = (phi-1)*^rotate (ttangle 1) v+    (p, RW v) -> --decompPiece (LD (z^-^v) `at` p.+^v)+                 --where z = (phi-1)*^rotate (ttangle 9) v+                 [ LD ((2-phi)*^v) `at` p+                 , RK (z^-^v) `at` (p.+^v)+                 ] where z = (phi-1)*^rotate (ttangle 9) v++    (p, LN v) -> [ RK (v^-^z) `at` p.+^ z]+                 where z = phi *^ rotate (ttangle 2) v+    (p, RN v) -> [ LK (v^-^z) `at` p.+^ z]+                 where z = phi *^ rotate (ttangle 8) v++-- | a P3_Patch is analagous to a Patch (but for for P3_Pieces)+type P3_Patch =  [Located P3_Piece]++-- |Conversion from a Patch to a P3_Patch (Kites and Darts to Rhombuses)+decompP2toP3 :: Patch -> P3_Patch+decompP2toP3 = concatMap decompPieceP2toP3++-- |Conversion from a P3_Patch to a Patch (Rhombuses to Kites and Darts)+-- Note this does not reverse decompP2toP3, but the combination+-- decompP3toP2 . decompP2toP3 is equivalent to a decompose operation (decompPatch)+decompP3toP2 :: P3_Patch -> Patch+decompP3toP2 = concatMap decompPieceP3toP2++-- |The drawn edges of a P3_Piece (as a list of vectors)+drawnedgesP3 :: P3_Piece -> [V2 Double]+drawnedgesP3 (LW v) = [z,v^-^z] where z = (phi-1)*^rotate (ttangle 1) v+drawnedgesP3 (RW v) = [z,v^-^z] where z = (phi-1)*^rotate (ttangle 9) v+drawnedgesP3 (LN v) = [z,v^-^z] where z = phi*^rotate (ttangle 2) v+drawnedgesP3 (RN v) = [z,v^-^z] where z = phi*^rotate (ttangle 8) v++-- |Draws the two drawn edges of a P3_Piece+drawPieceP3 :: OKBackend b => P3_Piece -> Diagram b+drawPieceP3 = strokeLine . fromOffsets . drawnedgesP3++-- |Draws all edges of a P3_Piece using a faint dashed line for the join edge+dashjPieceP3 :: OKBackend b => P3_Piece -> Diagram b+dashjPieceP3 p = drawPieceP3 p <> joinDashing (strokeLine $ fromOffsets [tileRepP3 p])++-- |Fills a P3_Piece with a colour (without drawn edges)+fillOnlyPieceP3 :: (OKBackend b, Color c) =>+                   c -> P3_Piece -> Diagram b+fillOnlyPieceP3 c p = +    lw none $ fillColor c $ +    strokeLoop $ closeLine $ fromOffsets $ drawnedgesP3 p++-- |Fills and draws a P3_Piece with one of 2 colours+-- The first colour is used for wide rhombuses, and the second for narrow rhombuses.+-- (Note the order WN)+fillPieceWN :: (OKBackend b, Color cw, Color cn) =>+               cw -> cn -> P3_Piece -> Diagram b+fillPieceWN cw cn rp = drawPieceP3 rp <> filledpiece where+    filledpiece = case rp of+        (LW _ ) -> fillOnlyPieceP3 cw rp+        (RW _ ) -> fillOnlyPieceP3 cw rp+        _       -> fillOnlyPieceP3 cn rp+++-- | A class for things that can be turned to diagrams when given a function to draw P3_Pieces.+class P3_Drawable a where+  drawP3With :: OKBackend b =>+                (P3_Piece ->  Diagram b) -> a -> Diagram b++-- | A P3_Patch is P3_Drawable.+instance P3_Drawable P3_Patch where+  -- | turn a P3_Patch into a diagram given a function for drawing P3_Pieces.+  drawP3With :: OKBackend b => (P3_Piece -> Diagram b) -> P3_Patch -> Diagram b+  drawP3With pd = position . fmap (viewLoc . mapLoc pd)++-- | A Patch is also P3_Drawable (by conversion to a P3_Patch).+instance P3_Drawable Patch where+  drawP3With :: OKBackend b => (P3_Piece -> Diagram b) -> Patch -> Diagram b+  drawP3With pd = drawP3With pd . decompP2toP3++-- | A VPatch is P3_Drawable.+instance P3_Drawable VPatch where+    drawP3With :: OKBackend b => (P3_Piece -> Diagram b) -> VPatch -> Diagram b+    drawP3With pd = drawP3With pd . dropLabels++-- | A Tgraph is P3_Drawable.+instance P3_Drawable Tgraph where+    drawP3With :: OKBackend b => (P3_Piece -> Diagram b) -> Tgraph -> Diagram b+    drawP3With pd = drawP3With pd . makeVP++-- |The main drawing function for anything P3_Drawable+drawP3 :: (OKBackend b, P3_Drawable a) => +          a -> Diagram b+drawP3 = drawP3With drawPieceP3++-- |An alternative drawing function for anything P3_Drawable adding dashed lines for join edges+dashjP3 :: (OKBackend b, P3_Drawable a) => +          a -> Diagram b+dashjP3 = drawP3With dashjPieceP3++-- |The main draw and fill function for anything P3_Drawable.+-- The first colour is used for wide rhombuses, and the second for narrow rhombuses.+-- (Note the order W N).+fillWN :: (OKBackend b, P3_Drawable a, Color cw, Color cn) =>+          cw -> cn -> a -> Diagram b+fillWN cw cn = drawP3With (fillPieceWN cw cn)++-- |A variation on fillWN where+-- the first colour is for narrow rhombuses, the second for wide rhombuses.+-- (Note the order N W).+fillNW :: (OKBackend b, P3_Drawable a, Color cw, Color cn) =>+          cw -> cn -> a -> Diagram b+fillNW = flip fillWN --drawP3With (fillPieceWN cw cn)

@@ -120,6 +120,12 @@     context "Forcing Tgraphs" $       it "Number of faces of force (dartDs !!6) should be 7546" $          length(faces(force dD6)) `shouldBe` 7546+    context "partCompose and Force" $+      it "Number of remainder faces when part composing force (dartDs !!3) should be 58" $+         length (fst $ partCompose $ force $ dartDs !!3) `shouldBe` 58+    context "partComposeF and ForceF" $+      it "Number of remainder faces when part composing forceF (dartDs !!3) should be 58" $+         length (fst $ partCompose $ force $ dartDs !!3) `shouldBe` 58  graphLabelCheck :: Spec graphLabelCheck = describe "Label critical examples check" $ do