{-|
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              #-}


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
    -- *  Emplace Choices
 , emplaceChoices
 , emplaceChoicesFig

  ) where

import Diagrams.Prelude
import PKD
import Tgraph.Prelude as NoWarn (makeUncheckedTgraph)
import Data.List (intersect,find)      -- for emplaceChoices


-- |used for most diagrams to give border padding
padBorder :: OKBackend b =>
             Diagram b -> Diagram b
padBorder :: forall b. OKBackend b => Diagram b -> Diagram b
padBorder = Double -> QDiagram b V2 Double Any -> QDiagram b V2 Double Any
forall (v :: * -> *) n m b.
(Metric v, OrderedField n, Monoid' m) =>
n -> QDiagram b v n m -> QDiagram b v n m
pad Double
1.2 (QDiagram b V2 Double Any -> QDiagram b V2 Double Any)
-> (QDiagram b V2 Double Any -> QDiagram b V2 Double Any)
-> QDiagram b V2 Double Any
-> QDiagram b V2 Double Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QDiagram b V2 Double Any -> QDiagram b V2 Double Any
forall (v :: * -> *) n a.
(InSpace v n a, R2 v, Fractional n, Alignable a, HasOrigin a) =>
a -> a
centerXY

-- |chunks n l -  split a list l into chunks of length n (n>0)
chunks::Int -> [a] -> [[a]]
chunks :: forall a. Vertex -> [a] -> [[a]]
chunks Vertex
n
  | Vertex
n Vertex -> Vertex -> Bool
forall a. Ord a => a -> a -> Bool
< Vertex
1 = [Char] -> [a] -> [[a]]
forall a. HasCallStack => [Char] -> a
error [Char]
"chunks: argument <1\n"
  | Bool
otherwise = [a] -> [[a]]
ch where
      ch :: [a] -> [[a]]
ch [] = []
      ch [a]
as = Vertex -> [a] -> [a]
forall a. Vertex -> [a] -> [a]
take Vertex
n [a]
as [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [a] -> [[a]]
ch (Vertex -> [a] -> [a]
forall a. Vertex -> [a] -> [a]
drop Vertex
n [a]
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.
arrangeRowsGap :: OKBackend b =>
                  Double -> Int -> [Diagram b] -> Diagram b
arrangeRowsGap :: forall b.
OKBackend b =>
Double -> Vertex -> [Diagram b] -> Diagram b
arrangeRowsGap Double
s Vertex
n = QDiagram b V2 Double Any -> QDiagram b V2 Double Any
forall (v :: * -> *) n a.
(InSpace v n a, R2 v, Fractional n, Alignable a, HasOrigin a) =>
a -> a
centerY (QDiagram b V2 Double Any -> QDiagram b V2 Double Any)
-> ([QDiagram b V2 Double Any] -> QDiagram b V2 Double Any)
-> [QDiagram b V2 Double Any]
-> QDiagram b V2 Double Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> [QDiagram b V2 Double Any] -> QDiagram b V2 Double Any
forall n a.
(InSpace V2 n a, Floating n, Juxtaposable a, HasOrigin a,
 Monoid' a) =>
n -> [a] -> a
vsep Double
s ([QDiagram b V2 Double Any] -> QDiagram b V2 Double Any)
-> ([QDiagram b V2 Double Any] -> [QDiagram b V2 Double Any])
-> [QDiagram b V2 Double Any]
-> QDiagram b V2 Double Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([QDiagram b V2 Double Any] -> QDiagram b V2 Double Any)
-> [[QDiagram b V2 Double Any]] -> [QDiagram b V2 Double Any]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (QDiagram b V2 Double Any -> QDiagram b V2 Double Any
forall (v :: * -> *) n a.
(InSpace v n a, R1 v, Fractional n, Alignable a, HasOrigin a) =>
a -> a
centerX (QDiagram b V2 Double Any -> QDiagram b V2 Double Any)
-> ([QDiagram b V2 Double Any] -> QDiagram b V2 Double Any)
-> [QDiagram b V2 Double Any]
-> QDiagram b V2 Double Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> [QDiagram b V2 Double Any] -> QDiagram b V2 Double Any
forall n a.
(InSpace V2 n a, Floating n, Juxtaposable a, HasOrigin a,
 Monoid' a) =>
n -> [a] -> a
hsep Double
s) ([[QDiagram b V2 Double Any]] -> [QDiagram b V2 Double Any])
-> ([QDiagram b V2 Double Any] -> [[QDiagram b V2 Double Any]])
-> [QDiagram b V2 Double Any]
-> [QDiagram b V2 Double Any]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vertex
-> [QDiagram b V2 Double Any] -> [[QDiagram b V2 Double Any]]
forall a. Vertex -> [a] -> [[a]]
chunks Vertex
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).
arrangeRows :: OKBackend b =>
               Int -> [Diagram b] -> Diagram b
arrangeRows :: forall b. OKBackend b => Vertex -> [Diagram b] -> Diagram b
arrangeRows = Double
-> Vertex
-> [QDiagram b (V b) (N b) Any]
-> QDiagram b (V b) (N b) Any
forall b.
OKBackend b =>
Double -> Vertex -> [Diagram b] -> Diagram b
arrangeRowsGap Double
1.0

-- |add a given label at a given point offset from the centre of the given diagram.
labelAt :: OKBackend b =>
           Point V2 Double -> String -> Diagram b -> Diagram b
labelAt :: forall b.
OKBackend b =>
Point V2 Double -> [Char] -> Diagram b -> Diagram b
labelAt Point V2 Double
p [Char]
l Diagram b
d = [Char] -> QDiagram b V2 Double Any
forall n b.
(TypeableFloat n, Renderable (Text n) b) =>
[Char] -> QDiagram b V2 n Any
baselineText [Char]
l QDiagram b V2 Double Any
-> (QDiagram b V2 Double Any -> QDiagram b V2 Double Any)
-> QDiagram b V2 Double Any
forall a b. a -> (a -> b) -> b
# Measure Double
-> QDiagram b V2 Double Any -> QDiagram b V2 Double Any
forall a n.
(N a ~ n, Typeable n, HasStyle a) =>
Measure n -> a -> a
fontSize (Double -> Measure Double
forall n. n -> Measure n
output Double
15) QDiagram b V2 Double Any
-> (QDiagram b V2 Double Any -> QDiagram b V2 Double Any)
-> QDiagram b V2 Double Any
forall a b. a -> (a -> b) -> b
# Point V2 Double
-> QDiagram b V2 Double Any -> QDiagram b V2 Double Any
forall (v :: * -> *) n t.
(InSpace v n t, HasOrigin t) =>
Point v n -> t -> t
moveTo Point V2 Double
p QDiagram b V2 Double Any
-> QDiagram b V2 Double Any -> QDiagram b V2 Double Any
forall a. Semigroup a => a -> a -> a
<> Diagram b
QDiagram b V2 Double Any
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 :: Tgraph
fool = [TileFace] -> Tgraph
makeTgraph [(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
RK (Vertex
5,Vertex
2,Vertex
7),(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
LK (Vertex
5,Vertex
6,Vertex
4),(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
RK (Vertex
5,Vertex
4,Vertex
3),(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
LK (Vertex
5,Vertex
3,Vertex
2),(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
RD (Vertex
1,Vertex
2,Vertex
3),(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
LD (Vertex
1,Vertex
3,Vertex
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 :: Tgraph
foolD = Tgraph -> Tgraph
decompose Tgraph
fool

-- |foolDminus: 3 faces removed from foolD - still a valid Tgraph
foolDminus :: Tgraph
foolDminus = [TileFace] -> Tgraph -> Tgraph
removeFaces [(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
RD (Vertex
5,Vertex
15,Vertex
13), (Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
LD (Vertex
5,Vertex
16,Vertex
15), (Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
RK (Vertex
7,Vertex
11,Vertex
2)] Tgraph
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 :: [Tgraph]
foolDs = Tgraph -> [Tgraph]
decompositions Tgraph
fool

-- | diagram of just fool.
foolFig :: OKBackend b => Diagram b
foolFig :: forall b. OKBackend b => Diagram b
foolFig = QDiagram b (V b) (N b) Any -> QDiagram b (V b) (N b) Any
forall b. OKBackend b => Diagram b -> Diagram b
padBorder (QDiagram b (V b) (N b) Any -> QDiagram b (V b) (N b) Any)
-> QDiagram b (V b) (N b) Any -> QDiagram b (V b) (N b) Any
forall a b. (a -> b) -> a -> b
$ Measure Double
-> (Patch -> QDiagram b (V b) (N b) Any)
-> Tgraph
-> QDiagram b (V b) (N b) Any
forall b a.
(OKBackend b, DrawableLabelled a) =>
Measure Double -> (Patch -> Diagram b) -> a -> Diagram b
labelSize Measure Double
forall n. OrderedField n => Measure n
normal Patch -> QDiagram b (V b) (N b) Any
forall a b. (Drawable a, OKBackend b) => a -> Diagram b
drawj Tgraph
fool

-- |diagram of fool with foolD.
foolAndFoolD :: OKBackend b => Diagram b
foolAndFoolD :: forall b. OKBackend b => Diagram b
foolAndFoolD = QDiagram b (V b) (N b) Any -> QDiagram b (V b) (N b) Any
forall b. OKBackend b => Diagram b -> Diagram b
padBorder (QDiagram b (V b) (N b) Any -> QDiagram b (V b) (N b) Any)
-> QDiagram b (V b) (N b) Any -> QDiagram b (V b) (N b) Any
forall a b. (a -> b) -> a -> b
$ Double -> [QDiagram b V2 Double Any] -> QDiagram b V2 Double Any
forall n a.
(InSpace V2 n a, Floating n, Juxtaposable a, HasOrigin a,
 Monoid' a) =>
n -> [a] -> a
hsep Double
1 [Double -> QDiagram b V2 Double Any -> QDiagram b V2 Double Any
forall (v :: * -> *) n a.
(InSpace v n a, Eq n, Fractional n, Transformable a) =>
n -> a -> a
scale Double
phi (QDiagram b V2 Double Any -> QDiagram b V2 Double Any)
-> QDiagram b V2 Double Any -> QDiagram b V2 Double Any
forall a b. (a -> b) -> a -> b
$ (Patch -> QDiagram b (V b) (N b) Any)
-> Tgraph -> QDiagram b (V b) (N b) Any
forall b a.
(OKBackend b, DrawableLabelled a) =>
(Patch -> Diagram b) -> a -> Diagram b
labelled Patch -> QDiagram b (V b) (N b) Any
forall a b. (Drawable a, OKBackend b) => a -> Diagram b
drawj Tgraph
fool, (Patch -> QDiagram b (V b) (N b) Any)
-> Tgraph -> QDiagram b (V b) (N b) Any
forall b a.
(OKBackend b, DrawableLabelled a) =>
(Patch -> Diagram b) -> a -> Diagram b
labelled Patch -> QDiagram b (V b) (N b) Any
forall a b. (Drawable a, OKBackend b) => a -> Diagram b
drawj Tgraph
foolD]

-- |Tgraph for a sun (sun vertex type)
sunGraph :: Tgraph
sunGraph :: Tgraph
sunGraph = [TileFace] -> Tgraph
makeTgraph
             [ (Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
RK (Vertex
1,Vertex
2,Vertex
11), (Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
LK (Vertex
1,Vertex
3,Vertex
2)
             , (Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
RK (Vertex
1,Vertex
4,Vertex
3) , (Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
LK (Vertex
1,Vertex
5,Vertex
4)
             , (Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
RK (Vertex
1,Vertex
6,Vertex
5) , (Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
LK (Vertex
1,Vertex
7,Vertex
6)
             , (Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
RK (Vertex
1,Vertex
8,Vertex
7) , (Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
LK (Vertex
1,Vertex
9,Vertex
8)
             , (Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
RK (Vertex
1,Vertex
10,Vertex
9), (Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
LK (Vertex
1,Vertex
11,Vertex
10)
             ]
-- | an infinite list of decompositions of sunGraph
sunDs :: [Tgraph]
sunDs :: [Tgraph]
sunDs =  Tgraph -> [Tgraph]
decompositions Tgraph
sunGraph

-- |Figure for a 3 times decomposed sun with a 2 times decomposed sun.
figSunD3D2 :: OKBackend b => Diagram b
figSunD3D2 :: forall b. OKBackend b => Diagram b
figSunD3D2 = QDiagram b (V b) (N b) Any -> QDiagram b (V b) (N b) Any
forall b. OKBackend b => Diagram b -> Diagram b
padBorder (QDiagram b (V b) (N b) Any -> QDiagram b (V b) (N b) Any)
-> QDiagram b (V b) (N b) Any -> QDiagram b (V b) (N b) Any
forall a b. (a -> b) -> a -> b
$ Double -> [QDiagram b V2 Double Any] -> QDiagram b V2 Double Any
forall n a.
(InSpace V2 n a, Floating n, Juxtaposable a, HasOrigin a,
 Monoid' a) =>
n -> [a] -> a
hsep Double
1 [(Patch -> QDiagram b (V b) (N b) Any)
-> Tgraph -> QDiagram b (V b) (N b) Any
forall b a.
(OKBackend b, DrawableLabelled a) =>
(Patch -> Diagram b) -> a -> Diagram b
labelled Patch -> QDiagram b (V b) (N b) Any
forall a b. (Drawable a, OKBackend b) => a -> Diagram b
drawj (Tgraph -> QDiagram b (V b) (N b) Any)
-> Tgraph -> QDiagram b (V b) (N b) Any
forall a b. (a -> b) -> a -> b
$ [Tgraph]
sunDs [Tgraph] -> Vertex -> Tgraph
forall a. HasCallStack => [a] -> Vertex -> a
!! Vertex
3, Double -> QDiagram b V2 Double Any -> QDiagram b V2 Double Any
forall (v :: * -> *) n a.
(InSpace v n a, Eq n, Fractional n, Transformable a) =>
n -> a -> a
scale Double
phi (QDiagram b V2 Double Any -> QDiagram b V2 Double Any)
-> QDiagram b V2 Double Any -> QDiagram b V2 Double Any
forall a b. (a -> b) -> a -> b
$ (Patch -> QDiagram b (V b) (N b) Any)
-> Tgraph -> QDiagram b (V b) (N b) Any
forall b a.
(OKBackend b, DrawableLabelled a) =>
(Patch -> Diagram b) -> a -> Diagram b
labelled Patch -> QDiagram b (V b) (N b) Any
forall a b. (Drawable a, OKBackend b) => a -> Diagram b
drawj (Tgraph -> QDiagram b (V b) (N b) Any)
-> Tgraph -> QDiagram b (V b) (N b) Any
forall a b. (a -> b) -> a -> b
$ [Tgraph]
sunDs [Tgraph] -> Vertex -> Tgraph
forall a. HasCallStack => [a] -> Vertex -> a
!! Vertex
2]

-- |Tgraph for kite
kiteGraph :: Tgraph
kiteGraph :: Tgraph
kiteGraph = [TileFace] -> Tgraph
makeTgraph [ (Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
RK (Vertex
1,Vertex
2,Vertex
4), (Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
LK (Vertex
1,Vertex
3,Vertex
2)]

-- | an infinite list of decompositions of a kite
kiteDs :: [Tgraph]
kiteDs :: [Tgraph]
kiteDs = Tgraph -> [Tgraph]
decompositions Tgraph
kiteGraph

-- |Tgraph for a dart
dartGraph :: Tgraph
dartGraph :: Tgraph
dartGraph =  [TileFace] -> Tgraph
makeTgraph [ (Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
RD (Vertex
1,Vertex
2,Vertex
3), (Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
LD (Vertex
1,Vertex
3,Vertex
4)]

-- | an infinite list of decompositions of a dart
dartDs :: [Tgraph]
dartDs :: [Tgraph]
dartDs =  Tgraph -> [Tgraph]
decompositions Tgraph
dartGraph

-- |Tgraph of 4 times decomposed dartGraph (used in several examples)
dartD4 :: Tgraph
dartD4 :: Tgraph
dartD4 = [Tgraph]
dartDs[Tgraph] -> Vertex -> Tgraph
forall a. HasCallStack => [a] -> Vertex -> a
!!Vertex
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 :: forall b. OKBackend b => Diagram b
pCompFig1 = Measure Double -> Diagram b -> Diagram b
forall a n.
(N a ~ n, HasStyle a, Typeable n) =>
Measure n -> a -> a
lw Measure Double
forall n. OrderedField n => Measure n
veryThin (Diagram b -> Diagram b) -> Diagram b -> Diagram b
forall a b. (a -> b) -> a -> b
$ Double -> [Diagram b] -> Diagram b
forall n a.
(InSpace V2 n a, Floating n, Juxtaposable a, HasOrigin a,
 Monoid' a) =>
n -> [a] -> a
hsep Double
5 ([Diagram b] -> Diagram b) -> [Diagram b] -> Diagram b
forall a b. (a -> b) -> a -> b
$ [Vertex]
-> [QDiagram b V2 Double Any] -> [QDiagram b V2 Double Any]
forall a.
(Transformable a, V a ~ V2, N a ~ Double) =>
[Vertex] -> [a] -> [a]
rotations [Vertex
1,Vertex
1] [Tgraph -> Diagram b
forall a b. (Drawable a, OKBackend b) => a -> Diagram b
draw Tgraph
fd3, Tgraph -> Diagram b
forall b. OKBackend b => Tgraph -> Diagram b
drawPCompose Tgraph
fd3]
            where fd3 :: Tgraph
fd3 = Tgraph -> Tgraph
forall a. Forcible a => a -> a
force (Tgraph -> Tgraph) -> Tgraph -> Tgraph
forall a b. (a -> b) -> a -> b
$ [Tgraph]
dartDs[Tgraph] -> Vertex -> Tgraph
forall a. HasCallStack => [a] -> Vertex -> a
!!Vertex
3
-- |diagram showing partial composition of a forced 3 times decomposed kite (with remainder faces in pale green).
pCompFig2 :: forall b. OKBackend b => Diagram b
pCompFig2 = Measure Double -> Diagram b -> Diagram b
forall a n.
(N a ~ n, HasStyle a, Typeable n) =>
Measure n -> a -> a
lw Measure Double
forall n. OrderedField n => Measure n
veryThin (Diagram b -> Diagram b) -> Diagram b -> Diagram b
forall a b. (a -> b) -> a -> b
$ Double -> [QDiagram b V2 Double Any] -> QDiagram b V2 Double Any
forall n a.
(InSpace V2 n a, Floating n, Juxtaposable a, HasOrigin a,
 Monoid' a) =>
n -> [a] -> a
hsep Double
5 [Tgraph -> Diagram b
forall a b. (Drawable a, OKBackend b) => a -> Diagram b
draw Tgraph
fk3, Tgraph -> Diagram b
forall b. OKBackend b => Tgraph -> Diagram b
drawPCompose Tgraph
fk3]
            where fk3 :: Tgraph
fk3 = Tgraph -> Tgraph
forall a. Forcible a => a -> a
force (Tgraph -> Tgraph) -> Tgraph -> Tgraph
forall a b. (a -> b) -> a -> b
$ [Tgraph]
kiteDs[Tgraph] -> Vertex -> Tgraph
forall a. HasCallStack => [a] -> Vertex -> a
!!Vertex
3
-- |diagram showing two partial compositions (with remainder faces in pale green).
pCompFig :: forall b. OKBackend b => Diagram b
pCompFig = QDiagram b (V b) (N b) Any -> QDiagram b (V b) (N b) Any
forall b. OKBackend b => Diagram b -> Diagram b
padBorder (QDiagram b (V b) (N b) Any -> QDiagram b (V b) (N b) Any)
-> QDiagram b (V b) (N b) Any -> QDiagram b (V b) (N b) Any
forall a b. (a -> b) -> a -> b
$ Double -> [QDiagram b V2 Double Any] -> QDiagram b V2 Double Any
forall n a.
(InSpace V2 n a, Floating n, Juxtaposable a, HasOrigin a,
 Monoid' a) =>
n -> [a] -> a
vsep Double
3 [QDiagram b V2 Double Any -> QDiagram b V2 Double Any
forall (v :: * -> *) n a.
(InSpace v n a, Fractional n, Traversable v, Alignable a,
 HasOrigin a) =>
a -> a
center QDiagram b (V b) (N b) Any
QDiagram b V2 Double Any
forall b. OKBackend b => Diagram b
pCompFig1, QDiagram b V2 Double Any -> QDiagram b V2 Double Any
forall (v :: * -> *) n a.
(InSpace v n a, Fractional n, Traversable v, Alignable a,
 HasOrigin a) =>
a -> a
center QDiagram b (V b) (N b) Any
QDiagram b V2 Double Any
forall b. OKBackend b => Diagram b
pCompFig2]


-- |diagram of foolDminus and the result of forcing.  
forceFoolDminus :: OKBackend b => Diagram b
forceFoolDminus :: forall b. OKBackend b => Diagram b
forceFoolDminus = Diagram b -> Diagram b
forall b. OKBackend b => Diagram b -> Diagram b
padBorder (Diagram b -> Diagram b) -> Diagram b -> Diagram b
forall a b. (a -> b) -> a -> b
$ Double -> [Diagram b] -> Diagram b
forall n a.
(InSpace V2 n a, Floating n, Juxtaposable a, HasOrigin a,
 Monoid' a) =>
n -> [a] -> a
hsep Double
1 ([Diagram b] -> Diagram b) -> [Diagram b] -> Diagram b
forall a b. (a -> b) -> a -> b
$ (Tgraph -> QDiagram b V2 Double Any)
-> [Tgraph] -> [QDiagram b V2 Double Any]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Patch -> Diagram b) -> Tgraph -> Diagram b
forall b a.
(OKBackend b, DrawableLabelled a) =>
(Patch -> Diagram b) -> a -> Diagram b
labelled Patch -> Diagram b
forall a b. (Drawable a, OKBackend b) => a -> Diagram b
drawj) [Tgraph
foolDminus, Tgraph -> Tgraph
forall a. Forcible a => a -> a
force Tgraph
foolDminus]


forceDartD5Fig,forceKiteD5Fig,forceSunD5Fig,forceFig :: OKBackend b => Diagram b
-- |diagram of forced 5 times decomposed dart.
forceDartD5Fig :: forall b. OKBackend b => Diagram b
forceDartD5Fig = Diagram b -> Diagram b
forall b. OKBackend b => Diagram b -> Diagram b
padBorder (Diagram b -> Diagram b) -> Diagram b -> Diagram b
forall a b. (a -> b) -> a -> b
$ Measure Double -> Diagram b -> Diagram b
forall a n.
(N a ~ n, HasStyle a, Typeable n) =>
Measure n -> a -> a
lw Measure Double
forall n. OrderedField n => Measure n
ultraThin (Diagram b -> Diagram b) -> Diagram b -> Diagram b
forall a b. (a -> b) -> a -> b
$ Tgraph -> Diagram b
forall b. OKBackend b => Tgraph -> Diagram b
drawForce (Tgraph -> Diagram b) -> Tgraph -> Diagram b
forall a b. (a -> b) -> a -> b
$ [Tgraph]
dartDs [Tgraph] -> Vertex -> Tgraph
forall a. HasCallStack => [a] -> Vertex -> a
!! Vertex
5
-- |diagram of forced 5 times decomposed kite.
forceKiteD5Fig :: forall b. OKBackend b => Diagram b
forceKiteD5Fig = Diagram b -> Diagram b
forall b. OKBackend b => Diagram b -> Diagram b
padBorder (Diagram b -> Diagram b) -> Diagram b -> Diagram b
forall a b. (a -> b) -> a -> b
$ Measure Double -> Diagram b -> Diagram b
forall a n.
(N a ~ n, HasStyle a, Typeable n) =>
Measure n -> a -> a
lw Measure Double
forall n. OrderedField n => Measure n
ultraThin (Diagram b -> Diagram b) -> Diagram b -> Diagram b
forall a b. (a -> b) -> a -> b
$ Angle Double -> Diagram b -> Diagram b
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate (Vertex -> Angle Double
ttangle Vertex
1) (Diagram b -> Diagram b) -> Diagram b -> Diagram b
forall a b. (a -> b) -> a -> b
$ Tgraph -> Diagram b
forall b. OKBackend b => Tgraph -> Diagram b
drawForce (Tgraph -> Diagram b) -> Tgraph -> Diagram b
forall a b. (a -> b) -> a -> b
$ [Tgraph]
kiteDs[Tgraph] -> Vertex -> Tgraph
forall a. HasCallStack => [a] -> Vertex -> a
!!Vertex
5
-- |diagram of forced 5 times decomposed sun.
forceSunD5Fig :: forall b. OKBackend b => Diagram b
forceSunD5Fig =  Diagram b -> Diagram b
forall b. OKBackend b => Diagram b -> Diagram b
padBorder (Diagram b -> Diagram b) -> Diagram b -> Diagram b
forall a b. (a -> b) -> a -> b
$ Measure Double -> Diagram b -> Diagram b
forall a n.
(N a ~ n, HasStyle a, Typeable n) =>
Measure n -> a -> a
lw Measure Double
forall n. OrderedField n => Measure n
ultraThin (Diagram b -> Diagram b) -> Diagram b -> Diagram b
forall a b. (a -> b) -> a -> b
$ Tgraph -> Diagram b
forall b. OKBackend b => Tgraph -> Diagram b
drawForce (Tgraph -> Diagram b) -> Tgraph -> Diagram b
forall a b. (a -> b) -> a -> b
$ [Tgraph]
sunDs [Tgraph] -> Vertex -> Tgraph
forall a. HasCallStack => [a] -> Vertex -> a
!! Vertex
5
-- |diagram of forced 5 times decomposed dart (left) and kite (right).
forceFig :: forall b. OKBackend b => Diagram b
forceFig = Double -> [QDiagram b V2 Double Any] -> QDiagram b V2 Double Any
forall n a.
(InSpace V2 n a, Floating n, Juxtaposable a, HasOrigin a,
 Monoid' a) =>
n -> [a] -> a
hsep Double
1 [QDiagram b (V b) (N b) Any
QDiagram b V2 Double Any
forall b. OKBackend b => Diagram b
forceDartD5Fig,QDiagram b (V b) (N b) Any
QDiagram b V2 Double Any
forall b. OKBackend b => Diagram b
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 :: Tgraph
brokenDart = [TileFace] -> Tgraph -> Tgraph
removeFaces [TileFace]
forall {a} {b} {c}. (Num a, Num b, Num c) => [HalfTile (a, b, c)]
deleted Tgraph
dartD4 where
  deleted :: [HalfTile (a, b, c)]
deleted = [(a, b, c) -> HalfTile (a, b, c)
forall rep. rep -> HalfTile rep
RK (a
2,b
16,c
33),(a, b, c) -> HalfTile (a, b, c)
forall rep. rep -> HalfTile rep
LD (a
15,b
33,c
16),(a, b, c) -> HalfTile (a, b, c)
forall rep. rep -> HalfTile rep
RK (a
16,b
66,c
15),(a, b, c) -> HalfTile (a, b, c)
forall rep. rep -> HalfTile rep
LK (a
16,b
67,c
66),(a, b, c) -> HalfTile (a, b, c)
forall rep. rep -> HalfTile rep
LK (a
5,b
15,c
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 :: Tgraph
badlyBrokenDart = [TileFace] -> Tgraph -> Tgraph
removeFaces [TileFace]
forall {a} {b} {c}. (Num a, Num b, Num c) => [HalfTile (a, b, c)]
deleted Tgraph
bbd where
  deleted :: [HalfTile (a, b, c)]
deleted = [(a, b, c) -> HalfTile (a, b, c)
forall rep. rep -> HalfTile rep
RK (a
6,b
28,c
54)]
  bbd :: Tgraph
bbd = [Vertex] -> Tgraph -> Tgraph
removeVertices [Vertex
63,Vertex
37] Tgraph
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 :: forall b. OKBackend b => Diagram b
brokenDartFig = Diagram b -> Diagram b
forall b. OKBackend b => Diagram b -> Diagram b
padBorder (Diagram b -> Diagram b) -> Diagram b -> Diagram b
forall a b. (a -> b) -> a -> b
$ Measure Double -> Diagram b -> Diagram b
forall a n.
(N a ~ n, HasStyle a, Typeable n) =>
Measure n -> a -> a
lw Measure Double
forall n. OrderedField n => Measure n
thin (Diagram b -> Diagram b) -> Diagram b -> Diagram b
forall a b. (a -> b) -> a -> b
$ Double -> [Diagram b] -> Diagram b
forall n a.
(InSpace V2 n a, Floating n, Juxtaposable a, HasOrigin a,
 Monoid' a) =>
n -> [a] -> a
hsep Double
1 ([Diagram b] -> Diagram b) -> [Diagram b] -> Diagram b
forall a b. (a -> b) -> a -> b
$ (Tgraph -> QDiagram b V2 Double Any)
-> [Tgraph] -> [QDiagram b V2 Double Any]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Patch -> Diagram b) -> Tgraph -> Diagram b
forall b a.
(OKBackend b, DrawableLabelled a) =>
(Patch -> Diagram b) -> a -> Diagram b
labelled Patch -> Diagram b
forall a b. (Drawable a, OKBackend b) => a -> Diagram b
drawj) [Tgraph
dartD4, Tgraph
brokenDart, Tgraph
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 :: forall b. OKBackend b => Diagram b
badlyBrokenDartFig = Diagram b -> Diagram b
forall b. OKBackend b => Diagram b -> Diagram b
padBorder (Diagram b -> Diagram b) -> Diagram b -> Diagram b
forall a b. (a -> b) -> a -> b
$ Measure Double -> Diagram b -> Diagram b
forall a n.
(N a ~ n, HasStyle a, Typeable n) =>
Measure n -> a -> a
lw Measure Double
forall n. OrderedField n => Measure n
thin (Diagram b -> Diagram b) -> Diagram b -> Diagram b
forall a b. (a -> b) -> a -> b
$ Double -> [Diagram b] -> Diagram b
forall n a.
(InSpace V2 n a, Floating n, Juxtaposable a, HasOrigin a,
 Monoid' a) =>
n -> [a] -> a
hsep Double
1 ([Diagram b] -> Diagram b) -> [Diagram b] -> Diagram b
forall a b. (a -> b) -> a -> b
$ (VPatch -> QDiagram b V2 Double Any)
-> [VPatch] -> [QDiagram b V2 Double Any]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Patch -> Diagram b) -> VPatch -> Diagram b
forall b a.
(OKBackend b, DrawableLabelled a) =>
(Patch -> Diagram b) -> a -> Diagram b
labelled Patch -> Diagram b
forall a b. (Drawable a, OKBackend b) => a -> Diagram b
drawj) [VPatch
vp, VPatch
vpComp, VPatch
vpFailed] where
    vp :: VPatch
vp = Tgraph -> VPatch
makeVP Tgraph
badlyBrokenDart
    comp :: Tgraph
comp = Tgraph -> Tgraph
compose Tgraph
badlyBrokenDart
    vpComp :: VPatch
vpComp = VPatch -> [TileFace] -> VPatch
restrictVP VPatch
vp ([TileFace] -> VPatch) -> [TileFace] -> VPatch
forall a b. (a -> b) -> a -> b
$ Tgraph -> [TileFace]
forall a. HasFaces a => a -> [TileFace]
faces Tgraph
comp
    vpFailed :: VPatch
vpFailed  = VPatch -> [TileFace] -> VPatch
restrictVP VPatch
vp ([TileFace] -> VPatch) -> [TileFace] -> VPatch
forall a b. (a -> b) -> a -> b
$ (([TileFace], [TileFace]) -> [TileFace]
forall a b. (a, b) -> b
snd (([TileFace], [TileFace]) -> [TileFace])
-> (Tgraph -> ([TileFace], [TileFace])) -> Tgraph -> [TileFace]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tgraph -> ([TileFace], [TileFace])
partComposeFaces) Tgraph
comp

-- |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 :: forall b. OKBackend b => Diagram b
removeIncompletesFig = QDiagram b (V b) (N b) Any -> QDiagram b (V b) (N b) Any
forall b. OKBackend b => Diagram b -> Diagram b
padBorder (QDiagram b (V b) (N b) Any -> QDiagram b (V b) (N b) Any)
-> QDiagram b (V b) (N b) Any -> QDiagram b (V b) (N b) Any
forall a b. (a -> b) -> a -> b
$ Tgraph -> QDiagram b (V b) (N b) Any
forall a b. (Drawable a, OKBackend b) => a -> Diagram b
drawj (Tgraph -> QDiagram b (V b) (N b) Any)
-> Tgraph -> QDiagram b (V b) (N b) Any
forall a b. (a -> b) -> a -> b
$ [TileFace] -> Tgraph -> Tgraph
removeFaces (Tgraph -> [TileFace]
boundaryJoinFaces Tgraph
g) Tgraph
g where
    g :: Tgraph
g = [Tgraph]
sunDs [Tgraph] -> Vertex -> Tgraph
forall a. HasCallStack => [a] -> Vertex -> a
!! Vertex
3


-- |mistake is a legal but incorrect Tgraph - a kite with 2 darts on its long edges
mistake:: Tgraph
mistake :: Tgraph
mistake = [TileFace] -> Tgraph
makeTgraph [(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
RK (Vertex
1,Vertex
2,Vertex
4), (Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
LK (Vertex
1,Vertex
3,Vertex
2), (Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
RD (Vertex
3,Vertex
1,Vertex
5), (Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
LD (Vertex
4,Vertex
6,Vertex
1), (Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
LD (Vertex
3,Vertex
5,Vertex
7), (Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
RD (Vertex
4,Vertex
8,Vertex
6)]

-- |mistake1 is a kite bordered by 2 half darts (subgraph of mistake and still incorrect)
mistake1:: Tgraph
mistake1 :: Tgraph
mistake1 = [TileFace] -> Tgraph
makeTgraph [(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
RK (Vertex
1,Vertex
2,Vertex
4), (Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
LK (Vertex
1,Vertex
3,Vertex
2), (Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
RD (Vertex
3,Vertex
1,Vertex
5), (Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
LD (Vertex
4,Vertex
6,Vertex
1)]

-- *  Figures for 7 vertex types

-- | vertexTypesFig is 7 vertex types in a single diagram as a row.
vertexTypesFig :: OKBackend b => Diagram b
vertexTypesFig :: forall b. OKBackend b => Diagram b
vertexTypesFig = QDiagram b (V b) (N b) Any -> QDiagram b (V b) (N b) Any
forall b. OKBackend b => Diagram b -> Diagram b
padBorder (QDiagram b (V b) (N b) Any -> QDiagram b (V b) (N b) Any)
-> QDiagram b (V b) (N b) Any -> QDiagram b (V b) (N b) Any
forall a b. (a -> b) -> a -> b
$ Double -> [QDiagram b V2 Double Any] -> QDiagram b V2 Double Any
forall n a.
(InSpace V2 n a, Floating n, Juxtaposable a, HasOrigin a,
 Monoid' a) =>
n -> [a] -> a
hsep Double
1 [QDiagram b V2 Double Any]
forall {b}.
(N b ~ Double, V b ~ V2, Renderable (Path V2 Double) b,
 Renderable (Text Double) b) =>
[QDiagram b V2 Double Any]
lTypeFigs
 where
 lTypeFigs :: [QDiagram b V2 Double Any]
lTypeFigs = ([Char] -> QDiagram b V2 Double Any -> QDiagram b V2 Double Any)
-> [[Char]]
-> [QDiagram b V2 Double Any]
-> [QDiagram b V2 Double Any]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Point V2 Double -> [Char] -> Diagram b -> Diagram b
forall b.
OKBackend b =>
Point V2 Double -> [Char] -> Diagram b -> Diagram b
labelAt ((Double, Double) -> Point V2 Double
forall n. (n, n) -> P2 n
p2 (Double
0,-Double
2.2))) [[Char]
"sun",[Char]
"star",[Char]
"jack",[Char]
"queen",[Char]
"king",[Char]
"ace",[Char]
"deuce"] [QDiagram b V2 Double Any]
forall {b}.
(N b ~ Double, V b ~ V2, Renderable (Path V2 Double) b,
 Renderable (Text Double) b) =>
[QDiagram b V2 Double Any]
vTypeFigs
 vTypeFigs :: [QDiagram b V2 Double Any]
vTypeFigs = (Tgraph -> (Vertex, Vertex) -> QDiagram b V2 Double Any)
-> [Tgraph] -> [(Vertex, Vertex)] -> [QDiagram b V2 Double Any]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Tgraph -> (Vertex, Vertex) -> QDiagram b V2 Double Any
Tgraph -> (Vertex, Vertex) -> QDiagram b V2 (N b) Any
forall {b}.
(V b ~ V2, N b ~ Double, Renderable (Path V2 Double) b,
 Renderable (Text Double) b) =>
Tgraph -> (Vertex, Vertex) -> QDiagram b V2 (N b) Any
drawVertex
               [Tgraph
sunGraph, Tgraph
starGraph, Tgraph
jackGraph, Tgraph
queenGraph, Tgraph
kingGraph, Tgraph
aceGraph,  Tgraph
deuceGraph]
               [(Vertex
1,Vertex
2),    (Vertex
1,Vertex
2),     (Vertex
1,Vertex
2),     (Vertex
1,Vertex
2),      (Vertex
1,Vertex
2),     (Vertex
3,Vertex
6),     (Vertex
2,Vertex
6)] -- alignments
 drawVertex :: Tgraph -> (Vertex, Vertex) -> QDiagram b V2 (N b) Any
drawVertex Tgraph
g (Vertex, Vertex)
alm = (VPatch -> QDiagram b V2 (N b) Any)
-> (Vertex, Vertex) -> Tgraph -> QDiagram b V2 (N b) Any
forall a. (VPatch -> a) -> (Vertex, Vertex) -> Tgraph -> a
alignBefore (Measure (N b) -> QDiagram b V2 (N b) Any -> QDiagram b V2 (N b) Any
forall a n.
(N a ~ n, HasStyle a, Typeable n) =>
Measure n -> a -> a
lw Measure (N b)
forall n. OrderedField n => Measure n
thin (QDiagram b V2 (N b) Any -> QDiagram b V2 (N b) Any)
-> (VPatch -> QDiagram b V2 (N b) Any)
-> VPatch
-> QDiagram b V2 (N b) Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QDiagram b V2 (N b) Any -> QDiagram b V2 (N b) Any
forall n b m.
(TypeableFloat n, Renderable (Path V2 n) b, Monoid' m) =>
QDiagram b V2 n m -> QDiagram b V2 n m
showOrigin (QDiagram b V2 (N b) Any -> QDiagram b V2 (N b) Any)
-> (VPatch -> QDiagram b V2 (N b) Any)
-> VPatch
-> QDiagram b V2 (N b) Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VPatch -> Diagram b
VPatch -> QDiagram b V2 (N b) Any
forall a b. (Drawable a, OKBackend b) => a -> Diagram b
drawj) (Vertex, Vertex)
alm Tgraph
g

jackGraph,kingGraph,queenGraph,aceGraph,deuceGraph,starGraph::Tgraph
-- |Tgraph for vertex type jack.
jackGraph :: Tgraph
jackGraph = [TileFace] -> Tgraph
makeTgraph
  [(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
LK (Vertex
7,Vertex
8,Vertex
1),(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
RK (Vertex
7,Vertex
1,Vertex
5),(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
LD (Vertex
9,Vertex
8,Vertex
10),(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
RD (Vertex
9,Vertex
1,Vertex
8),(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
LK (Vertex
1,Vertex
9,Vertex
11)
  ,(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
RK (Vertex
1,Vertex
11,Vertex
2),(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
RD (Vertex
4,Vertex
6,Vertex
5),(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
LD (Vertex
4,Vertex
5,Vertex
1),(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
RK (Vertex
1,Vertex
3,Vertex
4),(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
LK (Vertex
1,Vertex
2,Vertex
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 :: Tgraph
kingGraph = [TileFace] -> Tgraph
makeTgraph
  [(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
LD (Vertex
1,Vertex
10,Vertex
11),(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
RD (Vertex
1,Vertex
9,Vertex
10),(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
RK (Vertex
9,Vertex
7,Vertex
8),(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
LK (Vertex
9,Vertex
1,Vertex
7),(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
LK (Vertex
5,Vertex
6,Vertex
7)
  ,(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
RK (Vertex
5,Vertex
7,Vertex
1),(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
LD (Vertex
1,Vertex
4,Vertex
5),(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
RD (Vertex
1,Vertex
3,Vertex
4),(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
RD (Vertex
1,Vertex
11,Vertex
2),(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
LD (Vertex
1,Vertex
2,Vertex
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 :: Tgraph
queenGraph = [TileFace] -> Tgraph
makeTgraph
  [(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
RK (Vertex
11,Vertex
9,Vertex
10),(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
LK (Vertex
11,Vertex
1,Vertex
9),(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
LK (Vertex
7,Vertex
8,Vertex
9),(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
RK (Vertex
7,Vertex
9,Vertex
1),(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
RK (Vertex
7,Vertex
5,Vertex
6)
  ,(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
LK (Vertex
7,Vertex
1,Vertex
5),(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
LK (Vertex
3,Vertex
4,Vertex
5),(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
RK (Vertex
3,Vertex
5,Vertex
1),(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
RD (Vertex
1,Vertex
11,Vertex
2),(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
LD (Vertex
1,Vertex
2,Vertex
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 :: Tgraph
aceGraph = Tgraph
fool -- centre 3
-- |Tgraph for vertextype deuce.
deuceGraph :: Tgraph
deuceGraph = [TileFace] -> Tgraph
makeTgraph
  [(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
LK (Vertex
7,Vertex
8,Vertex
2),(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
RK (Vertex
7,Vertex
2,Vertex
6),(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
LK (Vertex
5,Vertex
6,Vertex
2),(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
RK (Vertex
5,Vertex
2,Vertex
4)
  ,(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
LD (Vertex
1,Vertex
8,Vertex
9),(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
RD (Vertex
1,Vertex
2,Vertex
8),(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
RD (Vertex
1,Vertex
3,Vertex
4),(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
LD (Vertex
1,Vertex
4,Vertex
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 :: Tgraph
starGraph = [TileFace] -> Tgraph
makeTgraph
  [(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
LD (Vertex
1,Vertex
2,Vertex
3),(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
RD (Vertex
1,Vertex
11,Vertex
2),(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
LD (Vertex
1,Vertex
10,Vertex
11),(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
RD (Vertex
1,Vertex
9,Vertex
10),(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
LD (Vertex
1,Vertex
8,Vertex
9)
  ,(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
RD (Vertex
1,Vertex
7,Vertex
8),(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
LD (Vertex
1,Vertex
6,Vertex
7),(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
RD (Vertex
1,Vertex
5,Vertex
6),(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
LD (Vertex
1,Vertex
4,Vertex
5),(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
RD (Vertex
1,Vertex
3,Vertex
4)
  ] -- centre 1

-- |forceVFigures is a list of 7 diagrams - force of 7 vertex types.
forceVFigures :: OKBackend b => [Diagram b]
forceVFigures :: forall b. OKBackend b => [Diagram b]
forceVFigures = [Vertex] -> [Diagram b] -> [Diagram b]
forall a.
(Transformable a, V a ~ V2, N a ~ Double) =>
[Vertex] -> [a] -> [a]
rotations [Vertex
0,Vertex
0,Vertex
9,Vertex
5,Vertex
0,Vertex
0,Vertex
1] ([Diagram b] -> [Diagram b]) -> [Diagram b] -> [Diagram b]
forall a b. (a -> b) -> a -> b
$
                (Tgraph -> QDiagram b V2 Double Any)
-> [Tgraph] -> [QDiagram b V2 Double Any]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (QDiagram b V2 Double Any -> QDiagram b V2 Double Any
forall (v :: * -> *) n a.
(InSpace v n a, Fractional n, Traversable v, Alignable a,
 HasOrigin a) =>
a -> a
center (QDiagram b V2 Double Any -> QDiagram b V2 Double Any)
-> (Tgraph -> QDiagram b V2 Double Any)
-> Tgraph
-> QDiagram b V2 Double Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tgraph -> Diagram b
Tgraph -> QDiagram b V2 Double Any
forall b. OKBackend b => Tgraph -> Diagram b
drawForce) [Tgraph
sunGraph,Tgraph
starGraph,Tgraph
jackGraph,Tgraph
queenGraph,Tgraph
kingGraph,Tgraph
aceGraph,Tgraph
deuceGraph]


sun3Dart :: Tgraph
-- |A sun with 3 darts on the boundary NOT all adjacent
-- (Used in superForceRocketsFig).
sun3Dart :: Tgraph
sun3Dart = (Vertex, Vertex) -> Tgraph -> Tgraph
forall a. Forcible a => (Vertex, Vertex) -> a -> a
addHalfDart (Vertex
9,Vertex
10) (Tgraph -> Tgraph) -> Tgraph -> Tgraph
forall a b. (a -> b) -> a -> b
$ (Vertex, Vertex) -> Tgraph -> Tgraph
forall a. Forcible a => (Vertex, Vertex) -> a -> a
addHalfDart (Vertex
8,Vertex
9) (Tgraph -> Tgraph) -> Tgraph -> Tgraph
forall a b. (a -> b) -> a -> b
$ (Vertex, Vertex) -> Tgraph -> Tgraph
forall a. Forcible a => (Vertex, Vertex) -> a -> a
addHalfDart (Vertex
5,Vertex
6) (Tgraph -> Tgraph) -> Tgraph -> Tgraph
forall a b. (a -> b) -> a -> b
$ (Vertex, Vertex) -> Tgraph -> Tgraph
forall a. Forcible a => (Vertex, Vertex) -> a -> a
addHalfDart (Vertex
4,Vertex
5) (Tgraph -> Tgraph) -> Tgraph -> Tgraph
forall a b. (a -> b) -> a -> b
$ (Vertex, Vertex) -> Tgraph -> Tgraph
forall a. Forcible a => (Vertex, Vertex) -> a -> a
addHalfDart (Vertex
3,Vertex
4) (Tgraph -> Tgraph) -> Tgraph -> Tgraph
forall a b. (a -> b) -> a -> b
$ (Vertex, Vertex) -> Tgraph -> Tgraph
forall a. Forcible a => (Vertex, Vertex) -> a -> a
addHalfDart (Vertex
2,Vertex
3) Tgraph
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 :: forall b. OKBackend b => Diagram b
superForceFig = Diagram b -> Diagram b
forall b. OKBackend b => Diagram b -> Diagram b
padBorder (Diagram b -> Diagram b) -> Diagram b -> Diagram b
forall a b. (a -> b) -> a -> b
$ Measure Double -> Diagram b -> Diagram b
forall a n.
(N a ~ n, HasStyle a, Typeable n) =>
Measure n -> a -> a
lw Measure Double
forall n. OrderedField n => Measure n
thin (Diagram b -> Diagram b) -> Diagram b -> Diagram b
forall a b. (a -> b) -> a -> b
$ Angle Double -> Diagram b -> Diagram b
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate (Vertex -> Angle Double
ttangle Vertex
1) (Diagram b -> Diagram b) -> Diagram b -> Diagram b
forall a b. (a -> b) -> a -> b
$ Tgraph -> Diagram b
forall b. OKBackend b => Tgraph -> Diagram b
drawSuperForce Tgraph
g where
    g :: Tgraph
g = (Vertex, Vertex) -> Tgraph -> Tgraph
forall a. Forcible a => (Vertex, Vertex) -> a -> a
addHalfDart (Vertex
220,Vertex
221) (Tgraph -> Tgraph) -> Tgraph -> Tgraph
forall a b. (a -> b) -> a -> b
$ Tgraph -> Tgraph
forall a. Forcible a => a -> a
force (Tgraph -> Tgraph) -> Tgraph -> Tgraph
forall a b. (a -> b) -> a -> b
$ Tgraph -> [Tgraph]
decompositions Tgraph
fool [Tgraph] -> Vertex -> Tgraph
forall a. HasCallStack => [a] -> Vertex -> a
!!Vertex
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.
superForceRocketsFig :: OKBackend b => Diagram b
superForceRocketsFig :: forall b. OKBackend b => Diagram b
superForceRocketsFig = Diagram b -> Diagram b
forall b. OKBackend b => Diagram b -> Diagram b
padBorder (Diagram b -> Diagram b) -> Diagram b -> Diagram b
forall a b. (a -> b) -> a -> b
$ Measure Double -> Diagram b -> Diagram b
forall a n.
(N a ~ n, HasStyle a, Typeable n) =>
Measure n -> a -> a
lw Measure Double
forall n. OrderedField n => Measure n
veryThin (Diagram b -> Diagram b) -> Diagram b -> Diagram b
forall a b. (a -> b) -> a -> b
$ Double -> [Diagram b] -> Diagram b
forall n a.
(InSpace V2 n a, Floating n, Juxtaposable a, HasOrigin a,
 Monoid' a) =>
n -> [a] -> a
vsep Double
1 ([Diagram b] -> Diagram b) -> [Diagram b] -> Diagram b
forall a b. (a -> b) -> a -> b
$ [Vertex] -> [Diagram b] -> [Diagram b]
forall a.
(Transformable a, V a ~ V2, N a ~ Double) =>
[Vertex] -> [a] -> [a]
rotations [Vertex
8,Vertex
9,Vertex
9,Vertex
8] ([Diagram b] -> [Diagram b]) -> [Diagram b] -> [Diagram b]
forall a b. (a -> b) -> a -> b
$
   (Tgraph -> QDiagram b V2 Double Any)
-> [Tgraph] -> [QDiagram b V2 Double Any]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Tgraph -> Diagram b
Tgraph -> QDiagram b V2 Double Any
forall b. OKBackend b => Tgraph -> Diagram b
drawSuperForce [Tgraph]
decomps where
      decomps :: [Tgraph]
decomps = Vertex -> [Tgraph] -> [Tgraph]
forall a. Vertex -> [a] -> [a]
take Vertex
4 ([Tgraph] -> [Tgraph]) -> [Tgraph] -> [Tgraph]
forall a b. (a -> b) -> a -> b
$ Tgraph -> [Tgraph]
decompositions Tgraph
sun3Dart

boundaryFDart4, boundaryFDart5 :: Tgraph
-- |graph of the boundary faces only of a forced graph (dartDs!!4)
boundaryFDart4 :: Tgraph
boundaryFDart4 = [TileFace] -> Tgraph
NoWarn.makeUncheckedTgraph ([TileFace] -> Tgraph) -> [TileFace] -> Tgraph
forall a b. (a -> b) -> a -> b
$ BoundaryState -> [TileFace]
boundaryFaces (BoundaryState -> [TileFace]) -> BoundaryState -> [TileFace]
forall a b. (a -> b) -> a -> b
$ BoundaryState -> BoundaryState
forall a. Forcible a => a -> a
force (BoundaryState -> BoundaryState) -> BoundaryState -> BoundaryState
forall a b. (a -> b) -> a -> b
$ Tgraph -> BoundaryState
makeBoundaryState Tgraph
dartD4
-- |graph of the boundary faces only of a forced graph (dartDs!!5)
boundaryFDart5 :: Tgraph
boundaryFDart5 = [TileFace] -> Tgraph
NoWarn.makeUncheckedTgraph ([TileFace] -> Tgraph) -> [TileFace] -> Tgraph
forall a b. (a -> b) -> a -> b
$ BoundaryState -> [TileFace]
boundaryFaces (BoundaryState -> [TileFace]) -> BoundaryState -> [TileFace]
forall a b. (a -> b) -> a -> b
$ BoundaryState -> BoundaryState
forall a. Forcible a => a -> a
force (BoundaryState -> BoundaryState) -> BoundaryState -> BoundaryState
forall a b. (a -> b) -> a -> b
$ Tgraph -> BoundaryState
makeBoundaryState ([Tgraph]
dartDs[Tgraph] -> Vertex -> Tgraph
forall a. HasCallStack => [a] -> Vertex -> a
!!Vertex
5)

boundaryFDart4Fig,boundaryFDart5Fig :: OKBackend b => Diagram b
-- |figure of the boundary faces only of a forced graph (dartDs!!4).
boundaryFDart4Fig :: forall b. OKBackend b => Diagram b
boundaryFDart4Fig = Diagram b -> Diagram b
forall b. OKBackend b => Diagram b -> Diagram b
padBorder (Diagram b -> Diagram b) -> Diagram b -> Diagram b
forall a b. (a -> b) -> a -> b
$ Measure Double -> Diagram b -> Diagram b
forall a n.
(N a ~ n, HasStyle a, Typeable n) =>
Measure n -> a -> a
lw Measure Double
forall n. OrderedField n => Measure n
ultraThin (Diagram b -> Diagram b) -> Diagram b -> Diagram b
forall a b. (a -> b) -> a -> b
$ Measure Double -> (Patch -> Diagram b) -> Tgraph -> Diagram b
forall b a.
(OKBackend b, DrawableLabelled a) =>
Measure Double -> (Patch -> Diagram b) -> a -> Diagram b
labelSize Measure Double
forall n. OrderedField n => Measure n
tiny Patch -> Diagram b
forall a b. (Drawable a, OKBackend b) => a -> Diagram b
drawj Tgraph
boundaryFDart4
-- |figure of the boundary faces only of a forced graph (dartDs!!5).
boundaryFDart5Fig :: forall b. OKBackend b => Diagram b
boundaryFDart5Fig = Diagram b -> Diagram b
forall b. OKBackend b => Diagram b -> Diagram b
padBorder (Diagram b -> Diagram b) -> Diagram b -> Diagram b
forall a b. (a -> b) -> a -> b
$ Measure Double -> Diagram b -> Diagram b
forall a n.
(N a ~ n, HasStyle a, Typeable n) =>
Measure n -> a -> a
lw Measure Double
forall n. OrderedField n => Measure n
ultraThin (Diagram b -> Diagram b) -> Diagram b -> Diagram b
forall a b. (a -> b) -> a -> b
$ Measure Double -> (Patch -> Diagram b) -> Tgraph -> Diagram b
forall b a.
(OKBackend b, DrawableLabelled a) =>
Measure Double -> (Patch -> Diagram b) -> a -> Diagram b
labelSize (Double -> Measure Double
forall n. Num n => n -> Measure n
normalized Double
0.006) Patch -> Diagram b
forall a b. (Drawable a, OKBackend b) => a -> Diagram b
drawj Tgraph
boundaryFDart5

boundaryGapFDart4, boundaryGapFDart5 :: Tgraph
-- |graph of the boundary faces only of a forced graph - with extra faces removed to make a gap
boundaryGapFDart4 :: Tgraph
boundaryGapFDart4 = [Vertex] -> Tgraph -> Tgraph
removeVertices [Vertex
354] Tgraph
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 :: Tgraph
boundaryGapFDart5 = [Vertex] -> Tgraph -> Tgraph
removeVertices [Vertex
1467] Tgraph
boundaryFDart5
    -- checkedTgraph $ filter ((/=1467).originV) (faces boundaryFDart5)

boundaryGap4Fig, boundaryGap5Fig  :: OKBackend b => Diagram b
-- |figure for the boundary gap graph boundaryGapFDart4.
boundaryGap4Fig :: forall b. OKBackend b => Diagram b
boundaryGap4Fig = Diagram b -> Diagram b
forall b. OKBackend b => Diagram b -> Diagram b
padBorder (Diagram b -> Diagram b) -> Diagram b -> Diagram b
forall a b. (a -> b) -> a -> b
$ Measure Double -> Diagram b -> Diagram b
forall a n.
(N a ~ n, HasStyle a, Typeable n) =>
Measure n -> a -> a
lw Measure Double
forall n. OrderedField n => Measure n
ultraThin (Diagram b -> Diagram b) -> Diagram b -> Diagram b
forall a b. (a -> b) -> a -> b
$ Measure Double -> (Patch -> Diagram b) -> Tgraph -> Diagram b
forall b a.
(OKBackend b, DrawableLabelled a) =>
Measure Double -> (Patch -> Diagram b) -> a -> Diagram b
labelSize Measure Double
forall n. OrderedField n => Measure n
tiny Patch -> Diagram b
forall a b. (Drawable a, OKBackend b) => a -> Diagram b
drawj Tgraph
boundaryGapFDart4
-- |figure for the boundary gap graph boundaryGapFDart5.
boundaryGap5Fig :: forall b. OKBackend b => Diagram b
boundaryGap5Fig = Diagram b -> Diagram b
forall b. OKBackend b => Diagram b -> Diagram b
padBorder (Diagram b -> Diagram b) -> Diagram b -> Diagram b
forall a b. (a -> b) -> a -> b
$ Measure Double -> Diagram b -> Diagram b
forall a n.
(N a ~ n, HasStyle a, Typeable n) =>
Measure n -> a -> a
lw Measure Double
forall n. OrderedField n => Measure n
ultraThin (Diagram b -> Diagram b) -> Diagram b -> Diagram b
forall a b. (a -> b) -> a -> b
$ Measure Double -> (Patch -> Diagram b) -> Tgraph -> Diagram b
forall b a.
(OKBackend b, DrawableLabelled a) =>
Measure Double -> (Patch -> Diagram b) -> a -> Diagram b
labelSize (Double -> Measure Double
forall n. Num n => n -> Measure n
normalized Double
0.006) Patch -> Diagram b
forall a b. (Drawable a, OKBackend b) => a -> Diagram b
drawj Tgraph
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).
boundaryVCoveringFigs :: OKBackend b =>
                         Forced BoundaryState -> [Diagram b]
boundaryVCoveringFigs :: forall b. OKBackend b => Forced BoundaryState -> [Diagram b]
boundaryVCoveringFigs Forced BoundaryState
bd =
    Measure Double
-> QDiagram b (V b) (N b) Any -> QDiagram b (V b) (N b) Any
forall a n.
(N a ~ n, HasStyle a, Typeable n) =>
Measure n -> a -> a
lw Measure Double
forall n. OrderedField n => Measure n
ultraThin (QDiagram b (V b) (N b) Any -> QDiagram b (V b) (N b) Any)
-> (Forced BoundaryState -> QDiagram b (V b) (N b) Any)
-> Forced BoundaryState
-> QDiagram b (V b) (N b) Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QDiagram b (V b) (N b) Any
redg <>) (QDiagram b (V b) (N b) Any -> QDiagram b (V b) (N b) Any)
-> (Forced BoundaryState -> QDiagram b (V b) (N b) Any)
-> Forced BoundaryState
-> QDiagram b (V b) (N b) Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VPatch -> QDiagram b (V b) (N b) Any)
-> (Vertex, Vertex) -> Tgraph -> QDiagram b (V b) (N b) Any
forall a. (VPatch -> a) -> (Vertex, Vertex) -> Tgraph -> a
alignBefore VPatch -> QDiagram b (V b) (N b) Any
forall a b. (Drawable a, OKBackend b) => a -> Diagram b
draw (Vertex, Vertex)
alig (Tgraph -> QDiagram b (V b) (N b) Any)
-> (Forced BoundaryState -> Tgraph)
-> Forced BoundaryState
-> QDiagram b (V b) (N b) Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BoundaryState -> Tgraph
recoverGraph (BoundaryState -> Tgraph)
-> (Forced BoundaryState -> BoundaryState)
-> Forced BoundaryState
-> Tgraph
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Forced BoundaryState -> BoundaryState
forall a. Forced a -> a
forgetF) (Forced BoundaryState -> QDiagram b (V b) (N b) Any)
-> [Forced BoundaryState] -> [QDiagram b (V b) (N b) Any]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Forced BoundaryState -> [Forced BoundaryState]
boundaryVCovering Forced BoundaryState
bd
      where redg :: QDiagram b (V b) (N b) Any
redg = Colour Double
-> QDiagram b (V b) (N b) Any -> QDiagram b (V b) (N b) Any
forall n a.
(InSpace V2 n a, Typeable n, Floating n, HasStyle a) =>
Colour Double -> a -> a
lc Colour Double
forall a. (Ord a, Floating a) => Colour a
red (QDiagram b (V b) (N b) Any -> QDiagram b (V b) (N b) Any)
-> QDiagram b (V b) (N b) Any -> QDiagram b (V b) (N b) Any
forall a b. (a -> b) -> a -> b
$ Tgraph -> QDiagram b (V b) (N b) Any
forall a b. (Drawable a, OKBackend b) => a -> Diagram b
draw Tgraph
g --alignBefore draw alig g
            alig :: (Vertex, Vertex)
alig = Tgraph -> (Vertex, Vertex)
forall a. HasFaces a => a -> (Vertex, Vertex)
defaultAlignment Tgraph
g
            g :: Tgraph
g = BoundaryState -> Tgraph
recoverGraph (BoundaryState -> Tgraph) -> BoundaryState -> Tgraph
forall a b. (a -> b) -> a -> b
$ Forced BoundaryState -> BoundaryState
forall a. Forced a -> a
forgetF Forced BoundaryState
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).
boundaryECoveringFigs :: OKBackend b =>
                         Forced BoundaryState -> [Diagram b]
boundaryECoveringFigs :: forall b. OKBackend b => Forced BoundaryState -> [Diagram b]
boundaryECoveringFigs Forced BoundaryState
bd =
    Measure Double
-> QDiagram b (V b) (N b) Any -> QDiagram b (V b) (N b) Any
forall a n.
(N a ~ n, HasStyle a, Typeable n) =>
Measure n -> a -> a
lw Measure Double
forall n. OrderedField n => Measure n
ultraThin (QDiagram b (V b) (N b) Any -> QDiagram b (V b) (N b) Any)
-> (Forced BoundaryState -> QDiagram b (V b) (N b) Any)
-> Forced BoundaryState
-> QDiagram b (V b) (N b) Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QDiagram b (V b) (N b) Any
redg <>) (QDiagram b (V b) (N b) Any -> QDiagram b (V b) (N b) Any)
-> (Forced BoundaryState -> QDiagram b (V b) (N b) Any)
-> Forced BoundaryState
-> QDiagram b (V b) (N b) Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VPatch -> QDiagram b (V b) (N b) Any)
-> (Vertex, Vertex) -> Tgraph -> QDiagram b (V b) (N b) Any
forall a. (VPatch -> a) -> (Vertex, Vertex) -> Tgraph -> a
alignBefore VPatch -> QDiagram b (V b) (N b) Any
forall a b. (Drawable a, OKBackend b) => a -> Diagram b
draw (Vertex, Vertex)
alig (Tgraph -> QDiagram b (V b) (N b) Any)
-> (Forced BoundaryState -> Tgraph)
-> Forced BoundaryState
-> QDiagram b (V b) (N b) Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoundaryState -> Tgraph
recoverGraph (BoundaryState -> Tgraph)
-> (Forced BoundaryState -> BoundaryState)
-> Forced BoundaryState
-> Tgraph
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Forced BoundaryState -> BoundaryState
forall a. Forced a -> a
forgetF  (Forced BoundaryState -> QDiagram b (V b) (N b) Any)
-> [Forced BoundaryState] -> [QDiagram b (V b) (N b) Any]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Forced BoundaryState -> [Forced BoundaryState]
boundaryECovering Forced BoundaryState
bd
      where redg :: QDiagram b (V b) (N b) Any
redg = Colour Double
-> QDiagram b (V b) (N b) Any -> QDiagram b (V b) (N b) Any
forall n a.
(InSpace V2 n a, Typeable n, Floating n, HasStyle a) =>
Colour Double -> a -> a
lc Colour Double
forall a. (Ord a, Floating a) => Colour a
red (QDiagram b (V b) (N b) Any -> QDiagram b (V b) (N b) Any)
-> QDiagram b (V b) (N b) Any -> QDiagram b (V b) (N b) Any
forall a b. (a -> b) -> a -> b
$ Tgraph -> QDiagram b (V b) (N b) Any
forall a b. (Drawable a, OKBackend b) => a -> Diagram b
draw Tgraph
g
            alig :: (Vertex, Vertex)
alig = Tgraph -> (Vertex, Vertex)
forall a. HasFaces a => a -> (Vertex, Vertex)
defaultAlignment Tgraph
g
            g :: Tgraph
g = BoundaryState -> Tgraph
recoverGraph (BoundaryState -> Tgraph) -> BoundaryState -> Tgraph
forall a b. (a -> b) -> a -> b
$ Forced BoundaryState -> BoundaryState
forall a. Forced a -> a
forgetF Forced BoundaryState
bd

kingECoveringFig,kingVCoveringFig :: OKBackend b => Diagram b
-- | diagram showing the boundaryECovering of a forced kingGraph.
kingECoveringFig :: forall b. OKBackend b => Diagram b
kingECoveringFig = QDiagram b (V b) (N b) Any -> QDiagram b (V b) (N b) Any
forall b. OKBackend b => Diagram b -> Diagram b
padBorder (QDiagram b (V b) (N b) Any -> QDiagram b (V b) (N b) Any)
-> QDiagram b (V b) (N b) Any -> QDiagram b (V b) (N b) Any
forall a b. (a -> b) -> a -> b
$ Vertex
-> [QDiagram b (V b) (N b) Any] -> QDiagram b (V b) (N b) Any
forall b. OKBackend b => Vertex -> [Diagram b] -> Diagram b
arrangeRows Vertex
3 ([QDiagram b (V b) (N b) Any] -> QDiagram b (V b) (N b) Any)
-> [QDiagram b (V b) (N b) Any] -> QDiagram b (V b) (N b) Any
forall a b. (a -> b) -> a -> b
$ Forced BoundaryState -> [QDiagram b (V b) (N b) Any]
forall b. OKBackend b => Forced BoundaryState -> [Diagram b]
boundaryECoveringFigs (Forced BoundaryState -> [QDiagram b (V b) (N b) Any])
-> Forced BoundaryState -> [QDiagram b (V b) (N b) Any]
forall a b. (a -> b) -> a -> b
$ BoundaryState -> Forced BoundaryState
forall a. Forcible a => a -> Forced a
forceF (BoundaryState -> Forced BoundaryState)
-> BoundaryState -> Forced BoundaryState
forall a b. (a -> b) -> a -> b
$ Tgraph -> BoundaryState
makeBoundaryState Tgraph
kingGraph
-- | diagram showing the boundaryVCovering of a forced kingGraph.
kingVCoveringFig :: forall b. OKBackend b => Diagram b
kingVCoveringFig = QDiagram b (V b) (N b) Any -> QDiagram b (V b) (N b) Any
forall b. OKBackend b => Diagram b -> Diagram b
padBorder (QDiagram b (V b) (N b) Any -> QDiagram b (V b) (N b) Any)
-> QDiagram b (V b) (N b) Any -> QDiagram b (V b) (N b) Any
forall a b. (a -> b) -> a -> b
$ Vertex
-> [QDiagram b (V b) (N b) Any] -> QDiagram b (V b) (N b) Any
forall b. OKBackend b => Vertex -> [Diagram b] -> Diagram b
arrangeRows Vertex
3 ([QDiagram b (V b) (N b) Any] -> QDiagram b (V b) (N b) Any)
-> [QDiagram b (V b) (N b) Any] -> QDiagram b (V b) (N b) Any
forall a b. (a -> b) -> a -> b
$ Forced BoundaryState -> [QDiagram b (V b) (N b) Any]
forall b. OKBackend b => Forced BoundaryState -> [Diagram b]
boundaryVCoveringFigs (Forced BoundaryState -> [QDiagram b (V b) (N b) Any])
-> Forced BoundaryState -> [QDiagram b (V b) (N b) Any]
forall a b. (a -> b) -> a -> b
$ BoundaryState -> Forced BoundaryState
forall a. Forcible a => a -> Forced a
forceF (BoundaryState -> Forced BoundaryState)
-> BoundaryState -> Forced BoundaryState
forall a b. (a -> b) -> a -> b
$ Tgraph -> BoundaryState
makeBoundaryState Tgraph
kingGraph

kingEmpiresFig, kingEmpire1Fig, kingEmpire2Fig :: OKBackend b => Diagram b
-- | figure showing King's empires (1 and 2).
kingEmpiresFig :: forall b. OKBackend b => Diagram b
kingEmpiresFig = QDiagram b (V b) (N b) Any -> QDiagram b (V b) (N b) Any
forall b. OKBackend b => Diagram b -> Diagram b
padBorder (QDiagram b (V b) (N b) Any -> QDiagram b (V b) (N b) Any)
-> QDiagram b (V b) (N b) Any -> QDiagram b (V b) (N b) Any
forall a b. (a -> b) -> a -> b
$ Double -> [QDiagram b V2 Double Any] -> QDiagram b V2 Double Any
forall n a.
(InSpace V2 n a, Floating n, Juxtaposable a, HasOrigin a,
 Monoid' a) =>
n -> [a] -> a
hsep Double
10 [QDiagram b (V b) (N b) Any
QDiagram b V2 Double Any
forall b. OKBackend b => Diagram b
kingEmpire1Fig, QDiagram b (V b) (N b) Any
QDiagram b V2 Double Any
forall b. OKBackend b => Diagram b
kingEmpire2Fig]
-- | figure showing King's empires 1.
kingEmpire1Fig :: forall b. OKBackend b => Diagram b
kingEmpire1Fig = Tgraph -> QDiagram b (V b) (N b) Any
forall b. OKBackend b => Tgraph -> Diagram b
showEmpire1 Tgraph
kingGraph
-- | figure showing King's empire 2.
kingEmpire2Fig :: forall b. OKBackend b => Diagram b
kingEmpire2Fig = Tgraph -> QDiagram b (V b) (N b) Any
forall b. OKBackend b => Tgraph -> Diagram b
showEmpire2 Tgraph
kingGraph


-- |emplaceChoices forces then maximally composes. At this top level it
-- produces a list of forced choices for each of the unknowns of this top level Tgraph.
-- It then repeatedly applies (force . decompose) back to the starting level to return a list of Tgraphs.
-- This version relies on compForce theorem and related theorems
emplaceChoices:: Tgraph -> [Tgraph]
emplaceChoices :: Tgraph -> [Tgraph]
emplaceChoices = Forced Tgraph -> [Tgraph]
emplaceChoicesForced (Forced Tgraph -> [Tgraph])
-> (Tgraph -> Forced Tgraph) -> Tgraph -> [Tgraph]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tgraph -> Forced Tgraph
forall a. Forcible a => a -> Forced a
forceF  where

  emplaceChoicesForced:: Forced Tgraph -> [Tgraph]
  emplaceChoicesForced :: Forced Tgraph -> [Tgraph]
emplaceChoicesForced Forced Tgraph
fg | Tgraph -> Bool
forall a. HasFaces a => a -> Bool
nullFaces Tgraph
g' = [([Vertex], Tgraph)] -> [Tgraph]
chooseUnknowns [(DartWingInfo -> [Vertex]
unknowns (DartWingInfo -> [Vertex]) -> DartWingInfo -> [Vertex]
forall a b. (a -> b) -> a -> b
$ Tgraph -> DartWingInfo
getDartWingInfo Tgraph
g0, Tgraph
g0)]
                          | Bool
otherwise    = Tgraph -> Tgraph
forall a. Forcible a => a -> a
force (Tgraph -> Tgraph) -> (Tgraph -> Tgraph) -> Tgraph -> Tgraph
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tgraph -> Tgraph
decompose (Tgraph -> Tgraph) -> [Tgraph] -> [Tgraph]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Forced Tgraph -> [Tgraph]
emplaceChoicesForced Forced Tgraph
fg'
                          where g0 :: Tgraph
g0 = Forced Tgraph -> Tgraph
forall a. Forced a -> a
forgetF Forced Tgraph
fg
                                fg' :: Forced Tgraph
fg' = Forced Tgraph -> Forced Tgraph
composeF Forced Tgraph
fg
                                g' :: Tgraph
g' = Forced Tgraph -> Tgraph
forall a. Forced a -> a
forgetF Forced Tgraph
fg'

  chooseUnknowns :: [([Vertex],Tgraph)] -> [Tgraph]
  chooseUnknowns :: [([Vertex], Tgraph)] -> [Tgraph]
chooseUnknowns [] = []
  chooseUnknowns (([],Tgraph
g0):[([Vertex], Tgraph)]
more) = Tgraph
g0Tgraph -> [Tgraph] -> [Tgraph]
forall a. a -> [a] -> [a]
:[([Vertex], Tgraph)] -> [Tgraph]
chooseUnknowns [([Vertex], Tgraph)]
more
  chooseUnknowns ((Vertex
u:[Vertex]
unks,Tgraph
g0): [([Vertex], Tgraph)]
more)
     =  [([Vertex], Tgraph)] -> [Tgraph]
chooseUnknowns ((Tgraph -> ([Vertex], Tgraph)) -> [Tgraph] -> [([Vertex], Tgraph)]
forall a b. (a -> b) -> [a] -> [b]
map ([Vertex] -> Tgraph -> ([Vertex], Tgraph)
forall {b}. HasFaces b => [Vertex] -> b -> ([Vertex], b)
remainingunks [Vertex]
unks) [Tgraph]
newgs [([Vertex], Tgraph)]
-> [([Vertex], Tgraph)] -> [([Vertex], Tgraph)]
forall a. [a] -> [a] -> [a]
++ [([Vertex], Tgraph)]
more)
        where newgs :: [Tgraph]
newgs = (BoundaryState -> Tgraph) -> [BoundaryState] -> [Tgraph]
forall a b. (a -> b) -> [a] -> [b]
map BoundaryState -> Tgraph
recoverGraph ([BoundaryState] -> [Tgraph]) -> [BoundaryState] -> [Tgraph]
forall a b. (a -> b) -> a -> b
$ [Try BoundaryState] -> [BoundaryState]
forall a. [Try a] -> [a]
atLeastOne ([Try BoundaryState] -> [BoundaryState])
-> [Try BoundaryState] -> [BoundaryState]
forall a b. (a -> b) -> a -> b
$ (Forced BoundaryState -> BoundaryState)
-> Either ShowS (Forced BoundaryState) -> Try BoundaryState
forall a b. (a -> b) -> Either ShowS a -> Either ShowS b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Forced BoundaryState -> BoundaryState
forall a. Forced a -> a
forgetF (Either ShowS (Forced BoundaryState) -> Try BoundaryState)
-> [Either ShowS (Forced BoundaryState)] -> [Try BoundaryState]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Vertex, Vertex)
-> BoundaryState -> [Either ShowS (Forced BoundaryState)]
forall a. Forcible a => (Vertex, Vertex) -> a -> [Try (Forced a)]
tryDartAndKiteF (Vertex -> BoundaryState -> (Vertex, Vertex)
findDartLongForWing Vertex
u BoundaryState
bd) BoundaryState
bd
              bd :: BoundaryState
bd = Tgraph -> BoundaryState
makeBoundaryState Tgraph
g0
              remainingunks :: [Vertex] -> b -> ([Vertex], b)
remainingunks [Vertex]
startunks b
g' = ([Vertex]
startunks [Vertex] -> [Vertex] -> [Vertex]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` b -> [Vertex]
forall a. HasFaces a => a -> [Vertex]
boundaryVs b
g', b
g')

  findDartLongForWing :: Vertex -> BoundaryState -> Dedge
  findDartLongForWing :: Vertex -> BoundaryState -> (Vertex, Vertex)
findDartLongForWing Vertex
v BoundaryState
bd
      = case (TileFace -> Bool) -> [TileFace] -> Maybe TileFace
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find TileFace -> Bool
forall rep. HalfTile rep -> Bool
isDart (BoundaryState -> Vertex -> [TileFace]
facesAtBV BoundaryState
bd Vertex
v) of
        Just TileFace
d -> TileFace -> (Vertex, Vertex)
longE TileFace
d
        Maybe TileFace
Nothing -> [Char] -> (Vertex, Vertex)
forall a. HasCallStack => [Char] -> a
error ([Char] -> (Vertex, Vertex)) -> [Char] -> (Vertex, Vertex)
forall a b. (a -> b) -> a -> b
$ [Char]
"findDartLongForWing: dart not found for dart wing vertex " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Vertex -> [Char]
forall a. Show a => a -> [Char]
show Vertex
v

-- |Example showing emplaceChoices for foolD with foolD shown in red in each choice
emplaceChoicesFig :: OKBackend b => Diagram b
emplaceChoicesFig :: forall b. OKBackend b => Diagram b
emplaceChoicesFig =  Measure Double -> Diagram b -> Diagram b
forall a n.
(N a ~ n, HasStyle a, Typeable n) =>
Measure n -> a -> a
lw Measure Double
forall n. OrderedField n => Measure n
thin (Diagram b -> Diagram b) -> Diagram b -> Diagram b
forall a b. (a -> b) -> a -> b
$ Double -> [Diagram b] -> Diagram b
forall n a.
(InSpace V2 n a, Floating n, Juxtaposable a, HasOrigin a,
 Monoid' a) =>
n -> [a] -> a
hsep Double
1 ([Diagram b] -> Diagram b) -> [Diagram b] -> Diagram b
forall a b. (a -> b) -> a -> b
$ (Tgraph -> Diagram b) -> [Tgraph] -> [Diagram b]
forall a b. (a -> b) -> [a] -> [b]
map Tgraph -> Diagram b
forall {b}.
(N b ~ Double, V b ~ V2, Renderable (Path V2 Double) b,
 Renderable (Text Double) b) =>
Tgraph -> QDiagram b (V b) (N b) Any
overlayg ([Tgraph] -> [Diagram b]) -> [Tgraph] -> [Diagram b]
forall a b. (a -> b) -> a -> b
$ Tgraph -> [Tgraph]
emplaceChoices Tgraph
g
    where g :: Tgraph
g = Tgraph
foolD
          overlayg :: Tgraph -> QDiagram b (V b) (N b) Any
overlayg Tgraph
g' = (VPatch -> QDiagram b (V b) (N b) Any)
-> (Vertex, Vertex) -> Tgraph -> QDiagram b (V b) (N b) Any
forall b.
OKBackend b =>
(VPatch -> Diagram b) -> (Vertex, Vertex) -> Tgraph -> Diagram b
smartAlignBefore VPatch -> QDiagram b (V b) (N b) Any
forall a b. (Drawable a, OKBackend b) => a -> Diagram b
draw (Vertex, Vertex)
algmnt Tgraph
g QDiagram b (V b) (N b) Any
-> (QDiagram b (V b) (N b) Any -> QDiagram b (V b) (N b) Any)
-> QDiagram b (V b) (N b) Any
forall a b. a -> (a -> b) -> b
# Colour Double
-> QDiagram b (V b) (N b) Any -> QDiagram b (V b) (N b) Any
forall n a.
(InSpace V2 n a, Typeable n, Floating n, HasStyle a) =>
Colour Double -> a -> a
lc Colour Double
forall a. (Ord a, Floating a) => Colour a
red QDiagram b (V b) (N b) Any
-> QDiagram b (V b) (N b) Any -> QDiagram b (V b) (N b) Any
forall a. Semigroup a => a -> a -> a
<> (VPatch -> QDiagram b (V b) (N b) Any)
-> (Vertex, Vertex) -> Tgraph -> QDiagram b (V b) (N b) Any
forall a. (VPatch -> a) -> (Vertex, Vertex) -> Tgraph -> a
alignBefore VPatch -> QDiagram b (V b) (N b) Any
forall a b. (Drawable a, OKBackend b) => a -> Diagram b
draw (Vertex, Vertex)
algmnt Tgraph
g'
          algmnt :: (Vertex, Vertex)
algmnt = Tgraph -> (Vertex, Vertex)
forall a. HasFaces a => a -> (Vertex, Vertex)
defaultAlignment Tgraph
g