{-|
Module      : Tgraph.Relabelling
Description : Guided union and commonFaces using relabelling operations 
Copyright   : (c) Chris Reade, 2021
License     : BSD-style
Maintainer  : chrisreade@mac.com
Stability   : experimental

This module includes relabelling functions for Tgraphs whose main purpose is
to implement a guided union of Tgraphs (fullUnion and tryFullUnion)
and also a commonFaces operation (a kind of intersection which need not be a Tgraph)
and a guided equality check (sameGraph).
-}
module Tgraph.Relabelling
  ( -- * Assisted Union (and matching) operations
    fullUnion
  , tryFullUnion
    -- * commonFaces (Assisted Intersection) and sameGraph (Assisted Equivalence)
  , commonFaces
  , sameGraph
    -- * Creating Relabellings
  , Relabelling(..)
  , newRelabelling
--  , relabellingFrom
--  , relabellingTo
--  , relabelUnion
    -- * Relabellings and matching
  , relabelToMatch
  , tryRelabelToMatch
--  , tryRelabelFromFaces
--  , tryGrowRelabel
  , relabelToMatchIgnore
--  , relabelFromFacesIgnore
--  , growRelabelIgnore
    -- * Using Relabellings
  , relabelGraph
  , checkRelabelGraph
  , relabelFace
  , relabelV
--  , relabelAvoid
  , prepareFixAvoid
  , relabelContig
    --  * Renumbering (not necessarily 1-1)
  , renumberFaces
--  , tryMatchFace
--  , twoVMatch
--  , matchFaceIgnore
-- , differing
  ) where


import Data.List (intersect, (\\), union,find,partition,nub)
import qualified Data.IntMap.Strict as VMap (IntMap, findWithDefault, fromList, fromAscList, union)
import qualified Data.IntSet as IntSet (fromList,intersection,findMax,elems,(\\),null,member)

import Tgraph.Prelude
-- import Tgraph.Convert (touchingVertices, touchingVerticesGen) -- used for fullUnion and commonFaces


{-| fullUnion (g1,e1) (g2,e2) will try to create the union of g1 and g2.  That is, it will try to combine the faces of g1
    and (possibly relabelled) faces of g2 as a Tgraph.  It does this
    by first matching the respective edges e1 and e2 and relabelling g2 to match g1 on a tile-connected region containing e1.
    It will raise an error if there is a mismatch.
    If succesfull it then uses geometry of tiles (vertex locations) to correct for multiple overlapping regions
    of tiles in g1 and relabelled g2 by a further relabelling of any touching vertices.
    The resulting union of faces requires an expensive tryTgraphProps if touching vertices were found.
    However the check is not needed when there are no touching vertices (i.e. a single tile-connected overlap).          
-}
fullUnion:: (Tgraph,Dedge) -> (Tgraph,Dedge) -> Tgraph
fullUnion :: (Tgraph, (Vertex, Vertex)) -> (Tgraph, (Vertex, Vertex)) -> Tgraph
fullUnion (Tgraph
g1,(Vertex, Vertex)
e1) (Tgraph
g2,(Vertex, Vertex)
e2) = Try Tgraph -> Tgraph
forall a. Try a -> a
runTry (Try Tgraph -> Tgraph) -> Try Tgraph -> Tgraph
forall a b. (a -> b) -> a -> b
$ (Tgraph, (Vertex, Vertex))
-> (Tgraph, (Vertex, Vertex)) -> Try Tgraph
tryFullUnion (Tgraph
g1,(Vertex, Vertex)
e1) (Tgraph
g2,(Vertex, Vertex)
e2)

{-| tryFullUnion (g1,e1) (g2,e2) will try to create the union of g1 and g2.  That is, it will try to combine the faces of g1
    and (possibly relabelled) faces of g2 as a Tgraph.  It does this
    by first matching the respective edges e1 and e2 and relabelling g2 to match g1 on a tile-connected region containing e1.
    It returns Left lines  if there is a mismatch (where lines explains the problem).
    If succesfull it then uses geometry of tiles (vertex locations) to correct for multiple overlapping regions
    of tiles in g1 and relabelled g2 by a further relabelling of any touching vertices. 
    The resulting union of faces requires an expensive tryTgraphProps if any touching vertices were found,
    and will return Left ... if this fails and Right t otherwise, where t is a Tgraph
    containing the union of faces.
    The check is not used when there are no touching vertices (i.e. a single tile-connected overlap).          
-}
tryFullUnion:: (Tgraph,Dedge) -> (Tgraph,Dedge) -> Try Tgraph
tryFullUnion :: (Tgraph, (Vertex, Vertex))
-> (Tgraph, (Vertex, Vertex)) -> Try Tgraph
tryFullUnion (Tgraph
g1,(Vertex, Vertex)
e1) (Tgraph
g2,(Vertex, Vertex)
e2) = String -> Try Tgraph -> Try Tgraph
forall a. String -> Try a -> Try a
onFail String
"tryFullUnion:\n" (Try Tgraph -> Try Tgraph) -> Try Tgraph -> Try Tgraph
forall a b. (a -> b) -> a -> b
$
  do Tgraph
g3 <- (Tgraph, (Vertex, Vertex))
-> (Tgraph, (Vertex, Vertex)) -> Try Tgraph
tryRelabelToMatch (Tgraph
g1,(Vertex, Vertex)
e1) (Tgraph
g2,(Vertex, Vertex)
e2)
     let fcs :: [TileFace]
fcs = Tgraph -> [TileFace]
faces Tgraph
g1 [TileFace] -> [TileFace] -> [TileFace]
forall a. Eq a => [a] -> [a] -> [a]
`union` Tgraph -> [TileFace]
faces Tgraph
g3
         touchVs :: [(Vertex, Vertex)]
touchVs = [TileFace] -> [(Vertex, Vertex)]
touchingVertices [TileFace]
fcs
     if [(Vertex, Vertex)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Vertex, Vertex)]
touchVs
     then Tgraph -> Try Tgraph
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tgraph -> Try Tgraph) -> Tgraph -> Try Tgraph
forall a b. (a -> b) -> a -> b
$ [TileFace] -> Tgraph
makeUncheckedTgraph [TileFace]
fcs -- no properties check needed!
     else let vertg1 :: VertexSet
vertg1 = Tgraph -> VertexSet
vertexSet Tgraph
g1
              correct :: (Vertex, Vertex) -> (Vertex, Vertex)
correct e :: (Vertex, Vertex)
e@(Vertex
a,Vertex
b) = if Vertex
a Vertex -> VertexSet -> Bool
`IntSet.member` VertexSet
vertg1 then (Vertex
b,Vertex
a) else (Vertex, Vertex)
e
              newrel :: Relabelling
newrel = [(Vertex, Vertex)] -> Relabelling
newRelabelling ([(Vertex, Vertex)] -> Relabelling)
-> [(Vertex, Vertex)] -> Relabelling
forall a b. (a -> b) -> a -> b
$ ((Vertex, Vertex) -> (Vertex, Vertex))
-> [(Vertex, Vertex)] -> [(Vertex, Vertex)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Vertex, Vertex) -> (Vertex, Vertex)
correct [(Vertex, Vertex)]
touchVs
          in [TileFace] -> Try Tgraph
tryTgraphProps ([TileFace] -> Try Tgraph) -> [TileFace] -> Try Tgraph
forall a b. (a -> b) -> a -> b
$ [TileFace] -> [TileFace]
forall a. Eq a => [a] -> [a]
nub ([TileFace] -> [TileFace]) -> [TileFace] -> [TileFace]
forall a b. (a -> b) -> a -> b
$ (TileFace -> TileFace) -> [TileFace] -> [TileFace]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Relabelling -> TileFace -> TileFace
relabelFace Relabelling
newrel) [TileFace]
fcs


-- | commonFaces (g1,e1) (g2,e2) relabels g2 to match with g1 (where they match)
-- and returns the common faces as a subset of faces of g1.
-- i.e. with g1 vertex labelling.
-- It requires a face in g1 with directed edge e1 to match a face in g2 with directed edge e2,
-- (apart from the third vertex label) otherwise an error is raised.
-- This uses vertex locations to correct touching vertices in multiply overlapping regions.
-- >>>> touching vertices being 1-1 is sensitive to nearness check of touchingVerticesGen <<<<<<<<<
commonFaces:: (Tgraph,Dedge) -> (Tgraph,Dedge) -> [TileFace]
commonFaces :: (Tgraph, (Vertex, Vertex))
-> (Tgraph, (Vertex, Vertex)) -> [TileFace]
commonFaces (Tgraph
g1,(Vertex, Vertex)
e1) (Tgraph
g2,(Vertex, Vertex)
e2) = Tgraph -> [TileFace]
faces Tgraph
g1 [TileFace] -> [TileFace] -> [TileFace]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` [TileFace]
relFaces where
  g3 :: Tgraph
g3 = (Tgraph, (Vertex, Vertex)) -> (Tgraph, (Vertex, Vertex)) -> Tgraph
relabelToMatchIgnore (Tgraph
g1,(Vertex, Vertex)
e1) (Tgraph
g2,(Vertex, Vertex)
e2)
  fcs :: [TileFace]
fcs = Tgraph -> [TileFace]
faces Tgraph
g1 [TileFace] -> [TileFace] -> [TileFace]
forall a. Eq a => [a] -> [a] -> [a]
`union` Tgraph -> [TileFace]
faces Tgraph
g3
  touchVs :: [(Vertex, Vertex)]
touchVs = [TileFace] -> [(Vertex, Vertex)]
touchingVerticesGen [TileFace]
fcs -- requires generalised version of touchingVertices
  relFaces :: [TileFace]
relFaces = (TileFace -> TileFace) -> [TileFace] -> [TileFace]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Relabelling -> TileFace -> TileFace
relabelFace (Relabelling -> TileFace -> TileFace)
-> Relabelling -> TileFace -> TileFace
forall a b. (a -> b) -> a -> b
$ [(Vertex, Vertex)] -> Relabelling
newRelabelling ([(Vertex, Vertex)] -> Relabelling)
-> [(Vertex, Vertex)] -> Relabelling
forall a b. (a -> b) -> a -> b
$ ((Vertex, Vertex) -> (Vertex, Vertex))
-> [(Vertex, Vertex)] -> [(Vertex, Vertex)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Vertex, Vertex) -> (Vertex, Vertex)
correct [(Vertex, Vertex)]
touchVs) (Tgraph -> [TileFace]
faces Tgraph
g3)
  vertg1 :: VertexSet
vertg1 = Tgraph -> VertexSet
vertexSet Tgraph
g1
  correct :: (Vertex, Vertex) -> (Vertex, Vertex)
correct e :: (Vertex, Vertex)
e@(Vertex
a,Vertex
b) = if Vertex
a Vertex -> VertexSet -> Bool
`IntSet.member` VertexSet
vertg1 then (Vertex
b,Vertex
a) else (Vertex, Vertex)
e

                      
-- | sameGraph (g1,e1) (g2,e2) checks to see if g1 and g2 are the same Tgraph after relabelling g2.
-- The relabelling is based on directed edge e2 in g2 matching e1 in g1 (where the direction is clockwise round a face)
-- and uses tryRelabelToMatch.
sameGraph :: (Tgraph,Dedge) -> (Tgraph,Dedge) -> Bool
sameGraph :: (Tgraph, (Vertex, Vertex)) -> (Tgraph, (Vertex, Vertex)) -> Bool
sameGraph (Tgraph
g1,(Vertex, Vertex)
e1) (Tgraph
g2,(Vertex, Vertex)
e2) =  [TileFace] -> Vertex
forall a. [a] -> Vertex
forall (t :: * -> *) a. Foldable t => t a -> Vertex
length (Tgraph -> [TileFace]
faces Tgraph
g1) Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
== [TileFace] -> Vertex
forall a. [a] -> Vertex
forall (t :: * -> *) a. Foldable t => t a -> Vertex
length (Tgraph -> [TileFace]
faces Tgraph
g2) Bool -> Bool -> Bool
&&
                             Bool -> Try Bool -> Bool
forall a. a -> Try a -> a
ifFail Bool
False Try Bool
tryResult where
 tryResult :: Try Bool
tryResult = do Tgraph
g <- (Tgraph, (Vertex, Vertex))
-> (Tgraph, (Vertex, Vertex)) -> Try Tgraph
tryRelabelToMatch (Tgraph
g1,(Vertex, Vertex)
e1) (Tgraph
g2,(Vertex, Vertex)
e2)
                Bool -> Try Bool
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tgraph -> VertexSet
vertexSet Tgraph
g VertexSet -> VertexSet -> Bool
forall a. Eq a => a -> a -> Bool
== Tgraph -> VertexSet
vertexSet Tgraph
g1)


-- |Relabelling is a special case of mappings from vertices to vertices that are not the 
-- identity on a finite number of vertices.
-- They are represented by keeping the non identity cases in a finite map.
-- When applied, we assume the identity map for vertices not found in the representation domain
-- (see relabelV).  Relabellings must be 1-1 on their representation domain,
-- and redundant identity mappings are removed in the representation.
-- Vertices in the range of a relabelling must be >0.
newtype Relabelling = Relabelling (VMap.IntMap Vertex)

-- | newRelabelling prs - make a relabelling from a finite list of vertex pairs.
-- The first item in each pair relabels to the second in the pair.
-- The resulting relabelling excludes any identity mappings of vertices.
-- An error is raised if second items of the pairs contain duplicated numbers or a number<1
newRelabelling :: [(Vertex,Vertex)] -> Relabelling
newRelabelling :: [(Vertex, Vertex)] -> Relabelling
newRelabelling [(Vertex, Vertex)]
prs 
    | [Vertex] -> Bool
forall {a}. (Ord a, Num a) => [a] -> Bool
wrong (((Vertex, Vertex) -> Vertex) -> [(Vertex, Vertex)] -> [Vertex]
forall a b. (a -> b) -> [a] -> [b]
map (Vertex, Vertex) -> Vertex
forall a b. (a, b) -> b
snd [(Vertex, Vertex)]
prs) = String -> Relabelling
forall a. HasCallStack => String -> a
error (String -> Relabelling) -> String -> Relabelling
forall a b. (a -> b) -> a -> b
$ String
"newRelabelling: Not 1-1 or Non-positive label in range " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [(Vertex, Vertex)] -> String
forall a. Show a => a -> String
show [(Vertex, Vertex)]
prs
    | Bool
otherwise = IntMap Vertex -> Relabelling
Relabelling (IntMap Vertex -> Relabelling) -> IntMap Vertex -> Relabelling
forall a b. (a -> b) -> a -> b
$ [(Vertex, Vertex)] -> IntMap Vertex
forall a. [(Vertex, a)] -> IntMap a
VMap.fromList ([(Vertex, Vertex)] -> IntMap Vertex)
-> [(Vertex, Vertex)] -> IntMap Vertex
forall a b. (a -> b) -> a -> b
$ [(Vertex, Vertex)] -> [(Vertex, Vertex)]
forall a. Eq a => [(a, a)] -> [(a, a)]
differing [(Vertex, Vertex)]
prs
  where wrong :: [a] -> Bool
wrong [a]
vs = (a -> Bool) -> [a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<a
1) [a]
vs Bool -> Bool -> Bool
|| Bool -> Bool
not ([a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([a] -> [a]
forall a. Eq a => [a] -> [a]
duplicates [a]
vs))

-- | relabellingFrom n vs - make a relabelling from finite set of vertices vs.
-- Elements of vs are ordered and relabelled from n upwards (an error is raised if n<1).
-- The resulting relabelling excludes any identity mappings of vertices.
relabellingFrom :: Int -> VertexSet -> Relabelling
relabellingFrom :: Vertex -> VertexSet -> Relabelling
relabellingFrom Vertex
n VertexSet
vs 
    | Vertex
nVertex -> Vertex -> Bool
forall a. Ord a => a -> a -> Bool
<Vertex
1 = String -> Relabelling
forall a. HasCallStack => String -> a
error (String -> Relabelling) -> String -> Relabelling
forall a b. (a -> b) -> a -> b
$ String
"relabellingFrom: Label not positive " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Vertex -> String
forall a. Show a => a -> String
show Vertex
n
    | Bool
otherwise = IntMap Vertex -> Relabelling
Relabelling (IntMap Vertex -> Relabelling) -> IntMap Vertex -> Relabelling
forall a b. (a -> b) -> a -> b
$ [(Vertex, Vertex)] -> IntMap Vertex
forall a. [(Vertex, a)] -> IntMap a
VMap.fromAscList ([(Vertex, Vertex)] -> IntMap Vertex)
-> [(Vertex, Vertex)] -> IntMap Vertex
forall a b. (a -> b) -> a -> b
$ [(Vertex, Vertex)] -> [(Vertex, Vertex)]
forall a. Eq a => [(a, a)] -> [(a, a)]
differing ([(Vertex, Vertex)] -> [(Vertex, Vertex)])
-> [(Vertex, Vertex)] -> [(Vertex, Vertex)]
forall a b. (a -> b) -> a -> b
$ [Vertex] -> [Vertex] -> [(Vertex, Vertex)]
forall a b. [a] -> [b] -> [(a, b)]
zip (VertexSet -> [Vertex]
IntSet.elems VertexSet
vs) [Vertex
n..] 

-- | f1 \`relabellingTo\` f2  - creates a relabelling so that
-- if applied to face f1, the vertices will match with face f2 exactly.
-- It does not check that the tile faces have the same form (LK,RK,LD,RD).
relabellingTo :: TileFace -> TileFace -> Relabelling
TileFace
f1 relabellingTo :: TileFace -> TileFace -> Relabelling
`relabellingTo` TileFace
f2 = [(Vertex, Vertex)] -> Relabelling
newRelabelling ([(Vertex, Vertex)] -> Relabelling)
-> [(Vertex, Vertex)] -> Relabelling
forall a b. (a -> b) -> a -> b
$ [Vertex] -> [Vertex] -> [(Vertex, Vertex)]
forall a b. [a] -> [b] -> [(a, b)]
zip (TileFace -> [Vertex]
faceVList TileFace
f1) (TileFace -> [Vertex]
faceVList TileFace
f2) -- f1 relabels to f2

-- | Combine relabellings (assumes disjoint representation domains and disjoint representation ranges but
-- no check is made for these).
relabelUnion:: Relabelling -> Relabelling -> Relabelling
relabelUnion :: Relabelling -> Relabelling -> Relabelling
relabelUnion (Relabelling IntMap Vertex
r1) (Relabelling IntMap Vertex
r2) = IntMap Vertex -> Relabelling
Relabelling (IntMap Vertex -> Relabelling) -> IntMap Vertex -> Relabelling
forall a b. (a -> b) -> a -> b
$ IntMap Vertex -> IntMap Vertex -> IntMap Vertex
forall a. IntMap a -> IntMap a -> IntMap a
VMap.union IntMap Vertex
r1 IntMap Vertex
r2 


{-|relabelToMatch (g1,e1) (g2,e2)  produces a relabelled version of g2 that is
consistent with g1 on a single tile-connected region of overlap.
The overlapping region must contain the directed edge e1 in g1. The edge e2 in g2
will be identified with e1 by the relabelling of g2.
This produces an error if a mismatch is found anywhere in the overlap.

CAVEAT: The relabelling may not be complete if the overlap is not just a SINGLE tile-connected region in g1.
If the overlap is more than a single tile-connected region, then the union of the relabelled faces with faces in g1
will be tile-connected but may have touching vertices.
This limitation is addressed by fullUnion. 
-}
relabelToMatch:: (Tgraph,Dedge) -> (Tgraph,Dedge) -> Tgraph
relabelToMatch :: (Tgraph, (Vertex, Vertex)) -> (Tgraph, (Vertex, Vertex)) -> Tgraph
relabelToMatch (Tgraph, (Vertex, Vertex))
ge1 (Tgraph, (Vertex, Vertex))
ge2 = Try Tgraph -> Tgraph
forall a. Try a -> a
runTry (Try Tgraph -> Tgraph) -> Try Tgraph -> Tgraph
forall a b. (a -> b) -> a -> b
$ (Tgraph, (Vertex, Vertex))
-> (Tgraph, (Vertex, Vertex)) -> Try Tgraph
tryRelabelToMatch (Tgraph, (Vertex, Vertex))
ge1 (Tgraph, (Vertex, Vertex))
ge2
 
{-|tryRelabelToMatch (g1,e1) (g2,e2) produces either Right g where g is a relabelled version of g2 that is
consistent with g1 on an overlapping tile-connected region or Left lines if there is a mismatch (lines explaining the problem).
The overlapping region must contain the directed edge e1 in g1. The edge e2 in g2
will be identified with e1 by the relabelling of g2.

CAVEAT: The relabelling may not be complete if the overlap is not just a SINGLE tile-connected region in g1.
If the overlap is more than a single tile-connected region, then the union of the relabelled faces with faces in g1
will be tile-connected but may have touching vertices.    
This limitation is addressed by tryFullUnion. 
-}
tryRelabelToMatch :: (Tgraph,Dedge) -> (Tgraph,Dedge) -> Try Tgraph
tryRelabelToMatch :: (Tgraph, (Vertex, Vertex))
-> (Tgraph, (Vertex, Vertex)) -> Try Tgraph
tryRelabelToMatch (Tgraph
g1,(Vertex
x1,Vertex
y1)) (Tgraph
g2,(Vertex
x2,Vertex
y2)) = String -> Try Tgraph -> Try Tgraph
forall a. String -> Try a -> Try a
onFail String
"tryRelabelToMatch:\n" (Try Tgraph -> Try Tgraph) -> Try Tgraph -> Try Tgraph
forall a b. (a -> b) -> a -> b
$ 
  do let g2prepared :: Tgraph
g2prepared = [Vertex] -> VertexSet -> Tgraph -> Tgraph
prepareFixAvoid [Vertex
x2,Vertex
y2] (Tgraph -> VertexSet
vertexSet Tgraph
g1) Tgraph
g2
     TileFace
fc2 <- (TileFace -> Bool) -> [TileFace] -> Maybe TileFace
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (TileFace -> (Vertex, Vertex) -> Bool
`hasDedge` (Vertex
x2,Vertex
y2)) (Tgraph -> [TileFace]
faces Tgraph
g2prepared)
            Maybe TileFace -> String -> Try TileFace
forall b. Maybe b -> String -> Try b
`nothingFail` (String
"No face found for edge " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Vertex, Vertex) -> String
forall a. Show a => a -> String
show (Vertex
x2,Vertex
y2))                      
     Maybe TileFace
maybef <- TileFace -> Tgraph -> Try (Maybe TileFace)
tryMatchFace (Relabelling -> TileFace -> TileFace
relabelFace ([(Vertex, Vertex)] -> Relabelling
newRelabelling [(Vertex
x2,Vertex
x1),(Vertex
y2,Vertex
y1)]) TileFace
fc2) Tgraph
g1
     TileFace
fc1 <- Maybe TileFace
maybef Maybe TileFace -> String -> Try TileFace
forall b. Maybe b -> String -> Try b
`nothingFail` 
                   (String
"No matching face found at edge "String -> String -> String
forall a. [a] -> [a] -> [a]
++(Vertex, Vertex) -> String
forall a. Show a => a -> String
show (Vertex
x1,Vertex
y1)String -> String -> String
forall a. [a] -> [a] -> [a]
++
                    String
"\nfor relabelled face " String -> String -> String
forall a. [a] -> [a] -> [a]
++ TileFace -> String
forall a. Show a => a -> String
show TileFace
fc2)  
  -- assert g2prepared has no labels in common with g1 except possibly those in fc2
     (Tgraph, TileFace) -> (Tgraph, TileFace) -> Try Tgraph
tryRelabelFromFaces (Tgraph
g1,TileFace
fc1) (Tgraph
g2prepared,TileFace
fc2)

{-|tryRelabelFromFaces is an auxiliary function for tryRelabelToMatch.
tryRelabelFromFaces (g1,fc1) (g2,fc2) - fc1 and fc2 should have the same form (RK,LK,RD,LD),
with fc1 a face in g1 and fc2 a face in g2.
g2 must have no vertices in common with g1 except for (possibly) vertices in fc2.
The result is either Right g3 where
g3 is a relabelling of g2 which is consistent with g1 in a single region of overlap containing fc1 if this is possible, or
Left lines if there is a mismatch (lines explaining the problem).
In the successful case fc2 will be relabelled to fc1.

CAVEAT: Only the single tile-connected region of common overlap (containing fc2) of g2 gets relabelled
to match with g1.
-}
tryRelabelFromFaces :: (Tgraph,TileFace) -> (Tgraph,TileFace) -> Try Tgraph
tryRelabelFromFaces :: (Tgraph, TileFace) -> (Tgraph, TileFace) -> Try Tgraph
tryRelabelFromFaces (Tgraph
g1,TileFace
fc1) (Tgraph
g2,TileFace
fc2) = String -> Try Tgraph -> Try Tgraph
forall a. String -> Try a -> Try a
onFail String
"tryRelabelFromFaces:\n" (Try Tgraph -> Try Tgraph) -> Try Tgraph -> Try Tgraph
forall a b. (a -> b) -> a -> b
$ 
   do Relabelling
rlab <- Tgraph
-> [TileFace] -> [TileFace] -> Relabelling -> Try Relabelling
tryGrowRelabel Tgraph
g1 [TileFace
fc2] (Tgraph -> [TileFace]
faces Tgraph
g2 [TileFace] -> [TileFace] -> [TileFace]
forall a. Eq a => [a] -> [a] -> [a]
\\ [TileFace
fc2]) (TileFace
fc2 TileFace -> TileFace -> Relabelling
`relabellingTo` TileFace
fc1)
      Tgraph -> Try Tgraph
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tgraph -> Try Tgraph) -> Tgraph -> Try Tgraph
forall a b. (a -> b) -> a -> b
$ Relabelling -> Tgraph -> Tgraph
relabelGraph Relabelling
rlab Tgraph
g2
      
{-|tryGrowRelabel is used by tryRelabelFromFaces to build a relabelling map which can fail, producing Left lines.
In the successful case it produces a Right rlab
where rlab is the required relabelling. 
The arguments are:  g processing awaiting rlab where
g is the Tgraph being matched against;
processing is a list of faces to be matched next
(each has an edge in common with at least one previously matched face or it is the starting face);
awaiting is a list of faces that have not yet been tried for a match and are not
tile-connected to any faces already matched.
rlab is the relabelling so far.

The idea is that from a single matched starting face we process faces that share an edge with a
previously matched face. Each face processed should have a match in g (with 2 matching vertices).
If a face is tried but has no such match, it is ignored (it may share some boundary with g, but
for the overlap to be a single tile-connected region, only boundaries with matched tiles are possible
and therefore relabelling will already be done for the boundary).
If a processed face has an edge in common with a face in g it has to match exactly
apart from (possibly) the third vertex label,
otherwise the faces do not match and this
indicates a mismatch on the overlap and Left ... is returned.
-}
tryGrowRelabel:: Tgraph -> [TileFace] -> [TileFace] -> Relabelling -> Try Relabelling
tryGrowRelabel :: Tgraph
-> [TileFace] -> [TileFace] -> Relabelling -> Try Relabelling
tryGrowRelabel Tgraph
_ [] [TileFace]
_ Relabelling
rlab = Relabelling -> Try Relabelling
forall a b. b -> Either a b
Right Relabelling
rlab -- awaiting are not tile-connected to overlap region
tryGrowRelabel Tgraph
g (TileFace
fc:[TileFace]
fcs) [TileFace]
awaiting Relabelling
rlab = 
  do Maybe TileFace
maybef <- TileFace -> Tgraph -> Try (Maybe TileFace)
tryMatchFace (Relabelling -> TileFace -> TileFace
relabelFace Relabelling
rlab TileFace
fc) Tgraph
g
     case Maybe TileFace
maybef of
       Maybe TileFace
Nothing   -> Tgraph
-> [TileFace] -> [TileFace] -> Relabelling -> Try Relabelling
tryGrowRelabel Tgraph
g [TileFace]
fcs [TileFace]
awaiting Relabelling
rlab
       Just TileFace
orig -> Tgraph
-> [TileFace] -> [TileFace] -> Relabelling -> Try Relabelling
tryGrowRelabel Tgraph
g ([TileFace]
fcs[TileFace] -> [TileFace] -> [TileFace]
forall a. [a] -> [a] -> [a]
++[TileFace]
fcs') [TileFace]
awaiting' Relabelling
rlab'
                    where ([TileFace]
fcs', [TileFace]
awaiting') = (TileFace -> Bool) -> [TileFace] -> ([TileFace], [TileFace])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (TileFace -> TileFace -> Bool
edgeNb TileFace
fc) [TileFace]
awaiting
                          rlab' :: Relabelling
rlab' = Relabelling -> Relabelling -> Relabelling
relabelUnion (TileFace
fc TileFace -> TileFace -> Relabelling
`relabellingTo` TileFace
orig) Relabelling
rlab



-- |same as relabelToMatch but ignores non-matching faces (except for the initial 2)
-- The initial 2 faces are those on the given edges, and an error is raised if they do not match.
-- This is used by commonFaces
relabelToMatchIgnore :: (Tgraph,Dedge) -> (Tgraph,Dedge) -> Tgraph
relabelToMatchIgnore :: (Tgraph, (Vertex, Vertex)) -> (Tgraph, (Vertex, Vertex)) -> Tgraph
relabelToMatchIgnore (Tgraph
g1,(Vertex
x1,Vertex
y1)) (Tgraph
g2,(Vertex
x2,Vertex
y2)) = (Tgraph, TileFace) -> (Tgraph, TileFace) -> Tgraph
relabelFromFacesIgnore (Tgraph
g1,TileFace
fc1) (Tgraph
g2prepared,TileFace
fc2) where
  g2prepared :: Tgraph
g2prepared = [Vertex] -> VertexSet -> Tgraph -> Tgraph
prepareFixAvoid [Vertex
x2,Vertex
y2] (Tgraph -> VertexSet
vertexSet Tgraph
g1) Tgraph
g2
  fc2 :: TileFace
fc2 = case (TileFace -> Bool) -> [TileFace] -> Maybe TileFace
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (TileFace -> (Vertex, Vertex) -> Bool
`hasDedge` (Vertex
x2,Vertex
y2)) (Tgraph -> [TileFace]
faces Tgraph
g2prepared) of
           Maybe TileFace
Nothing -> String -> TileFace
forall a. HasCallStack => String -> a
error (String -> TileFace) -> String -> TileFace
forall a b. (a -> b) -> a -> b
$ String
"No face found for edge " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Vertex, Vertex) -> String
forall a. Show a => a -> String
show (Vertex
x2,Vertex
y2)
           Just TileFace
f -> TileFace
f                      
  fc1 :: TileFace
fc1 = case TileFace -> Tgraph -> Maybe TileFace
matchFaceIgnore (Relabelling -> TileFace -> TileFace
relabelFace ([(Vertex, Vertex)] -> Relabelling
newRelabelling [(Vertex
x2,Vertex
x1),(Vertex
y2,Vertex
y1)]) TileFace
fc2) Tgraph
g1 of
           Maybe TileFace
Nothing -> String -> TileFace
forall a. HasCallStack => String -> a
error (String -> TileFace) -> String -> TileFace
forall a b. (a -> b) -> a -> b
$ String
"No matching face found at edge "String -> String -> String
forall a. [a] -> [a] -> [a]
++(Vertex, Vertex) -> String
forall a. Show a => a -> String
show (Vertex
x1,Vertex
y1)String -> String -> String
forall a. [a] -> [a] -> [a]
++
                              String
"\nfor relabelled face " String -> String -> String
forall a. [a] -> [a] -> [a]
++ TileFace -> String
forall a. Show a => a -> String
show TileFace
fc2
           Just TileFace
f -> TileFace
f
   

{-| relabelFromFacesIgnore is an auxiliary function for relabelToMatchIgnore.
It is similar to tryRelabelFromFaces except that it uses growRelabelIgnore and matchFaceIgnore
which ignores non-matching faces rather than failing. It thus returns a definite relabelled Tgraph.
tryRelabelFromFaces (g1,fc1) (g2,fc2) - fc1 and fc2 should have the same form (RK,LK,RD,LD),
with fc1 a face in g1 and fc2 a face in g2.
g2 must have no vertices in common with g1 except for (possibly) vertices in fc2.
The result is g3 where
g3 is a relabelling of g2 which is consistent with g1 in a common single region of overlap containing fc1.

CAVEAT: Only the single tile-connected region of common overlap (containing fc2) of g2 gets relabelled
to match with g1.
-}
relabelFromFacesIgnore :: (Tgraph,TileFace) -> (Tgraph,TileFace) -> Tgraph
relabelFromFacesIgnore :: (Tgraph, TileFace) -> (Tgraph, TileFace) -> Tgraph
relabelFromFacesIgnore (Tgraph
g1,TileFace
fc1) (Tgraph
g2,TileFace
fc2) = Relabelling -> Tgraph -> Tgraph
relabelGraph Relabelling
rlab Tgraph
g2 where
    rlab :: Relabelling
rlab = Tgraph -> [TileFace] -> [TileFace] -> Relabelling -> Relabelling
growRelabelIgnore Tgraph
g1 [TileFace
fc2] (Tgraph -> [TileFace]
faces Tgraph
g2 [TileFace] -> [TileFace] -> [TileFace]
forall a. Eq a => [a] -> [a] -> [a]
\\ [TileFace
fc2]) (TileFace
fc2 TileFace -> TileFace -> Relabelling
`relabellingTo` TileFace
fc1)

-- |growRelabelIgnore is similar to tryGrowRelabel except that it uses matchFaceIgnore (instead of tryMatchFace)
-- which ignores non-matching faces rather than failing. It thus returns a definite Relabelling.
growRelabelIgnore:: Tgraph -> [TileFace] -> [TileFace] -> Relabelling -> Relabelling
growRelabelIgnore :: Tgraph -> [TileFace] -> [TileFace] -> Relabelling -> Relabelling
growRelabelIgnore Tgraph
_ [] [TileFace]
_ Relabelling
rlab = Relabelling
rlab -- awaiting are not tile-connected to overlap region
growRelabelIgnore Tgraph
g (TileFace
fc:[TileFace]
fcs) [TileFace]
awaiting Relabelling
rlab = 
     case TileFace -> Tgraph -> Maybe TileFace
matchFaceIgnore (Relabelling -> TileFace -> TileFace
relabelFace Relabelling
rlab TileFace
fc) Tgraph
g of
       Maybe TileFace
Nothing   -> Tgraph -> [TileFace] -> [TileFace] -> Relabelling -> Relabelling
growRelabelIgnore Tgraph
g [TileFace]
fcs [TileFace]
awaiting Relabelling
rlab
       Just TileFace
orig -> Tgraph -> [TileFace] -> [TileFace] -> Relabelling -> Relabelling
growRelabelIgnore Tgraph
g ([TileFace]
fcs[TileFace] -> [TileFace] -> [TileFace]
forall a. [a] -> [a] -> [a]
++[TileFace]
fcs') [TileFace]
awaiting' Relabelling
rlab'
                    where ([TileFace]
fcs', [TileFace]
awaiting') = (TileFace -> Bool) -> [TileFace] -> ([TileFace], [TileFace])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (TileFace -> TileFace -> Bool
edgeNb TileFace
fc) [TileFace]
awaiting
                          rlab' :: Relabelling
rlab' = Relabelling -> Relabelling -> Relabelling
relabelUnion (TileFace
fc TileFace -> TileFace -> Relabelling
`relabellingTo` TileFace
orig) Relabelling
rlab


-- |relabelGraph rlab g - uses a Relabelling rlab to change vertices in a Tgraph g.
-- Caveat: This should only be used when it is known that:
-- rlab is 1-1 on its (representation) domain, and
-- the vertices of g are disjoint from those vertices that are in the representation range
-- but which are not in the representation domain of rlab.
-- This ensures rlab (extended with the identity) remains 1-1 on vertices in g,
-- so that the resulting Tgraph does not need an expensive check for Tgraph properties.
-- (See also checkRelabelGraph)
relabelGraph:: Relabelling -> Tgraph -> Tgraph
relabelGraph :: Relabelling -> Tgraph -> Tgraph
relabelGraph Relabelling
rlab Tgraph
g = [TileFace] -> Tgraph
makeUncheckedTgraph [TileFace]
newFaces where
   newFaces :: [TileFace]
newFaces = (TileFace -> TileFace) -> [TileFace] -> [TileFace]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Relabelling -> TileFace -> TileFace
relabelFace Relabelling
rlab) (Tgraph -> [TileFace]
faces Tgraph
g) 

-- |checkRelabelGraph uses a relabelling map to change vertices in a Tgraph,
-- then checks that the result is a valid Tgraph. (see also relabelGraph)
checkRelabelGraph:: Relabelling -> Tgraph -> Tgraph
checkRelabelGraph :: Relabelling -> Tgraph -> Tgraph
checkRelabelGraph Relabelling
rlab Tgraph
g = [TileFace] -> Tgraph
checkedTgraph [TileFace]
newFaces where
   newFaces :: [TileFace]
newFaces = (TileFace -> TileFace) -> [TileFace] -> [TileFace]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Relabelling -> TileFace -> TileFace
relabelFace Relabelling
rlab) (Tgraph -> [TileFace]
faces Tgraph
g) 

-- |Uses a relabelling to relabel the three vertices of a face.
-- Any vertex not in the domain of the mapping is left unchanged.
-- The mapping should be 1-1 on the 3 vertices to avoid creating a self loop edge.
relabelFace:: Relabelling -> TileFace -> TileFace
relabelFace :: Relabelling -> TileFace -> TileFace
relabelFace Relabelling
rlab = ((Vertex, Vertex, Vertex) -> (Vertex, Vertex, Vertex))
-> TileFace -> TileFace
forall a b. (a -> b) -> HalfTile a -> HalfTile b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Vertex -> Vertex)
-> (Vertex, Vertex, Vertex) -> (Vertex, Vertex, Vertex)
forall {t} {c}. (t -> c) -> (t, t, t) -> (c, c, c)
all3 (Relabelling -> Vertex -> Vertex
relabelV Relabelling
rlab)) where -- fmap of HalfTile Functor
  all3 :: (t -> c) -> (t, t, t) -> (c, c, c)
all3 t -> c
f (t
a,t
b,t
c) = (t -> c
f t
a,t -> c
f t
b,t -> c
f t
c)

-- |relabelV rlab v - uses relabelling rlab to find a replacement for v (leaves as v if none found).
-- I.e relabelV turns a Relabelling into a total function using identity
-- for undefined cases in the Relabelling representation. 
relabelV:: Relabelling -> Vertex -> Vertex
relabelV :: Relabelling -> Vertex -> Vertex
relabelV (Relabelling IntMap Vertex
r) Vertex
v = Vertex -> Vertex -> IntMap Vertex -> Vertex
forall a. a -> Vertex -> IntMap a -> a
VMap.findWithDefault Vertex
v Vertex
v IntMap Vertex
r

-- |relabelAvoid avoid g - produces a new Tgraph from g by relabelling.
-- Any vertex in g that is in the set avoid will be changed to a new vertex that is
-- neither in g nor in the set avoid. Vertices in g that are not in avoid will remain the same.
relabelAvoid :: VertexSet -> Tgraph -> Tgraph
relabelAvoid :: VertexSet -> Tgraph -> Tgraph
relabelAvoid VertexSet
avoid Tgraph
g = Relabelling -> Tgraph -> Tgraph
relabelGraph Relabelling
rlab Tgraph
g where
  gverts :: VertexSet
gverts = Tgraph -> VertexSet
vertexSet Tgraph
g
  avoidMax :: Vertex
avoidMax = if VertexSet -> Bool
IntSet.null VertexSet
avoid then Vertex
0 else VertexSet -> Vertex
IntSet.findMax VertexSet
avoid
  vertsToChange :: VertexSet
vertsToChange = VertexSet
gverts VertexSet -> VertexSet -> VertexSet
`IntSet.intersection` VertexSet
avoid
  rlab :: Relabelling
rlab = Vertex -> VertexSet -> Relabelling
relabellingFrom (Vertex
1Vertex -> Vertex -> Vertex
forall a. Num a => a -> a -> a
+ Vertex -> Vertex -> Vertex
forall a. Ord a => a -> a -> a
max (Tgraph -> Vertex
maxV Tgraph
g) Vertex
avoidMax) VertexSet
vertsToChange
  -- assert: rlab is 1-1 on the vertices of g
  -- assert: the relabelled Tgraph satisfies Tgraph properties (if g does)
  -- assert: the relabelled Tgraph does not have vertices in the set avoid

  
{-|prepareFixAvoid fix avoid g - produces a new Tgraph from g by relabelling.
 Any vertex in g that is in the set avoid but not in the list fix will be changed to a new vertex that is
 neither in g nor in the set (avoid with fix removed).
 All other vertices of g (including those in fix) will remain the same.
 Usage: This is used to prepare a graph by avoiding accidental label clashes with the avoid set
 (usually vertices of another graph).
  However we fix a list of vertices which we intend to control in a subsequent relabelling.
  (this is usually a pair of vertices from a directed edge that will get a specific subsequent relabelling).
Note: If any element of the list fix is not a vertex in g, it could end up in the relabelled Tgraph.
-}
prepareFixAvoid :: [Vertex] -> VertexSet -> Tgraph -> Tgraph
prepareFixAvoid :: [Vertex] -> VertexSet -> Tgraph -> Tgraph
prepareFixAvoid [Vertex]
fix VertexSet
avoid = VertexSet -> Tgraph -> Tgraph
relabelAvoid (VertexSet
avoid VertexSet -> VertexSet -> VertexSet
IntSet.\\ [Vertex] -> VertexSet
IntSet.fromList [Vertex]
fix)
  -- assert: the relabelled Tgraph satisfies Tgraph properties (if the argument Tgraph does)
  -- assert: the relabelled Tgraph does not have vertices in the set (avoid\\fix)

-- |Relabel all vertices in a Tgraph using new labels 1..n (where n is the number of vertices).
relabelContig :: Tgraph -> Tgraph
relabelContig :: Tgraph -> Tgraph
relabelContig Tgraph
g = Relabelling -> Tgraph -> Tgraph
relabelGraph Relabelling
rlab Tgraph
g where
   rlab :: Relabelling
rlab = Vertex -> VertexSet -> Relabelling
relabellingFrom Vertex
1 (Tgraph -> VertexSet
vertexSet Tgraph
g)
  -- assert: rlab is 1-1 on the vertices of g
  -- assert: the relabelled Tgraph satisfies Tgraph properties (if g does)
 

-- |renumberFaces allows for a non 1-1 relabelling represented by a list of pairs.
-- It is used only for tryCorrectTouchingVs in Tgraphs which then checks the result 
renumberFaces :: [(Vertex,Vertex)] -> [TileFace] -> [TileFace]
renumberFaces :: [(Vertex, Vertex)] -> [TileFace] -> [TileFace]
renumberFaces [(Vertex, Vertex)]
prs = (TileFace -> TileFace) -> [TileFace] -> [TileFace]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TileFace -> TileFace
renumberFace where
    mapping :: IntMap Vertex
mapping = [(Vertex, Vertex)] -> IntMap Vertex
forall a. [(Vertex, a)] -> IntMap a
VMap.fromList ([(Vertex, Vertex)] -> IntMap Vertex)
-> [(Vertex, Vertex)] -> IntMap Vertex
forall a b. (a -> b) -> a -> b
$ [(Vertex, Vertex)] -> [(Vertex, Vertex)]
forall a. Eq a => [(a, a)] -> [(a, a)]
differing [(Vertex, Vertex)]
prs
    renumberFace :: TileFace -> TileFace
renumberFace = ((Vertex, Vertex, Vertex) -> (Vertex, Vertex, Vertex))
-> TileFace -> TileFace
forall a b. (a -> b) -> HalfTile a -> HalfTile b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Vertex -> Vertex)
-> (Vertex, Vertex, Vertex) -> (Vertex, Vertex, Vertex)
forall {t} {c}. (t -> c) -> (t, t, t) -> (c, c, c)
all3 Vertex -> Vertex
renumber)
    all3 :: (t -> c) -> (t, t, t) -> (c, c, c)
all3 t -> c
f (t
a,t
b,t
c) = (t -> c
f t
a,t -> c
f t
b,t -> c
f t
c)
    renumber :: Vertex -> Vertex
renumber Vertex
v = Vertex -> Vertex -> IntMap Vertex -> Vertex
forall a. a -> Vertex -> IntMap a -> a
VMap.findWithDefault Vertex
v Vertex
v IntMap Vertex
mapping
 
                     
{-|
tryMatchFace f g - looks for a face in g that corresponds to f (sharing a directed edge),
If the corresponding face does not match properly (with twoVMatch) this stops the
matching process returning Left ... to indicate a failed match.
Otherwise it returns either Right (Just f) where f is the matched face or
Right Nothing if there is no corresponding face.
-}
tryMatchFace:: TileFace -> Tgraph -> Try (Maybe TileFace)  
tryMatchFace :: TileFace -> Tgraph -> Try (Maybe TileFace)
tryMatchFace TileFace
face Tgraph
g = String -> Try (Maybe TileFace) -> Try (Maybe TileFace)
forall a. String -> Try a -> Try a
onFail String
"tryMatchFace:\n" (Try (Maybe TileFace) -> Try (Maybe TileFace))
-> Try (Maybe TileFace) -> Try (Maybe TileFace)
forall a b. (a -> b) -> a -> b
$
  case (TileFace -> Bool) -> [TileFace] -> Maybe TileFace
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (TileFace -> [(Vertex, Vertex)] -> Bool
`hasDedgeIn` TileFace -> [(Vertex, Vertex)]
faceDedges TileFace
face) (Tgraph -> [TileFace]
faces Tgraph
g) of
    Maybe TileFace
Nothing      -> Maybe TileFace -> Try (Maybe TileFace)
forall a b. b -> Either a b
Right Maybe TileFace
forall a. Maybe a
Nothing
    Just TileFace
corresp -> if TileFace -> TileFace -> Bool
twoVMatch TileFace
corresp TileFace
face
                    then Maybe TileFace -> Try (Maybe TileFace)
forall a b. b -> Either a b
Right (Maybe TileFace -> Try (Maybe TileFace))
-> Maybe TileFace -> Try (Maybe TileFace)
forall a b. (a -> b) -> a -> b
$ TileFace -> Maybe TileFace
forall a. a -> Maybe a
Just TileFace
corresp
                    else String -> Try (Maybe TileFace)
forall a b. a -> Either a b
Left (String -> Try (Maybe TileFace)) -> String -> Try (Maybe TileFace)
forall a b. (a -> b) -> a -> b
$ String
"Found non matching faces " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (TileFace, TileFace) -> String
forall a. Show a => a -> String
show (TileFace
corresp, TileFace
face) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"

-- |twoVMatch f1 f2 is True if the two tilefaces are the same except
-- for a single vertex label possibly not matching.
twoVMatch:: TileFace -> TileFace -> Bool
twoVMatch :: TileFace -> TileFace -> Bool
twoVMatch TileFace
f1 TileFace
f2 = TileFace -> TileFace -> Bool
forall rep1 rep2. HalfTile rep1 -> HalfTile rep2 -> Bool
isMatched TileFace
f1 TileFace
f2 Bool -> Bool -> Bool
&&
                  if TileFace -> Vertex
firstV TileFace
f1 Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
== TileFace -> Vertex
firstV TileFace
f2
                  then TileFace -> Vertex
secondV TileFace
f1 Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
== TileFace -> Vertex
secondV TileFace
f2 Bool -> Bool -> Bool
|| TileFace -> Vertex
thirdV TileFace
f1 Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
== TileFace -> Vertex
thirdV TileFace
f2
                  else TileFace -> Vertex
secondV TileFace
f1 Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
== TileFace -> Vertex
secondV TileFace
f2 Bool -> Bool -> Bool
&& TileFace -> Vertex
thirdV TileFace
f1 Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
== TileFace -> Vertex
thirdV TileFace
f2

{-|A version of tryMatchFace that just ignores mismatches.
matchFaceIgnore f g - looks for a face in g that corresponds to f (sharing a directed edge),
If there is a corresponding face f' which matches label and corresponding directed edge then Just f' is returned
Otherwise Nothing is returned. (Thus ignoring a clash)
-}
matchFaceIgnore:: TileFace -> Tgraph -> Maybe TileFace  
matchFaceIgnore :: TileFace -> Tgraph -> Maybe TileFace
matchFaceIgnore TileFace
face Tgraph
g = case TileFace -> Tgraph -> Try (Maybe TileFace)
tryMatchFace TileFace
face Tgraph
g of
   Right Maybe TileFace
mf -> Maybe TileFace
mf
   Left String
_   -> Maybe TileFace
forall a. Maybe a
Nothing
   

-- |selects only non-matching pairs from a list
differing :: Eq a => [(a,a)] -> [(a,a)]
differing :: forall a. Eq a => [(a, a)] -> [(a, a)]
differing = ((a, a) -> Bool) -> [(a, a)] -> [(a, a)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(a
a,a
b) -> a
aa -> a -> Bool
forall a. Eq a => a -> a -> Bool
/=a
b)