module Tgraph.Decompose
( decompose
, decompositions
, phiVMap
, decompFace
) where
import qualified Data.Map.Strict as Map (Map, (!), fromList)
import Data.List(sort)
import Tgraph.Prelude
decompose :: Tgraph -> Tgraph
decompose :: Tgraph -> Tgraph
decompose Tgraph
g = [TileFace] -> Tgraph
makeUncheckedTgraph [TileFace]
newFaces where
newFaces :: [TileFace]
newFaces = (TileFace -> [TileFace]) -> [TileFace] -> [TileFace]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Map Dedge Vertex -> TileFace -> [TileFace]
decompFace (Tgraph -> Map Dedge Vertex
phiVMap Tgraph
g)) (Tgraph -> [TileFace]
faces Tgraph
g)
phiVMap :: Tgraph -> Map.Map Dedge Vertex
phiVMap :: Tgraph -> Map Dedge Vertex
phiVMap Tgraph
g = Map Dedge Vertex
edgeVMap where
phiReps :: [Dedge]
phiReps = [Dedge] -> [Dedge]
forall a. Ord a => [a] -> [a]
sort [(Vertex
a,Vertex
b) | (Vertex
a,Vertex
b) <- Tgraph -> [Dedge]
phiEdges Tgraph
g, Vertex
aVertex -> Vertex -> Bool
forall a. Ord a => a -> a -> Bool
<Vertex
b]
newVs :: [Vertex]
newVs = [Vertex
vVertex -> Vertex -> Vertex
forall a. Num a => a -> a -> a
+Vertex
1..Vertex
vVertex -> Vertex -> Vertex
forall a. Num a => a -> a -> a
+Vertex
n]
n :: Vertex
n = [Dedge] -> Vertex
forall a. [a] -> Vertex
forall (t :: * -> *) a. Foldable t => t a -> Vertex
length [Dedge]
phiReps
v :: Vertex
v = Tgraph -> Vertex
maxV Tgraph
g
edgeVMap :: Map Dedge Vertex
edgeVMap = [(Dedge, Vertex)] -> Map Dedge Vertex
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Dedge, Vertex)] -> Map Dedge Vertex)
-> [(Dedge, Vertex)] -> Map Dedge Vertex
forall a b. (a -> b) -> a -> b
$ [Dedge] -> [Vertex] -> [(Dedge, Vertex)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Dedge]
phiReps [Vertex]
newVs [(Dedge, Vertex)] -> [(Dedge, Vertex)] -> [(Dedge, Vertex)]
forall a. [a] -> [a] -> [a]
++ [Dedge] -> [Vertex] -> [(Dedge, Vertex)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Dedge -> Dedge) -> [Dedge] -> [Dedge]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Dedge -> Dedge
reverseD [Dedge]
phiReps) [Vertex]
newVs
decompFace:: Map.Map Dedge Vertex -> TileFace -> [TileFace]
decompFace :: Map Dedge Vertex -> TileFace -> [TileFace]
decompFace Map Dedge Vertex
newVFor TileFace
fc = case TileFace
fc of
RK(Vertex
a,Vertex
b,Vertex
c) -> [(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
RK(Vertex
c,Vertex
x,Vertex
b), (Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
LK(Vertex
c,Vertex
y,Vertex
x), (Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
RD(Vertex
a,Vertex
x,Vertex
y)]
where x :: Vertex
x = Map Dedge Vertex -> Dedge -> Vertex
forall k a. Ord k => Map k a -> k -> a
(Map.!) Map Dedge Vertex
newVFor (Vertex
a,Vertex
b)
y :: Vertex
y = Map Dedge Vertex -> Dedge -> Vertex
forall k a. Ord k => Map k a -> k -> a
(Map.!) Map Dedge Vertex
newVFor (Vertex
c,Vertex
a)
LK(Vertex
a,Vertex
b,Vertex
c) -> [(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
LK(Vertex
b,Vertex
c,Vertex
y), (Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
RK(Vertex
b,Vertex
y,Vertex
x), (Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
LD(Vertex
a,Vertex
x,Vertex
y)]
where x :: Vertex
x = Map Dedge Vertex -> Dedge -> Vertex
forall k a. Ord k => Map k a -> k -> a
(Map.!) Map Dedge Vertex
newVFor (Vertex
a,Vertex
b)
y :: Vertex
y = Map Dedge Vertex -> Dedge -> Vertex
forall k a. Ord k => Map k a -> k -> a
(Map.!) Map Dedge Vertex
newVFor (Vertex
c,Vertex
a)
RD(Vertex
a,Vertex
b,Vertex
c) -> [(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
LK(Vertex
a,Vertex
x,Vertex
c), (Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
RD(Vertex
b,Vertex
c,Vertex
x)]
where x :: Vertex
x = Map Dedge Vertex -> Dedge -> Vertex
forall k a. Ord k => Map k a -> k -> a
(Map.!) Map Dedge Vertex
newVFor (Vertex
a,Vertex
b)
LD(Vertex
a,Vertex
b,Vertex
c) -> [(Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
RK(Vertex
a,Vertex
b,Vertex
x), (Vertex, Vertex, Vertex) -> TileFace
forall rep. rep -> HalfTile rep
LD(Vertex
c,Vertex
x,Vertex
b)]
where x :: Vertex
x = Map Dedge Vertex -> Dedge -> Vertex
forall k a. Ord k => Map k a -> k -> a
(Map.!) Map Dedge Vertex
newVFor (Vertex
a,Vertex
c)
decompositions :: Tgraph -> [Tgraph]
decompositions :: Tgraph -> [Tgraph]
decompositions = (Tgraph -> Tgraph) -> Tgraph -> [Tgraph]
forall a. (a -> a) -> a -> [a]
iterate Tgraph -> Tgraph
decompose