{-|
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 #-}
{-# LANGUAGE TupleSections #-}
module TgraphExamples
(-- * Some Layout tools
padBorder
, chunks
, arrangeRowsGap
, arrangeRows
, 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
) where
import Diagrams.Prelude
import Diagrams.TwoD.Text (Text)
-- import ChosenBackend (B)
import TileLib
import Tgraphs
-- |used for most diagrams to give border padding
--
-- When a specific Backend B is in scope, padBorder:: Diagram B -> Diagram B
padBorder :: Diagram2D b -> Diagram2D b
padBorder = pad 1.2 . centerXY
-- |chunks n l - split a list l into chunks of length n (n>0)
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)
-- |arrangeRowsGap s n diags - arranges diags into n per row, centering each row horizontally,
-- with a seperation gap (horizontally and vertically) of s.
-- The result is a single diagram.
--
-- When a specific Backend B is in scope, arrangeRowsGap :: Double -> Int -> [Diagram B] -> Diagram B
arrangeRowsGap :: Double -> Int -> [Diagram2D b] -> Diagram2D b
arrangeRowsGap s n = centerY . vsep s . fmap (centerX . hsep s) . chunks n
-- |arrangeRows n diags - arranges diags into n per row, centering each row horizontally.
-- The result is a single diagram (seperation is 1 unit vertically and horizontally).
--
-- When a specific Backend B is in scope, arrangeRows :: Int -> [Diagram B] -> Diagram B
arrangeRows :: Int -> [Diagram2D b] -> Diagram2D b
arrangeRows = arrangeRowsGap 1.0
-- |add a given label at a given point offset from the centre of the given diagram.
--
-- When a specific Backend B is in scope, labelAt :: Point V2 Double -> String -> Diagram B -> Diagram B
labelAt :: Renderable (Text Double) b =>
Point V2 Double -> String -> Diagram2D b -> Diagram2D 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.
--
-- When a specific Backend B is in scope, foolFig :: Diagram B
foolFig :: (Renderable (Path V2 Double) b, Renderable (Text Double) b) => Diagram2D b
foolFig = padBorder $ labelSize normal drawj fool
-- |diagram of fool with foolD.
--
-- When a specific Backend B is in scope, foolAndFoolD :: Diagram B
foolAndFoolD :: (Renderable (Path V2 Double) b, Renderable (Text Double) b) => Diagram2D 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.
--
-- When a specific Backend B is in scope, figSunD3D2 :: Diagram B
figSunD3D2 :: (Renderable (Path V2 Double) b, Renderable (Text Double) b) => Diagram2D 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 :: Renderable (Path V2 Double) b => Diagram2D b
-- |diagram showing partial composition of a forced 3 times decomposed dart (with remainder faces in pale green).
--
-- When a specific Backend B is in scope, pCompFig1 :: Diagram B
pCompFig1 = lw veryThin $ 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).
--
-- When a specific Backend B is in scope, pCompFig2 :: Diagram B
pCompFig2 = lw veryThin $ hsep 5 [draw fk3, drawPCompose fk3]
where fk3 = force $ kiteDs!!3
-- |diagram showing two partial compositions (with remainder faces in pale green).
--
-- When a specific Backend B is in scope, pCompFig :: Diagram B
pCompFig = padBorder $ vsep 3 [center pCompFig1, center pCompFig2]
-- |diagram of foolDminus and the result of forcing.
--
-- When a specific Backend B is in scope, forceFoolDminus :: Diagram B
forceFoolDminus :: (Renderable (Path V2 Double) b, Renderable (Text Double) b) => Diagram2D b
forceFoolDminus = padBorder $ hsep 1 $ fmap (labelled drawj) [foolDminus, force foolDminus]
forceDartD5Fig,forceKiteD5Fig,forceSunD5Fig,forceFig :: Renderable (Path V2 Double) b => Diagram2D b
-- |diagram of forced 5 times decomposed dart.
--
-- When a specific Backend B is in scope, forceDartD5Fig :: Diagram B
forceDartD5Fig = padBorder $ lw ultraThin $ drawForce $ dartDs !! 5
-- |diagram of forced 5 times decomposed kite.
--
-- When a specific Backend B is in scope, forceKiteD5Fig :: Diagram B
forceKiteD5Fig = padBorder $ lw ultraThin $ rotate (ttangle 1) $ drawForce $ kiteDs!!5
-- |diagram of forced 5 times decomposed sun.
--
-- When a specific Backend B is in scope, forceSunD5Fig :: Diagram B
forceSunD5Fig = padBorder $ lw ultraThin $ drawForce $ sunDs !! 5
-- |diagram of forced 5 times decomposed dart (left) and kite (right).
--
-- When a specific Backend B is in scope, forceFig :: Diagram B
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.
--
-- When a specific Backend B is in scope, brokenDartFig :: Diagram B
brokenDartFig :: (Renderable (Path V2 Double) b, Renderable (Text Double) b) => Diagram2D b
brokenDartFig = padBorder $ lw thin $ hsep 1 $ fmap (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).
--
-- When a specific Backend B is in scope, badlyBrokenDartFig :: Diagram B
badlyBrokenDartFig :: (Renderable (Path V2 Double) b, Renderable (Text Double) b) => Diagram2D b
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 $ composedFaces comp
-- |figure showing the result of removing incomplete tiles (those that do not have their matching halftile)
-- to a 3 times decomposed sun.
--
-- When a specific Backend B is in scope, removeIncompletesFig :: Diagram B
removeIncompletesFig :: Renderable (Path V2 Double) b => Diagram2D 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.
--
-- When a specific Backend B is in scope, vertexTypesFig :: Diagram B
vertexTypesFig :: (Renderable (Path V2 Double) b, Renderable (Text Double) b) => Diagram2D 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 = alignBefore (lw thin . showOrigin . drawj) alm g
jackGraph,kingGraph,queenGraph,aceGraph,deuceGraph,starGraph::Tgraph
-- |Tgraph for vertex type jack.
jackGraph = makeTgraph
[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,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
[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),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.
--
-- When a specific Backend B is in scope, forceVFigures :: [Diagram B]
forceVFigures :: Renderable (Path V2 Double) b => [Diagram2D b]
forceVFigures = rotations [0,0,9,5,0,0,1] $
fmap (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).
--
-- When a specific Backend B is in scope, superForceFig :: Diagram B
superForceFig :: Renderable (Path V2 Double) b => Diagram2D b
superForceFig = padBorder $ lw thin $ rotate (ttangle 1) $ drawSuperForce g where
g = addHalfDart (220,221) $ force $ decompositions fool !!3
-- |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.
--
-- When a specific Backend B is in scope, superForceRocketsFig :: Diagram B
superForceRocketsFig :: Renderable (Path V2 Double) b => Diagram2D b
superForceRocketsFig = padBorder $ lw veryThin $ vsep 1 $ rotations [8,9,9,8] $
fmap drawSuperForce decomps where
decomps = take 4 $ decompositions sun3Dart
boundaryFDart4, boundaryFDart5 :: Tgraph
-- |graph of the boundary faces only of a forced graph (dartDs!!4)
boundaryFDart4 = checkedTgraph $ boundaryFaces $ force $ makeBoundaryState dartD4
-- |graph of the boundary faces only of a forced graph (dartDs!!5)
boundaryFDart5 = checkedTgraph $ boundaryFaces $ force $ makeBoundaryState (dartDs!!5)
boundaryFDart4Fig,boundaryFDart5Fig :: (Renderable (Path V2 Double) b, Renderable (Text Double) b) => Diagram2D b
-- |figure of the boundary faces only of a forced graph (dartDs!!4).
--
-- When a specific Backend B is in scope, boundaryFDart4Fig :: Diagram B
boundaryFDart4Fig = padBorder $ lw ultraThin $ labelSize tiny drawj boundaryFDart4
-- |figure of the boundary faces only of a forced graph (dartDs!!5).
--
-- When a specific Backend B is in scope, boundaryFDart5Fig :: Diagram B
boundaryFDart5Fig = padBorder $ lw ultraThin $ labelSize (normalized 0.006) drawj 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
-- checkedTgraph $ filter ((/=354).originV) (faces boundaryFDart4)
-- |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)
boundaryGap4Fig, boundaryGap5Fig :: (Renderable (Path V2 Double) b, Renderable (Text Double) b) => Diagram2D b
-- |figure for the boundary gap graph boundaryGapFDart4.
--
-- When a specific Backend B is in scope, boundaryGap4Fig :: Diagram B
boundaryGap4Fig = padBorder $ lw ultraThin $ labelSize tiny drawj boundaryGapFDart4
-- |figure for the boundary gap graph boundaryGapFDart5.
--
-- When a specific Backend B is in scope, boundaryGap5Fig :: Diagram B
boundaryGap5Fig = padBorder $ lw ultraThin $ labelSize (normalized 0.006) drawj boundaryGapFDart5
-- | boundaryVCoveringFigs bd - produces a list of diagrams for the boundaryVCovering of bd
-- (with the Tgraph represented by bd shown in red in each case).
--
-- When a specific Backend B is in scope, boundaryVCoveringFigs :: BoundaryState -> [Diagram B]
boundaryVCoveringFigs :: Renderable (Path V2 Double) b =>
BoundaryState -> [Diagram2D b]
boundaryVCoveringFigs bd =
fmap (lw ultraThin . (redg <>) . alignBefore draw alig . recoverGraph) $ boundaryVCovering bd
where redg = lc red $ draw g --alignBefore draw alig g
alig = defaultAlignment g
g = recoverGraph bd
-- | boundaryECoveringFigs bd - produces a list of diagrams for the boundaryECovering of bd
-- (with the Tgraph represented by bd shown in red in each case).
--
-- When a specific Backend B is in scope, boundaryECoveringFigs :: BoundaryState -> [Diagram B]
boundaryECoveringFigs :: Renderable (Path V2 Double) b =>
BoundaryState -> [Diagram2D b]
boundaryECoveringFigs bd =
fmap (lw ultraThin . (redg <>) . alignBefore draw alig . recoverGraph) $ boundaryECovering bd
where redg = lc red $ draw g
alig = defaultAlignment g
g = recoverGraph bd
kingECoveringFig,kingVCoveringFig :: Renderable (Path V2 Double) b => Diagram2D b
-- | diagram showing the boundaryECovering of a forced kingGraph.
--
-- When a specific Backend B is in scope, kingECoveringFig :: Diagram B
kingECoveringFig = padBorder $ arrangeRows 3 $ boundaryECoveringFigs $ force $ makeBoundaryState kingGraph
-- | diagram showing the boundaryVCovering of a forced kingGraph.
--
-- When a specific Backend B is in scope, kingVCoveringFig :: Diagram B
kingVCoveringFig = padBorder $ arrangeRows 3 $ boundaryVCoveringFigs $ force $ makeBoundaryState kingGraph
kingEmpiresFig, kingEmpire1Fig, kingEmpire2Fig :: Renderable (Path V2 Double) b => Diagram2D b
-- | figure showing King's empires (1 and 2).
--
-- When a specific Backend B is in scope, kingEmpiresFig :: Diagram B
kingEmpiresFig = padBorder $ hsep 10 [kingEmpire1Fig, kingEmpire2Fig]
-- | figure showing King's empires 1.
--
-- When a specific Backend B is in scope, kingEmpire1Fig :: Diagram B
kingEmpire1Fig = showEmpire1 kingGraph
-- | figure showing King's empire 2.
--
-- When a specific Backend B is in scope, kingEmpire2Fig :: Diagram B
kingEmpire2Fig = showEmpire2 kingGraph