{-|
Module : TgraphExamples
Description : Examples of tilings represented with Tgraphs and their diagrams
Copyright : (c) Chris Reade, 2021
License : BSD-style
Maintainer : chrisreade@mac.com
Stability : experimental
-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-deprecations #-}
module TgraphExamples
(-- * Some Layout tools
padBorder
, chunks
, chunking
, centerRows
, centerRows'
, arrangeRows
, arrangeRows'
, arrangeRowsGap -- deprecated
, labelAt
-- * Tgraphs for 7 vertex types
, sunGraph
, jackGraph
, kingGraph
, queenGraph
, aceGraph
, deuceGraph
, starGraph
-- * Further Basic Tgraphs
, kiteGraph
, dartGraph
, fool
, foolD
, foolDminus
, foolDs
, sunDs
, kiteDs
, dartDs
, dartD4
, sun3Dart
-- * Some Simple Figures
, foolFig
, foolAndFoolD
, figSunD3D2
-- * Figures for 7 vertex types
, vertexTypesFig
, forceVFigures
-- * Partial Composition figures
, pCompFig1
, pCompFig2
, pCompFig
-- * Forced Tgraph figures
, forceFoolDminus
, forceDartD5Fig
, forceKiteD5Fig
, forceSunD5Fig
, forceFig
-- * Removed faces (forcing and composing)
, brokenDart
, badlyBrokenDart
, brokenDartFig
, badlyBrokenDartFig
, removeIncompletesFig
-- * Incorrect Tgraphs
, mistake
, mistake1
-- * superForce Figure
, superForceFig
, superForceRocketsFig
-- * Tgraphs with Boundary faces
, boundaryFDart4
, boundaryFDart5
, boundaryFDart4Fig
, boundaryFDart5Fig
, boundaryGapFDart4
, boundaryGapFDart5
, boundaryGap4Fig
, boundaryGap5Fig
-- * Boundary coverings and empires
, boundaryVCoveringFigs
, boundaryECoveringFigs
, kingECoveringFig
, kingVCoveringFig
, kingEmpiresFig
, kingEmpire1Fig
, kingEmpire2Fig
-- * Emplace Extend Choices
, emplaceChoices
, emplaceChoicesFig
, extendChoices
, extendChoicesFig
-- * Example showing a P3 tiling
, testRhombus
-- * Examples showing VPatch transform and deform
, testVPTransform
, deformExample
) where
import Diagrams.Prelude
import PKD
import Data.List (intersect,find) -- for emplaceChoices
-- |used for most diagrams to give border padding
padBorder :: OKBackend b =>
Diagram b -> Diagram b
padBorder = pad 1.2 . centerXY
-- |chunks n l - split a list l into chunks of length n (n>0)
-- The last list may have fewer than n items.
-- An error wil be raised if n<1.
chunks::Int -> [a] -> [[a]]
chunks n
| n < 1 = error "chunks: argument <1\n"
| otherwise = ch where
ch [] = []
ch as = take n as : ch (drop n as)
{- |chunking generalises chunks to allow specifying different lengths.
chunking ns as - will split the list as into a list of lists, where the lengths of inner lists
are determined by the Ints in ns (in order). The last Int in ns will be used as a default length for all subsequent inner lists.
The last inner list may be shorter than specified if there are not enough remaining elements in as.
An error will be raised if ns is null or if a non-positive Int is encountered in ns before as runs out.
-}
chunking :: [Int] -> [a] -> [[a]]
chunking _ [] = []
chunking (n:_) _ | n<1 = error $ "chunking: non-positive Int found " ++ "show n"
chunking (n:m:more) ds = take n ds: chunking (m:more) (drop n ds)
chunking [n] ds = chunks n ds -- repeat last Int n
chunking [] _ = error "chunking: empty Int list found "
-- |makes a list of lists of diagrams into a single diagram treating them as a column of rows,
-- using default separator of 1.0 for rows and columns (see also centerRows').
centerRows :: OKBackend b =>
[[Diagram b]] -> Diagram b
centerRows = centerRows' 1.0
-- |given a default seperator value, this makes a list of lists of diagrams into a single diagram treating them as a column of rows,
-- using the default separator for rows and columns.
centerRows' :: OKBackend b =>
Double -> [[Diagram b]] -> Diagram b
centerRows' s = centerY . vsep s . map (centerX . hsep s)
-- |arrangeRows n diags - arranges diags into a single diagram with n>0 per row, centering each row horizontally.
-- The default separation is 1.0 vertically and horizontally (see also arrangeRows').
-- An error is raised if n<1
arrangeRows :: OKBackend b =>
Int -> [Diagram b] -> Diagram b
arrangeRows = arrangeRows' 1.0
-- |arrangeRows' s n diags - arranges diags into a single diagram with n>0 per row, centering each row horizontally,
-- with a separation gap (horizontally and vertically) of s.
-- An error is raised if n<1
arrangeRows' :: OKBackend b =>
Double -> Int -> [Diagram b] -> Diagram b
arrangeRows' s n = centerRows' s . chunks n
{-# DEPRECATED arrangeRowsGap "Renamed as arrangeRows'" #-}
-- |arrangeRowsGap s n diags - arranges diags into n per row, centering each row horizontally,
-- with a separation gap (horizontally and vertically) of s.
-- The result is a single diagram.
arrangeRowsGap :: OKBackend b =>
Double -> Int -> [Diagram b] -> Diagram b
arrangeRowsGap = arrangeRows'
-- |add a given label at a given point in the given diagram.
labelAt :: OKBackend b =>
Point V2 Double -> String -> Diagram b -> Diagram b
labelAt p l d = baselineText l # fontSize (output 15) # moveTo p <> d
--labelAt p l d = baselineText l # fontSize (normalized 0.02) # moveTo p <> d
fool, foolD, foolDminus:: Tgraph
-- |fool: fool's kite - also called an ace.
fool = makeTgraph [RK (5,2,7),LK (5,6,4),RK (5,4,3),LK (5,3,2),RD (1,2,3),LD (1,3,4)]
-- fool = makeTgraph [ RD (1,2,3), LD (1,3,4), RK (6,2,5), LK (6,3,2), RK (6,4,3), LK (6,7,4)]
-- |a once decomposed fool (= foolDs!!1)
foolD = decompose fool
-- |foolDminus: 3 faces removed from foolD - still a valid Tgraph
foolDminus = removeFaces [RD (5,15,13), LD (5,16,15), RK (7,11,2)] foolD
-- foolDminus = removeFaces [RD (6,15,13), LD (6,17,15), RK (5,11,2)] foolD
-- | an infinite list of decompositions of fool
foolDs :: [Tgraph]
foolDs = decompositions fool
-- | diagram of just fool.
foolFig :: OKBackend b => Diagram b
foolFig = padBorder $ labelSize normal drawj fool
-- |diagram of fool with foolD.
foolAndFoolD :: OKBackend b => Diagram b
foolAndFoolD = padBorder $ hsep 1 [scale phi $ labelled drawj fool, labelled drawj foolD]
-- |Tgraph for a sun (sun vertex type)
sunGraph :: Tgraph
sunGraph = makeTgraph
[ RK (1,2,11), LK (1,3,2)
, RK (1,4,3) , LK (1,5,4)
, RK (1,6,5) , LK (1,7,6)
, RK (1,8,7) , LK (1,9,8)
, RK (1,10,9), LK (1,11,10)
]
-- | an infinite list of decompositions of sunGraph
sunDs :: [Tgraph]
sunDs = decompositions sunGraph
-- |Figure for a 3 times decomposed sun with a 2 times decomposed sun.
figSunD3D2 :: OKBackend b => Diagram b
figSunD3D2 = padBorder $ hsep 1 [labelled drawj $ sunDs !! 3, scale phi $ labelled drawj $ sunDs !! 2]
-- |Tgraph for kite
kiteGraph :: Tgraph
kiteGraph = makeTgraph [ RK (1,2,4), LK (1,3,2)]
-- | an infinite list of decompositions of a kite
kiteDs :: [Tgraph]
kiteDs = decompositions kiteGraph
-- |Tgraph for a dart
dartGraph :: Tgraph
dartGraph = makeTgraph [ RD (1,2,3), LD (1,3,4)]
-- | an infinite list of decompositions of a dart
dartDs :: [Tgraph]
dartDs = decompositions dartGraph
-- |Tgraph of 4 times decomposed dartGraph (used in several examples)
dartD4 :: Tgraph
dartD4 = dartDs!!4
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 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 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]
-- |diagram of foolDminus and the result of forcing.
forceFoolDminus :: OKBackend b => Diagram b
forceFoolDminus = padBorder $ hsep 1 $ map (labelled drawj) [foolDminus, force foolDminus]
forceDartD5Fig,forceKiteD5Fig,forceSunD5Fig,forceFig :: OKBackend b => Diagram b
-- |diagram of forced 5 times decomposed dart.
forceDartD5Fig = padBorder $ lw ultraThin $ drawForce $ dartDs !! 5
-- |diagram of forced 5 times decomposed kite.
forceKiteD5Fig = padBorder $ lw ultraThin $ rotate (ttangle 1) $ drawForce $ kiteDs!!5
-- |diagram of forced 5 times decomposed sun.
forceSunD5Fig = padBorder $ lw ultraThin $ drawForce $ sunDs !! 5
-- |diagram of forced 5 times decomposed dart (left) and kite (right).
forceFig = hsep 1 [forceDartD5Fig,forceKiteD5Fig]
-- |brokenDart is a 4 times decomposed dart (dartD4) with 5 halftile faces removed.
-- Forcing will repair to produce the same Tgraph as force dartD4.
-- This graph can also be repeatedly composed (without forcing) to get a maximal Tgraph.
brokenDart :: Tgraph
brokenDart = removeFaces deleted dartD4 where
deleted = [RK (2,16,33),LD (15,33,16),RK (16,66,15),LK (16,67,66),LK (5,15,66)]
{-| badlyBrokenDart has more faces removed from brokenDart.
This will also get repaired by forcing (to produce the same as force dartD4).
However it will fail to produce a valid Tgraph if composed twice without forcing.
-}
badlyBrokenDart :: Tgraph
badlyBrokenDart = removeFaces deleted bbd where
deleted = [RK (6,28,54)]
bbd = removeVertices [63,37] brokenDart
-- deleted = RK(6,28,54):filter (isAtV 63) (faces brokenDart)
-- |brokenDartFig shows the faces removed from dartD4 to make brokenDart and badlyBrokenDart.
brokenDartFig :: OKBackend b => Diagram b
brokenDartFig = padBorder $ lw thin $ hsep 1 $ map (labelled drawj) [dartD4, brokenDart, badlyBrokenDart]
-- |badlyBrokenDartFig shows badlyBrokenDart, followed by its composition, followed by the faces
-- that would result from an unchecked second composition which are not tile-connected.
-- (Simply applying compose twice to badlyBrokenDart will raise an error).
badlyBrokenDartFig :: OKBackend b => Diagram b
badlyBrokenDartFig = padBorder $ lw thin $ hsep 1 $ map (labelled drawj) [vp, vpComp, vpFailed] where
vp = makeVP badlyBrokenDart
comp = compose badlyBrokenDart
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.
removeIncompletesFig :: OKBackend b => Diagram b
removeIncompletesFig = padBorder $ drawj $ removeFaces (boundaryJoinFaces g) g where
g = sunDs !! 3
-- |mistake is a legal but incorrect Tgraph - a kite with 2 darts on its long edges
mistake:: Tgraph
mistake = makeTgraph [RK (1,2,4), LK (1,3,2), RD (3,1,5), LD (4,6,1), LD (3,5,7), RD (4,8,6)]
-- |mistake1 is a kite bordered by 2 half darts (subgraph of mistake and still incorrect)
mistake1:: Tgraph
mistake1 = makeTgraph [RK (1,2,4), LK (1,3,2), RD (3,1,5), LD (4,6,1)]
-- * Figures for 7 vertex types
-- | vertexTypesFig is 7 vertex types in a single diagram as a row.
vertexTypesFig :: OKBackend b => Diagram b
vertexTypesFig = padBorder $ hsep 1 lTypeFigs
where
lTypeFigs = zipWith (labelAt (p2 (0,-2.2))) ["sun","star","jack","queen","king","ace","deuce"] vTypeFigs
vTypeFigs = zipWith drawVertex
[sunGraph, starGraph, jackGraph, queenGraph, kingGraph, aceGraph, deuceGraph]
[(1,2), (1,2), (1,2), (1,2), (1,2), (3,6), (2,6)] -- alignments
drawVertex g alm = aligning alm (lw thin . showOrigin . drawj) g
jackGraph,kingGraph,queenGraph,aceGraph,deuceGraph,starGraph::Tgraph
-- |Tgraph for vertex type jack.
jackGraph = makeTgraph
[LK (7,8,1),RK (7,1,5),LD (9,8,10),RD (9,1,8),LK (1,9,11)
,RK (1,11,2),RD (4,6,5),LD (4,5,1),RK (1,3,4),LK (1,2,3)
] -- centre 1
{-
[LK (1,9,11),RK (1,11,2),LK (7,8,1),RD (9,1,8),RK (1,3,4)
,LK (1,2,3),RK (7,1,5),LD (4,5,1),LD (9,8,10),RD (4,6,5)
] -- centre 1
-}
-- |Tgraph for vertex type king.
kingGraph = makeTgraph
[LD (1,10,11),RD (1,9,10),RK (9,7,8),LK (9,1,7),LK (5,6,7)
,RK (5,7,1),LD (1,4,5),RD (1,3,4),RD (1,11,2),LD (1,2,3)
] -- centre 1
{-
[LD (1,2,3),RD (1,11,2),LD (1,4,5),RD (1,3,4),LD (1,10,11)
,RD (1,9,10),LK (9,1,7),RK (9,7,8),RK (5,7,1),LK (5,6,7)
] -- centre 1
-}
-- |Tgraph for vertex type queen.
queenGraph = makeTgraph
[RK (11,9,10),LK (11,1,9),LK (7,8,9),RK (7,9,1),RK (7,5,6)
,LK (7,1,5),LK (3,4,5),RK (3,5,1),RD (1,11,2),LD (1,2,3)
] -- centre 1
{-
[LK (7,1,5),RK (3,5,1),LD (1,2,3),RK (7,9,1),LK (11,1,9)
,RD (1,11,2),RK (7,5,6),LK (7,8,9),LK (3,4,5),RK (11,9,10)
] -- centre 1
-}
-- |Tgraph for vertex type ace (same as fool).
aceGraph = fool -- centre 3
-- |Tgraph for vertextype deuce.
deuceGraph = makeTgraph
[LK (7,8,2),RK (7,2,6),LK (5,6,2),RK (5,2,4)
,LD (1,8,9),RD (1,2,8),RD (1,3,4),LD (1,4,2)
] -- centre 2
{-
[LK (7,8,2),RK (7,2,6),RK (5,2,4),LK (5,6,2),LD (1,4,2)
,RD (1,2,8),RD (1,3,4),LD (1,8,9)
] -- centre 2
-}
-- |Tgraph for vertex type star.
starGraph = makeTgraph
[LD (1,2,3),RD (1,11,2),LD (1,10,11),RD (1,9,10),LD (1,8,9)
,RD (1,7,8),LD (1,6,7),RD (1,5,6),LD (1,4,5),RD (1,3,4)
] -- centre 1
-- |forceVFigures is a list of 7 diagrams - force of 7 vertex types.
forceVFigures :: OKBackend b => [Diagram b]
forceVFigures = rotations [0,0,9,5,0,0,1] $
map (center . drawForce) [sunGraph,starGraph,jackGraph,queenGraph,kingGraph,aceGraph,deuceGraph]
sun3Dart :: Tgraph
-- |A sun with 3 darts on the boundary NOT all adjacent
-- (Used in superForceRocketsFig).
sun3Dart = addHalfDart (9,10) $ addHalfDart (8,9) $ addHalfDart (5,6) $ addHalfDart (4,5) $ addHalfDart (3,4) $ addHalfDart (2,3) sunGraph
-- sun3Dart = addHalfDart (9,10) $ addHalfDart (8,9) sun2AdjDart
-- |Diagram showing superForce with initial Tgraph g (red), force g (red and black),
-- and superForce g (red and black and blue).
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.
superForceRocketsFig :: OKBackend b => Diagram b
superForceRocketsFig = padBorder $ lw veryThin $ vsep 1 $ rotations [8,9,9,8] $
map drawSuperForce decomps where
decomps = take 4 $ decompositions sun3Dart
boundaryFDart4, boundaryFDart5 :: Tgraph
-- |graph of the boundary faces only of a forced graph (dartDs!!4)
boundaryFDart4 = runTry $ tryBoundaryFaceGraph $ force $ initFS dartD4
-- |graph of the boundary faces only of a forced graph (dartDs!!5)
boundaryFDart5 = runTry $ tryBoundaryFaceGraph $ force $ initFS (dartDs!!5)
boundaryFDart4Fig,boundaryFDart5Fig :: OKBackend b => Diagram b
-- |figure of the boundary faces only of a forced graph (dartDs!!4).
boundaryFDart4Fig = padBorder $ lw ultraThin $ smart (labelSize tiny draw) boundaryFDart4
-- |figure of the boundary faces only of a forced graph (dartDs!!5).
boundaryFDart5Fig = padBorder $ lw ultraThin $ smart (labelSize (normalized 0.006) draw) boundaryFDart5
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
-- (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
-- (Used in testing)
boundaryGap4Fig, boundaryGap5Fig :: OKBackend b => Diagram b
-- |figure for the boundary gap graph boundaryGapFDart4.
boundaryGap4Fig = padBorder $ lw ultraThin $ smart (labelSize tiny draw) boundaryGapFDart4
-- |figure for the boundary gap graph boundaryGapFDart5.
boundaryGap5Fig = padBorder $ lw ultraThin $ smart (labelSize (normalized 0.006) draw) boundaryGapFDart5
-- | boundaryVCoveringFigs fs - produces a list of diagrams for the boundaryVCovering of fs
-- (with the Tgraph represented by fs shown in red in each case).
boundaryVCoveringFigs :: OKBackend b =>
Forced ForceState -> [Diagram b]
boundaryVCoveringFigs fs =
lw ultraThin . (redg <>) . aligning alig draw . recoverGraph <$> boundaryVCovering fs
where redg = lc red $ draw g
alig = defaultAlignment g
g = recoverGraph fs
-- | boundaryECoveringFigs bd - produces a list of diagrams for the boundaryECovering of bd
-- (with the Tgraph represented by bd shown in red in each case).
boundaryECoveringFigs :: OKBackend b =>
Forced ForceState -> [Diagram b]
boundaryECoveringFigs fs =
lw ultraThin . (redg <>) . aligning alig draw . recoverGraph <$> boundaryECovering fs
where redg = lc red $ draw g
alig = defaultAlignment g
g = recoverGraph fs
kingECoveringFig,kingVCoveringFig :: OKBackend b => Diagram b
-- | diagram showing the boundaryECovering of a forced kingGraph.
kingECoveringFig = padBorder $ arrangeRows 3 $ boundaryECoveringFigs $ forceF $ initFS kingGraph
-- | diagram showing the boundaryVCovering of a forced kingGraph.
kingVCoveringFig = padBorder $ arrangeRows 3 $ boundaryVCoveringFigs $ forceF $ initFS kingGraph
kingEmpiresFig, kingEmpire1Fig, kingEmpire2Fig :: OKBackend b => Diagram b
-- | figure showing King's empires (1 and 2).
kingEmpiresFig = padBorder $ hsep 10 [kingEmpire1Fig, kingEmpire2Fig]
-- | figure showing King's empires 1.
kingEmpire1Fig = showEmpire1 kingGraph
-- | figure showing King's empire 2.
kingEmpire2Fig = showEmpire2 kingGraph
-- |emplaceChoices first forces then maximally composes. At this top level it
-- produces a list of forced choices for the unknowns (boundary dart long edges).
-- It then repeatedly applies (forceF . decompose) back to the starting level to return a list of Forced Tgraphs.
-- This version relies on compForce theorem and related theorems.
--
-- Note that emplaceChoices is no longer considered useful as information
-- can still be lost when composing even after forcing so the results may not always extend
-- the given Tgraph (e.g. for sun3Dart).
--
-- A better approach to finding extension choices
-- is to calculate a boundaryECovering or a boundaryVCovering after forcing.
-- See extendChoices and extendChoicesFig.
emplaceChoices:: Tgraph -> [Forced Tgraph]
emplaceChoices = emplaceChoicesF . forceF where
emplaceChoicesF:: Forced Tgraph -> [Forced Tgraph]
emplaceChoicesF fg | nullGraph compfg = chooseUnknowns [(unknowns $ getDartWingInfoForced fg, withForced makeBoundaryState fg)]
| otherwise = forceF . decompose <$> emplaceChoicesF compfg
where compfg = composeF fg
chooseUnknowns :: [([Vertex],Forced BoundaryState)] -> [Forced Tgraph]
chooseUnknowns [] = []
chooseUnknowns (([],bd):more) = withForced recoverGraph bd:chooseUnknowns more
chooseUnknowns ((u:unks,bd): more)
= chooseUnknowns (map (remainingunks unks) newgs ++ more)
where newgs = runTry $ tryCheckCasesDKF de bd
de = findDartLongForWing u $ forgetF bd
remainingunks startunks bd' = (startunks `intersect` boundaryVsDup bd', bd')
findDartLongForWing :: Vertex -> BoundaryState -> Dedge
findDartLongForWing v bd
= case find isDart (facesAtBV bd v) of
Just d -> longE d
Nothing -> error $ "findDartLongForWing: dart not found for dart wing vertex " ++ show v
-- |Original example showing emplaceChoices for foolD with foolD shown in red in each choice.
-- Note that replacing foolD by sun3Dart shows that the results do not always extend the original Tgraph.
-- (See also extendChoicesFig.)
emplaceChoicesFig :: OKBackend b => Diagram b
emplaceChoicesFig = padBorder $ lw thin $ hsep 1 $ overlayg <$> emplaceChoices g
where g = foolD
overlayg g' = smartAligning algmnt draw g # lc red # lw medium
<> aligning algmnt draw g'
algmnt = defaultAlignment $ maxCompForce g
-- | extendChoices (better than emplaceChoices) uses a boundary cover after forcing.
-- If there are no force failures (with an incorrect Tgraph),
-- the result is a list of all local possible forced extensions to the given Tgraph.
extendChoices :: Tgraph -> [Forced Tgraph]
extendChoices g = withForced recoverGraph <$> boundaryECovering (forceF $ initFS g)
-- | An example of extendChoices applied to foolD
extendChoicesFig :: OKBackend b => Diagram b
extendChoicesFig = padBorder $ lw thin $ vsep 2 [hsep 3 (take 3 figs), hsep 3 (drop 3 figs)] where
figs = map drawChoice $ extendChoices foolD
drawChoice d = lc red (smartAligning (1,5) draw foolD) <>
aligning (1,5) draw (force foolD) <>
lw ultraThin (aligning (1,5) draw d)
-- | 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 $ lw veryThin $
fillWN darkmagenta indigo g # lc gold
===
draw g # reflectY
where g = decompositions sunGraph !! 5
-- |Performs a shearY transform before and after drawing a forced queenGraph with labels.
-- The left figure shows an untransformed forced queenGraph.
-- The middle figure shows the result of drawing with labels after the VPatch is transformed.
-- The right figure shows the result of transforming the final diagram after drawing with labels.
-- (Since PenroseKiteDart version 1.10, 2D linear transforms will commute with unlabelled drawing
-- from a VPatch, Patch, or P3_Patch.
-- Prior to 1.10 this was only true if the transformation preserved angles.)
testVPTransform :: OKBackend b => Diagram b
testVPTransform =
padBorder $ lw thin $
hcat [drawing vp, drawing (shearY 1.05 vp), shearY 1.05 (drawing vp)]
where vp = rotatedVP (90@@deg) g
g = force queenGraph
drawing = labelled (colourDKG(silver, powderblue, indigo))
-- |Illustrating a non linear (squeeze) deformation being applied to a VPatch.
-- The left figure shows a forced, twice decomposed kingGraph,
-- the middle and right figures are drawn after the deformation,
-- showing both dart/kite (P2 style) and rhombus (P3 style) drawing.
-- Since PenroseKiteDart version 1.10.1 a VPatch is deformable.
deformExample :: OKBackend b => Diagram b
deformExample = padBorder $ lw thin $ hsep 1 [drawing vp1, drawing vp2, drawingR vp2]
where drawing = colourDKG (darkcyan, indigo, peachpuff)
drawingR = lc peachpuff . fillNW darkcyan indigo
g = force $ decompositions kingGraph !!2
vp1 = rotatedVP (90@@deg) g
vp2 = deformVP squeeze vp1
squeeze = Deformation $ \p ->
((p ^. _x) * (1 - (p ^. _y)/30)) ^& (p ^. _y)